<p><b>duda</b> 2010-07-13 15:27:45 -0600 (Tue, 13 Jul 2010)</p><p>BRANCH COMMIT<br>
<br>
Remove unused alternate versions of non-hydrostatic core files.<br>
<br>
D    src/core_nhyd_atmos/module_test_cases.F.100705<br>
D    src/core_nhyd_atmos/module_time_integration.F.0531<br>
D    src/core_nhyd_atmos/module_time_integration.F.sh0609<br>
D    src/core_nhyd_atmos/module_test_cases.F.sh0614<br>
D    src/core_nhyd_atmos/module_test_cases.F.0521<br>
D    src/core_nhyd_atmos/module_test_cases.F.ok<br>
</p><hr noshade><pre><font color="gray">Deleted: branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.0521
===================================================================
--- branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.0521        2010-07-12 19:38:09 UTC (rev 372)
+++ branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.0521        2010-07-13 21:27:45 UTC (rev 373)
@@ -1,964 +0,0 @@
-module test_cases
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine setup_nhyd_test_case(domain)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Configure grid metadata and model state for the hydrostatic test case
-   !   specified in the namelist
-   !
-   ! Output: block - a subset (not necessarily proper) of the model domain to be
-   !                 initialized
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-
-      integer :: i
-      type (block_type), pointer :: block_ptr
-
-      if (config_test_case == 0) then
-         write(0,*) ' need nonhydrostatic test case configuration, error stop '
-         stop
-
-      else if ((config_test_case == 1) .or. (config_test_case == 2) .or. (config_test_case == 3)) then
-         write(0,*) ' Jablonowski and Williamson baroclinic wave test case '
-         if (config_test_case == 1) write(0,*) ' no initial perturbation '
-         if (config_test_case == 2) write(0,*) ' initial perturbation included '
-         if (config_test_case == 3) write(0,*) ' normal-mode perturbation included '
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            write(0,*) ' calling test case setup '
-            call nhyd_test_case_jw(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
-            write(0,*) ' returned from test case setup '
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 4 ) then
-
-         write(0,*) ' squall line - super cell test case '
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            write(0,*) ' calling test case setup '
-            call nhyd_test_case_squall_line(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
-            write(0,*) ' returned from test case setup '
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else
-
-         write(0,*) ' Only test case 1, 2, 3 and 4 are currently supported for nonhydrostatic core '
-         stop
-      end if
-
-   end subroutine setup_nhyd_test_case
-
-!----------------------------------------------------------------------------------------------------------
-
-   subroutine nhyd_test_case_jw(grid, state, test_case)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_meta), intent(inout) :: grid
-      type (grid_state), intent(inout) :: state
-      integer, intent(in) :: test_case
-
-      real (kind=RKIND), parameter :: u0 = 35.0
-      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
-      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
-      real (kind=RKIND), parameter :: t0b = 250., t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
-      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
-      real (kind=RKIND), parameter :: theta_c = pii/4.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
-      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
-
-      real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
-      real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx
-      real (kind=RKIND), dimension(:,:), pointer :: pressure, ppb, pb, rho, rb, rr, tb, rtb, p, pp, dss, t, rt
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp
-
-      !This is temporary variable here. It just need when calculate tangential velocity v.
-      integer :: eoe, j
-      integer, dimension(:), pointer :: nEdgesOnEdge 
-      integer, dimension(:,:), pointer :: edgesOnEdge
-      real, dimension(:,:), pointer :: weightsOnEdge
-
-      real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
-
-      real (kind=RKIND) :: ptop, p0, phi
-      real (kind=RKIND) :: lon_Edge
-
-      real (kind=RKIND) :: r_earth, etavs, ztemp, zd, zt, dz, gam, delt, str
-
-      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature, qv
-      real (kind=RKIND) :: ptmp, es, qvs, xnutr, znut, ptemp
-      integer :: iter
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: sh, zw, ah
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: zu, dzw, rdzwp, rdzwm
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: eta, etav, teta, ppi, tt
-
-      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      
-      nz1 = grid % nVertLevels
-      nz = nz1 + 1
-
-      zgrid =&gt; grid % zgrid % array
-      rdzw =&gt; grid % rdzw % array
-      dzu =&gt; grid % dzu % array
-      rdzu =&gt; grid % rdzu % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zx =&gt; grid % zx % array
-      zz =&gt; grid % zz % array
-      hx =&gt; grid % hx % array
-      dss =&gt; grid % dss % array
-
-      pb =&gt; grid % exner_base % array
-      rb =&gt; grid % rho_base % array
-      tb =&gt; grid % theta_base % array
-      rtb =&gt; grid % rtheta_base % array
-      p =&gt; grid % exner % array
-
-      ppb =&gt; grid % pressure_base % array
-      pp =&gt; state % pressure % array
-
-      rho =&gt; state % rho % array
-      rr =&gt; state % rho_p % array
-      t =&gt; state % theta % array      
-      rt =&gt; grid % rtheta_p % array
-
-
-      scalars(:,:,:) = 0.
-
-      xnutr = 0.
-      zd = 12000.
-      znut = eta_t
-
-      etavs = (1.-0.252)*pii/2.
-      r_earth = a
-      p0 = 1.e+05
-
-      write(0,*) ' point 1 in test case setup '
-
-! We may pass in an hx(:,:) that has been precomputed elsewhere.
-! For now it is independent of k
-
-      do iCell=1,grid % nCells
-        do k=1,nz
-          phi = grid % latCell % array (iCell)
-          hx(k,iCell) = u0/gravity*cos(etavs)**1.5                                   &amp;
-                      *((-2.*sin(phi)**6                                   &amp;
-                            *(cos(phi)**2+1./3.)+10./63.)                  &amp;
-                            *(u0)*cos(etavs)**1.5                          &amp;
-                       +(1.6*cos(phi)**3                                   &amp;
-                            *(sin(phi)**2+2./3.)-pii/4.)*r_earth*omega_e)
-        enddo
-      enddo
-
-      !     metrics for hybrid coordinate and vertical stretching
-
-      str = 1.5
-      zt = 45000.
-      dz = zt/float(nz1)
-
-      write(0,*) ' hx computation complete '
-
-      do k=1,nz
-                
-!           sh(k) is the stretching specified for height surfaces
-
-            sh(k) = (real(k-1)*dz/zt)**str 
-                                
-!           to specify specific heights zc(k) for coordinate surfaces,
-!           input zc(k) and define sh(k) = zc(k)/zt
-!           zw(k) is the hieght of zeta surfaces
-!                zw(k) = (k-1)*dz yields constant dzeta
-!                        and nonconstant dzeta/dz
-!                zw(k) = sh(k)*zt yields nonconstant dzeta
-!                        and nearly constant dzeta/dz 
-
-            zw(k) = float(k-1)*dz
-!            zw(k) = sh(k)*zt
-!
-!           ah(k) governs the transition between terrain-following 
-!           and pureheight coordinates
-!                ah(k) = 0 is a terrain-following coordinate
-!                ah(k) = 1 is a height coordinate
- 
-            ah(k) = 1.-cos(.5*pii*(k-1)*dz/zt)**6
-!            ah(k) = 0.
-            write(0,*) ' k, sh, zw, ah ',k,sh(k),zw(k),ah(k)                        
-      end do
-      do k=1,nz1
-         dzw (k) = zw(k+1)-zw(k)
-         rdzw(k) = 1./dzw(k)
-         zu(k  ) = .5*(zw(k)+zw(k+1))
-      end do
-      do k=2,nz1
-         dzu (k)  = .5*(dzw(k)+dzw(k-1))
-         rdzu(k)  =  1./dzu(k)
-         fzp (k)  = .5* dzw(k  )/dzu(k)
-         fzm (k)  = .5* dzw(k-1)/dzu(k)
-         rdzwp(k) = dzw(k-1)/(dzw(k  )*(dzw(k)+dzw(k-1)))
-         rdzwm(k) = dzw(k  )/(dzw(k-1)*(dzw(k)+dzw(k-1)))
-      end do
-
-!**********  how are we storing cf1, cf2 and cf3?
-
-      d1  = .5*dzw(1)
-      d2  = dzw(1)+.5*dzw(2)
-      d3  = dzw(1)+dzw(2)+.5*dzw(3)
-      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-
-      do iCell=1,grid % nCells
-        do k=1,nz        
-          zgrid(k,iCell) = (1.-ah(k))*(sh(k)*(zt-hx(k,iCell))+hx(k,iCell))  &amp;
-                         + ah(k) * sh(k)* zt        
-        end do
-        do k=1,nz1
-          zz (k,iCell) = (zw(k+1)-zw(k))/(zgrid(k+1,iCell)-zgrid(k,iCell))
-        end do
-      end do
-
-      do i=1, grid % nEdges
-        iCell1 = grid % CellsOnEdge % array(1,i)
-        iCell2 = grid % CellsOnEdge % array(2,i)
-        do k=1,nz
-          zx (k,i) = (zgrid(k,iCell2)-zgrid(k,iCell1)) / grid % dcEdge % array(i)
-        end do
-      end do
-      do i=1, grid % nCells
-        do k=1,nz1
-          ztemp = .5*(zgrid(k+1,i)+zgrid(k,i))
-          dss(k,i) = 0.
-          ztemp = zgrid(k,i)
-          if(ztemp.gt.zd+.1)  then
-             dss(k,i) = dss(k,i)+xnutr*sin(.5*pii*(ztemp-zd)/(zt-zd))**2
-          end if
-        end do
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zgrid(k,1),hx(k,1) ',k,zgrid(k,1),hx(k,1)
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zx(k,1) ',k,zx(k,1)
-      enddo
-
-      write(0,*) ' grid metrics setup complete '
-!
-!---- baroclinc wave initialization ---------------------------------
-!
-!     reference sounding based on dry isothermal atmosphere
-!
-      do i=1, grid % nCells
-        !write(0,*) ' thermodynamic setup, cell ',i
-        do k=1,nz1
-          ztemp    = .5*(zgrid(k+1,i)+zgrid(k,i))
-          ppb(k,i) = p0*exp(-gravity*ztemp/(rgas*t0b)) 
-          pb (k,i) = (ppb(k,i)/p0)**(rgas/cp)
-          rb (k,i) = ppb(k,i)/(rgas*t0b*zz(k,i))
-          tb (k,i) = t0b/pb(k,i)
-          rtb(k,i) = rb(k,i)*tb(k,i)
-          p  (k,i) = pb(k,i)
-          pp (k,i) = 0.
-          rr (k,i) = 0.
-        end do
-
-        if(i == 1) then
-          do k=1,nz1
-            write(0,*) ' k, ppb, pb, rb, tb (k,1) ',k,ppb(k,1),pb(k,1),rb(k,1)*zz(k,1),tb(k,1)
-          enddo
-        end if
-!
-!     iterations to converge temperature as a function of pressure
-!
-        do itr = 1,10
-
-          do k=1,nz1
-            eta (k) = (ppb(k,i)+pp(k,i))/p0
-            etav(k) = (eta(k)-.252)*pii/2.
-            if(eta(k).ge.znut)  then
-              teta(k) = t0*eta(k)**(rgas*dtdz/gravity)
-            else
-              teta(k) = t0*eta(k)**(rgas*dtdz/gravity) + delta_t*(znut-eta(k))**5
-            end if
-          end do
-          phi = grid % latCell % array (i)
-          do k=1,nz1
-            tt(k) = 0.
-            tt(k) = teta(k)+.75*eta(k)*pii*u0/rgas*sin(etav(k))      &amp;
-                            *sqrt(cos(etav(k)))*                   &amp;
-                              ((-2.*sin(phi)**6                    &amp;
-                                   *(cos(phi)**2+1./3.)+10./63.)   &amp;
-                                   *2.*u0*cos(etav(k))**1.5        &amp;
-                              +(1.6*cos(phi)**3                    &amp;
-                                *(sin(phi)**2+2./3.)-pii/4.)*r_earth*omega_e)
-
-
-            !write(0,*) ' k, tt(k) ',k,tt(k)
-            ztemp   = .5*(zgrid(k,i)+zgrid(k+1,i))
-            ptemp   = ppb(k,i) + pp(k,i)
-!            qv(k,i) = env_qv( ztemp, tt(k), ptemp, 0 )
-            qv(k,i) = 0.
-
-          end do
-!          do k=2,nz1
-!            cqw(k,i) = 1./(1.+.5*(qv(k,i)+qv(k-1,i)))
-!          end do
-                
-          do itrp = 1,25
-            do k=1,nz1                                
-              rr(k,i)  = (pp(k,i)/(rgas*zz(k,i))  &amp;
-                          -rb(k,i)*(tt(k)-t0b))/tt(k)
-            end do
-
-            ppi(1) = p0-.5*dzw(1)*gravity                         &amp;
-                          *(1.25*(rr(1,i)+rb(1,i))*(1.+qv(1,i))   &amp;
-                            -.25*(rr(2,i)+rb(2,i))*(1.+qv(2,i)))
-
-            ppi(1) = ppi(1)-ppb(1,i)
-            do k=1,nz1-1
-              ppi(k+1) = ppi(k)-.5*dzu(k+1)*gravity*                     &amp;
-                            (rr(k  ,i)+(rr(k  ,i)+rb(k  ,i))*qv(k  ,i)   &amp;
-                            +rr(k+1,i)+(rr(k+1,i)+rb(k+1,i))*qv(k+1,i))
-            end do
-
-            do k=1,nz1
-              pp(k,i) = .2*ppi(k)+.8*pp(k,i)
-            end do
-
-          end do  ! end inner iteration loop itrp
-
-        end do  ! end outer iteration loop itr
-
-        do k=1,nz1        
-          p (k,i) = ((ppb(k,i)+pp(k,i))/p0)**(rgas/cp)
-          t (k,i) = tt(k)/p(k,i)
-          rt (k,i) = t(k,i)*rr(k,i)+rb(k,i)*(t(k,i)-tb(k,i))
-          rho (k,i) = rb(k,i) + rr(k,i)
-        end do
-
-        if(i == 1) then
-          do k=1,nz1
-            write(0,*) ' k, p, t, rt ',k,p(k,1),t(k,1),rt(k,1)
-          enddo
-        end if
-
-      end do  ! end loop over cells
-
-      lat_pert = latitude_pert*pii/180.
-      lon_pert = longitude_pert*pii/180.
-
-      do iEdge=1,grid % nEdges
-
-         vtx1 = grid % VerticesOnEdge % array (1,iEdge)
-         vtx2 = grid % VerticesOnEdge % array (2,iEdge)
-         lat1 = grid%latVertex%array(vtx1)
-         lat2 = grid%latVertex%array(vtx2)
-         iCell1 = grid % cellsOnEdge % array(1,iEdge)
-         iCell2 = grid % cellsOnEdge % array(2,iEdge)
-         flux = (0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-
-         if (config_test_case == 2) then
-            r_pert = sphere_distance( grid % latEdge % array (iEdge), grid % lonEdge % array (iEdge), &amp;
-                                      lat_pert, lon_pert, 1.)/(pert_radius)
-            u_pert = u_perturbation*exp(-r_pert**2)*(lat2-lat1)*a/grid % dvEdge % array(iEdge)
-
-         else if (config_test_case == 3) then
-            lon_Edge = grid % lonEdge % array(iEdge)
-            u_pert = u_perturbation*cos(k_x*(lon_Edge - lon_pert)) &amp;
-                         *(0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-         else
-            u_pert = 0.0
-         end if
-
-
-         do k=1,grid % nVertLevels
-           etavs = (0.5*(ppb(k,iCell1)+ppb(k,iCell2)+pp(k,iCell1)+pp(k,iCell2))/p0 - 0.252)*pii/2.
-  
-           fluxk = u0*flux*(cos(etavs)**1.5)
-!           fluxk = u0*flux*(cos(znuv(k))**(1.5))
-           state % u % array(k,iEdge) = fluxk + u_pert
-         end do
-
-      !
-      ! Generate rotated Coriolis field
-      !
-
-         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
-                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha_grid) + &amp;
-                                         sin(grid%latEdge%array(iEdge)) * cos(alpha_grid) &amp;
-                                       )
-      end do
-
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
-                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha_grid) + &amp;
-                                          sin(grid%latVertex%array(iVtx)) * cos(alpha_grid) &amp;
-                                         )
-      end do
-
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      state % v % array(:,:) = 0.0
-      do iEdge = 1, grid%nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1, grid%nVertLevels
-                 state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-
-   end subroutine nhyd_test_case_jw
-
-!----------------------------------------------------------------------------------------------------------
-
-   subroutine nhyd_test_case_squall_line(grid, state, test_case)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_meta), intent(inout) :: grid
-      type (grid_state), intent(inout) :: state
-      integer, intent(in) :: test_case
-
-      real (kind=RKIND), parameter :: u0 = 35.0
-      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
-      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
-      real (kind=RKIND), parameter :: t0b = 250., t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
-      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
-      real (kind=RKIND), parameter :: theta_c = pii/4.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
-      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
-
-      real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
-      real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx, cqw
-      real (kind=RKIND), dimension(:,:), pointer :: ppb, pb, rho, rb, rr, tb, rtb, p, pp, dss, t, rt, u, ru
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp, cell1, cell2, nCellsSolve
-
-      !This is temporary variable here. It just need when calculate tangential velocity v.
-      integer :: eoe, j
-      integer, dimension(:), pointer :: nEdgesOnEdge 
-      integer, dimension(:,:), pointer :: edgesOnEdge
-      real, dimension(:,:), pointer :: weightsOnEdge
-
-      real (kind=RKIND) :: flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
-
-      real (kind=RKIND) :: ptop, p0, phi
-      real (kind=RKIND) :: lon_Edge
-
-      real (kind=RKIND) :: r_earth, etavs, ztemp, zd, zt, dz, gam, str
-
-      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature, qv, rh
-      real (kind=RKIND) :: ptmp, es, qvs, xnutr, znut, ptemp
-      integer :: iter
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: zc, zw, ah
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: zu, dzw, rdzwp, rdzwm
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: eta, etav, teta, ppi, tt, thi
-
-      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3
-      real (kind=RKIND) :: ztr, thetar, ttr, thetas, um, us, zts, pitop, ptopb, rcp, rcv
-      real (kind=RKIND) :: radx, radz, zcent, xmid, delt, xloc, rad, temp, pres, yloc, ymid, a_scale
-
-      !
-      ! Scale all distances
-      !
-
-      a_scale = 1.0
-
-      grid % xCell % array = grid % xCell % array * a_scale
-      grid % yCell % array = grid % yCell % array * a_scale
-      grid % zCell % array = grid % zCell % array * a_scale
-      grid % xVertex % array = grid % xVertex % array * a_scale
-      grid % yVertex % array = grid % yVertex % array * a_scale
-      grid % zVertex % array = grid % zVertex % array * a_scale
-      grid % xEdge % array = grid % xEdge % array * a_scale
-      grid % yEdge % array = grid % yEdge % array * a_scale
-      grid % zEdge % array = grid % zEdge % array * a_scale
-      grid % dvEdge % array = grid % dvEdge % array * a_scale
-      grid % dcEdge % array = grid % dcEdge % array * a_scale
-      grid % areaCell % array = grid % areaCell % array * a_scale**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a_scale**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a_scale**2.0
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      
-      nz1 = grid % nVertLevels
-      nz = nz1 + 1
-      nCellsSolve = grid % nCellsSolve
-
-      zgrid =&gt; grid % zgrid % array
-      rdzw =&gt; grid % rdzw % array
-      dzu =&gt; grid % dzu % array
-      rdzu =&gt; grid % rdzu % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zx =&gt; grid % zx % array
-      zz =&gt; grid % zz % array
-      hx =&gt; grid % hx % array
-      dss =&gt; grid % dss % array
-
-      ppb =&gt; grid % pressure_base % array
-      pb =&gt; grid % exner_base % array
-      rb =&gt; grid % rho_base % array
-      tb =&gt; grid % theta_base % array
-      rtb =&gt; grid % rtheta_base % array
-      p =&gt; grid % exner % array
-      cqw =&gt; grid % cqw % array
-
-      rho =&gt; state % rho % array
-
-      pp =&gt; state % pressure % array
-      rr =&gt; state % rho_p % array
-      t =&gt; state % theta % array      
-      rt =&gt; grid % rtheta_p % array
-      u =&gt; state % u % array
-      ru =&gt; grid % ru % array
-
-      scalars =&gt; state % scalars % array
-
-      scalars(:,:,:) = 0.
-
-      xnutr = 0.
-      zd = 12000.
-      znut = eta_t
-
-      etavs = (1.-0.252)*pii/2.
-      r_earth = a
-      p0 = 1.e+05
-      rcp = rgas/cp
-      rcv = rgas/(cp-rgas)
-
-     write(0,*) ' point 1 in test case setup '
-
-! We may pass in an hx(:,:) that has been precomputed elsewhere.
-! For now it is independent of k
-
-      do iCell=1,grid % nCells
-        do k=1,nz
-          hx(k,iCell) = 0.  ! squall line or supercell on flat plane
-        enddo
-      enddo
-
-      !     metrics for hybrid coordinate and vertical stretching
-
-      str = 1.0
-      zt = 20000.
-      dz = zt/float(nz1)
-
-      write(0,*) ' dz = ',dz
-      write(0,*) ' hx computation complete '
-
-      do k=1,nz
-                
-!           sh(k) is the stretching specified for height surfaces
-
-            zc(k) = zt*(real(k-1)*dz/zt)**str 
-                                
-!           to specify specific heights zc(k) for coordinate surfaces,
-!           input zc(k) 
-!           zw(k) is the hieght of zeta surfaces
-!                zw(k) = (k-1)*dz yields constant dzeta
-!                        and nonconstant dzeta/dz
-!                zw(k) = sh(k)*zt yields nonconstant dzeta
-!                        and nearly constant dzeta/dz 
-
-!            zw(k) = float(k-1)*dz
-            zw(k) = zc(k)
-!
-!           ah(k) governs the transition between terrain-following 
-!           and pureheight coordinates
-!                ah(k) = 0 is a terrain-following coordinate
-!                ah(k) = 1 is a height coordinate
- 
-!            ah(k) = 1.-cos(.5*pii*(k-1)*dz/zt)**6
-            ah(k) = 1.
-            write(0,*) ' k, zc, zw, ah ',k,zc(k),zw(k),ah(k)                        
-      end do
-      do k=1,nz1
-         dzw (k) = zw(k+1)-zw(k)
-         rdzw(k) = 1./dzw(k)
-         zu(k  ) = .5*(zw(k)+zw(k+1))
-      end do
-      do k=2,nz1
-         dzu (k)  = .5*(dzw(k)+dzw(k-1))
-         rdzu(k)  =  1./dzu(k)
-         fzp (k)  = .5* dzw(k  )/dzu(k)
-         fzm (k)  = .5* dzw(k-1)/dzu(k)
-         rdzwp(k) = dzw(k-1)/(dzw(k  )*(dzw(k)+dzw(k-1)))
-         rdzwm(k) = dzw(k  )/(dzw(k-1)*(dzw(k)+dzw(k-1)))
-      end do
-
-!**********  how are we storing cf1, cf2 and cf3?
-
-      d1  = .5*dzw(1)
-      d2  = dzw(1)+.5*dzw(2)
-      d3  = dzw(1)+dzw(2)+.5*dzw(3)
-      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-
-      do iCell=1,grid % nCells
-        do k=1,nz        
-            zgrid(k,iCell) = ah(k)*(zc(k)*(1.-hx(k,iCell)/zt)+hx(k,iCell)) &amp;
-                           + (1.-ah(k)) * zc(k)        
-        end do
-        do k=1,nz1
-          zz (k,iCell) = (zw(k+1)-zw(k))/(zgrid(k+1,iCell)-zgrid(k,iCell))
-        end do
-      end do
-
-      do i=1, grid % nEdges
-        iCell1 = grid % CellsOnEdge % array(1,i)
-        iCell2 = grid % CellsOnEdge % array(2,i)
-        do k=1,nz
-          zx (k,i) = (zgrid(k,iCell2)-zgrid(k,iCell1)) / grid % dcEdge % array(i)
-        end do
-      end do
-      do i=1, grid % nCells
-        do k=1,nz1
-          ztemp = .5*(zgrid(k+1,i)+zgrid(k,i))
-          dss(k,i) = 0.
-          ztemp = zgrid(k,i)
-          if(ztemp.gt.zd+.1)  then
-             dss(k,i) = dss(k,i)+xnutr*sin(.5*pii*(ztemp-zd)/(zt-zd))**2
-          end if
-        end do
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zgrid(k,1),hx(k,1) ',k,zgrid(k,1),hx(k,1)
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zx(k,1) ',k,zx(k,1)
-      enddo
-
-      write(0,*) ' grid metrics setup complete '
-!
-! convective initialization
-!
-         ztr    = 12000.
-         thetar = 343.
-         ttr    = 213.
-         thetas = 300.5
-
-!  no flow
-         um = 0.
-         us = 0.
-         zts = 5000.
-!  supercell parameters
-!         um = 30.
-!         us = 15.
-!         zts = 5000.
-!  squall-line parameters
-!         um = 12.
-!         us = 10.
-!         zts = 2500.
-
-
-         do i=1,grid % nCells
-            do k=1,nz1
-               ztemp = .5*(zgrid(k,i)+zgrid(k+1,i))
-               if(ztemp .gt. ztr) then
-                  t (k,i) = thetar*exp(9.8*(ztemp-ztr)/(1003.*ttr))
-                  rh(k,i) = 0.25
-               else
-                  t (k,i) = 300.+43.*(ztemp/ztr)**1.25
-                  rh(k,i) = (1.-0.75*(ztemp/ztr)**1.25)
-                  rh(k,i) = 0.
-                  if(t(k,i).lt.thetas) t(k,i) = thetas
-               end if
-               tb(k,i) = t(k,i)
-            end do
-         end do
-
-!  set the velocity field - we are on a plane here.
-
-         do i=1, grid % nEdges
-            cell1 = grid % CellsOnEdge % array(1,i)
-            cell2 = grid % CellsOnEdge % array(2,i)
-            if(cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-            do k=1,nz1
-               ztemp = .25*( zgrid(k,cell1 )+zgrid(k+1,cell1 )  &amp;
-                            +zgrid(k,cell2)+zgrid(k+1,cell2))
-               if(ztemp.lt.zts)  then
-                  u(k,i) = um*ztemp/zts
-               else
-                  u(k,i) = um
-               end if
-               u(k,i) = cos(grid % angleEdge % array(i)) * (u(k,i) - us)
-            end do
-            end if
-         end do
-!
-!     reference sounding based on dry atmosphere
-!
-      pitop = 1.-.5*dzw(1)*gravity/(cp*tb(1,1)*zz(1,1))
-      do k=2,nz1
-         pitop = pitop-dzu(k)*gravity/(cp*.5*(tb(k,1)+tb(k-1,1))   &amp;
-                                   *.5*(zz(k,1)+zz(k-1,1)))
-          
-         write(0,*) k,pitop,tb(k,1),dzu(k),tb(k,1)
-      end do
-      pitop = pitop-.5*dzw(nz1)*gravity/(cp*tb(nz1,1)*zz(nz1,1))
-
-      ptopb = p0*pitop**(1./rcp)
-      write(6,*) 'ptopb = ',.01*ptopb
-                
-      do i=1, grid % nCells
-         pb(nz1,i) = pitop+.5*dzw(nz1)*gravity/(cp*tb(nz1,i)*zz(nz1,i))
-         p (nz1,i) = pitop+.5*dzw(nz1)*gravity/(cp*t (nz1,i)*zz(nz1,i))
-         do k=nz1-1,1,-1
-            pb(k,i)  = pb(k+1,i) + dzu(k+1)*gravity/(cp*.5*(tb(k,i)+tb(k+1,i))   &amp;
-                                           *.5*(zz(k,i)+zz(k+1,i)))
-            p (k,i)  = p (k+1,i) + dzu(k+1)*gravity/(cp*.5*(t (k,i)+t (k+1,i))   &amp;
-                                           *.5*(zz(k,i)+zz(k+1,i)))
-         end do
-         do k=1,nz1
-            rb (k,i) = pb(k,i)**(1./rcv)/((rgas/p0)*tb(k,i)*zz(k,i))
-            rtb(k,i) = rb(k,i)*tb(k,i)
-            rr (k,i) = p (k,i)**(1./rcv)/((rgas/p0)*t (k,i)*zz(k,i))-rb(k,i)
-            cqw(k,i) = 1.
-         end do
-      end do
-
-
-      write(0,*) ' base state sounding '
-      do k=1,grid%nVertLevels
-        write(0,*) ' k, pb,rb,tb,rtb,t,rr,p ', k,pb(k,1),rb(k,1),tb(k,1),rtb(k,1),t(k,1),rr(k,1),p(k,1)
-      end do
-
-!-------------------------------------------------------------------
-!     ITERATIONS TO CONVERGE MOIST SOUNDING
-!
-!      delt = -15.
-      delt = 0.
-      radx  = 10000.
-      radz  = 1500.
-      zcent = 1500.
-      xmid = 20000.
-      ymid = 20000.
-
-      do i = 1, grid % nCells
-        xloc = grid % xCell % array(i) - xmid
-        yloc = grid % yCell % array(i) - ymid
-          do k = 1,nz1
-            thi(k) = 0.
-            ztemp     = .5*(zgrid(k+1,i)+zgrid(k,i))
-            rad =sqrt((xloc/radx)**2+(yloc/radx)**2+((ztemp-zcent)/radz)**2)
-            if(rad.lt.1)  then
-               thi(k) = t(k,i) + delt*cos(.5*pii*rad)**2
-            end if
-         end do
-
-        do itr=1,30
-                
-          if(i.eq.1) then
-            pitop = 1.-.5*dzw(1)*gravity*(1.+qv(1,1))/(cp*t(1,1)*zz(1,1))
-            do k=2,nz1
-               pitop = pitop-dzu(k)*gravity/(cp*cqw(k,1)*.5*(t (k,1)+t (k-1,1)) &amp;
-                                                  *.5*(zz(k,1)+zz(k-1,1)))
-            end do
-            pitop = pitop - .5*dzw(nz1)*gravity*(1.+qv(nz1,1))/(cp*t(nz1,1)*zz(nz1,1))
-            ptop = p0*pitop**(1./rcp)
-            write(0,*) 'ptop  = ',.01*ptop
-          end if
-
-          pp(nz1,i) = ptop-ptopb+.5*dzw(nz1)*gravity*   &amp;
-                       (rr(nz1,i)+(rr(nz1,i)+rb(nz1,i))*qv(nz1,i))
-          do k=nz1-1,1,-1
-             pp(k,i) = pp(k+1,i)+.5*dzu(k+1)*gravity*                   &amp;
-                            (rr(k  ,i)+(rr(k  ,i)+rb(k  ,i))*qv(k  ,i)  &amp;
-                            +rr(k+1,i)+(rr(k+1,i)+rb(k+1,i))*qv(k+1,i))
-          end do
-          do k=1,nz1
-             rt(k,i) = (pp(k,i)/(r*zz(k,i))                   &amp;
-                     -rtb(k,i)*(p(k,i)-pb(k,i)))/p(k,i)       
-             p (k,i) = (zz(k,i)*(rgas/p0)*(rtb(k,i)+rt(k,i)))**rcv
-             rr(k,i) = (rt(k,i)-rb(k,i)*(t(k,i)-tb(k,i)))/t(k,i)
-          end do
-!
-!     update water vapor mixing ratio from humitidty profile
-!
-          do k=1,nz1
-             temp   = p(k,1)*thi(k)
-             pres   = p0*p(k,1)**(1./rcp)
-             qvs    = 380.*exp(17.27*(temp-273.)/(temp-36.))/pres
-             scalars(k,i,index_qv) = amin1(0.014,rh(k,1)*qvs)
-          end do
-                        
-          do k=1,nz1
-             t (k,i) = thi(k)*(1.+1.61*scalars(k,i,index_qv))
-          end do
-          do k=2,nz1
-             cqw(k,i) = 1./(1.+.5*( scalars(k  ,i,index_qv)  &amp;
-                                   +scalars(k-1,i,index_qv)))
-          end do
-        end do !  iteration loop
-      end do ! loop over cells
-!----------------------------------------------------------------------
-!
-      write(0,*) ' sounding for the simulation '
-      do k=1,nz1
-         write(6,10) .5*(zgrid(k,1)+zgrid(k+1,1))/1000.,                            &amp;
-                   .01*p0*p(k,1)**(1./rcp),t(k,1)/(1.+1.61*scalars(k,1,index_qv)),  &amp;
-                   1000.*scalars(k,1,index_qv),u(k,1)
-   10    format(1x,5f10.3)
-      end do
-                
-!
-      do i=1,grid % ncells
-         do k=1,nz1
-            rho(k,i) = rb(k,i)+rr(k,i)
-         end do
-      end do
-
-      do i=1,grid % nEdges
-        cell1 = grid % CellsOnEdge % array(1,i)
-        cell2 = grid % CellsOnEdge % array(2,i)
-        if(cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-          do k=1,nz1
-            ru (k,i)  = 0.5*(rho(k,cell1)+rho(k,cell2))*u(k,i)    
-          end do
-        end if
-      end do
-
-!
-!        CALCULATION OF OMEGA, RW = ZX * RU + ZZ * RW
-!
-!  we are assuming w and rw are zero for this initialization
-!  i.e., no terrain
-!
-       grid % rw % array = 0.
-
-!      DO I=1,NX
-!         IM1=I-1
-!         IF(IPER.EQ.1.AND.I.EQ.1) IM1=NX1
-!         RW(1 ,I) = 0.
-!         RW(NZ,I) = 0.
-!         DO K=2,NZ1
-!           RW(K ,I) = (FZM(K)*ZZ(K,I)+FZP(K)*ZZ(K-1,I))*(
-!     &amp;                -RDX*(RUZ(K,I  )*(ZUW(K,I  )-ZGRID(K,I))
-!     &amp;                     -RUZ(K,IM1)*(ZUW(K,IM1)-ZGRID(K,I))))
-!         END DO
-!         DO K=1,NZ
-!            RW1(K,I) = RW(K,I)
-!         END DO
-!      END DO
-
-
-      !
-      ! Generate rotated Coriolis field
-      !
-      do iEdge=1,grid % nEdges
-         grid % fEdge % array(iEdge) = 0.
-      end do
-
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 0.
-      end do
-
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      state % v % array(:,:) = 0.0
-      do iEdge = 1, grid%nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1, grid%nVertLevels
-                 state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-   end subroutine nhyd_test_case_squall_line
-
-   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
-   !   sphere with given radius.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
-
-      real (kind=RKIND) :: arg1
-
-      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
-                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
-      sphere_distance = 2.*radius*asin(arg1)
-
-   end function sphere_distance
-
-end module test_cases

Deleted: branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.100705
===================================================================
--- branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.100705        2010-07-12 19:38:09 UTC (rev 372)
+++ branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.100705        2010-07-13 21:27:45 UTC (rev 373)
@@ -1,1007 +0,0 @@
-module test_cases
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine setup_nhyd_test_case(domain)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Configure grid metadata and model state for the hydrostatic test case
-   !   specified in the namelist
-   !
-   ! Output: block - a subset (not necessarily proper) of the model domain to be
-   !                 initialized
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-
-      integer :: i
-      type (block_type), pointer :: block_ptr
-
-      if (config_test_case == 0) then
-         write(0,*) ' need nonhydrostatic test case configuration, error stop '
-         stop
-
-      else if ((config_test_case == 1) .or. (config_test_case == 2) .or. (config_test_case == 3)) then
-         write(0,*) ' Jablonowski and Williamson baroclinic wave test case '
-         if (config_test_case == 1) write(0,*) ' no initial perturbation '
-         if (config_test_case == 2) write(0,*) ' initial perturbation included '
-         if (config_test_case == 3) write(0,*) ' normal-mode perturbation included '
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            write(0,*) ' calling test case setup '
-            call nhyd_test_case_jw(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
-            write(0,*) ' returned from test case setup '
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 4 ) then
-
-         write(0,*) ' squall line - super cell test case '
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            write(0,*) ' calling test case setup '
-            call nhyd_test_case_squall_line(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
-            write(0,*) ' returned from test case setup '
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else
-
-         write(0,*) ' Only test case 1, 2, 3 and 4 are currently supported for nonhydrostatic core '
-         stop
-      end if
-
-   end subroutine setup_nhyd_test_case
-
-!----------------------------------------------------------------------------------------------------------
-
-   subroutine nhyd_test_case_jw(grid, state, test_case)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_meta), intent(inout) :: grid
-      type (grid_state), intent(inout) :: state
-      integer, intent(in) :: test_case
-
-      real (kind=RKIND), parameter :: u0 = 35.0
-      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
-      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
-      real (kind=RKIND), parameter :: t0b = 250., t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
-      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
-      real (kind=RKIND), parameter :: theta_c = pii/4.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
-      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
-
-      real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
-      real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx
-      real (kind=RKIND), dimension(:,:), pointer :: pressure, ppb, pb, rho, rb, rr, tb, rtb, p, pp, dss, t, rt
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp
-
-      !This is temporary variable here. It just need when calculate tangential velocity v.
-      integer :: eoe, j
-      integer, dimension(:), pointer :: nEdgesOnEdge 
-      integer, dimension(:,:), pointer :: edgesOnEdge
-      real, dimension(:,:), pointer :: weightsOnEdge
-
-      real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
-
-      real (kind=RKIND) :: ptop, p0, phi
-      real (kind=RKIND) :: lon_Edge
-
-      real (kind=RKIND) :: r_earth, etavs, ztemp, zd, zt, dz, gam, delt, str
-
-      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature, qv
-      real (kind=RKIND) :: ptmp, es, qvs, xnutr, znut, ptemp
-      integer :: iter
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: sh, zw, ah
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: zu, dzw, rdzwp, rdzwm
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: eta, etav, teta, ppi, tt
-
-      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3, cof1, cof2, psurf
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      
-      nz1 = grid % nVertLevels
-      nz = nz1 + 1
-
-      zgrid =&gt; grid % zgrid % array
-      rdzw =&gt; grid % rdzw % array
-      dzu =&gt; grid % dzu % array
-      rdzu =&gt; grid % rdzu % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zx =&gt; grid % zx % array
-      zz =&gt; grid % zz % array
-      hx =&gt; grid % hx % array
-      dss =&gt; grid % dss % array
-
-      pb =&gt; grid % exner_base % array
-      rb =&gt; grid % rho_base % array
-      tb =&gt; grid % theta_base % array
-      rtb =&gt; grid % rtheta_base % array
-      p =&gt; grid % exner % array
-
-      ppb =&gt; grid % pressure_base % array
-      pp =&gt; state % pressure % array
-
-      rho =&gt; state % rho % array
-      rr =&gt; state % rho_p % array
-      t =&gt; state % theta % array      
-      rt =&gt; grid % rtheta_p % array
-
-
-      scalars(:,:,:) = 0.
-
-      xnutr = 0.
-      zd = 12000.
-      znut = eta_t
-
-      etavs = (1.-0.252)*pii/2.
-      r_earth = a
-      p0 = 1.e+05
-
-      write(0,*) ' point 1 in test case setup '
-
-! We may pass in an hx(:,:) that has been precomputed elsewhere.
-! For now it is independent of k
-
-      do iCell=1,grid % nCells
-        do k=1,nz
-          phi = grid % latCell % array (iCell)
-          hx(k,iCell) = u0/gravity*cos(etavs)**1.5                                   &amp;
-                      *((-2.*sin(phi)**6                                   &amp;
-                            *(cos(phi)**2+1./3.)+10./63.)                  &amp;
-                            *(u0)*cos(etavs)**1.5                          &amp;
-                       +(1.6*cos(phi)**3                                   &amp;
-                            *(sin(phi)**2+2./3.)-pii/4.)*r_earth*omega_e)
-        enddo
-      enddo
-
-      !     metrics for hybrid coordinate and vertical stretching
-
-      str = 1.5
-      zt = 45000.
-      dz = zt/float(nz1)
-
-      write(0,*) ' hx computation complete '
-
-      do k=1,nz
-                
-!           sh(k) is the stretching specified for height surfaces
-
-            sh(k) = (real(k-1)*dz/zt)**str 
-                                
-!           to specify specific heights zc(k) for coordinate surfaces,
-!           input zc(k) and define sh(k) = zc(k)/zt
-!           zw(k) is the hieght of zeta surfaces
-!                zw(k) = (k-1)*dz yields constant dzeta
-!                        and nonconstant dzeta/dz
-!                zw(k) = sh(k)*zt yields nonconstant dzeta
-!                        and nearly constant dzeta/dz 
-
-            zw(k) = float(k-1)*dz
-!            zw(k) = sh(k)*zt
-!
-!           ah(k) governs the transition between terrain-following 
-!           and pureheight coordinates
-!                ah(k) = 0 is a terrain-following coordinate
-!                ah(k) = 1 is a height coordinate
- 
-            ah(k) = 1.-cos(.5*pii*(k-1)*dz/zt)**6
-!            ah(k) = 0.
-            write(0,*) ' k, sh, zw, ah ',k,sh(k),zw(k),ah(k)                        
-      end do
-      do k=1,nz1
-         dzw (k) = zw(k+1)-zw(k)
-         rdzw(k) = 1./dzw(k)
-         zu(k  ) = .5*(zw(k)+zw(k+1))
-      end do
-      do k=2,nz1
-         dzu (k)  = .5*(dzw(k)+dzw(k-1))
-         rdzu(k)  =  1./dzu(k)
-         fzp (k)  = .5* dzw(k  )/dzu(k)
-         fzm (k)  = .5* dzw(k-1)/dzu(k)
-         rdzwp(k) = dzw(k-1)/(dzw(k  )*(dzw(k)+dzw(k-1)))
-         rdzwm(k) = dzw(k  )/(dzw(k-1)*(dzw(k)+dzw(k-1)))
-      end do
-
-!**********  how are we storing cf1, cf2 and cf3?
-
-      COF1 = (2.*DZU(2)+DZU(3))/(DZU(2)+DZU(3))*DZW(1)/DZU(2) 
-      COF2 =     DZU(2)        /(DZU(2)+DZU(3))*DZW(1)/DZU(3) 
-      CF1  = FZP(2) + COF1
-      CF2  = FZM(2) - COF1 - COF2
-      CF3  = COF2       
-
-!      d1  = .5*dzw(1)
-!      d2  = dzw(1)+.5*dzw(2)
-!      d3  = dzw(1)+dzw(2)+.5*dzw(3)
-!      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-!      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-!      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-
-      write(0,*) ' cf1, cf2, cf3 = ',cf1,cf2,cf3
-
-      do iCell=1,grid % nCells
-        do k=1,nz        
-          zgrid(k,iCell) = (1.-ah(k))*(sh(k)*(zt-hx(k,iCell))+hx(k,iCell))  &amp;
-                         + ah(k) * sh(k)* zt        
-        end do
-        do k=1,nz1
-          zz (k,iCell) = (zw(k+1)-zw(k))/(zgrid(k+1,iCell)-zgrid(k,iCell))
-        end do
-      end do
-
-      do i=1, grid % nEdges
-        iCell1 = grid % CellsOnEdge % array(1,i)
-        iCell2 = grid % CellsOnEdge % array(2,i)
-        do k=1,nz
-          zx (k,i) = (zgrid(k,iCell2)-zgrid(k,iCell1)) / grid % dcEdge % array(i)
-        end do
-      end do
-      do i=1, grid % nCells
-        do k=1,nz1
-          ztemp = .5*(zgrid(k+1,i)+zgrid(k,i))
-          dss(k,i) = 0.
-          ztemp = zgrid(k,i)
-          if(ztemp.gt.zd+.1)  then
-             dss(k,i) = dss(k,i)+xnutr*sin(.5*pii*(ztemp-zd)/(zt-zd))**2
-          end if
-        end do
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zgrid(k,1),hx(k,1) ',k,zgrid(k,1),hx(k,1)
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zx(k,1) ',k,zx(k,1)
-      enddo
-
-      write(0,*) ' grid metrics setup complete '
-!
-!---- baroclinc wave initialization ---------------------------------
-!
-!     reference sounding based on dry isothermal atmosphere
-!
-      do i=1, grid % nCells
-        !write(0,*) ' thermodynamic setup, cell ',i
-        do k=1,nz1
-          ztemp    = .5*(zgrid(k+1,i)+zgrid(k,i))
-          ppb(k,i) = p0*exp(-gravity*ztemp/(rgas*t0b)) 
-          pb (k,i) = (ppb(k,i)/p0)**(rgas/cp)
-          rb (k,i) = ppb(k,i)/(rgas*t0b*zz(k,i))
-          tb (k,i) = t0b/pb(k,i)
-          rtb(k,i) = rb(k,i)*tb(k,i)
-          p  (k,i) = pb(k,i)
-          pp (k,i) = 0.
-          rr (k,i) = 0.
-        end do
-
-        if(i == 1) then
-          do k=1,nz1
-            write(0,*) ' k, ppb, pb, rb, tb (k,1) ',k,ppb(k,1),pb(k,1),rb(k,1)*zz(k,1),tb(k,1)
-          enddo
-        end if
-!
-!     iterations to converge temperature as a function of pressure
-!
-        do itr = 1,10
-
-          do k=1,nz1
-            eta (k) = (ppb(k,i)+pp(k,i))/p0
-            etav(k) = (eta(k)-.252)*pii/2.
-            if(eta(k).ge.znut)  then
-              teta(k) = t0*eta(k)**(rgas*dtdz/gravity)
-            else
-              teta(k) = t0*eta(k)**(rgas*dtdz/gravity) + delta_t*(znut-eta(k))**5
-            end if
-          end do
-          phi = grid % latCell % array (i)
-          do k=1,nz1
-            tt(k) = 0.
-            tt(k) = teta(k)+.75*eta(k)*pii*u0/rgas*sin(etav(k))      &amp;
-                            *sqrt(cos(etav(k)))*                   &amp;
-                              ((-2.*sin(phi)**6                    &amp;
-                                   *(cos(phi)**2+1./3.)+10./63.)   &amp;
-                                   *2.*u0*cos(etav(k))**1.5        &amp;
-                              +(1.6*cos(phi)**3                    &amp;
-                                *(sin(phi)**2+2./3.)-pii/4.)*r_earth*omega_e)
-
-
-            !write(0,*) ' k, tt(k) ',k,tt(k)
-            ztemp   = .5*(zgrid(k,i)+zgrid(k+1,i))
-            ptemp   = ppb(k,i) + pp(k,i)
-!            qv(k,i) = env_qv( ztemp, tt(k), ptemp, 0 )
-            qv(k,i) = 0.
-
-          end do
-!          do k=2,nz1
-!            cqw(k,i) = 1./(1.+.5*(qv(k,i)+qv(k-1,i)))
-!          end do
-                
-          do itrp = 1,25
-            do k=1,nz1                                
-              rr(k,i)  = (pp(k,i)/(rgas*zz(k,i))  &amp;
-                          -rb(k,i)*(tt(k)-t0b))/tt(k)
-            end do
-
-            ppi(1) = p0-.5*dzw(1)*gravity                         &amp;
-                          *(1.25*(rr(1,i)+rb(1,i))*(1.+qv(1,i))   &amp;
-                            -.25*(rr(2,i)+rb(2,i))*(1.+qv(2,i)))
-
-            ppi(1) = ppi(1)-ppb(1,i)
-            do k=1,nz1-1
-              ppi(k+1) = ppi(k)-.5*dzu(k+1)*gravity*                     &amp;
-                            (rr(k  ,i)+(rr(k  ,i)+rb(k  ,i))*qv(k  ,i)   &amp;
-                            +rr(k+1,i)+(rr(k+1,i)+rb(k+1,i))*qv(k+1,i))
-            end do
-
-            do k=1,nz1
-              pp(k,i) = .2*ppi(k)+.8*pp(k,i)
-            end do
-
-          end do  ! end inner iteration loop itrp
-
-        end do  ! end outer iteration loop itr
-
-        do k=1,nz1        
-          p (k,i) = ((ppb(k,i)+pp(k,i))/p0)**(rgas/cp)
-          t (k,i) = tt(k)/p(k,i)
-          rt (k,i) = t(k,i)*rr(k,i)+rb(k,i)*(t(k,i)-tb(k,i))
-          rho (k,i) = rb(k,i) + rr(k,i)
-        end do
-
-        if(i == 1) then
-          do k=1,nz1
-            write(0,*) ' k, p, t, rt ',k,p(k,1),t(k,1),rt(k,1)
-          enddo
-        end if
-
-      end do  ! end loop over cells
-
-      lat_pert = latitude_pert*pii/180.
-      lon_pert = longitude_pert*pii/180.
-
-      do iEdge=1,grid % nEdges
-
-         vtx1 = grid % VerticesOnEdge % array (1,iEdge)
-         vtx2 = grid % VerticesOnEdge % array (2,iEdge)
-         lat1 = grid%latVertex%array(vtx1)
-         lat2 = grid%latVertex%array(vtx2)
-         iCell1 = grid % cellsOnEdge % array(1,iEdge)
-         iCell2 = grid % cellsOnEdge % array(2,iEdge)
-         flux = (0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-
-         if (config_test_case == 2) then
-            r_pert = sphere_distance( grid % latEdge % array (iEdge), grid % lonEdge % array (iEdge), &amp;
-                                      lat_pert, lon_pert, 1.)/(pert_radius)
-            u_pert = u_perturbation*exp(-r_pert**2)*(lat2-lat1)*a/grid % dvEdge % array(iEdge)
-
-         else if (config_test_case == 3) then
-            lon_Edge = grid % lonEdge % array(iEdge)
-            u_pert = u_perturbation*cos(k_x*(lon_Edge - lon_pert)) &amp;
-                         *(0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-         else
-            u_pert = 0.0
-         end if
-
-
-         do k=1,grid % nVertLevels
-!!           etavs = (0.5*(ppb(k,iCell1)+ppb(k,iCell2)+pp(k,iCell1)+pp(k,iCell2))/p0 - 0.252)*pii/2.
-!           etavs = (0.5*(ppb(k,1)+ppb(k,1)+pp(k,1)+pp(k,1))/p0 - 0.252)*pii/2.
-           etavs = (0.5*(ppb(k,440)+ppb(k,440)+pp(k,440)+pp(k,440))/p0 - 0.252)*pii/2.  ! 10262 mesh
-!           etavs = (0.5*(ppb(k,505)+ppb(k,505)+pp(k,505)+pp(k,505))/p0 - 0.252)*pii/2.  ! 40962 mesh
-  
-           fluxk = u0*flux*(cos(etavs)**1.5)
-!!           fluxk = u0*flux*(cos(znuv(k))**(1.5))
-!!           fluxk = u0 * cos(grid % angleEdge % array(iEdge)) * (sin(lat1+lat2)**2) *(cos(etavs)**1.5)
-           state % u % array(k,iEdge) = fluxk + u_pert
-         end do
-
-      !
-      ! Generate rotated Coriolis field
-      !
-
-         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
-                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha_grid) + &amp;
-                                         sin(grid%latEdge%array(iEdge)) * cos(alpha_grid) &amp;
-                                       )
-      end do
-
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
-                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha_grid) + &amp;
-                                          sin(grid%latVertex%array(iVtx)) * cos(alpha_grid) &amp;
-                                         )
-      end do
-
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      state % v % array(:,:) = 0.0
-      do iEdge = 1, grid%nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1, grid%nVertLevels
-                 state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-      do i=1,10
-        psurf = (cf1*(ppb(1,i)+pp(1,i)) + cf2*(ppb(2,i)+pp(2,i)) + cf3*(ppb(3,i)+pp(3,i)))/100.
-
-            psurf = (ppb(1,i)+pp(1,i)) + .5*dzw(1)*gravity        &amp;
-                          *(1.25*(rr(1,i)+rb(1,i))*(1.+qv(1,i))   &amp;
-                            -.25*(rr(2,i)+rb(2,i))*(1.+qv(2,i)))
-
-        write(0,*) ' i, psurf, lat ',i,psurf,grid%latCell%array(i)*180./3.1415828
-      enddo
-!      stop
-
-   end subroutine nhyd_test_case_jw
-
-!----------------------------------------------------------------------------------------------------------
-
-   subroutine nhyd_test_case_squall_line(grid, state, test_case)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup squall line and supercell test case
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_meta), intent(inout) :: grid
-      type (grid_state), intent(inout) :: state
-      integer, intent(in) :: test_case
-
-      real (kind=RKIND), parameter :: u0 = 35.0
-      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
-      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
-      real (kind=RKIND), parameter :: t0b = 250., t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
-      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
-      real (kind=RKIND), parameter :: theta_c = pii/4.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
-      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
-
-      real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
-      real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx, cqw
-      real (kind=RKIND), dimension(:,:), pointer :: ppb, pb, rho, rb, rr, tb, rtb, p, pp, dss, t, rt, u, ru
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp, cell1, cell2, nCellsSolve
-
-      !This is temporary variable here. It just need when calculate tangential velocity v.
-      integer :: eoe, j
-      integer, dimension(:), pointer :: nEdgesOnEdge 
-      integer, dimension(:,:), pointer :: edgesOnEdge
-      real, dimension(:,:), pointer :: weightsOnEdge
-
-      real (kind=RKIND) :: flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
-
-      real (kind=RKIND) :: ptop, p0, phi
-      real (kind=RKIND) :: lon_Edge
-
-      real (kind=RKIND) :: r_earth, etavs, ztemp, zd, zt, dz, gam, str
-
-      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature, rh, thi
-      real (kind=RKIND) :: ptmp, es, qvs, xnutr, znut, ptemp
-      integer :: iter
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: zc, zw, ah
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: zu, dzw, rdzwp, rdzwm
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: eta, etav, teta, ppi, tt
-
-      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3
-      real (kind=RKIND) :: ztr, thetar, ttr, thetas, um, us, zts, pitop, ptopb, rcp, rcv
-      real (kind=RKIND) :: radx, radz, zcent, xmid, delt, xloc, rad, temp, pres, yloc, ymid, a_scale
-
-      !
-      ! Scale all distances
-      !
-
-      a_scale = 1.0
-
-      grid % xCell % array = grid % xCell % array * a_scale
-      grid % yCell % array = grid % yCell % array * a_scale
-      grid % zCell % array = grid % zCell % array * a_scale
-      grid % xVertex % array = grid % xVertex % array * a_scale
-      grid % yVertex % array = grid % yVertex % array * a_scale
-      grid % zVertex % array = grid % zVertex % array * a_scale
-      grid % xEdge % array = grid % xEdge % array * a_scale
-      grid % yEdge % array = grid % yEdge % array * a_scale
-      grid % zEdge % array = grid % zEdge % array * a_scale
-      grid % dvEdge % array = grid % dvEdge % array * a_scale
-      grid % dcEdge % array = grid % dcEdge % array * a_scale
-      grid % areaCell % array = grid % areaCell % array * a_scale**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a_scale**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a_scale**2.0
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      
-      nz1 = grid % nVertLevels
-      nz = nz1 + 1
-      nCellsSolve = grid % nCellsSolve
-
-      zgrid =&gt; grid % zgrid % array
-      rdzw =&gt; grid % rdzw % array
-      dzu =&gt; grid % dzu % array
-      rdzu =&gt; grid % rdzu % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zx =&gt; grid % zx % array
-      zz =&gt; grid % zz % array
-      hx =&gt; grid % hx % array
-      dss =&gt; grid % dss % array
-
-      ppb =&gt; grid % pressure_base % array
-      pb =&gt; grid % exner_base % array
-      rb =&gt; grid % rho_base % array
-      tb =&gt; grid % theta_base % array
-      rtb =&gt; grid % rtheta_base % array
-      p =&gt; grid % exner % array
-      cqw =&gt; grid % cqw % array
-
-      rho =&gt; state % rho % array
-
-      pp =&gt; state % pressure % array
-      rr =&gt; state % rho_p % array
-      t =&gt; state % theta % array      
-      rt =&gt; grid % rtheta_p % array
-      u =&gt; state % u % array
-      ru =&gt; grid % ru % array
-
-      scalars =&gt; state % scalars % array
-
-      scalars(:,:,:) = 0.
-
-      xnutr = 0.
-      zd = 12000.
-      znut = eta_t
-
-      etavs = (1.-0.252)*pii/2.
-      r_earth = a
-      p0 = 1.e+05
-      rcp = rgas/cp
-      rcv = rgas/(cp-rgas)
-
-     write(0,*) ' point 1 in test case setup '
-
-! We may pass in an hx(:,:) that has been precomputed elsewhere.
-! For now it is independent of k
-
-      do iCell=1,grid % nCells
-        do k=1,nz
-          hx(k,iCell) = 0.  ! squall line or supercell on flat plane
-        enddo
-      enddo
-
-      !     metrics for hybrid coordinate and vertical stretching
-
-      str = 1.0
-      zt = 20000.
-      dz = zt/float(nz1)
-
-      write(0,*) ' dz = ',dz
-      write(0,*) ' hx computation complete '
-
-      do k=1,nz
-                
-!           sh(k) is the stretching specified for height surfaces
-
-            zc(k) = zt*(real(k-1)*dz/zt)**str 
-                                
-!           to specify specific heights zc(k) for coordinate surfaces,
-!           input zc(k) 
-!           zw(k) is the hieght of zeta surfaces
-!                zw(k) = (k-1)*dz yields constant dzeta
-!                        and nonconstant dzeta/dz
-!                zw(k) = sh(k)*zt yields nonconstant dzeta
-!                        and nearly constant dzeta/dz 
-
-!            zw(k) = float(k-1)*dz
-            zw(k) = zc(k)
-!
-!           ah(k) governs the transition between terrain-following 
-!           and pureheight coordinates
-!                ah(k) = 0 is a terrain-following coordinate
-!                ah(k) = 1 is a height coordinate
- 
-!            ah(k) = 1.-cos(.5*pii*(k-1)*dz/zt)**6
-            ah(k) = 1.
-            write(0,*) ' k, zc, zw, ah ',k,zc(k),zw(k),ah(k)                        
-      end do
-      do k=1,nz1
-         dzw (k) = zw(k+1)-zw(k)
-         rdzw(k) = 1./dzw(k)
-         zu(k  ) = .5*(zw(k)+zw(k+1))
-      end do
-      do k=2,nz1
-         dzu (k)  = .5*(dzw(k)+dzw(k-1))
-         rdzu(k)  =  1./dzu(k)
-         fzp (k)  = .5* dzw(k  )/dzu(k)
-         fzm (k)  = .5* dzw(k-1)/dzu(k)
-         rdzwp(k) = dzw(k-1)/(dzw(k  )*(dzw(k)+dzw(k-1)))
-         rdzwm(k) = dzw(k  )/(dzw(k-1)*(dzw(k)+dzw(k-1)))
-      end do
-
-!**********  how are we storing cf1, cf2 and cf3?
-
-      d1  = .5*dzw(1)
-      d2  = dzw(1)+.5*dzw(2)
-      d3  = dzw(1)+dzw(2)+.5*dzw(3)
-      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-
-      do iCell=1,grid % nCells
-        do k=1,nz        
-            zgrid(k,iCell) = ah(k)*(zc(k)*(1.-hx(k,iCell)/zt)+hx(k,iCell)) &amp;
-                           + (1.-ah(k)) * zc(k)        
-        end do
-        do k=1,nz1
-          zz (k,iCell) = (zw(k+1)-zw(k))/(zgrid(k+1,iCell)-zgrid(k,iCell))
-        end do
-      end do
-
-      do i=1, grid % nEdges
-        iCell1 = grid % CellsOnEdge % array(1,i)
-        iCell2 = grid % CellsOnEdge % array(2,i)
-        do k=1,nz
-          zx (k,i) = (zgrid(k,iCell2)-zgrid(k,iCell1)) / grid % dcEdge % array(i)
-        end do
-      end do
-      do i=1, grid % nCells
-        do k=1,nz1
-          ztemp = .5*(zgrid(k+1,i)+zgrid(k,i))
-          dss(k,i) = 0.
-          ztemp = zgrid(k,i)
-          if(ztemp.gt.zd+.1)  then
-             dss(k,i) = dss(k,i)+xnutr*sin(.5*pii*(ztemp-zd)/(zt-zd))**2
-          end if
-        end do
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zgrid(k,1),hx(k,1) ',k,zgrid(k,1),hx(k,1)
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zx(k,1) ',k,zx(k,1)
-      enddo
-
-      write(0,*) ' grid metrics setup complete '
-!
-! convective initialization
-!
-         ztr    = 12000.
-         thetar = 343.
-         ttr    = 213.
-         thetas = 300.5
-
-         write(0,*) ' rgas, cp, gravity ',rgas,cp, gravity
-
-!  no flow
-!         um = 0.
-!         us = 0.
-!         zts = 5000.
-!  supercell parameters
-         um = 30.
-         us = 15.
-         zts = 5000.
-!  squall-line parameters
-         um = 12.
-         us = 10.
-         zts = 2500.
-
-
-         do i=1,grid % nCells
-            do k=1,nz1
-               ztemp = .5*(zgrid(k,i)+zgrid(k+1,i))
-               if(ztemp .gt. ztr) then
-                  t (k,i) = thetar*exp(9.8*(ztemp-ztr)/(1003.*ttr))
-                  rh(k,i) = 0.25
-               else
-                  t (k,i) = 300.+43.*(ztemp/ztr)**1.25
-                  rh(k,i) = (1.-0.75*(ztemp/ztr)**1.25)
-                  if(t(k,i).lt.thetas) t(k,i) = thetas
-               end if
-               tb(k,i) = t(k,i)
-            end do
-         end do
-
-!         rh(:,:) = 0.
-
-!  set the velocity field - we are on a plane here.
-
-         do i=1, grid % nEdges
-            cell1 = grid % CellsOnEdge % array(1,i)
-            cell2 = grid % CellsOnEdge % array(2,i)
-            if(cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-            do k=1,nz1
-               ztemp = .25*( zgrid(k,cell1 )+zgrid(k+1,cell1 )  &amp;
-                            +zgrid(k,cell2)+zgrid(k+1,cell2))
-               if(ztemp.lt.zts)  then
-                  u(k,i) = um*ztemp/zts
-               else
-                  u(k,i) = um
-               end if
-               if(i == 1 ) grid % u_init % array(k) = u(k,i) - us
-               u(k,i) = cos(grid % angleEdge % array(i)) * (u(k,i) - us)
-            end do
-            end if
-         end do
-!
-!     reference sounding based on dry atmosphere
-!
-      pitop = 1.-.5*dzw(1)*gravity/(cp*tb(1,1)*zz(1,1))
-      do k=2,nz1
-         pitop = pitop-dzu(k)*gravity/(cp*.5*(tb(k,1)+tb(k-1,1))   &amp;
-                                   *.5*(zz(k,1)+zz(k-1,1)))
-          
-         write(0,*) k,pitop,tb(k,1),dzu(k),tb(k,1)
-      end do
-      pitop = pitop-.5*dzw(nz1)*gravity/(cp*tb(nz1,1)*zz(nz1,1))
-
-      ptopb = p0*pitop**(1./rcp)
-      write(6,*) 'ptopb = ',.01*ptopb
-                
-      do i=1, grid % nCells
-         pb(nz1,i) = pitop+.5*dzw(nz1)*gravity/(cp*tb(nz1,i)*zz(nz1,i))
-         p (nz1,i) = pitop+.5*dzw(nz1)*gravity/(cp*t (nz1,i)*zz(nz1,i))
-         do k=nz1-1,1,-1
-            pb(k,i)  = pb(k+1,i) + dzu(k+1)*gravity/(cp*.5*(tb(k,i)+tb(k+1,i))   &amp;
-                                           *.5*(zz(k,i)+zz(k+1,i)))
-            p (k,i)  = p (k+1,i) + dzu(k+1)*gravity/(cp*.5*(t (k,i)+t (k+1,i))   &amp;
-                                           *.5*(zz(k,i)+zz(k+1,i)))
-         end do
-         do k=1,nz1
-            rb (k,i) = pb(k,i)**(1./rcv)/((rgas/p0)*tb(k,i)*zz(k,i))
-            rtb(k,i) = rb(k,i)*tb(k,i)
-            rr (k,i) = p (k,i)**(1./rcv)/((rgas/p0)*t (k,i)*zz(k,i))-rb(k,i)
-            cqw(k,i) = 1.
-         end do
-      end do
-
-      write(0,*) ' base state sounding '
-      do k=1,grid%nVertLevels
-        write(0,*) ' k, pb,rb,tb,rtb,t,rr,p ', k,pb(k,1),rb(k,1),tb(k,1),rtb(k,1),t(k,1),rr(k,1),p(k,1)
-      end do
-
-!-------------------------------------------------------------------
-!     ITERATIONS TO CONVERGE MOIST SOUNDING
-!
-!      delt = -10.
-!      delt = -0.01
-      delt = 3.
-      radx  = 10000.
-      radz  = 1500.
-      zcent = 1500.
-      xmid = 150000.
-      ymid = 50000.*cos(pii/6.)
-
-      do i=1, grid % nCells
-        xloc = grid % xCell % array(i) - xmid
-        yloc = grid % yCell % array(i) - ymid
-        yloc = 0.
-!        xloc = 0.
-        do k = 1,nz1
-          thi(k,i) = t(k,i)
-          ztemp     = .5*(zgrid(k+1,i)+zgrid(k,i))
-          rad =sqrt((xloc/radx)**2+(yloc/radx)**2+((ztemp-zcent)/radz)**2)
-          if(rad.lt.1)  then
-            thi(k,i) = t(k,i) + delt*cos(.5*pii*rad)**2
-          end if
-        end do
-      end do
-
-      do itr=1,30
-        pitop = 1.-.5*dzw(1)*gravity*(1.+scalars(index_qv,1,1))/(cp*t(1,1)*zz(1,1))
-        do k=2,nz1
-          pitop = pitop-dzu(k)*gravity/(cp*cqw(k,1)*.5*(t (k,1)+t (k-1,1)) &amp;
-                                                  *.5*(zz(k,1)+zz(k-1,1)))
-        end do
-        pitop = pitop - .5*dzw(nz1)*gravity*(1.+scalars(index_qv,nz1,1))/(cp*t(nz1,1)*zz(nz1,1))
-        ptop = p0*pitop**(1./rcp)
-        write(0,*) 'ptop  = ',.01*ptop
-
-      do i = 1, grid % nCells
-
-          pp(nz1,i) = ptop-ptopb+.5*dzw(nz1)*gravity*   &amp;
-                       (rr(nz1,i)+(rr(nz1,i)+rb(nz1,i))*scalars(index_qv,nz1,i))
-          do k=nz1-1,1,-1
-             pp(k,i) = pp(k+1,i)+.5*dzu(k+1)*gravity*                   &amp;
-                            (rr(k  ,i)+(rr(k  ,i)+rb(k  ,i))*scalars(index_qv,k  ,i)  &amp;
-                            +rr(k+1,i)+(rr(k+1,i)+rb(k+1,i))*scalars(index_qv,k+1,i))
-          end do
-          do k=1,nz1
-             rt(k,i) = (pp(k,i)/(rgas*zz(k,i))                   &amp;
-                     -rtb(k,i)*(p(k,i)-pb(k,i)))/p(k,i)       
-             p (k,i) = (zz(k,i)*(rgas/p0)*(rtb(k,i)+rt(k,i)))**rcv
-             rr(k,i) = (rt(k,i)-rb(k,i)*(t(k,i)-tb(k,i)))/t(k,i)
-          end do
-!
-!     update water vapor mixing ratio from humitidty profile
-!
-          do k=1,nz1
-             temp   = p(k,i)*thi(k,i)
-             pres   = p0*p(k,i)**(1./rcp)
-             qvs    = 380.*exp(17.27*(temp-273.)/(temp-36.))/pres
-             scalars(index_qv,k,i) = amin1(0.014,rh(k,i)*qvs)
-          end do
-                        
-          do k=1,nz1
-             t (k,i) = thi(k,i)*(1.+1.61*scalars(index_qv,k,i))
-          end do
-          do k=2,nz1
-             cqw(k,i) = 1./(1.+.5*( scalars(index_qv,k-1,i)  &amp;
-                                   +scalars(index_qv,k  ,i)))
-          end do
-        end do !  iteration loop
-
-      end do ! loop over cells
-!----------------------------------------------------------------------
-!
-      write(0,*) ' sounding for the simulation '
-      do k=1,nz1
-         write(6,10) .5*(zgrid(k,1)+zgrid(k+1,1))/1000.,                            &amp;
-                   .01*p0*p(k,1)**(1./rcp),t(k,1)/(1.+1.61*scalars(index_qv,k,1)),  &amp;
-                   1000.*scalars(index_qv,k,1),u(k,1)
-   10    format(1x,5f10.3)
-
-        grid % t_init % array(k) = t(k,1)
-        grid % qv_init % array(k) = scalars(index_qv,k,1)
-
-      end do
-                
-!
-      do i=1,grid % ncells
-         do k=1,nz1
-            rho(k,i) = rb(k,i)+rr(k,i)
-         end do
-      end do
-
-      do i=1,grid % nEdges
-        cell1 = grid % CellsOnEdge % array(1,i)
-        cell2 = grid % CellsOnEdge % array(2,i)
-        if(cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-          do k=1,nz1
-            ru (k,i)  = 0.5*(rho(k,cell1)+rho(k,cell2))*u(k,i)    
-          end do
-        end if
-      end do
-
-!
-!        CALCULATION OF OMEGA, RW = ZX * RU + ZZ * RW
-!
-!  we are assuming w and rw are zero for this initialization
-!  i.e., no terrain
-!
-       grid % rw % array = 0.
-       state % w % array = 0.
-
-!      DO I=1,NX
-!         IM1=I-1
-!         IF(IPER.EQ.1.AND.I.EQ.1) IM1=NX1
-!         RW(1 ,I) = 0.
-!         RW(NZ,I) = 0.
-!         DO K=2,NZ1
-!           RW(K ,I) = (FZM(K)*ZZ(K,I)+FZP(K)*ZZ(K-1,I))*(
-!     &amp;                -RDX*(RUZ(K,I  )*(ZUW(K,I  )-ZGRID(K,I))
-!     &amp;                     -RUZ(K,IM1)*(ZUW(K,IM1)-ZGRID(K,I))))
-!         END DO
-!         DO K=1,NZ
-!            RW1(K,I) = RW(K,I)
-!         END DO
-!      END DO
-
-
-      !
-      ! Generate rotated Coriolis field
-      !
-      do iEdge=1,grid % nEdges
-         grid % fEdge % array(iEdge) = 0.
-      end do
-
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 0.
-      end do
-
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      state % v % array(:,:) = 0.0
-      do iEdge = 1, grid%nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1, grid%nVertLevels
-                 state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-!      do iCell = 1, grid % nCells
-!        rt(5,iCell) = rt(5,iCell) + .1
-!      enddo
-
-
-      do k=1,grid%nVertLevels
-        write(0,*) ' k,u_init, t_init, qv_init ',k,grid % u_init % array(k),grid % t_init% array(k),grid % qv_init % array(k)
-      end do
-
-   end subroutine nhyd_test_case_squall_line
-
-   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
-   !   sphere with given radius.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
-
-      real (kind=RKIND) :: arg1
-
-      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
-                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
-      sphere_distance = 2.*radius*asin(arg1)
-
-   end function sphere_distance
-
-end module test_cases

Deleted: branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.ok
===================================================================
--- branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.ok        2010-07-12 19:38:09 UTC (rev 372)
+++ branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.ok        2010-07-13 21:27:45 UTC (rev 373)
@@ -1,966 +0,0 @@
-module test_cases
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine setup_nhyd_test_case(domain)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Configure grid metadata and model state for the hydrostatic test case
-   !   specified in the namelist
-   !
-   ! Output: block - a subset (not necessarily proper) of the model domain to be
-   !                 initialized
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-
-      integer :: i
-      type (block_type), pointer :: block_ptr
-
-      if (config_test_case == 0) then
-         write(0,*) ' need nonhydrostatic test case configuration, error stop '
-         stop
-
-      else if ((config_test_case == 1) .or. (config_test_case == 2) .or. (config_test_case == 3)) then
-         write(0,*) ' Jablonowski and Williamson baroclinic wave test case '
-         if (config_test_case == 1) write(0,*) ' no initial perturbation '
-         if (config_test_case == 2) write(0,*) ' initial perturbation included '
-         if (config_test_case == 3) write(0,*) ' normal-mode perturbation included '
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            write(0,*) ' calling test case setup '
-            call nhyd_test_case_jw(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
-            write(0,*) ' returned from test case setup '
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 4 ) then
-
-         write(0,*) ' squall line - super cell test case '
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            write(0,*) ' calling test case setup '
-            call nhyd_test_case_squall_line(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
-            write(0,*) ' returned from test case setup '
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else
-
-         write(0,*) ' Only test case 1, 2, 3 and 4 are currently supported for nonhydrostatic core '
-         stop
-      end if
-
-   end subroutine setup_nhyd_test_case
-
-!----------------------------------------------------------------------------------------------------------
-
-   subroutine nhyd_test_case_jw(grid, state, test_case)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_meta), intent(inout) :: grid
-      type (grid_state), intent(inout) :: state
-      integer, intent(in) :: test_case
-
-      real (kind=RKIND), parameter :: u0 = 35.0
-      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
-      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
-      real (kind=RKIND), parameter :: t0b = 250., t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
-      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
-      real (kind=RKIND), parameter :: theta_c = pii/4.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
-      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
-
-      real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
-      real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx
-      real (kind=RKIND), dimension(:,:), pointer :: pressure, ppb, pb, rho, rb, rr, tb, rtb, p, pp, dss, t, rt
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp
-
-      !This is temporary variable here. It just need when calculate tangential velocity v.
-      integer :: eoe, j
-      integer, dimension(:), pointer :: nEdgesOnEdge 
-      integer, dimension(:,:), pointer :: edgesOnEdge
-      real, dimension(:,:), pointer :: weightsOnEdge
-
-      real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
-
-      real (kind=RKIND) :: ptop, p0, phi
-      real (kind=RKIND) :: lon_Edge
-
-      real (kind=RKIND) :: r_earth, etavs, ztemp, zd, zt, dz, gam, delt, str
-
-      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature, qv
-      real (kind=RKIND) :: ptmp, es, qvs, xnutr, znut, ptemp
-      integer :: iter
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: sh, zw, ah
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: zu, dzw, rdzwp, rdzwm
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: eta, etav, teta, ppi, tt
-
-      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      
-      nz1 = grid % nVertLevels
-      nz = nz1 + 1
-
-      zgrid =&gt; grid % zgrid % array
-      rdzw =&gt; grid % rdzw % array
-      dzu =&gt; grid % dzu % array
-      rdzu =&gt; grid % rdzu % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zx =&gt; grid % zx % array
-      zz =&gt; grid % zz % array
-      hx =&gt; grid % hx % array
-      dss =&gt; grid % dss % array
-
-      pb =&gt; grid % exner_base % array
-      rb =&gt; grid % rho_base % array
-      tb =&gt; grid % theta_base % array
-      rtb =&gt; grid % rtheta_base % array
-      p =&gt; grid % exner % array
-
-      ppb =&gt; grid % pressure_base % array
-      pp =&gt; state % pressure % array
-
-      rho =&gt; state % rho % array
-      rr =&gt; state % rho_p % array
-      t =&gt; state % theta % array      
-      rt =&gt; grid % rtheta_p % array
-
-
-      scalars(:,:,:) = 0.
-
-      xnutr = 0.
-      zd = 12000.
-      znut = eta_t
-
-      etavs = (1.-0.252)*pii/2.
-      r_earth = a
-      p0 = 1.e+05
-
-      write(0,*) ' point 1 in test case setup '
-
-! We may pass in an hx(:,:) that has been precomputed elsewhere.
-! For now it is independent of k
-
-      do iCell=1,grid % nCells
-        do k=1,nz
-          phi = grid % latCell % array (iCell)
-          hx(k,iCell) = u0/gravity*cos(etavs)**1.5                                   &amp;
-                      *((-2.*sin(phi)**6                                   &amp;
-                            *(cos(phi)**2+1./3.)+10./63.)                  &amp;
-                            *(u0)*cos(etavs)**1.5                          &amp;
-                       +(1.6*cos(phi)**3                                   &amp;
-                            *(sin(phi)**2+2./3.)-pii/4.)*r_earth*omega_e)
-        enddo
-      enddo
-
-      !     metrics for hybrid coordinate and vertical stretching
-
-      str = 1.5
-      zt = 45000.
-      dz = zt/float(nz1)
-
-      write(0,*) ' hx computation complete '
-
-      do k=1,nz
-                
-!           sh(k) is the stretching specified for height surfaces
-
-            sh(k) = (real(k-1)*dz/zt)**str 
-                                
-!           to specify specific heights zc(k) for coordinate surfaces,
-!           input zc(k) and define sh(k) = zc(k)/zt
-!           zw(k) is the hieght of zeta surfaces
-!                zw(k) = (k-1)*dz yields constant dzeta
-!                        and nonconstant dzeta/dz
-!                zw(k) = sh(k)*zt yields nonconstant dzeta
-!                        and nearly constant dzeta/dz 
-
-            zw(k) = float(k-1)*dz
-!            zw(k) = sh(k)*zt
-!
-!           ah(k) governs the transition between terrain-following 
-!           and pureheight coordinates
-!                ah(k) = 0 is a terrain-following coordinate
-!                ah(k) = 1 is a height coordinate
- 
-            ah(k) = 1.-cos(.5*pii*(k-1)*dz/zt)**6
-!            ah(k) = 0.
-            write(0,*) ' k, sh, zw, ah ',k,sh(k),zw(k),ah(k)                        
-      end do
-      do k=1,nz1
-         dzw (k) = zw(k+1)-zw(k)
-         rdzw(k) = 1./dzw(k)
-         zu(k  ) = .5*(zw(k)+zw(k+1))
-      end do
-      do k=2,nz1
-         dzu (k)  = .5*(dzw(k)+dzw(k-1))
-         rdzu(k)  =  1./dzu(k)
-         fzp (k)  = .5* dzw(k  )/dzu(k)
-         fzm (k)  = .5* dzw(k-1)/dzu(k)
-         rdzwp(k) = dzw(k-1)/(dzw(k  )*(dzw(k)+dzw(k-1)))
-         rdzwm(k) = dzw(k  )/(dzw(k-1)*(dzw(k)+dzw(k-1)))
-      end do
-
-!**********  how are we storing cf1, cf2 and cf3?
-
-      d1  = .5*dzw(1)
-      d2  = dzw(1)+.5*dzw(2)
-      d3  = dzw(1)+dzw(2)+.5*dzw(3)
-      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-
-      do iCell=1,grid % nCells
-        do k=1,nz        
-          zgrid(k,iCell) = (1.-ah(k))*(sh(k)*(zt-hx(k,iCell))+hx(k,iCell))  &amp;
-                         + ah(k) * sh(k)* zt        
-        end do
-        do k=1,nz1
-          zz (k,iCell) = (zw(k+1)-zw(k))/(zgrid(k+1,iCell)-zgrid(k,iCell))
-        end do
-      end do
-
-      do i=1, grid % nEdges
-        iCell1 = grid % CellsOnEdge % array(1,i)
-        iCell2 = grid % CellsOnEdge % array(2,i)
-        do k=1,nz
-          zx (k,i) = (zgrid(k,iCell2)-zgrid(k,iCell1)) / grid % dcEdge % array(i)
-        end do
-      end do
-      do i=1, grid % nCells
-        do k=1,nz1
-          ztemp = .5*(zgrid(k+1,i)+zgrid(k,i))
-          dss(k,i) = 0.
-          ztemp = zgrid(k,i)
-          if(ztemp.gt.zd+.1)  then
-             dss(k,i) = dss(k,i)+xnutr*sin(.5*pii*(ztemp-zd)/(zt-zd))**2
-          end if
-        end do
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zgrid(k,1),hx(k,1) ',k,zgrid(k,1),hx(k,1)
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zx(k,1) ',k,zx(k,1)
-      enddo
-
-      write(0,*) ' grid metrics setup complete '
-!
-!---- baroclinc wave initialization ---------------------------------
-!
-!     reference sounding based on dry isothermal atmosphere
-!
-      do i=1, grid % nCells
-        !write(0,*) ' thermodynamic setup, cell ',i
-        do k=1,nz1
-          ztemp    = .5*(zgrid(k+1,i)+zgrid(k,i))
-          ppb(k,i) = p0*exp(-gravity*ztemp/(rgas*t0b)) 
-          pb (k,i) = (ppb(k,i)/p0)**(rgas/cp)
-          rb (k,i) = ppb(k,i)/(rgas*t0b*zz(k,i))
-          tb (k,i) = t0b/pb(k,i)
-          rtb(k,i) = rb(k,i)*tb(k,i)
-          p  (k,i) = pb(k,i)
-          pp (k,i) = 0.
-          rr (k,i) = 0.
-        end do
-
-        if(i == 1) then
-          do k=1,nz1
-            write(0,*) ' k, ppb, pb, rb, tb (k,1) ',k,ppb(k,1),pb(k,1),rb(k,1)*zz(k,1),tb(k,1)
-          enddo
-        end if
-!
-!     iterations to converge temperature as a function of pressure
-!
-        do itr = 1,10
-
-          do k=1,nz1
-            eta (k) = (ppb(k,i)+pp(k,i))/p0
-            etav(k) = (eta(k)-.252)*pii/2.
-            if(eta(k).ge.znut)  then
-              teta(k) = t0*eta(k)**(rgas*dtdz/gravity)
-            else
-              teta(k) = t0*eta(k)**(rgas*dtdz/gravity) + delta_t*(znut-eta(k))**5
-            end if
-          end do
-          phi = grid % latCell % array (i)
-          do k=1,nz1
-            tt(k) = 0.
-            tt(k) = teta(k)+.75*eta(k)*pii*u0/rgas*sin(etav(k))      &amp;
-                            *sqrt(cos(etav(k)))*                   &amp;
-                              ((-2.*sin(phi)**6                    &amp;
-                                   *(cos(phi)**2+1./3.)+10./63.)   &amp;
-                                   *2.*u0*cos(etav(k))**1.5        &amp;
-                              +(1.6*cos(phi)**3                    &amp;
-                                *(sin(phi)**2+2./3.)-pii/4.)*r_earth*omega_e)
-
-
-            !write(0,*) ' k, tt(k) ',k,tt(k)
-            ztemp   = .5*(zgrid(k,i)+zgrid(k+1,i))
-            ptemp   = ppb(k,i) + pp(k,i)
-!            qv(k,i) = env_qv( ztemp, tt(k), ptemp, 0 )
-            qv(k,i) = 0.
-
-          end do
-!          do k=2,nz1
-!            cqw(k,i) = 1./(1.+.5*(qv(k,i)+qv(k-1,i)))
-!          end do
-                
-          do itrp = 1,25
-            do k=1,nz1                                
-              rr(k,i)  = (pp(k,i)/(rgas*zz(k,i))  &amp;
-                          -rb(k,i)*(tt(k)-t0b))/tt(k)
-            end do
-
-            ppi(1) = p0-.5*dzw(1)*gravity                         &amp;
-                          *(1.25*(rr(1,i)+rb(1,i))*(1.+qv(1,i))   &amp;
-                            -.25*(rr(2,i)+rb(2,i))*(1.+qv(2,i)))
-
-            ppi(1) = ppi(1)-ppb(1,i)
-            do k=1,nz1-1
-              ppi(k+1) = ppi(k)-.5*dzu(k+1)*gravity*                     &amp;
-                            (rr(k  ,i)+(rr(k  ,i)+rb(k  ,i))*qv(k  ,i)   &amp;
-                            +rr(k+1,i)+(rr(k+1,i)+rb(k+1,i))*qv(k+1,i))
-            end do
-
-            do k=1,nz1
-              pp(k,i) = .2*ppi(k)+.8*pp(k,i)
-            end do
-
-          end do  ! end inner iteration loop itrp
-
-        end do  ! end outer iteration loop itr
-
-        do k=1,nz1        
-          p (k,i) = ((ppb(k,i)+pp(k,i))/p0)**(rgas/cp)
-          t (k,i) = tt(k)/p(k,i)
-          rt (k,i) = t(k,i)*rr(k,i)+rb(k,i)*(t(k,i)-tb(k,i))
-          rho (k,i) = rb(k,i) + rr(k,i)
-        end do
-
-        if(i == 1) then
-          do k=1,nz1
-            write(0,*) ' k, p, t, rt ',k,p(k,1),t(k,1),rt(k,1)
-          enddo
-        end if
-
-      end do  ! end loop over cells
-
-      lat_pert = latitude_pert*pii/180.
-      lon_pert = longitude_pert*pii/180.
-
-      do iEdge=1,grid % nEdges
-
-         vtx1 = grid % VerticesOnEdge % array (1,iEdge)
-         vtx2 = grid % VerticesOnEdge % array (2,iEdge)
-         lat1 = grid%latVertex%array(vtx1)
-         lat2 = grid%latVertex%array(vtx2)
-         iCell1 = grid % cellsOnEdge % array(1,iEdge)
-         iCell2 = grid % cellsOnEdge % array(2,iEdge)
-         flux = (0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-
-         if (config_test_case == 2) then
-            r_pert = sphere_distance( grid % latEdge % array (iEdge), grid % lonEdge % array (iEdge), &amp;
-                                      lat_pert, lon_pert, 1.)/(pert_radius)
-            u_pert = u_perturbation*exp(-r_pert**2)*(lat2-lat1)*a/grid % dvEdge % array(iEdge)
-
-         else if (config_test_case == 3) then
-            lon_Edge = grid % lonEdge % array(iEdge)
-            u_pert = u_perturbation*cos(k_x*(lon_Edge - lon_pert)) &amp;
-                         *(0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-         else
-            u_pert = 0.0
-         end if
-
-
-         do k=1,grid % nVertLevels
-           etavs = (0.5*(ppb(k,iCell1)+ppb(k,iCell2)+pp(k,iCell1)+pp(k,iCell2))/p0 - 0.252)*pii/2.
-  
-           fluxk = u0*flux*(cos(etavs)**1.5)
-!           fluxk = u0*flux*(cos(znuv(k))**(1.5))
-           state % u % array(k,iEdge) = fluxk + u_pert
-         end do
-
-      !
-      ! Generate rotated Coriolis field
-      !
-
-         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
-                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha_grid) + &amp;
-                                         sin(grid%latEdge%array(iEdge)) * cos(alpha_grid) &amp;
-                                       )
-      end do
-
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
-                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha_grid) + &amp;
-                                          sin(grid%latVertex%array(iVtx)) * cos(alpha_grid) &amp;
-                                         )
-      end do
-
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      state % v % array(:,:) = 0.0
-      do iEdge = 1, grid%nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1, grid%nVertLevels
-                 state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-
-   end subroutine nhyd_test_case_jw
-
-!----------------------------------------------------------------------------------------------------------
-
-   subroutine nhyd_test_case_squall_line(grid, state, test_case)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_meta), intent(inout) :: grid
-      type (grid_state), intent(inout) :: state
-      integer, intent(in) :: test_case
-
-      real (kind=RKIND), parameter :: u0 = 35.0
-      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
-      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
-      real (kind=RKIND), parameter :: t0b = 250., t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
-      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
-      real (kind=RKIND), parameter :: theta_c = pii/4.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
-      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
-
-      real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
-      real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx, cqw
-      real (kind=RKIND), dimension(:,:), pointer :: ppb, pb, rho, rb, rr, tb, rtb, p, pp, dss, t, rt, u, ru
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp, cell1, cell2, nCellsSolve
-
-      !This is temporary variable here. It just need when calculate tangential velocity v.
-      integer :: eoe, j
-      integer, dimension(:), pointer :: nEdgesOnEdge 
-      integer, dimension(:,:), pointer :: edgesOnEdge
-      real, dimension(:,:), pointer :: weightsOnEdge
-
-      real (kind=RKIND) :: flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
-
-      real (kind=RKIND) :: ptop, p0, phi
-      real (kind=RKIND) :: lon_Edge
-
-      real (kind=RKIND) :: r_earth, etavs, ztemp, zd, zt, dz, gam, str
-
-      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature, rh
-      real (kind=RKIND) :: ptmp, es, qvs, xnutr, znut, ptemp
-      integer :: iter
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: zc, zw, ah
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: zu, dzw, rdzwp, rdzwm
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: eta, etav, teta, ppi, tt, thi
-
-      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3
-      real (kind=RKIND) :: ztr, thetar, ttr, thetas, um, us, zts, pitop, ptopb, rcp, rcv
-      real (kind=RKIND) :: radx, radz, zcent, xmid, delt, xloc, rad, temp, pres, yloc, ymid, a_scale
-
-      !
-      ! Scale all distances
-      !
-
-      a_scale = 1.0
-
-      grid % xCell % array = grid % xCell % array * a_scale
-      grid % yCell % array = grid % yCell % array * a_scale
-      grid % zCell % array = grid % zCell % array * a_scale
-      grid % xVertex % array = grid % xVertex % array * a_scale
-      grid % yVertex % array = grid % yVertex % array * a_scale
-      grid % zVertex % array = grid % zVertex % array * a_scale
-      grid % xEdge % array = grid % xEdge % array * a_scale
-      grid % yEdge % array = grid % yEdge % array * a_scale
-      grid % zEdge % array = grid % zEdge % array * a_scale
-      grid % dvEdge % array = grid % dvEdge % array * a_scale
-      grid % dcEdge % array = grid % dcEdge % array * a_scale
-      grid % areaCell % array = grid % areaCell % array * a_scale**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a_scale**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a_scale**2.0
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      
-      nz1 = grid % nVertLevels
-      nz = nz1 + 1
-      nCellsSolve = grid % nCellsSolve
-
-      zgrid =&gt; grid % zgrid % array
-      rdzw =&gt; grid % rdzw % array
-      dzu =&gt; grid % dzu % array
-      rdzu =&gt; grid % rdzu % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zx =&gt; grid % zx % array
-      zz =&gt; grid % zz % array
-      hx =&gt; grid % hx % array
-      dss =&gt; grid % dss % array
-
-      ppb =&gt; grid % pressure_base % array
-      pb =&gt; grid % exner_base % array
-      rb =&gt; grid % rho_base % array
-      tb =&gt; grid % theta_base % array
-      rtb =&gt; grid % rtheta_base % array
-      p =&gt; grid % exner % array
-      cqw =&gt; grid % cqw % array
-
-      rho =&gt; state % rho % array
-
-      pp =&gt; state % pressure % array
-      rr =&gt; state % rho_p % array
-      t =&gt; state % theta % array      
-      rt =&gt; grid % rtheta_p % array
-      u =&gt; state % u % array
-      ru =&gt; grid % ru % array
-
-      scalars =&gt; state % scalars % array
-
-      scalars(:,:,:) = 0.
-
-      xnutr = 0.
-      zd = 12000.
-      znut = eta_t
-
-      etavs = (1.-0.252)*pii/2.
-      r_earth = a
-      p0 = 1.e+05
-      rcp = rgas/cp
-      rcv = rgas/(cp-rgas)
-
-     write(0,*) ' point 1 in test case setup '
-
-! We may pass in an hx(:,:) that has been precomputed elsewhere.
-! For now it is independent of k
-
-      do iCell=1,grid % nCells
-        do k=1,nz
-          hx(k,iCell) = 0.  ! squall line or supercell on flat plane
-        enddo
-      enddo
-
-      !     metrics for hybrid coordinate and vertical stretching
-
-      str = 1.0
-      zt = 20000.
-      dz = zt/float(nz1)
-
-      write(0,*) ' dz = ',dz
-      write(0,*) ' hx computation complete '
-
-      do k=1,nz
-                
-!           sh(k) is the stretching specified for height surfaces
-
-            zc(k) = zt*(real(k-1)*dz/zt)**str 
-                                
-!           to specify specific heights zc(k) for coordinate surfaces,
-!           input zc(k) 
-!           zw(k) is the hieght of zeta surfaces
-!                zw(k) = (k-1)*dz yields constant dzeta
-!                        and nonconstant dzeta/dz
-!                zw(k) = sh(k)*zt yields nonconstant dzeta
-!                        and nearly constant dzeta/dz 
-
-!            zw(k) = float(k-1)*dz
-            zw(k) = zc(k)
-!
-!           ah(k) governs the transition between terrain-following 
-!           and pureheight coordinates
-!                ah(k) = 0 is a terrain-following coordinate
-!                ah(k) = 1 is a height coordinate
- 
-!            ah(k) = 1.-cos(.5*pii*(k-1)*dz/zt)**6
-            ah(k) = 1.
-            write(0,*) ' k, zc, zw, ah ',k,zc(k),zw(k),ah(k)                        
-      end do
-      do k=1,nz1
-         dzw (k) = zw(k+1)-zw(k)
-         rdzw(k) = 1./dzw(k)
-         zu(k  ) = .5*(zw(k)+zw(k+1))
-      end do
-      do k=2,nz1
-         dzu (k)  = .5*(dzw(k)+dzw(k-1))
-         rdzu(k)  =  1./dzu(k)
-         fzp (k)  = .5* dzw(k  )/dzu(k)
-         fzm (k)  = .5* dzw(k-1)/dzu(k)
-         rdzwp(k) = dzw(k-1)/(dzw(k  )*(dzw(k)+dzw(k-1)))
-         rdzwm(k) = dzw(k  )/(dzw(k-1)*(dzw(k)+dzw(k-1)))
-      end do
-
-!**********  how are we storing cf1, cf2 and cf3?
-
-      d1  = .5*dzw(1)
-      d2  = dzw(1)+.5*dzw(2)
-      d3  = dzw(1)+dzw(2)+.5*dzw(3)
-      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-
-      do iCell=1,grid % nCells
-        do k=1,nz        
-            zgrid(k,iCell) = ah(k)*(zc(k)*(1.-hx(k,iCell)/zt)+hx(k,iCell)) &amp;
-                           + (1.-ah(k)) * zc(k)        
-        end do
-        do k=1,nz1
-          zz (k,iCell) = (zw(k+1)-zw(k))/(zgrid(k+1,iCell)-zgrid(k,iCell))
-        end do
-      end do
-
-      do i=1, grid % nEdges
-        iCell1 = grid % CellsOnEdge % array(1,i)
-        iCell2 = grid % CellsOnEdge % array(2,i)
-        do k=1,nz
-          zx (k,i) = (zgrid(k,iCell2)-zgrid(k,iCell1)) / grid % dcEdge % array(i)
-        end do
-      end do
-      do i=1, grid % nCells
-        do k=1,nz1
-          ztemp = .5*(zgrid(k+1,i)+zgrid(k,i))
-          dss(k,i) = 0.
-          ztemp = zgrid(k,i)
-          if(ztemp.gt.zd+.1)  then
-             dss(k,i) = dss(k,i)+xnutr*sin(.5*pii*(ztemp-zd)/(zt-zd))**2
-          end if
-        end do
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zgrid(k,1),hx(k,1) ',k,zgrid(k,1),hx(k,1)
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zx(k,1) ',k,zx(k,1)
-      enddo
-
-      write(0,*) ' grid metrics setup complete '
-!
-! convective initialization
-!
-         ztr    = 12000.
-         thetar = 343.
-         ttr    = 213.
-         thetas = 300.5
-
-         write(0,*) ' rgas, cp, gravity ',rgas,cp, gravity
-
-!  no flow
-         um = 0.
-         us = 0.
-         zts = 5000.
-!  supercell parameters
-!         um = 30.
-!         us = 15.
-!         zts = 5000.
-!  squall-line parameters
-!         um = 12.
-!         us = 10.
-!         zts = 2500.
-
-
-         do i=1,grid % nCells
-            do k=1,nz1
-               ztemp = .5*(zgrid(k,i)+zgrid(k+1,i))
-               if(ztemp .gt. ztr) then
-                  t (k,i) = thetar*exp(9.8*(ztemp-ztr)/(1003.*ttr))
-                  rh(k,i) = 0.25
-               else
-                  t (k,i) = 300.+43.*(ztemp/ztr)**1.25
-                  rh(k,i) = (1.-0.75*(ztemp/ztr)**1.25)
-                  if(t(k,i).lt.thetas) t(k,i) = thetas
-               end if
-               tb(k,i) = t(k,i)
-            end do
-         end do
-
-!  set the velocity field - we are on a plane here.
-
-         do i=1, grid % nEdges
-            cell1 = grid % CellsOnEdge % array(1,i)
-            cell2 = grid % CellsOnEdge % array(2,i)
-            if(cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-            do k=1,nz1
-               ztemp = .25*( zgrid(k,cell1 )+zgrid(k+1,cell1 )  &amp;
-                            +zgrid(k,cell2)+zgrid(k+1,cell2))
-               if(ztemp.lt.zts)  then
-                  u(k,i) = um*ztemp/zts
-               else
-                  u(k,i) = um
-               end if
-               u(k,i) = cos(grid % angleEdge % array(i)) * (u(k,i) - us)
-            end do
-            end if
-         end do
-!
-!     reference sounding based on dry atmosphere
-!
-      pitop = 1.-.5*dzw(1)*gravity/(cp*tb(1,1)*zz(1,1))
-      do k=2,nz1
-         pitop = pitop-dzu(k)*gravity/(cp*.5*(tb(k,1)+tb(k-1,1))   &amp;
-                                   *.5*(zz(k,1)+zz(k-1,1)))
-          
-         write(0,*) k,pitop,tb(k,1),dzu(k),tb(k,1)
-      end do
-      pitop = pitop-.5*dzw(nz1)*gravity/(cp*tb(nz1,1)*zz(nz1,1))
-
-      ptopb = p0*pitop**(1./rcp)
-      write(6,*) 'ptopb = ',.01*ptopb
-                
-      do i=1, grid % nCells
-         pb(nz1,i) = pitop+.5*dzw(nz1)*gravity/(cp*tb(nz1,i)*zz(nz1,i))
-         p (nz1,i) = pitop+.5*dzw(nz1)*gravity/(cp*t (nz1,i)*zz(nz1,i))
-         do k=nz1-1,1,-1
-            pb(k,i)  = pb(k+1,i) + dzu(k+1)*gravity/(cp*.5*(tb(k,i)+tb(k+1,i))   &amp;
-                                           *.5*(zz(k,i)+zz(k+1,i)))
-            p (k,i)  = p (k+1,i) + dzu(k+1)*gravity/(cp*.5*(t (k,i)+t (k+1,i))   &amp;
-                                           *.5*(zz(k,i)+zz(k+1,i)))
-         end do
-         do k=1,nz1
-            rb (k,i) = pb(k,i)**(1./rcv)/((rgas/p0)*tb(k,i)*zz(k,i))
-            rtb(k,i) = rb(k,i)*tb(k,i)
-            rr (k,i) = p (k,i)**(1./rcv)/((rgas/p0)*t (k,i)*zz(k,i))-rb(k,i)
-            cqw(k,i) = 1.
-         end do
-      end do
-
-      write(0,*) ' base state sounding '
-      do k=1,grid%nVertLevels
-        write(0,*) ' k, pb,rb,tb,rtb,t,rr,p ', k,pb(k,1),rb(k,1),tb(k,1),rtb(k,1),t(k,1),rr(k,1),p(k,1)
-      end do
-
-!-------------------------------------------------------------------
-!     ITERATIONS TO CONVERGE MOIST SOUNDING
-!
-!      delt = -15.
-      delt = 0.
-      radx  = 10000.
-      radz  = 1500.
-      zcent = 1500.
-      xmid = 20000.
-      ymid = 20000.
-
-      do i = 1, grid % nCells
-        xloc = grid % xCell % array(i) - xmid
-        yloc = grid % yCell % array(i) - ymid
-          do k = 1,nz1
-            thi(k) = t(k,i)
-            ztemp     = .5*(zgrid(k+1,i)+zgrid(k,i))
-            rad =sqrt((xloc/radx)**2+(yloc/radx)**2+((ztemp-zcent)/radz)**2)
-            if(rad.lt.1)  then
-               thi(k) = t(k,i) + delt*cos(.5*pii*rad)**2
-            end if
-         end do
-
-        do itr=1,30
-                
-          if(i.eq.1) then
-            pitop = 1.-.5*dzw(1)*gravity*(1.+scalars(index_qv,1,1))/(cp*t(1,1)*zz(1,1))
-            do k=2,nz1
-               pitop = pitop-dzu(k)*gravity/(cp*cqw(k,1)*.5*(t (k,1)+t (k-1,1)) &amp;
-                                                  *.5*(zz(k,1)+zz(k-1,1)))
-            end do
-            pitop = pitop - .5*dzw(nz1)*gravity*(1.+scalars(index_qv,nz1,1))/(cp*t(nz1,1)*zz(nz1,1))
-            ptop = p0*pitop**(1./rcp)
-            write(0,*) 'ptop  = ',.01*ptop
-          end if
-
-          pp(nz1,i) = ptop-ptopb+.5*dzw(nz1)*gravity*   &amp;
-                       (rr(nz1,i)+(rr(nz1,i)+rb(nz1,i))*scalars(index_qv,nz1,i))
-          do k=nz1-1,1,-1
-             pp(k,i) = pp(k+1,i)+.5*dzu(k+1)*gravity*                   &amp;
-                            (rr(k  ,i)+(rr(k  ,i)+rb(k  ,i))*scalars(index_qv,k  ,i)  &amp;
-                            +rr(k+1,i)+(rr(k+1,i)+rb(k+1,i))*scalars(index_qv,k+1,i))
-          end do
-          do k=1,nz1
-             rt(k,i) = (pp(k,i)/(rgas*zz(k,i))                   &amp;
-                     -rtb(k,i)*(p(k,i)-pb(k,i)))/p(k,i)       
-             p (k,i) = (zz(k,i)*(rgas/p0)*(rtb(k,i)+rt(k,i)))**rcv
-             rr(k,i) = (rt(k,i)-rb(k,i)*(t(k,i)-tb(k,i)))/t(k,i)
-          end do
-!
-!     update water vapor mixing ratio from humitidty profile
-!
-          do k=1,nz1
-             temp   = p(k,1)*thi(k)
-             pres   = p0*p(k,1)**(1./rcp)
-             qvs    = 380.*exp(17.27*(temp-273.)/(temp-36.))/pres
-             scalars(index_qv,k,1) = amin1(0.014,rh(k,1)*qvs)
-          end do
-            
-                        
-          do k=1,nz1
-             t (k,i) = thi(k)*(1.+1.61*scalars(index_qv,k,i))
-          end do
-          do k=2,nz1
-             cqw(k,i) = 1./(1.+.5*( scalars(index_qv,k  ,i)  &amp;
-                                   +scalars(index_qv,k  ,i)))
-          end do
-        end do !  iteration loop
-
-      end do ! loop over cells
-!----------------------------------------------------------------------
-!
-      write(0,*) ' sounding for the simulation '
-      do k=1,nz1
-         write(6,10) .5*(zgrid(k,1)+zgrid(k+1,1))/1000.,                            &amp;
-                   .01*p0*p(k,1)**(1./rcp),t(k,1)/(1.+1.61*scalars(index_qv,k,1)),  &amp;
-                   1000.*scalars(index_qv,k,1),u(k,1)
-   10    format(1x,5f10.3)
-      end do
-                
-!
-      do i=1,grid % ncells
-         do k=1,nz1
-            rho(k,i) = rb(k,i)+rr(k,i)
-         end do
-      end do
-
-      do i=1,grid % nEdges
-        cell1 = grid % CellsOnEdge % array(1,i)
-        cell2 = grid % CellsOnEdge % array(2,i)
-        if(cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-          do k=1,nz1
-            ru (k,i)  = 0.5*(rho(k,cell1)+rho(k,cell2))*u(k,i)    
-          end do
-        end if
-      end do
-
-!
-!        CALCULATION OF OMEGA, RW = ZX * RU + ZZ * RW
-!
-!  we are assuming w and rw are zero for this initialization
-!  i.e., no terrain
-!
-       grid % rw % array = 0.
-
-!      DO I=1,NX
-!         IM1=I-1
-!         IF(IPER.EQ.1.AND.I.EQ.1) IM1=NX1
-!         RW(1 ,I) = 0.
-!         RW(NZ,I) = 0.
-!         DO K=2,NZ1
-!           RW(K ,I) = (FZM(K)*ZZ(K,I)+FZP(K)*ZZ(K-1,I))*(
-!     &amp;                -RDX*(RUZ(K,I  )*(ZUW(K,I  )-ZGRID(K,I))
-!     &amp;                     -RUZ(K,IM1)*(ZUW(K,IM1)-ZGRID(K,I))))
-!         END DO
-!         DO K=1,NZ
-!            RW1(K,I) = RW(K,I)
-!         END DO
-!      END DO
-
-
-      !
-      ! Generate rotated Coriolis field
-      !
-      do iEdge=1,grid % nEdges
-         grid % fEdge % array(iEdge) = 0.
-      end do
-
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 0.
-      end do
-
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      state % v % array(:,:) = 0.0
-      do iEdge = 1, grid%nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1, grid%nVertLevels
-                 state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-   end subroutine nhyd_test_case_squall_line
-
-   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
-   !   sphere with given radius.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
-
-      real (kind=RKIND) :: arg1
-
-      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
-                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
-      sphere_distance = 2.*radius*asin(arg1)
-
-   end function sphere_distance
-
-end module test_cases

Deleted: branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.sh0614
===================================================================
--- branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.sh0614        2010-07-12 19:38:09 UTC (rev 372)
+++ branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_test_cases.F.sh0614        2010-07-13 21:27:45 UTC (rev 373)
@@ -1,998 +0,0 @@
-module test_cases
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine setup_nhyd_test_case(domain)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Configure grid metadata and model state for the hydrostatic test case
-   !   specified in the namelist
-   !
-   ! Output: block - a subset (not necessarily proper) of the model domain to be
-   !                 initialized
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-
-      integer :: i
-      type (block_type), pointer :: block_ptr
-
-      if (config_test_case == 0) then
-         write(0,*) ' need nonhydrostatic test case configuration, error stop '
-         stop
-
-      else if ((config_test_case == 1) .or. (config_test_case == 2) .or. (config_test_case == 3)) then
-         write(0,*) ' Jablonowski and Williamson baroclinic wave test case '
-         if (config_test_case == 1) write(0,*) ' no initial perturbation '
-         if (config_test_case == 2) write(0,*) ' initial perturbation included '
-         if (config_test_case == 3) write(0,*) ' normal-mode perturbation included '
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            write(0,*) ' calling test case setup '
-            call nhyd_test_case_jw(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
-            write(0,*) ' returned from test case setup '
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 4 ) then
-
-         write(0,*) ' squall line - super cell test case '
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            write(0,*) ' calling test case setup '
-            call nhyd_test_case_squall_line(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
-            write(0,*) ' returned from test case setup '
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else
-
-         write(0,*) ' Only test case 1, 2, 3 and 4 are currently supported for nonhydrostatic core '
-         stop
-      end if
-
-   end subroutine setup_nhyd_test_case
-
-!----------------------------------------------------------------------------------------------------------
-
-   subroutine nhyd_test_case_jw(grid, state, test_case)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_meta), intent(inout) :: grid
-      type (grid_state), intent(inout) :: state
-      integer, intent(in) :: test_case
-
-      real (kind=RKIND), parameter :: u0 = 35.0
-      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
-      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
-      real (kind=RKIND), parameter :: t0b = 250., t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
-      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
-      real (kind=RKIND), parameter :: theta_c = pii/4.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
-      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
-
-      real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
-      real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx
-      real (kind=RKIND), dimension(:,:), pointer :: pressure, ppb, pb, rho, rb, rr, tb, rtb, p, pp, dss, t, rt
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp
-
-      !This is temporary variable here. It just need when calculate tangential velocity v.
-      integer :: eoe, j
-      integer, dimension(:), pointer :: nEdgesOnEdge 
-      integer, dimension(:,:), pointer :: edgesOnEdge
-      real, dimension(:,:), pointer :: weightsOnEdge
-
-      real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
-
-      real (kind=RKIND) :: ptop, p0, phi
-      real (kind=RKIND) :: lon_Edge
-
-      real (kind=RKIND) :: r_earth, etavs, ztemp, zd, zt, dz, gam, delt, str
-
-      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature, qv
-      real (kind=RKIND) :: ptmp, es, qvs, xnutr, znut, ptemp
-      integer :: iter
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: sh, zw, ah
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: zu, dzw, rdzwp, rdzwm
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: eta, etav, teta, ppi, tt
-
-      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      
-      nz1 = grid % nVertLevels
-      nz = nz1 + 1
-
-      zgrid =&gt; grid % zgrid % array
-      rdzw =&gt; grid % rdzw % array
-      dzu =&gt; grid % dzu % array
-      rdzu =&gt; grid % rdzu % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zx =&gt; grid % zx % array
-      zz =&gt; grid % zz % array
-      hx =&gt; grid % hx % array
-      dss =&gt; grid % dss % array
-
-      pb =&gt; grid % exner_base % array
-      rb =&gt; grid % rho_base % array
-      tb =&gt; grid % theta_base % array
-      rtb =&gt; grid % rtheta_base % array
-      p =&gt; grid % exner % array
-
-      ppb =&gt; grid % pressure_base % array
-      pp =&gt; state % pressure % array
-
-      rho =&gt; state % rho % array
-      rr =&gt; state % rho_p % array
-      t =&gt; state % theta % array      
-      rt =&gt; grid % rtheta_p % array
-
-
-      scalars(:,:,:) = 0.
-
-      xnutr = 0.
-      zd = 12000.
-      znut = eta_t
-
-      etavs = (1.-0.252)*pii/2.
-      r_earth = a
-      p0 = 1.e+05
-
-      write(0,*) ' point 1 in test case setup '
-
-! We may pass in an hx(:,:) that has been precomputed elsewhere.
-! For now it is independent of k
-
-      do iCell=1,grid % nCells
-        do k=1,nz
-          phi = grid % latCell % array (iCell)
-          hx(k,iCell) = u0/gravity*cos(etavs)**1.5                                   &amp;
-                      *((-2.*sin(phi)**6                                   &amp;
-                            *(cos(phi)**2+1./3.)+10./63.)                  &amp;
-                            *(u0)*cos(etavs)**1.5                          &amp;
-                       +(1.6*cos(phi)**3                                   &amp;
-                            *(sin(phi)**2+2./3.)-pii/4.)*r_earth*omega_e)
-        enddo
-      enddo
-
-      !     metrics for hybrid coordinate and vertical stretching
-
-      str = 1.5
-      zt = 45000.
-      dz = zt/float(nz1)
-
-      write(0,*) ' hx computation complete '
-
-      do k=1,nz
-                
-!           sh(k) is the stretching specified for height surfaces
-
-            sh(k) = (real(k-1)*dz/zt)**str 
-                                
-!           to specify specific heights zc(k) for coordinate surfaces,
-!           input zc(k) and define sh(k) = zc(k)/zt
-!           zw(k) is the hieght of zeta surfaces
-!                zw(k) = (k-1)*dz yields constant dzeta
-!                        and nonconstant dzeta/dz
-!                zw(k) = sh(k)*zt yields nonconstant dzeta
-!                        and nearly constant dzeta/dz 
-
-            zw(k) = float(k-1)*dz
-!            zw(k) = sh(k)*zt
-!
-!           ah(k) governs the transition between terrain-following 
-!           and pureheight coordinates
-!                ah(k) = 0 is a terrain-following coordinate
-!                ah(k) = 1 is a height coordinate
- 
-            ah(k) = 1.-cos(.5*pii*(k-1)*dz/zt)**6
-!            ah(k) = 0.
-            write(0,*) ' k, sh, zw, ah ',k,sh(k),zw(k),ah(k)                        
-      end do
-      do k=1,nz1
-         dzw (k) = zw(k+1)-zw(k)
-         rdzw(k) = 1./dzw(k)
-         zu(k  ) = .5*(zw(k)+zw(k+1))
-      end do
-      do k=2,nz1
-         dzu (k)  = .5*(dzw(k)+dzw(k-1))
-         rdzu(k)  =  1./dzu(k)
-         fzp (k)  = .5* dzw(k  )/dzu(k)
-         fzm (k)  = .5* dzw(k-1)/dzu(k)
-         rdzwp(k) = dzw(k-1)/(dzw(k  )*(dzw(k)+dzw(k-1)))
-         rdzwm(k) = dzw(k  )/(dzw(k-1)*(dzw(k)+dzw(k-1)))
-      end do
-
-!**********  how are we storing cf1, cf2 and cf3?
-
-      d1  = .5*dzw(1)
-      d2  = dzw(1)+.5*dzw(2)
-      d3  = dzw(1)+dzw(2)+.5*dzw(3)
-      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-
-      do iCell=1,grid % nCells
-        do k=1,nz        
-          zgrid(k,iCell) = (1.-ah(k))*(sh(k)*(zt-hx(k,iCell))+hx(k,iCell))  &amp;
-                         + ah(k) * sh(k)* zt        
-        end do
-        do k=1,nz1
-          zz (k,iCell) = (zw(k+1)-zw(k))/(zgrid(k+1,iCell)-zgrid(k,iCell))
-        end do
-      end do
-
-      do i=1, grid % nEdges
-        iCell1 = grid % CellsOnEdge % array(1,i)
-        iCell2 = grid % CellsOnEdge % array(2,i)
-        do k=1,nz
-          zx (k,i) = (zgrid(k,iCell2)-zgrid(k,iCell1)) / grid % dcEdge % array(i)
-        end do
-      end do
-      do i=1, grid % nCells
-        do k=1,nz1
-          ztemp = .5*(zgrid(k+1,i)+zgrid(k,i))
-          dss(k,i) = 0.
-          ztemp = zgrid(k,i)
-          if(ztemp.gt.zd+.1)  then
-             dss(k,i) = dss(k,i)+xnutr*sin(.5*pii*(ztemp-zd)/(zt-zd))**2
-          end if
-        end do
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zgrid(k,1),hx(k,1) ',k,zgrid(k,1),hx(k,1)
-      enddo
-
-      do k=1,nz1
-        write(0,*) ' k, zx(k,1) ',k,zx(k,1)
-      enddo
-
-      write(0,*) ' grid metrics setup complete '
-!
-!---- baroclinc wave initialization ---------------------------------
-!
-!     reference sounding based on dry isothermal atmosphere
-!
-      do i=1, grid % nCells
-        !write(0,*) ' thermodynamic setup, cell ',i
-        do k=1,nz1
-          ztemp    = .5*(zgrid(k+1,i)+zgrid(k,i))
-          ppb(k,i) = p0*exp(-gravity*ztemp/(rgas*t0b)) 
-          pb (k,i) = (ppb(k,i)/p0)**(rgas/cp)
-          rb (k,i) = ppb(k,i)/(rgas*t0b*zz(k,i))
-          tb (k,i) = t0b/pb(k,i)
-          rtb(k,i) = rb(k,i)*tb(k,i)
-          p  (k,i) = pb(k,i)
-          pp (k,i) = 0.
-          rr (k,i) = 0.
-        end do
-
-        if(i == 1) then
-          do k=1,nz1
-            write(0,*) ' k, ppb, pb, rb, tb (k,1) ',k,ppb(k,1),pb(k,1),rb(k,1)*zz(k,1),tb(k,1)
-          enddo
-        end if
-!
-!     iterations to converge temperature as a function of pressure
-!
-        do itr = 1,10
-
-          do k=1,nz1
-            eta (k) = (ppb(k,i)+pp(k,i))/p0
-            etav(k) = (eta(k)-.252)*pii/2.
-            if(eta(k).ge.znut)  then
-              teta(k) = t0*eta(k)**(rgas*dtdz/gravity)
-            else
-              teta(k) = t0*eta(k)**(rgas*dtdz/gravity) + delta_t*(znut-eta(k))**5
-            end if
-          end do
-          phi = grid % latCell % array (i)
-          do k=1,nz1
-            tt(k) = 0.
-            tt(k) = teta(k)+.75*eta(k)*pii*u0/rgas*sin(etav(k))      &amp;
-                            *sqrt(cos(etav(k)))*                   &amp;
-                              ((-2.*sin(phi)**6                    &amp;
-                                   *(cos(phi)**2+1./3.)+10./63.)   &amp;
-                                   *2.*u0*cos(etav(k))**1.5        &amp;
-                              +(1.6*cos(phi)**3                    &amp;
-                                *(sin(phi)**2+2./3.)-pii/4.)*r_earth*omega_e)
-
-
-            !write(0,*) ' k, tt(k) ',k,tt(k)
-            ztemp   = .5*(zgrid(k,i)+zgrid(k+1,i))
-            ptemp   = ppb(k,i) + pp(k,i)
-!            qv(k,i) = env_qv( ztemp, tt(k), ptemp, 0 )
-            qv(k,i) = 0.
-
-          end do
-!          do k=2,nz1
-!            cqw(k,i) = 1./(1.+.5*(qv(k,i)+qv(k-1,i)))
-!          end do
-                
-          do itrp = 1,25
-            do k=1,nz1                                
-              rr(k,i)  = (pp(k,i)/(rgas*zz(k,i))  &amp;
-                          -rb(k,i)*(tt(k)-t0b))/tt(k)
-            end do
-
-            ppi(1) = p0-.5*dzw(1)*gravity                         &amp;
-                          *(1.25*(rr(1,i)+rb(1,i))*(1.+qv(1,i))   &amp;
-                            -.25*(rr(2,i)+rb(2,i))*(1.+qv(2,i)))
-
-            ppi(1) = ppi(1)-ppb(1,i)
-            do k=1,nz1-1
-              ppi(k+1) = ppi(k)-.5*dzu(k+1)*gravity*                     &amp;
-                            (rr(k  ,i)+(rr(k  ,i)+rb(k  ,i))*qv(k  ,i)   &amp;
-                            +rr(k+1,i)+(rr(k+1,i)+rb(k+1,i))*qv(k+1,i))
-            end do
-
-            do k=1,nz1
-              pp(k,i) = .2*ppi(k)+.8*pp(k,i)
-            end do
-
-          end do  ! end inner iteration loop itrp
-
-        end do  ! end outer iteration loop itr
-
-        do k=1,nz1        
-          p (k,i) = ((ppb(k,i)+pp(k,i))/p0)**(rgas/cp)
-          t (k,i) = tt(k)/p(k,i)
-          rt (k,i) = t(k,i)*rr(k,i)+rb(k,i)*(t(k,i)-tb(k,i))
-          rho (k,i) = rb(k,i) + rr(k,i)
-        end do
-
-        if(i == 1) then
-          do k=1,nz1
-            write(0,*) ' k, p, t, rt ',k,p(k,1),t(k,1),rt(k,1)
-          enddo
-        end if
-
-      end do  ! end loop over cells
-
-      lat_pert = latitude_pert*pii/180.
-      lon_pert = longitude_pert*pii/180.
-
-      do iEdge=1,grid % nEdges
-
-         vtx1 = grid % VerticesOnEdge % array (1,iEdge)
-         vtx2 = grid % VerticesOnEdge % array (2,iEdge)
-         lat1 = grid%latVertex%array(vtx1)
-         lat2 = grid%latVertex%array(vtx2)
-         iCell1 = grid % cellsOnEdge % array(1,iEdge)
-         iCell2 = grid % cellsOnEdge % array(2,iEdge)
-         flux = (0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-
-         if (config_test_case == 2) then
-            r_pert = sphere_distance( grid % latEdge % array (iEdge), grid % lonEdge % array (iEdge), &amp;
-                                      lat_pert, lon_pert, 1.)/(pert_radius)
-            u_pert = u_perturbation*exp(-r_pert**2)*(lat2-lat1)*a/grid % dvEdge % array(iEdge)
-
-         else if (config_test_case == 3) then
-            lon_Edge = grid % lonEdge % array(iEdge)
-            u_pert = u_perturbation*cos(k_x*(lon_Edge - lon_pert)) &amp;
-                         *(0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-         else
-            u_pert = 0.0
-         end if
-
-
-         do k=1,grid % nVertLevels
-           etavs = (0.5*(ppb(k,iCell1)+ppb(k,iCell2)+pp(k,iCell1)+pp(k,iCell2))/p0 - 0.252)*pii/2.
-  
-           fluxk = u0*flux*(cos(etavs)**1.5)
-!           fluxk = u0*flux*(cos(znuv(k))**(1.5))
-           state % u % array(k,iEdge) = fluxk + u_pert
-         end do
-
-      !
-      ! Generate rotated Coriolis field
-      !
-
-         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
-                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha_grid) + &amp;
-                                         sin(grid%latEdge%array(iEdge)) * cos(alpha_grid) &amp;
-                                       )
-      end do
-
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
-                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha_grid) + &amp;
-                                          sin(grid%latVertex%array(iVtx)) * cos(alpha_grid) &amp;
-                                         )
-      end do
-
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      state % v % array(:,:) = 0.0
-      do iEdge = 1, grid%nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1, grid%nVertLevels
-                 state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-
-   end subroutine nhyd_test_case_jw
-
-!----------------------------------------------------------------------------------------------------------
-
-   subroutine nhyd_test_case_squall_line(grid, state, test_case)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_meta), intent(inout) :: grid
-      type (grid_state), intent(inout) :: state
-      integer, intent(in) :: test_case
-
-      real (kind=RKIND), parameter :: u0 = 35.0
-      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
-      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
-      real (kind=RKIND), parameter :: t0b = 250., t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
-      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
-      real (kind=RKIND), parameter :: theta_c = pii/4.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
-      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
-
-      real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
-      real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx, cqw
-      real (kind=RKIND), dimension(:,:), pointer :: ppb, pb, rho, rb, rr, tb, rtb, p, pp, dss, t, rt, u, ru
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp, cell1, cell2, nCellsSolve
-
-      !This is temporary variable here. It just need when calculate tangential velocity v.
-      integer :: eoe, j
-      integer, dimension(:), pointer :: nEdgesOnEdge 
-      integer, dimension(:,:), pointer :: edgesOnEdge
-      real, dimension(:,:), pointer :: weightsOnEdge
-
-      real (kind=RKIND) :: flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
-
-      real (kind=RKIND) :: ptop, p0, phi
-      real (kind=RKIND) :: lon_Edge
-
-      real (kind=RKIND) :: r_earth, etavs, ztemp, zd, zt, dz, gam, str
-
-      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature, rh, thi
-      real (kind=RKIND) :: ptmp, es, qvs, xnutr, znut, ptemp
-      integer :: iter
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn
-
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: zc, zw, ah
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: zu, dzw, rdzwp, rdzwm
-      real (kind=RKIND), dimension(grid % nVertLevels ) :: eta, etav, teta, ppi, tt
-
-      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3
-      real (kind=RKIND) :: ztr, thetar, ttr, thetas, um, us, zts, pitop, ptopb, rcp, rcv
-      real (kind=RKIND) :: radx, radz, zcent, xmid, delt, xloc, rad, temp, pres, yloc, ymid, a_scale
-
-      !
-      ! Scale all distances
-      !
-
-      a_scale = 1.0
-
-      grid % xCell % array = grid % xCell % array * a_scale
-      grid % yCell % array = grid % yCell % array * a_scale
-      grid % zCell % array = grid % zCell % array * a_scale
-      grid % xVertex % array = grid % xVertex % array * a_scale
-      grid % yVertex % array = grid % yVertex % array * a_scale
-      grid % zVertex % array = grid % zVertex % array * a_scale
-      grid % xEdge % array = grid % xEdge % array * a_scale
-      grid % yEdge % array = grid % yEdge % array * a_scale
-      grid % zEdge % array = grid % zEdge % array * a_scale
-      grid % dvEdge % array = grid % dvEdge % array * a_scale
-      grid % dcEdge % array = grid % dcEdge % array * a_scale
-      grid % areaCell % array = grid % areaCell % array * a_scale**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a_scale**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a_scale**2.0
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      
-      nz1 = grid % nVertLevels
-      nz = nz1 + 1
-      nCellsSolve = grid % nCellsSolve
-
-      zgrid =&gt; grid % zgrid % array
-      rdzw =&gt; grid % rdzw % array
-      dzu =&gt; grid % dzu % array
-      rdzu =&gt; grid % rdzu % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zx =&gt; grid % zx % array
-      zz =&gt; grid % zz % array
-      hx =&gt; grid % hx % array
-      dss =&gt; grid % dss % array
-
-      ppb =&gt; grid % pressure_base % array
-      pb =&gt; grid % exner_base % array
-      rb =&gt; grid % rho_base % array
-      tb =&gt; grid % theta_base % array
-      rtb =&gt; grid % rtheta_base % array
-      p =&gt; grid % exner % array
-      cqw =&gt; grid % cqw % array
-
-      rho =&gt; state % rho % array
-
-      pp =&gt; state % pressure % array
-      rr =&gt; state % rho_p % array
-      t =&gt; state % theta % array      
-      rt =&gt; grid % rtheta_p % array
-      u =&gt; state % u % array
-      ru =&gt; grid % ru % array
-
-      scalars =&gt; state % scalars % array
-
-      scalars(:,:,:) = 0.
-
-      xnutr = 0.
-      zd = 12000.
-      znut = eta_t
-
-      etavs = (1.-0.252)*pii/2.
-      r_earth = a
-      p0 = 1.e+05
-      rcp = rgas/cp
-      rcv = rgas/(cp-rgas)
-
-     write(0,*) ' point 1 in test case setup '
-
-! We may pass in an hx(:,:) that has been precomputed elsewhere.
-! For now it is independent of k
-
-      do iCell=1,grid % nCells
-        do k=1,nz
-          hx(k,iCell) = 0.  ! squall line or supercell on flat plane
-        enddo
-      enddo
-
-      !     metrics for hybrid coordinate and vertical stretching
-
-      str = 1.0
-      zt = 20000.
-      dz = zt/float(nz1)
-
-      write(0,*) ' dz = ',dz
-      write(0,*) ' hx computation complete '
-
-      do k=1,nz
-                
-!           sh(k) is the stretching specified for height surfaces
-
-            zc(k) = zt*(real(k-1)*dz/zt)**str 
-                                
-!           to specify specific heights zc(k) for coordinate surfaces,
-!           input zc(k) 
-!           zw(k) is the hieght of zeta surfaces
-!                zw(k) = (k-1)*dz yields constant dzeta
-!                        and nonconstant dzeta/dz
-!                zw(k) = sh(k)*zt yields nonconstant dzeta
-!                        and nearly constant dzeta/dz 
-
-!            zw(k) = float(k-1)*dz
-            zw(k) = zc(k)
-!
-!           ah(k) governs the transition between terrain-following 
-!           and pureheight coordinates
-!                ah(k) = 0 is a terrain-following coordinate
-!                ah(k) = 1 is a height coordinate
- 
-!            ah(k) = 1.-cos(.5*pii*(k-1)*dz/zt)**6
-            ah(k) = 1.
-            write(0,*) ' k, zc, zw, ah ',k,zc(k),zw(k),ah(k)                        
-      end do
-      do k=1,nz1
-         dzw (k) = zw(k+1)-zw(k)
-         rdzw(k) = 1./dzw(k)
-         zu(k  ) = .5*(zw(k)+zw(k+1))
-      end do
-      do k=2,nz1
-         dzu (k)  = .5*(dzw(k)+dzw(k-1))
-         rdzu(k)  =  1./dzu(k)
-         fzp (k)  = .5* dzw(k  )/dzu(k)
-         fzm (k)  = .5* dzw(k-1)/dzu(k)
-         rdzwp(k) = dzw(k-1)/(dzw(k  )*(dzw(k)+dzw(k-1)))
-         rdzwm(k) = dzw(k  )/(dzw(k-1)*(dzw(k)+dzw(k-1)))
-      end do
-
-!**********  how are we storing cf1, cf2 and cf3?
-
-      d1  = .5*dzw(1)
-      d2  = dzw(1)+.5*dzw(2)
-      d3  = dzw(1)+dzw(2)+.5*dzw(3)
-      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-
-      do iCell=1,grid % nCells
-        do k=1,nz        
-            zgrid(k,iCell) = ah(k)*(zc(k)*(1.-hx(k,iCell)/zt)+hx(k,iCell)) &amp;
-                           + (1.-ah(k)) * zc(k)        
-        end do
-        do k=1,nz1
-          zz (k,iCell) = (zw(k+1)-zw(k))/(zgrid(k+1,iCell)-zgrid(k,iCell))
-        end do
-      end do
-
-      do i=1, grid % nEdges
-        iCell1 = grid % CellsOnEdge % array(1,i)
-        iCell2 = grid % CellsOnEdge % array(2,i)
-        do k=1,nz
-          zx (k,i) = (zgrid(k,iCell2)-zgrid(k,iCell1)) / grid % dcEdge % array(i)
-        end do
-      end do
-      do i=1, grid % nCells
-        do k=1,nz1
-          ztemp = .5*(zgrid(k+1,i)+zgrid(k,i))
-          dss(k,i) = 0.
-          ztemp = zgrid(k,i)
-          if(ztemp.gt.zd+.1)  then
-             dss(k,i) = dss(k,i)+xnutr*sin(.5*pii*(ztemp-zd)/(zt-zd))**2
-          end if
-        end do
-      enddo
-
-!      do k=1,nz1
-!        write(0,*) ' k, zgrid(k,1),hx(k,1) ',k,zgrid(k,1),hx(k,1)
-!      enddo
-
-!      do k=1,nz1
-!        write(0,*) ' k, zx(k,1) ',k,zx(k,1)
-!      enddo
-
-!      write(0,*) ' grid metrics setup complete '
-!
-! convective initialization
-!
-         ztr    = 12000.
-         thetar = 343.
-         ttr    = 213.
-         thetas = 300.5
-
-         write(0,*) ' rgas, cp, gravity ',rgas,cp, gravity
-
-!  no flow
-!         um = 0.
-!         us = 0.
-!         zts = 5000.
-!  supercell parameters
-         um = 30.
-         us = 15.
-!         us = 0.
-         zts = 5000.
-!  squall-line parameters
-!         um = 12.
-!         us = 10.
-!         zts = 2500.
-
-
-         do i=1,grid % nCells
-            do k=1,nz1
-               ztemp = .5*(zgrid(k,i)+zgrid(k+1,i))
-               if(ztemp .gt. ztr) then
-                  t (k,i) = thetar*exp(9.8*(ztemp-ztr)/(1003.*ttr))
-                  rh(k,i) = 0.25
-               else
-                  t (k,i) = 300.+43.*(ztemp/ztr)**1.25
-                  rh(k,i) = (1.-0.75*(ztemp/ztr)**1.25)
-                  if(t(k,i).lt.thetas) t(k,i) = thetas
-               end if
-               tb(k,i) = t(k,i)
-            end do
-         end do
-
-!         rh(:,:) = 0.
-
-!  set the velocity field - we are on a plane here.
-
-         do i=1, grid % nEdges
-            cell1 = grid % CellsOnEdge % array(1,i)
-            cell2 = grid % CellsOnEdge % array(2,i)
-            if(cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-            do k=1,nz1
-               ztemp = .25*( zgrid(k,cell1 )+zgrid(k+1,cell1 )  &amp;
-                            +zgrid(k,cell2)+zgrid(k+1,cell2))
-               if(ztemp.lt.zts)  then
-                  u(k,i) = um*ztemp/zts
-               else
-                  u(k,i) = um
-               end if
-               if(i == 1 ) grid % u_init % array(k) = u(k,i) - us
-               u(k,i) = sin(grid % angleEdge % array(i)) * (u(k,i) - us) 
-            end do
-            end if
-         end do
-!
-!     reference sounding based on dry atmosphere
-!
-      write(0,*) &quot;k, pitop, tb(k,1), dzu(k)&quot;
-      pitop = 1.-.5*dzw(1)*gravity/(cp*tb(1,1)*zz(1,1))
-      do k=2,nz1
-         pitop = pitop-dzu(k)*gravity/(cp*.5*(tb(k,1)+tb(k-1,1))   &amp;
-                                   *.5*(zz(k,1)+zz(k-1,1)))
-          
-         write(0,*) k,pitop,tb(k,1),dzu(k)
-      end do
-      pitop = pitop-.5*dzw(nz1)*gravity/(cp*tb(nz1,1)*zz(nz1,1))
-
-      ptopb = p0*pitop**(1./rcp)
-      write(6,*) 'ptopb = ',.01*ptopb
-                
-      do i=1, grid % nCells
-         pb(nz1,i) = pitop+.5*dzw(nz1)*gravity/(cp*tb(nz1,i)*zz(nz1,i))
-         p (nz1,i) = pitop+.5*dzw(nz1)*gravity/(cp*t (nz1,i)*zz(nz1,i))
-         do k=nz1-1,1,-1
-            pb(k,i)  = pb(k+1,i) + dzu(k+1)*gravity/(cp*.5*(tb(k,i)+tb(k+1,i))   &amp;
-                                           *.5*(zz(k,i)+zz(k+1,i)))
-            p (k,i)  = p (k+1,i) + dzu(k+1)*gravity/(cp*.5*(t (k,i)+t (k+1,i))   &amp;
-                                           *.5*(zz(k,i)+zz(k+1,i)))
-         end do
-         do k=1,nz1
-            rb (k,i) = pb(k,i)**(1./rcv)/((rgas/p0)*tb(k,i)*zz(k,i))
-            rtb(k,i) = rb(k,i)*tb(k,i)
-            rr (k,i) = p (k,i)**(1./rcv)/((rgas/p0)*t (k,i)*zz(k,i))-rb(k,i)
-            cqw(k,i) = 1.
-         end do
-      end do
-
-      write(0,*) ' base state sounding '
-      do k=1,grid%nVertLevels
-        write(0,*) ' k, pb,rb,tb,rtb,t,rr,p ', k,pb(k,1),rb(k,1),tb(k,1),rtb(k,1),t(k,1),rr(k,1),p(k,1)
-      end do
-
-!-------------------------------------------------------------------
-!     ITERATIONS TO CONVERGE MOIST SOUNDING
-!
-!      delt = -10.
-!      delt = -0.01
-      delt = 3.
-      radx  = 10000.
-      radz  = 1500.
-      zcent = 1500.
-      !xmid = 50000.
-      !ymid = 50000.*cos(pii/6.)
-      xmid = maxval (grid % xCell % array(:))/2. 
-      ymid = maxval (grid % yCell % array(:))/2. 
-
-      do i=1, grid % nCells
-        xloc = grid % xCell % array(i) - xmid
-        yloc = grid % yCell % array(i) - ymid
-!        yloc = 0.
-!        xloc = 0.
-        do k = 1,nz1
-          thi(k,i) = t(k,i)
-          ztemp     = .5*(zgrid(k+1,i)+zgrid(k,i))
-          rad =sqrt((xloc/radx)**2+(yloc/radx)**2+((ztemp-zcent)/radz)**2)
-          if(rad.lt.1)  then
-            thi(k,i) = t(k,i) + delt*cos(.5*pii*rad)**2
-          end if
-        end do
-      end do
-
-      do itr=1,30
-        pitop = 1.-.5*dzw(1)*gravity*(1.+scalars(index_qv,1,1))/(cp*t(1,1)*zz(1,1))
-        do k=2,nz1
-          pitop = pitop-dzu(k)*gravity/(cp*cqw(k,1)*.5*(t (k,1)+t (k-1,1)) &amp;
-                                                  *.5*(zz(k,1)+zz(k-1,1)))
-        end do
-        pitop = pitop - .5*dzw(nz1)*gravity*(1.+scalars(index_qv,nz1,1))/(cp*t(nz1,1)*zz(nz1,1))
-        ptop = p0*pitop**(1./rcp)
-        write(0,*) 'ptop  = ',.01*ptop
-
-      do i = 1, grid % nCells
-
-          pp(nz1,i) = ptop-ptopb+.5*dzw(nz1)*gravity*   &amp;
-                       (rr(nz1,i)+(rr(nz1,i)+rb(nz1,i))*scalars(index_qv,nz1,i))
-          do k=nz1-1,1,-1
-             pp(k,i) = pp(k+1,i)+.5*dzu(k+1)*gravity*                   &amp;
-                            (rr(k  ,i)+(rr(k  ,i)+rb(k  ,i))*scalars(index_qv,k  ,i)  &amp;
-                            +rr(k+1,i)+(rr(k+1,i)+rb(k+1,i))*scalars(index_qv,k+1,i))
-          end do
-          do k=1,nz1
-             rt(k,i) = (pp(k,i)/(rgas*zz(k,i))                   &amp;
-                     -rtb(k,i)*(p(k,i)-pb(k,i)))/p(k,i)       
-             p (k,i) = (zz(k,i)*(rgas/p0)*(rtb(k,i)+rt(k,i)))**rcv
-             rr(k,i) = (rt(k,i)-rb(k,i)*(t(k,i)-tb(k,i)))/t(k,i)
-          end do
-!
-!     update water vapor mixing ratio from humitidty profile
-!
-          do k=1,nz1
-             temp   = p(k,i)*thi(k,i)
-             pres   = p0*p(k,i)**(1./rcp)
-             qvs    = 380.*exp(17.27*(temp-273.)/(temp-36.))/pres
-             scalars(index_qv,k,i) = amin1(0.014,rh(k,i)*qvs)
-          end do
-                        
-          do k=1,nz1
-             t (k,i) = thi(k,i)*(1.+1.61*scalars(index_qv,k,i))
-          end do
-          do k=2,nz1
-             cqw(k,i) = 1./(1.+.5*( scalars(index_qv,k-1,i)  &amp;
-                                   +scalars(index_qv,k  ,i)))
-          end do
-        end do !  iteration loop
-
-      end do ! loop over cells
-!----------------------------------------------------------------------
-!
-      write(0,*) ' sounding for the simulation '
-      do k=1,nz1
-         write(6,166) .5*(zgrid(k,1)+zgrid(k+1,1))/1000.,        &amp;
-                       t(k,1)/(1.+1.61*scalars(index_qv,k,1)),   &amp;
-                       1000.*scalars(index_qv,k,1),              &amp;
-                       (rb(k,1)+rr(k,1))*(1.+scalars(index_qv,k,1)),      &amp;
-                       u(k,1)
-   166    format(1x,f7.3,2x,f9.5,2x,f8.5,2x,f7.5,2x,f9.5)
-      end do
-
-      do k=1,nz1
-         write(6,10) .5*(zgrid(k,1)+zgrid(k+1,1))/1000.,                            &amp;
-                   .01*p0*p(k,1)**(1./rcp),t(k,1)/(1.+1.61*scalars(index_qv,k,1)),  &amp;
-                   1000.*scalars(index_qv,k,1),u(k,1)
-   10    format(1x,5f10.3)
-
-        grid % t_init % array(k) = t(k,1)
-        grid % qv_init % array(k) = scalars(index_qv,k,1)
-
-      end do
-                
-!
-      do i=1,grid % ncells
-         do k=1,nz1
-            rho(k,i) = rb(k,i)+rr(k,i)
-         end do
-      end do
-
-      do i=1,grid % nEdges
-        cell1 = grid % CellsOnEdge % array(1,i)
-        cell2 = grid % CellsOnEdge % array(2,i)
-        if(cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-          do k=1,nz1
-            ru (k,i)  = 0.5*(rho(k,cell1)+rho(k,cell2))*u(k,i)    
-          end do
-        end if
-      end do
-
-!
-!        CALCULATION OF OMEGA, RW = ZX * RU + ZZ * RW
-!
-!  we are assuming w and rw are zero for this initialization
-!  i.e., no terrain
-!
-       grid % rw % array = 0.
-       state % w % array = 0.
-
-!      DO I=1,NX
-!         IM1=I-1
-!         IF(IPER.EQ.1.AND.I.EQ.1) IM1=NX1
-!         RW(1 ,I) = 0.
-!         RW(NZ,I) = 0.
-!         DO K=2,NZ1
-!           RW(K ,I) = (FZM(K)*ZZ(K,I)+FZP(K)*ZZ(K-1,I))*(
-!     &amp;                -RDX*(RUZ(K,I  )*(ZUW(K,I  )-ZGRID(K,I))
-!     &amp;                     -RUZ(K,IM1)*(ZUW(K,IM1)-ZGRID(K,I))))
-!         END DO
-!         DO K=1,NZ
-!            RW1(K,I) = RW(K,I)
-!         END DO
-!      END DO
-
-
-      !
-      ! Generate rotated Coriolis field
-      !
-      do iEdge=1,grid % nEdges
-         grid % fEdge % array(iEdge) = 0.
-      end do
-
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 0.
-      end do
-
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      state % v % array(:,:) = 0.0
-      do iEdge = 1, grid%nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1, grid%nVertLevels
-                 state % v % array(k,iEdge) = state % v %array(k,iEdge) + weightsOnEdge(i,iEdge) * state % u % array(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-!      do iCell = 1, grid % nCells
-!        rt(5,iCell) = rt(5,iCell) + .1
-!      enddo
-
-
-      do k=1,grid%nVertLevels
-        write(0,*) ' k,u_init, t_init, qv_init ',k,grid % u_init % array(k),grid % t_init% array(k),grid % qv_init % array(k)
-      end do
-
-   end subroutine nhyd_test_case_squall_line
-
-   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
-   !   sphere with given radius.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
-
-      real (kind=RKIND) :: arg1
-
-      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
-                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
-      sphere_distance = 2.*radius*asin(arg1)
-
-   end function sphere_distance
-
-end module test_cases

Deleted: branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_time_integration.F.0531
===================================================================
--- branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_time_integration.F.0531        2010-07-12 19:38:09 UTC (rev 372)
+++ branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_time_integration.F.0531        2010-07-13 21:27:45 UTC (rev 373)
@@ -1,2861 +0,0 @@
-module time_integration
-
-   use grid_types
-   use configure
-   use constants
-   use dmpar
-
-
-   contains
-
-
-   subroutine timestep(domain, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Advance model state forward in time by the specified time step
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-
-      type (block_type), pointer :: block
-
-      if (trim(config_time_integration) == 'SRK3') then
-         call srk3(domain, dt)
-      else
-         write(0,*) 'Unknown time integration option '//trim(config_time_integration)
-         write(0,*) 'Currently, only ''SRK3'' is supported.'
-         stop
-      end if
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         block % time_levs(2) % state % xtime % scalar = block % time_levs(1) % state % xtime % scalar + dt
-         block =&gt; block % next
-      end do
-
-   end subroutine timestep
-
-
-   subroutine srk3(domain, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Advance model state forward in time by the specified time step using 
-   !   time-split RK3 scheme
-   !
-   ! Hydrostatic (primitive eqns.) solver
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-
-      integer :: iCell, k, iEdge
-      type (block_type), pointer :: block
-
-      integer, parameter :: TEND   = 1
-      integer :: rk_step, number_of_sub_steps
-
-      real (kind=RKIND), dimension(3) :: rk_timestep, rk_sub_timestep
-      integer, dimension(3) :: number_sub_steps
-      integer :: small_step
-      logical, parameter :: debug = .false.
-!      logical, parameter :: debug = .true.
-      logical, parameter :: debug_mass_conservation = .true.
-      logical, parameter :: do_microphysics = .true.
-
-      real (kind=RKIND) :: domain_mass, scalar_mass, scalar_min, scalar_max
-      real (kind=RKIND) :: global_domain_mass, global_scalar_mass, global_scalar_min, global_scalar_max
-
-      !
-      ! Initialize RK weights
-      !
-
-      number_of_sub_steps = config_number_of_sub_steps
-      rk_timestep(1) = dt/3.
-      rk_timestep(2) = dt/2.
-      rk_timestep(3) = dt
-
-      rk_sub_timestep(1) = dt/3.
-      rk_sub_timestep(2) = dt/real(number_of_sub_steps)
-      rk_sub_timestep(3) = dt/real(number_of_sub_steps)
-
-      number_sub_steps(1) = 1
-      number_sub_steps(2) = number_of_sub_steps/2
-      number_sub_steps(3) = number_of_sub_steps
-
-      if(debug) write(0,*) ' copy step in rk solver '
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         ! We are setting values in the halo here, so no communications are needed.
-         ! Alternatively, we could just set owned cells and edge values and communicate after this block loop.
-         call rk_integration_setup( block % time_levs(2) % state, block % time_levs(1) % state, block % mesh )
-         block =&gt; block % next
-      end do
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      ! BEGIN RK loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      do rk_step = 1, 3  ! Runge-Kutta loop
-
-        if(debug) write(0,*) ' rk substep ', rk_step
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           ! The coefficients are set for owned cells (cqw) and for all edges of owned cells, 
-           ! thus no communications should be needed after this call.  
-           ! We could consider combining this and the next block loop.
-           call compute_moist_coefficients( block % time_levs(2) % state, block % mesh )
-           block =&gt; block % next
-        end do
-
-
-        if (debug) write(0,*) ' compute_dyn_tend '
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call compute_dyn_tend( block % intermediate_step(TEND), block % time_levs(2) % state, block % mesh )
-           block =&gt; block % next
-        end do
-        if (debug) write(0,*) ' finished compute_dyn_tend '
-
-!***********************************
-!  we will need to communicate the momentum tendencies here - we want tendencies for all edges of owned cells
-!  because we are solving for all edges of owned cells
-!***********************************
-
-        block =&gt; domain % blocklist
-          do while (associated(block))
-            call set_smlstep_pert_variables( block % time_levs(1) % state, block % time_levs(2) % state,  &amp;
-                                             block % intermediate_step(TEND), block % mesh               )
-            call compute_vert_imp_coefs( block % time_levs(2) % state, block % mesh, rk_sub_timestep(rk_step) )
-            block =&gt; block % next
-        end do
-
-        do small_step = 1, number_sub_steps(rk_step)
-
-           if(debug) write(0,*) ' acoustic step ',small_step
-      
-           block =&gt; domain % blocklist
-           do while (associated(block))
-              call advance_acoustic_step( block % time_levs(2) % state,  block % intermediate_step(TEND),  &amp;
-                                          block % mesh, rk_sub_timestep(rk_step)                          )
-              block =&gt; block % next
-           end do
-
-           if(debug) write(0,*) ' acoustic step complete '
-  
-           !  will need communications here for rtheta_pp
- 
-        end do  ! end of small stimestep loop
-
-        !  will need communications here for rho_pp
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call recover_large_step_variables( block % time_levs(2) % state,             &amp;
-                                              block % mesh, rk_sub_timestep(rk_step),   &amp;
-                                              number_sub_steps(rk_step)  )
-           block =&gt; block % next
-        end do
-
-!  ************  advection of moist variables here...
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           !
-           ! Note: The advance_scalars_mono routine can be used without limiting, and thus, encompasses 
-           !       the functionality of the advance_scalars routine; however, it is noticeably slower, 
-           !       so we keep the advance_scalars routine as well
-           !
-           if (rk_step &lt; 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then
-              call advance_scalars( block % intermediate_step(TEND),                            &amp;
-                                    block % time_levs(1) % state, block % time_levs(2) % state, &amp;
-                                    block % mesh, rk_timestep(rk_step) )
-           else
-              call advance_scalars_mono( block % intermediate_step(TEND),                            &amp;
-                                         block % time_levs(1) % state, block % time_levs(2) % state, &amp;
-                                         block % mesh, rk_timestep(rk_step), rk_step, 3,             &amp;
-                                         domain % dminfo, block % parinfo % cellsToSend, block % parinfo % cellsToRecv )
-           end if
-           block =&gt; block % next
-        end do
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call compute_solve_diagnostics( dt, block % time_levs(2) % state, block % mesh )
-           block =&gt; block % next
-        end do
-
-        if(debug) write(0,*) ' diagnostics complete '
-
-
-      ! need communications here to fill out u, w, theta, p, and pp, scalars, etc  
-      ! so that they are available for next RK step or the first rk substep of the next timestep
-
-      end do ! rk_step loop
-
-!  microphysics here...
-
-      if(do_microphysics) then
-      block =&gt; domain % blocklist
-        do while (associated(block))
-           call qd_kessler( block % time_levs(1) % state, block % time_levs(2) % state, block % mesh, dt )
-           block =&gt; block % next
-        end do
-      end if
-
-!      if(debug) then
-        block =&gt; domain % blocklist
-          do while (associated(block))
-             scalar_min = 0.
-             scalar_max = 0.
-             do iCell = 1, block % mesh % nCellsSolve
-             do k = 1, block % mesh % nVertLevels
-               scalar_min = min(scalar_min, block % time_levs(2) % state % w % array(k,iCell))
-               scalar_max = max(scalar_max, block % time_levs(2) % state % w % array(k,iCell))
-             enddo
-             enddo
-             write(6,*) ' min, max w ',scalar_min, scalar_max
-
-             scalar_min = 0.
-             scalar_max = 0.
-             do iEdge = 1, block % mesh % nEdgesSolve
-             do k = 1, block % mesh % nVertLevels
-               scalar_min = min(scalar_min, block % time_levs(2) % state % u % array(k,iEdge))
-               scalar_max = max(scalar_max, block % time_levs(2) % state % u % array(k,iEdge))
-             enddo
-             enddo
-             write(6,*) ' min, max u ',scalar_min, scalar_max
-
-             scalar_min = 0.
-             scalar_max = 0.
-             do iCell = 1, block % mesh % nCellsSolve
-             do k = 1, block % mesh % nVertLevels
-               scalar_min = min(scalar_min, block % time_levs(2) % state % scalars % array(index_qc,k,iCell))
-               scalar_max = max(scalar_max, block % time_levs(2) % state % scalars % array(index_qc,k,iCell))
-             enddo
-             enddo
-             write(6,*) ' min, max qc ',scalar_min, scalar_max
-
-             block =&gt; block % next
-
-          end do
-!      end if
-
-
-   end subroutine srk3
-
-!---
-
-   subroutine rk_integration_setup( s_old, s_new, grid )
-
-     implicit none
-     type (grid_state) :: s_new, s_old
-     type (grid_meta) :: grid
-     integer :: iCell, k
-
-     grid % ru_save % array = grid % ru % array
-     grid % rw_save % array = grid % rw % array
-     grid % rtheta_p_save % array = grid % rtheta_p % array
-     grid % rho_p_save % array = s_new % rho_p % array
-
-     s_old % u % array = s_new % u % array
-     s_old % w % array = s_new % w % array
-     s_old % theta % array = s_new % theta % array
-     s_old % rho_p % array = s_new % rho_p % array
-     s_old % rho % array = s_new % rho % array
-     s_old % pressure % array = s_new % pressure % array
-
-
-     s_old % scalars % array = s_new % scalars % array
-
-   end subroutine rk_integration_setup
-
-!-----
-
-   subroutine compute_moist_coefficients( state, grid )
-
-     implicit none
-     type (grid_state) :: state
-     type (grid_meta) :: grid
-
-      integer :: iEdge, iCell, k, cell1, cell2, iq
-      integer :: nCells, nEdges, nVertLevels, nCellsSolve
-      real (kind=RKIND) :: qtot
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertLevels = grid % nVertLevels
-      nCellsSolve = grid % nCellsSolve
-
-        do iCell = 1, nCellsSolve
-          do k = 2, nVertLevels
-            qtot = 0.
-            do iq = moist_start, moist_end
-              qtot = qtot + 0.5 * (state % scalars % array (iq, k, iCell) + state % scalars % array (iq, k-1, iCell))
-            end do
-            grid % cqw % array(k,iCell) = 1./(1.+qtot)
-          end do
-        end do
-
-        do iEdge = 1, nEdges
-          cell1 = grid % cellsOnEdge % array(1,iEdge)
-          cell2 = grid % cellsOnEdge % array(2,iEdge)
-          if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-            do k = 1, nVertLevels
-              qtot = 0.
-              do iq = moist_start, moist_end
-                 qtot = qtot + 0.5 * ( state % scalars % array (iq, k, cell1) + state % scalars % array (iq, k, cell2) )
-              end do
-              grid % cqu % array(k,iEdge) = 1./( 1. + qtot)
-            end do
-          end if
-        end do
-
-   end subroutine compute_moist_coefficients
-
-!---
-
-   subroutine compute_vert_imp_coefs(s, grid, dts)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute coefficients for vertically implicit gravity-wave/acoustic computations
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - cofrz, cofwr, cofwz, coftz, cofwt, a, alpha and gamma
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_state), intent(in) :: s
-      type (grid_meta), intent(inout) :: grid
-      real (kind=RKIND), intent(in) :: dts
-
-      integer :: i, k, iq
-
-      integer :: nCells, nVertLevels, nCellsSolve
-      real (kind=RKIND), dimension(:,:), pointer :: zz, cqw, p, t, rb, rtb, pb, rt
-      real (kind=RKIND), dimension(:,:), pointer :: cofwr, cofwz, coftz, cofwt, a_tri, alpha_tri, gamma_tri
-      real (kind=RKIND), dimension(:), pointer :: cofrz, rdzw, fzm, fzp, rdzu
-
-      real (kind=RKIND), dimension( grid % nVertLevels ) :: b_tri,c_tri
-      real (kind=RKIND) :: epssm, dtseps, c2, qtot, rcv
-
-!  set coefficients
-
-      nCells      = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      nVertLevels = grid % nVertLevels
-!      epssm = grid % epssm  !  this should come in through the namelist  ******************
-      epssm = 0.2
-
-      rdzu =&gt; grid % rdzu % array
-      rdzw =&gt; grid % rdzw % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zz =&gt; grid % zz % array
-      cqw =&gt; grid % cqw % array
-
-      p =&gt; grid % exner % array
-      pb =&gt; grid % exner_base % array
-      rt =&gt; grid % rtheta_p % array
-      rtb =&gt; grid % rtheta_base % array
-      rb =&gt; grid % rho_base % array
-
-      alpha_tri =&gt; grid % alpha_tri % array
-      gamma_tri =&gt; grid % gamma_tri % array
-      a_tri =&gt; grid % a_tri % array
-      cofwr =&gt; grid % cofwr % array      
-      cofwz =&gt; grid % cofwz % array      
-      coftz =&gt; grid % coftz % array      
-      cofwt =&gt; grid % cofwt % array      
-      cofrz =&gt; grid % cofrz % array      
-
-      t =&gt; s % theta % array
-
-      dtseps = .5*dts*(1.+epssm)
-      rcv = rgas/(cp-rgas)
-      c2 = cp*rcv
-
-      do k=1,nVertLevels
-         cofrz(k) = dtseps*rdzw(k)
-      end do
-
-      do i = 1, nCellsSolve  !  we only need to do cells we are solving for, not halo cells
-
-        do k=2,nVertLevels
-          cofwr(k,i) =.5*dtseps*gravity*(fzm(k)*zz(k,i)+fzp(k)*zz(k-1,i))
-        end do
-        do k=2,nVertLevels
-           cofwz(k,i) = dtseps*c2*(fzm(k)*zz(k,i)+fzp(k)*zz(k-1,i))  &amp;
-                *rdzu(k)*cqw(k,i)*(fzm(k)*p (k,i)+fzp(k)*p (k-1,i))
-           coftz(k,i) = dtseps*   (fzm(k)*t (k,i)+fzp(k)*t (k-1,i))
-        end do
-        do k=1,nVertLevels
-
-          qtot = 0.
-          do iq = moist_start, moist_end
-            qtot = qtot + s % scalars % array (iq, k, i)
-          end do
-
-          cofwt(k,i) = .5*dtseps*rcv*zz(k,i)*gravity*rb(k,i)/(1.+qtot)  &amp;
-                              *p(k,i)/((rtb(k,i)+rt(k,i))*pb(k,i))
-        end do
-
-        a_tri(1,i) = 0.  ! note, this value is never used
-        b_tri(1) = 1.    ! note, this value is never used
-        c_tri(1) = 0.    ! note, this value is never used
-        gamma_tri(1,i) = 0.
-        alpha_tri(1,i) = 0.  ! note, this value is never used
-
-        do k=2,nVertLevels
-          a_tri(k,i) = -cofwz(k  ,i)* coftz(k-1,i)*rdzw(k-1)*zz(k-1,i)   &amp;
-                       +cofwr(k  ,i)* cofrz(k-1  )                       &amp;
-                       -cofwt(k-1,i)* coftz(k-1,i)*rdzw(k-1)
-          b_tri(k) = 1.                                                  &amp;
-                       +cofwz(k  ,i)*(coftz(k  ,i)*rdzw(k  )*zz(k  ,i)   &amp;
-                                    +coftz(k  ,i)*rdzw(k-1)*zz(k-1,i))   &amp;
-                       -coftz(k  ,i)*(cofwt(k  ,i)*rdzw(k  )             &amp;
-                                     -cofwt(k-1,i)*rdzw(k-1))            &amp;
-                       +cofwr(k,  i)*(cofrz(k    )-cofrz(k-1))
-          c_tri(k) =   -cofwz(k  ,i)* coftz(k+1,i)*rdzw(k  )*zz(k  ,i)   &amp;
-                       -cofwr(k  ,i)* cofrz(k    )                       &amp;
-                       +cofwt(k  ,i)* coftz(k+1,i)*rdzw(k  )
-        end do
-        do k=2,nVertLevels
-          alpha_tri(k,i) = 1./(b_tri(k)-a_tri(k,i)*gamma_tri(k-1,i))
-          gamma_tri(k,i) = c_tri(k)*alpha_tri(k,i)
-        end do
-
-      end do ! loop over cells
-
-      end subroutine compute_vert_imp_coefs
-
-!------------------------
-
-      subroutine set_smlstep_pert_variables( s_old, s_new, tend, grid )
-
-      implicit none
-      type (grid_state) :: s_new, s_old, tend
-      type (grid_meta) :: grid
-      integer :: iCell, k
-
-      grid % rho_pp % array = grid % rho_p_save % array - s_new % rho_p % array
-
-      grid % ru_p % array = grid % ru_save % array - grid % ru % array
-      grid % rtheta_pp % array = grid % rtheta_p_save % array - grid % rtheta_p % array
-      grid % rtheta_pp_old % array = grid % rtheta_pp % array
-      grid % rw_p % array = grid % rw_save % array - grid % rw % array
-
-      do iCell = 1, grid % nCellsSolve
-      do k = 2, grid % nVertLevels
-        tend % w % array(k,iCell) = ( grid % fzm % array (k) * grid % zz % array(k  ,iCell) +   &amp;
-                                      grid % fzp % array (k) * grid % zz % array(k-1,iCell)   ) &amp;
-                                     * tend % w % array(k,iCell)
-      end do
-      end do
-
-      grid % ruAvg % array = 0.
-      grid % wwAvg % array = 0.
-
-      end subroutine set_smlstep_pert_variables
-
-!-------------------------------
-
-      subroutine advance_acoustic_step( s, tend, grid, dts )
-
-      implicit none
-
-      type (grid_state) :: s, tend
-      type (grid_meta) :: grid
-      real (kind=RKIND), intent(in) :: dts
-
-      real (kind=RKIND), dimension(:,:), pointer :: rho, theta, ru_p, rw_p, rtheta_pp,    &amp;
-                                                    rtheta_pp_old, zz, exner, cqu, ruAvg, &amp;
-                                                    wwAvg, rho_pp, cofwt, coftz, zx,      &amp;
-                                                    a_tri, alpha_tri, gamma_tri, dss,     &amp;
-                                                    tend_ru, tend_rho, tend_rt, tend_rw,  &amp;
-                                                    zgrid, cofwr, cofwz, w
-      real (kind=RKIND), dimension(:), pointer :: fzm, fzp, rdzw, dcEdge, AreaCell, cofrz, dvEdge
-
-      real (kind=RKIND) :: smdiv, c2, rcv
-      real (kind=RKIND), dimension( grid % nVertLevels ) :: du
-      real (kind=RKIND), dimension( grid % nVertLevels + 1 ) :: dpzx
-      real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells ) :: ts, rs
-      real (kind=RKIND), dimension( grid % nVertLevels + 1 , grid % nCells ) :: ws
-
-      integer :: cell1, cell2, iEdge, iCell, k
-      real (kind=RKIND) :: pgrad, flux1, flux2, flux, resm, epssm
-
-      real (kind=RKIND) :: cf1, cf2, cf3
-
-      integer :: nEdges, nCells, nCellsSolve, nVertLevels
-
-      logical, parameter :: debug = .false.
-!      logical, parameter :: debug = .true.
-      logical, parameter :: debug1 = .false.
-      real (kind=RKIND) :: wmax
-      integer :: iwmax, kwmax
-
-!--
-
-      rho =&gt; s % rho % array
-      theta =&gt; s % theta % array
-      w =&gt; s % w % array
-
-      rtheta_pp =&gt; grid % rtheta_pp % array
-      rtheta_pp_old =&gt; grid % rtheta_pp_old % array
-      ru_p =&gt; grid % ru_p % array
-      rw_p =&gt; grid % rw_p % array
-      exner =&gt; grid % exner % array
-      cqu =&gt; grid % cqu % array
-      ruAvg =&gt; grid % ruAvg % array
-      wwAvg =&gt; grid % wwAvg % array
-      rho_pp =&gt; grid % rho_pp % array
-      cofwt =&gt; grid % cofwt % array
-      coftz =&gt; grid % coftz % array
-      cofrz =&gt; grid % cofrz % array
-      cofwr =&gt; grid % cofwr % array
-      cofwz =&gt; grid % cofwz % array
-      a_tri =&gt; grid % a_tri % array
-      alpha_tri =&gt; grid % alpha_tri % array
-      gamma_tri =&gt; grid % gamma_tri % array
-      dss =&gt; grid % dss % array
-
-      tend_ru =&gt; tend % u % array
-      tend_rho =&gt; tend % rho % array
-      tend_rt =&gt; tend % theta % array
-      tend_rw =&gt; tend % w % array
-
-      zz =&gt; grid % zz % array
-      zx =&gt; grid % zx % array
-      zgrid =&gt; grid % zgrid % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      rdzw =&gt; grid % rdzw % array
-      dcEdge =&gt; grid % dcEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-      AreaCell =&gt; grid % AreaCell % array
-
-!  might these be pointers instead? **************************
-
-      nEdges = grid % nEdges
-      nCells = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      nVertLevels = grid % nVertLevels
-
-!  cf1, cf2 and cf3 should come from the initialization  *************
-
-      cf1 = 1.5
-      cf2 = -0.5
-      cf3 = 0.
-
-!  these values should come from the namelist  *****************
-
-      epssm = 0.2
-      smdiv = 0.1
-
-      rcv = rgas/(cp-rgas)
-      c2 = cp*rcv
-      resm   = (1.-epssm)/(1.+epssm)
-
-      ts = 0.
-      rs = 0.
-      ws = 0.
-
-      ! acoustic step divergence damping - forward weight rtheta_pp
-      rtheta_pp_old = rtheta_pp + smdiv*(rtheta_pp - rtheta_pp_old)
-
-      if(debug) write(0,*) ' updating ru_p '
-
-      do iEdge = 1, nEdges
- 
-        cell1 = grid % cellsOnEdge % array (1,iEdge)
-        cell2 = grid % cellsOnEdge % array (2,iEdge)
-        ! update edge for block-owned cells
-        if (cell1 &lt;= grid % nCellsSolve .or. cell2 &lt;= grid % nCellsSolve ) then
-
-          k = 1
-          dpzx(k) = .5*zx(k,iEdge)*(cf1*(zz(k  ,cell2)*rtheta_pp_old(k  ,cell2)    &amp;
-                                        +zz(k  ,cell1)*rtheta_pp_old(k  ,cell1))   &amp;
-                                   +cf2*(zz(k+1,cell2)*rtheta_pp_old(k+1,cell2)    &amp;
-                                        +zz(k+1,cell1)*rtheta_pp_old(k+1,cell1))   &amp;
-                                   +cf3*(zz(k+2,cell2)*rtheta_pp_old(k+2,cell2)    &amp;
-                                        +zz(k+2,cell1)*rtheta_pp_old(k+2,cell1)))
-          do k=2,grid % nVertLevels
-            dpzx(k)=.5*zx(k,iEdge)*(fzm(k)*(zz(k  ,cell2)*rtheta_pp_old(k  ,cell2)   &amp;
-                                           +zz(k  ,cell1)*rtheta_pp_old(k  ,cell1))  &amp;
-                                   +fzp(k)*(zz(k-1,cell2)*rtheta_pp_old(k-1,cell2)   &amp;
-                                           +zz(k-1,cell1)*rtheta_pp_old(k-1,cell1)))
-          end do
-          dpzx(nVertLevels + 1) = 0.
-
-          do k=1,nVertLevels
-            pgrad =  (rtheta_pp_old(k,cell2)-rtheta_pp_old(k,cell1))/dcEdge(iEdge)  &amp;
-                         - rdzw(k)*(dpzx(k+1)-dpzx(k))
-            pgrad = 0.5*c2*(exner(k,cell1)+exner(k,cell2))*pgrad
-            du(k) = dts*(tend_ru(k,iEdge) - cqu(k,iEdge) * pgrad)
-
-            ru_p(k,iEdge) = ru_p(k,iEdge) + du(k)
-
-            if(debug) then
-              if(iEdge == 3750) then
-                write(0,*) ' k, pgrad, tend_ru ',k,pgrad,tend_ru(k,3750)
-              end if
-            end if
-
-!  need to add horizontal fluxes into density update, rtheta update and w update
-
-            flux = dts*dvEdge(iEdge)*ru_p(k,iEdge)
-            rs(k,cell1) = rs(k,cell1)-flux/AreaCell(cell1)
-            rs(k,cell2) = rs(k,cell2)+flux/AreaCell(cell2)
-
-            flux = flux*0.5*(theta(k,cell2)+theta(k,cell1))
-            ts(k,cell1) = ts(k,cell1)-flux/AreaCell(cell1)
-            ts(k,cell2) = ts(k,cell2)+flux/AreaCell(cell2)
-
-            ruAvg(k,iEdge) = ruAvg(k,iEdge) + ru_p(k,iEdge)
-
-          end do
-
-          do k=2,nVertLevels
-            flux =  dts*0.5*dvEdge(iEdge)*((zgrid(k,cell2)-zgrid(k,cell1))*(fzm(k)*du(k)+fzp(k)*du(k-1))  )
-            flux2 =  - (fzm(k)*zz(k  ,cell2) +fzp(k)*zz(k-1,cell2))*flux/AreaCell(cell2)
-            flux1 =  - (fzm(k)*zz(k  ,cell1) +fzp(k)*zz(k-1,cell1))*flux/AreaCell(cell1)
-            ws(k,cell2) = ws(k,cell2) + flux2
-            ws(k,cell1) = ws(k,cell1) + flux1
-          enddo
-
-        end if ! end test for block-owned cells
-
-      end do ! end loop over edges
-
-      ! saving rtheta_pp before update for use in divergence damping in next acoustic step
-      rtheta_pp_old(:,:) = rtheta_pp(:,:)
-
-      do iCell = 1, nCellsSolve
-
-        do k=1, nVertLevels
-          rs(k,iCell) = rho_pp(k,iCell) + dts*tend_rho(k,iCell) + rs(k,iCell)      &amp;
-                          - cofrz(k)*resm*(rw_p(k+1,iCell)-rw_p(k,iCell))
-          ts(k,iCell) = rtheta_pp(k,iCell) + dts*tend_rt(k,iCell) + ts(k,iCell)    &amp;
-                             - resm*rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell)      &amp;
-                             -coftz(k,iCell)*rw_p(k,iCell))
-        enddo
-
-        do k=2, nVertLevels
-
-          wwavg(k,iCell) = wwavg(k,iCell) + 0.5*(1.-epssm)*rw_p(k,iCell)
-
-          rw_p(k,iCell) = rw_p(k,iCell) + ws(k,iCell) + dts*tend_rw(k,iCell)          &amp;
-                     - cofwz(k,iCell)*((zz(k  ,iCell)*ts (k  ,iCell)                  &amp;
-                                   -zz(k-1,iCell)*ts (k-1,iCell))                     &amp;
-                             +resm*(zz(k  ,iCell)*rtheta_pp(k  ,iCell)                &amp;
-                                   -zz(k-1,iCell)*rtheta_pp(k-1,iCell)))              &amp;
-                     - cofwr(k,iCell)*((rs (k,iCell)+rs (k-1,iCell))                  &amp;
-                             +resm*(rho_pp(k,iCell)+rho_pp(k-1,iCell)))               &amp;
-                     + cofwt(k  ,iCell)*(ts (k  ,iCell)+resm*rtheta_pp(k  ,iCell))    &amp;
-                     + cofwt(k-1,iCell)*(ts (k-1,iCell)+resm*rtheta_pp(k-1,iCell))
-        enddo
-
-        do k=2,nVertLevels
-          rw_p(k,iCell) = (rw_p(k,iCell)-a_tri(k,iCell)*rw_p(k-1,iCell))*alpha_tri(k,iCell)
-        end do
-
-        do k=nVertLevels,1,-1
-          rw_p(k,iCell) = rw_p(k,iCell) - gamma_tri(k,iCell)*rw_p(k+1,iCell)                     
-        end do
-
-        do k=2,nVertLevels
-           rw_p(k,iCell) = (rw_p(k,iCell)-dts*dss(k,iCell)*               &amp;
-                       (fzm(k)*zz (k,iCell)+fzp(k)*zz (k-1,iCell))        &amp;
-                       *(fzm(k)*rho(k,iCell)+fzp(k)*rho(k-1,iCell))       &amp;
-                                *w(k,iCell)    )/(1.+dts*dss(k,iCell))
-
-           wwAvg(k,iCell) = wwAvg(k,iCell) + 0.5*(1.+epssm)*rw_p(k,iCell)
-
-        end do
-
-        do k=1,nVertLevels
-          rho_pp(k,iCell) = rs(k,iCell) - cofrz(k) *(rw_p(k+1,iCell)-rw_p(k  ,iCell))
-          rtheta_pp(k,iCell) = ts(k,iCell) - rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell)  &amp;
-                             -coftz(k  ,iCell)*rw_p(k  ,iCell))
-        end do
-
-      end do !  end of loop over cells
-
-      end subroutine advance_acoustic_step
-
-!------------------------
-
-      subroutine recover_large_step_variables( s, grid, dt, ns )
-
-      implicit none
-      type (grid_state) :: s
-      type (grid_meta) :: grid
-      integer, intent(in) :: ns
-      real (kind=RKIND), intent(in) :: dt
-
-      real (kind=RKIND), dimension(:,:), pointer :: wwAvg, rw_save, w, rw, rw_p, rtheta_p, rtheta_pp,   &amp;
-                                                    rtheta_p_save, rt_diabatic_tend, rho_p, rho_p_save, &amp;
-                                                    rho_pp, rho, rho_base, ruAvg, ru_save, ru_p, u, ru, &amp;
-                                                    exner, exner_base, rtheta_base, pressure_p,         &amp;
-                                                    zz, theta, zgrid
-      real (kind=RKIND), dimension(:), pointer :: fzm, fzp, dvEdge, AreaCell
-      integer, dimension(:,:), pointer :: CellsOnEdge
-
-      integer :: iCell, iEdge, k, cell1, cell2
-      integer :: nVertLevels, nCells, nCellsSolve, nEdges, nEdgesSolve
-      real (kind=RKIND) :: rcv, p0, cf1, cf2, cf3, flux
-
-!      logical, parameter :: debug=.true.
-      logical, parameter :: debug=.false.
-
-!---
-
-       wwAvg =&gt; grid % wwAvg % array
-       rw_save =&gt; grid % rw_save % array
-       rw =&gt; grid % rw % array
-       rw_p =&gt; grid % rw_p % array
-       w =&gt; s % w % array
-
-       rtheta_p =&gt; grid % rtheta_p % array
-       rtheta_p_save =&gt; grid % rtheta_p_save % array
-       rtheta_pp =&gt; grid % rtheta_pp % array
-       rtheta_base =&gt; grid % rtheta_base % array
-       rt_diabatic_tend =&gt; grid % rt_diabatic_tend % array
-       theta =&gt; s % theta % array
-
-       rho =&gt; s % rho % array
-       rho_p =&gt; s % rho_p % array
-       rho_p_save =&gt; grid % rho_p_save % array
-       rho_pp =&gt; grid % rho_pp % array
-       rho_base =&gt; grid % rho_base % array
-
-       ruAvg =&gt; grid % ruAvg % array
-       ru_save =&gt; grid % ru_save % array
-       ru_p =&gt; grid % ru_p % array
-       ru =&gt; grid % ru % array
-       u =&gt; s % u % array
-
-       exner =&gt; grid % exner % array
-       exner_base =&gt; grid % exner_base % array
-
-       pressure_p =&gt; s % pressure % array
-
-       zz =&gt; grid % zz % array
-       zgrid =&gt; grid % zgrid % array
-       fzm =&gt; grid % fzm % array
-       fzp =&gt; grid % fzp % array
-       dvEdge =&gt; grid % dvEdge % array
-       AreaCell =&gt; grid % AreaCell % array
-       CellsOnEdge =&gt; grid % CellsOnEdge % array
-
-       nVertLevels = grid % nVertLevels
-       nCells = grid % nCells
-       nCellsSolve = grid % nCellsSolve
-       nEdges = grid % nEdges
-       nEdgesSolve = grid % nEdgesSolve
-
-       rcv = rgas/(cp-rgas)
-       p0 = 1.e+05  ! this should come from somewhere else...
-       cf1 = 1.5
-       cf2 = -0.5
-       cf3 = 0.
-
-      ! compute new density everywhere so we can compute u from ru.
-      ! we will also need it to compute theta below
-
-      do iCell = 1, nCells
-
-        if(debug) then
-          if( iCell == 479 ) then
-             write(0,*) ' k,rho_old,rp_old, rho_pp '
-            do k=1,nVertLevels
-              write(0,*) k, rho(k,iCell) ,rho_p(k,iCell), rho_pp(k,iCell)
-            enddo
-          end if
-        end if
-
-        do k = 1, nVertLevels
-
-          rho_p(k,iCell) = rho_p(k,iCell) + rho_pp(k,iCell)
-
-          rho(k,iCell) = rho_p(k,iCell) + rho_base(k,iCell)
-        end do
-
-      !  recover owned-cell values in block
-
-        if( iCell &lt;= nCellsSolve ) then
-
-          if(debug) then
-          if( iCell == 479 ) then
-             write(0,*) ' k, rw, rw_save, rw_p '
-            do k=1,nVertLevels
-              write(0,*) k, rw(k,iCell), rw_save(k,iCell) ,rw_p(k,iCell)
-            enddo
-          end if
-          end if
-
-          w(1,iCell) = 0.
-          do k = 2, nVertLevels
-            wwAvg(k,iCell) = rw(k,iCell) + (wwAvg(k,iCell) / float(ns))
-
-            rw(k,iCell) = rw(k,iCell) + rw_p(k,iCell)
-
-
-          ! pick up part of diagnosed w from omega
-            w(k,iCell) = rw(k,iCell)/( (fzm(k)*zz (k,iCell)+fzp(k)*zz (k-1,iCell))   &amp;
-                                      *(fzm(k)*rho(k,iCell)+fzp(k)*rho(k-1,iCell)) )
-          end do
-          w(nVertLevels+1,iCell) = 0.
-
-          if(debug) then
-          if( iCell == 479 ) then
-             write(0,*) ' k, rtheta_p_save, rtheta_pp, rtheta_base '
-            do k=1,nVertLevels
-              write(0,*) k, rtheta_p_save(k,iCell), rtheta_pp(k,iCell), rtheta_base(k,iCell)
-            enddo
-          end if
-          end if
-
-          do k = 1, nVertLevels
-
-            rtheta_p(k,iCell) = rtheta_p(k,iCell) + rtheta_pp(k,iCell) ! - dt * rt_diabatic_tend(k,iCell)
-
-
-            theta(k,iCell) = (rtheta_p(k,iCell) + rtheta_base(k,iCell))/rho(k,iCell)
-            exner(k,iCell) = (zz(k,iCell)*(rgas/p0)*(rtheta_p(k,iCell)+rtheta_base(k,iCell)))**rcv
-             ! pressure below is perturbation pressure - perhaps we should rename it in the Registry????
-            pressure_p(k,iCell) = zz(k,iCell) * rgas * (exner(k,iCell)*rtheta_p(k,iCell)+rtheta_base(k,iCell)  &amp;
-                                                          * (exner(k,iCell)-exner_base(k,iCell)))
-          end do
-
-        end if
-
-      end do
-
-      ! recover time-averaged ruAvg on all edges of owned cells (for upcoming scalar transport).  
-      ! we solved for these in the acoustic-step loop.  
-      ! we will compute ru and u here also, given we are here, even though we only need them on nEdgesSolve
-
-      do iEdge = 1, nEdges
-
-        cell1 = CellsOnEdge(1,iEdge)
-        cell2 = CellsOnEdge(2,iEdge)
-
-        if( cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve ) then
-
-          do k = 1, nVertLevels
-            ruAvg(k,iEdge) = ru(k,iEdge) + (ruAvg(k,iEdge) / float(ns))
-
-            ru(k,iEdge) = ru(k,iEdge) + ru_p(k,iEdge)
-
-            u(k,iEdge) = 2.*ru(k,iEdge)/(rho(k,cell1)+rho(k,cell2))
-          enddo
-
-          flux = dvEdge(iEdge)*0.5*(cf1*u(1,iEdge)+cf2*u(2,iEdge)+cf3*u(3,iEdge))*(zgrid(1,cell2)-zgrid(1,cell1))
-          w(1,cell2) = w(1,cell2)+flux/AreaCell(cell2) 
-          w(1,cell1) = w(1,cell1)+flux/AreaCell(cell1) 
-
-          do k = 2, nVertLevels
-            flux = dvEdge(iEdge)*0.5*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))*(zgrid(k,cell2)-zgrid(k,cell1))
-            w(k,cell2) = w(k,cell2)+flux/AreaCell(cell2) 
-            w(k,cell1) = w(k,cell1)+flux/AreaCell(cell1) 
-          enddo
-
-        end if
-
-      enddo
-
-      end subroutine recover_large_step_variables
-
-!---------------------------------------------------------------------------------------
-
-   subroutine advance_scalars( tend, s_old, s_new, grid, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed scalar tendencies
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (grid_state), intent(in) :: tend
-      type (grid_state), intent(in) :: s_old
-      type (grid_state), intent(out) :: s_new
-      type (grid_meta), intent(in) :: grid
-      real (kind=RKIND) :: dt
-
-      integer :: i, iCell, iEdge, k, iScalar, cell1, cell2
-      real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, h_old, h_new, wwAvg, rho_edge, rho, zgrid
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell, qv_init
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND), dimension( num_scalars, grid % nVertLevels + 1 ) :: wdtn
-      integer :: nVertLevels
-
-      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
-      real (kind=RKIND) :: coef_3rd_order
-
-
-      real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2, scalar_turb_flux, z1,z2,z3,z4,zm,z0,zp
-      logical, parameter :: mix_full = .false.
-!      logical, parameter :: mix_full = .true.
-
-      coef_3rd_order = 0.
-      if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
-      if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-      scalar_old  =&gt; s_old % scalars % array
-      scalar_new  =&gt; s_new % scalars % array
-      deriv_two   =&gt; grid % deriv_two % array
-!****      uhAvg       =&gt; grid % uhAvg % array
-      uhAvg       =&gt; grid % ruAvg % array
-      dvEdge      =&gt; grid % dvEdge % array
-      dcEdge      =&gt; grid % dcEdge % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      scalar_tend =&gt; tend % scalars % array
-!****      h_old       =&gt; s_old % h % array
-!****      h_new       =&gt; s_new % h % array
-      h_old       =&gt; s_old % rho % array
-      h_new       =&gt; s_new % rho % array
-      wwAvg       =&gt; grid % wwAvg % array
-      areaCell    =&gt; grid % areaCell % array
-
-!****      fnm         =&gt; grid % fnm % array
-!****      fnp         =&gt; grid % fnp % array
-!****      rdnw        =&gt; grid % rdnw % array
-      fnm         =&gt; grid % fzm % array
-      fnp         =&gt; grid % fzp % array
-      rdnw        =&gt; grid % rdzw % array
-
-      nVertLevels = grid % nVertLevels
-
-      h_theta_eddy_visc2 = config_h_theta_eddy_visc2
-      v_theta_eddy_visc2 = config_v_theta_eddy_visc2
-      rho_edge     =&gt; s_new % rho_edge % array
-      rho          =&gt; s_new % rho % array
-      qv_init      =&gt; grid % qv_init % array
-      zgrid        =&gt; grid % zgrid % array
-
-      scalar_tend = 0.  !  testing purposes - we have no sources or sinks
-
-      !
-      ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts form scalar_old
-      !
-      !
-      !  horizontal flux divergence, accumulate in scalar_tend
-
-      if (config_scalar_adv_order == 2) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-               do k=1,grid % nVertLevels
-                  do iScalar=1,num_scalars
-                     scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
-                     flux = uhAvg(k,iEdge) * dvEdge(iEdge)  * scalar_edge
-                     scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
-                     scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
-                  end do 
-               end do 
-            end if
-         end do 
-
-      else if (config_scalar_adv_order == 3) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-  
-               do k=1,grid % nVertLevels
-   
-                  do iScalar=1,num_scalars
-                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
-                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
-                     do i=1, grid % nEdgesOnCell % array (cell1)
-                        if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                        d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                       deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
-                     end do
-                     do i=1, grid % nEdgesOnCell % array (cell2)
-                        if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                        d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                       deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
-                     end do
- 
-                     if (uhAvg(k,iEdge) &gt; 0) then
-                        flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
-                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                                -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                                -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     else
-                        flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                                -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                                +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     end if
-
-! old version of the above code, with coef_3rd_order assumed to be 1.0
-!                     if (uhAvg(k,iEdge) &gt; 0) then
-!                        flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
-!                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-!                                               -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
-!                     else
-!                        flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-!                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-!                                               -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
-!                     end if
-    
-                     scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
-                     scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
-  
-                  end do 
-               end do 
-            end if
-         end do 
-
-      else  if (config_scalar_adv_order == 4) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-
-               do k=1,grid % nVertLevels
-   
-                  do iScalar=1,num_scalars
-                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
-                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
-                     do i=1, grid % nEdgesOnCell % array (cell1)
-                        if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                           d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                          deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
-                     end do
-                     do i=1, grid % nEdgesOnCell % array (cell2)
-                        if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                        d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                       deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
-                     end do
-       
-                     flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-       
-                     scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
-                     scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
-                  end do 
-               end do 
-            end if
- 
-         end do
-      end if
-
-!  horizontal mixing for scalars - we could combine this with transport...
-
-      if ( h_theta_eddy_visc2 &gt; 0.0 ) then
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-
-               do k=1,grid % nVertLevels
-                  do iScalar=1,num_scalars
-                    scalar_turb_flux = h_theta_eddy_visc2*prandtl*  &amp;
-                                        (scalar_new(iScalar,k,cell2) - scalar_new(iScalar,k,cell1))/dcEdge(iEdge)
-                    flux = dvEdge (iEdge) * rho_edge(k,iEdge) * scalar_turb_flux
-                    scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) + flux/areaCell(cell1)
-                    scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) - flux/areaCell(cell2)
-                  end do
-               end do
-
-            end if
-         end do
-
-      end if
-
-      ! vertical mixing
-
-      if ( v_theta_eddy_visc2 &gt; 0.0 ) then
-
-         do iCell = 1, grid % nCellsSolve
-            do k=2,nVertLevels-1
-               z1 = zgrid(k-1,iCell)
-               z2 = zgrid(k  ,iCell)
-               z3 = zgrid(k+1,iCell)
-               z4 = zgrid(k+2,iCell)
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               do iScalar=1,num_scalars
-                 scalar_tend(iScalar,k,iCell) = scalar_tend(iScalar,k,iCell) + v_theta_eddy_visc2*prandtl*rho(k,iCell)*(&amp;
-                                        (scalar_new(iScalar,k+1,iCell)-scalar_new(iScalar,k  ,iCell))/(zp-z0)                 &amp;
-                                       -(scalar_new(iScalar,k  ,iCell)-scalar_new(iScalar,k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
-               end do
-             end do
-
-             if ( .not. mix_full) then
-             iScalar = index_qv
-               do k=2,nVertLevels-1
-                z1 = zgrid(k-1,iCell)
-                z2 = zgrid(k  ,iCell)
-                z3 = zgrid(k+1,iCell)
-                z4 = zgrid(k+2,iCell)
-
-                zm = 0.5*(z1+z2)
-                z0 = 0.5*(z2+z3)
-                zp = 0.5*(z3+z4)
-
-                 scalar_tend(iScalar,k,iCell) = scalar_tend(iScalar,k,iCell) + v_theta_eddy_visc2*prandtl*rho(k,iCell)*(&amp;
-                                        (-qv_init(k+1)+qv_init(k))/(zp-z0) &amp;
-                                       -(-qv_init(k)+qv_init(k-1))/(z0-zm) )/(0.5*(zp-zm))
-               end do
-             end if
-
-         end do
-
-         end if
-
-      !
-      !  vertical flux divergence
-      !
-
-      do iCell=1,grid % nCells
-
-        wdtn(:,1) = 0.
-        do k = 2, nVertLevels
-          do iScalar=1,num_scalars
-            wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
-          end do
-        end do
-        wdtn(:,nVertLevels+1) = 0.
-
-         do k=1,grid % nVertLevelsSolve
-            do iScalar=1,num_scalars
-              scalar_new(iScalar,k,iCell) = (   scalar_old(iScalar,k,iCell)*h_old(k,iCell) &amp;
-                    + dt*( scalar_tend(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) )/h_new(k,iCell)
-                                                                                        
-            end do
-         end do
-      end do
-
-   end subroutine advance_scalars
-
-
-   subroutine advance_scalars_mono( tend, s_old, s_new, grid, dt, rk_step, rk_order, dminfo, cellsToSend, cellsToRecv)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed scalar tendencies
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (grid_state), intent(in) :: tend
-      type (grid_state), intent(in) :: s_old
-      type (grid_state), intent(out) :: s_new
-      type (grid_meta), intent(in) :: grid
-      integer, intent(in) :: rk_step, rk_order
-      real (kind=RKIND), intent(in) :: dt
-      type (dm_info), intent(in) :: dminfo
-      type (exchange_list), pointer :: cellsToSend, cellsToRecv
-
-      integer :: i, iCell, iEdge, k, iScalar, cell_upwind, cell1, cell2
-      real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
-      real (kind=RKIND) :: fdir, flux_upwind, h_flux_upwind, s_upwind
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, h_old, h_new, wwAvg
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND), dimension( num_scalars, grid % nEdges) :: h_flux
-      real (kind=RKIND), dimension( num_scalars, grid % nCells, 2 ) :: v_flux, v_flux_upwind, s_update
-      real (kind=RKIND), dimension( num_scalars, grid % nCells, 2 ) :: scale_out, scale_in
-      real (kind=RKIND), dimension( num_scalars ) :: s_max, s_min, s_max_update, s_min_update
-
-      integer :: nVertLevels, km0, km1, ktmp, kcp1, kcm1
-
-      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
-      real (kind=RKIND), parameter :: eps=1.e-20
-      real (kind=RKIND) :: coef_3rd_order
-
-      scalar_old  =&gt; s_old % scalars % array
-      scalar_new  =&gt; s_new % scalars % array
-      deriv_two   =&gt; grid % deriv_two % array
-!****      uhAvg       =&gt; grid % uhAvg % array
-      uhAvg       =&gt; grid % ruAvg % array
-      dvEdge      =&gt; grid % dvEdge % array
-      dcEdge      =&gt; grid % dcEdge % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      scalar_tend =&gt; tend % scalars % array
-!****      h_old       =&gt; s_old % h % array
-!****      h_new       =&gt; s_new % h % array
-      h_old       =&gt; s_old % rho % array
-      h_new       =&gt; s_new % rho % array
-      wwAvg       =&gt; grid % wwAvg % array
-      areaCell    =&gt; grid % areaCell % array
-
-!****      fnm         =&gt; grid % fnm % array
-!****      fnp         =&gt; grid % fnp % array
-!****      rdnw        =&gt; grid % rdnw % array
-      fnm         =&gt; grid % fzm % array
-      fnp         =&gt; grid % fzp % array
-      rdnw        =&gt; grid % rdzw % array
-
-      nVertLevels = grid % nVertLevels
-
-      scalar_tend = 0.  !  testing purposes - we have no sources or sinks
-
-      !
-      ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old
-      !
-
-      km1 = 1
-      km0 = 2
-      v_flux(:,:,km1) = 0.
-      v_flux_upwind(:,:,km1) = 0.
-      scale_out(:,:,:) = 1.
-      scale_in(:,:,:) = 1.
-
-      coef_3rd_order = 0.
-      if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
-      if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-      do k = 1, grid % nVertLevels
-         kcp1 = min(k+1,grid % nVertLevels)
-         kcm1 = max(k-1,1)
-
-!  vertical flux
-
-         do iCell=1,grid % nCells
-
-            if (k &lt; grid % nVertLevels) then
-               cell_upwind = k
-               if (wwAvg(k+1,iCell) &gt;= 0) cell_upwind = k+1
-               do iScalar=1,num_scalars
-                  v_flux(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) *   &amp;
-                       (fnm(k+1) * scalar_new(iScalar,k+1,iCell) + fnp(k+1) * scalar_new(iScalar,k,iCell))
-                  v_flux_upwind(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) * scalar_old(iScalar,cell_upwind,iCell)
-                  v_flux(iScalar,iCell,km0) = v_flux(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km0)
-!                  v_flux(iScalar,iCell,km0) = 0.  ! use only upwind - for testing
-                  s_update(iScalar,iCell,km0) = scalar_old(iScalar,k,iCell) * h_old(k,iCell)  &amp;
-                            - rdnw(k) * (v_flux_upwind(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km1))
-               end do
-            else
-               do iScalar=1,num_scalars
-                  v_flux(iScalar,iCell,km0) = 0.
-                  v_flux_upwind(iScalar,iCell,km0) = 0.
-                  s_update(iScalar,iCell,km0) = scalar_old(iScalar,k,iCell) * h_old(k,iCell)  &amp;
-                            - rdnw(k) * (v_flux_upwind(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km1))
-               end do
-            end if
-
-         end do
-
-! horizontal flux
-
-         if (config_scalar_adv_order == 2) then
-
-            do iEdge=1,grid%nEdges
-               cell1 = cellsOnEdge(1,iEdge)
-               cell2 = cellsOnEdge(2,iEdge)
-               if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-                  cell_upwind = cell2
-                  if (uhAvg(k,iEdge) &gt;= 0) cell_upwind = cell1
-                  do iScalar=1,num_scalars
-                     scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
-                     h_flux(iScalar,iEdge) = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_edge
-                     h_flux_upwind = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_old(iScalar,k,cell_upwind)
-                     h_flux(iScalar,iEdge) = h_flux(iScalar,iEdge) - h_flux_upwind
-!                     h_flux(iScalar,iEdge) = 0.  ! use only upwind - for testing
-                     s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - h_flux_upwind / grid % areaCell % array(cell1)
-                     s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + h_flux_upwind / grid % areaCell % array(cell2)
-                  end do 
-               end if
-            end do 
-
-         else if (config_scalar_adv_order &gt;= 3) then
-
-            do iEdge=1,grid%nEdges
-               cell1 = cellsOnEdge(1,iEdge)
-               cell2 = cellsOnEdge(2,iEdge)
-               if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-                  cell_upwind = cell2
-                  if (uhAvg(k,iEdge) &gt;= 0) cell_upwind = cell1
-                  do iScalar=1,num_scalars
-  
-                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
-                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
-                     do i=1, grid % nEdgesOnCell % array (cell1)
-                        if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                        d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                       deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
-                     end do
-                     do i=1, grid % nEdgesOnCell % array (cell2)
-                        if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                        d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                       deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
-                     end do
-    
-                     if (uhAvg(k,iEdge) &gt; 0) then
-                        flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
-                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                                -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                                -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     else
-                        flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                                -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                                +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     end if
-   
-                     h_flux(iScalar,iEdge) = dt * flux
-                     h_flux_upwind = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_old(iScalar,k,cell_upwind)
-                     h_flux(iScalar,iEdge) = h_flux(iScalar,iEdge) - h_flux_upwind
-!                     h_flux(iScalar,iEdge) = 0.  ! use only upwind - for testing
-                     s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - h_flux_upwind / grid % areaCell % array(cell1)
-                     s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + h_flux_upwind / grid % areaCell % array(cell2)
-                  end do 
-               end if
-            end do 
-
-         end if
-
-
-         if ( (rk_step == rk_order) .and. (config_monotonic .or. config_positive_definite) ) then   
-
-!*************************************************************************************************************
-!---  limiter - we limit horizontal and vertical fluxes on level k 
-!---  (these are h fluxes contributing to level k scalars, and v flux contributing to level k, k-1 scalars)
-
-            do iCell=1,grid % nCells
-  
-               do iScalar=1,num_scalars
-   
-                  s_max(iScalar) = max(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
-                  s_min(iScalar) = min(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
-                  s_max_update(iScalar) = s_update(iScalar,iCell,km0)
-                  s_min_update(iScalar) = s_update(iScalar,iCell,km0)
-    
-                  ! add in vertical flux to get max and min estimate
-                  s_max_update(iScalar) = s_max_update(iScalar)  &amp;
-                     - rdnw(k) * (max(0.,v_flux(iScalar,iCell,km0)) - min(0.,v_flux(iScalar,iCell,km1)))
-                  s_min_update(iScalar) = s_min_update(iScalar)  &amp;
-                     - rdnw(k) * (min(0.,v_flux(iScalar,iCell,km0)) - max(0.,v_flux(iScalar,iCell,km1)))
-    
-               end do
-   
-               do i = 1, grid % nEdgesOnCell % array(iCell)  ! go around the edges of each cell
-                  if (grid % cellsOnCell % array(i,iCell) &gt; 0) then
-                     do iScalar=1,num_scalars
-    
-                        s_max(iScalar)  = max(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_max(iScalar))
-                        s_min(iScalar)  = min(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_min(iScalar))
-     
-                        iEdge = grid % EdgesOnCell % array (i,iCell)
-                        if (iCell == cellsOnEdge(1,iEdge)) then
-                           fdir = 1.0
-                        else
-                           fdir = -1.0
-                        end if
-                        flux = -fdir * h_flux(iScalar,iEdge)/grid % areaCell % array(iCell)
-                        s_max_update(iScalar) = s_max_update(iScalar) + max(0.,flux)
-                        s_min_update(iScalar) = s_min_update(iScalar) + min(0.,flux)
-    
-                     end do
-                  end if
-   
-               end do
-   
-               if( config_positive_definite ) s_min(:) = 0.
-   
-               do iScalar=1,num_scalars
-                  scale_out (iScalar,iCell,km0) = 1.
-                  scale_in (iScalar,iCell,km0) = 1.
-                  s_max_update (iScalar) =  s_max_update (iScalar) / h_new (k,iCell)
-                  s_min_update (iScalar) =  s_min_update (iScalar) / h_new (k,iCell)
-                  s_upwind = s_update(iScalar,iCell,km0) / h_new(k,iCell)
-                  if ( s_max_update(iScalar) &gt; s_max(iScalar) .and. config_monotonic)   &amp;
-                     scale_in (iScalar,iCell,km0) = max(0.,(s_max(iScalar)-s_upwind)/(s_max_update(iScalar)-s_upwind+eps))
-                  if ( s_min_update(iScalar) &lt; s_min(iScalar) )   &amp;
-                     scale_out (iScalar,iCell,km0) = max(0.,(s_upwind-s_min(iScalar))/(s_upwind-s_min_update(iScalar)+eps))
-                end do
-  
-            end do ! end loop over cells to compute scale factor
-
-
-            call dmpar_exch_halo_field2dReal(dminfo, scale_out(:,:,1), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-            call dmpar_exch_halo_field2dReal(dminfo, scale_out(:,:,2), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-            call dmpar_exch_halo_field2dReal(dminfo, scale_in(:,:,1), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-            call dmpar_exch_halo_field2dReal(dminfo, scale_in(:,:,2), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-
-       ! rescale the horizontal fluxes
- 
-            do iEdge = 1, grid % nEdges
-               cell1 = grid % cellsOnEdge % array(1,iEdge)
-               cell2 = grid % cellsOnEdge % array(2,iEdge)
-               if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-                  do iScalar=1,num_scalars
-                     flux = h_flux(iScalar,iEdge)
-                     if (flux &gt; 0) then
-                        flux = flux * min(scale_out(iScalar,cell1,km0), scale_in(iScalar,cell2,km0))
-                     else
-                        flux = flux * min(scale_in(iScalar,cell1,km0), scale_out(iScalar,cell2,km0))
-                     end if
-                     h_flux(iScalar,iEdge) = flux
-                  end do
-               end if
-            end do
- 
-       ! rescale the vertical flux
- 
-            do iCell=1,grid % nCells
-               do iScalar=1,num_scalars
-                  flux =  v_flux(iScalar,iCell,km1)
-                  if (flux &gt; 0) then
-                     flux = flux * min(scale_out(iScalar,iCell,km0), scale_in(iScalar,iCell,km1))
-                  else
-                     flux = flux * min(scale_in(iScalar,iCell,km0), scale_out(iScalar,iCell,km1))
-                  end if
-                  v_flux(iScalar,iCell,km1) = flux
-               end do
-            end do
-
-!  end of limiter
-!*******************************************************************************************************************
-
-         end if
-
-!---  update
-
-         do iCell=1,grid % nCells
-            !  add in upper vertical flux that was just renormalized
-            do iScalar=1,num_scalars
-               s_update(iScalar,iCell,km0) = s_update(iScalar,iCell,km0) + rdnw(k) * v_flux(iScalar,iCell,km1)
-               if (k &gt; 1) s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) - rdnw(k-1)*v_flux(iScalar,iCell,km1)
-            end do
-         end do
- 
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-               do iScalar=1,num_scalars
-                  s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - &amp;
-                      h_flux(iScalar,iEdge) / grid % areaCell % array(cell1)
-                  s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + &amp;
-                      h_flux(iScalar,iEdge) / grid % areaCell % array(cell2)
-               end do 
-            end if
-         end do 
- 
-         ! decouple from mass
-         if (k &gt; 1) then
-            do iCell=1,grid % nCells
-               do iScalar=1,num_scalars
-                  s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) / h_new(k-1,iCell)
-               end do
-            end do
- 
-            do iCell=1,grid % nCells
-               do iScalar=1,num_scalars
-                  scalar_new(iScalar,k-1,iCell) = s_update(iScalar,iCell,km1) 
-               end do
-            end do
-         end if
- 
-         ktmp = km1
-         km1 = km0
-         km0 = ktmp
-
-      end do
-
-      do iCell=1,grid % nCells
-         do iScalar=1,num_scalars
-            scalar_new(iScalar,grid % nVertLevels,iCell) = s_update(iScalar,iCell,km1) / h_new(grid%nVertLevels,iCell)
-         end do
-      end do
-
-   end subroutine advance_scalars_mono
-
-!----
-
-   subroutine compute_dyn_tend(tend, s, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Compute height and normal wind tendencies, as well as diagnostic variables
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed diagnostics (parallel velocities, v; mass fluxes, rv; 
-   !                circulation; vorticity; and kinetic energy, ke) and the 
-   !                tendencies for height (h) and u (u)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (grid_state), intent(inout) :: tend
-      type (grid_state), intent(in) :: s
-      type (grid_meta), intent(in) :: grid
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
-      real (kind=RKIND) :: flux, vorticity_abs, rho_vertex, workpv, q, upstream_bias
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, nCellsSolve
-      real (kind=RKIND) :: h_mom_eddy_visc2,   v_mom_eddy_visc2,   h_mom_eddy_visc4
-      real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2, h_theta_eddy_visc4
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), pointer ::  fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
-      real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge, kiteAreasOnVertex, zgrid, rho_edge, rho, ru, u, v, tend_u, &amp;
-                                                    circulation, divergence, vorticity, ke, pv_edge, theta, rw, tend_rho, &amp;
-                                                    h_diabatic, tend_theta, tend_w, w, cqw, rb, rr, pp, pressure_b, zz, zx, cqu
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-
-      real (kind=RKIND), dimension( grid % nVertLevels + 1 ) :: wduz, wdwz, wdtz, dpzx
-      real (kind=RKIND), dimension( grid % nVertLevels ) :: u_mix
-      real (kind=RKIND) :: theta_edge, theta_turb_flux, z1, z2, z3, z4, zm, z0, zp, r
-      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2, pgrad
-
-      real (kind=RKIND), dimension(:), pointer :: rdzu, rdzw, fzm, fzp, t_init
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: rv, divergence_ru 
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_theta, delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-      real (kind=RKIND) :: cf1, cf2, cf3
-
-!      logical, parameter :: debug = .true.
-      logical, parameter :: debug = .false.
-      logical, parameter :: mix_full = .false.
-!      logical, parameter :: mix_full = .true.
-
-      rho          =&gt; s % rho % array
-      rho_edge     =&gt; s % rho_edge % array
-      rb           =&gt; grid % rho_base % array
-      rr           =&gt; s % rho_p % array
-      u            =&gt; s % u % array
-      ru           =&gt; grid % ru % array
-      w            =&gt; s % w % array
-      rw           =&gt; grid % rw % array
-      theta        =&gt; s % theta % array
-      circulation  =&gt; s % circulation % array
-      divergence   =&gt; s % divergence % array
-      vorticity    =&gt; s % vorticity % array
-      ke           =&gt; s % ke % array
-      pv_edge      =&gt; s % pv_edge % array
-      pp           =&gt; s % pressure % array
-      pressure_b   =&gt; grid % pressure_base % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      fEdge             =&gt; grid % fEdge % array
-      deriv_two         =&gt; grid % deriv_two % array
-      zz                =&gt; grid % zz % array
-      zx                =&gt; grid % zx % array
-
-      tend_u      =&gt; tend % u % array
-      tend_theta  =&gt; tend % theta % array
-      tend_w      =&gt; tend % w % array
-      tend_rho    =&gt; tend % rho % array
-      h_diabatic  =&gt; grid % rt_diabatic_tend % array
-
-      t_init      =&gt; grid % t_init % array
-
-      rdzu        =&gt; grid % rdzu % array
-      rdzw        =&gt; grid % rdzw % array
-      fzm         =&gt; grid % fzm % array
-      fzp         =&gt; grid % fzp % array
-      zgrid       =&gt; grid % zgrid % array
-      cqw         =&gt; grid % cqw % array
-      cqu         =&gt; grid % cqu % array
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertLevels = grid % nVertLevels
-      nVertices   = grid % nVertices
-      nCellsSolve = grid % nCellsSolve
-
-      h_mom_eddy_visc2 = config_h_mom_eddy_visc2
-      h_mom_eddy_visc4 = config_h_mom_eddy_visc4
-      v_mom_eddy_visc2 = config_v_mom_eddy_visc2
-      h_theta_eddy_visc2 = config_h_theta_eddy_visc2
-      h_theta_eddy_visc4 = config_h_theta_eddy_visc4
-      v_theta_eddy_visc2 = config_v_theta_eddy_visc2
-
-      !
-      ! Compute u (normal) velocity tendency for each edge (cell face)
-      !
-
-      tend_u(:,:) = 0.0
-
-      cf1 = 1.5
-      cf2 = -.5
-      cf3 = 0.
-
-      !  tendency for density
-      !  divergence_ru may calculated in the diagnostic subroutine - it is temporary
-      allocate(divergence_ru(nVertLevels, nCells))
-
-      divergence_ru(:,:) = 0.0
-      do iEdge=1,grid % nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,nVertLevels
-           flux = ru(k,iEdge)*dvEdge(iEdge)
-           divergence_ru(k,cell1) = divergence_ru(k,cell1) + flux
-           divergence_ru(k,cell2) = divergence_ru(k,cell2) - flux
-         end do
-      end do
-
-      do iCell = 1,nCells
-        r = 1.0 / areaCell(iCell)
-        do k = 1,nVertLevels
-           divergence_ru(k,iCell) = divergence_ru(k,iCell) * r
-           tend_rho(k,iCell) = -divergence_ru(k,iCell)-rdzw(k)*(rw(k+1,iCell)-rw(k,iCell))
-        end do
-      end do    
-
-#ifdef LANL_FORMULATION
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         !  horizontal pressure gradient, nonlinear Coriolis term and ke gradient
-
-         k = 1
-         dpzx(k) = .5*zx(k,iEdge)*(cf1*(pp(k  ,cell2)+pp(k  ,cell1))   &amp;
-                                  +cf2*(pp(k+1,cell2)+pp(k+1,cell1))   &amp;
-                                  +cf3*(pp(k+2,cell2)+pp(k+2,cell1)))
-         do k = 2, nVertLevels
-           dpzx(k) = .5*zx(k,iEdge)*(fzm(k)*(pp(k  ,cell2)+pp(k  ,cell1))  &amp;
-                                +fzp(k)*(pp(k-1,cell2)+pp(k-1,cell1)))
-         end do
-         dpzx(nVertLevels+1) = 0.
-
-
-         do k=1,nVertLevels
-            q = 0.0
-            do j = 1,nEdgesOnEdge(iEdge)
-               eoe = edgesOnEdge(j,iEdge)
-               workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
-               q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * rho_edge(k,eoe)
-            end do
-            tend_u(k,iEdge) = rho_edge(k,iEdge)* (q - (ke(k,cell2) - ke(k,cell1)) / dcEdge(iEdge))                  &amp;
-                              - u(k,iEdge)*0.5*(divergence_ru(k,cell1)+divergence_ru(k,cell2))                      &amp;
-                              - cqu(k,iEdge)*( (pp(k,cell2)/zz(k,cell2) - pp(k,cell1)/zz(k,cell1)) /  dcEdge(iEdge) &amp;
-                                              -rdzw(k)*(dpzx(k+1)-dpzx(k)) )
-         end do
-
-      end do
-
-#endif
-
-#ifdef NCAR_FORMULATION
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-
-      allocate(rv(nVertLevels, nEdges))
-      rv(:,:) = 0.0
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         k = 1
-         dpzx(k) = .5*zx(k,iEdge)*(cf1*(pp(k  ,cell2)+pp(k  ,cell1))   &amp;
-                                  +cf2*(pp(k+1,cell2)+pp(k+1,cell1))   &amp;
-                                  +cf3*(pp(k+2,cell2)+pp(k+2,cell1)))
-         do k = 2, nVertLevels
-           dpzx(k) = .5*zx(k,iEdge)*(fzm(k)*(pp(k  ,cell2)+pp(k  ,cell1))  &amp;
-                                +fzp(k)*(pp(k-1,cell2)+pp(k-1,cell1)))
-         end do
-         dpzx(nVertLevels+1) = 0.
-
-         do j=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(j,iEdge)
-            do k=1,nVertLevels
-               rv(k,iEdge) = rv(k,iEdge) + weightsOnEdge(j,iEdge) * ru(k,eoe)
-            end do
-         end do
-      end do
-
-      do iEdge=1,grid % nEdgesSolve
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,nVertLevels
-            vorticity_abs = fEdge(iEdge) + (circulation(k,vertex1) + circulation(k,vertex2)) / &amp;
-                                           (areaTriangle(vertex1) + areaTriangle(vertex2))
-
-            workpv = 2.0 * vorticity_abs / (rho(k,cell1) + rho(k,cell2))
-
-            tend_u(k,iEdge) = rho_edge(k,iEdge)* (workpv * rv(k,iEdge) - (ke(k,cell2) - ke(k,cell1)) / dcEdge(iEdge)) &amp;
-                              - u(k,iEdge)*0.5*(divergence_ru(k,cell1)+divergence_ru(k,cell2))                        &amp;
-                              - cqu(k,iEdge)*( (pp(k,Cell2)/zz(k,cell2) - pp(k,cell1)/zz(k,cell1)) /  dcEdge(iEdge)   &amp;
-                                              -rdzw(k)*(dpzx(k+1)-dpzx(k)) )
-
-         end do
-
-      end do
-      deallocate(rv)
-#endif
-      deallocate(divergence_ru)
-
-      !
-      !  vertical advection for u
-      !
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         wduz(1) = 0.
-         do k=2,nVertLevels
-            wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2) )*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))  
-         end do
-         wduz(nVertLevels+1) = 0.
-
-         do k=1,nVertLevels
-            tend_u(k,iEdge) = tend_u(k,iEdge) - rdzw(k)*(wduz(k+1)-wduz(k)) 
-         end do
-      end do
-
-      !
-      !  horizontal mixing for u
-      !
-      if ( h_mom_eddy_visc2 &gt; 0.0 ) then
-         do iEdge=1,grid % nEdgesSolve
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            vertex1 = verticesOnEdge(1,iEdge)
-            vertex2 = verticesOnEdge(2,iEdge)
-
-            do k=1,nVertLevels
-
-               !
-               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
-               !                    only valid for h_mom_eddy_visc2 == constant
-               !
-               u_diffusion =   ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                              -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
-               u_diffusion = rho_edge(k,iEdge)*h_mom_eddy_visc2 * u_diffusion
-
-               tend_u(k,iEdge) = tend_u(k,iEdge) + u_diffusion
-            end do
-         end do
-      end if
-
-      if ( h_mom_eddy_visc4 &gt; 0.0 ) then
-
-         allocate(delsq_divergence(nVertLevels, nCells))
-         allocate(delsq_u(nVertLevels, nEdges))
-         allocate(delsq_circulation(nVertLevels, nVertices))
-         allocate(delsq_vorticity(nVertLevels, nVertices))
-
-         delsq_u(:,:) = 0.0
-
-         do iEdge=1,grid % nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            vertex1 = verticesOnEdge(1,iEdge)
-            vertex2 = verticesOnEdge(2,iEdge)
-
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-               do k=1,nVertLevels
-
-                  !
-                  ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
-                  !                    only valid for h_mom_eddy_visc4 == constant
-                  !
-                  u_diffusion =   ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                                 -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
-
-                  delsq_u(k,iEdge) = delsq_u(k,iEdge) + u_diffusion
-               end do
-            end if
-         end do
-
-         delsq_circulation(:,:) = 0.0
-         do iEdge=1,nEdges
-            if (verticesOnEdge(1,iEdge) &gt; 0) then
-               do k=1,nVertLevels
-                  delsq_circulation(k,verticesOnEdge(1,iEdge)) = delsq_circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * delsq_u(k,iEdge)
-               end do
-            end if
-            if (verticesOnEdge(2,iEdge) &gt; 0) then
-               do k=1,nVertLevels
-                  delsq_circulation(k,verticesOnEdge(2,iEdge)) = delsq_circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * delsq_u(k,iEdge)
-               end do
-            end if
-         end do
-         do iVertex=1,nVertices
-            r = 1.0 / areaTriangle(iVertex)
-            do k=1,nVertLevels
-               delsq_vorticity(k,iVertex) = delsq_circulation(k,iVertex) * r
-            end do
-         end do
-
-         delsq_divergence(:,:) = 0.0
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve) then 
-               do k=1,nVertLevels
-                 delsq_divergence(k,cell1) = delsq_divergence(k,cell1) + delsq_u(k,iEdge)*dvEdge(iEdge)
-               end do
-            end if
-            if (cell2 &lt;= nCellsSolve) then
-               do k=1,nVertLevels
-                 delsq_divergence(k,cell2) = delsq_divergence(k,cell2) - delsq_u(k,iEdge)*dvEdge(iEdge)
-               end do
-            end if
-         end do
-         do iCell = 1,nCells
-            r = 1.0 / areaCell(iCell)
-            do k = 1,nVertLevels
-               delsq_divergence(k,iCell) = delsq_divergence(k,iCell) * r
-            end do
-         end do
-
-         do iEdge=1,grid % nEdgesSolve
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            vertex1 = verticesOnEdge(1,iEdge)
-            vertex2 = verticesOnEdge(2,iEdge)
-
-            do k=1,nVertLevels
-
-               !
-               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="gray">abla vorticity
-               !                    only valid for h_mom_eddy_visc4 == constant
-               !
-               u_diffusion =  rho_edge(k,iEdge) * ( delsq_divergence(k,cell2)  - delsq_divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                                                 -( delsq_vorticity(k,vertex2) - delsq_vorticity(k,vertex1) ) / dvEdge(iEdge)
-
-               tend_u(k,iEdge) = tend_u(k,iEdge) - h_mom_eddy_visc4 * u_diffusion
-            end do
-         end do
-
-         deallocate(delsq_divergence)
-         deallocate(delsq_u)
-         deallocate(delsq_circulation)
-         deallocate(delsq_vorticity)
-
-      end if
-
-      !
-      !  vertical mixing for u - 2nd order 
-      !
-      if ( v_mom_eddy_visc2 &gt; 0.0 ) then
-
-         if (mix_full) then
-
-         do iEdge=1,grid % nEdgesSolve
-
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            do k=2,nVertLevels-1
-
-               z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2))
-               z2 = 0.5*(zgrid(k  ,cell1)+zgrid(k  ,cell2))
-               z3 = 0.5*(zgrid(k+1,cell1)+zgrid(k+1,cell2))
-               z4 = 0.5*(zgrid(k+2,cell1)+zgrid(k+2,cell2))
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               tend_u(k,iEdge) = tend_u(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*(  &amp;
-                                  (u(k+1,iEdge)-u(k  ,iEdge))/(zp-z0)                      &amp;
-                                 -(u(k  ,iEdge)-u(k-1,iEdge))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-         else  ! idealized cases where we mix on the perturbation from the initial 1-D state
-
-         do iEdge=1,grid % nEdgesSolve
-
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            do k=1,nVertLevels
-              u_mix = u(k,iEdge) - grid % u_init % array(k) * cos( grid % angleEdge % array(iEdge) )
-            end do
-
-            do k=2,nVertLevels-1
-
-               z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2))
-               z2 = 0.5*(zgrid(k  ,cell1)+zgrid(k  ,cell2))
-               z3 = 0.5*(zgrid(k+1,cell1)+zgrid(k+1,cell2))
-               z4 = 0.5*(zgrid(k+2,cell1)+zgrid(k+2,cell2))
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               tend_u(k,iEdge) = tend_u(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*(  &amp;
-                                  (u_mix(k+1)-u_mix(k  ))/(zp-z0)                      &amp;
-                                 -(u_mix(k  )-u_mix(k-1))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-         end if
-
-      end if
-
-!----------- rhs for w
-
-      tend_w(:,:) = 0.
-
-      !
-      !  horizontal advection for w
-      !
-
-      if (config_theta_adv_order == 2) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-               do k=2,grid % nVertLevels
-                  flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge) ) &amp;
-                                        *(w(k,cell1) + w(k,cell2))*0.5 
-                  tend_w(k,cell1) = tend_w(k,cell1) - flux
-                  tend_w(k,cell2) = tend_w(k,cell2) + flux
-               end do
-            end if
-         end do
-
-      else if (config_theta_adv_order == 3) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=2,grid % nVertLevels
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * w(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * w(k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                     d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * w(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                     d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * w(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-!  3rd order stencil
-                  if( u(k,iEdge)+u(k-1,iEdge) &gt; 0) then
-                     flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge))*(  &amp;
-                                             0.5*(w(k,cell1) + w(k,cell2))                 &amp;
-                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
-                  else
-                     flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge))*(  &amp;
-                                             0.5*(w(k,cell1) + w(k,cell2))                 &amp;
-                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
-                  end if
-
-                  tend_w(k,cell1) = tend_w(k,cell1) - flux
-                  tend_w(k,cell2) = tend_w(k,cell2) + flux
-
-               end do
-            end if
-         end do
-
-      else  if (config_theta_adv_order == 4) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=2,grid % nVertLevels
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * w(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * w(k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                     d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * w(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                     d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * w(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-                  flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge)) * (  &amp;
-                                          0.5*(w(k,cell1) + w(k,cell2))                   &amp;
-                                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-
-                  tend_w(k,cell1) = tend_w(k,cell1) - flux
-                  tend_w(k,cell2) = tend_w(k,cell2) + flux
-               end do
-
-            end if
-
-         end do
-      end if
-
-      !
-      !  horizontal mixing for w - we could combine this with advection directly (i.e. as a turbulent flux),
-      !  but here we can also code in hyperdiffusion if we wish (2nd order at present)
-      !
-
-      !  Note: we are using quite a bit of the theta code here - could be combined later???
-
-      if ( h_mom_eddy_visc2 &gt; 0.0 ) then
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=2,grid % nVertLevels
-                  theta_turb_flux = h_mom_eddy_visc2*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
-                  flux = 0.5*dvEdge (iEdge) * (rho_edge(k,iEdge)+rho_edge(k-1,iEdge)) * theta_turb_flux
-                  tend_w(k,cell1) = tend_w(k,cell1) + flux
-                  tend_w(k,cell2) = tend_w(k,cell2) - flux
-               end do
-
-            end if
-         end do
- 
-      end if
-
-      if ( h_mom_eddy_visc4 &gt; 0.0 ) then
-
-         allocate(delsq_theta(nVertLevels, nCells))
-
-         delsq_theta(:,:) = 0.
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-           
-               do k=2,grid % nVertLevels
-                  delsq_theta(k,cell1) = delsq_theta(k,cell1) + dvEdge(iEdge)*0.5*(rho_edge(k,iEdge)+rho_edge(k-1,iEdge))*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
-                  delsq_theta(k,cell2) = delsq_theta(k,cell2) - dvEdge(iEdge)*0.5*(rho_edge(k,iEdge)+rho_edge(k-1,iEdge))*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
-               end do
-
-            end if
-         end do
-
-         do iCell = 1, nCells
-            r = 1.0 / areaCell(iCell)
-            do k=2,nVertLevels
-               delsq_theta(k,iCell) = delsq_theta(k,iCell) * r
-            end do
-         end do
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=2,grid % nVertLevels
-                  theta_turb_flux = h_mom_eddy_visc4*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
-                  flux = dvEdge (iEdge) * theta_turb_flux
-
-                  tend_w(k,cell1) = tend_w(k,cell1) - flux
-                  tend_w(k,cell2) = tend_w(k,cell2) + flux
-               end do
-
-            end if
-         end do
-
-         deallocate(delsq_theta)
-
-      end if
-
-      !
-      !  vertical advection, pressure gradient and buoyancy for w
-      !  Note: we are also dividing through by the cell area after the horizontal flux divergence
-      !
-
-      do iCell = 1, nCells
-         wdwz(1) = 0.
-         do k=2,nVertLevels
-            wdwz(k) =  0.25*(rw(k,icell)+rw(k-1,iCell))*(w(k,iCell)+w(k-1,iCell))
-         end do
-         wdwz(nVertLevels+1) = 0.
-         do k=2,nVertLevels
-            tend_w(k,iCell) = tend_w(k,iCell)/areaCell(iCell) -rdzu(k)*(wdwz(k+1)-wdwz(k))    &amp;
-                                  - cqw(k,iCell)*( rdzu(k)*(pp(k,iCell)-pp(k-1,iCell))        &amp;
-                                  - gravity*(fzm(k)*rb(k,iCell)+fzp(k)*rb(k-1,iCell)) )       &amp;
-                                  - gravity*( fzm(k)*(rr(k,iCell)+rb(k,iCell)) + fzp(k)*(rr(k-1,iCell)+rb(k-1,iCell)) )
-
-
-
-!                               - cqw(k,iCell)*rdzu(k)*(pp(k,iCell)-pp(k-1,iCell))                            &amp;
-!                                - gravity*( fzm(k)*rr(k,iCell)+fzp(k)*rr(k-1,iCell) &amp;
-!                                           +(1.-cqw(k,iCell))*(fzm(k)*rb(k,iCell)+fzp(k)*rb(k-1,iCell)))
-
-
-
-! WCS version                               - cqw(k,iCell)*rdzu(k)*(pp(k,iCell)-pp(k-1,iCell))                            &amp;
-!                                - gravity*0.5*(rr(k,iCell)+rr(k-1,iCell)+(1.-cqw(k,iCell))*(rb(k,iCell)+rb(k-1,iCell)))
-
-!Joe formulation
-!                                  - cqw(k,iCell)*( rdzu(k)*(pp(k,iCell)-pp(k-1,iCell))        &amp;
-!                                  - gravity*(fzm(k)*rb(k,iCell)+fzp(k)*rb(k-1,iCell)) )       &amp;
-!                                  - gravity*( fzm(k)*(rr(k,iCell)+rb(k,iCell)) + fzp(k)*(rr(k-1,iCell)+rb(k-1,iCell)) )
-
-         end do
-      end do
-
-      !
-      !  vertical mixing for w - 2nd order 
-      !
-      if ( v_mom_eddy_visc2 &gt; 0.0 ) then
-
-         do iCell = 1, grid % nCellsSolve
-            do k=2,nVertLevels-1
-               tend_w(k,iCell) = tend_w(k,iCell) + v_mom_eddy_visc2*0.5*(rho(k,iCell)+rho(k-1,iCell))*(  &amp;
-                                        (w(k+1,iCell)-w(k  ,iCell))*rdzw(k)                              &amp;
-                                       -(w(k  ,iCell)-w(k-1,iCell))*rdzw(k-1) )*rdzu(k)
-            end do
-         end do
-
-      end if
-
-!----------- rhs for theta
-
-      tend_theta(:,:) = 0.
-
-      !
-      !  horizontal advection for theta
-      !
-
-      if (config_theta_adv_order == 2) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-               do k=1,grid % nVertLevels
-                  flux = dvEdge(iEdge) *  ru(k,iEdge) * ( 0.5*(theta(k,cell1) + theta(k,cell2)) )
-                  tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-               end do
-            end if
-         end do
-
-      else if (config_theta_adv_order == 3) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=1,grid % nVertLevels
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta(k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                     d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                     d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-!  3rd order stencil
-                  if( u(k,iEdge) &gt; 0) then
-                     flux = dvEdge(iEdge) *  ru(k,iEdge) * (        &amp;
-                                            0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
-                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
-                  else
-                     flux = dvEdge(iEdge) *  ru(k,iEdge) * (        &amp;
-                                            0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
-                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
-                  end if
-
-                  tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-
-               end do
-            end if
-         end do
-
-      else  if (config_theta_adv_order == 4) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-
-               do k=1,grid % nVertLevels
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta(k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                     d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                     d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-                  flux = dvEdge(iEdge) *  ru(k,iEdge) * (                                               &amp;
-                                         0.5*(theta(k,cell1) + theta(k,cell2))                          &amp;
-                                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-
-                  tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-               end do
-
-            end if
-
-         end do
-      end if
-
-!      write(0,*) ' pt 1 tend_theta(3,1120) ',tend_theta(3,1120)/AreaCell(1120)
-
-      !
-      !  horizontal mixing for theta - we could combine this with advection directly (i.e. as a turbulent flux),
-      !  but here we can also code in hyperdiffusion if we wish (2nd order at present)
-      !
-      if ( h_theta_eddy_visc2 &gt; 0.0 ) then
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=1,grid % nVertLevels
-                  theta_turb_flux = h_theta_eddy_visc2*prandtl*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
-                  flux = dvEdge (iEdge) * rho_edge(k,iEdge) * theta_turb_flux
-                  tend_theta(k,cell1) = tend_theta(k,cell1) + flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) - flux
-               end do
-
-            end if
-         end do
-
-      end if
-
-      if ( h_theta_eddy_visc4 &gt; 0.0 ) then
-
-         allocate(delsq_theta(nVertLevels, nCells))
-
-         delsq_theta(:,:) = 0.
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-           
-               do k=1,grid % nVertLevels
-                  delsq_theta(k,cell1) = delsq_theta(k,cell1) + dvEdge(iEdge)*rho_edge(k,iEdge)*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
-                  delsq_theta(k,cell2) = delsq_theta(k,cell2) - dvEdge(iEdge)*rho_edge(k,iEdge)*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
-               end do
-
-            end if
-         end do
-
-         do iCell = 1, nCells
-            r = 1.0 / areaCell(iCell)
-            do k=1,nVertLevels
-               delsq_theta(k,iCell) = delsq_theta(k,iCell) * r
-            end do
-         end do
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=1,grid % nVertLevels
-                  theta_turb_flux = h_theta_eddy_visc4*prandtl*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
-                  flux = dvEdge (iEdge) * theta_turb_flux
-
-                  tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-               end do
-
-            end if
-         end do
-
-         deallocate(delsq_theta)
-
-      end if
-
-      !
-      !  vertical advection plus diabatic term
-      !  Note: we are also dividing through by the cell area after the horizontal flux divergence
-      !
-      do iCell = 1, nCells
-         wdtz(1) = 0.
-         do k=2,nVertLevels
-            wdtz(k) =  rw(k,icell)*(fzm(k)*theta(k,iCell)+fzp(k)*theta(k-1,iCell))
-         end do
-         wdtz(nVertLevels+1) = 0.
-         do k=1,nVertLevels
-            tend_theta(k,iCell) = tend_theta(k,iCell)/areaCell(iCell) -rdzw(k)*(wdtz(k+1)-wdtz(k))
-!!           tend_theta(k,iCell) = tend_theta(k) + rho(k,iCell)*h_diabatic(k,iCell)
-         end do
-      end do
-
-      !
-      !  vertical mixing for theta - 2nd order 
-      !
-      if ( v_theta_eddy_visc2 &gt; 0.0 ) then
-
-         if (mix_full) then
-
-         do iCell = 1, grid % nCellsSolve
-            do k=2,nVertLevels-1
-               z1 = zgrid(k-1,iCell)
-               z2 = zgrid(k  ,iCell)
-               z3 = zgrid(k+1,iCell)
-               z4 = zgrid(k+2,iCell)
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               tend_theta(k,iCell) = tend_theta(k,iCell) + v_theta_eddy_visc2*prandtl*rho(k,iCell)*(&amp;
-                                        (theta(k+1,iCell)-theta(k  ,iCell))/(zp-z0)                 &amp;
-                                       -(theta(k  ,iCell)-theta(k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-         else  ! idealized cases where we mix on the perturbation from the initial 1-D state
-
-         do iCell = 1, grid % nCellsSolve
-            do k=2,nVertLevels-1
-               z1 = zgrid(k-1,iCell)
-               z2 = zgrid(k  ,iCell)
-               z3 = zgrid(k+1,iCell)
-               z4 = zgrid(k+2,iCell)
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               tend_theta(k,iCell) = tend_theta(k,iCell) + v_theta_eddy_visc2*prandtl*rho(k,iCell)*(&amp;
-                                        ((theta(k+1,iCell)-t_init(k+1))-(theta(k  ,iCell)-t_init(k)))/(zp-z0)                 &amp;
-                                       -((theta(k  ,iCell)-t_init(k))-(theta(k-1,iCell)-t_init(k-1)))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-         end if
-
-      end if
-
-   end subroutine compute_dyn_tend
-
-!-------
-
-   subroutine compute_solve_diagnostics(dt, s, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Compute diagnostic fields used in the tendency computations
-   !
-   ! Input: grid - grid metadata
-   !
-   ! Output: s - computed diagnostics
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      real (kind=RKIND), intent(in) :: dt
-      type (grid_state), intent(inout) :: s
-      type (grid_meta), intent(in) :: grid
-
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, r
-
-      integer :: nCells, nEdges, nVertices, nVertLevels
-      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
-      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
-                                                    circulation, vorticity, ke, pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, &amp;
-                                                    divergence
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-
-
-!      h           =&gt; s % h % array
-      h           =&gt; s % rho % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      vh          =&gt; s % rv % array
-      h_edge      =&gt; s % rho_edge % array
-!      tend_h      =&gt; s % h % array
-!      tend_u      =&gt; s % u % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      pv_edge     =&gt; s % pv_edge % array
-      pv_vertex   =&gt; s % pv_vertex % array
-      pv_cell     =&gt; s % pv_cell % array
-      gradPVn     =&gt; s % gradPVn % array
-      gradPVt     =&gt; s % gradPVt % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      !
-      ! Compute height on cell edges at velocity locations
-      !
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-            do k=1,nVertLevels
-               h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
-            end do
-         end if
-      end do
-
-
-
-      !
-      ! Compute circulation and relative vorticity at each vertex
-      !
-      circulation(:,:) = 0.0
-      do iEdge=1,nEdges
-         if (verticesOnEdge(1,iEdge) &gt; 0) then
-            do k=1,nVertLevels
-               circulation(k,verticesOnEdge(1,iEdge)) = circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * u(k,iEdge)
-            end do
-         end if
-         if (verticesOnEdge(2,iEdge) &gt; 0) then
-            do k=1,nVertLevels
-               circulation(k,verticesOnEdge(2,iEdge)) = circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * u(k,iEdge)
-            end do
-         end if
-      end do
-      do iVertex=1,nVertices
-         do k=1,nVertLevels
-            vorticity(k,iVertex) = circulation(k,iVertex) / areaTriangle(iVertex)
-         end do
-      end do
-
-
-      !
-      ! Compute the divergence at each cell center
-      !
-      divergence(:,:) = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         if (cell1 &gt; 0) then
-            do k=1,nVertLevels
-              divergence(k,cell1) = divergence(k,cell1) + u(k,iEdge)*dvEdge(iEdge)
-            end do
-         end if
-         if(cell2 &gt; 0) then
-            do k=1,nVertLevels
-              divergence(k,cell2) = divergence(k,cell2) - u(k,iEdge)*dvEdge(iEdge)
-            end do
-         end if
-
-      end do
-      do iCell = 1,nCells
-        r = 1.0 / areaCell(iCell)
-        do k = 1,nVertLevels
-           divergence(k,iCell) = divergence(k,iCell) * r
-        end do
-      end do
-
-
-      !
-      ! Compute kinetic energy in each cell
-      !
-      ke(:,:) = 0.0
-      do iCell=1,nCells
-         do i=1,nEdgesOnCell(iCell)
-            iEdge = edgesOnCell(i,iCell)
-            do k=1,nVertLevels
-               ke(k,iCell) = ke(k,iCell) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
-            end do
-         end do
-         do k=1,nVertLevels
-            ke(k,iCell) = ke(k,iCell) / areaCell(iCell)
-         end do
-      end do
-
-      !
-      ! Compute v (tangential) velocities
-      !
-      v(:,:) = 0.0
-      do iEdge = 1,nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1,nVertLevels
-                 v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-
-      ! tdr
-      !
-      ! Compute height at vertices, pv at vertices, and average pv to edge locations
-      !  ( this computes pv_vertex at all vertices bounding real cells )
-      !
-      VTX_LOOP: do iVertex = 1,nVertices
-         do i=1,grid % vertexDegree
-            if (cellsOnVertex(i,iVertex) &lt;= 0) cycle VTX_LOOP
-         end do
-         do k=1,nVertLevels
-            h_vertex = 0.0
-            do i=1,grid % vertexDegree
-               h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
-            end do
-            h_vertex = h_vertex / areaTriangle(iVertex)
-
-            pv_vertex(k,iVertex) = (fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
-         end do
-      end do VTX_LOOP
-      ! tdr
-
-
-      ! tdr
-      !
-      ! Compute gradient of PV in the tangent direction
-      !   ( this computes gradPVt at all edges bounding real cells )
-      !
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-           gradPVt(k,iEdge) = (pv_vertex(k,verticesOnEdge(2,iEdge)) - pv_vertex(k,verticesOnEdge(1,iEdge))) / &amp;
-                              dvEdge(iEdge)
-         end do
-      end do
-
-      ! tdr
-      !
-      ! Compute pv at the edges
-      !   ( this computes pv_edge at all edges bounding real cells )
-      !
-      pv_edge(:,:) = 0.0
-      do iVertex = 1,nVertices
-        do i=1,grid % vertexDegree
-          iEdge = edgesOnVertex(i,iVertex)
-          if(iEdge &gt; 0) then
-            do k=1,nVertLevels
-              pv_edge(k,iEdge) =  pv_edge(k,iEdge)  + 0.5 * pv_vertex(k,iVertex)
-            end do
-          end if
-        end do
-      end do
-      ! tdr
-
-      ! tdr
-      !
-      ! Modify PV edge with upstream bias. 
-      !
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-           pv_edge(k,iEdge) = pv_edge(k,iEdge) - 0.5 * v(k,iEdge) * dt * gradPVt(k,iEdge)
-         end do
-      end do
-
-
-      ! tdr
-      !
-      ! Compute pv at cell centers
-      !    ( this computes pv_cell for all real cells )
-      !
-      pv_cell(:,:) = 0.0
-      do iVertex = 1, nVertices
-       do i=1,grid % vertexDegree
-         iCell = cellsOnVertex(i,iVertex)
-         if( iCell &gt; 0) then
-           do k = 1,nVertLevels
-             pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) / areaCell(iCell)
-           end do
-         end if
-       end do
-      end do
-      ! tdr
-
-      ! tdr
-      !
-      ! Compute gradient of PV in normal direction
-      !   (tdr: 2009-10-02: this is not correct because the pv_cell in the halo is not correct)
-      !
-      gradPVn(:,:) = 0.0
-      do iEdge = 1,nEdges
-        if( cellsOnEdge(1,iEdge) &gt; 0 .and. cellsOnEdge(2,iEdge) &gt; 0) then
-          do k = 1,nVertLevels
-            gradPVn(k,iEdge) = (pv_cell(k,cellsOnEdge(2,iEdge)) - pv_cell(k,cellsOnEdge(1,iEdge))) / &amp;
-                                 dcEdge(iEdge)
-          end do
-        end if
-      end do
-      ! tdr
-
-      ! Modify PV edge with upstream bias.
-      !
-     do iEdge = 1,nEdges
-        do k = 1,nVertLevels
-          pv_edge(k,iEdge) = pv_edge(k,iEdge) - 0.5 * u(k,iEdge) *dt * gradPVn(k,iEdge)
-        end do
-     end do
-
-
-   end subroutine compute_solve_diagnostics
-
-!----------
-
-   subroutine init_coupled_diagnostics( state, grid )
-
-   implicit none
-   
-   type (grid_state), intent(inout) :: state
-   type (grid_meta), intent(inout) :: grid
-
-   integer :: k,iEdge,i,iCell1,iCell2
-
-      do iEdge = 1, grid%nEdges
-        iCell1 = grid % cellsOnEdge % array(1,iEdge)
-        iCell2 = grid % cellsOnEdge % array(2,iEdge)
-        do k=1,grid % nVertLevels
-          grid % ru % array(k,iEdge) = 0.5 * state % u % array(k,iEdge)*(state % rho % array(k,iCell1)+state % rho % array(k,iCell2))
-        enddo
-      enddo
-
-      do i=1,grid%nCellsSolve
-        do k=1,grid % nVertLevels + 1
-          grid % rw % array (k,i) = 0.
-        enddo
-      enddo
-
-   end subroutine init_coupled_diagnostics
-
-! ------------------------
-
-   subroutine qd_kessler( state_old, state_new, grid, dt )
-
-   implicit none
-   
-   type (grid_state), intent(inout) :: state_old, state_new
-   type (grid_meta), intent(inout) :: grid
-   real (kind=RKIND), intent(in) :: dt
-
-   real (kind=RKIND), dimension( grid % nVertLevels ) :: t, rho, p, dzu, qv, qc, qr, qc1, qr1
-
-   integer :: k,iEdge,i,iCell,nz1
-   real (kind=RKIND) :: p0,rcv
-
-
-   write(0,*) ' in qd_kessler '
-
-   p0 = 1.e+05
-   rcv = rgas/(cp-rgas)
-   nz1 = grid % nVertLevels
-
-   do iCell = 1, grid % nCellsSolve
-
-     do k = 1, grid % nVertLevels
-
-       grid % rt_diabatic_tend % array(k,iCell) = state_new % theta % array(k,iCell)
-
-       t(k) = state_new % theta % array(k,iCell)/(1. + 1.61*state_new % scalars % array(index_qv,k,iCell))
-       rho(k) = grid % zz % array(k,iCell)*state_new % rho % array(k,iCell)
-       p(k) = grid % exner % array(k,iCell)
-       qv(k) = max(0.,state_new % scalars % array(index_qv,k,iCell))
-       qc(k) = max(0.,state_new % scalars % array(index_qc,k,iCell))
-       qr(k) = max(0.,state_new % scalars % array(index_qr,k,iCell))
-       qc1(k) = max(0.,state_old % scalars % array(index_qc,k,iCell))
-       qr1(k) = max(0.,state_old % scalars % array(index_qr,k,iCell))
-       dzu(k) = grid % dzu % array(k)
-
-     end do
-
-     call kessler( t,qv,qc,qc1,qr,qr1,rho,p,dt,dzu,nz1, 1)
-
-     do k = 1, grid % nVertLevels
-
-       grid % rt_diabatic_tend % array(k,iCell) = state_new % theta % array(k,iCell)
-
-       state_new % theta % array(k,iCell) = t(k)*(1.+1.61*qv(k))
-       grid % rt_diabatic_tend % array(k,iCell) = state_new % rho % array(k,iCell) *  &amp;
-                  (state_new % theta % array(k,iCell) - grid % rt_diabatic_tend % array(k,iCell))/dt
-       grid % rtheta_p % array(k,iCell) = state_new % rho % array(k,iCell) * state_new % theta % array(k,iCell)  &amp;
-                                      - grid % rtheta_base % array(k,iCell) 
-       state_new % scalars % array(index_qv,k,iCell) = qv(k)
-       state_new % scalars % array(index_qc,k,iCell) = qc(k)
-       state_new % scalars % array(index_qr,k,iCell) = qr(k)
-
-       grid % exner % array(k,iCell) =                                       &amp;
-                              ( grid % zz % array(k,iCell)*(rgas/p0) * ( &amp;
-                                  grid % rtheta_p % array(k,iCell)       &amp;
-                                + grid % rtheta_base % array(k,iCell) ) )**rcv
-
-       state_new % pressure % array(k,iCell) =                                               &amp;
-            grid % zz % array(k,iCell) * rgas * (                                        &amp;
-              grid % exner % array(k,iCell)*grid % rtheta_p % array(k,iCell)             &amp;
-                                +grid % rtheta_base % array(k,iCell) *                   &amp;
-                     (grid % exner % array(k,iCell) - grid % exner_base % array(k,iCell)) )
-     end do
-
-   end do
-
-   write(0,*) ' exiting qd_kessler '
-
-   end subroutine qd_kessler
-
-!-----------------------------------------------------------------------
-      subroutine kessler( t1t, qv1t, qc1t, qc1, qr1t, qr1,        &amp;
-                              rho, pii, dt, dzu, nz1, nx         )
-!-----------------------------------------------------------------------
-!
-      implicit none
-      integer :: nx, nz1
-      real (kind=RKIND) :: t1t (nz1,nx), qv1t(nz1,nx), qc1t(nz1,nx), &amp;
-                            qr1t(nz1,nx), qc1 (nz1,nx), qr1 (nz1,nx), &amp;
-                            rho (nz1,nx), pii (nz1,nx), dzu(nz1)
-      integer, parameter :: mz=200
-      real (kind=RKIND) ::  qrprod(mz), prod (mz), rcgs( mz), rcgsi (mz) &amp;
-                           ,ern   (mz), vt   (mz), vtden(mz), gam   (mz) &amp;
-                           ,r     (mz), rhalf(mz), velqr(mz), buoycy(mz) &amp;
-                           ,pk    (mz), pc   (mz), f0   (mz), qvs   (mz)
-
-      real (kind=RKIND) :: c1, c2, c3, c4, f5, mxfall, dtfall, fudge, dt, velu, veld, artemp, artot
-      real (kind=RKIND) :: cp, product, ackess, ckess, fvel, f2x, xk, xki, psl
-      integer :: nfall
-      integer :: i,k,n
-
-      ackess = 0.001
-      ckess  = 2.2
-      fvel   = 36.34
-      f2x    = 17.27
-      f5     = 237.3*f2x*2.5e6/1003.
-      xk     = .2875          
-      xki    = 1./xk         
-      psl    = 1000.
-
-      do k=1,nz1
-         r(k)     = 0.001*rho(k,1)
-         rhalf(k) = sqrt(rho(1,1)/rho(k,1))
-         pk(k)    = pii(k,1)
-         pc(k)    = 3.8/(pk(k)**xki*psl)
-         f0(k)    = 2.5e6/(1003.*pk(k))
-      end do
-!
-      do i=1,nx
-         do k=1,nz1
-            qrprod(k) = qc1t(k,i)                                  &amp;
-                      -(qc1t(k,i)-dt*amax1(ackess*(qc1(k,i)-.001), &amp;
-                           0.))/(1.+dt*ckess*qr1(k,i)**.875)       
-                           velqr(k)  = (qr1(k,i)*r(k))**1.1364*rhalf(k)
-            qvs(k)    = pc(k)*exp(f2x*(pk(k)*t1t(k,i)-273.)  &amp;
-                                  /(pk(k)*t1t(k,i)- 36.))
-         end do
-         velu         = (qr1(2,i)*r(2))**1.1364*rhalf(2)
-         veld         = (qr1(1,i)*r(1))**1.1364*rhalf(1)
-         qr1t(1,i)    = qr1t(1,i)+dt*(velu-veld)*fvel/(r(1)*dzu(2))
-         do k=2,nz1-1
-            qr1t(k,i) = qr1t(k,i)+dt*fvel/r(k)                  &amp;
-                         *.5*((velqr(k+1)-velqr(k  ))/dzu(k+1)  &amp;
-                             +(velqr(k  )-velqr(k-1))/dzu(k  ))
-         end do
-         qr1t(nz1,i)  = qr1t(nz1,i)-dt*fvel*velqr(nz1-1)    &amp;
-                                    /(r(nz1)*dzu(nz1)*(1.+1.))
-         artemp       = 36340.*(.5*(velqr(2)+velqr(1))+veld-velu)
-         artot        = artot+dt*artemp
-         do k=1,nz1
-            qc1t(k,i) = amax1(qc1t(k,i)-qrprod(k),0.)
-            qr1t(k,i) = amax1(qr1t(k,i)+qrprod(k),0.)
-            prod(k)   = (qv1t(k,i)-qvs(k))/(1.+qvs(k)*f5  &amp;
-                                /(pk(k)*t1t(k,i)-36.)**2)
-         end do
-         do k=1,nz1
-            ern(k)    = amin1(dt*(((1.6+124.9*(r(k)*qr1t(k,i))**.2046)  &amp;
-                         *(r(k)*qr1t(k,i))**.525)/(2.55e6*pc(k)         &amp;
-                         /(3.8 *qvs(k))+5.4e5))*(dim(qvs(k),qv1t(k,i))  &amp;
-                         /(r(k)*qvs(k))),                               &amp;
-                          amax1(-prod(k)-qc1t(k,i),0.),qr1t(k,i))
-         end do
-         do k=1,nz1
-            buoycy(k) = f0(k)*(amax1(prod(k),-qc1t(k,i))-ern(k))
-                                qv1t(k,i) = amax1(qv1t(k,i)    &amp;
-                         -amax1(prod(k),-qc1t(k,i))+ern(k),0.)
-            qc1t(k,i) = qc1t(k,i)+amax1(prod(k),-qc1t(k,i))
-            qr1t(k,i) = qr1t(k,i)-ern(k)
-            t1t (k,i) = t1t (k,i)+buoycy(k)
-         end do
-      end do
-
-      end  subroutine kessler
-
-end module time_integration

Deleted: branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_time_integration.F.sh0609
===================================================================
--- branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_time_integration.F.sh0609        2010-07-12 19:38:09 UTC (rev 372)
+++ branches/atmos_nonhydrostatic/src/core_nhyd_atmos/module_time_integration.F.sh0609        2010-07-13 21:27:45 UTC (rev 373)
@@ -1,2876 +0,0 @@
-module time_integration
-
-   use grid_types
-   use configure
-   use constants
-   use dmpar
-
-
-   contains
-
-
-   subroutine timestep(domain, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Advance model state forward in time by the specified time step
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-
-      type (block_type), pointer :: block
-
-      if (trim(config_time_integration) == 'SRK3') then
-         call srk3(domain, dt)
-      else
-         write(0,*) 'Unknown time integration option '//trim(config_time_integration)
-         write(0,*) 'Currently, only ''SRK3'' is supported.'
-         stop
-      end if
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         block % time_levs(2) % state % xtime % scalar = block % time_levs(1) % state % xtime % scalar + dt
-         block =&gt; block % next
-      end do
-
-   end subroutine timestep
-
-
-   subroutine srk3(domain, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Advance model state forward in time by the specified time step using 
-   !   time-split RK3 scheme
-   !
-   ! Hydrostatic (primitive eqns.) solver
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-
-      integer :: iCell, k, iEdge
-      type (block_type), pointer :: block
-
-      integer, parameter :: TEND   = 1
-      integer :: rk_step, number_of_sub_steps
-
-      real (kind=RKIND), dimension(3) :: rk_timestep, rk_sub_timestep
-      integer, dimension(3) :: number_sub_steps
-      integer :: small_step
-      logical, parameter :: debug = .false.
-!      logical, parameter :: debug = .true.
-      logical, parameter :: debug_mass_conservation = .true.
-      logical, parameter :: do_microphysics = .true.
-
-      real (kind=RKIND) :: domain_mass, scalar_mass, scalar_min, scalar_max
-      real (kind=RKIND) :: global_domain_mass, global_scalar_mass, global_scalar_min, global_scalar_max
-
-      !
-      ! Initialize RK weights
-      !
-
-      number_of_sub_steps = config_number_of_sub_steps
-      rk_timestep(1) = dt/3.
-      rk_timestep(2) = dt/2.
-      rk_timestep(3) = dt
-
-      rk_sub_timestep(1) = dt/3.
-      rk_sub_timestep(2) = dt/real(number_of_sub_steps)
-      rk_sub_timestep(3) = dt/real(number_of_sub_steps)
-
-      number_sub_steps(1) = 1
-      number_sub_steps(2) = number_of_sub_steps/2
-      number_sub_steps(3) = number_of_sub_steps
-
-      if(debug) write(0,*) ' copy step in rk solver '
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         ! We are setting values in the halo here, so no communications are needed.
-         ! Alternatively, we could just set owned cells and edge values and communicate after this block loop.
-         call rk_integration_setup( block % time_levs(2) % state, block % time_levs(1) % state, block % mesh )
-         block =&gt; block % next
-      end do
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      ! BEGIN RK loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      do rk_step = 1, 3  ! Runge-Kutta loop
-
-        if(debug) write(0,*) ' rk substep ', rk_step
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           ! The coefficients are set for owned cells (cqw) and for all edges of owned cells, 
-           ! thus no communications should be needed after this call.  
-           ! We could consider combining this and the next block loop.
-           call compute_moist_coefficients( block % time_levs(2) % state, block % mesh )
-           block =&gt; block % next
-        end do
-
-
-        if (debug) write(0,*) ' compute_dyn_tend '
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call compute_dyn_tend( block % intermediate_step(TEND), block % time_levs(2) % state, block % mesh )
-           block =&gt; block % next
-        end do
-        if (debug) write(0,*) ' finished compute_dyn_tend '
-
-!***********************************
-!  we will need to communicate the momentum tendencies here - we want tendencies for all edges of owned cells
-!  because we are solving for all edges of owned cells
-!***********************************
-
-        block =&gt; domain % blocklist
-          do while (associated(block))
-            call set_smlstep_pert_variables( block % time_levs(1) % state, block % time_levs(2) % state,  &amp;
-                                             block % intermediate_step(TEND), block % mesh               )
-            call compute_vert_imp_coefs( block % time_levs(2) % state, block % mesh, rk_sub_timestep(rk_step) )
-            block =&gt; block % next
-        end do
-
-        do small_step = 1, number_sub_steps(rk_step)
-
-           if(debug) write(0,*) ' acoustic step ',small_step
-      
-           block =&gt; domain % blocklist
-           do while (associated(block))
-              call advance_acoustic_step( block % time_levs(2) % state,  block % intermediate_step(TEND),  &amp;
-                                          block % mesh, rk_sub_timestep(rk_step)                          )
-              block =&gt; block % next
-           end do
-
-           if(debug) write(0,*) ' acoustic step complete '
-  
-           !  will need communications here for rtheta_pp
- 
-        end do  ! end of small stimestep loop
-
-        !  will need communications here for rho_pp
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call recover_large_step_variables( block % time_levs(2) % state,             &amp;
-                                              block % mesh, rk_sub_timestep(rk_step),   &amp;
-                                              number_sub_steps(rk_step)  )
-           block =&gt; block % next
-        end do
-
-!  ************  advection of moist variables here...
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           !
-           ! Note: The advance_scalars_mono routine can be used without limiting, and thus, encompasses 
-           !       the functionality of the advance_scalars routine; however, it is noticeably slower, 
-           !       so we keep the advance_scalars routine as well
-           !
-           if (rk_step &lt; 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then
-              call advance_scalars( block % intermediate_step(TEND),                            &amp;
-                                    block % time_levs(1) % state, block % time_levs(2) % state, &amp;
-                                    block % mesh, rk_timestep(rk_step) )
-           else
-              call advance_scalars_mono( block % intermediate_step(TEND),                            &amp;
-                                         block % time_levs(1) % state, block % time_levs(2) % state, &amp;
-                                         block % mesh, rk_timestep(rk_step), rk_step, 3,             &amp;
-                                         domain % dminfo, block % parinfo % cellsToSend, block % parinfo % cellsToRecv )
-           end if
-           block =&gt; block % next
-        end do
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call compute_solve_diagnostics( dt, block % time_levs(2) % state, block % mesh )
-           block =&gt; block % next
-        end do
-
-        if(debug) write(0,*) ' diagnostics complete '
-
-
-      ! need communications here to fill out u, w, theta, p, and pp, scalars, etc  
-      ! so that they are available for next RK step or the first rk substep of the next timestep
-
-      end do ! rk_step loop
-
-!  microphysics here...
-
-      if(do_microphysics) then
-      block =&gt; domain % blocklist
-        do while (associated(block))
-           call qd_kessler( block % time_levs(1) % state, block % time_levs(2) % state, block % mesh, dt )
-           block =&gt; block % next
-        end do
-      end if
-
-!      if(debug) then
-        block =&gt; domain % blocklist
-          do while (associated(block))
-             scalar_min = 0.
-             scalar_max = 0.
-             do iCell = 1, block % mesh % nCellsSolve
-             do k = 1, block % mesh % nVertLevels
-               scalar_min = min(scalar_min, block % time_levs(2) % state % w % array(k,iCell))
-               scalar_max = max(scalar_max, block % time_levs(2) % state % w % array(k,iCell))
-             enddo
-             enddo
-             write(6,*) ' min, max w ',scalar_min, scalar_max
-
-             scalar_min = 0.
-             scalar_max = 0.
-             do iEdge = 1, block % mesh % nEdgesSolve
-             do k = 1, block % mesh % nVertLevels
-               scalar_min = min(scalar_min, block % time_levs(2) % state % u % array(k,iEdge))
-               scalar_max = max(scalar_max, block % time_levs(2) % state % u % array(k,iEdge))
-             enddo
-             enddo
-             write(6,*) ' min, max u ',scalar_min, scalar_max
-
-             scalar_min = 0.
-             scalar_max = 0.
-             do iCell = 1, block % mesh % nCellsSolve
-             do k = 1, block % mesh % nVertLevels
-               scalar_min = min(scalar_min, block % time_levs(2) % state % scalars % array(index_qc,k,iCell))
-               scalar_max = max(scalar_max, block % time_levs(2) % state % scalars % array(index_qc,k,iCell))
-             enddo
-             enddo
-             write(6,*) ' min, max qc ',scalar_min, scalar_max
-
-             block =&gt; block % next
-
-          end do
-!      end if
-
-
-   end subroutine srk3
-
-!---
-
-   subroutine rk_integration_setup( s_old, s_new, grid )
-
-     implicit none
-     type (grid_state) :: s_new, s_old
-     type (grid_meta) :: grid
-     integer :: iCell, k
-
-     grid % ru_save % array = grid % ru % array
-     grid % rw_save % array = grid % rw % array
-     grid % rtheta_p_save % array = grid % rtheta_p % array
-     grid % rho_p_save % array = s_new % rho_p % array
-
-     s_old % u % array = s_new % u % array
-     s_old % w % array = s_new % w % array
-     s_old % theta % array = s_new % theta % array
-     s_old % rho_p % array = s_new % rho_p % array
-     s_old % rho % array = s_new % rho % array
-     s_old % pressure % array = s_new % pressure % array
-
-
-     s_old % scalars % array = s_new % scalars % array
-
-   end subroutine rk_integration_setup
-
-!-----
-
-   subroutine compute_moist_coefficients( state, grid )
-
-     implicit none
-     type (grid_state) :: state
-     type (grid_meta) :: grid
-
-      integer :: iEdge, iCell, k, cell1, cell2, iq
-      integer :: nCells, nEdges, nVertLevels, nCellsSolve
-      real (kind=RKIND) :: qtot
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertLevels = grid % nVertLevels
-      nCellsSolve = grid % nCellsSolve
-
-        do iCell = 1, nCellsSolve
-          do k = 2, nVertLevels
-            qtot = 0.
-            do iq = moist_start, moist_end
-              qtot = qtot + 0.5 * (state % scalars % array (iq, k, iCell) + state % scalars % array (iq, k-1, iCell))
-            end do
-            grid % cqw % array(k,iCell) = 1./(1.+qtot)
-          end do
-        end do
-
-        do iEdge = 1, nEdges
-          cell1 = grid % cellsOnEdge % array(1,iEdge)
-          cell2 = grid % cellsOnEdge % array(2,iEdge)
-          if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-            do k = 1, nVertLevels
-              qtot = 0.
-              do iq = moist_start, moist_end
-                 qtot = qtot + 0.5 * ( state % scalars % array (iq, k, cell1) + state % scalars % array (iq, k, cell2) )
-              end do
-              grid % cqu % array(k,iEdge) = 1./( 1. + qtot)
-            end do
-          end if
-        end do
-
-   end subroutine compute_moist_coefficients
-
-!---
-
-   subroutine compute_vert_imp_coefs(s, grid, dts)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute coefficients for vertically implicit gravity-wave/acoustic computations
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - cofrz, cofwr, cofwz, coftz, cofwt, a, alpha and gamma
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (grid_state), intent(in) :: s
-      type (grid_meta), intent(inout) :: grid
-      real (kind=RKIND), intent(in) :: dts
-
-      integer :: i, k, iq
-
-      integer :: nCells, nVertLevels, nCellsSolve
-      real (kind=RKIND), dimension(:,:), pointer :: zz, cqw, p, t, rb, rtb, pb, rt
-      real (kind=RKIND), dimension(:,:), pointer :: cofwr, cofwz, coftz, cofwt, a_tri, alpha_tri, gamma_tri
-      real (kind=RKIND), dimension(:), pointer :: cofrz, rdzw, fzm, fzp, rdzu
-
-      real (kind=RKIND), dimension( grid % nVertLevels ) :: b_tri,c_tri
-      real (kind=RKIND) :: epssm, dtseps, c2, qtot, rcv
-
-!  set coefficients
-
-      nCells      = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      nVertLevels = grid % nVertLevels
-!      epssm = grid % epssm  !  this should come in through the namelist  ******************
-      epssm = 0.1
-
-      rdzu =&gt; grid % rdzu % array
-      rdzw =&gt; grid % rdzw % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      zz =&gt; grid % zz % array
-      cqw =&gt; grid % cqw % array
-
-      p =&gt; grid % exner % array
-      pb =&gt; grid % exner_base % array
-      rt =&gt; grid % rtheta_p % array
-      rtb =&gt; grid % rtheta_base % array
-      rb =&gt; grid % rho_base % array
-
-      alpha_tri =&gt; grid % alpha_tri % array
-      gamma_tri =&gt; grid % gamma_tri % array
-      a_tri =&gt; grid % a_tri % array
-      cofwr =&gt; grid % cofwr % array      
-      cofwz =&gt; grid % cofwz % array      
-      coftz =&gt; grid % coftz % array      
-      cofwt =&gt; grid % cofwt % array      
-      cofrz =&gt; grid % cofrz % array      
-
-      t =&gt; s % theta % array
-
-      dtseps = .5*dts*(1.+epssm)
-      rcv = rgas/(cp-rgas)
-      c2 = cp*rcv
-
-      do k=1,nVertLevels
-         cofrz(k) = dtseps*rdzw(k)
-      end do
-
-      do i = 1, nCellsSolve  !  we only need to do cells we are solving for, not halo cells
-
-        do k=2,nVertLevels
-          cofwr(k,i) =.5*dtseps*gravity*(fzm(k)*zz(k,i)+fzp(k)*zz(k-1,i))
-        end do
-        do k=2,nVertLevels
-           cofwz(k,i) = dtseps*c2*(fzm(k)*zz(k,i)+fzp(k)*zz(k-1,i))  &amp;
-                *rdzu(k)*cqw(k,i)*(fzm(k)*p (k,i)+fzp(k)*p (k-1,i))
-           coftz(k,i) = dtseps*   (fzm(k)*t (k,i)+fzp(k)*t (k-1,i))
-        end do
-        do k=1,nVertLevels
-
-          qtot = 0.
-          do iq = moist_start, moist_end
-            qtot = qtot + s % scalars % array (iq, k, i)
-          end do
-
-          cofwt(k,i) = .5*dtseps*rcv*zz(k,i)*gravity*rb(k,i)/(1.+qtot)  &amp;
-                              *p(k,i)/((rtb(k,i)+rt(k,i))*pb(k,i))
-        end do
-
-        a_tri(1,i) = 0.  ! note, this value is never used
-        b_tri(1) = 1.    ! note, this value is never used
-        c_tri(1) = 0.    ! note, this value is never used
-        gamma_tri(1,i) = 0.
-        alpha_tri(1,i) = 0.  ! note, this value is never used
-
-        do k=2,nVertLevels
-          a_tri(k,i) = -cofwz(k  ,i)* coftz(k-1,i)*rdzw(k-1)*zz(k-1,i)   &amp;
-                       +cofwr(k  ,i)* cofrz(k-1  )                       &amp;
-                       -cofwt(k-1,i)* coftz(k-1,i)*rdzw(k-1)
-          b_tri(k) = 1.                                                  &amp;
-                       +cofwz(k  ,i)*(coftz(k  ,i)*rdzw(k  )*zz(k  ,i)   &amp;
-                                    +coftz(k  ,i)*rdzw(k-1)*zz(k-1,i))   &amp;
-                       -coftz(k  ,i)*(cofwt(k  ,i)*rdzw(k  )             &amp;
-                                     -cofwt(k-1,i)*rdzw(k-1))            &amp;
-                       +cofwr(k,  i)*(cofrz(k    )-cofrz(k-1))
-          c_tri(k) =   -cofwz(k  ,i)* coftz(k+1,i)*rdzw(k  )*zz(k  ,i)   &amp;
-                       -cofwr(k  ,i)* cofrz(k    )                       &amp;
-                       +cofwt(k  ,i)* coftz(k+1,i)*rdzw(k  )
-        end do
-        do k=2,nVertLevels
-          alpha_tri(k,i) = 1./(b_tri(k)-a_tri(k,i)*gamma_tri(k-1,i))
-          gamma_tri(k,i) = c_tri(k)*alpha_tri(k,i)
-        end do
-
-      end do ! loop over cells
-
-      end subroutine compute_vert_imp_coefs
-
-!------------------------
-
-      subroutine set_smlstep_pert_variables( s_old, s_new, tend, grid )
-
-      implicit none
-      type (grid_state) :: s_new, s_old, tend
-      type (grid_meta) :: grid
-      integer :: iCell, k
-
-      grid % rho_pp % array = grid % rho_p_save % array - s_new % rho_p % array
-
-      grid % ru_p % array = grid % ru_save % array - grid % ru % array
-      grid % rtheta_pp % array = grid % rtheta_p_save % array - grid % rtheta_p % array
-      grid % rtheta_pp_old % array = grid % rtheta_pp % array
-      grid % rw_p % array = grid % rw_save % array - grid % rw % array
-
-      do iCell = 1, grid % nCellsSolve
-      do k = 2, grid % nVertLevels
-        tend % w % array(k,iCell) = ( grid % fzm % array (k) * grid % zz % array(k  ,iCell) +   &amp;
-                                      grid % fzp % array (k) * grid % zz % array(k-1,iCell)   ) &amp;
-                                     * tend % w % array(k,iCell)
-      end do
-      end do
-
-      grid % ruAvg % array = 0.
-      grid % wwAvg % array = 0.
-
-      end subroutine set_smlstep_pert_variables
-
-!-------------------------------
-
-      subroutine advance_acoustic_step( s, tend, grid, dts )
-
-      implicit none
-
-      type (grid_state) :: s, tend
-      type (grid_meta) :: grid
-      real (kind=RKIND), intent(in) :: dts
-
-      real (kind=RKIND), dimension(:,:), pointer :: rho, theta, ru_p, rw_p, rtheta_pp,    &amp;
-                                                    rtheta_pp_old, zz, exner, cqu, ruAvg, &amp;
-                                                    wwAvg, rho_pp, cofwt, coftz, zx,      &amp;
-                                                    a_tri, alpha_tri, gamma_tri, dss,     &amp;
-                                                    tend_ru, tend_rho, tend_rt, tend_rw,  &amp;
-                                                    zgrid, cofwr, cofwz, w
-      real (kind=RKIND), dimension(:), pointer :: fzm, fzp, rdzw, dcEdge, AreaCell, cofrz, dvEdge
-
-      real (kind=RKIND) :: smdiv, c2, rcv
-      real (kind=RKIND), dimension( grid % nVertLevels ) :: du
-      real (kind=RKIND), dimension( grid % nVertLevels + 1 ) :: dpzx
-      real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells ) :: ts, rs
-      real (kind=RKIND), dimension( grid % nVertLevels + 1 , grid % nCells ) :: ws
-
-      integer :: cell1, cell2, iEdge, iCell, k
-      real (kind=RKIND) :: pgrad, flux1, flux2, flux, resm, epssm
-
-      real (kind=RKIND) :: cf1, cf2, cf3
-
-      integer :: nEdges, nCells, nCellsSolve, nVertLevels
-
-      logical, parameter :: debug = .false.
-!      logical, parameter :: debug = .true.
-      logical, parameter :: debug1 = .false.
-      real (kind=RKIND) :: wmax
-      integer :: iwmax, kwmax
-
-!--
-
-      rho =&gt; s % rho % array
-      theta =&gt; s % theta % array
-      w =&gt; s % w % array
-
-      rtheta_pp =&gt; grid % rtheta_pp % array
-      rtheta_pp_old =&gt; grid % rtheta_pp_old % array
-      ru_p =&gt; grid % ru_p % array
-      rw_p =&gt; grid % rw_p % array
-      exner =&gt; grid % exner % array
-      cqu =&gt; grid % cqu % array
-      ruAvg =&gt; grid % ruAvg % array
-      wwAvg =&gt; grid % wwAvg % array
-      rho_pp =&gt; grid % rho_pp % array
-      cofwt =&gt; grid % cofwt % array
-      coftz =&gt; grid % coftz % array
-      cofrz =&gt; grid % cofrz % array
-      cofwr =&gt; grid % cofwr % array
-      cofwz =&gt; grid % cofwz % array
-      a_tri =&gt; grid % a_tri % array
-      alpha_tri =&gt; grid % alpha_tri % array
-      gamma_tri =&gt; grid % gamma_tri % array
-      dss =&gt; grid % dss % array
-
-      tend_ru =&gt; tend % u % array
-      tend_rho =&gt; tend % rho % array
-      tend_rt =&gt; tend % theta % array
-      tend_rw =&gt; tend % w % array
-
-      zz =&gt; grid % zz % array
-      zx =&gt; grid % zx % array
-      zgrid =&gt; grid % zgrid % array
-      fzm =&gt; grid % fzm % array
-      fzp =&gt; grid % fzp % array
-      rdzw =&gt; grid % rdzw % array
-      dcEdge =&gt; grid % dcEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-      AreaCell =&gt; grid % AreaCell % array
-
-!  might these be pointers instead? **************************
-
-      nEdges = grid % nEdges
-      nCells = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      nVertLevels = grid % nVertLevels
-
-!  cf1, cf2 and cf3 should come from the initialization  *************
-
-      cf1 = 1.5
-      cf2 = -0.5
-      cf3 = 0.
-
-!  these values should come from the namelist  *****************
-
-      epssm = 0.1
-      smdiv = 0.1
-
-      rcv = rgas/(cp-rgas)
-      c2 = cp*rcv
-      resm   = (1.-epssm)/(1.+epssm)
-
-      ts = 0.
-      rs = 0.
-      ws = 0.
-
-      ! acoustic step divergence damping - forward weight rtheta_pp
-      rtheta_pp_old = rtheta_pp + smdiv*(rtheta_pp - rtheta_pp_old)
-
-      if(debug) write(0,*) ' updating ru_p '
-
-      do iEdge = 1, nEdges
- 
-        cell1 = grid % cellsOnEdge % array (1,iEdge)
-        cell2 = grid % cellsOnEdge % array (2,iEdge)
-        ! update edge for block-owned cells
-        if (cell1 &lt;= grid % nCellsSolve .or. cell2 &lt;= grid % nCellsSolve ) then
-
-          k = 1
-          dpzx(k) = .5*zx(k,iEdge)*(cf1*(zz(k  ,cell2)*rtheta_pp_old(k  ,cell2)    &amp;
-                                        +zz(k  ,cell1)*rtheta_pp_old(k  ,cell1))   &amp;
-                                   +cf2*(zz(k+1,cell2)*rtheta_pp_old(k+1,cell2)    &amp;
-                                        +zz(k+1,cell1)*rtheta_pp_old(k+1,cell1))   &amp;
-                                   +cf3*(zz(k+2,cell2)*rtheta_pp_old(k+2,cell2)    &amp;
-                                        +zz(k+2,cell1)*rtheta_pp_old(k+2,cell1)))
-          do k=2,grid % nVertLevels
-            dpzx(k)=.5*zx(k,iEdge)*(fzm(k)*(zz(k  ,cell2)*rtheta_pp_old(k  ,cell2)   &amp;
-                                           +zz(k  ,cell1)*rtheta_pp_old(k  ,cell1))  &amp;
-                                   +fzp(k)*(zz(k-1,cell2)*rtheta_pp_old(k-1,cell2)   &amp;
-                                           +zz(k-1,cell1)*rtheta_pp_old(k-1,cell1)))
-          end do
-          dpzx(nVertLevels + 1) = 0.
-
-          do k=1,nVertLevels
-            pgrad =  (rtheta_pp_old(k,cell2)-rtheta_pp_old(k,cell1))/dcEdge(iEdge)  &amp;
-                         - rdzw(k)*(dpzx(k+1)-dpzx(k))
-            pgrad = 0.5*c2*(exner(k,cell1)+exner(k,cell2))*pgrad
-            du(k) = dts*(tend_ru(k,iEdge) - cqu(k,iEdge) * pgrad)
-
-            ru_p(k,iEdge) = ru_p(k,iEdge) + du(k)
-
-            if(debug) then
-              if(iEdge == 3750) then
-                write(0,*) ' k, pgrad, tend_ru ',k,pgrad,tend_ru(k,3750)
-              end if
-            end if
-
-!  need to add horizontal fluxes into density update, rtheta update and w update
-
-            flux = dts*dvEdge(iEdge)*ru_p(k,iEdge)
-            rs(k,cell1) = rs(k,cell1)-flux/AreaCell(cell1)
-            rs(k,cell2) = rs(k,cell2)+flux/AreaCell(cell2)
-
-            flux = flux*0.5*(theta(k,cell2)+theta(k,cell1))
-            ts(k,cell1) = ts(k,cell1)-flux/AreaCell(cell1)
-            ts(k,cell2) = ts(k,cell2)+flux/AreaCell(cell2)
-
-            ruAvg(k,iEdge) = ruAvg(k,iEdge) + ru_p(k,iEdge)
-
-          end do
-
-          do k=2,nVertLevels
-            flux =  dts*0.5*dvEdge(iEdge)*((zgrid(k,cell2)-zgrid(k,cell1))*(fzm(k)*du(k)+fzp(k)*du(k-1))  )
-            flux2 =  - (fzm(k)*zz(k  ,cell2) +fzp(k)*zz(k-1,cell2))*flux/AreaCell(cell2)
-            flux1 =  - (fzm(k)*zz(k  ,cell1) +fzp(k)*zz(k-1,cell1))*flux/AreaCell(cell1)
-            ws(k,cell2) = ws(k,cell2) + flux2
-            ws(k,cell1) = ws(k,cell1) + flux1
-          enddo
-
-        end if ! end test for block-owned cells
-
-      end do ! end loop over edges
-
-      ! saving rtheta_pp before update for use in divergence damping in next acoustic step
-      rtheta_pp_old(:,:) = rtheta_pp(:,:)
-
-      do iCell = 1, nCellsSolve
-
-        do k=1, nVertLevels
-          rs(k,iCell) = rho_pp(k,iCell) + dts*tend_rho(k,iCell) + rs(k,iCell)      &amp;
-                          - cofrz(k)*resm*(rw_p(k+1,iCell)-rw_p(k,iCell))
-          ts(k,iCell) = rtheta_pp(k,iCell) + dts*tend_rt(k,iCell) + ts(k,iCell)    &amp;
-                             - resm*rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell)      &amp;
-                             -coftz(k,iCell)*rw_p(k,iCell))
-        enddo
-
-        do k=2, nVertLevels
-
-          wwavg(k,iCell) = wwavg(k,iCell) + 0.5*(1.-epssm)*rw_p(k,iCell)
-
-          rw_p(k,iCell) = rw_p(k,iCell) + ws(k,iCell) + dts*tend_rw(k,iCell)          &amp;
-                     - cofwz(k,iCell)*((zz(k  ,iCell)*ts (k  ,iCell)                  &amp;
-                                   -zz(k-1,iCell)*ts (k-1,iCell))                     &amp;
-                             +resm*(zz(k  ,iCell)*rtheta_pp(k  ,iCell)                &amp;
-                                   -zz(k-1,iCell)*rtheta_pp(k-1,iCell)))              &amp;
-                     - cofwr(k,iCell)*((rs (k,iCell)+rs (k-1,iCell))                  &amp;
-                             +resm*(rho_pp(k,iCell)+rho_pp(k-1,iCell)))               &amp;
-                     + cofwt(k  ,iCell)*(ts (k  ,iCell)+resm*rtheta_pp(k  ,iCell))    &amp;
-                     + cofwt(k-1,iCell)*(ts (k-1,iCell)+resm*rtheta_pp(k-1,iCell))
-        enddo
-
-        do k=2,nVertLevels
-          rw_p(k,iCell) = (rw_p(k,iCell)-a_tri(k,iCell)*rw_p(k-1,iCell))*alpha_tri(k,iCell)
-        end do
-
-        do k=nVertLevels,1,-1
-          rw_p(k,iCell) = rw_p(k,iCell) - gamma_tri(k,iCell)*rw_p(k+1,iCell)                     
-        end do
-
-        do k=2,nVertLevels
-           rw_p(k,iCell) = (rw_p(k,iCell)-dts*dss(k,iCell)*               &amp;
-                       (fzm(k)*zz (k,iCell)+fzp(k)*zz (k-1,iCell))        &amp;
-                       *(fzm(k)*rho(k,iCell)+fzp(k)*rho(k-1,iCell))       &amp;
-                                *w(k,iCell)    )/(1.+dts*dss(k,iCell))
-
-           wwAvg(k,iCell) = wwAvg(k,iCell) + 0.5*(1.+epssm)*rw_p(k,iCell)
-
-        end do
-
-        do k=1,nVertLevels
-          rho_pp(k,iCell) = rs(k,iCell) - cofrz(k) *(rw_p(k+1,iCell)-rw_p(k  ,iCell))
-          rtheta_pp(k,iCell) = ts(k,iCell) - rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell)  &amp;
-                             -coftz(k  ,iCell)*rw_p(k  ,iCell))
-        end do
-
-      end do !  end of loop over cells
-
-      end subroutine advance_acoustic_step
-
-!------------------------
-
-      subroutine recover_large_step_variables( s, grid, dt, ns )
-
-      implicit none
-      type (grid_state) :: s
-      type (grid_meta) :: grid
-      integer, intent(in) :: ns
-      real (kind=RKIND), intent(in) :: dt
-
-      real (kind=RKIND), dimension(:,:), pointer :: wwAvg, rw_save, w, rw, rw_p, rtheta_p, rtheta_pp,   &amp;
-                                                    rtheta_p_save, rt_diabatic_tend, rho_p, rho_p_save, &amp;
-                                                    rho_pp, rho, rho_base, ruAvg, ru_save, ru_p, u, ru, &amp;
-                                                    exner, exner_base, rtheta_base, pressure_p,         &amp;
-                                                    zz, theta, zgrid
-      real (kind=RKIND), dimension(:), pointer :: fzm, fzp, dvEdge, AreaCell
-      integer, dimension(:,:), pointer :: CellsOnEdge
-
-      integer :: iCell, iEdge, k, cell1, cell2
-      integer :: nVertLevels, nCells, nCellsSolve, nEdges, nEdgesSolve
-      real (kind=RKIND) :: rcv, p0, cf1, cf2, cf3, flux
-
-!      logical, parameter :: debug=.true.
-      logical, parameter :: debug=.false.
-
-!---
-
-       wwAvg =&gt; grid % wwAvg % array
-       rw_save =&gt; grid % rw_save % array
-       rw =&gt; grid % rw % array
-       rw_p =&gt; grid % rw_p % array
-       w =&gt; s % w % array
-
-       rtheta_p =&gt; grid % rtheta_p % array
-       rtheta_p_save =&gt; grid % rtheta_p_save % array
-       rtheta_pp =&gt; grid % rtheta_pp % array
-       rtheta_base =&gt; grid % rtheta_base % array
-       rt_diabatic_tend =&gt; grid % rt_diabatic_tend % array
-       theta =&gt; s % theta % array
-
-       rho =&gt; s % rho % array
-       rho_p =&gt; s % rho_p % array
-       rho_p_save =&gt; grid % rho_p_save % array
-       rho_pp =&gt; grid % rho_pp % array
-       rho_base =&gt; grid % rho_base % array
-
-       ruAvg =&gt; grid % ruAvg % array
-       ru_save =&gt; grid % ru_save % array
-       ru_p =&gt; grid % ru_p % array
-       ru =&gt; grid % ru % array
-       u =&gt; s % u % array
-
-       exner =&gt; grid % exner % array
-       exner_base =&gt; grid % exner_base % array
-
-       pressure_p =&gt; s % pressure % array
-
-       zz =&gt; grid % zz % array
-       zgrid =&gt; grid % zgrid % array
-       fzm =&gt; grid % fzm % array
-       fzp =&gt; grid % fzp % array
-       dvEdge =&gt; grid % dvEdge % array
-       AreaCell =&gt; grid % AreaCell % array
-       CellsOnEdge =&gt; grid % CellsOnEdge % array
-
-       nVertLevels = grid % nVertLevels
-       nCells = grid % nCells
-       nCellsSolve = grid % nCellsSolve
-       nEdges = grid % nEdges
-       nEdgesSolve = grid % nEdgesSolve
-
-       rcv = rgas/(cp-rgas)
-       p0 = 1.e+05  ! this should come from somewhere else...
-       cf1 = 1.5
-       cf2 = -0.5
-       cf3 = 0.
-
-      ! compute new density everywhere so we can compute u from ru.
-      ! we will also need it to compute theta below
-
-      do iCell = 1, nCells
-
-        if(debug) then
-          if( iCell == 479 ) then
-             write(0,*) ' k,rho_old,rp_old, rho_pp '
-            do k=1,nVertLevels
-              write(0,*) k, rho(k,iCell) ,rho_p(k,iCell), rho_pp(k,iCell)
-            enddo
-          end if
-        end if
-
-        do k = 1, nVertLevels
-
-          rho_p(k,iCell) = rho_p(k,iCell) + rho_pp(k,iCell)
-
-          rho(k,iCell) = rho_p(k,iCell) + rho_base(k,iCell)
-        end do
-
-      !  recover owned-cell values in block
-
-        if( iCell &lt;= nCellsSolve ) then
-
-          if(debug) then
-          if( iCell == 479 ) then
-             write(0,*) ' k, rw, rw_save, rw_p '
-            do k=1,nVertLevels
-              write(0,*) k, rw(k,iCell), rw_save(k,iCell) ,rw_p(k,iCell)
-            enddo
-          end if
-          end if
-
-          w(1,iCell) = 0.
-          do k = 2, nVertLevels
-            wwAvg(k,iCell) = rw(k,iCell) + (wwAvg(k,iCell) / float(ns))
-
-            rw(k,iCell) = rw(k,iCell) + rw_p(k,iCell)
-
-
-          ! pick up part of diagnosed w from omega
-            w(k,iCell) = rw(k,iCell)/( (fzm(k)*zz (k,iCell)+fzp(k)*zz (k-1,iCell))   &amp;
-                                      *(fzm(k)*rho(k,iCell)+fzp(k)*rho(k-1,iCell)) )
-          end do
-          w(nVertLevels+1,iCell) = 0.
-
-          if(debug) then
-          if( iCell == 479 ) then
-             write(0,*) ' k, rtheta_p_save, rtheta_pp, rtheta_base '
-            do k=1,nVertLevels
-              write(0,*) k, rtheta_p_save(k,iCell), rtheta_pp(k,iCell), rtheta_base(k,iCell)
-            enddo
-          end if
-          end if
-
-          do k = 1, nVertLevels
-
-            rtheta_p(k,iCell) = rtheta_p(k,iCell) + rtheta_pp(k,iCell) ! - dt * rt_diabatic_tend(k,iCell)
-
-
-            theta(k,iCell) = (rtheta_p(k,iCell) + rtheta_base(k,iCell))/rho(k,iCell)
-            exner(k,iCell) = (zz(k,iCell)*(rgas/p0)*(rtheta_p(k,iCell)+rtheta_base(k,iCell)))**rcv
-             ! pressure below is perturbation pressure - perhaps we should rename it in the Registry????
-            pressure_p(k,iCell) = zz(k,iCell) * rgas * (exner(k,iCell)*rtheta_p(k,iCell)+rtheta_base(k,iCell)  &amp;
-                                                          * (exner(k,iCell)-exner_base(k,iCell)))
-          end do
-
-        end if
-
-      end do
-
-      ! recover time-averaged ruAvg on all edges of owned cells (for upcoming scalar transport).  
-      ! we solved for these in the acoustic-step loop.  
-      ! we will compute ru and u here also, given we are here, even though we only need them on nEdgesSolve
-
-      do iEdge = 1, nEdges
-
-        cell1 = CellsOnEdge(1,iEdge)
-        cell2 = CellsOnEdge(2,iEdge)
-
-        if( cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve ) then
-
-          do k = 1, nVertLevels
-            ruAvg(k,iEdge) = ru(k,iEdge) + (ruAvg(k,iEdge) / float(ns))
-
-            ru(k,iEdge) = ru(k,iEdge) + ru_p(k,iEdge)
-
-            u(k,iEdge) = 2.*ru(k,iEdge)/(rho(k,cell1)+rho(k,cell2))
-          enddo
-
-          flux = dvEdge(iEdge)*0.5*(cf1*u(1,iEdge)+cf2*u(2,iEdge)+cf3*u(3,iEdge))*(zgrid(1,cell2)-zgrid(1,cell1))
-          w(1,cell2) = w(1,cell2)+flux/AreaCell(cell2) 
-          w(1,cell1) = w(1,cell1)+flux/AreaCell(cell1) 
-
-          do k = 2, nVertLevels
-            flux = dvEdge(iEdge)*0.5*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))*(zgrid(k,cell2)-zgrid(k,cell1))
-            w(k,cell2) = w(k,cell2)+flux/AreaCell(cell2) 
-            w(k,cell1) = w(k,cell1)+flux/AreaCell(cell1) 
-          enddo
-
-        end if
-
-      enddo
-
-      end subroutine recover_large_step_variables
-
-!---------------------------------------------------------------------------------------
-
-   subroutine advance_scalars( tend, s_old, s_new, grid, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed scalar tendencies
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (grid_state), intent(in) :: tend
-      type (grid_state), intent(in) :: s_old
-      type (grid_state), intent(out) :: s_new
-      type (grid_meta), intent(in) :: grid
-      real (kind=RKIND) :: dt
-
-      integer :: i, iCell, iEdge, k, iScalar, cell1, cell2
-      real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, h_old, h_new, wwAvg, rho_edge, rho, zgrid
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell, qv_init
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND), dimension( num_scalars, grid % nVertLevels + 1 ) :: wdtn
-      integer :: nVertLevels
-
-      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
-      real (kind=RKIND) :: coef_3rd_order
-
-
-      real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2, scalar_turb_flux, z1,z2,z3,z4,zm,z0,zp
-      logical, parameter :: mix_full = .false.
-!      logical, parameter :: mix_full = .true.
-
-      coef_3rd_order = 0.
-      if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
-      if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-      scalar_old  =&gt; s_old % scalars % array
-      scalar_new  =&gt; s_new % scalars % array
-      deriv_two   =&gt; grid % deriv_two % array
-!****      uhAvg       =&gt; grid % uhAvg % array
-      uhAvg       =&gt; grid % ruAvg % array
-      dvEdge      =&gt; grid % dvEdge % array
-      dcEdge      =&gt; grid % dcEdge % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      scalar_tend =&gt; tend % scalars % array
-!****      h_old       =&gt; s_old % h % array
-!****      h_new       =&gt; s_new % h % array
-      h_old       =&gt; s_old % rho % array
-      h_new       =&gt; s_new % rho % array
-      wwAvg       =&gt; grid % wwAvg % array
-      areaCell    =&gt; grid % areaCell % array
-
-!****      fnm         =&gt; grid % fnm % array
-!****      fnp         =&gt; grid % fnp % array
-!****      rdnw        =&gt; grid % rdnw % array
-      fnm         =&gt; grid % fzm % array
-      fnp         =&gt; grid % fzp % array
-      rdnw        =&gt; grid % rdzw % array
-
-      nVertLevels = grid % nVertLevels
-
-      h_theta_eddy_visc2 = config_h_theta_eddy_visc2
-      v_theta_eddy_visc2 = config_v_theta_eddy_visc2
-      rho_edge     =&gt; s_new % rho_edge % array
-      rho          =&gt; s_new % rho % array
-      qv_init      =&gt; grid % qv_init % array
-      zgrid        =&gt; grid % zgrid % array
-
-      scalar_tend = 0.  !  testing purposes - we have no sources or sinks
-
-      !
-      ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts form scalar_old
-      !
-      !
-      !  horizontal flux divergence, accumulate in scalar_tend
-
-      if (config_scalar_adv_order == 2) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-               do k=1,grid % nVertLevels
-                  do iScalar=1,num_scalars
-                     scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
-                     flux = uhAvg(k,iEdge) * dvEdge(iEdge)  * scalar_edge
-                     scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
-                     scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
-                  end do 
-               end do 
-            end if
-         end do 
-
-      else if (config_scalar_adv_order == 3) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-  
-               do k=1,grid % nVertLevels
-   
-                  do iScalar=1,num_scalars
-                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
-                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
-                     do i=1, grid % nEdgesOnCell % array (cell1)
-                        if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                        d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                       deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
-                     end do
-                     do i=1, grid % nEdgesOnCell % array (cell2)
-                        if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                        d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                       deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
-                     end do
- 
-                     if (uhAvg(k,iEdge) &gt; 0) then
-                        flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
-                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                                -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                                -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     else
-                        flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                                -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                                +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     end if
-
-! old version of the above code, with coef_3rd_order assumed to be 1.0
-!                     if (uhAvg(k,iEdge) &gt; 0) then
-!                        flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
-!                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-!                                               -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
-!                     else
-!                        flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-!                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-!                                               -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
-!                     end if
-    
-                     scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
-                     scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
-  
-                  end do 
-               end do 
-            end if
-         end do 
-
-      else  if (config_scalar_adv_order == 4) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-
-               do k=1,grid % nVertLevels
-   
-                  do iScalar=1,num_scalars
-                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
-                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
-                     do i=1, grid % nEdgesOnCell % array (cell1)
-                        if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                           d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                          deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
-                     end do
-                     do i=1, grid % nEdgesOnCell % array (cell2)
-                        if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                        d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                       deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
-                     end do
-       
-                     flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-       
-                     scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
-                     scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
-                  end do 
-               end do 
-            end if
- 
-         end do
-      end if
-
-!  horizontal mixing for scalars - we could combine this with transport...
-
-      if ( h_theta_eddy_visc2 &gt; 0.0 ) then
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-
-               do k=1,grid % nVertLevels
-                  do iScalar=1,num_scalars
-                    scalar_turb_flux = h_theta_eddy_visc2*prandtl*  &amp;
-                                        (scalar_new(iScalar,k,cell2) - scalar_new(iScalar,k,cell1))/dcEdge(iEdge)
-                    flux = dvEdge (iEdge) * rho_edge(k,iEdge) * scalar_turb_flux
-                    scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) + flux/areaCell(cell1)
-                    scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) - flux/areaCell(cell2)
-                  end do
-               end do
-
-            end if
-         end do
-
-      end if
-
-      ! vertical mixing
-
-      if ( v_theta_eddy_visc2 &gt; 0.0 ) then
-
-         do iCell = 1, grid % nCellsSolve
-            do k=2,nVertLevels-1
-               z1 = zgrid(k-1,iCell)
-               z2 = zgrid(k  ,iCell)
-               z3 = zgrid(k+1,iCell)
-               z4 = zgrid(k+2,iCell)
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               do iScalar=1,num_scalars
-                 scalar_tend(iScalar,k,iCell) = scalar_tend(iScalar,k,iCell) + v_theta_eddy_visc2*prandtl*rho(k,iCell)*(&amp;
-                                        (scalar_new(iScalar,k+1,iCell)-scalar_new(iScalar,k  ,iCell))/(zp-z0)                 &amp;
-                                       -(scalar_new(iScalar,k  ,iCell)-scalar_new(iScalar,k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
-               end do
-             end do
-
-             if ( .not. mix_full) then
-             iScalar = index_qv
-               do k=2,nVertLevels-1
-                z1 = zgrid(k-1,iCell)
-                z2 = zgrid(k  ,iCell)
-                z3 = zgrid(k+1,iCell)
-                z4 = zgrid(k+2,iCell)
-
-                zm = 0.5*(z1+z2)
-                z0 = 0.5*(z2+z3)
-                zp = 0.5*(z3+z4)
-
-                 scalar_tend(iScalar,k,iCell) = scalar_tend(iScalar,k,iCell) + v_theta_eddy_visc2*prandtl*rho(k,iCell)*(&amp;
-                                        (-qv_init(k+1)+qv_init(k))/(zp-z0) &amp;
-                                       -(-qv_init(k)+qv_init(k-1))/(z0-zm) )/(0.5*(zp-zm))
-               end do
-             end if
-
-         end do
-
-         end if
-
-      !
-      !  vertical flux divergence
-      !
-
-      do iCell=1,grid % nCells
-
-        wdtn(:,1) = 0.
-        do k = 2, nVertLevels
-          do iScalar=1,num_scalars
-            wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
-          end do
-        end do
-        wdtn(:,nVertLevels+1) = 0.
-
-         do k=1,grid % nVertLevelsSolve
-            do iScalar=1,num_scalars
-              scalar_new(iScalar,k,iCell) = (   scalar_old(iScalar,k,iCell)*h_old(k,iCell) &amp;
-                    + dt*( scalar_tend(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) )/h_new(k,iCell)
-                                                                                        
-            end do
-         end do
-      end do
-
-   end subroutine advance_scalars
-
-
-   subroutine advance_scalars_mono( tend, s_old, s_new, grid, dt, rk_step, rk_order, dminfo, cellsToSend, cellsToRecv)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed scalar tendencies
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (grid_state), intent(in) :: tend
-      type (grid_state), intent(in) :: s_old
-      type (grid_state), intent(out) :: s_new
-      type (grid_meta), intent(in) :: grid
-      integer, intent(in) :: rk_step, rk_order
-      real (kind=RKIND), intent(in) :: dt
-      type (dm_info), intent(in) :: dminfo
-      type (exchange_list), pointer :: cellsToSend, cellsToRecv
-
-      integer :: i, iCell, iEdge, k, iScalar, cell_upwind, cell1, cell2
-      real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
-      real (kind=RKIND) :: fdir, flux_upwind, h_flux_upwind, s_upwind
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, h_old, h_new, wwAvg
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND), dimension( num_scalars, grid % nEdges) :: h_flux
-      real (kind=RKIND), dimension( num_scalars, grid % nCells, 2 ) :: v_flux, v_flux_upwind, s_update
-      real (kind=RKIND), dimension( num_scalars, grid % nCells, 2 ) :: scale_out, scale_in
-      real (kind=RKIND), dimension( num_scalars ) :: s_max, s_min, s_max_update, s_min_update
-
-      integer :: nVertLevels, km0, km1, ktmp, kcp1, kcm1
-
-      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
-      real (kind=RKIND), parameter :: eps=1.e-20
-      real (kind=RKIND) :: coef_3rd_order
-
-      scalar_old  =&gt; s_old % scalars % array
-      scalar_new  =&gt; s_new % scalars % array
-      deriv_two   =&gt; grid % deriv_two % array
-!****      uhAvg       =&gt; grid % uhAvg % array
-      uhAvg       =&gt; grid % ruAvg % array
-      dvEdge      =&gt; grid % dvEdge % array
-      dcEdge      =&gt; grid % dcEdge % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      scalar_tend =&gt; tend % scalars % array
-!****      h_old       =&gt; s_old % h % array
-!****      h_new       =&gt; s_new % h % array
-      h_old       =&gt; s_old % rho % array
-      h_new       =&gt; s_new % rho % array
-      wwAvg       =&gt; grid % wwAvg % array
-      areaCell    =&gt; grid % areaCell % array
-
-!****      fnm         =&gt; grid % fnm % array
-!****      fnp         =&gt; grid % fnp % array
-!****      rdnw        =&gt; grid % rdnw % array
-      fnm         =&gt; grid % fzm % array
-      fnp         =&gt; grid % fzp % array
-      rdnw        =&gt; grid % rdzw % array
-
-      nVertLevels = grid % nVertLevels
-
-      scalar_tend = 0.  !  testing purposes - we have no sources or sinks
-
-      !
-      ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old
-      !
-
-      km1 = 1
-      km0 = 2
-      v_flux(:,:,km1) = 0.
-      v_flux_upwind(:,:,km1) = 0.
-      scale_out(:,:,:) = 1.
-      scale_in(:,:,:) = 1.
-
-      coef_3rd_order = 0.
-      if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
-      if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-      do k = 1, grid % nVertLevels
-         kcp1 = min(k+1,grid % nVertLevels)
-         kcm1 = max(k-1,1)
-
-!  vertical flux
-
-         do iCell=1,grid % nCells
-
-            if (k &lt; grid % nVertLevels) then
-               cell_upwind = k
-               if (wwAvg(k+1,iCell) &gt;= 0) cell_upwind = k+1
-               do iScalar=1,num_scalars
-                  v_flux(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) *   &amp;
-                       (fnm(k+1) * scalar_new(iScalar,k+1,iCell) + fnp(k+1) * scalar_new(iScalar,k,iCell))
-                  v_flux_upwind(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) * scalar_old(iScalar,cell_upwind,iCell)
-                  v_flux(iScalar,iCell,km0) = v_flux(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km0)
-!                  v_flux(iScalar,iCell,km0) = 0.  ! use only upwind - for testing
-                  s_update(iScalar,iCell,km0) = scalar_old(iScalar,k,iCell) * h_old(k,iCell)  &amp;
-                            - rdnw(k) * (v_flux_upwind(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km1))
-               end do
-            else
-               do iScalar=1,num_scalars
-                  v_flux(iScalar,iCell,km0) = 0.
-                  v_flux_upwind(iScalar,iCell,km0) = 0.
-                  s_update(iScalar,iCell,km0) = scalar_old(iScalar,k,iCell) * h_old(k,iCell)  &amp;
-                            - rdnw(k) * (v_flux_upwind(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km1))
-               end do
-            end if
-
-         end do
-
-! horizontal flux
-
-         if (config_scalar_adv_order == 2) then
-
-            do iEdge=1,grid%nEdges
-               cell1 = cellsOnEdge(1,iEdge)
-               cell2 = cellsOnEdge(2,iEdge)
-               if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-                  cell_upwind = cell2
-                  if (uhAvg(k,iEdge) &gt;= 0) cell_upwind = cell1
-                  do iScalar=1,num_scalars
-                     scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
-                     h_flux(iScalar,iEdge) = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_edge
-                     h_flux_upwind = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_old(iScalar,k,cell_upwind)
-                     h_flux(iScalar,iEdge) = h_flux(iScalar,iEdge) - h_flux_upwind
-!                     h_flux(iScalar,iEdge) = 0.  ! use only upwind - for testing
-                     s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - h_flux_upwind / grid % areaCell % array(cell1)
-                     s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + h_flux_upwind / grid % areaCell % array(cell2)
-                  end do 
-               end if
-            end do 
-
-         else if (config_scalar_adv_order &gt;= 3) then
-
-            do iEdge=1,grid%nEdges
-               cell1 = cellsOnEdge(1,iEdge)
-               cell2 = cellsOnEdge(2,iEdge)
-               if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-                  cell_upwind = cell2
-                  if (uhAvg(k,iEdge) &gt;= 0) cell_upwind = cell1
-                  do iScalar=1,num_scalars
-  
-                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
-                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
-                     do i=1, grid % nEdgesOnCell % array (cell1)
-                        if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                        d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                       deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
-                     end do
-                     do i=1, grid % nEdgesOnCell % array (cell2)
-                        if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                        d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                       deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
-                     end do
-    
-                     if (uhAvg(k,iEdge) &gt; 0) then
-                        flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
-                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                                -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                                -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     else
-                        flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-                                               0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                                -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                                +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     end if
-   
-                     h_flux(iScalar,iEdge) = dt * flux
-                     h_flux_upwind = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_old(iScalar,k,cell_upwind)
-                     h_flux(iScalar,iEdge) = h_flux(iScalar,iEdge) - h_flux_upwind
-!                     h_flux(iScalar,iEdge) = 0.  ! use only upwind - for testing
-                     s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - h_flux_upwind / grid % areaCell % array(cell1)
-                     s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + h_flux_upwind / grid % areaCell % array(cell2)
-                  end do 
-               end if
-            end do 
-
-         end if
-
-
-         if ( (rk_step == rk_order) .and. (config_monotonic .or. config_positive_definite) ) then   
-
-!*************************************************************************************************************
-!---  limiter - we limit horizontal and vertical fluxes on level k 
-!---  (these are h fluxes contributing to level k scalars, and v flux contributing to level k, k-1 scalars)
-
-            do iCell=1,grid % nCells
-  
-               do iScalar=1,num_scalars
-   
-                  s_max(iScalar) = max(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
-                  s_min(iScalar) = min(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
-                  s_max_update(iScalar) = s_update(iScalar,iCell,km0)
-                  s_min_update(iScalar) = s_update(iScalar,iCell,km0)
-    
-                  ! add in vertical flux to get max and min estimate
-                  s_max_update(iScalar) = s_max_update(iScalar)  &amp;
-                     - rdnw(k) * (max(0.,v_flux(iScalar,iCell,km0)) - min(0.,v_flux(iScalar,iCell,km1)))
-                  s_min_update(iScalar) = s_min_update(iScalar)  &amp;
-                     - rdnw(k) * (min(0.,v_flux(iScalar,iCell,km0)) - max(0.,v_flux(iScalar,iCell,km1)))
-    
-               end do
-   
-               do i = 1, grid % nEdgesOnCell % array(iCell)  ! go around the edges of each cell
-                  if (grid % cellsOnCell % array(i,iCell) &gt; 0) then
-                     do iScalar=1,num_scalars
-    
-                        s_max(iScalar)  = max(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_max(iScalar))
-                        s_min(iScalar)  = min(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_min(iScalar))
-     
-                        iEdge = grid % EdgesOnCell % array (i,iCell)
-                        if (iCell == cellsOnEdge(1,iEdge)) then
-                           fdir = 1.0
-                        else
-                           fdir = -1.0
-                        end if
-                        flux = -fdir * h_flux(iScalar,iEdge)/grid % areaCell % array(iCell)
-                        s_max_update(iScalar) = s_max_update(iScalar) + max(0.,flux)
-                        s_min_update(iScalar) = s_min_update(iScalar) + min(0.,flux)
-    
-                     end do
-                  end if
-   
-               end do
-   
-               if( config_positive_definite ) s_min(:) = 0.
-   
-               do iScalar=1,num_scalars
-                  scale_out (iScalar,iCell,km0) = 1.
-                  scale_in (iScalar,iCell,km0) = 1.
-                  s_max_update (iScalar) =  s_max_update (iScalar) / h_new (k,iCell)
-                  s_min_update (iScalar) =  s_min_update (iScalar) / h_new (k,iCell)
-                  s_upwind = s_update(iScalar,iCell,km0) / h_new(k,iCell)
-                  if ( s_max_update(iScalar) &gt; s_max(iScalar) .and. config_monotonic)   &amp;
-                     scale_in (iScalar,iCell,km0) = max(0.,(s_max(iScalar)-s_upwind)/(s_max_update(iScalar)-s_upwind+eps))
-                  if ( s_min_update(iScalar) &lt; s_min(iScalar) )   &amp;
-                     scale_out (iScalar,iCell,km0) = max(0.,(s_upwind-s_min(iScalar))/(s_upwind-s_min_update(iScalar)+eps))
-                end do
-  
-            end do ! end loop over cells to compute scale factor
-
-
-            call dmpar_exch_halo_field2dReal(dminfo, scale_out(:,:,1), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-            call dmpar_exch_halo_field2dReal(dminfo, scale_out(:,:,2), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-            call dmpar_exch_halo_field2dReal(dminfo, scale_in(:,:,1), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-            call dmpar_exch_halo_field2dReal(dminfo, scale_in(:,:,2), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-
-       ! rescale the horizontal fluxes
- 
-            do iEdge = 1, grid % nEdges
-               cell1 = grid % cellsOnEdge % array(1,iEdge)
-               cell2 = grid % cellsOnEdge % array(2,iEdge)
-               if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-                  do iScalar=1,num_scalars
-                     flux = h_flux(iScalar,iEdge)
-                     if (flux &gt; 0) then
-                        flux = flux * min(scale_out(iScalar,cell1,km0), scale_in(iScalar,cell2,km0))
-                     else
-                        flux = flux * min(scale_in(iScalar,cell1,km0), scale_out(iScalar,cell2,km0))
-                     end if
-                     h_flux(iScalar,iEdge) = flux
-                  end do
-               end if
-            end do
- 
-       ! rescale the vertical flux
- 
-            do iCell=1,grid % nCells
-               do iScalar=1,num_scalars
-                  flux =  v_flux(iScalar,iCell,km1)
-                  if (flux &gt; 0) then
-                     flux = flux * min(scale_out(iScalar,iCell,km0), scale_in(iScalar,iCell,km1))
-                  else
-                     flux = flux * min(scale_in(iScalar,iCell,km0), scale_out(iScalar,iCell,km1))
-                  end if
-                  v_flux(iScalar,iCell,km1) = flux
-               end do
-            end do
-
-!  end of limiter
-!*******************************************************************************************************************
-
-         end if
-
-!---  update
-
-         do iCell=1,grid % nCells
-            !  add in upper vertical flux that was just renormalized
-            do iScalar=1,num_scalars
-               s_update(iScalar,iCell,km0) = s_update(iScalar,iCell,km0) + rdnw(k) * v_flux(iScalar,iCell,km1)
-               if (k &gt; 1) s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) - rdnw(k-1)*v_flux(iScalar,iCell,km1)
-            end do
-         end do
- 
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-               do iScalar=1,num_scalars
-                  s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - &amp;
-                      h_flux(iScalar,iEdge) / grid % areaCell % array(cell1)
-                  s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + &amp;
-                      h_flux(iScalar,iEdge) / grid % areaCell % array(cell2)
-               end do 
-            end if
-         end do 
- 
-         ! decouple from mass
-         if (k &gt; 1) then
-            do iCell=1,grid % nCells
-               do iScalar=1,num_scalars
-                  s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) / h_new(k-1,iCell)
-               end do
-            end do
- 
-            do iCell=1,grid % nCells
-               do iScalar=1,num_scalars
-                  scalar_new(iScalar,k-1,iCell) = s_update(iScalar,iCell,km1) 
-               end do
-            end do
-         end if
- 
-         ktmp = km1
-         km1 = km0
-         km0 = ktmp
-
-      end do
-
-      do iCell=1,grid % nCells
-         do iScalar=1,num_scalars
-            scalar_new(iScalar,grid % nVertLevels,iCell) = s_update(iScalar,iCell,km1) / h_new(grid%nVertLevels,iCell)
-         end do
-      end do
-
-   end subroutine advance_scalars_mono
-
-!----
-
-   subroutine compute_dyn_tend(tend, s, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Compute height and normal wind tendencies, as well as diagnostic variables
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed diagnostics (parallel velocities, v; mass fluxes, rv; 
-   !                circulation; vorticity; and kinetic energy, ke) and the 
-   !                tendencies for height (h) and u (u)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (grid_state), intent(inout) :: tend
-      type (grid_state), intent(in) :: s
-      type (grid_meta), intent(in) :: grid
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, iq
-      real (kind=RKIND) :: flux, vorticity_abs, rho_vertex, workpv, q, upstream_bias
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, nCellsSolve
-      real (kind=RKIND) :: h_mom_eddy_visc2,   v_mom_eddy_visc2,   h_mom_eddy_visc4
-      real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2, h_theta_eddy_visc4
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), pointer ::  fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
-      real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge, kiteAreasOnVertex, zgrid, rho_edge, rho, ru, u, v, tend_u, &amp;
-                                                    circulation, divergence, vorticity, ke, pv_edge, theta, rw, tend_rho, &amp;
-                                                    h_diabatic, tend_theta, tend_w, w, cqw, rb, rr, pp, pressure_b, zz, zx, cqu
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-
-      real (kind=RKIND), dimension( grid % nVertLevels + 1 ) :: wduz, wdwz, wdtz, dpzx
-      real (kind=RKIND), dimension( grid % nVertLevels ) :: u_mix
-      real (kind=RKIND) :: theta_edge, theta_turb_flux, z1, z2, z3, z4, zm, z0, zp, r
-      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2, pgrad
-
-      real (kind=RKIND), dimension(:), pointer :: rdzu, rdzw, fzm, fzp, t_init
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: rv, divergence_ru, qtot 
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_theta, delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-      real (kind=RKIND) :: cf1, cf2, cf3
-
-!      logical, parameter :: debug = .true.
-      logical, parameter :: debug = .false.
-      logical, parameter :: mix_full = .false.
-!      logical, parameter :: mix_full = .true.
-
-      rho          =&gt; s % rho % array
-      rho_edge     =&gt; s % rho_edge % array
-      rb           =&gt; grid % rho_base % array
-      rr           =&gt; s % rho_p % array
-      u            =&gt; s % u % array
-      ru           =&gt; grid % ru % array
-      w            =&gt; s % w % array
-      rw           =&gt; grid % rw % array
-      theta        =&gt; s % theta % array
-      circulation  =&gt; s % circulation % array
-      divergence   =&gt; s % divergence % array
-      vorticity    =&gt; s % vorticity % array
-      ke           =&gt; s % ke % array
-      pv_edge      =&gt; s % pv_edge % array
-      pp           =&gt; s % pressure % array
-      pressure_b   =&gt; grid % pressure_base % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      fEdge             =&gt; grid % fEdge % array
-      deriv_two         =&gt; grid % deriv_two % array
-      zz                =&gt; grid % zz % array
-      zx                =&gt; grid % zx % array
-
-      tend_u      =&gt; tend % u % array
-      tend_theta  =&gt; tend % theta % array
-      tend_w      =&gt; tend % w % array
-      tend_rho    =&gt; tend % rho % array
-      h_diabatic  =&gt; grid % rt_diabatic_tend % array
-
-      t_init      =&gt; grid % t_init % array
-
-      rdzu        =&gt; grid % rdzu % array
-      rdzw        =&gt; grid % rdzw % array
-      fzm         =&gt; grid % fzm % array
-      fzp         =&gt; grid % fzp % array
-      zgrid       =&gt; grid % zgrid % array
-      cqw         =&gt; grid % cqw % array
-      cqu         =&gt; grid % cqu % array
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertLevels = grid % nVertLevels
-      nVertices   = grid % nVertices
-      nCellsSolve = grid % nCellsSolve
-
-      h_mom_eddy_visc2 = config_h_mom_eddy_visc2
-      h_mom_eddy_visc4 = config_h_mom_eddy_visc4
-      v_mom_eddy_visc2 = config_v_mom_eddy_visc2
-      h_theta_eddy_visc2 = config_h_theta_eddy_visc2
-      h_theta_eddy_visc4 = config_h_theta_eddy_visc4
-      v_theta_eddy_visc2 = config_v_theta_eddy_visc2
-
-      !
-      ! Compute u (normal) velocity tendency for each edge (cell face)
-      !
-
-      tend_u(:,:) = 0.0
-
-      cf1 = 1.5
-      cf2 = -.5
-      cf3 = 0.
-
-      !  tendency for density
-      !  divergence_ru may calculated in the diagnostic subroutine - it is temporary
-      allocate(divergence_ru(nVertLevels, nCells))
-      allocate(qtot(nVertLevels, nCells))
-
-      divergence_ru(:,:) = 0.0
-      do iEdge=1,grid % nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,nVertLevels
-           flux = ru(k,iEdge)*dvEdge(iEdge)
-           divergence_ru(k,cell1) = divergence_ru(k,cell1) + flux
-           divergence_ru(k,cell2) = divergence_ru(k,cell2) - flux
-         end do
-      end do
-
-      qtot(:,:)=0.
-      do iCell = 1,nCells
-        r = 1.0 / areaCell(iCell)
-        do k = 1,nVertLevels
-           divergence_ru(k,iCell) = divergence_ru(k,iCell) * r
-           tend_rho(k,iCell) = -divergence_ru(k,iCell)-rdzw(k)*(rw(k+1,iCell)-rw(k,iCell))
-
-           do iq = moist_start, moist_end
-              qtot(k,iCell) = qtot(k,iCell) + s % scalars % array (iq, k, iCell)
-           end do
-
-        end do
-      end do    
-
-#ifdef LANL_FORMULATION
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         !  horizontal pressure gradient, nonlinear Coriolis term and ke gradient
-
-         k = 1
-         dpzx(k) = .5*zx(k,iEdge)*(cf1*(pp(k  ,cell2)+pp(k  ,cell1))   &amp;
-                                  +cf2*(pp(k+1,cell2)+pp(k+1,cell1))   &amp;
-                                  +cf3*(pp(k+2,cell2)+pp(k+2,cell1)))
-         do k = 2, nVertLevels
-           dpzx(k) = .5*zx(k,iEdge)*(fzm(k)*(pp(k  ,cell2)+pp(k  ,cell1))  &amp;
-                                +fzp(k)*(pp(k-1,cell2)+pp(k-1,cell1)))
-         end do
-         dpzx(nVertLevels+1) = 0.
-
-
-         do k=1,nVertLevels
-            q = 0.0
-            do j = 1,nEdgesOnEdge(iEdge)
-               eoe = edgesOnEdge(j,iEdge)
-               workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
-               q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * rho_edge(k,eoe)
-            end do
-            tend_u(k,iEdge) = rho_edge(k,iEdge)* (q - (ke(k,cell2) - ke(k,cell1)) / dcEdge(iEdge))                  &amp;
-                              - u(k,iEdge)*0.5*(divergence_ru(k,cell1)+divergence_ru(k,cell2))                      &amp;
-                              - cqu(k,iEdge)*( (pp(k,cell2)/zz(k,cell2) - pp(k,cell1)/zz(k,cell1)) /  dcEdge(iEdge) &amp;
-                                              -rdzw(k)*(dpzx(k+1)-dpzx(k)) )
-         end do
-
-      end do
-
-#endif
-
-#ifdef NCAR_FORMULATION
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-
-      allocate(rv(nVertLevels, nEdges))
-      rv(:,:) = 0.0
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         k = 1
-         dpzx(k) = .5*zx(k,iEdge)*(cf1*(pp(k  ,cell2)+pp(k  ,cell1))   &amp;
-                                  +cf2*(pp(k+1,cell2)+pp(k+1,cell1))   &amp;
-                                  +cf3*(pp(k+2,cell2)+pp(k+2,cell1)))
-         do k = 2, nVertLevels
-           dpzx(k) = .5*zx(k,iEdge)*(fzm(k)*(pp(k  ,cell2)+pp(k  ,cell1))  &amp;
-                                +fzp(k)*(pp(k-1,cell2)+pp(k-1,cell1)))
-         end do
-         dpzx(nVertLevels+1) = 0.
-
-         do j=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(j,iEdge)
-            do k=1,nVertLevels
-               rv(k,iEdge) = rv(k,iEdge) + weightsOnEdge(j,iEdge) * ru(k,eoe)
-            end do
-         end do
-      end do
-
-      do iEdge=1,grid % nEdgesSolve
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,nVertLevels
-            vorticity_abs = fEdge(iEdge) + (circulation(k,vertex1) + circulation(k,vertex2)) / &amp;
-                                           (areaTriangle(vertex1) + areaTriangle(vertex2))
-
-            workpv = 2.0 * vorticity_abs / (rho(k,cell1) + rho(k,cell2))
-
-            tend_u(k,iEdge) = rho_edge(k,iEdge)* (workpv * rv(k,iEdge) - (ke(k,cell2) - ke(k,cell1)) / dcEdge(iEdge)) &amp;
-                              - u(k,iEdge)*0.5*(divergence_ru(k,cell1)+divergence_ru(k,cell2))                        &amp;
-                              - cqu(k,iEdge)*( (pp(k,Cell2)/zz(k,cell2) - pp(k,cell1)/zz(k,cell1)) /  dcEdge(iEdge)   &amp;
-                                              -rdzw(k)*(dpzx(k+1)-dpzx(k)) )
-
-         end do
-
-      end do
-      deallocate(rv)
-#endif
-      deallocate(divergence_ru)
-
-      !
-      !  vertical advection for u
-      !
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         wduz(1) = 0.
-         do k=2,nVertLevels
-            wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2) )*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))  
-         end do
-         wduz(nVertLevels+1) = 0.
-
-         do k=1,nVertLevels
-            tend_u(k,iEdge) = tend_u(k,iEdge) - rdzw(k)*(wduz(k+1)-wduz(k)) 
-         end do
-      end do
-
-      !
-      !  horizontal mixing for u
-      !
-      if ( h_mom_eddy_visc2 &gt; 0.0 ) then
-         do iEdge=1,grid % nEdgesSolve
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            vertex1 = verticesOnEdge(1,iEdge)
-            vertex2 = verticesOnEdge(2,iEdge)
-
-            do k=1,nVertLevels
-
-               !
-               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
-               !                    only valid for h_mom_eddy_visc2 == constant
-               !
-               u_diffusion =   ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                              -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
-               u_diffusion = rho_edge(k,iEdge)*h_mom_eddy_visc2 * u_diffusion
-
-               tend_u(k,iEdge) = tend_u(k,iEdge) + u_diffusion
-            end do
-         end do
-      end if
-
-      if ( h_mom_eddy_visc4 &gt; 0.0 ) then
-
-         allocate(delsq_divergence(nVertLevels, nCells))
-         allocate(delsq_u(nVertLevels, nEdges))
-         allocate(delsq_circulation(nVertLevels, nVertices))
-         allocate(delsq_vorticity(nVertLevels, nVertices))
-
-         delsq_u(:,:) = 0.0
-
-         do iEdge=1,grid % nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            vertex1 = verticesOnEdge(1,iEdge)
-            vertex2 = verticesOnEdge(2,iEdge)
-
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-               do k=1,nVertLevels
-
-                  !
-                  ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
-                  !                    only valid for h_mom_eddy_visc4 == constant
-                  !
-                  u_diffusion =   ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                                 -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
-
-                  delsq_u(k,iEdge) = delsq_u(k,iEdge) + u_diffusion
-               end do
-            end if
-         end do
-
-         delsq_circulation(:,:) = 0.0
-         do iEdge=1,nEdges
-            if (verticesOnEdge(1,iEdge) &gt; 0) then
-               do k=1,nVertLevels
-                  delsq_circulation(k,verticesOnEdge(1,iEdge)) = delsq_circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * delsq_u(k,iEdge)
-               end do
-            end if
-            if (verticesOnEdge(2,iEdge) &gt; 0) then
-               do k=1,nVertLevels
-                  delsq_circulation(k,verticesOnEdge(2,iEdge)) = delsq_circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * delsq_u(k,iEdge)
-               end do
-            end if
-         end do
-         do iVertex=1,nVertices
-            r = 1.0 / areaTriangle(iVertex)
-            do k=1,nVertLevels
-               delsq_vorticity(k,iVertex) = delsq_circulation(k,iVertex) * r
-            end do
-         end do
-
-         delsq_divergence(:,:) = 0.0
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve) then 
-               do k=1,nVertLevels
-                 delsq_divergence(k,cell1) = delsq_divergence(k,cell1) + delsq_u(k,iEdge)*dvEdge(iEdge)
-               end do
-            end if
-            if (cell2 &lt;= nCellsSolve) then
-               do k=1,nVertLevels
-                 delsq_divergence(k,cell2) = delsq_divergence(k,cell2) - delsq_u(k,iEdge)*dvEdge(iEdge)
-               end do
-            end if
-         end do
-         do iCell = 1,nCells
-            r = 1.0 / areaCell(iCell)
-            do k = 1,nVertLevels
-               delsq_divergence(k,iCell) = delsq_divergence(k,iCell) * r
-            end do
-         end do
-
-         do iEdge=1,grid % nEdgesSolve
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            vertex1 = verticesOnEdge(1,iEdge)
-            vertex2 = verticesOnEdge(2,iEdge)
-
-            do k=1,nVertLevels
-
-               !
-               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
-               !                    only valid for h_mom_eddy_visc4 == constant
-               !
-               u_diffusion =  rho_edge(k,iEdge) * ( delsq_divergence(k,cell2)  - delsq_divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                                                 -( delsq_vorticity(k,vertex2) - delsq_vorticity(k,vertex1) ) / dvEdge(iEdge)
-
-               tend_u(k,iEdge) = tend_u(k,iEdge) - h_mom_eddy_visc4 * u_diffusion
-            end do
-         end do
-
-         deallocate(delsq_divergence)
-         deallocate(delsq_u)
-         deallocate(delsq_circulation)
-         deallocate(delsq_vorticity)
-
-      end if
-
-      !
-      !  vertical mixing for u - 2nd order 
-      !
-      if ( v_mom_eddy_visc2 &gt; 0.0 ) then
-
-         if (mix_full) then
-
-         do iEdge=1,grid % nEdgesSolve
-
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            do k=2,nVertLevels-1
-
-               z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2))
-               z2 = 0.5*(zgrid(k  ,cell1)+zgrid(k  ,cell2))
-               z3 = 0.5*(zgrid(k+1,cell1)+zgrid(k+1,cell2))
-               z4 = 0.5*(zgrid(k+2,cell1)+zgrid(k+2,cell2))
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               tend_u(k,iEdge) = tend_u(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*(  &amp;
-                                  (u(k+1,iEdge)-u(k  ,iEdge))/(zp-z0)                      &amp;
-                                 -(u(k  ,iEdge)-u(k-1,iEdge))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-         else  ! idealized cases where we mix on the perturbation from the initial 1-D state
-
-         do iEdge=1,grid % nEdgesSolve
-
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            do k=1,nVertLevels
-              u_mix = u(k,iEdge) - grid % u_init % array(k) * cos( grid % angleEdge % array(iEdge) )
-            end do
-
-            do k=2,nVertLevels-1
-
-               z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2))
-               z2 = 0.5*(zgrid(k  ,cell1)+zgrid(k  ,cell2))
-               z3 = 0.5*(zgrid(k+1,cell1)+zgrid(k+1,cell2))
-               z4 = 0.5*(zgrid(k+2,cell1)+zgrid(k+2,cell2))
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               tend_u(k,iEdge) = tend_u(k,iEdge) + rho_edge(k,iEdge) * v_mom_eddy_visc2*(  &amp;
-                                  (u_mix(k+1)-u_mix(k  ))/(zp-z0)                      &amp;
-                                 -(u_mix(k  )-u_mix(k-1))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-         end if
-
-      end if
-
-!----------- rhs for w
-
-      tend_w(:,:) = 0.
-
-      !
-      !  horizontal advection for w
-      !
-
-      if (config_theta_adv_order == 2) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-               do k=2,grid % nVertLevels
-                  flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge) ) &amp;
-                                        *(w(k,cell1) + w(k,cell2))*0.5 
-                  tend_w(k,cell1) = tend_w(k,cell1) - flux
-                  tend_w(k,cell2) = tend_w(k,cell2) + flux
-               end do
-            end if
-         end do
-
-      else if (config_theta_adv_order == 3) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=2,grid % nVertLevels
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * w(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * w(k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                     d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * w(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                     d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * w(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-!  3rd order stencil
-                  if( u(k,iEdge)+u(k-1,iEdge) &gt; 0) then
-                     flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge))*(  &amp;
-                                             0.5*(w(k,cell1) + w(k,cell2))                 &amp;
-                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
-                  else
-                     flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge))*(  &amp;
-                                             0.5*(w(k,cell1) + w(k,cell2))                 &amp;
-                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
-                  end if
-
-                  tend_w(k,cell1) = tend_w(k,cell1) - flux
-                  tend_w(k,cell2) = tend_w(k,cell2) + flux
-
-               end do
-            end if
-         end do
-
-      else  if (config_theta_adv_order == 4) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=2,grid % nVertLevels
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * w(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * w(k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                     d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * w(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                     d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * w(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-                  flux = dvEdge(iEdge) * (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge)) * (  &amp;
-                                          0.5*(w(k,cell1) + w(k,cell2))                   &amp;
-                                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-
-                  tend_w(k,cell1) = tend_w(k,cell1) - flux
-                  tend_w(k,cell2) = tend_w(k,cell2) + flux
-               end do
-
-            end if
-
-         end do
-      end if
-
-      !
-      !  horizontal mixing for w - we could combine this with advection directly (i.e. as a turbulent flux),
-      !  but here we can also code in hyperdiffusion if we wish (2nd order at present)
-      !
-
-      !  Note: we are using quite a bit of the theta code here - could be combined later???
-
-      if ( h_mom_eddy_visc2 &gt; 0.0 ) then
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=2,grid % nVertLevels
-                  theta_turb_flux = h_mom_eddy_visc2*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
-                  flux = 0.5*dvEdge (iEdge) * (rho_edge(k,iEdge)+rho_edge(k-1,iEdge)) * theta_turb_flux
-                  tend_w(k,cell1) = tend_w(k,cell1) + flux
-                  tend_w(k,cell2) = tend_w(k,cell2) - flux
-               end do
-
-            end if
-         end do
- 
-      end if
-
-      if ( h_mom_eddy_visc4 &gt; 0.0 ) then
-
-         allocate(delsq_theta(nVertLevels, nCells))
-
-         delsq_theta(:,:) = 0.
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-           
-               do k=2,grid % nVertLevels
-                  delsq_theta(k,cell1) = delsq_theta(k,cell1) + dvEdge(iEdge)*0.5*(rho_edge(k,iEdge)+rho_edge(k-1,iEdge))*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
-                  delsq_theta(k,cell2) = delsq_theta(k,cell2) - dvEdge(iEdge)*0.5*(rho_edge(k,iEdge)+rho_edge(k-1,iEdge))*(w(k,cell2) - w(k,cell1))/dcEdge(iEdge)
-               end do
-
-            end if
-         end do
-
-         do iCell = 1, nCells
-            r = 1.0 / areaCell(iCell)
-            do k=2,nVertLevels
-               delsq_theta(k,iCell) = delsq_theta(k,iCell) * r
-            end do
-         end do
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=2,grid % nVertLevels
-                  theta_turb_flux = h_mom_eddy_visc4*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
-                  flux = dvEdge (iEdge) * theta_turb_flux
-
-                  tend_w(k,cell1) = tend_w(k,cell1) - flux
-                  tend_w(k,cell2) = tend_w(k,cell2) + flux
-               end do
-
-            end if
-         end do
-
-         deallocate(delsq_theta)
-
-      end if
-
-      !
-      !  vertical advection, pressure gradient and buoyancy for w
-      !  Note: we are also dividing through by the cell area after the horizontal flux divergence
-      !
-
-      do iCell = 1, nCells
-         wdwz(1) = 0.
-         do k=2,nVertLevels
-            wdwz(k) =  0.25*(rw(k,icell)+rw(k-1,iCell))*(w(k,iCell)+w(k-1,iCell))
-         end do
-         wdwz(nVertLevels+1) = 0.
-         do k=2,nVertLevels
-
-
-            tend_w(k,iCell) = tend_w(k,iCell)/areaCell(iCell) -rdzu(k)*(wdwz(k+1)-wdwz(k))    &amp;
-                                  - cqw(k,iCell)*( rdzu(k)*(pp(k,iCell)-pp(k-1,iCell))        &amp;
-                                  + gravity*  &amp;
-!shpark
-                                   ( fzm(k)*rr(k,iCell) + fzm(k)*(rb(k,iCell)+rr(k,iCell))*qtot(k,iCell) &amp; 
-                                    +fzp(k)*rr(k-1,iCell) + fzp(k)*(rb(k-1,iCell)+rr(k-1,iCell))*qtot(k-1,iCell) )) 
-        
-!                                  - gravity*(fzm(k)*rb(k,iCell)+fzp(k)*rb(k-1,iCell)) )       &amp;
-!                                  - gravity*( fzm(k)*(rr(k,iCell)+rb(k,iCell)) + fzp(k)*(rr(k-1,iCell)+rb(k-1,iCell)) )
-
-
-
-!                               - cqw(k,iCell)*rdzu(k)*(pp(k,iCell)-pp(k-1,iCell))                            &amp;
-!                                - gravity*( fzm(k)*rr(k,iCell)+fzp(k)*rr(k-1,iCell) &amp;
-!                                           +(1.-cqw(k,iCell))*(fzm(k)*rb(k,iCell)+fzp(k)*rb(k-1,iCell)))
-
-
-
-! WCS version                               - cqw(k,iCell)*rdzu(k)*(pp(k,iCell)-pp(k-1,iCell))                            &amp;
-!                                - gravity*0.5*(rr(k,iCell)+rr(k-1,iCell)+(1.-cqw(k,iCell))*(rb(k,iCell)+rb(k-1,iCell)))
-
-!Joe formulation
-!                                  - cqw(k,iCell)*( rdzu(k)*(pp(k,iCell)-pp(k-1,iCell))        &amp;
-!                                  - gravity*(fzm(k)*rb(k,iCell)+fzp(k)*rb(k-1,iCell)) )       &amp;
-!                                  - gravity*( fzm(k)*(rr(k,iCell)+rb(k,iCell)) + fzp(k)*(rr(k-1,iCell)+rb(k-1,iCell)) )
-
-         end do
-      end do
-
-      !
-      !  vertical mixing for w - 2nd order 
-      !
-      if ( v_mom_eddy_visc2 &gt; 0.0 ) then
-
-         do iCell = 1, grid % nCellsSolve
-            do k=2,nVertLevels-1
-               tend_w(k,iCell) = tend_w(k,iCell) + v_mom_eddy_visc2*0.5*(rho(k,iCell)+rho(k-1,iCell))*(  &amp;
-                                        (w(k+1,iCell)-w(k  ,iCell))*rdzw(k)                              &amp;
-                                       -(w(k  ,iCell)-w(k-1,iCell))*rdzw(k-1) )*rdzu(k)
-            end do
-         end do
-
-      end if
-      deallocate(qtot)
-
-!----------- rhs for theta
-
-      tend_theta(:,:) = 0.
-
-      !
-      !  horizontal advection for theta
-      !
-
-      if (config_theta_adv_order == 2) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-               do k=1,grid % nVertLevels
-                  flux = dvEdge(iEdge) *  ru(k,iEdge) * ( 0.5*(theta(k,cell1) + theta(k,cell2)) )
-                  tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-               end do
-            end if
-         end do
-
-      else if (config_theta_adv_order == 3) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=1,grid % nVertLevels
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta(k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                     d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                     d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-!  3rd order stencil
-                  if( u(k,iEdge) &gt; 0) then
-                     flux = dvEdge(iEdge) *  ru(k,iEdge) * (        &amp;
-                                            0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
-                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
-                  else
-                     flux = dvEdge(iEdge) *  ru(k,iEdge) * (        &amp;
-                                            0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
-                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
-                  end if
-
-                  tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-
-               end do
-            end if
-         end do
-
-      else  if (config_theta_adv_order == 4) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-
-               do k=1,grid % nVertLevels
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta(k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     if ( grid % CellsOnCell % array (i,cell1) &gt; 0) &amp;
-                     d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     if ( grid % CellsOnCell % array (i,cell2) &gt; 0) &amp;
-                     d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-                  flux = dvEdge(iEdge) *  ru(k,iEdge) * (                                               &amp;
-                                         0.5*(theta(k,cell1) + theta(k,cell2))                          &amp;
-                                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-
-                  tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-               end do
-
-            end if
-
-         end do
-      end if
-
-!      write(0,*) ' pt 1 tend_theta(3,1120) ',tend_theta(3,1120)/AreaCell(1120)
-
-      !
-      !  horizontal mixing for theta - we could combine this with advection directly (i.e. as a turbulent flux),
-      !  but here we can also code in hyperdiffusion if we wish (2nd order at present)
-      !
-      if ( h_theta_eddy_visc2 &gt; 0.0 ) then
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=1,grid % nVertLevels
-                  theta_turb_flux = h_theta_eddy_visc2*prandtl*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
-                  flux = dvEdge (iEdge) * rho_edge(k,iEdge) * theta_turb_flux
-                  tend_theta(k,cell1) = tend_theta(k,cell1) + flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) - flux
-               end do
-
-            end if
-         end do
-
-      end if
-
-      if ( h_theta_eddy_visc4 &gt; 0.0 ) then
-
-         allocate(delsq_theta(nVertLevels, nCells))
-
-         delsq_theta(:,:) = 0.
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-           
-               do k=1,grid % nVertLevels
-                  delsq_theta(k,cell1) = delsq_theta(k,cell1) + dvEdge(iEdge)*rho_edge(k,iEdge)*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
-                  delsq_theta(k,cell2) = delsq_theta(k,cell2) - dvEdge(iEdge)*rho_edge(k,iEdge)*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
-               end do
-
-            end if
-         end do
-
-         do iCell = 1, nCells
-            r = 1.0 / areaCell(iCell)
-            do k=1,nVertLevels
-               delsq_theta(k,iCell) = delsq_theta(k,iCell) * r
-            end do
-         end do
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            if (cell1 &lt;= nCellsSolve .or. cell2 &lt;= nCellsSolve) then
-
-               do k=1,grid % nVertLevels
-                  theta_turb_flux = h_theta_eddy_visc4*prandtl*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
-                  flux = dvEdge (iEdge) * theta_turb_flux
-
-                  tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-                  tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-               end do
-
-            end if
-         end do
-
-         deallocate(delsq_theta)
-
-      end if
-
-      !
-      !  vertical advection plus diabatic term
-      !  Note: we are also dividing through by the cell area after the horizontal flux divergence
-      !
-      do iCell = 1, nCells
-         wdtz(1) = 0.
-         do k=2,nVertLevels
-            wdtz(k) =  rw(k,icell)*(fzm(k)*theta(k,iCell)+fzp(k)*theta(k-1,iCell))
-         end do
-         wdtz(nVertLevels+1) = 0.
-         do k=1,nVertLevels
-            tend_theta(k,iCell) = tend_theta(k,iCell)/areaCell(iCell) -rdzw(k)*(wdtz(k+1)-wdtz(k))
-!!           tend_theta(k,iCell) = tend_theta(k) + rho(k,iCell)*h_diabatic(k,iCell)
-         end do
-      end do
-
-      !
-      !  vertical mixing for theta - 2nd order 
-      !
-      if ( v_theta_eddy_visc2 &gt; 0.0 ) then
-
-         if (mix_full) then
-
-         do iCell = 1, grid % nCellsSolve
-            do k=2,nVertLevels-1
-               z1 = zgrid(k-1,iCell)
-               z2 = zgrid(k  ,iCell)
-               z3 = zgrid(k+1,iCell)
-               z4 = zgrid(k+2,iCell)
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               tend_theta(k,iCell) = tend_theta(k,iCell) + v_theta_eddy_visc2*prandtl*rho(k,iCell)*(&amp;
-                                        (theta(k+1,iCell)-theta(k  ,iCell))/(zp-z0)                 &amp;
-                                       -(theta(k  ,iCell)-theta(k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-         else  ! idealized cases where we mix on the perturbation from the initial 1-D state
-
-         do iCell = 1, grid % nCellsSolve
-            do k=2,nVertLevels-1
-               z1 = zgrid(k-1,iCell)
-               z2 = zgrid(k  ,iCell)
-               z3 = zgrid(k+1,iCell)
-               z4 = zgrid(k+2,iCell)
-
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-
-               tend_theta(k,iCell) = tend_theta(k,iCell) + v_theta_eddy_visc2*prandtl*rho(k,iCell)*(&amp;
-                                        ((theta(k+1,iCell)-t_init(k+1))-(theta(k  ,iCell)-t_init(k)))/(zp-z0)                 &amp;
-                                       -((theta(k  ,iCell)-t_init(k))-(theta(k-1,iCell)-t_init(k-1)))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-         end if
-
-      end if
-
-   end subroutine compute_dyn_tend
-
-!-------
-
-   subroutine compute_solve_diagnostics(dt, s, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Compute diagnostic fields used in the tendency computations
-   !
-   ! Input: grid - grid metadata
-   !
-   ! Output: s - computed diagnostics
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      real (kind=RKIND), intent(in) :: dt
-      type (grid_state), intent(inout) :: s
-      type (grid_meta), intent(in) :: grid
-
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, r
-
-      integer :: nCells, nEdges, nVertices, nVertLevels
-      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
-      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
-                                                    circulation, vorticity, ke, pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, &amp;
-                                                    divergence
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-
-
-!      h           =&gt; s % h % array
-      h           =&gt; s % rho % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      vh          =&gt; s % rv % array
-      h_edge      =&gt; s % rho_edge % array
-!      tend_h      =&gt; s % h % array
-!      tend_u      =&gt; s % u % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      pv_edge     =&gt; s % pv_edge % array
-      pv_vertex   =&gt; s % pv_vertex % array
-      pv_cell     =&gt; s % pv_cell % array
-      gradPVn     =&gt; s % gradPVn % array
-      gradPVt     =&gt; s % gradPVt % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      !
-      ! Compute height on cell edges at velocity locations
-      !
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         if (cell1 &gt; 0 .and. cell2 &gt; 0) then
-            do k=1,nVertLevels
-               h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
-            end do
-         end if
-      end do
-
-
-
-      !
-      ! Compute circulation and relative vorticity at each vertex
-      !
-      circulation(:,:) = 0.0
-      do iEdge=1,nEdges
-         if (verticesOnEdge(1,iEdge) &gt; 0) then
-            do k=1,nVertLevels
-               circulation(k,verticesOnEdge(1,iEdge)) = circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * u(k,iEdge)
-            end do
-         end if
-         if (verticesOnEdge(2,iEdge) &gt; 0) then
-            do k=1,nVertLevels
-               circulation(k,verticesOnEdge(2,iEdge)) = circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * u(k,iEdge)
-            end do
-         end if
-      end do
-      do iVertex=1,nVertices
-         do k=1,nVertLevels
-            vorticity(k,iVertex) = circulation(k,iVertex) / areaTriangle(iVertex)
-         end do
-      end do
-
-
-      !
-      ! Compute the divergence at each cell center
-      !
-      divergence(:,:) = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         if (cell1 &gt; 0) then
-            do k=1,nVertLevels
-              divergence(k,cell1) = divergence(k,cell1) + u(k,iEdge)*dvEdge(iEdge)
-            end do
-         end if
-         if(cell2 &gt; 0) then
-            do k=1,nVertLevels
-              divergence(k,cell2) = divergence(k,cell2) - u(k,iEdge)*dvEdge(iEdge)
-            end do
-         end if
-
-      end do
-      do iCell = 1,nCells
-        r = 1.0 / areaCell(iCell)
-        do k = 1,nVertLevels
-           divergence(k,iCell) = divergence(k,iCell) * r
-        end do
-      end do
-
-
-      !
-      ! Compute kinetic energy in each cell
-      !
-      ke(:,:) = 0.0
-      do iCell=1,nCells
-         do i=1,nEdgesOnCell(iCell)
-            iEdge = edgesOnCell(i,iCell)
-            do k=1,nVertLevels
-               ke(k,iCell) = ke(k,iCell) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
-            end do
-         end do
-         do k=1,nVertLevels
-            ke(k,iCell) = ke(k,iCell) / areaCell(iCell)
-         end do
-      end do
-
-      !
-      ! Compute v (tangential) velocities
-      !
-      v(:,:) = 0.0
-      do iEdge = 1,nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            if (eoe &gt; 0) then
-               do k = 1,nVertLevels
-                 v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
-              end do
-            end if
-         end do
-      end do
-
-
-      ! tdr
-      !
-      ! Compute height at vertices, pv at vertices, and average pv to edge locations
-      !  ( this computes pv_vertex at all vertices bounding real cells )
-      !
-      VTX_LOOP: do iVertex = 1,nVertices
-         do i=1,grid % vertexDegree
-            if (cellsOnVertex(i,iVertex) &lt;= 0) cycle VTX_LOOP
-         end do
-         do k=1,nVertLevels
-            h_vertex = 0.0
-            do i=1,grid % vertexDegree
-               h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
-            end do
-            h_vertex = h_vertex / areaTriangle(iVertex)
-
-            pv_vertex(k,iVertex) = (fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
-         end do
-      end do VTX_LOOP
-      ! tdr
-
-
-      ! tdr
-      !
-      ! Compute gradient of PV in the tangent direction
-      !   ( this computes gradPVt at all edges bounding real cells )
-      !
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-           gradPVt(k,iEdge) = (pv_vertex(k,verticesOnEdge(2,iEdge)) - pv_vertex(k,verticesOnEdge(1,iEdge))) / &amp;
-                              dvEdge(iEdge)
-         end do
-      end do
-
-      ! tdr
-      !
-      ! Compute pv at the edges
-      !   ( this computes pv_edge at all edges bounding real cells )
-      !
-      pv_edge(:,:) = 0.0
-      do iVertex = 1,nVertices
-        do i=1,grid % vertexDegree
-          iEdge = edgesOnVertex(i,iVertex)
-          if(iEdge &gt; 0) then
-            do k=1,nVertLevels
-              pv_edge(k,iEdge) =  pv_edge(k,iEdge)  + 0.5 * pv_vertex(k,iVertex)
-            end do
-          end if
-        end do
-      end do
-      ! tdr
-
-      ! tdr
-      !
-      ! Modify PV edge with upstream bias. 
-      !
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-           pv_edge(k,iEdge) = pv_edge(k,iEdge) - 0.5 * v(k,iEdge) * dt * gradPVt(k,iEdge)
-         end do
-      end do
-
-
-      ! tdr
-      !
-      ! Compute pv at cell centers
-      !    ( this computes pv_cell for all real cells )
-      !
-      pv_cell(:,:) = 0.0
-      do iVertex = 1, nVertices
-       do i=1,grid % vertexDegree
-         iCell = cellsOnVertex(i,iVertex)
-         if( iCell &gt; 0) then
-           do k = 1,nVertLevels
-             pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) / areaCell(iCell)
-           end do
-         end if
-       end do
-      end do
-      ! tdr
-
-      ! tdr
-      !
-      ! Compute gradient of PV in normal direction
-      !   (tdr: 2009-10-02: this is not correct because the pv_cell in the halo is not correct)
-      !
-      gradPVn(:,:) = 0.0
-      do iEdge = 1,nEdges
-        if( cellsOnEdge(1,iEdge) &gt; 0 .and. cellsOnEdge(2,iEdge) &gt; 0) then
-          do k = 1,nVertLevels
-            gradPVn(k,iEdge) = (pv_cell(k,cellsOnEdge(2,iEdge)) - pv_cell(k,cellsOnEdge(1,iEdge))) / &amp;
-                                 dcEdge(iEdge)
-          end do
-        end if
-      end do
-      ! tdr
-
-      ! Modify PV edge with upstream bias.
-      !
-     do iEdge = 1,nEdges
-        do k = 1,nVertLevels
-          pv_edge(k,iEdge) = pv_edge(k,iEdge) - 0.5 * u(k,iEdge) *dt * gradPVn(k,iEdge)
-        end do
-     end do
-
-
-   end subroutine compute_solve_diagnostics
-
-!----------
-
-   subroutine init_coupled_diagnostics( state, grid )
-
-   implicit none
-   
-   type (grid_state), intent(inout) :: state
-   type (grid_meta), intent(inout) :: grid
-
-   integer :: k,iEdge,i,iCell1,iCell2
-
-      do iEdge = 1, grid%nEdges
-        iCell1 = grid % cellsOnEdge % array(1,iEdge)
-        iCell2 = grid % cellsOnEdge % array(2,iEdge)
-        do k=1,grid % nVertLevels
-          grid % ru % array(k,iEdge) = 0.5 * state % u % array(k,iEdge)*(state % rho % array(k,iCell1)+state % rho % array(k,iCell2))
-        enddo
-      enddo
-
-      do i=1,grid%nCellsSolve
-        do k=1,grid % nVertLevels + 1
-          grid % rw % array (k,i) = 0.
-        enddo
-      enddo
-
-   end subroutine init_coupled_diagnostics
-
-! ------------------------
-
-   subroutine qd_kessler( state_old, state_new, grid, dt )
-
-   implicit none
-   
-   type (grid_state), intent(inout) :: state_old, state_new
-   type (grid_meta), intent(inout) :: grid
-   real (kind=RKIND), intent(in) :: dt
-
-   real (kind=RKIND), dimension( grid % nVertLevels ) :: t, rho, p, dzu, qv, qc, qr, qc1, qr1
-
-   integer :: k,iEdge,i,iCell,nz1
-   real (kind=RKIND) :: p0,rcv
-
-
-   write(0,*) ' in qd_kessler '
-
-   p0 = 1.e+05
-   rcv = rgas/(cp-rgas)
-   nz1 = grid % nVertLevels
-
-   do iCell = 1, grid % nCellsSolve
-
-     do k = 1, grid % nVertLevels
-
-       grid % rt_diabatic_tend % array(k,iCell) = state_new % theta % array(k,iCell)
-
-       t(k) = state_new % theta % array(k,iCell)/(1. + 1.61*state_new % scalars % array(index_qv,k,iCell))
-       rho(k) = grid % zz % array(k,iCell)*state_new % rho % array(k,iCell)
-       p(k) = grid % exner % array(k,iCell)
-       qv(k) = max(0.,state_new % scalars % array(index_qv,k,iCell))
-       qc(k) = max(0.,state_new % scalars % array(index_qc,k,iCell))
-       qr(k) = max(0.,state_new % scalars % array(index_qr,k,iCell))
-       qc1(k) = max(0.,state_old % scalars % array(index_qc,k,iCell))
-       qr1(k) = max(0.,state_old % scalars % array(index_qr,k,iCell))
-       dzu(k) = grid % dzu % array(k)
-
-     end do
-
-     call kessler( t,qv,qc,qc1,qr,qr1,rho,p,dt,dzu,nz1, 1)
-
-     do k = 1, grid % nVertLevels
-
-       grid % rt_diabatic_tend % array(k,iCell) = state_new % theta % array(k,iCell)
-
-       state_new % theta % array(k,iCell) = t(k)*(1.+1.61*qv(k))
-       grid % rt_diabatic_tend % array(k,iCell) = state_new % rho % array(k,iCell) *  &amp;
-                  (state_new % theta % array(k,iCell) - grid % rt_diabatic_tend % array(k,iCell))/dt
-       grid % rtheta_p % array(k,iCell) = state_new % rho % array(k,iCell) * state_new % theta % array(k,iCell)  &amp;
-                                      - grid % rtheta_base % array(k,iCell) 
-       state_new % scalars % array(index_qv,k,iCell) = qv(k)
-       state_new % scalars % array(index_qc,k,iCell) = qc(k)
-       state_new % scalars % array(index_qr,k,iCell) = qr(k)
-
-       grid % exner % array(k,iCell) =                                       &amp;
-                              ( grid % zz % array(k,iCell)*(rgas/p0) * ( &amp;
-                                  grid % rtheta_p % array(k,iCell)       &amp;
-                                + grid % rtheta_base % array(k,iCell) ) )**rcv
-
-       state_new % pressure % array(k,iCell) =                                               &amp;
-            grid % zz % array(k,iCell) * rgas * (                                        &amp;
-              grid % exner % array(k,iCell)*grid % rtheta_p % array(k,iCell)             &amp;
-                                +grid % rtheta_base % array(k,iCell) *                   &amp;
-                     (grid % exner % array(k,iCell) - grid % exner_base % array(k,iCell)) )
-     end do
-
-   end do
-
-   write(0,*) ' exiting qd_kessler '
-
-   end subroutine qd_kessler
-
-!-----------------------------------------------------------------------
-      subroutine kessler( t1t, qv1t, qc1t, qc1, qr1t, qr1,        &amp;
-                              rho, pii, dt, dzu, nz1, nx         )
-!-----------------------------------------------------------------------
-!
-      implicit none
-      integer :: nx, nz1
-      real (kind=RKIND) :: t1t (nz1,nx), qv1t(nz1,nx), qc1t(nz1,nx), &amp;
-                            qr1t(nz1,nx), qc1 (nz1,nx), qr1 (nz1,nx), &amp;
-                            rho (nz1,nx), pii (nz1,nx), dzu(nz1)
-      integer, parameter :: mz=200
-      real (kind=RKIND) ::  qrprod(mz), prod (mz), rcgs( mz), rcgsi (mz) &amp;
-                           ,ern   (mz), vt   (mz), vtden(mz), gam   (mz) &amp;
-                           ,r     (mz), rhalf(mz), velqr(mz), buoycy(mz) &amp;
-                           ,pk    (mz), pc   (mz), f0   (mz), qvs   (mz)
-
-      real (kind=RKIND) :: c1, c2, c3, c4, f5, mxfall, dtfall, fudge, dt, velu, veld, artemp, artot
-      real (kind=RKIND) :: cp, product, ackess, ckess, fvel, f2x, xk, xki, psl
-      integer :: nfall
-      integer :: i,k,n
-
-      ackess = 0.001
-      ckess  = 2.2
-      fvel   = 36.34
-      f2x    = 17.27
-      f5     = 237.3*f2x*2.5e6/1003.
-      xk     = .2875          
-      xki    = 1./xk         
-      psl    = 1000.
-
-      do k=1,nz1
-         r(k)     = 0.001*rho(k,1)
-         rhalf(k) = sqrt(rho(1,1)/rho(k,1))
-         pk(k)    = pii(k,1)
-         pc(k)    = 3.8/(pk(k)**xki*psl)
-         f0(k)    = 2.5e6/(1003.*pk(k))
-      end do
-!
-      do i=1,nx
-         do k=1,nz1
-            qrprod(k) = qc1t(k,i)                                  &amp;
-                      -(qc1t(k,i)-dt*amax1(ackess*(qc1(k,i)-.001), &amp;
-                           0.))/(1.+dt*ckess*qr1(k,i)**.875)       
-                           velqr(k)  = (qr1(k,i)*r(k))**1.1364*rhalf(k)
-            qvs(k)    = pc(k)*exp(f2x*(pk(k)*t1t(k,i)-273.)  &amp;
-                                  /(pk(k)*t1t(k,i)- 36.))
-         end do
-         velu         = (qr1(2,i)*r(2))**1.1364*rhalf(2)
-         veld         = (qr1(1,i)*r(1))**1.1364*rhalf(1)
-         qr1t(1,i)    = qr1t(1,i)+dt*(velu-veld)*fvel/(r(1)*dzu(2))
-         do k=2,nz1-1
-            qr1t(k,i) = qr1t(k,i)+dt*fvel/r(k)                  &amp;
-                         *.5*((velqr(k+1)-velqr(k  ))/dzu(k+1)  &amp;
-                             +(velqr(k  )-velqr(k-1))/dzu(k  ))
-         end do
-         qr1t(nz1,i)  = qr1t(nz1,i)-dt*fvel*velqr(nz1-1)    &amp;
-                                    /(r(nz1)*dzu(nz1)*(1.+1.))
-         artemp       = 36340.*(.5*(velqr(2)+velqr(1))+veld-velu)
-         artot        = artot+dt*artemp
-         do k=1,nz1
-            qc1t(k,i) = amax1(qc1t(k,i)-qrprod(k),0.)
-            qr1t(k,i) = amax1(qr1t(k,i)+qrprod(k),0.)
-            prod(k)   = (qv1t(k,i)-qvs(k))/(1.+qvs(k)*f5  &amp;
-                                /(pk(k)*t1t(k,i)-36.)**2)
-         end do
-         do k=1,nz1
-            ern(k)    = amin1(dt*(((1.6+124.9*(r(k)*qr1t(k,i))**.2046)  &amp;
-                         *(r(k)*qr1t(k,i))**.525)/(2.55e6*pc(k)         &amp;
-                         /(3.8 *qvs(k))+5.4e5))*(dim(qvs(k),qv1t(k,i))  &amp;
-                         /(r(k)*qvs(k))),                               &amp;
-                          amax1(-prod(k)-qc1t(k,i),0.),qr1t(k,i))
-         end do
-         do k=1,nz1
-            buoycy(k) = f0(k)*(amax1(prod(k),-qc1t(k,i))-ern(k))
-                                qv1t(k,i) = amax1(qv1t(k,i)    &amp;
-                         -amax1(prod(k),-qc1t(k,i))+ern(k),0.)
-            qc1t(k,i) = qc1t(k,i)+amax1(prod(k),-qc1t(k,i))
-            qr1t(k,i) = qr1t(k,i)-ern(k)
-            t1t (k,i) = t1t (k,i)+buoycy(k)
-         end do
-      end do
-
-      end  subroutine kessler
-
-end module time_integration

</font>
</pre>