Sources Esope | Cast3M

chamar
C CHAMAR    SOURCE    CHAT      05/01/12    21:54:46     5004
      SUBROUTINE CHAMAR(IUNIT,IC,CC,A1,A2,RI,ALFA,BETA,DENS,XP,YP,ZP,
     +     BXP,BYP,BZP)
C-----------------------------------------------------------------------
CALCUL DU CHAMP D'UN ARC DE BOBINE RECTANGULAIRE
C     IUNIT INDIQUE LES UNITES CHOISIES:
C                             IUNIT=0 OU 1   IUNIT=2         IUNIT=3
C     DIMENSIONS EN                M          MM              MM
C     DENSITE DE COURANT EN       A/M2       A/MM2           A/MM2
C     CHAMP EN                   TESLA       TESLA           GAUSS
C     GRADIENTS EN               TESLA/M     TESLA/MM        GAUSS/MM
C     FMUJ=MU*DENS/4*XPI         1E-7*DENS   1E-4*DENS         DENS
C
C     PRECIS=PRECISION RELATIVE DEMANDEE DU CALCUL DES INTEGRALES
C     PRABW=PRECISION ABSOLUE DU CALCUL SUR LA COMPOSANTE BW
C
C     IF(IC.EQ.1) CALCUL DE LA COMPOSANTE BZP SEULE
C     IF(IC.EQ.2) CALCUL DES COMPOSANTES BXP ET BYP SEULES
C     IF(IC.NE.1.OR.NE.2) CALCUL DES TROIS COMPOSANTES BZP BYP BXP
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      EXTERNAL FONZ,FONR,FONT
      DIMENSION CC(3)
-INC CCREEL
 
-INC PPARAM
-INC CCOPTIO
      COMMON/CMCHAM/ D1,D2,R,A,U,DD1,DD2,LSOMD,LD1,LD2
      LOGICAL LSOMD,LSOMT,LD1,LD2,LR
      BXP=0.D0
      BYP=0.D0
      BZP=0.D0
      BRP=0.D0
      BTP=0.D0
      PRABZ=0.D0
      UPSI=0.000001D0
      U=1.D0
      UU=1.D0
      FMUJ=DENS*0.0000001D0
      IF(IUNIT.EQ.2) FMUJ=DENS*0.0001D0
      IF(IUNIT.EQ.3) FMUJ=DENS
      RMUJ=FMUJ*RI
      X=XP-CC(1)
      Y=YP-CC(2)
      RP=SQRT(X**2+Y**2)
      Z=(ZP-CC(3))/RI
      D1=Z-BETA
      D2=Z+BETA
      R=RP/RI
      A=ALFA
      DD1=D1**2
      DD2=D2**2
      AA=A**2
      LR=R.LE.UPSI
      LSOMD=ABS(D1+D2).LE.UPSI
      LD1=ABS(D1).LE.UPSI
      LD2=ABS(D2).LE.UPSI
      IF(LR) GOTO 2
      TAU=ASIN(Y/RP)
      IF(X.LT.0.D0) TAU=XPI-TAU
      T1=A1-TAU
      T2=A2-TAU
      ABST=ABS(T1+T2)
      LSOMT=(ABST.LE.UPSI).OR.(ABS(ABST-2.D0*XPI).LE.UPSI)
      IF(LSOMT) T1=(T1+T2)/2.D0
      COSTAU=COS(TAU)
      SINTAU=SIN(TAU)
C
CAS OU R.NE.0.D0
      IF(IC.EQ.2) GOTO 11
CALCUL DE LA COMPOSANTE AXIALE BZP
      ACBZ=0.D0
      SOMBZ= GQUAD(FONZ,T1,T2,80)
      IF(IERR.NE.0) RETURN
      BZP=RMUJ*(SOMBZ+FZ4(T2)-FZ4(T1))
      IF(LSOMT) BZP=2.D0*BZP
      PRABZ=ABS(ACBZ*SOMBZ*RMUJ)
      IF(SOMBZ.EQ.0.D0)  PRABZ=RMUJ*ACBZ
      IF(LSOMT) PRABZ=2.D0*PRABZ
      IF(IC.EQ.1) RETURN
 11   CONTINUE
CALCUL DE LA COMPOSANTE RADIALE BRP
      IF(LSOMD)  RETURN
      SOMBR= GQUAD(FONR,T1,T2,80)
      IF(IERR.NE.0) RETURN
      IF(LSOMT) SOMBR=2.D0*SOMBR
      BRP=RMUJ*SOMBR
CALCUL DE LA COMPOSANTE TANGENTIELLE
      IF(LSOMT) GOTO 3
      SOMBT= GQUAD(FONT,T1,T2,80)
      IF(IERR.NE.0) RETURN
      BTP=RMUJ*SOMBT
 3    CONTINUE
CALCUL DES COMPOSANTES BXP ET BYP
      BXP=BRP*COSTAU-BTP*SINTAU
      BYP=BRP*SINTAU+BTP*COSTAU
      RETURN
 2    CONTINUE
C
CAS OU R.EQ.0.D0
      SQA2=SQRT(AA+DD2)
      SQA1=SQRT(AA+DD1)
      SQU2=SQRT(UU+DD2)
      SQU1=SQRT(UU+DD1)
      IF(IC.EQ.2) GOTO 22
      SOMLG2=LOG((A+SQA2)/(U+SQU2))
      SOMLG1=LOG((A+SQA1)/(U+SQU1))
      BZP=RMUJ*(D2*SOMLG2-D1*SOMLG1)*(A2-A1)
      IF(IC.EQ.1) RETURN
 22   CONTINUE
      IF(LSOMD) RETURN
      SOR=SQA2-SQA1-SQU2+SQU1
      BXP=RMUJ*SOR*(SIN(A1)-SIN(A2))
      BYP=RMUJ*SOR*(COS(A2)-COS(A1))
      RETURN
      END