      SUBROUTINE AHWFNC                                                 WFNC001 
	character*8 id,ndate,modx,mody,modz,modrin,koll,modsav
C          CALCULATES THE REFRACTIVE INDEX AND ITS GRADIENT USING THE   WFNC002 
C          APPLETON-HARTREE FORMULA WITH FIELD, NO COLLISIONS           WFNC003 
      COMMON /CONST/ PI,PIT2,PID2,DEGS,RADIAN,K,C,LOGTEN                WFNC004 
      COMMON /RIN/ MODRIN(3),COLL,FIELD,SPACE,KAY2,KAY2I,               WFNC005 
     1              H,HI,PHPT,PHPTI,PHPR,PHPRI,PHPTH,PHPTHI,PHPPH,PHPPHIWFNC006 
     2            ,PHPOM,PHPOMI,PHPKR,PHPKRI,PHPKTH,PHPKTI,PHPKPH,PHPKPIWFNC007 
     3            ,KPHPK,KPHPKI,POLAR,POLARI,LPOLAR,LPOLRI,SGN          WFNC008 
      COMMON /XX/ MODX(2),X,PXPR,PXPTH,PXPPH,PXPT,HMAX                  WFNC009 
      COMMON /YY/ MODY,Y,PYPR,PYPTH,PYPPH,YR,PYRPR,PYRPT,PYRPP,YTH,PYTPRWFNC010 
     1           ,PYTPT,PYTPP,YPH,PYPPR,PYPPT,PYPPP                     WFNC011 
      COMMON /ZZ/ MODZ,Z(4)                                             WFNC012 
      COMMON /RK/ N,STEP,MODE,E1MAX,E1MIN,E2MAX,E2MIN,FACT,RSTART       WFNC013 
      COMMON R,TH,PH,KR,KTH,KPH   /WW/ ID(10),W0,W(400)                 WFNC014 
      EQUIVALENCE (RAY,W(1)),(F,W(6))                                   WFNC015 
      LOGICAL SPACE                                                     WFNC016 
      REAL KR,KTH,KPH,K2,KPHPK,KPHPKI,KAY2,KAY2I,N2,NNP,LPOLAR,LPOLRI   WFNC017 
c
	real k,logten
c
	data coll,kay2i,hi,phpti,phpri,phpthi,phpphi,phpomi,phpkri,
     a       phpkti,phpkpi,kphpki,polar,lpolar,x,pxpr,pxpth,pxpph,pxpt,
     a       y,pypr,pypth,pypph,yr,pyrpr,pyrpt,pyrpp,yth,pytpr,pytpt,
     a       pytpp,yph,pyppr,pyppt,pyppp / 35*0.0 /
	data field,u / 1.0,1.0 /
	data modrin,modz / 'appleton','-hartree',' formula',' ' /
