SUBROUTINE HEELIS
      implicit none
C     ****
C     ****     GENERATE AURORAL CIRCLE FIELDS, UI, VI, WI
C     ****
      include "params.h"
      include "dynphi.h"
      include "blnk.h"
      include "vscr.h"
      include "cons.h"
      include "index.h"
      include "strt.h"
      include "buff.h"
      include "phys.h"
      real :: bxm,bx,bxp,by,byp,bz,bzp,bmod,bmodp
      COMMON/MAGFLD/BXM(ZIMXP,2),BX(ZIMXP,ZJMX),BXP(ZIMXP,4),
     1  BY(ZIMXP,ZJMX),BYP(ZIMXP,4),BZ(ZIMXP,ZJMX),BZP(ZIMXP,4),
     2  BMOD(ZIMXP,ZJMX),BMODP(ZIMXP,2)
C     ****
C     ****  DIMENSIONS FOR AMIE FIELDS OF POTENTIAL (KV) AND
C     ****    UI,VI,WI (M/S)
C     ****  NORTHERN HEMISPHERE ONLY --- 17.5 TO 87.5 DEG LATITUDE ****
C     ****
      include "amie.h"
!
! Local:
      real :: WION(ZIMXP),userla
      integer :: nuik,nvik,nwik,i,jj,ishunk
!
C     ****     CALCULATE UI AND VI
C     ****
C     ****     SCALE UI AND VI FROM INPUT
C     ****
      NUIK=NDJ+NUI
      NVIK=NDJ+NVI
      NWIK=NDJ+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
!
! userla and ishunk are local (s.a. orora):
      USERLA=(FLOAT(J-JMAX)-.5)*C(2)+C(110)/2.
      ISHUNK=1
      IF(IAUR.EQ.0)ISHUNK=0
      IF(ABS(USERLA).LT.C(110)/6.)ISHUNK=0
      IF(ISHUNK.EQ.0)GO TO 24
      IF (IAMIE .EQ. 1) THEN
        CALL AMIEPA (T2(3),T1(3),T4(3),T5(3),T6(3),T8(3),T3(3),WION(3))
        GO TO 499
      ENDIF
      JJ=((2*J-JMAX-1)/IABS(2*J-JMAX-1)+3)/2
      CALL FLOWXX(T5(3),T6(3),T8(3),T3(3))
  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
!     write(6,"(/,'heelis after aurht: j=',i2)") j
!     write(6,"('t3=',/,(6e12.4))") t3 
!     write(6,"('t5=',/,(6e12.4))") t5 
!     write(6,"('t6=',/,(6e12.4))") t6 
!     write(6,"('t7=',/,(6e12.4))") t7 
!     write(6,"('t8=',/,(6e12.4))") t8 
!     write(6,"('t9=',/,(6e12.4))") t9 
      GO TO 25
   24 CONTINUE
      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
   25 CONTINUE
C     ****
C     ****     SAVE AURORAL PARAMETERS
C     ****
      RETURN
      END
C