This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / c / r4sp.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:01:57  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10 #if defined(CERNLIB_SINGLE)
11       FUNCTION C309R4(X,ETA,ZL,EPS,FCL,TPK1,ETANE0,LIMIT,ERR,NFP,
12      1              FPMIN,FPMAX,LPR)
13 C
14 C ***   Evaluate CF1 = F'(ZL,ETA,X)/F(ZL,ETA,X)    (REAL)
15 C
16       IMPLICIT REAL(A-H,O-Z)
17       LOGICAL LPR,ETANE0
18
19       FCL=1
20       XI=1/X
21       PK=ZL+1
22       PX=PK+LIMIT
23       EK=ETA/PK
24       F=EK+PK*XI
25       IF(ABS(F) .LT. FPMIN) F=FPMIN
26       D=0
27       C=F
28       SMALL=SQRT(FPMIN)
29       RK2=1+EK*EK
30 C
31 C ***   begin CF1 loop on PK = k = lambda + 1
32 C
33    10 PK1=PK+1
34       TPK1=PK+PK1
35       IF(ETANE0) THEN
36        EK=ETA/PK
37        RK2=1+EK*EK
38        TK=TPK1*(XI+EK/PK1)
39       ELSE
40        TK=TPK1*XI
41       END IF
42       C=TK-RK2/C
43       D=TK-RK2*D
44       IF(ABS(C) .LT. FPMIN) C=FPMIN
45       IF(ABS(D) .LT. FPMIN) D=FPMIN
46       D=1/D
47       DF=D*C
48       F=F*DF
49       FCL=FCL*D*TPK1*XI
50       IF(ABS(FCL) .LT. SMALL) FCL=FCL/SMALL
51       IF(ABS(FCL) .GT. FPMAX) FCL=FCL*FPMIN
52       PK=PK1
53       IF(PK .LE. PX) THEN
54        IF(ABS(DF-1) .GE. EPS) GO TO 10
55        NFP=PK-ZL-1
56        ERR=EPS*SQRT(REAL(NFP))
57        C309R4=F
58       ELSE
59        IF(LPR) WRITE (6,1000) LIMIT,ABS(X)
60        ERR=2
61       END IF
62       RETURN
63  1000 FORMAT(1X,'***** CERN C309 CCLBES ... CF1 (REAL) HAS FAILED ',
64      1'TO CONVERGE AFTER',I10,' ITERATIONS AS ABS(X) =',F15.0)
65       END
66 #endif