1 : C CHAMPM SOURCE CHAT 05/01/12 21:55:18 5004 2 : SUBROUTINE CHAMPM (RX,ZX,RXC,ZXC,SURF,NE,ELIP,DELIP,CHGR,BZ) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : -INC CCREEL 6 : REAL*8 RX,ZX,RXC,ZXC,SURF,Z 7 : REAL*8 CHGR,CHGZ 8 : REAL*8 FCIR,DH,AX,AS1,AS2,ELI,DELI 9 : INTEGER NE,NF 10 : DIMENSION ELIP(101),DELIP(101) 11 : 12 : C WRITE(6,*) '##ChampMag##','RX=',RX 13 : IF (RXC.EQ.0.) THEN 14 : c WRITE(6,*) 'ERREUR il faut un rayon d inducteur > 0 ' 14 : call erreur(959) 15 : ELSE 16 : 17 : F=8.54 18 : DH=SURF/F 19 : AS1= (RX*RX)+(RXC*RXC)+((ZX-ZXC)*(ZX-ZXC)) 20 : as1 = as1 + dh 21 : * IF ((AS1-(2*RX*RXC)).LE.DH) THEN 22 : * AS1=(2*RX*RXC)+DH 23 : * END IF 24 : AS2= AS1**0.5 25 : AX= RX*RXC/AS1 26 : NF= INT(2*AX*NE) 27 : 28 : IF (NF.LT.NE) THEN 29 : 30 : ELI= (ELIP(NF+1)*(NF+1-(2*AX*NE)))+(ELIP(NF+2)*((2*AX*NE)-NF)) 31 : C WRITE(6,*) 'ELI=',ELI 32 : DELI=(DELIP(NF+1)*(NF+1-(2*AX*NE)))+(DELIP(NF+2)*((2*AX*NE)-NF)) 33 : ELI=ELI-(0.707107*(LOG(1-(4*AX*AX))))+(0.3127313*AX*AX) 34 : DELI=DELI+(5.656856*AX/(1-(4*AX*AX)))+(0.625463*AX) 35 : 36 : FCIR=(2*AX*DELI)-ELI 37 : IF (RX.EQ.0 ) THEN 38 : CHGR= 0. 39 : Z= ABS(ZXC-ZX) 40 : c BZ=(2.*xpi*1.e-1)*((rxc/z)**3)*((1.+(rxc/z)**2)**(-1.5))*(1./rxc) 41 : BZ=(2.*xpi*1.e-1)*((1.+(z/rxc)**2)**(-1.5))*(1./rxc) 42 : ELSE 43 : CHGR=FCIR/(10.*RX*AS1)*AS2*(ZX-ZXC) 44 : FCIR=(RXC/RX*DELI)-FCIR 45 : BZ= FCIR/(10.*AS1)*AS2 46 : END IF 47 : 48 : ELSE 49 : WRITE(6,*) 'Attention NF=',NF,'>=NE=',NE,'B non calcule' 49 : call erreur(960) 50 : END IF 51 : 52 : END IF 53 : RETURN 54 : END 55 : 56 : 57 : 58 : 59 :
© Cast3M 2003 - All rights reserved.
Disclaimer