!
      subroutine advnce
      implicit none
C     ****                   ADVANCES THE MODEL IN TIME
      include "params.h"
      include "blnk.h"
      include "vscr.h"
      include "buff.h"
      include "cons.h"
      include "index.h"
      include "strt.h"
      include "unit.h"
      include "phys.h"
      include "sechis.h"
      include "amie.h"
      include "fgcom.h"
!
! Local:
      real :: delta,sec,x
      integer :: ienda,ja,ia,ka,nsin,len,num,jp2,njput,ilim,n,klim,
     |  nxk,nyk,k,id,i,njp2k,njputk,jj,nsot,nqpk,njget,itemp,nsin1,
     |  nsin2,jx
      real :: cputime0,cputime1
      real,external :: second
!
! Init buffer indices:
      modulo=8
      call init
!
!     cputime0 = second()
!     write(6,"(/'Enter advance at iter ',i6,' total accum cpuTime=',
!    |  f8.2)") iter,cputime0
      write(6,"(/'Enter advance at iter ',i6)") iter
!
! Main time loop:
  100 continue
      iter=iter+1
!     write(6,"(/'advnce: time step iter = ',i5)") iter
C     ****
C     ****     FIND UT TIME BETWEEN 0-24 HR (MODEL DAY = UT DAY, 11/89)
C     ****
      secs = amod(float(iter)*c(4),86400.)
      if (iadvda == 1) call advnceday(c)
C     ****
C     ****     CALCULATE AURORAL PARAMETERS FOR THIS TIME STEP
C     ****
C     ****     FIND UT TIME  (MODEL DAY = UT DAY, 11/89)
      sec = float(iter)*c(4)
      sectgcm = float(iter)*c(4)
      call sun
      if (iamie==1) call setamie(sec)
      call getgpi
      call tail (sec)
      ihis=ihis-1
      isav=isav-1
      if (iter.le.isecstop) then
        ihissech = ihissech-1
        isavsech = isavsech-1
      endif
C     ****                   FOR THE FIRST FORWARD TIME STEP OF A
C     ****                   FORECAST START, HALVE DT.
      if (modefc == 0) then
  1     C(4) = C(111)/2.
        C(6)   = 2.*C(4)
        C(7)   = 1./C(6)
        MODEFC=1
      elseif (modefc > 0) then
        C(4) = C(111)
        C(6)   = 2.*C(4)
        C(7)   = 1./C(6)
        MODEFC=-1
      endif
!
! init_sflux calls ssflux (see qrj.f):
!
      call init_sflux
C     ****                   BEGIN SWEEP OF MESH FROM SOUTH TO NORTH
C     ****                   BRING IN LINE 1
      call vdrift
!
! Calculate global NZ, NMS, and NVC and store in fg:
!
!MIC$ DOALL PRIVATE(j) SHARED(jmax,ixtimep)
      do j=1,jmax
        call addiag(j,ixtimep,0)
      enddo
!
! Make boundary latitudes:
      call mklatbndfg(0     ,1     ,ixtimep,.false.)
      call mklatbndfg(-1    ,2     ,ixtimep,.false.)
      call mklatbndfg(jmax+1,jmax  ,ixtimep,.false.)
      call mklatbndfg(jmax+2,jmax-1,ixtimep,.false.)
!
! hdif1 saves nrh and kmh at j in fnrh and fkmh (fgcom.h),
! using fg fields UNM and VNM at j+1 and j+2, and TNM and NMS at j+1.
!
!MIC$ DOALL PRIVATE(j) SHARED(jmax,ixtimep)
      do j=-2,jmax
        call hdif1(j,ixtimep)
      enddo
!
! hdif2 saves kld fields in fg at j+1 (0->37)
! (hdif2 uses fg, and nrh, kmh at j-1 from hdif1)
!
!MIC$ DOALL PRIVATE(j) SHARED(jmax,ixtimep)
      do j=-1,jmax
        call hdif2(j,ixtimep)
      enddo
!
! Report cpu time from top of time loop:
!     cputime1 = second()
!     write(6,"('Time to main lat loop from beginning',
!    |  ' of iter: ',f8.2,' (secs)')") cputime1-cputime0
!
! Reinit cputime for lat loop timing:
      cputime0 = second()
!
! Main latitude loop:
!
!MIC$  DOALL
!MIC$+   SHARED(jmax,c,cs,ixtimep,ixtimec,ndisk,njtmp,njnp)
!MIC$+   PRIVATE(j,jx,jj,i,racs,ifrst)
!
      do 3000 jx=1,jmax
        j = jx                  ! j is in common in phys.h
!       write(6,"('advnce begin main lat loop: jx=',i2)") jx
        racs=1./(c(51)*cs(jx))
