Esope source files

   1 : C DGAMMA    SOURCE    CHAT      05/01/12    22:48:22     5004           
   2 : *  en proevenance de la bibliotheque du CERN - PV
   3 :       FUNCTION DGAMMA(X)
   4 : C
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C
   8 : -INC CCOPTIO
   9 :       CHARACTER*(*) NAME
  10 :       PARAMETER(NAME='GAMMA/DGAMMA')
  11 : C
  12 :       CHARACTER*80 ERRTXT
  13 : 
  14 :       DIMENSION C(0:15)
  15 : 
  16 :       DATA C( 0) /3.65738 77250 83382 44D0/
  17 :       DATA C( 1) /1.95754 34566 61268 27D0/
  18 :       DATA C( 2) /0.33829 71138 26160 39D0/
  19 :       DATA C( 3) /0.04208 95127 65575 49D0/
  20 :       DATA C( 4) /0.00428 76504 82129 09D0/
  21 :       DATA C( 5) /0.00036 52121 69294 62D0/
  22 :       DATA C( 6) /0.00002 74006 42226 42D0/
  23 :       DATA C( 7) /0.00000 18124 02333 65D0/
  24 :       DATA C( 8) /0.00000 01096 57758 66D0/
  25 :       DATA C( 9) /0.00000 00059 87184 05D0/
  26 :       DATA C(10) /0.00000 00003 07690 81D0/
  27 :       DATA C(11) /0.00000 00000 14317 93D0/
  28 :       DATA C(12) /0.00000 00000 00651 09D0/
  29 :       DATA C(13) /0.00000 00000 00025 96D0/
  30 :       DATA C(14) /0.00000 00000 00001 11D0/
  31 :       DATA C(15) /0.00000 00000 00000 04D0/
  32 : 
  33 :       U=X
  34 :       IF(U .LE. 0) THEN
  35 :        WRITE(IOIMP,*) ' dgamma valeur incorrecte ',U
  36 :        H=0
  37 :        GO TO 9
  38 :       ENDIF
  39 :     8 F=1
  40 :       IF(U .LT. 3) THEN
  41 :        DO 1 I = 1,INT(4-U)
  42 :        F=F/U
  43 :     1  U=U+1
  44 :       ELSE
  45 :        DO 2 I = 1,INT(U-3)
  46 :        U=U-1
  47 :     2  F=F*U
  48 :       END IF
  49 :       H=U+U-7
  50 :       ALFA=H+H
  51 :       B1=0
  52 :       B2=0
  53 :       DO 3 I = 15,0,-1
  54 :       B0=C(I)+ALFA*B1-B2
  55 :       B2=B1
  56 :     3 B1=B0
  57 :     9 DGAMMA=F*(B0-H*B2)
  58 :       RETURN
  59 :   101 FORMAT('ARGUMENT IS NEGATIVE = ',1P,E15.1)
  60 :       END
  61 :  
  62 :  
  63 :  
  64 :