MINICERN/mathlib/gen/c/rrizet64.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:00  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 #if defined(CERNLIB_DOUBLE)
  11       FUNCTION DRIZET(X)
  12 C
  13 #include "gen/imp64.inc"
  14 C
  15       CHARACTER*(*) NAME
  16       PARAMETER(NAME='RRIZET/DRIZET')
  17 #endif
  18 #if !defined(CERNLIB_DOUBLE)
  19       FUNCTION RRIZET(X)
  20 C
  21       CHARACTER*(*) NAME
  22       PARAMETER(NAME='RRIZET')
  23 #endif
  24 C
  25       DIMENSION P1(0:8),P2(0:8),P3(0:9),P4(0:8)
  26       DIMENSION Q1(0:8),Q2(0:8),Q3(0:9),Q4(0:8)
  27
  28       PARAMETER (DELTA = 1D-13)
  29       PARAMETER (Z1 = 1, HF = Z1/2, TH = Z1/3)
  30       PARAMETER (PI = 3.14159 26535 89793 24D0)
  31       PARAMETER (PIH = PI/2, PI2 = 2*PI)
  32
  33       DATA (P1(J),Q1(J),J=0,8)
  34      A/ 1.28716 81214 82446 39D+10, 2.57433 62429 64846 24D+10,
  35      1  1.37539 69320 37025 11D+10, 5.93816 56486 79590 16D+09,
  36      2  5.10665 59183 64406 10D+09, 9.00633 03732 61233 44D+08,
  37      3  8.56147 10024 33314 86D+08, 8.04253 66342 83289 89D+07,
  38      4  7.48361 81243 80232 98D+07, 5.60971 17595 41920 06D+06,
  39      5  4.86010 65854 61882 51D+06, 2.24743 12028 99137 52D+05,
  40      6  2.73957 49902 21406 09D+05, 7.57457 89093 41537 56D+03,
  41      7  4.63171 08431 83427 12D+03,-2.37383 57813 73772 62D+01,
  42      8  5.78758 10040 96660 66D+01, 1/
  43
  44       DATA (P2(J),Q2(J),J=0,8)
  45      A/-6.88197 29321 63489 54D+06,-1.29725 62493 48915 54D+09,
  46      1  7.48218 91630 53159 72D+06,-9.48715 40757 99078 17D+08,
  47      2 -2.07584 50481 02110 14D+06,-1.05496 19347 40052 03D+08,
  48      3  3.55302 55709 62142 95D+05, 4.67774 48821 19930 48D+06,
  49      4 -4.06706 44955 18548 89D+04, 3.12936 04057 38135 34D+06,
  50      5  3.19804 86402 71469 11D+03, 4.59581 80383 93050 70D+05,
  51      6 -1.69820 93703 37228 53D+02, 3.88176 10961 03968 34D+04,
  52      7  5.61485 84239 42890 48D+00, 1.92561 54483 44914 23D+03,
  53      8 -8.93888 70592 61549 44D-02, 5.12578 12500 00000 00D+01/
  54
  55       DATA (P3(J),Q3(J),J=0,9)
  56      A/ 1.66156 48051 57746 76D-11,-6.99562 63351 91916 55D-10,
  57      1 -4.68068 82766 06545 29D-09,-1.77757 96189 51492 57D-08,
  58      2  5.83519 72731 91470 47D-07,-9.82231 82573 40780 36D-07,
  59      3 -4.17644 01264 31456 02D-05,-2.84927 28275 90964 88D-05,
  60      4  1.85468 42284 35979 59D-03,-5.81727 90938 80480 94D-04,
  61      5 -5.11288 80022 04902 41D-02,-1.15848 74916 97665 86D-02,
  62      6  8.10450 23175 11003 53D-01,-1.28149 12405 19781 96D-01,
  63      7 -5.69951 94876 84789 23D+00,-1.11913 05734 90977 09D+00,
  64      8  0                         ,-7.67928 76160 46288 13D-01,
  65      9  0                         , 1/
  66
  67       DATA (P4(J),Q4(J),J=0,8)
  68      A/ 1.03144 87718 88597 12D-15, 5.93959 41728 84190 50D-11,
  69      1 -5.12584 61396 46882 41D-13,-6.04755 35907 99918 06D-09,
  70      2  1.12948 79419 48735 48D-10, 3.64680 20866 83885 63D-07,
  71      3 -1.44234 66537 31309 52D-08,-1.29456 90556 80118 12D-05,
  72      4  1.16824 67698 44580 98D-06, 3.20189 49847 02292 50D-04,
  73      5 -6.14975 16799 03148 06D-05,-5.07801 55709 99940 77D-03,
  74      6  2.05594 67798 88303 28D-03, 5.49628 90788 15872 66D-02,
  75      7 -3.99339 42939 46688 69D-02,-3.24517 61115 59724 19D-01,
  76      8  3.45234 97673 61784 57D-01, 1/
  77
  78       V=X
  79       F=1
  80       IF(X .NE. 0 .AND. X .LT. HF) THEN
  81        IX=X-DELTA
  82        IF(ABS(IX-X) .LE. DELTA) THEN
  83         IF(MOD(-IX,2) .EQ. 0) THEN
  84          H=0
  85          GO TO 9
  86         ELSE
  87          V=1-X
  88 #if defined(CERNLIB_DOUBLE)
  89          F=2*(-Z1)**((1-IX)/2)*DGAMMA(V)/PI2**V
  90 #endif
  91 #if !defined(CERNLIB_DOUBLE)
  92          F=2*(-Z1)**((1-IX)/2)*GAMMA(V)/PI2**V
  93 #endif
  94         ENDIF
  95        ELSE
  96         V=1-X
  97 #if defined(CERNLIB_DOUBLE)
  98         F=2*SIN(PIH*X)*DGAMMA(V)/PI2**V
  99 #endif
 100 #if !defined(CERNLIB_DOUBLE)
 101         F=2*SIN(PIH*X)*GAMMA(V)/PI2**V
 102 #endif
 103        ENDIF
 104       ENDIF
 105       IF(X .EQ. 0) THEN
 106        H=-3*HF
 107       ELSEIF(X .EQ. 1) THEN
 108        H=0
 109        CALL MTLPRT(NAME,'C315.1','ZETA(X) HAS POLE AT X = 1')
 110       ELSEIF(V .LE. 5) THEN
 111        AP=P1(8)
 112        AQ=Q1(8)
 113        DO 1 J = 7,0,-1
 114        AP=P1(J)+V*AP
 115     1  AQ=Q1(J)+V*AQ
 116        H=AP/(AQ*(V-1))-1
 117       ELSEIF(V .LE. 11) THEN
 118        T=TH*(V-8)
 119        ALFA=T+T
 120        B1=0
 121        B2=0
 122        DO 2 J = 8,0,-1
 123        B0=P2(J)+ALFA*B1-B2
 124        B2=B1
 125     2  B1=B0
 126        H=B0-T*B2
 127        B1=0
 128        B2=0
 129        DO 12 J = 8,0,-1
 130        B0=Q2(J)+ALFA*B1-B2
 131        B2=B1
 132    12  B1=B0
 133        H=H/(B0-T*B2)
 134       ELSEIF(V .LE. 25) THEN
 135        T=1/V
 136        AP=P3(7)
 137        DO 3 J = 6,0,-1
 138     3  AP=P3(J)+T*AP
 139        AQ=Q3(9)
 140        DO 13 J = 8,0,-1
 141    13  AQ=Q3(J)+T*AQ
 142        H=HF**(V-T*AP/AQ)
 143       ELSEIF(V .LE. 55) THEN
 144        T=1/V
 145        AP=P4(8)
 146        AQ=Q4(8)
 147        DO 4 J = 7,0,-1
 148        AP=P4(J)+T*AP
 149     4  AQ=Q4(J)+T*AQ
 150        H=HF**(V-T*AP/AQ)
 151       ELSEIF(V .LE. 90) THEN
 152        H=HF**V+TH**V
 153       ELSE
 154        H=HF**V
 155       ENDIF
 156       IF(X .LT. 1) H=F*(1+H)
 157 #if defined(CERNLIB_DOUBLE)
 158     9 DRIZET=H
 159 #endif
 160 #if !defined(CERNLIB_DOUBLE)
 161     9 RRIZET=H
 162 #endif
 163       RETURN
 164       END