      SUBROUTINE AHWFWC                                                 WFWC001 

C          CALCULATES THE REFRACTIVE INDEX AND ITS GRADIENT USING THE   WFWC002 

C          APPLETON-HARTREE FORMULA WITH FIELD, WITH COLLISIONS         WFWC003 

      COMMON /CONST/ PI,PIT2,PID2,DEGS,RADIAN,K,C,LOGTEN                WFWC004 

      COMMON /RIN/ MODRIN(3),COLL,FIELD,SPACE,KAY2,H,PHPT,PHPR,PHPTH,   WFWC005 

     1             PHPPH,PHPOM,PHPKR,PHPKTH,PHPKPH,KPHPK,POLAR,LPOLAR   WFWC006 

      COMMON /XX/ MODX(2),X,PXPR,PXPTH,PXPPH,PXPT,HMAX                  WFWC007 

      COMMON /YY/ MODY,Y,PYPR,PYPTH,PYPPH,YR,PYRPR,PYRPT,PYRPP,YTH,PYTPRWFWC008 

     1            ,PYTPT,PYTPP,YPH,PYPPR,PYPPT,PYPPP                    WFWC009 

      COMMON /ZZ/ MODZ,Z,PZPR,PZPTH,PZPPH                               WFWC010 

      COMMON R,TH,PH,KR,KTH,KPH   /WW/ ID(10),W0,W(400)                 WFWC011 

      COMMON /RK/ N,STEP,MODE,E1MAX,E1MIN,E2MAX,E2MIN,FACT,RSTART       WFWC012 

      EQUIVALENCE (RAY,W(1)),(F,W(6))                                   WFWC013 

      LOGICAL SPACE                                                     WFWC014 

      REAL KR,KTH,KPH,K2                                                WFWC015 

      COMPLEX N2,PNPR,PNPTH,PNPPH,PNPVR,PNPVTH,PNPVPH,NNP,PNPT,         WFWC016 

     1        POLAR,LPOLAR,I,U,RAD,D,PNPPS,PNPX,PNPY,PNPZ,UX,UX2,D2,    WFWC017 

     2        KAY2,H,PHPT,PHPR,PHPTH,PHPPH,PHPOM,PHPKR,PHPKTH,PHPKPH,   WFWC018 

     3        KPHPK                                                     WFWC019 

      DATA (MODRIN=8HAPPLETON,8H-HARTREE,8H FORMULA),(COLL=1.),         WFWC020 

     1     (FIELD=1.),                                                  WFWC021 

     2     (X=0.),(PXPR=0.),(PXPTH=0.),(PXPPH=0.),(PXPT=0.),            WFWC022 

     3     (Y=0.),(PYPR=0.),(PYPTH=0.),(PYPPH=0.),(YR=0.),(PYRPR=0.),   WFWC023 

     4     (PYRPT=0.),(PYRPP=0.),(YTH=0.),(PYTPR=0.),(PYTPT=0.),        WFWC024 

     5     (PYTPP=0.),(YPH=0.),(PYPPR=0.),(PYPPT=0.),(PYPPP=0.)         WFWC025 

     6    ,(Z=0.),(PZPR=0.),(PZPTH=0.),(PZPPH=0.),                      WFWC026 

     7     (I=(0.,1.)),(ABSLIM=1.E-5)                                   WFWC027 

      ENTRY RINDEX                                                      WFWC028 

      OM=PIT2*1.E6*F                                                    WFWC029 

      C2=C*C                                                            WFWC030 

      K2=KR*KR+KTH*KTH+KPH*KPH                                          WFWC031 

      OM2=OM*OM                                                         WFWC032 

      VR =C/OM*KR                                                       WFWC033 

      VTH=C/OM*KTH                                                      WFWC034 

      VPH=C/OM*KPH                                                      WFWC035 

      CALL ELECTX                                                       WFWC036 

      CALL MAGY                                                         WFWC037 

      V2=VR**2+VTH**2+VPH**2                                            WFWC038 

      VDOTY=VR*YR+VTH*YTH+VPH*YPH                                       WFWC039 

      YLV=VDOTY/V2                                                      WFWC040 

      YL2=VDOTY**2/V2                                                   WFWC041 

      YT2=Y**2-YL2                                                      WFWC042 

      YT4=YT2*YT2                                                       WFWC043 

      CALL COLFRZ                                                       WFWC044 

      U=CMPLX(1.,-Z)                                                    WFWC045 

      UX=U-X                                                            WFWC046 

      UX2=UX*UX                                                         WFWC047 

      RAD=RAY*CSQRT(YT4+4.*YL2*UX2)                                     WFWC048 

      D=2.*U*UX-YT2+RAD                                                 WFWC049 

      D2=D*D                                                            WFWC050 

      N2=1.-2.*X*UX/D                                                   WFWC051 

      PNPPS=2.*X*UX*(-1.+(YT2-2.*UX2)/RAD)/D2                           WFWC052 

      PPSPR =YL2/Y*PYPR -(VR*PYRPR+VTH*PYTPR+VPH*PYPPR)*YLV             WFWC053 

      PPSPTH=YL2/Y*PYPTH-(VR*PYRPT+VTH*PYTPT+VPH*PYPPT)*YLV             WFWC054 

      PPSPPH=YL2/Y*PYPPH-(VR*PYRPP+VTH*PYTPP+VPH*PYPPP)*YLV             WFWC055 

      PNPX=-(2.*U*UX2-YT2*(U-2.*X)+(YT4*(U-2.*X)+4.*YL2*UX*UX2)/RAD)/D2 WFWC056 

      PNPY=2.*X*UX*(-YT2+(YT4+2.*YL2*UX2)/RAD)/(D2*Y)                   WFWC057 

      PNPZ=I*X*(-2.*UX2-YT2+YT4/RAD)/D2                                 WFWC058 

      PNPR =PNPX*PXPR +PNPY*PYPR +PNPZ*PZPR +PNPPS*PPSPR                WFWC059 

      PNPTH=PNPX*PXPTH+PNPY*PYPTH+PNPZ*PZPTH+PNPPS*PPSPTH               WFWC060 

      PNPPH=PNPX*PXPPH+PNPY*PYPPH+PNPZ*PZPPH+PNPPS*PPSPPH               WFWC061 

      PNPVR =PNPPS*(VR *YL2/V2-YLV*YR )                                 WFWC062 

      PNPVTH=PNPPS*(VTH*YL2/V2-YLV*YTH)                                 WFWC063 

      PNPVPH=PNPPS*(VPH*YL2/V2-YLV*YPH)                                 WFWC064 

      NNP=N2-(2.*X*PNPX+Y*PNPY+Z*PNPZ)                                  WFWC065 

      PNPT=PNPX*PXPT                                                    WFWC066 

      SPACE=REAL(N2).EQ.1..AND.ABS(AIMAG(N2)).LT.ABSLIM                 WFWC067 

      POLAR=-I*SQRT(V2)*(-YT2+RAD)/(2.*VDOTY*UX)                        WFWC068 

      GAM=(-YT2+RAD)/(2.*UX)                                            WFWC069 

      LPOLAR=I*X*SQRT(YT2)/(UX*(U+GAM))                                 WFWC070 

      KAY2=OM2/C2*N2                                                    WFWC071 

      IF(RSTART.EQ.0.) GO TO 1                                          WFWC072 

      SCALE=SQRT(REAL(KAY2)/K2)                                         WFWC073 

      KR =SCALE*KR                                                      WFWC074 

      KTH=SCALE*KTH                                                     WFWC075 

      KPH=SCALE*KPH                                                     WFWC076 

  1   CONTINUE                                                          WFWC077 

C********* CALCULATES A HAMILTONIAN H                                   WFWC078 

      H=.5*(C2*K2/OM2-N2)                                               WFWC079 

C********* AND ITS PARTIAL DERIVATIVES WITH RESPECT TO                  WFWC080 

C********* TIME, R, THETA, PHI, OMEGA, KR, KTHETA, AND KPHI.            WFWC081 

      PHPT =-PNPT                                                       WFWC082 

      PHPR =-PNPR                                                       WFWC083 

      PHPTH=-PNPTH                                                      WFWC084 

      PHPPH=-PNPPH                                                      WFWC085 

      PHPOM=-NNP/OM                                                     WFWC086 

      PHPKR =C2/OM2*KR -C/OM*PNPVR                                      WFWC087 

      PHPKTH=C2/OM2*KTH-C/OM*PNPVTH                                     WFWC088 

      PHPKPH=C2/OM2*KPH-C/OM*PNPVPH                                     WFWC089 

      KPHPK=N2                                                          WFWC090 

      RETURN                                                            WFWC091 

         END                                                            WFWC092 

