]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 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 |