MINICERN/mathlib/gen/c/legfn.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:01:59  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE LEGFN (V,Z,P,Q,NC,NF)
  11 #include "legbl.inc"
  12      1,V,Z,P,Q
  13      2,ZZS,CISP,CISM,PT,VVP,ZZZ
  14      3,CSQRTK
  15       DATA AC/0.0000001/
  16 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
  17       DATA QINF/37770000000000000000B/
  18 #endif
  19 #if (defined(CERNLIB_CDC))&&(!defined(CERNLIB_F4))
  20       DATA QINF/O"37770000000000000000"/
  21 #endif
  22 #if defined(CERNLIB_IBM)
  23       DATA QINF/.1E70/
  24 #endif
  25 #if (!defined(CERNLIB_CDC))&&(!defined(CERNLIB_IBM))
  26       DATA QINF / .1E36/
  27 #endif
  28       CALL C311BD
  29       ACC=AC**2
  30       IF(REAL(V)+0.5) 16,17,17
  31    16 VV=-V-1.0
  32       GOTO 18
  33    17 VV=V
  34 C---  It seems that NIC311 expects a REAL argument
  35 C     NVV=NIC311(VV)
  36    18 NVV=NIC311(REAL(VV))
  37 C*UL 30      VVP=VV*PI
  38       VVP=VV*PI
  39       GOTO (21,22,23,24,25),NVV
  40    21 SV=1.0
  41       GOTO 26
  42    23 SV=-1.0
  43    26 CV=0.0
  44       GOTO 28
  45    22 CV=-1.0
  46       GOTO 27
  47    24 CV=1.0
  48    27 SV=0.0
  49       GOTO 28
  50    25 SV=SIN(REAL(VVP))
  51       CV=COS(REAL(VVP))
  52    28 EIP=EXP(AIMAG(VVP))
  53       EIM=EXP(-AIMAG(VVP))
  54       SHV=0.5*(EIP-EIM)
  55       CHV=0.5*(EIP+EIM)
  56       SVV=SV*CHV+U*CV*SHV
  57       CVV=CV*CHV-U*SV*SHV
  58       CISP=CVV+U*SVV
  59       CISM=CVV-U*SVV
  60       IF(REAL(Z))9,10,11
  61     9 ZZ=-Z
  62       N23=3
  63       NFF=-NF
  64       GOTO 12
  65    10 N24=4
  66       ZZ=Z
  67       IF(AIMAG(ZZ))13,77,13
  68    11 ZZ=Z
  69       N23=2
  70       NFF=NF
  71    12 N24=2
  72    13 ZZS=ZZ**2
  73       Z1=(1.0-ZZ)/2.0
  74       IF(AIMAG(ZZ))7,6,7
  75     6 IF(REAL(Z1))4,70,5
  76     4 NFRIG=SIGN(N23,NFF)
  77       GOTO 8
  78     5 NFRIG=NFF
  79       GOTO 8
  80     7 NFRIG=SIGN(REAL(N24),AIMAG(ZZ))
  81     8 Z2=1.0/ZZS
  82       SRZ=CSQRTK(ZZS-1.0,NFRIG,1)
  83       ZZ1=(ZZ+SRZ)/(2.0*SRZ)
  84       ZZ2=(-ZZ+SRZ)/(2.0*SRZ)
  85       IF(REAL(Z))1,2,2
  86     1 SRZ=-SRZ
  87     2 ZZZ=ZZ
  88       ZZ=Z
  89       VR=REAL(VV)**2
  90       VI=AIMAG(VV)**2
  91       R1=ABS(Z1)
  92       R2=ABS(Z2)
  93       R3=ABS(ZZ1)
  94       R4=ABS(ZZ2)
  95       IF(R1-R2)61,61,62
  96    61 RR=MAX(R3,R4)/0.045-19.5
  97       IF(RR)66,66,65
  98    65 VRI=VR+VI
  99       IF(VRI)165,67,165
 100   165 IF(RR**2-VRI+VI**2/(2.0*VRI))66,67,67
 101    66 CALL LEGV
 102       IF(NCVG)166,97,166
 103   166 ZZ=ZZZ
 104       CALL LEG1
 105       GOTO 90
 106    67 ZZ=ZZZ
 107       CALL LEG1
 108       IF(NCVG)167,90,167
 109   167 ZZ=Z
 110       CALL LEGV
 111       GOTO 97
 112    62 IF(VR+VI-16.0*R2**2)63,64,64
 113    64 CALL LEGV
 114       IF(NCVG)164,97,164
 115   164 CALL LEGZ
 116       GOTO 97
 117    63 CALL LEGZ
 118       IF(NCVG)163,97,163
 119   163 CALL LEGV
 120       GOTO 97
 121    90 IF(REAL(Z)) 93,97,97
 122    93 PT=-2.0/PI*SVV*QQ
 123       IF(NFRIG) 94,95,96
 124    94 PP=CISP*PP+PT
 125       QQ=-CISM*QQ
 126       GOTO 97
 127    95 QQ=-CVV*QQ-PI/2.0*SVV*PP
 128       PP=CVV*PP+PT
 129       GOTO 97
 130    96 PP=CISM*PP+PT
 131       QQ=-CISP*QQ
 132       GOTO 97
 133    97 IF(REAL(V)+0.5) 91,92,92
 134    91 IF(ABS(SVV).NE.0.) GOTO 98
 135       QQ=QINF
 136       GOTO 92
 137    98 QQ=(QQ*SVV-PI*CVV*PP)/SVV
 138    92 P=PP
 139       Q=QQ
 140       NC=NCVG
 141       RETURN
 142    70 QQ=QINF
 143 C
 144       IF(REAL(Z))173,173,74
 145   173 IF(AIMAG(V))71,73,71
 146    73 GOTO (71,72,71,74,71),NVV
 147    71 PP=QQ
 148       GOTO 82
 149    72 PP=-1.0
 150       GOTO 82
 151    74 PP=1.0
 152       GOTO 82
 153    77 NFRIG=NF
 154       CALL LEGOR
 155    82 NCVG=0
 156       GOTO 92
 157       END