Sources Esope | Cast3M

farca
C FARCA     SOURCE    CB215821  17/07/21    21:15:09     9513           
      FUNCTION FARCA(X,A,B,C,D,E,R,COST,SINT)
      IMPLICIT INTEGER(I-N)
      REAL*8 X,A,B,C,D,E
      REAL*8 T,ARG,DE
      REAL*8 RE,IM,SA,FARCA,AL,BE,DELTA
      REAL*8 C0,C1,C2,C3,C4,C5,C6,K1,K2
      REAL*8 R,COST,SINT,RES,MU,TD
      REAL*8 A2,B2,XI
      REAL*8 PREC
CCCCC CASTEM 2000 interdit COMPLEX*16.....
C      COMPLEX*16 Z1,FNUM1,DENRED,TMP
      COMPLEX*16 Z1,FNUM1,DENRED,TMP
C
      DATA PREC/1.D-8/
C
      SA=SQRT(A)
      AL=1.-D/SA
      BE=1.+D/SA
      DELTA=B**2-4.*A*C
      RE=-E+R*COST/(D-SA)
      IM=R*SINT/(D-SA)
      Z1=CMPLX(RE,IM)
C
      T=-SA*X+SQRT(A*X**2+B*X+C)
      DE=B-2.*SA*T
      C0=1./(4.*A)
C
      IF(ABS(IM).GT.PREC) THEN
       IF((ABS(DE).GT.PREC).AND.(ABS(DELTA).GT.PREC)) THEN
        ARG=(T-RE)/IM
        C1=B/(8.*A**1.5)-(B-2.*E*SA)/(4.*A*(D-SA))
        C4=(B**2-4.*A*C)**2/(8.*A**1.5)
        DENRED=(B-2.*SA*Z1)**3
        TMP=(Z1**2-C)**2
     &     *(2.*A*AL*Z1**2-2.*B*SA*AL*Z1+B**2-2.*A*C*BE)
        FNUM1=TMP/DENRED
        C5=AIMAG(FNUM1)/IM
        C6=REAL(FNUM1)-C5*RE
        K1=-2.*C1*DELTA
        K1=K1-C4*(2.*B**3+24.*A*B*C)/DELTA**2
        K1=K1-2.*(C5*C*(B-2.*E*SA)-C6*(E*B-2.*C*SA))/R**2
        K2=-C0*DELTA/(2.*SA)
        K2=K2-C4*(3.*B**2+4.*A*C)/DELTA**2
        K2=K2+(C5*(E*B-2.*C*SA)-C6*(B-2.*E*SA))/(2.*SA*R**2)
        C3=B*K2-0.5*K1
        C2=K2-2.*B*C3/DELTA
        RES=0.5*C0*T**2+C1*T-C2*LOG(ABS(DE))/(2.*SA)
     &     +C3/(2.*SA*DE)+C4/(4.*SA*DE**2)
     &     +(C5*0.5*LOG(ABS(T**2-2.*RE*T+(RE**2+IM**2)))
     &     +(C6+RE*C5)/IM*ATAN(ARG))/(D-SA)
       ELSE
        A2=D+SA
        B2=B/(2.*SA)+E
        XI=A2*X+B2
        RES=(0.5*XI*(XI-4.*B2)+B2**2*LOG(ABS(XI)))/(A2**2)
       ENDIF
      ELSE
       IF((ABS(DE).GT.PREC).AND.(ABS(DELTA).GT.PREC)) THEN
        TD=(E*SA-0.5*B)/(D-SA)
        MU=-D*R-E
        C1=(3.*B-4.*MU/(D-SA))/(8.*A*SA)
        C5=2.*R**2
        C4=2.*MU**4/(A*SA)
        K1=-C1*DELTA-C4*(B**3+12.*A*B*C)/DELTA**2
        K1=K1+C5*TD*DELTA/(TD**2-C)
        K2=-C0*0.5*DELTA/SA-C4*(3.*B**2+4.*A*C)/DELTA**2
        K2=K2+C5*DELTA*0.5/((TD**2-C)*SA)
        C3=B*K2-K1
        C2=K2-2.*B*C3/DELTA
        RES=0.5*C0*T**2+C1*T-C2*LOG(ABS(DE))/(2.*SA)
     &     +C3/(2.*SA*DE)+C4/(4.*SA*DE**2)
     &     +C5*LOG(ABS(T-TD))
       ELSE
        A2=D+SA
        B2=B/(2.*SA)+E
        XI=A2*X+B2
        RES=(0.5*XI*(XI-4.*B2)+B2**2*LOG(ABS(XI)))/(A2**2)
       ENDIF
      ENDIF
      FARCA=0.5*RES
      RETURN
      END