| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.1.1.1 1996/04/01 15:02:02 mclareni |
| 6 | * Mathlib gen |
| 7 | * |
| 8 | * |
| 9 | #include "gen/pilot.h" |
| 10 | #if !defined(CERNLIB_DOUBLE) |
| 11 | FUNCTION RFERDR(X,K) |
| 12 | #endif |
| 13 | #if defined(CERNLIB_DOUBLE) |
| 14 | FUNCTION DFERDR(X,K) |
| 15 | #include "gen/imp64.inc" |
| 16 | #endif |
| 17 | CHARACTER NAME*(*) |
| 18 | CHARACTER*80 ERRTXT |
| 19 | #if !defined(CERNLIB_DOUBLE) |
| 20 | PARAMETER (NAME = 'RFERDR') |
| 21 | #endif |
| 22 | #if defined(CERNLIB_DOUBLE) |
| 23 | PARAMETER (NAME = 'FRERDR/DFERDR') |
| 24 | #endif |
| 25 | |
| 26 | DIMENSION P1(5),P2(5),P3(5),P4(5),P5(5),P6(5),P7(5),P8(5),P9(5) |
| 27 | DIMENSION Q1(5),Q2(5),Q3(5),Q4(5),Q5(5),Q6(5),Q7(5),Q8(5),Q9(5) |
| 28 | |
| 29 | DATA C1 /1.77245 38509 05516 03D0/ |
| 30 | DATA C2 /0.88622 69254 52758 01D0/ |
| 31 | DATA C3 /1.32934 03881 79137 02D0/ |
| 32 | DATA C4 /0.66666 66666 66666 67D0/ |
| 33 | DATA C5 /0.40000 00000 00000 00D0/ |
| 34 | |
| 35 | DATA P1 |
| 36 | 1/-1.25331 41288 20D+0, -1.72366 35577 01D+0, -6.55904 57292 58D-1, |
| 37 | 2 -6.34228 31976 82D-2, -1.48838 31061 16D-5/ |
| 38 | DATA Q1 |
| 39 | 1/+1.00000 00000 00D+0, +2.19178 09259 80D+0, +1.60581 29554 06D+0, |
| 40 | 2 +4.44366 95274 81D-1, +3.62423 22881 12D-2/ |
| 41 | DATA P2 |
| 42 | 1/-3.13328 53055 70D-1, -4.16187 38522 93D-1, -1.50220 84005 88D-1, |
| 43 | 2 -1.33957 93751 73D-2, -1.51335 07001 38D-5/ |
| 44 | DATA Q2 |
| 45 | 1/+1.00000 00000 00D+0, +1.87260 86759 02D+0, +1.14520 44465 78D+0, |
| 46 | 2 +2.57022 55875 73D-1, +1.63990 25435 68D-2/ |
| 47 | DATA P3 |
| 48 | 1/-2.34996 39854 06D-1, -2.92737 36375 47D-1, -9.88309 75887 38D-2, |
| 49 | 2 -8.25138 63795 51D-3, -1.87438 41532 23D-5/ |
| 50 | DATA Q3 |
| 51 | 1/+1.00000 00000 00D+0, +1.60859 71091 46D+0, +8.27528 95308 80D-1, |
| 52 | 2 +1.52232 23828 50D-1, +7.69512 04750 64D-3/ |
| 53 | DATA P4 |
| 54 | 1/+1.07381 27694D+0, +5.60033 03660D+0, +3.68822 11270D+0, |
| 55 | 2 +1.17433 92816D+0, +2.36419 35527D-1/ |
| 56 | DATA Q4 |
| 57 | 1/+1.00000 00000D+0, +4.60318 40667D+0, +4.30759 10674D-1, |
| 58 | 2 +4.21511 32145D-1, +1.18326 01601D-2/ |
| 59 | DATA P5 |
| 60 | 1/+6.78176 62666 0D-1, +6.33124 01791 0D-1, +2.94479 65177 2D-1, |
| 61 | 2 +8.01320 71141 9D-2, +1.33918 21294 0D-2/ |
| 62 | DATA Q5 |
| 63 | 1/+1.00000 00000 0D+0, +1.43740 40039 7D-1, +7.08662 14845 0D-2, |
| 64 | 2 +2.34579 49473 5D-3, -1.29449 92883 5D-5/ |
| 65 | DATA P6 |
| 66 | 1/+1.15302 13402D+0, +1.05915 58972D+0, +4.68988 03095D-1, |
| 67 | 2 +1.18829 08784D-1, +1.94387 55787D-2/ |
| 68 | DATA Q6 |
| 69 | 1/+1.00000 00000D+0, +3.73489 53841D-2, +2.32484 58137D-2, |
| 70 | 2 -1.37667 70874D-3, +4.64663 92781D-5/ |
| 71 | DATA P7 |
| 72 | 1/-8.22255 9330D-1, -3.62036 9345D+1, -3.01538 5410D+3, |
| 73 | 2 -7.04987 1579D+4, -5.69814 5924D+4/ |
| 74 | DATA Q7 |
| 75 | 1/+1.00000 0000D+0, +3.93568 9841D+1, +3.56875 6266D+3, |
| 76 | 2 +4.18189 3625D+4, +3.38513 8907D+5/ |
| 77 | DATA P8 |
| 78 | 1/+8.22449 97626D-1, +2.00463 03393D+1, +1.82680 93446D+3, |
| 79 | 2 +1.22265 30374D+4, +1.40407 50092D+5/ |
| 80 | DATA Q8 |
| 81 | 1/+1.00000 00000D+0, +2.34862 07659D+1, +2.20134 83743D+3, |
| 82 | 1 +1.14426 73596D+4, +1.65847 15900D+5/ |
| 83 | DATA P9 |
| 84 | 1/+2.46740 02368 4D+0, +2.19167 58236 8D+2, +1.23829 37907 5D+4, |
| 85 | 2 +2.20667 72496 8D+5, +8.49442 92003 4D+5/ |
| 86 | DATA Q9 |
| 87 | 1/+1.00000 00000 0D+0, +8.91125 14061 9D+1, +5.04575 66966 7D+3, |
| 88 | 2 +9.09075 94630 4D+4, +3.89960 91564 1D+5/ |
| 89 | |
| 90 | IF(K .EQ. -1) THEN |
| 91 | IF(X .LE. 1) THEN |
| 92 | Y=EXP(X) |
| 93 | H=Y*(C1+Y* |
| 94 | 1 (P1(1)+Y*(P1(2)+Y*(P1(3)+Y*(P1(4)+Y*P1(5)))))/ |
| 95 | 2 (Q1(1)+Y*(Q1(2)+Y*(Q1(3)+Y*(Q1(4)+Y*Q1(5)))))) |
| 96 | ELSE IF(X .LE. 4) THEN |
| 97 | H=(P4(1)+X*(P4(2)+X*(P4(3)+X*(P4(4)+X*P4(5)))))/ |
| 98 | 1 (Q4(1)+X*(Q4(2)+X*(Q4(3)+X*(Q4(4)+X*Q4(5))))) |
| 99 | ELSE |
| 100 | Y=1/X**2 |
| 101 | H=SQRT(X)*(2+Y* |
| 102 | 1 (P7(1)+Y*(P7(2)+Y*(P7(3)+Y*(P7(4)+Y*P7(5)))))/ |
| 103 | 2 (Q7(1)+Y*(Q7(2)+Y*(Q7(3)+Y*(Q7(4)+Y*Q7(5)))))) |
| 104 | END IF |
| 105 | ELSE IF(K .EQ. 1) THEN |
| 106 | IF(X .LE. 1) THEN |
| 107 | Y=EXP(X) |
| 108 | H=Y*(C2+Y* |
| 109 | 1 (P2(1)+Y*(P2(2)+Y*(P2(3)+Y*(P2(4)+Y*P2(5)))))/ |
| 110 | 2 (Q2(1)+Y*(Q2(2)+Y*(Q2(3)+Y*(Q2(4)+Y*Q2(5)))))) |
| 111 | ELSE IF(X .LE. 4) THEN |
| 112 | H=(P5(1)+X*(P5(2)+X*(P5(3)+X*(P5(4)+X*P5(5)))))/ |
| 113 | 1 (Q5(1)+X*(Q5(2)+X*(Q5(3)+X*(Q5(4)+X*Q5(5))))) |
| 114 | ELSE |
| 115 | Y=1/X**2 |
| 116 | H=X*SQRT(X)*(C4+Y* |
| 117 | 1 (P8(1)+Y*(P8(2)+Y*(P8(3)+Y*(P8(4)+Y*P8(5)))))/ |
| 118 | 2 (Q8(1)+Y*(Q8(2)+Y*(Q8(3)+Y*(Q8(4)+Y*Q8(5)))))) |
| 119 | END IF |
| 120 | ELSE IF(K .EQ. 3) THEN |
| 121 | IF(X .LE. 1) THEN |
| 122 | Y=EXP(X) |
| 123 | H=Y*(C3+Y* |
| 124 | 1 (P3(1)+Y*(P3(2)+Y*(P3(3)+Y*(P3(4)+Y*P3(5)))))/ |
| 125 | 2 (Q3(1)+Y*(Q3(2)+Y*(Q3(3)+Y*(Q3(4)+Y*Q3(5)))))) |
| 126 | ELSE IF(X .LE. 4) THEN |
| 127 | H=(P6(1)+X*(P6(2)+X*(P6(3)+X*(P6(4)+X*P6(5)))))/ |
| 128 | 1 (Q6(1)+X*(Q6(2)+X*(Q6(3)+X*(Q6(4)+X*Q6(5))))) |
| 129 | ELSE |
| 130 | Y=1/X**2 |
| 131 | H=X**2*SQRT(X)*(C5+Y* |
| 132 | 1 (P9(1)+Y*(P9(2)+Y*(P9(3)+Y*(P9(4)+Y*P9(5)))))/ |
| 133 | 2 (Q9(1)+Y*(Q9(2)+Y*(Q9(3)+Y*(Q9(4)+Y*Q9(5)))))) |
| 134 | END IF |
| 135 | ELSE |
| 136 | H=0 |
| 137 | WRITE(ERRTXT,101) K |
| 138 | CALL MTLPRT(NAME,'C323.1',ERRTXT) |
| 139 | END IF |
| 140 | #if defined(CERNLIB_DOUBLE) |
| 141 | DFERDR=H |
| 142 | #endif |
| 143 | #if !defined(CERNLIB_DOUBLE) |
| 144 | RFERDR=H |
| 145 | #endif |
| 146 | RETURN |
| 147 | 101 FORMAT('INCORRECT K = ',I5) |
| 148 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame