MINICERN/mathlib/gen/g/xm2lan.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:45  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 C     This will be XM2LAN,IF=DOUBLE and XM2LAN64,IF=-DOUBLE
  11       FUNCTION XM2LAN(X)
  12
  13       DIMENSION P1(0:4),P2(0:4),P3(0:3),P4(0:4),P5(0:3)
  14       DIMENSION Q1(0:4),Q2(0:4),Q3(0:3),Q4(0:4),Q5(0:3)
  15       DIMENSION A0(0:6),A1(1:3),A2(0:3),A3(0:3)
  16
  17       DATA (P1(I),I=0,4),(Q1(I),I=0,4)
  18      1/ 0.11698 37582E+1,-0.48348 74539E+0, 0.43837 74644E+0,
  19      2  0.32871 75228E-2, 0.18791 29206E-1,
  20      3  1.0             , 0.17951 54326E+0, 0.46127 95899E-1,
  21      4  0.21834 59337E-2, 0.72266 23623E-4/
  22
  23       DATA (P2(I),I=0,4),(Q2(I),I=0,4)
  24      1/ 0.11579 39823E+1,-0.38428 09495E+0, 0.33175 32899E+0,
  25      2  0.35476 06781E-1, 0.67256 45279E-2,
  26      3  1.0             , 0.29168 24021E+0, 0.52598 53480E-1,
  27      4  0.38400 11061E-2, 0.99503 24173E-4/
  28
  29       DATA (P3(I),I=0,3),(Q3(I),I=0,3)
  30      1/ 0.11781 91282E+1, 0.10116 23342E+2,-0.12855 85291E+2,
  31      2  0.36413 61437E+2,
  32      3  1.0             , 0.86141 60194E+1, 0.31189 29630E+2,
  33      4  0.15143 51300E+0/
  34
  35       DATA (P4(I),I=0,4),(Q4(I),I=0,4)
  36      1/ 0.10307 63698E+1, 0.12167 58660E+3, 0.16374 31386E+4,
  37      2 -0.21714 66507E+4, 0.70101 68358E+4,
  38      3  1.0             , 0.10224 87911E+3, 0.13776 46350E+4,
  39      4  0.36991 84961E+4, 0.42513 15610E+4/
  40
  41       DATA (P5(I),I=0,3),(Q5(I),I=0,3)
  42      1/ 0.10100 84827E+1, 0.39442 24824E+3, 0.17730 25353E+5,
  43      2 -0.70759 63938E+5,
  44      3  1.0             , 0.36059 50254E+3, 0.13927 84158E+5,
  45      4 -0.18816 80027E+5/
  46
  47       DATA (A0(I),I=0,6)
  48      1/-0.20434 03138E+1,-0.84556 86702E+0,-0.30886 26596E+0,
  49      2  0.58213 46754E+1, 0.42278 43351E+0, 0.65529 93748E+1,
  50      3 -0.10767 14945E+2/
  51
  52       DATA (A1(I),I=1,3)
  53      1/-0.45833 33333E+0, 0.66753 47222E+0,-0.16417 41416E+1/
  54
  55       DATA (A2(I),I=0,3)
  56      1/-0.19583 33333E+1, 0.55633 68056E+1,-0.21113 52961E+2,
  57      2  0.10069 46266E+3/
  58
  59       DATA (A3(I),I=0,3)
  60      1/-1.0             , 0.44583 33333E+1,-0.21167 53472E+2,
  61      2  0.11636 74359E+3/
  62
  63       V=X
  64       IF(V .LT. -4.5) THEN
  65        U=EXP(V+1)
  66        XM2LAN=V**2-2*U**2*
  67      1        (V/U+A2(0)*V+A3(0)+(A2(1)*V+A3(1)+(A2(2)*V+A3(2)+
  68      2        (A2(3)*V+A3(3))*U)*U)*U)/
  69      3        (1+(A1(1)+(A1(2)+A1(3)*U)*U)*U)
  70       ELSEIF(V .LT. -2) THEN
  71        XM2LAN=(P1(0)+(P1(1)+(P1(2)+(P1(3)+P1(4)*V)*V)*V)*V)/
  72      1        (Q1(0)+(Q1(1)+(Q1(2)+(Q1(3)+Q1(4)*V)*V)*V)*V)
  73       ELSEIF(V .LT. 2) THEN
  74        XM2LAN=(P2(0)+(P2(1)+(P2(2)+(P2(3)+P2(4)*V)*V)*V)*V)/
  75      1        (Q2(0)+(Q2(1)+(Q2(2)+(Q2(3)+Q2(4)*V)*V)*V)*V)
  76       ELSEIF(V .LT. 5) THEN
  77        U=1/V
  78        XM2LAN=V*(P3(0)+(P3(1)+(P3(2)+P3(3)*U)*U)*U)/
  79      1          (Q3(0)+(Q3(1)+(Q3(2)+Q3(3)*U)*U)*U)
  80       ELSEIF(V .LT. 50) THEN
  81        U=1/V
  82        XM2LAN=V*(P4(0)+(P4(1)+(P4(2)+(P4(3)+P4(4)*U)*U)*U)*U)/
  83      1          (Q4(0)+(Q4(1)+(Q4(2)+(Q4(3)+Q4(4)*U)*U)*U)*U)
  84       ELSEIF(V .LT. 200) THEN
  85        U=1/V
  86        XM2LAN=V*(P5(0)+(P5(1)+(P5(2)+P5(3)*U)*U)*U)/
  87      1          (Q5(0)+(Q5(1)+(Q5(2)+Q5(3)*U)*U)*U)
  88       ELSE
  89        U=V-V*LOG(V)/(V+1)
  90        V=1/(U-U*(U+LOG(U)-V)/(U+1))
  91        U=-LOG(V)
  92        XM2LAN=(1/V+U**2+A0(0)+A0(1)*U+(-U**2+A0(2)*U+A0(3)+
  93      1        (A0(4)*U**2+A0(5)*U+A0(6))*V)*V)/(1-(1-A0(4)*V)*V)
  94       ENDIF
  95       RETURN
  96       END