1 : C CHAMAR SOURCE CHAT 05/01/12 21:54:46 5004 2 : SUBROUTINE CHAMAR(IUNIT,IC,CC,A1,A2,RI,ALFA,BETA,DENS,XP,YP,ZP, 3 : + BXP,BYP,BZP) 4 : C----------------------------------------------------------------------- 5 : CALCUL DU CHAMP D'UN ARC DE BOBINE RECTANGULAIRE 6 : C IUNIT INDIQUE LES UNITES CHOISIES: 7 : C IUNIT=0 OU 1 IUNIT=2 IUNIT=3 8 : C DIMENSIONS EN M MM MM 9 : C DENSITE DE COURANT EN A/M2 A/MM2 A/MM2 10 : C CHAMP EN TESLA TESLA GAUSS 11 : C GRADIENTS EN TESLA/M TESLA/MM GAUSS/MM 12 : C FMUJ=MU*DENS/4*XPI 1E-7*DENS 1E-4*DENS DENS 13 : C 14 : C PRECIS=PRECISION RELATIVE DEMANDEE DU CALCUL DES INTEGRALES 15 : C PRABW=PRECISION ABSOLUE DU CALCUL SUR LA COMPOSANTE BW 16 : C 17 : C IF(IC.EQ.1) CALCUL DE LA COMPOSANTE BZP SEULE 18 : C IF(IC.EQ.2) CALCUL DES COMPOSANTES BXP ET BYP SEULES 19 : C IF(IC.NE.1.OR.NE.2) CALCUL DES TROIS COMPOSANTES BZP BYP BXP 20 : C----------------------------------------------------------------------- 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8 (A-H,O-Z) 23 : EXTERNAL FONZ,FONR,FONT 24 : DIMENSION CC(3) 25 : -INC CCREEL 26 : -INC CCOPTIO 27 : COMMON/CMCHAM/ D1,D2,R,A,U,DD1,DD2,LSOMD,LD1,LD2 28 : LOGICAL LSOMD,LSOMT,LD1,LD2,LR 29 : BXP=0.D0 30 : BYP=0.D0 31 : BZP=0.D0 32 : BRP=0.D0 33 : BTP=0.D0 34 : PRABZ=0.D0 35 : UPSI=0.000001D0 36 : U=1.D0 37 : UU=1.D0 38 : FMUJ=DENS*0.0000001D0 39 : IF(IUNIT.EQ.2) FMUJ=DENS*0.0001D0 40 : IF(IUNIT.EQ.3) FMUJ=DENS 41 : RMUJ=FMUJ*RI 42 : X=XP-CC(1) 43 : Y=YP-CC(2) 44 : RP=SQRT(X**2+Y**2) 45 : Z=(ZP-CC(3))/RI 46 : D1=Z-BETA 47 : D2=Z+BETA 48 : R=RP/RI 49 : A=ALFA 50 : DD1=D1**2 51 : DD2=D2**2 52 : AA=A**2 53 : LR=R.LE.UPSI 54 : LSOMD=ABS(D1+D2).LE.UPSI 55 : LD1=ABS(D1).LE.UPSI 56 : LD2=ABS(D2).LE.UPSI 57 : IF(LR) GOTO 2 58 : TAU=ASIN(Y/RP) 59 : IF(X.LT.0.D0) TAU=XPI-TAU 60 : T1=A1-TAU 61 : T2=A2-TAU 62 : ABST=ABS(T1+T2) 63 : LSOMT=(ABST.LE.UPSI).OR.(ABS(ABST-2.D0*XPI).LE.UPSI) 64 : IF(LSOMT) T1=(T1+T2)/2.D0 65 : COSTAU=COS(TAU) 66 : SINTAU=SIN(TAU) 67 : C 68 : CAS OU R.NE.0.D0 69 : IF(IC.EQ.2) GOTO 11 70 : CALCUL DE LA COMPOSANTE AXIALE BZP 71 : ACBZ=0.D0 72 : SOMBZ= GQUAD(FONZ,T1,T2,80) 73 : IF(IERR.NE.0) RETURN 74 : BZP=RMUJ*(SOMBZ+FZ4(T2)-FZ4(T1)) 75 : IF(LSOMT) BZP=2.D0*BZP 76 : PRABZ=ABS(ACBZ*SOMBZ*RMUJ) 77 : IF(SOMBZ.EQ.0.D0) PRABZ=RMUJ*ACBZ 78 : IF(LSOMT) PRABZ=2.D0*PRABZ 79 : IF(IC.EQ.1) RETURN 80 : 11 CONTINUE 81 : CALCUL DE LA COMPOSANTE RADIALE BRP 82 : IF(LSOMD) RETURN 83 : SOMBR= GQUAD(FONR,T1,T2,80) 84 : IF(IERR.NE.0) RETURN 85 : IF(LSOMT) SOMBR=2.D0*SOMBR 86 : BRP=RMUJ*SOMBR 87 : CALCUL DE LA COMPOSANTE TANGENTIELLE 88 : IF(LSOMT) GOTO 3 89 : SOMBT= GQUAD(FONT,T1,T2,80) 90 : IF(IERR.NE.0) RETURN 91 : BTP=RMUJ*SOMBT 92 : 3 CONTINUE 93 : CALCUL DES COMPOSANTES BXP ET BYP 94 : BXP=BRP*COSTAU-BTP*SINTAU 95 : BYP=BRP*SINTAU+BTP*COSTAU 96 : RETURN 97 : 2 CONTINUE 98 : C 99 : CAS OU R.EQ.0.D0 100 : SQA2=SQRT(AA+DD2) 101 : SQA1=SQRT(AA+DD1) 102 : SQU2=SQRT(UU+DD2) 103 : SQU1=SQRT(UU+DD1) 104 : IF(IC.EQ.2) GOTO 22 105 : SOMLG2=LOG((A+SQA2)/(U+SQU2)) 106 : SOMLG1=LOG((A+SQA1)/(U+SQU1)) 107 : BZP=RMUJ*(D2*SOMLG2-D1*SOMLG1)*(A2-A1) 108 : IF(IC.EQ.1) RETURN 109 : 22 CONTINUE 110 : IF(LSOMD) RETURN 111 : SOR=SQA2-SQA1-SQU2+SQU1 112 : BXP=RMUJ*SOR*(SIN(A1)-SIN(A2)) 113 : BYP=RMUJ*SOR*(COS(A2)-COS(A1)) 114 : RETURN 115 : END 116 : 117 : 118 : 119 : 120 :
© Cast3M 2003 - All rights reserved.
Disclaimer