* * $Id: r5sp.F,v 1.1.1.1 1996/04/01 15:01:57 mclareni Exp $ * * $Log: r5sp.F,v $ * Revision 1.1.1.1 1996/04/01 15:01:57 mclareni * Mathlib gen * * #include "gen/pilot.h" #if defined(CERNLIB_SINGLE) FUNCTION C309R5(X,ETA,ZL,EPS,FCL,TPK1,ETANE0,LIMIT,ERR,NFP, 1 FPMIN,FPMAX,LPR) C C *** Evaluate CF1 = F'(ZL,ETA,X)/F(ZL,ETA,X) (COMPLEX) C IMPLICIT COMPLEX(A-H,O-Z) LOGICAL LPR,ETANE0 REAL EPS,ERR,FPMIN,FPMAX,ABSC,SMALL,PX ABSC(W)=ABS(REAL(W))+ABS(AIMAG(W)) FCL=1 XI=1/X PK=ZL+1 PX=PK+LIMIT EK=ETA/PK F=EK+PK*XI IF(ABSC(F) .LT. FPMIN) F=FPMIN D=0 C=F SMALL=SQRT(FPMIN) RK2=1+EK*EK C C *** begin CF1 loop on PK = k = lambda + 1 C 10 PK1=PK+1 TPK1=PK+PK1 IF(ETANE0) THEN EK=ETA/PK RK2=1+EK*EK TK=TPK1*(XI+EK/PK1) ELSE TK=TPK1*XI END IF C=TK-RK2/C D=TK-RK2*D IF(ABSC(C) .LT. FPMIN) C=FPMIN IF(ABSC(D) .LT. FPMIN) D=FPMIN D=1/D DF=D*C F=F*DF FCL=FCL*D*TPK1*XI IF(ABSC(FCL) .LT. SMALL) FCL=FCL/SMALL IF(ABSC(FCL) .GT. FPMAX) FCL=FCL*FPMIN PK=PK1 IF(REAL(PK) .LE. PX) THEN IF(ABSC(DF-1) .GE. EPS) GO TO 10 NFP=PK-ZL-1 ERR=EPS*SQRT(REAL(NFP)) C309R5=F ELSE IF(LPR) WRITE (6,1000) LIMIT,ABS(X) ERR=2 END IF RETURN 1000 FORMAT(1X,'***** CERN C309 CCLBES ... CF1 (COMPLEX) HAS FAILED ', 1'TO CONVERGE AFTER',I10,' ITERATIONS AS ABS(X) =',F15.0) END #endif