#include "dims.h"
!
      subroutine dynamics(lat,step,istep,ixtime)
      use chemrates,only: chemrates_tdep
      use bndry_module,only: bndry_comp
      implicit none
#include "params.h"
#include "buff.h"
!
      logical :: partial_run
      common/part_com/ partial_run
!
! Args:
      integer,intent(in) :: lat,ixtime,step,istep
!
! Local:
!     character(len=8) :: chnj(8) = 
!    +  (/'NJM2    ','NJM1    ','NJ      ','NJP1    ','NJP2    ',
!    +    'NJIN    ','NJOT    ','NJNP    '/)
      integer :: i
      logical :: print=.false.
      integer :: idn(zimxp)
!
! Dynamics driver: called from advnce in the main multi-tasked
!   latitude loop. The f-array is private to each processor
!   (fcom.h is task common).
! These routines use f(:,njm2-njm1-nj-njp1-nmp2) from previous
!   iteration and output f(:,njnp). nj is pointer to current
!   latitude fields (lat is current latitude index).
!
      if (print) write(6,"(/,'dynamics: lat=',i3)") lat
!
      call bndry_comp
      if (print) write(6,"('dynamics after bndry_comp: lat=',i2)") lat
C     ****
C     ****    CALCULATE W AT N*DT
C     ****
      CALL SWDOT
      if (print) write(6,"('dynamics after swdot: lat=',i2)") lat
C     ****
C     ****     CALCULATE ION DRIFT VELOCITY
C     ****
      CALL VDRIFT2
      if (print) write(6,"('dynamics after vdrift2: lat=',i2)") lat
C     ****     CALCULATE CP, KT, AND KM
      CALL CPKTKM
      if (print) write(6,"('dynamics after cpktkm: lat=',i2)") lat
C     ****      CLEAR NQO2P, NQOP, NQN2P, NQNOP, NQNP
      call clearnq ! must use this until new qrj is installed
C     ****     CALCULATE COLUMN NUMBER DENSITIES
      CALL CHAPMN(idn) ! chapmn returns day/night index idn(zimxp)
      if (print) write(6,"('dynamics after chapmn: lat=',i2)") lat
C     ****     CALCULATE SOLAR HEATING
C     ****     CALCULATE REACTION RATES
C     CALL ALTV
!
! set temperature-dependent rates.
      call chemrates_tdep 
      if (print) write(6,"('dynamics after chemrates_tdep: lat=',i2)") 
     |  lat
!
!     write(6,"('dynamics: lat=',i2,' idn=',/,(30i2))") lat,idn
!     do i=1,zimxp
!       if (idn(i)==1) then
!         CALL QRJ(i)
!         if (print) write(6,"('dynamics after qrj: lat=',i2)") lat
!       endif
!     enddo
      CALL QRJ
      if (print) write(6,"('dynamics after qrj: lat=',i2)") lat
C     ****     CALCULATE BACKGROUND (NIGHT-TIME) IONIZATION
      CALL QINITE
      if (print) write(6,"('dynamics after qinite: lat=',i2)") lat
C     ****     ADD IONIZATION DUE TO SOLAR X-RAYS
      CALL XRAY
      if (print) write(6,"('dynamics after xray: lat=',i2)") lat
C     ****     GENERATE AURORAL FIELDS, UI, VI, WI.  FIELDS RETURNED
C     ****     IN T1 THRU T7
      CALL HEELIS
      if (print) write(6,"('dynamics after heelis: lat=',i2)") lat
C     ****     CALCULATE AURORAL ADDITIONS TO IONIZATION RATES
      CALL ORORA
      if (print) write(6,"('dynamics after orora: lat=',i2)") lat
C     ****     SOLVE FOR N(O+)
C     ****     SET FLUX AT UPPER BOUNDARY
      CALL OPFLUX
      if (print) write(6,"('dynamics after opflux: lat=',i2)") lat
      CALL OPLUS
      if (print) write(6,"('dynamics after oplus: lat=',i2)") lat
C     ****     COMPUTE ELECTRON DENSITY, N(E), AND ION NUMBER DENSITIES,
C     ****     N(O2+), N(N2+), N(NO+), N(N+)
      CALL ELDEN
      if (print) write(6,"('dynamics after elden: lat=',i2)") lat
C     ****     ION-DRAG PARAMETERS, LXX, LYY, LXY (IN DIPOLE COORDINATE
C     ****     SYSTEM)
      CALL LAMDAS
      if (print) write(6,"('dynamics after lamdas: lat=',i2)") lat
C     ****     ROTATE LAMDAS TO GEOGRAPHIC SYSTEM
      CALL ROTATE
      if (print) write(6,"('dynamics after rotate: lat=',i2)") lat
C     ****     ELECTRON PRODUCTION OF N4S AND N2D
      CALL QTIEFF
      if (print) write(6,"('dynamics after qtieff: lat=',i2)") lat
