#include "dims.h"
      SUBROUTINE HEELIS
      use cons_module,only: len1,len3,imax,imaxp2,jmax,dphi,pi
      use input_module,only: aurora
      implicit none
C     ****
C     ****     GENERATE AURORAL CIRCLE FIELDS, UI, VI, WI
C     ****
#include "params.h"
#include "fcom.h"
#include "vscr.h"
#include "index.h"
#include "buff.h"
#include "phys.h"
!
      integer :: iamie,iuts1,iuts2,nspsec,ntims,ntst,im
      real :: sectgcm,crad,phida,secuta,hpsha,hpnha,cpsha,cpnha,
     |  cuspsta,cuspnta,cuspsla,cuspnla,potkva1,vixyza1,ekeva1,
     |  eflxa1,potkva2,vixyza2,ekeva2,eflxa2
      COMMON/AMIE/IAMIE,IUTS1,IUTS2,NSPSEC,NTIMS,NTST,SECTGCM,CRAD(2),
     1 PHIDA(2),SECUTA(2),HPSHA(2),HPNHA(2),CPSHA(2),CPNHA(2),
     2 CUSPSTA(2),CUSPNTA(2),CUSPSLA(2),CUSPNLA(2),
     3 POTKVA1(73,36),VIXYZA1(73,36,3),EKEVA1(73,36),EFLXA1(73,36),
     4 POTKVA2(73,36),VIXYZA2(73,36,3),EKEVA2(73,36),EFLXA2(73,36)
!
C     ****
C     ****  DIMENSIONS FOR AMIE FIELDS OF POTENTIAL (KV) AND
C     ****    UI,VI,WI (M/S)
C     ****
      real :: WION(ZIMXP)
      integer :: ishunk,IHEM,nuik,nvik,nwik,i
      real :: userla
!
C     ****     CALCULATE UI AND VI
C     ****
C     ****     SCALE UI AND VI FROM INPUT
C     ****
      NUIK=NUI
      NVIK=NVI
      NWIK=NWI
      DO 500 I=1,LEN3
        F(I,NUIK)=100.*F(I,NUIK)
        F(I,NVIK)=100.*F(I,NVIK)
        F(I,NWIK)=100.*F(I,NWIK)
  500 CONTINUE
!
! Aurora routines flowv3, polht, and aurht are called only when
!   abs(latitude) <= 32.5 (also orora, called after heelis)
! (ISHUNK and USERLA are local)
!
      USERLA=(FLOAT(J-JMAX)-.5)*dphi+pi/2.
      ISHUNK=1
      IF (aurora.EQ.0) ISHUNK=0
      IF (ABS(USERLA).LT.pi/6.) ISHUNK=0
      IF (ISHUNK.EQ.1) then
!
! Amie not tested w/ multi-tasking as of 10/98:
      IF (IAMIE .EQ. 1) THEN
        write(6,"('heelis calling amiepa')")
        CALL AMIEPA (T2(3),T1(3),T4(3),T5(3),T6(3),T8(3),T3(3),WION(3))
        GO TO 499
      ENDIF
!
! Call flowv3, polht, and aurht (flowxx, flowx0, flowv1, and flowv2
!   have been eliminated).
! Flowv3 defines taskcommon /cflowv3/, which is needed by
!   polht and aurht. 
! Flowv3 also defines ihem (local), which is passed to polht and aurht.
!
      call flowv3(IHEM)
!
! T5=CUSP, T6=ALFA, T8=FLUX, T3=DRIZL T7=ALFA2 T9=FLUX2 
! 
! polht defines cusp in t5:
!                cusp
      call polht(t5(3),imax,IHEM)
!
! aurht defines alfa,flux,drizl,alfa2,flux2:
!                alfa  flux  drizl alfa2 flux2
      call aurht(t6(3),t8(3),t3(3),t7(3),t9(3),imax,IHEM)
!
  499 CONTINUE
C     ****     INSERT PERIODIC POINTS
      DO 502 I=1,2
        T3(I)=T3(I+IMAX)
        T5(I)=T5(I+IMAX)
        T6(I)=T6(I+IMAX)
        T7(I)=T7(I+IMAX)
        T8(I)=T8(I+IMAX)
        T9(I)=T9(I+IMAX)
!
        T3(I+IMAXP2)=T3(I+2)
        T5(I+IMAXP2)=T5(I+2)
        T6(I+IMAXP2)=T6(I+2)
        T7(I+IMAXP2)=T7(I+2)
        T8(I+IMAXP2)=T8(I+2)
        T9(I+IMAXP2)=T9(I+2)
  502 CONTINUE
!
! ishunk==0 (abs(lat) < 32.5)
      else
        DO 26 I=1,LEN1
          T3(I)=0.
          T5(I)=0.
          T6(I)=0.
          T7(I)=0.
          T8(I)=0.
          T9(I)=0.
   26   CONTINUE
!
! End latitude >= 32.5
      endif ! ishunk
      RETURN
      END