X-Git-Url: http://git.uio.no/git/?a=blobdiff_plain;f=MINICERN%2Fmathlib%2Fgen%2Fc%2Fr2dp.F;fp=MINICERN%2Fmathlib%2Fgen%2Fc%2Fr2dp.F;h=0000000000000000000000000000000000000000;hb=b9d0a01d7a0723a09071b0b56200d72f59a9c2b6;hp=e83c7e9c1f2bc0a1d476b33e47cbc0a82e22e0dd;hpb=9754311559f405f3949bf48d6883dd02a93e7088;p=u%2Fmrichter%2FAliRoot.git diff --git a/MINICERN/mathlib/gen/c/r2dp.F b/MINICERN/mathlib/gen/c/r2dp.F deleted file mode 100644 index e83c7e9c1f2..00000000000 --- a/MINICERN/mathlib/gen/c/r2dp.F +++ /dev/null @@ -1,128 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.1.1.1 1996/04/01 15:01:56 mclareni -* Mathlib gen -* -* -#include "gen/pilot.h" -#if defined(CERNLIB_DOUBLE) - FUNCTION C309R2(X,ETA,ZL,P,EPS,LIMIT,KIND,ERR,NITS, - 1 FPMAX,ACC8,ACC16) -C -C *** evaluate the HYPERGEOMETRIC FUNCTION -C i -C F (AA;BB; Z) = SUM (AA) Z / ( (BB) i! ) -C 1 1 i i i -C -C to accuracy EPS with at most LIMIT terms. -C If KIND = 0 : using extended precision but real arithmetic only, -C 1 : using normal precision in complex arithmetic, -C or 2 : using normal complex arithmetic, but with WDIGAM factor -C -C where AA, BB, and Z are defined below -C - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - COMPLEX*16 X,ETA,ZL,P,AA,BB,Z,C309R2,WDIGAM - COMPLEX*16 DD,G,F,AI,BI,T -#if (!defined(CERNLIB_UNIX))&&(!defined(CERNLIB_QMALPH)) - REAL*16 AR,BR,GR,GI,DR,DI,TR,TI,UR,UI,FI,FI1,DEN -#endif -#if defined(CERNLIB_UNIX)||defined(CERNLIB_QMALPH) - DOUBLE PRECISION AR,BR,GR,GI,DR,DI,TR,TI,UR,UI,FI,FI1,DEN -#endif - - PARAMETER(TBBB = 3D0/2D0) - -#if defined(CERNLIB_QF2C) -#include "defdr.inc" -#endif - - ABSC(AA)=ABS(DREAL(AA))+ABS(DIMAG(AA)) - NINTC(AA)=NINT(DREAL(AA)) - - C309R2 = 0. - - AA=ZL+1-ETA*P - BB=2*ZL+2 - Z=2*P*X - IF(DREAL(BB) .LE. 0 .AND. ABS(BB-NINTC(BB)) .LT. - 1 SQRT(SQRT(ACC8))**3 .AND. DREAL(BB)+LIMIT .GE. TBBB) THEN - NITS=-1 - RETURN - END IF - IF(LIMIT .LE. 0) THEN - C309R2=0 - ERR=0 - NITS=1 - RETURN - END IF - TA=1 - RK=1 - IF(KIND .LE. 0 .AND. ABSC(Z)*ABSC(AA) .GT. ABSC(BB)*1.0) THEN - DR=1 - DI=0 - GR=1 - GI=0 - AR=DREAL(AA) - BR=DREAL(BB) - FI=0 - DO 20 I = 2,LIMIT - FI1=FI+1 - TR=BR*FI1 - TI=DIMAG(BB)*FI1 - DEN=1/(TR*TR+TI*TI) - UR=(AR*TR+DIMAG(AA)*TI)*DEN - UI=(DIMAG(AA)*TR-AR*TI)*DEN - TR=UR*GR-UI*GI - TI=UR*GI+UI*GR - GR=DREAL(Z)*TR-DIMAG(Z)*TI - GI=DREAL(Z)*TI+DIMAG(Z)*TR - DR=DR+GR - DI=DI+GI - ERR=ABS(GR)+ABS(GI) - IF(ERR .GT. FPMAX) GO TO 60 - RK=ABS(DR)+ABS(DI) - TA=MAX(TA,RK) - IF(ERR .LT. RK*EPS .OR. I .GE. 4 .AND. ERR .LT. ACC16) GO TO 30 - FI=FI1 - AR=AR+1 - 20 BR=BR+1 -C - 30 C309R2=DR+(0,1)*DI - ERR=ACC16*TA/RK - ELSE -C -C* If REAL*16 arithmetic is not available, (or already using it!), -C* then use KIND > 0 -C - G=1 - F=1 - IF(KIND .GE. 2) F=WDIGAM(AA)-WDIGAM(BB)-WDIGAM(G) - DD=F - DO 40 I = 2,LIMIT - AI=AA+(I-2) - BI=BB+(I-2) - R=I-1 - G=G*Z*AI/(BI*R) -C -C multiply by (psi(a+r)-psi(b+r)-psi(1+r)) -C - IF(KIND .EQ. 2) F=F+1/AI-1/BI-1/R - T=G*F - DD=DD+T - ERR=ABSC(T) - IF(ERR .GT. FPMAX) GO TO 60 - RK=ABSC(DD) - TA=MAX(TA,RK) - IF(ERR .LT. RK*EPS .OR. ERR .LT. ACC8 .AND. I .GE. 4) GO TO 50 - 40 CONTINUE - - 50 ERR=ACC8*TA/RK - C309R2=DD - END IF - 60 NITS=I - RETURN - END -#endif