This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / c / r3sp.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 C309R3(AA,BB,Z,EPS,JMAX,RE,FPMAX,N,X)
12 C
13 C     evaluate the HYPERGEOMETRIC FUNCTION
14 C                                             i
15 C            F (AA,BB;;Z) = SUM  (AA)  (BB)  Z / i!
16 C           2 0              i       i     i
17 C
18 C     to accuracy EPS with at most JMAX terms.
19 C
20 C     if the terms start diverging,
21 C     the corresponding continued fraction is found by RCF
22 C     & evaluated progressively by Steed's method to obtain convergence.
23 C
24       IMPLICIT COMPLEX(A-H,O-Z)
25       DIMENSION X(JMAX,4)
26       LOGICAL FINITE
27       REAL EP,EPS,AT,ATL,ABSC,RE,FPMAX
28
29       ABSC(W)=ABS(REAL(W))+ABS(AIMAG(W))
30       NINTC(W)=NINT(REAL(W))
31 C
32       RE=0
33       X(1,1)=1
34       SUM=X(1,1)
35       ATL=ABSC(X(1,1))
36       F=SUM
37       D=1
38       DF=SUM
39       J=0
40       EP=EPS*(10*JMAX)
41       MA=-NINTC(AA)
42       MB=-NINTC(BB)
43       FINITE=ABS(ABS(REAL(AA))-MA) .LT. EP .AND. ABS(AIMAG(AA)) .LT. EP
44      1  .OR. ABS(ABS(REAL(BB))-MB) .LT. EP .AND. ABS(AIMAG(BB)) .LT. EP
45       IMAX=JMAX
46       IF(FINITE .AND. MA .GE. 0) IMAX=MIN(MA+1,IMAX)
47       IF(FINITE .AND. MB .GE. 0) IMAX=MIN(MB+1,IMAX)
48       DO 10 I = 2,IMAX
49       X(I,1)=X(I-1,1)*Z*(AA+I-2)*(BB+I-2)/(I-1)
50       IF(ABSC(X(I,1)) .GT. FPMAX) THEN
51        N=0
52        C309R3=SUM
53        IF(.NOT.FINITE) RE=AT/ABSC(SUM)
54        RETURN
55       END IF
56       AT=ABSC(X(I,1))
57       IF(J .EQ. 0) THEN
58        SUM=SUM+X(I,1)
59        IF(AT .LT. ABSC(SUM)*EPS) THEN
60         N=I
61         C309R3=SUM
62         IF(.NOT.FINITE) RE=AT/ABSC(SUM)
63         RETURN
64        END IF
65       END IF
66       IF(FINITE) GO TO 10
67       IF(J .GT. 0 .OR. AT .GT. ATL .OR. I .GE. JMAX-2) J=J+1
68       IF(J .EQ. 0) GO TO 10
69       CALL C309R7(X(1,1),X(1,2),J,I,X(1,3),EPS)
70       IF(I .LT. 0) THEN
71        N=0
72        C309R3=SUM
73        IF(.NOT.FINITE) RE=AT/ABSC(SUM)
74        RETURN
75       END IF
76       DO 50 K = MAX(J,2),I
77       D=1/(D*X(K,2)+1)
78       DF=DF*D-DF
79       F=F+DF
80       IF(ABSC(DF) .LT. ABSC(F)*EPS .OR.
81      1   DF .EQ. 0 .AND. F .EQ. 0 .AND. I .GE. 4) THEN
82        N=K
83        C309R3=F
84        RE=ABSC(DF)/ABSC(F)
85        RETURN
86       END IF
87    50 CONTINUE
88       J=I
89    10 ATL=AT
90       IF(.NOT.FINITE) I=-JMAX
91       N=I
92       C309R3=SUM
93       IF(.NOT.FINITE) RE=AT/ABSC(SUM)
94       RETURN
95       END
96 #endif