*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/04/01 15:02:02  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
#if !defined(CERNLIB_DOUBLE)
      FUNCTION RFERDR(X,K)
#endif
#if defined(CERNLIB_DOUBLE)
      FUNCTION DFERDR(X,K)
#include "gen/imp64.inc"
#endif
      CHARACTER NAME*(*)
      CHARACTER*80 ERRTXT
#if !defined(CERNLIB_DOUBLE)
      PARAMETER (NAME = 'RFERDR')
#endif
#if defined(CERNLIB_DOUBLE)
      PARAMETER (NAME = 'FRERDR/DFERDR')
#endif

      DIMENSION P1(5),P2(5),P3(5),P4(5),P5(5),P6(5),P7(5),P8(5),P9(5)
      DIMENSION Q1(5),Q2(5),Q3(5),Q4(5),Q5(5),Q6(5),Q7(5),Q8(5),Q9(5)

      DATA C1 /1.77245 38509 05516 03D0/
      DATA C2 /0.88622 69254 52758 01D0/
      DATA C3 /1.32934 03881 79137 02D0/
      DATA C4 /0.66666 66666 66666 67D0/
      DATA C5 /0.40000 00000 00000 00D0/

      DATA P1
     1/-1.25331 41288 20D+0, -1.72366 35577 01D+0, -6.55904 57292 58D-1,
     2 -6.34228 31976 82D-2, -1.48838 31061 16D-5/
      DATA Q1
     1/+1.00000 00000 00D+0, +2.19178 09259 80D+0, +1.60581 29554 06D+0,
     2 +4.44366 95274 81D-1, +3.62423 22881 12D-2/
      DATA P2
     1/-3.13328 53055 70D-1, -4.16187 38522 93D-1, -1.50220 84005 88D-1,
     2 -1.33957 93751 73D-2, -1.51335 07001 38D-5/
      DATA Q2
     1/+1.00000 00000 00D+0, +1.87260 86759 02D+0, +1.14520 44465 78D+0,
     2 +2.57022 55875 73D-1, +1.63990 25435 68D-2/
      DATA P3
     1/-2.34996 39854 06D-1, -2.92737 36375 47D-1, -9.88309 75887 38D-2,
     2 -8.25138 63795 51D-3, -1.87438 41532 23D-5/
      DATA Q3
     1/+1.00000 00000 00D+0, +1.60859 71091 46D+0, +8.27528 95308 80D-1,
     2 +1.52232 23828 50D-1, +7.69512 04750 64D-3/
      DATA P4
     1/+1.07381 27694D+0, +5.60033 03660D+0, +3.68822 11270D+0,
     2 +1.17433 92816D+0, +2.36419 35527D-1/
      DATA Q4
     1/+1.00000 00000D+0, +4.60318 40667D+0, +4.30759 10674D-1,
     2 +4.21511 32145D-1, +1.18326 01601D-2/
      DATA P5
     1/+6.78176 62666 0D-1, +6.33124 01791 0D-1, +2.94479 65177 2D-1,
     2 +8.01320 71141 9D-2, +1.33918 21294 0D-2/
      DATA Q5
     1/+1.00000 00000 0D+0, +1.43740 40039 7D-1, +7.08662 14845 0D-2,
     2 +2.34579 49473 5D-3, -1.29449 92883 5D-5/
      DATA P6
     1/+1.15302 13402D+0, +1.05915 58972D+0, +4.68988 03095D-1,
     2 +1.18829 08784D-1, +1.94387 55787D-2/
      DATA Q6
     1/+1.00000 00000D+0, +3.73489 53841D-2, +2.32484 58137D-2,
     2 -1.37667 70874D-3, +4.64663 92781D-5/
      DATA P7
     1/-8.22255 9330D-1, -3.62036 9345D+1, -3.01538 5410D+3,
     2 -7.04987 1579D+4, -5.69814 5924D+4/
      DATA Q7
     1/+1.00000 0000D+0, +3.93568 9841D+1, +3.56875 6266D+3,
     2 +4.18189 3625D+4, +3.38513 8907D+5/
      DATA P8
     1/+8.22449 97626D-1, +2.00463 03393D+1, +1.82680 93446D+3,
     2 +1.22265 30374D+4, +1.40407 50092D+5/
      DATA Q8
     1/+1.00000 00000D+0, +2.34862 07659D+1, +2.20134 83743D+3,
     1 +1.14426 73596D+4, +1.65847 15900D+5/
      DATA P9
     1/+2.46740 02368 4D+0, +2.19167 58236 8D+2, +1.23829 37907 5D+4,
     2 +2.20667 72496 8D+5, +8.49442 92003 4D+5/
      DATA Q9
     1/+1.00000 00000 0D+0, +8.91125 14061 9D+1, +5.04575 66966 7D+3,
     2 +9.09075 94630 4D+4, +3.89960 91564 1D+5/

      IF(K .EQ. -1) THEN
       IF(X .LE. 1) THEN
        Y=EXP(X)
        H=Y*(C1+Y*
     1       (P1(1)+Y*(P1(2)+Y*(P1(3)+Y*(P1(4)+Y*P1(5)))))/
     2       (Q1(1)+Y*(Q1(2)+Y*(Q1(3)+Y*(Q1(4)+Y*Q1(5))))))
       ELSE IF(X .LE. 4) THEN
        H=(P4(1)+X*(P4(2)+X*(P4(3)+X*(P4(4)+X*P4(5)))))/
     1         (Q4(1)+X*(Q4(2)+X*(Q4(3)+X*(Q4(4)+X*Q4(5)))))
       ELSE
        Y=1/X**2
        H=SQRT(X)*(2+Y*
     1       (P7(1)+Y*(P7(2)+Y*(P7(3)+Y*(P7(4)+Y*P7(5)))))/
     2       (Q7(1)+Y*(Q7(2)+Y*(Q7(3)+Y*(Q7(4)+Y*Q7(5))))))
       END IF
      ELSE IF(K .EQ. 1) THEN
       IF(X .LE. 1) THEN
        Y=EXP(X)
        H=Y*(C2+Y*
     1       (P2(1)+Y*(P2(2)+Y*(P2(3)+Y*(P2(4)+Y*P2(5)))))/
     2       (Q2(1)+Y*(Q2(2)+Y*(Q2(3)+Y*(Q2(4)+Y*Q2(5))))))
       ELSE IF(X .LE. 4) THEN
        H=(P5(1)+X*(P5(2)+X*(P5(3)+X*(P5(4)+X*P5(5)))))/
     1         (Q5(1)+X*(Q5(2)+X*(Q5(3)+X*(Q5(4)+X*Q5(5)))))
       ELSE
        Y=1/X**2
        H=X*SQRT(X)*(C4+Y*
     1       (P8(1)+Y*(P8(2)+Y*(P8(3)+Y*(P8(4)+Y*P8(5)))))/
     2       (Q8(1)+Y*(Q8(2)+Y*(Q8(3)+Y*(Q8(4)+Y*Q8(5))))))
       END IF
      ELSE IF(K .EQ. 3) THEN
       IF(X .LE. 1) THEN
        Y=EXP(X)
        H=Y*(C3+Y*
     1       (P3(1)+Y*(P3(2)+Y*(P3(3)+Y*(P3(4)+Y*P3(5)))))/
     2       (Q3(1)+Y*(Q3(2)+Y*(Q3(3)+Y*(Q3(4)+Y*Q3(5))))))
       ELSE IF(X .LE. 4) THEN
        H=(P6(1)+X*(P6(2)+X*(P6(3)+X*(P6(4)+X*P6(5)))))/
     1         (Q6(1)+X*(Q6(2)+X*(Q6(3)+X*(Q6(4)+X*Q6(5)))))
       ELSE
        Y=1/X**2
        H=X**2*SQRT(X)*(C5+Y*
     1       (P9(1)+Y*(P9(2)+Y*(P9(3)+Y*(P9(4)+Y*P9(5)))))/
     2       (Q9(1)+Y*(Q9(2)+Y*(Q9(3)+Y*(Q9(4)+Y*Q9(5))))))
       END IF
      ELSE
       H=0
       WRITE(ERRTXT,101) K
       CALL MTLPRT(NAME,'C323.1',ERRTXT)
      END IF
#if defined(CERNLIB_DOUBLE)
      DFERDR=H
#endif
#if !defined(CERNLIB_DOUBLE)
      RFERDR=H
#endif
      RETURN
  101 FORMAT('INCORRECT K = ',I5)
      END