C CHAMPM    SOURCE    CHAT      05/01/12    21:55:18     5004
        SUBROUTINE CHAMPM (RX,ZX,RXC,ZXC,SURF,NE,ELIP,DELIP,CHGR,BZ)
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8 (A-H,O-Z)
-INC CCREEL
        REAL*8 RX,ZX,RXC,ZXC,SURF,Z
        REAL*8 CHGR,CHGZ
        REAL*8 FCIR,DH,AX,AS1,AS2,ELI,DELI
        INTEGER  NE,NF
        DIMENSION  ELIP(101),DELIP(101)

C       WRITE(6,*) '##ChampMag##','RX=',RX
        IF (RXC.EQ.0.) THEN
c        WRITE(6,*) 'ERREUR il faut un rayon d inducteur > 0 '
           call erreur(959)
        ELSE

        F=8.54
        DH=SURF/F
        AS1= (RX*RX)+(RXC*RXC)+((ZX-ZXC)*(ZX-ZXC))
        as1 = as1 + dh
*        IF ((AS1-(2*RX*RXC)).LE.DH) THEN
*        AS1=(2*RX*RXC)+DH
*        END IF
        AS2= AS1**0.5
        AX= RX*RXC/AS1
        NF= INT(2*AX*NE)

        IF (NF.LT.NE) THEN

        ELI= (ELIP(NF+1)*(NF+1-(2*AX*NE)))+(ELIP(NF+2)*((2*AX*NE)-NF))
C       WRITE(6,*) 'ELI=',ELI
        DELI=(DELIP(NF+1)*(NF+1-(2*AX*NE)))+(DELIP(NF+2)*((2*AX*NE)-NF))
        ELI=ELI-(0.707107*(LOG(1-(4*AX*AX))))+(0.3127313*AX*AX)
        DELI=DELI+(5.656856*AX/(1-(4*AX*AX)))+(0.625463*AX)

        FCIR=(2*AX*DELI)-ELI
        IF (RX.EQ.0 ) THEN
          CHGR= 0.
          Z= ABS(ZXC-ZX)
c         BZ=(2.*xpi*1.e-1)*((rxc/z)**3)*((1.+(rxc/z)**2)**(-1.5))*(1./rxc)
          BZ=(2.*xpi*1.e-1)*((1.+(z/rxc)**2)**(-1.5))*(1./rxc)
        ELSE
         CHGR=FCIR/(10.*RX*AS1)*AS2*(ZX-ZXC)
         FCIR=(RXC/RX*DELI)-FCIR
         BZ= FCIR/(10.*AS1)*AS2
        END IF

        ELSE
          WRITE(6,*) 'Attention NF=',NF,'>=NE=',NE,'B non calcule'
           call erreur(960)
        END IF

        END IF
        RETURN
        END