      SUBROUTINE AMIEPA (VELNS,VELEW,POTEN,CUSP,ALFA,FLUX,DRIZL,WION)
C
C  GET ION VELOCITIES, POTENTIAL AND AURORAL OVAL FROM AMIE RESULTS
C
      include "params.h"
      include "cflowv3.h"
      include "cons.h"
      include "phys.h"
      include "amie.h"
      COMMON/TRGM/RLATM(ZIMXP,ZJMX),RLONM(ZIMXP,ZJMX),
     | DUMID(ZIMXP,ZJMX,6),RLATMP(ZJMX),RLONMP(ZJMX),DLONS(ZJMX)
      COMMON /OVALR/ RRAD(2),H0,RH,RROTH,E0,REE,RROTE,FC,ALFAC,FD,ALFAD
     |, ALFK,ALF6,ALF21,RROT6,RROT21,RD6,RD6V,RD21,RH6,RH21,RT6,RT21
     |, ALFA0,RALFA,ALFA20,RALFA2,E20,RE2
      DIMENSION VELNS(ZIMX),VELEW(ZIMX),POTEN(ZIMX),WION(ZIMX),
     | ALFA(ZIMXP,2),FLUX(ZIMXP,2),DRIZL(ZIMX),CUSP(ZIMX),DLAT(ZIMX),
     | DLON(ZIMX)
      DATA S5/0.08726646/, S10/0.174532925/, S20/0.34906585/
      DATA PI/3.14159265358979/
C
      IH = 1
      IF (J .GE. ZJMX/2) IH = 2
C  GET AURORAL OVAL
      DO 1000 I=1,IMAX
      DLAT(I) = RLATM(I+2,J)
 1000 DLON(I) = RLONM(I+2,J)-DLONS(J)
C  CALCULATE COLAT AND ALON FOR CUSP AND DRIZZLE
C  VALUES IN OVALPOS WILL ALREADY BE DETERMINED FROM CALL TO FLOWXX FOR
C   S. H.
      DO 2000 I=1,IMAX
      SINLAT(I) = SIN(ABS(DLAT(I)))
      COSLAT(I) = COS(DLAT(I))
      SINLON(I) = SIN(DLON(I))
      COSLON(I) = COS(DLON(I))
      COLAT(I) = ACOS( SINLAT(I) )
 2000 ALON(I) = AMOD(ATAN2(+SINLON(I)*COSLAT(I),COSLAT(I)*COSLON(I))
     | +3.*PI,2.*PI) - PI
C  SUBSTITUTE IN AMIE VALUES
C  POTKV IN KV, POTEN IN V
C  VIXYZA IN M/S, VELEW,NS,WION IN CM/S
C  EKEVA (2*ALFA) IN KEV, ALFA IN KEV
C  EFLXA IN W/M2, NFLUX ASSUMES IT IS IN ERG/CM2-S
      SECA = AMAX1(UTSA(1,IH),SECTGCM)
      SECA = AMIN1(UTSA(2,IH),SECA)
      DENOMA = UTSA(2,IH) - UTSA(1,IH)
      F2 = (SECA - UTSA(1,IH))/DENOMA
      F1 = (UTSA(2,IH) - SECA)/DENOMA
      SECP = AMAX1(UTSP(1,IH),SECTGCM)
      SECP = AMIN1(UTSP(2,IH),SECP)
      DENOMP = UTSP(2,IH) - UTSP(1,IH)
      P2 = (SECP - UTSP(1,IH))/DENOMP
      P1 = (UTSP(2,IH) - SECP)/DENOMP
      DO 3000 I=1,IMAX
      POTEN(I) = (P1*POTKVA1(I,J)+P2*POTKVA2(I,J))*1000.
      VELEW(I) = (P1*VIXYZA1(I,J,1)+P2*VIXYZA2(I,J,1)) * 100.
      VELNS(I) = (P1*VIXYZA1(I,J,2)+P2*VIXYZA2(I,J,2)) * 100.
      WION(I) = (P1*VIXYZA1(I,J,3)+P2*VIXYZA2(I,J,3)) * 100.
      ALFA(I,1) = (F1*EKEVA1(I,J)+F2*EKEVA2(I,J))*0.5
C  WARNING --- THIS WORKS ONLY BECAUSE ALFA21=ALFA22=ALFA20
      ALFA(I,2) = ALFA20
C  CUSP AND DRIZL ARE FRACTIONS, NUMBERS BETWEEN 0 AND 1.
C  ON RECOMMENDATION OFROD HEELIS, PLACE THE CUSP AT THE REVERSAL
C   BOUNDARY WITH A RADIUS OF 5 DEGREES
      CUSP(I)=(EXP(-((CRAD(IH)-COLAT(I))/S5)**2)+EXP(-((PI-CRAD(IH)-
     |COLAT(I))/S5)**2))*EXP(-(ATAN2(SIN(ALON(I)-PHIDA(IH)),COS(ALON(I)
     | - PHIDA(IH)))/S20)**2)
 3000 DRIZL(I) = EXP(-(( COLAT(I)-CRAD(IH) + ABS(COLAT(I)-CRAD(IH)) )
     | / S10)**2)
      DO 4000 I=1,IMAX
c     FLUX(I,1) = (F1*EFLXA1(I,J)+F2*EFLXA2(I,J))*1000. / (2.*ALFA(I,1)
c    | * 1.602E-9 )
      FLUX(I,1) = AMAX1( (F1*EFLXA1(I,J)+F2*EFLXA2(I,J))*1000. /
     | (2.*ALFA(I,1)*1.602E-9 ) , 1.E-20 )
C  7/92  The following flux is much too large, and immediately develops
C        large Te's and low Ne's in the auroral region
C     FLUX(I,2) = (F1*EFLXA1(I,J)+F2*EFLXA2(I,J))*1000. / (2.*ALFA20
C    | * 1.602E-9 )
C  WK1 = COS(LAMDA)
      WK1(I) = COS(ATAN2(SIN(ALON(I)-RROTE),COS(ALON(I)-RROTE)))
C  WK2 = auroral half-width
      WK2(I) = H0*(1.-RH*COS(ATAN2(SIN(ALON(I)-RROTH),COS(ALON(I)-
     | RROTH))) )
C  WK3 = colat - rad
      WK3(I) = COLAT(I) - CRAD(IH)
 4000 FLUX(I,2) = E20*(1.-RE2*WK1(I)) * EXP(-(WK3(I)/WK2(I))**2)
     | / (2. * ALFA20 * 1.602E-9)
      RETURN
      END
C