C     ****     ODD NITROGEN CHEMISTRY
C     ****
C     ****     Calculate thermal and momentum inputs due to gravity
C     ****      waves
C     ****
      CALL MGW(float(step),lat)
      if (print) write(6,"('dynamics after mgw: lat=',i2)") lat
      CALL CMPSOLGAR
      if (print) write(6,"('dynamics after cmpsolgar: lat=',i2)") lat
      CALL CMPMETA
      if (print) write(6,"('dynamics after cmpmeta: lat=',i2)") lat
      CALL HOXPION
      if (print) write(6,"('dynamics after hoxpion: lat=',i2)") lat
!
! hdif3 uses kld terms calculated in hdif2, and
! defines nflh,nfph,nqdh,npsdh,npsdh2 in f-array
!
      call hdif3(lat,ixtime)
      if (print) write(6,"('dynamics after hdif3: lat=',i2)") lat
C
C CMPSOLGAR replaces CMPCLX, and defines RMN2O, RMCL, and RMCLO 
C   (see also solgar_import)
!     CALL CMPSOLGAR
!     if (print) write(6,"('dynamics after cmpsolgar: lat=',i2)") lat
      CALL CMPHOX
      if (print) write(6,"('dynamics after cmphox: lat=',i2)") lat
      CALL CMPN4S
      if (print) write(6,"('dynamics after cmpn4s: lat=',i2)") lat
      CALL CMPNOZ
      if (print) write(6,"('dynamics after cmpnoz: lat=',i2)") lat
      CALL CMPCH4
      if (print) write(6,"('dynamics after cmpch4: lat=',i2)") lat
      CALL CMPCO2
      if (print) write(6,"('dynamics after cmpco2: lat=',i2)") lat
      CALL CMPCO
      if (print) write(6,"('dynamics after cmpco: lat=',i2)") lat
      CALL CMPH2O
      if (print) write(6,"('dynamics after cmph2o: lat=',i2)") lat
      CALL CMPH2
      if (print) write(6,"('dynamics after cmph2: lat=',i2)") lat
      CALL CMPOX
      if (print) write(6,"('dynamics after cmpox: lat=',i2)") lat
!
! 12/8/00: helium not working (probably mpi problem). S.a., helium
!          call in advnce.
!     CALL CMPHE
!     if (print) write(6,"('dynamics after cmphe: lat=',i2)") lat
!
! 3/8/01: not calling cmpar, cmpnat, cmphe for double vertical resolution
!         because coefficients are not available (see cmpdat.F).
#if (NLEV==44)
      CALL CMPAR
      if (print) write(6,"('dynamics after cmpar: lat=',i2)") lat
      CALL CMPNAT
      if (print) write(6,"('dynamics after cmpnat: lat=',i2)") lat
#endif
C
C     ****     HEATING AND O2 DISSOCIATION DUE TO ODD NITROGEN AND ION
C     ****     CHEMISTRY
      CALL QJNNO
      if (print) write(6,"('dynamics after qjnno: lat=',i2)") lat
      CALL QJION
      if (print) write(6,"('dynamics after qjion: lat=',i2)") lat
C     ****     CALCULATE ELECTRON AND ION TEMPERATURES
      CALL SETTEI
      if (print) write(6,"('dynamics after settei: lat=',i2)") lat
!
C     ****     CALCULATE IMPLICIT AND EXPLICIT COOLING TERMS IN NWTI
C     ****     AND NWTE
!
! New radcool routine generalized for 2 vertical resolution models,
!  dz=0.5, dz=0.25
!
      call radcool
      if (print) write(6,"('dynamics after radcool: lat=',i2)") lat
!
C     ****     ADD IN O3P COOLING
      CALL NEWTO3P
      if (print) write(6,"('dynamics after newto3p: lat=',i2)") lat
C     ****     ADVANCE T, U, V BY ONE TIME STEP
C     ****
C     ****     DETERMINE BOUNDARY CONDITIONS FOR T, U AND V IN T1, T2
C     ****       AND T3
C     ****
      CALL TUVBND
      if (print) write(6,"('dynamics after tuvbnd: lat=',i2)") lat
      CALL DT
      if (print) write(6,"('dynamics after dt: lat=',i2)") lat
      CALL DUV
      if (print) write(6,"('dynamics after duv: lat=',i2)") lat
C     ****     COMPOSITION OF MAJOR SPECIES
      CALL COMP
      if (print) write(6,"('dynamics after comp: lat=',i2)") lat
C     ****   SUBROUTINE TO PARTITION OX INTO O AND O3
      CALL COMPART
      if (print) write(6,"('dynamics after compart: lat=',i2)") lat
      end subroutine dynamics
!-------------------------------------------------------------------
      subroutine clearnq
      use cons_module,only: len3
      implicit none
!
! Called from dynamics after CPKTKM, before CHAPMN.
!
#include "params.h"
#include "fcom.h"
#include "index.h"
!
! Local:
      integer :: nqpk,i
C     ****      CLEAR NQO2P, NQOP, NQN2P, NQNOP, NQNP
      NQPK=NQO2P
      DO 1 I=1,5*LEN3
      F(I,NQPK)=0.
    1 CONTINUE
      end subroutine clearnq