MINICERN/mathlib/gen/c/algama128.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:01:54  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 #if defined(CERNLIB_QUAD)
  11 #if !defined(CERNLIB_DOUBLE)
  12       FUNCTION DLGAMA(X)
  13 #endif
  14 #if defined(CERNLIB_DOUBLE)
  15       FUNCTION QLGAMA(X)
  16 #endif
  17 #include "gen/imp128.inc"
  18       CHARACTER NAME*(*)
  19       CHARACTER*80 ERRTXT
  20 #if defined(CERNLIB_DOUBLE)
  21       PARAMETER (NAME = 'QLGAMA')
  22       DIMENSION C(0:27)
  23
  24       PARAMETER (AL2 =  0.69314 71805 59945 30941 72321 21458 18Q0)
  25
  26       DATA C( 0) / 0.52854 30369 82234 59886 70146 10587 97Q0/
  27       DATA C( 1) / 0.54987 64461 21414 11418 47224 01104 36Q0/
  28       DATA C( 2) / 0.02073 98006 16136 65135 91673 63567 71Q0/
  29       DATA C( 3) /-0.00056 91677 04215 43842 38953 35739 98Q0/
  30       DATA C( 4) / 0.00002 32458 72104 00168 83522 53120 41Q0/
  31       DATA C( 5) /-0.00000 11306 07585 70393 43721 97663 24Q0/
  32       DATA C( 6) / 0.00000 00606 56530 98948 08283 26590 28Q0/
  33       DATA C( 7) /-0.00000 00034 62843 57769 83164 91206 97Q0/
  34       DATA C( 8) / 0.00000 00002 06249 98805 67913 53392 37Q0/
  35       DATA C( 9) /-0.00000 00000 12663 51115 66776 12652 22Q0/
  36       DATA C(10) / 0.00000 00000 00795 31006 91836 38345 01Q0/
  37       DATA C(11) /-0.00000 00000 00050 82076 64160 41154 37Q0/
  38       DATA C(12) / 0.00000 00000 00003 29187 26043 65876 53Q0/
  39       DATA C(13) /-0.00000 00000 00000 21555 55420 93157 81Q0/
  40       DATA C(14) / 0.00000 00000 00000 01423 99484 99073 76Q0/
  41       DATA C(15) /-0.00000 00000 00000 00094 75908 48729 10Q0/
  42       DATA C(16) / 0.00000 00000 00000 00006 34422 73080 16Q0/
  43       DATA C(17) /-0.00000 00000 00000 00000 42694 88760 51Q0/
  44       DATA C(18) / 0.00000 00000 00000 00000 02885 95426 13Q0/
  45       DATA C(19) /-0.00000 00000 00000 00000 00195 82123 61Q0/
  46       DATA C(20) / 0.00000 00000 00000 00000 00013 33140 05Q0/
  47       DATA C(21) /-0.00000 00000 00000 00000 00000 91025 69Q0/
  48       DATA C(22) / 0.00000 00000 00000 00000 00000 06231 33Q0/
  49       DATA C(23) /-0.00000 00000 00000 00000 00000 00427 57Q0/
  50       DATA C(24) / 0.00000 00000 00000 00000 00000 00029 40Q0/
  51       DATA C(25) /-0.00000 00000 00000 00000 00000 00002 02Q0/
  52       DATA C(26) / 0.00000 00000 00000 00000 00000 00000 14Q0/
  53       DATA C(27) /-0.00000 00000 00000 00000 00000 00000 01Q0/
  54
  55       PARAMETER (FM = 1Q20)
  56
  57 #endif
  58 #if !defined(CERNLIB_DOUBLE)
  59       PARAMETER (NAME = 'DLGAMA')
  60       DIMENSION C(0:25)
  61
  62       PARAMETER (AL2 =  0.69314 71805 59945 30941 72321 21458 18D0)
  63
  64       DATA C( 0) / 0.52854 30369 82234 59886 70146 10587 97D0/
  65       DATA C( 1) / 0.54987 64461 21414 11418 47224 01104 36D0/
  66       DATA C( 2) / 0.02073 98006 16136 65135 91673 63567 71D0/
  67       DATA C( 3) /-0.00056 91677 04215 43842 38953 35739 98D0/
  68       DATA C( 4) / 0.00002 32458 72104 00168 83522 53120 41D0/
  69       DATA C( 5) /-0.00000 11306 07585 70393 43721 97663 24D0/
  70       DATA C( 6) / 0.00000 00606 56530 98948 08283 26590 28D0/
  71       DATA C( 7) /-0.00000 00034 62843 57769 83164 91206 97D0/
  72       DATA C( 8) / 0.00000 00002 06249 98805 67913 53392 37D0/
  73       DATA C( 9) /-0.00000 00000 12663 51115 66776 12652 22D0/
  74       DATA C(10) / 0.00000 00000 00795 31006 91836 38345 01D0/
  75       DATA C(11) /-0.00000 00000 00050 82076 64160 41154 37D0/
  76       DATA C(12) / 0.00000 00000 00003 29187 26043 65876 53D0/
  77       DATA C(13) /-0.00000 00000 00000 21555 55420 93157 81D0/
  78       DATA C(14) / 0.00000 00000 00000 01423 99484 99073 76D0/
  79       DATA C(15) /-0.00000 00000 00000 00094 75908 48729 10D0/
  80       DATA C(16) / 0.00000 00000 00000 00006 34422 73080 16D0/
  81       DATA C(17) /-0.00000 00000 00000 00000 42694 88760 51D0/
  82       DATA C(18) / 0.00000 00000 00000 00000 02885 95426 13D0/
  83       DATA C(19) /-0.00000 00000 00000 00000 00195 82123 61D0/
  84       DATA C(20) / 0.00000 00000 00000 00000 00013 33140 05D0/
  85       DATA C(21) /-0.00000 00000 00000 00000 00000 91025 69D0/
  86       DATA C(22) / 0.00000 00000 00000 00000 00000 06231 33D0/
  87       DATA C(23) /-0.00000 00000 00000 00000 00000 00427 57D0/
  88       DATA C(24) / 0.00000 00000 00000 00000 00000 00029 40D0/
  89       DATA C(25) /-0.00000 00000 00000 00000 00000 00002 02D0/
  90
  91       PARAMETER (FM = 1D20)
  92 #endif
  93
  94       U=X
  95       IF(X .LE. 0) THEN
  96        H=0
  97        WRITE(ERRTXT,101) X
  98        CALL MTLPRT(NAME,'C304.1',ERRTXT)
  99        GO TO 9
 100       ENDIF
 101       F=1
 102       IF(U .LT. 3) THEN
 103        DO 1 I = 1,INT(4-U)
 104        F=F/U
 105     1  U=U+1
 106        FL=LOG(F)+AL2
 107       ELSE
 108        FL=AL2
 109        DO 2 I = 1,INT(U-3)
 110        U=U-1
 111        F=F*U
 112        IF(F .GT. FM) THEN
 113         FL=FL+LOG(F)
 114         F=1
 115        ENDIF
 116     2  CONTINUE
 117        FL=FL+LOG(F)
 118       END IF
 119       H=U+U-7
 120       ALFA=H+H
 121       B1=0
 122       B2=0
 123       DO 3 I = 27,0,-1
 124       B0=C(I)+ALFA*B1-B2
 125       B2=B1
 126     3 B1=B0
 127       H=FL+B0-H*B2
 128 #if defined(CERNLIB_DOUBLE)
 129     9 QLGAMA=H
 130 #endif
 131 #if !defined(CERNLIB_DOUBLE)
 132     9 DLGAMA=H
 133 #endif
 134       RETURN
 135   101 FORMAT('ARGUMENT IS NEGATIVE = ',1P,E15.1)
 136       END
 137 #endif