c
      ENTRY RINDEX                                                      WFNC027 
      OM=PIT2*1.E6*F                                                    WFNC028 
      C2=C*C                                                            WFNC029 
      K2=KR*KR+KTH*KTH+KPH*KPH                                          WFNC030 
      OM2=OM*OM                                                         WFNC031 
      VR =C/OM*KR                                                       WFNC032 
      VTH=C/OM*KTH                                                      WFNC033 
      VPH=C/OM*KPH                                                      WFNC034 
      CALL ELECTX                                                       WFNC035 
      CALL MAGY                                                         WFNC036 
      V2=VR**2+VTH**2+VPH**2                                            WFNC037 
      VDOTY=VR*YR+VTH*YTH+VPH*YPH                                       WFNC038 
      YLV=VDOTY/V2                                                      WFNC039 
      YL2=VDOTY**2/V2                                                   WFNC040 
      YT2=Y**2-YL2                                                      WFNC041 
      YT4=YT2*YT2                                                       WFNC042 
      UX=U-X                                                            WFNC043 
      UX2=UX*UX                                                         WFNC044 
      RAD=RAY*SQRT(YT4+4.*YL2*UX2)                                      WFNC045 
      D=2.*UX-YT2+RAD                                                   WFNC046 
      D2=D*D                                                            WFNC047 
      N2=1.-2.*X*UX/D                                                   WFNC048 
      PNPPS=2.*X*UX*(-1.+(YT2-2.*UX2)/RAD)/D2                           WFNC049 
      PPSPR= YL2/Y*PYPR -(VR*PYRPR+VTH*PYTPR+VPH*PYPPR)*YLV             WFNC050 
      PPSPTH=YL2/Y*PYPTH-(VR*PYRPT+VTH*PYTPT+VPH*PYPPT)*YLV             WFNC051 
      PPSPPH=YL2/Y*PYPPH-(VR*PYRPP+VTH*PYTPP+VPH*PYPPP)*YLV             WFNC052 
      PNPX=-(2.*UX2-YT2*(U-2.*X)+(YT4*(U-2.*X)+4.*YL2*UX*UX2)/RAD)/D2   WFNC053 
      PNPY=2.*X*UX*(-YT2+(YT4+2.*YL2*UX2)/RAD)/(D2*Y)                   WFNC054 
      NNP=N2-(2.*X*PNPX+Y*PNPY)                                         WFNC055 
      PNPR =PNPX*PXPR +PNPY*PYPR +PNPPS*PPSPR                           WFNC056 
      PNPTH=PNPX*PXPTH+PNPY*PYPTH+PNPPS*PPSPTH                          WFNC057 
      PNPPH=PNPX*PXPPH+PNPY*PYPPH+PNPPS*PPSPPH                          WFNC058 
      PNPVR =PNPPS*(VR *YL2-VDOTY*YR )/V2                               WFNC059 
      PNPVTH=PNPPS*(VTH*YL2-VDOTY*YTH)/V2                               WFNC060 
      PNPVPH=PNPPS*(VPH*YL2-VDOTY*YPH)/V2                               WFNC061 
      PNPT=PNPX*PXPT                                                    WFNC062 
      SPACE=N2.EQ.1.                                                    WFNC063 
      POLARI=SQRT(V2)*(YT2-RAD)/(2.*VDOTY*UX)                           WFNC064 
      GAM=(-YT2+RAD)/(2.*UX)                                            WFNC065 
      LPOLRI=X*SQRT(YT2)/(UX*(U+GAM))                                   WFNC066 
      KAY2=OM2/C2*N2                                                    WFNC067 
      IF(RSTART.EQ.0.) GO TO 1                                          WFNC068 
      SCALE=SQRT(KAY2/K2)                                               WFNC069 
      KR =SCALE*KR                                                      WFNC070 
      KTH=SCALE*KTH                                                     WFNC071 
      KPH=SCALE*KPH                                                     WFNC072 
  1   CONTINUE                                                          WFNC073 
C********* CALCULATES A HAMILTONIAN H                                   WFNC074 
      H=.5*(C2*K2/OM2-N2)                                               WFNC075 
C********* AND ITS PARTIAL DERIVATIVES WITH RESPECT TO                  WFNC076 
C********* TIME, R, THETA, PHI, OMEGA, KR, KTHETA, AND KPHI.            WFNC077 
      PHPT =-PNPT                                                       WFNC078 
      PHPR =-PNPR                                                       WFNC079 
      PHPTH=-PNPTH                                                      WFNC080 
      PHPPH=-PNPPH                                                      WFNC081 
      PHPOM=-NNP/OM                                                     WFNC082 
      PHPKR =C2/OM2*KR -C/OM*PNPVR                                      WFNC083 
      PHPKTH=C2/OM2*KTH-C/OM*PNPVTH                                     WFNC084 
      PHPKPH=C2/OM2*KPH-C/OM*PNPVPH                                     WFNC085 
      KPHPK=N2                                                          WFNC086 
      RETURN                                                            WFNC087 
         END                                                            WFNC088-
