Download champm.eso

Back to the list

   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