!
! Each processor gets its own private f-array from the global fg-array,
! according to j (fg's 3rd dimension (latitude) is -1:jmax+2)
!
! j   njm2 njm1 nj njp1 njp2
! 1   -1    0    1    2   3
! 2    0    1    2    3   4
! 3    1    2    3    4   5
!  ...
! 34   32  33   34   35   36
! 35   33  34   35   36   37
! 36   34  35   36   37   38
!
        i = 0
        do jj=jx-2,jx+2
          i = i+1
          call putf(njtmp(i+1),jj,ixtimep,1,ndisk+2)
        enddo
        if(jx.eq.jmax) ifrst=1
!
! Dynamics driver (stores updated j in f(njnp)):
        call dynamics(j,ixtimep)
!
! Save updated latitude in njnp to fg (current time index):
        call putfg(njnp,jx,ixtimec,1,ndisk+2)
!
! End main latitude loop:
!       write(6,"('  end main lat loop: jx=',i2)") jx
 3000 continue
!
! Report cpu time through main lat loop:
!     cputime1 = second()
!     write(6,"('Time in main latitude loop = ',f8.2,' (secs)')")
!    |  cputime1-cputime0
!
! Swap time indices of fg for next iteration.
! (current time becomes previous time for next iteration).
!
      itemp = ixtimec
      ixtimec = ixtimep
      ixtimep = itemp
!
C     ****
C     ****     SET UP AND SOLVE DYNAMO EQUATIONS
C     ****
!
! Init timing for dynamo:
!     cputime0 = second()
!
! Dynamo:
      call dyn
!
! Report time through dynamo (and optionally helium):
!     cputime1 = second()
!     write(6,"('Time through dynamo: ',f8.2,' (secs)')") 
!    |  cputime1-cputime0
!
!     write(6,"('ADVNCE iter',i5,': ihis=',i2,
!    +  ' isav=',i2,' sechis=',i2,' secsav=',i2,' secstrt,stop=',
!    +  2i5)") iter,ihis,isav,ihissech,isavsech,isecstart,isecstop
!
 3130 if (isav.eq.0.or.isavsech.eq.0) goto 3150
      if (ihis.ne.0.and.ihissech.ne.0) goto 3140
      if (iter.ge.nstp) then
        isav = 0
        isavsech = 0
      endif
      goto 3150
 3140 if (iter.lt.nstp) goto 100
      isav = 0
      isavsech = 0
 3150 write(6,"('Exit advance at iter  ',i6)") iter
      return
      end
C
!-----------------------------------------------------------------------
      subroutine advnceday(c)
      implicit none
      include "strt.h"
!
! Args:
      real,intent(inout) :: c(120)
!
! Local:
      integer :: idayit,idapr,iyrpr,iyr4,iyr100,lpyr,ienda
      real :: pi,delta
!
      IDAYIT = ITER*IFIX(C(4))/86400
      IF (IDAYIT*86400 .EQ. ITER*IFIX(C(4))) THEN
C       ****
C       ****     ADVANCE DAY
C       ****
        IDAPR = IIDAY
        IYRPR = IYEAR
        IIDAY = IIDAY + 1
C       ****
C       ****     LPYR = 1(0)  IF IS (NOT) A LEAP YEAR
C       ****
        IYR4 = IYEAR/4
        IYR100 = IYEAR/100
        LPYR = 0
        IF (IYR4*4 .EQ. IYEAR .AND. IYR100*100 .NE. IYEAR) LPYR=1
        IENDA = 365 + LPYR
        IF (IIDAY .GT. IENDA) THEN
         IYEAR = IYEAR + 1
         IIDAY = IIDAY - IENDA
        ENDIF                          !   FOR PAST YEAR'S END
C       ****
C       ****     RECALCULATE SUN'S DECLINATION
C       ****
        PI = 3.14159265358979
        DELTA = ATAN(TAN(23.5*PI/180.)*SIN(2.*PI*FLOAT(IIDAY-80)/365.))
        C(95) = SIN(DELTA)
        C(96) = COS(DELTA)
        WRITE(6,"(1X,'ADVNCE:  ADVANCING DAY (PREVIOUS,PRESENT)=',4I5)")
     1   IDAPR,IYRPR,IIDAY,IYEAR
      ENDIF
      end subroutine advnceday
!-----------------------------------------------------------------------
      subroutine setamie(sec)
      implicit none
      include "amie.h"
      include "unit.h"
!
! Args:
      real,intent(in) :: sec
!
! Local:
      integer :: ja,ia,ka
!
      IF (NTST.LT.NTIMS .AND. SEC.GT.SECUTA(2)) THEN
        NTST = NTST + 1
        SECUTA(1) = SECUTA(2)
        HPNHA(1) = HPNHA(2)
        HPSHA(1) = HPSHA(2)
        CPNHA(1) = CPNHA(2)
        CPSHA(1) = CPSHA(2)
        CUSPSTA(1) = CUSPSTA(2)
        CUSPSLA(1) = CUSPSLA(2)
        CUSPNTA(1) = CUSPNTA(2)
        CUSPNLA(1) = CUSPNLA(2)
        DO 120 JA=1,36
          DO 120 IA=1,73
            POTKVA1(IA,JA) = POTKVA2(IA,JA)
            EKEVA1(IA,JA) = EKEVA2(IA,JA)
            EFLXA1(IA,JA) = EFLXA2(IA,JA)
  120   CONTINUE
        DO 121 KA=1,3
          DO 121 JA=1,36
            DO 121 IA=1,73
              VIXYZA1(IA,JA,KA) = VIXYZA2(IA,JA,KA)
  121   CONTINUE
        READ (IUAMI) SECUTA(2),HPSHA(2),HPNHA(2),CPSHA(2),CPNHA(2),
     1    CUSPSTA(2),CUSPNTA(2),CUSPSLA(2),CUSPNLA(2),POTKVA2,VIXYZA2,
     2    EKEVA2,EFLXA2
      ENDIF                    !  FOR READING AMIE
      end subroutine setamie