fv_control.F90

Go to the documentation of this file.

!***********************************************************************
!*                   GNU Lesser General Public License                 
!*
!* This file is part of the FV3 dynamical core.
!*
!* The FV3 dynamical core is free software: you can redistribute it 
!* and/or modify it under the terms of the
!* GNU Lesser General Public License as published by the
!* Free Software Foundation, either version 3 of the License, or 
!* (at your option) any later version.
!*
!* The FV3 dynamical core is distributed in the hope that it will be 
!* useful, but WITHOUT ANYWARRANTY; without even the implied warranty 
!* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
!* See the GNU General Public License for more details.
!*
!* You should have received a copy of the GNU Lesser General Public
!* License along with the FV3 dynamical core.  
!* If not, see <http://www.gnu.org/licenses/>.
!***********************************************************************

!----------------
! FV control panel
!----------------

module fv_control_mod
! Modules Included:
! <table>
! <tr>
!     <th>Module Name</th>
!     <th>Functions Included</th>
!   </tr>
! <table>
!   <tr>
!     <td>constants_mod</td>
!     <td>pi=>pi_8, kappa, radius, grav, rdgas</td>
!   </tr>
!   <tr>
!     <td>field_manager_mod</td>
!     <td>MODEL_ATMOS</td>
!   </tr>
!   <tr>
!     <td>fms_mod</td>
!     <td>write_version_number, open_namelist_file,
!         check_nml_error, close_file, file_exist</td>
!   </tr>
!   <tr>
!     <td>fv_arrays_mod</td>
!     <td>fv_atmos_type, allocate_fv_atmos_type, deallocate_fv_atmos_type,
!          R_GRID</td>
!   </tr>
!   <tr>
!     <td>fv_diagnostics_mod</td>
!     <td>fv_diag_init_gn</td>
!   </tr>
!   <tr>
!     <td>fv_eta_mod</td>
!     <td>set_eta</td>
!   </tr>
!   <tr>
!     <td>fv_grid_tools_mod</td>
!     <td>init_grid</td>
!   </tr>
!   <tr>
!     <td>fv_grid_utils_mod</td>
!     <td>grid_utils_init, grid_utils_end, ptop_min</td>
!   </tr>
!   <tr>
!     <td>fv_mp_mod</td>
!     <td>mp_start, mp_assign_gid, domain_decomp,ng, switch_current_Atm,
!         broadcast_domains, mp_barrier, is_master, setup_master </td>
!   </tr>
!   <tr>
!     <td>fv_io_mod</td>
!     <td>fv_io_exit</td>
!   </tr>
!   <tr>
!     <td>fv_restart_mod</td>
!     <td>fv_restart_init, fv_restart_end</td>
!   </tr>
!   <tr>
!     <td>fv_timing_mod</td>
!     <td>timing_on, timing_off, timing_init, timing_prt</td>
!   </tr>
!   <tr>
!     <td>mpp_mod</td>
!     <td>mpp_send, mpp_sync, mpp_transmit, mpp_set_current_pelist, mpp_declare_pelist, 
!         mpp_root_pe, mpp_recv, mpp_sync_self, mpp_broadcast, read_input_nml,
!         FATAL, mpp_error, mpp_pe, stdlog, mpp_npes, mpp_get_current_pelist, 
!         input_nml_file, get_unit, WARNING, read_ascii_file, INPUT_STR_LENGTH</td>
!   </tr>
!   <tr>
!     <td>mpp_domains_mod</td>
!     <td>mpp_get_data_domain, mpp_get_compute_domain, domain2D, mpp_define_nest_domains, 
!        nest_domain_type, mpp_get_global_domain, mpp_get_C2F_index, mpp_get_F2C_index,
!        mpp_broadcast_domain, CENTER, CORNER, NORTH, EAST, WEST, SOUTH</td>
!   </tr>
!   <tr>
!     <td>mpp_parameter_mod</td>
!     <td>AGRID_PARAM=>AGRID</td>
!   </tr>
!   <tr>
!     <td>test_cases_mod</td>
!     <td>test_case, bubble_do, alpha, nsolitons, soliton_Umax, soliton_size</td>
!   </tr>
!   <tr>
!     <td>tracer_manager_mod</td>
!     <td>tm_get_number_tracers => get_number_tracers,tm_get_tracer_index => get_tracer_index,   
!         tm_get_tracer_indices => get_tracer_indices, tm_set_tracer_profile => set_tracer_profile, 
!         tm_get_tracer_names => get_tracer_names,tm_check_if_prognostic=> check_if_prognostic,
!         tm_register_tracers => register_tracers</td>
!   </tr>
! </table>

   use constants_mod,       only: pi=>pi_8, kappa, radius, grav, rdgas
   use field_manager_mod,   only: model_atmos
   use fms_mod,             only: write_version_number, open_namelist_file, &
                                  check_nml_error, close_file, file_exist
   use mpp_mod,             only: fatal, mpp_error, mpp_pe, stdlog, &
                                  mpp_npes, mpp_get_current_pelist, &
                                  input_nml_file, get_unit, warning, &
                                  read_ascii_file, input_str_length
   use mpp_domains_mod,     only: mpp_get_data_domain, mpp_get_compute_domain
   use tracer_manager_mod,  only: tm_get_number_tracers => get_number_tracers, &
                                  tm_get_tracer_index   => get_tracer_index,   &
                                  tm_get_tracer_indices => get_tracer_indices, &
                                  tm_set_tracer_profile => set_tracer_profile, &
                                  tm_get_tracer_names   => get_tracer_names,   &
                                  tm_check_if_prognostic=> check_if_prognostic,&
                                  tm_register_tracers   => register_tracers

   use fv_io_mod,           only: fv_io_exit
   use fv_restart_mod,      only: fv_restart_init, fv_restart_end
   use fv_arrays_mod,       only: fv_atmos_type, allocate_fv_atmos_type, deallocate_fv_atmos_type, &
                                  r_grid
   use fv_grid_utils_mod,   only: grid_utils_init, grid_utils_end, ptop_min
   use fv_eta_mod,          only: set_eta
   use fv_grid_tools_mod,   only: init_grid
   use fv_mp_mod,           only: mp_start, mp_assign_gid, domain_decomp
   use fv_mp_mod,           only: ng, switch_current_atm
   use fv_mp_mod,           only: broadcast_domains, mp_barrier, is_master, setup_master
!!! CLEANUP: should be replaced by a getter function?
   use test_cases_mod,      only: test_case, bubble_do, alpha, nsolitons, soliton_umax, soliton_size
   use fv_timing_mod,       only: timing_on, timing_off, timing_init, timing_prt
   use mpp_domains_mod,     only: domain2d
   use mpp_domains_mod,     only: mpp_define_nest_domains, nest_domain_type, mpp_get_global_domain
   use mpp_domains_mod,     only: mpp_get_c2f_index, mpp_get_f2c_index, mpp_broadcast_domain
   use mpp_domains_mod,     only: center, corner, north, east, west, south
   use mpp_mod,             only: mpp_send, mpp_sync, mpp_transmit, mpp_set_current_pelist, mpp_declare_pelist, mpp_root_pe, mpp_recv, mpp_sync_self, mpp_broadcast, read_input_nml
   use fv_diagnostics_mod,  only: fv_diag_init_gn

#ifdef MULTI_GASES
   use constants_mod,       only: rvgas, cp_air
   use multi_gases_mod,     only: multi_gases_init, &
                                  rilist => ri,     &
                                  cpilist => cpi
#endif

   implicit none
   private

!-----------------------------------------------------------------------
! Grid descriptor file setup
!-----------------------------------------------------------------------
!------------------------------------------
! Model Domain parameters
! See fv_arrays.F90 for descriptions
!------------------------------------------
!CLEANUP module pointers
   character(len=80) , pointer :: grid_name
   character(len=120), pointer :: grid_file
   integer, pointer :: grid_type
   integer , pointer :: hord_mt 
   integer , pointer :: kord_mt 
   integer , pointer :: kord_wz 
   integer , pointer :: hord_vt 
   integer , pointer :: hord_tm 
   integer , pointer :: hord_dp 
   integer , pointer :: kord_tm 
   integer , pointer :: hord_tr 
   integer , pointer :: kord_tr 
   real    , pointer :: scale_z 
   real    , pointer :: w_max 
   real    , pointer :: z_min 
   real    , pointer :: lim_fac

   integer , pointer :: nord
   integer , pointer :: nord_tr
   real    , pointer :: dddmp 
   real    , pointer :: d2_bg 
   real    , pointer :: d4_bg 
   real    , pointer :: vtdm4 
   real    , pointer :: trdm2 
   real    , pointer :: d2_bg_k1 
   real    , pointer :: d2_bg_k2 
   real    , pointer :: d2_divg_max_k1 
   real    , pointer :: d2_divg_max_k2 
   real    , pointer :: damp_k_k1 
   real    , pointer :: damp_k_k2 
   integer , pointer ::    n_zs_filter
   integer , pointer :: nord_zs_filter
   logical , pointer :: full_zs_filter

   logical , pointer :: rf_fast
   logical , pointer :: consv_am
   logical , pointer :: do_sat_adj
   logical , pointer :: do_f3d
   logical , pointer :: no_dycore 
   logical , pointer :: convert_ke 
   logical , pointer :: do_vort_damp 
   logical , pointer :: use_old_omega 
! PG off centering:
   real    , pointer :: beta  
   integer , pointer :: n_sponge 
   real    , pointer :: d_ext 
   integer , pointer :: nwat  
   logical , pointer :: warm_start 
   logical , pointer :: inline_q 
   real , pointer :: shift_fac   
   logical , pointer :: do_schmidt 
   real(kind=R_GRID) , pointer :: stretch_fac 
   real(kind=R_GRID) , pointer :: target_lat  
   real(kind=R_GRID) , pointer :: target_lon  

   logical , pointer :: reset_eta 
   real    , pointer :: p_fac
   real    , pointer :: a_imp
   integer , pointer :: n_split 

   real    , pointer :: fac_n_spl
   real    , pointer :: fhouri
                             ! Default 
   integer , pointer :: m_split 
   integer , pointer :: k_split 
   logical , pointer :: use_logp

   integer , pointer :: q_split 
   integer , pointer :: print_freq 
   logical , pointer :: write_3d_diags

   integer , pointer :: npx           
   integer , pointer :: npy           
   integer , pointer :: npz
   integer , pointer :: npz_rst 
                                      
   integer , pointer :: ncnst 
   integer , pointer :: pnats 
   integer , pointer :: dnats 
   integer , pointer :: ntiles        
   integer , pointer :: nf_omega  
   integer , pointer :: fv_sg_adj 
                                      
   integer , pointer :: na_init 
   logical , pointer :: nudge_dz
   real    , pointer :: p_ref 
   real    , pointer :: dry_mass 
   integer , pointer :: nt_prog 
   integer , pointer :: nt_phys 
   real    , pointer :: tau_h2o 

   real    , pointer :: delt_max
   real    , pointer :: d_con 
   real    , pointer :: ke_bg
   real    , pointer :: consv_te 
   real    , pointer :: tau 
   real    , pointer :: rf_cutoff
   logical , pointer :: filter_phys 
   logical , pointer :: dwind_2d 
   logical , pointer :: breed_vortex_inline 
   logical , pointer :: range_warn 
   logical , pointer :: fill 
   logical , pointer :: fill_dp 
   logical , pointer :: fill_wz 
   logical , pointer :: check_negative
   logical , pointer :: non_ortho 
   logical , pointer :: adiabatic 
   logical , pointer :: moist_phys 
   logical , pointer :: do_held_suarez 
   logical , pointer :: do_reed_physics
   logical , pointer :: reed_cond_only
   logical , pointer :: reproduce_sum 
   logical , pointer :: adjust_dry_mass 
   logical , pointer :: fv_debug  
   logical , pointer :: srf_init  
   logical , pointer :: mountain  
   logical , pointer :: remap_t  
   logical , pointer :: z_tracer 

   logical , pointer :: old_divg_damp 
   logical , pointer :: fv_land 
   logical , pointer :: nudge 
   logical , pointer :: nudge_ic
   logical , pointer :: ncep_ic 
   logical , pointer :: nggps_ic 
   logical , pointer :: ecmwf_ic 
   logical , pointer :: gfs_phil
   logical , pointer :: agrid_vel_rst
   logical , pointer :: use_new_ncep 
   logical , pointer :: use_ncep_phy 
   logical , pointer :: fv_diag_ic 
   logical , pointer :: external_ic 
   logical , pointer :: external_eta
   logical , pointer :: read_increment
   character(len=128) , pointer :: res_latlon_dynamics
   character(len=128) , pointer :: res_latlon_tracers 
   logical , pointer :: hydrostatic 
   logical , pointer :: phys_hydrostatic
   logical , pointer :: use_hydro_pressure
   logical , pointer :: do_uni_zfull !miz
   logical , pointer :: adj_mass_vmr ! f1p
   logical , pointer :: hybrid_z    
   logical , pointer :: make_nh     
   logical , pointer :: make_hybrid_z  
   logical , pointer :: nudge_qv
   real,     pointer :: add_noise

   integer , pointer :: a2b_ord 
   integer , pointer :: c2l_ord 

   integer, pointer :: ndims

  real(kind=R_GRID), pointer :: dx_const
  real(kind=R_GRID), pointer :: dy_const
  real(kind=R_GRID), pointer :: deglon_start, deglon_stop, &  ! boundaries of latlon patch
          deglat_start, deglat_stop
  real(kind=R_GRID), pointer :: deglat

  logical, pointer :: nested, twowaynest
  logical, pointer :: regional
  integer, pointer :: bc_update_interval 
  integer, pointer :: parent_tile, refinement, nestbctype, nestupdate, nsponge, ioffset, joffset
  real, pointer :: s_weight, update_blend

  integer, pointer :: layout(:), io_layout(:)

   integer :: ntilesme                ! Number of tiles on this process =1 for now

#ifdef OVERLOAD_R4
   real    :: too_big  = 1.e8
#else
   real    :: too_big  = 1.e35
#endif
   public :: fv_init, fv_end

   integer, public :: ngrids = 1
   integer, public, allocatable :: pelist_all(:)
   integer :: commid, max_refinement_of_global = 1.
   integer :: gid

   real :: umax = 350.
   integer :: parent_grid_num = -1

   integer :: halo_update_type = 1



! version number of this module
! Include variable "version" to be written to log file.
#include<file_version.h>

 contains

!-------------------------------------------------------------------------------
 subroutine fv_init(Atm, dt_atmos, grids_on_this_pe, p_split)

   type(fv_atmos_type), allocatable, intent(inout), target :: Atm(:)
   real,                intent(in)    :: dt_atmos
   logical, allocatable, intent(INOUT) :: grids_on_this_pe(:)
   integer, intent(INOUT) :: p_split

   integer :: i, j, k, n, p
   real :: sdt

! tracers
   integer :: num_family

   integer :: isc_p, iec_p, jsc_p, jec_p, isg, ieg, jsg, jeg, upoff, jind
   integer :: ic, jc

   gid = mpp_pe()
   call init_nesting(atm, grids_on_this_pe, p_split)

   !This call is needed to set up the pointers for fv_current_grid, even for a single-grid run
   !call switch_current_Atm(Atm(1), .false.)
   call setup_pointers(atm(1))

! Start up MPI

   !call mp_assign_gid

    ! Initialize timing routines
      call timing_init
      call timing_on('TOTAL')

    ! Setup the run from namelist 
      ntilesme = size(atm(:)) !Full number of Atm arrays; one less than number of grids, if multiple grids

      call run_setup(atm,dt_atmos, grids_on_this_pe, p_split)   ! initializes domain_decomp

      do n=1,ntilesme

         !In a single-grid run this will still be needed to correctly set the domain
         call switch_current_atm(atm(n))
         call setup_pointers(atm(n))
         
         target_lon = target_lon * pi/180.
         target_lat = target_lat * pi/180.

!--------------------------------------------------
! override number of tracers by reading field_table
!--------------------------------------------------

         !not sure if this works with multiple grids
         call tm_register_tracers (model_atmos, ncnst, nt_prog, pnats, num_family)
         if(is_master()) then
            write(*,*) 'ncnst=', ncnst,' num_prog=',nt_prog,' pnats=',pnats,' dnats=',dnats,' num_family=',num_family         
            print*, ''
         endif

         if (grids_on_this_pe(n)) then
            call allocate_fv_atmos_type(atm(n), atm(n)%bd%isd, atm(n)%bd%ied, atm(n)%bd%jsd, atm(n)%bd%jed, &
                 atm(n)%bd%isc, atm(n)%bd%iec, atm(n)%bd%jsc, atm(n)%bd%jec, &
                 npx, npy, npz, ndims, ncnst, ncnst-pnats, ng, .false., grids_on_this_pe(n), ngrids)

            if (grids_on_this_pe(n)) then

               call switch_current_atm(atm(n))
               call setup_pointers(atm(n))

               if ( (atm(n)%bd%iec-atm(n)%bd%isc+1).lt.4 .or. (atm(n)%bd%jec-atm(n)%bd%jsc+1).lt.4 ) then
                  if (is_master()) write(*,'(6I6)') atm(n)%bd%isc, atm(n)%bd%iec, atm(n)%bd%jsc, atm(n)%bd%jec, n
                  call mpp_error(fatal,'Domain Decomposition:  Cubed Sphere compute domain has a &
                       &minium requirement of 4 points in X and Y, respectively')
               end if

            endif

            !!CLEANUP: Convenience pointers
            atm(n)%gridstruct%nested      => atm(n)%neststruct%nested
            atm(n)%gridstruct%grid_type   => atm(n)%flagstruct%grid_type
            atm(n)%flagstruct%grid_number => atm(n)%grid_number
            atm(n)%gridstruct%regional  => atm(n)%flagstruct%regional

            call init_grid(atm(n), grid_name, grid_file, npx, npy, npz, ndims, ntiles, ng)

            ! Initialize the SW (2D) part of the model
            !!!CLEANUP: this call could definitely use some cleaning up
            call grid_utils_init(atm(n), npx, npy, npz, non_ortho, grid_type, c2l_ord)

            !!!CLEANUP: Are these correctly writing out on all pes?
            if ( is_master() ) then
               sdt =  dt_atmos/real(n_split*k_split*abs(p_split))
               write(*,*) ' '
               write(*,*) 'Divergence damping Coefficients'
               write(*,*) 'For small dt=', sdt
               write(*,*) 'External mode del-2 (m**2/s)=',  d_ext*atm(n)%gridstruct%da_min_c/sdt
               write(*,*) 'Internal mode del-2 SMAG dimensionless coeff=',  dddmp
               write(*,*) 'Internal mode del-2 background diff=', d2_bg*atm(n)%gridstruct%da_min_c/sdt

               if (nord==1) then
                   write(*,*) 'Internal mode del-4 background diff=', d4_bg
                   write(*,*) 'Vorticity del-4 (m**4/s)=', (vtdm4*atm(n)%gridstruct%da_min)**2/sdt*1.e-6
               endif
               if (nord==2) write(*,*) 'Internal mode del-6 background diff=', d4_bg
               if (nord==3) write(*,*) 'Internal mode del-8 background diff=', d4_bg
               write(*,*) 'tracer del-2 diff=', trdm2

               write(*,*) 'Vorticity del-4 (m**4/s)=', (vtdm4*atm(n)%gridstruct%da_min)**2/sdt*1.e-6
               write(*,*) 'beta=', beta
               write(*,*) ' '
            endif


            atm(n)%ts   = 300.
            atm(n)%phis = too_big
            ! The following statements are to prevent the phatom corner regions from
            ! growing instability
            atm(n)%u  = 0.
            atm(n)%v  = 0.
            atm(n)%ua = too_big
            atm(n)%va = too_big

         else !this grid is NOT defined on this pe

            !Allocate dummy arrays
            call allocate_fv_atmos_type(atm(n),  atm(n)%bd%isd, atm(n)%bd%ied, atm(n)%bd%jsd, atm(n)%bd%jed, &
                 atm(n)%bd%isc, atm(n)%bd%iec, atm(n)%bd%jsc, atm(n)%bd%jec, &
                 npx, npy, npz, ndims, ncnst, ncnst-pnats, ng, .true., .false., ngrids)

            !Need to SEND grid_global to any child grids; this is received in setup_aligned_nest in fv_grid_tools
            if (atm(n)%neststruct%nested) then

               call mpp_get_global_domain( atm(n)%parent_grid%domain, &
                    isg, ieg, jsg, jeg)

               !FIXME: Should replace this by generating the global grid (or at least one face thereof) on the 
               ! nested PEs instead of sending it around.
               if (gid == atm(n)%parent_grid%pelist(1)) then
                     call mpp_send(atm(n)%parent_grid%grid_global(isg-ng:ieg+1+ng,jsg-ng:jeg+1+ng,1:2,parent_tile), &
                          size(atm(n)%parent_grid%grid_global(isg-ng:ieg+1+ng,jsg-ng:jeg+1+ng,1:2,parent_tile)), &
                       atm(n)%pelist(1)) !send to p_ind in setup_aligned_nest
                  call mpp_sync_self()
               endif

               if (atm(n)%neststruct%twowaynest) then

                  !This in reality should be very simple. With the
                  ! restriction that only the compute domain data is
                  ! sent from the coarse grid, we can compute
                  ! exactly which coarse grid cells should use
                  ! which nested-grid data. We then don't need to send around p_ind.

                  atm(n)%neststruct%ind_update_h = -99999

                  if (atm(n)%parent_grid%tile == atm(n)%neststruct%parent_tile) then

                     isc_p = atm(n)%parent_grid%bd%isc
                     iec_p = atm(n)%parent_grid%bd%iec
                     jsc_p = atm(n)%parent_grid%bd%jsc
                     jec_p = atm(n)%parent_grid%bd%jec
                     upoff = atm(n)%neststruct%upoff

                     atm(n)%neststruct%jsu = jsc_p
                     atm(n)%neststruct%jeu = jsc_p-1
                     do j=jsc_p,jec_p+1
                        if (j < joffset+upoff) then
                           do i=isc_p,iec_p+1
                              atm(n)%neststruct%ind_update_h(i,j,2) = -9999
                           enddo
                           atm(n)%neststruct%jsu = atm(n)%neststruct%jsu + 1
                        elseif (j > joffset + (npy-1)/refinement - upoff) then
                           do i=isc_p,iec_p+1
                              atm(n)%neststruct%ind_update_h(i,j,2) = -9999
                           enddo
                        else
                           jind = (j - joffset)*refinement + 1
                           do i=isc_p,iec_p+1
                              atm(n)%neststruct%ind_update_h(i,j,2) = jind
                           enddo
                           if ( (j < joffset + (npy-1)/refinement - upoff) .and. j <= jec_p)  atm(n)%neststruct%jeu = j
                        endif
                        !write(mpp_pe()+4000,*) j, joffset, upoff, Atm(n)%neststruct%ind_update_h(isc_p,j,2)
                     enddo

                     atm(n)%neststruct%isu = isc_p
                     atm(n)%neststruct%ieu = isc_p-1
                     do i=isc_p,iec_p+1
                        if (i < ioffset+upoff) then
                           atm(n)%neststruct%ind_update_h(i,:,1) = -9999
                           atm(n)%neststruct%isu = atm(n)%neststruct%isu + 1
                        elseif (i > ioffset + (npx-1)/refinement - upoff) then
                           atm(n)%neststruct%ind_update_h(i,:,1) = -9999
                        else
                           atm(n)%neststruct%ind_update_h(i,:,1) = (i-ioffset)*refinement + 1
                           if ( (i < ioffset + (npx-1)/refinement - upoff) .and. i <= iec_p) atm(n)%neststruct%ieu = i
                           end if
                        !write(mpp_pe()+5000,*) i, ioffset, upoff, Atm(n)%neststruct%ind_update_h(i,jsc_p,1)
                     enddo

                  end if


               end if

            endif
         endif
      end do
      
    ! Initialize restart functions
      call fv_restart_init()

!     if ( reset_eta ) then
!         do n=1, ntilesMe
!            call set_eta(npz, Atm(n)%ks, ptop, Atm(n)%ak, Atm(n)%bk)
!         enddo
!         if(is_master()) write(*,*) "Hybrid sigma-p coordinate has been reset"
!     endif

      if (ntilesme > 1) call switch_current_atm(atm(1))
      if (ntilesme > 1) call setup_pointers(atm(1))

 end subroutine fv_init
!-------------------------------------------------------------------------------

 subroutine fv_end(Atm, grids_on_this_pe)

    type(fv_atmos_type), intent(inout) :: Atm(:)
    logical, intent(INOUT) :: grids_on_this_pe(:)

    integer :: n

    call timing_off('TOTAL')
    call timing_prt( gid )

    call fv_restart_end(atm, grids_on_this_pe)
    call fv_io_exit()

  ! Free temporary memory from sw_core routines

  ! Deallocate
    call grid_utils_end

    do n = 1, ntilesme
       call deallocate_fv_atmos_type(atm(n))
    end do


 end subroutine fv_end
!-------------------------------------------------------------------------------

 subroutine run_setup(Atm, dt_atmos, grids_on_this_pe, p_split)
   type(fv_atmos_type), intent(inout), target :: Atm(:)
   real, intent(in)                   :: dt_atmos
   logical, intent(INOUT) :: grids_on_this_pe(:)
   integer, intent(INOUT) :: p_split
   !--- local variables ---
   character(len=80) :: tracerName, errString
   character(len=32) :: nested_grid_filename
   integer :: ios, ierr, f_unit, unit
   logical :: exists

   real :: dim0 = 180.
   real :: dt0  = 1800.
   real :: ns0  = 5.
   !real :: umax = 350.          ! max wave speed for grid_type>3 ! Now defined above
   real :: dimx, dl, dp, dxmin, dymin, d_fac

   integer :: n0split
   integer :: n, nn, i

   integer :: pe_counter

!  local version of these variables to allow PGI compiler to compile
   character(len=128) :: res_latlon_dynamics = ''
   character(len=128) :: res_latlon_tracers  = ''
   character(len=80)  :: grid_name = ''
   character(len=120) :: grid_file = ''


   namelist /fv_grid_nml/ grid_name, grid_file
   namelist /fv_core_nml/npx, npy, ntiles, npz, npz_rst, layout, io_layout, ncnst, nwat,  &
                         use_logp, p_fac, a_imp, k_split, n_split, m_split, q_split, print_freq, write_3d_diags, do_schmidt,  &
                         hord_mt, hord_vt, hord_tm, hord_dp, hord_tr, shift_fac, stretch_fac, target_lat, target_lon, &
                         kord_mt, kord_wz, kord_tm, kord_tr, fv_debug, fv_land, nudge, do_sat_adj, do_f3d, &
                         external_ic, read_increment, ncep_ic, nggps_ic, ecmwf_ic, use_new_ncep, use_ncep_phy, fv_diag_ic, &
                         external_eta, res_latlon_dynamics, res_latlon_tracers, scale_z, w_max, z_min, lim_fac, &
                         dddmp, d2_bg, d4_bg, vtdm4, trdm2, d_ext, delt_max, beta, non_ortho, n_sponge, &
                         warm_start, adjust_dry_mass, mountain, d_con, ke_bg, nord, nord_tr, convert_ke, use_old_omega, &
                         dry_mass, grid_type, do_held_suarez, do_reed_physics, reed_cond_only, &
                         consv_te, fill, filter_phys, fill_dp, fill_wz, consv_am, rf_fast, &
                         range_warn, dwind_2d, inline_q, z_tracer, reproduce_sum, adiabatic, do_vort_damp, no_dycore,   &
                         tau, tau_h2o, rf_cutoff, nf_omega, hydrostatic, fv_sg_adj, breed_vortex_inline,  &
                         na_init, nudge_dz, hybrid_z, make_nh, n_zs_filter, nord_zs_filter, full_zs_filter, reset_eta,         &
                         pnats, dnats, a2b_ord, remap_t, p_ref, d2_bg_k1, d2_bg_k2,  &
                         c2l_ord, dx_const, dy_const, umax, deglat,      &
                         deglon_start, deglon_stop, deglat_start, deglat_stop, &
                         phys_hydrostatic, use_hydro_pressure, make_hybrid_z, old_divg_damp, add_noise, &
                         nested, twowaynest, parent_grid_num, parent_tile, nudge_qv, &
                         refinement, nestbctype, nestupdate, nsponge, s_weight, &
                         ioffset, joffset, check_negative, nudge_ic, halo_update_type, gfs_phil, agrid_vel_rst,     &
                         do_uni_zfull, adj_mass_vmr, fac_n_spl, fhouri, regional, bc_update_interval

   namelist /test_case_nml/test_case, bubble_do, alpha, nsolitons, soliton_umax, soliton_size
#ifdef MULTI_GASES
   namelist /multi_gases_nml/ rilist,cpilist
#endif


   pe_counter = mpp_root_pe()

! Make alpha = 0 the default:
   alpha = 0.
   bubble_do = .false.
   test_case = 11   ! (USGS terrain)

#ifdef INTERNAL_FILE_NML
! Read Main namelist
   read (input_nml_file,fv_grid_nml,iostat=ios)
   ierr = check_nml_error(ios,'fv_grid_nml')
#else
   f_unit=open_namelist_file()
   rewind(f_unit)
! Read Main namelist
   read (f_unit,fv_grid_nml,iostat=ios)
   ierr = check_nml_error(ios,'fv_grid_nml')
   call close_file(f_unit)
#endif

   call write_version_number ( 'FV_CONTROL_MOD', version )
   unit = stdlog()
   write(unit, nml=fv_grid_nml)

   do n=1,size(atm)

      call switch_current_atm(atm(n), .false.)
      call setup_pointers(atm(n))
      atm(n)%grid_number = n
      if (grids_on_this_pe(n)) then
         call fv_diag_init_gn(atm(n))
      endif

#ifdef INTERNAL_FILE_NML
   ! Set input_file_nml for correct parent/nest initialization
      if (n > 1) then
         write(nested_grid_filename,'(A4, I2.2)') 'nest', n
         call read_input_nml(nested_grid_filename)
      endif
   ! Read FVCORE namelist 
      read (input_nml_file,fv_core_nml,iostat=ios)
      ierr = check_nml_error(ios,'fv_core_nml')
#ifdef MULTI_GASES
      if( is_master() ) print *,' enter multi_gases: ncnst = ',ncnst
      allocate (rilist(0:ncnst))
      allocate (cpilist(0:ncnst))
      rilist     =    0.0
      cpilist    =    0.0
      rilist(0)  = rdgas
      rilist(1)  = rvgas
      cpilist(0) = cp_air
      cpilist(1) = 4*cp_air
   ! Read multi_gases namelist
      read (input_nml_file,multi_gases_nml,iostat=ios)
      ierr = check_nml_error(ios,'multi_gases_nml')
#endif
   ! Read Test_Case namelist
      read (input_nml_file,test_case_nml,iostat=ios)
      ierr = check_nml_error(ios,'test_case_nml')

   ! Reset input_file_nml to default behavior
      call read_input_nml
#else
      if (size(atm) == 1) then
         f_unit = open_namelist_file()
      else if (n == 1) then
         f_unit = open_namelist_file('input.nml')
      else 
         write(nested_grid_filename,'(A10, I2.2, A4)') 'input_nest', n, '.nml'
         f_unit = open_namelist_file(nested_grid_filename)
      endif

   ! Read FVCORE namelist 
      read (f_unit,fv_core_nml,iostat=ios)
      ierr = check_nml_error(ios,'fv_core_nml')

#ifdef MULTI_GASES
      if( is_master() ) print *,' enter multi_gases: ncnst = ',ncnst
      allocate (rilist(0:ncnst))
      allocate (cpilist(0:ncnst))
      rilist     =    0.0
      cpilist    =    0.0
      rilist(0)  = rdgas
      rilist(1)  = rvgas
      cpilist(0) = cp_air
      cpilist(1) = 4*cp_air
   ! Read multi_gases namelist
      rewind(f_unit)
      read (f_unit,multi_gases_nml,iostat=ios)
      ierr = check_nml_error(ios,'multi_gases_nml')
#endif
   ! Read Test_Case namelist
      rewind(f_unit)
      read (f_unit,test_case_nml,iostat=ios)
      ierr = check_nml_error(ios,'test_case_nml')
      call close_file(f_unit)
#endif         
      write(unit, nml=fv_core_nml)
      write(unit, nml=test_case_nml)
#ifdef MULTI_GASES
      write(unit, nml=multi_gases_nml)
      call multi_gases_init(ncnst,nwat)
#endif

      if (len_trim(grid_file) /= 0) atm(n)%flagstruct%grid_file = grid_file
      if (len_trim(grid_name) /= 0) atm(n)%flagstruct%grid_name = grid_name
      if (len_trim(res_latlon_dynamics) /= 0) atm(n)%flagstruct%res_latlon_dynamics = res_latlon_dynamics
      if (len_trim(res_latlon_tracers)  /= 0) atm(n)%flagstruct%res_latlon_tracers = res_latlon_tracers

      !*** single tile for Cartesian grids
      if (grid_type>3) then
         ntiles=1
         non_ortho = .false.
         nf_omega = 0
      endif

      if (.not. (nested .or. regional)) atm(n)%neststruct%npx_global = npx

      ! Define n_split if not in namelist
      if (ntiles == 6) then
         dimx = 4.0*(npx-1)
         if ( hydrostatic ) then
            if ( npx >= 120 ) ns0 = 6
         else
            if ( npx <= 45 ) then
               ns0 = 6
            elseif ( npx <= 90 ) then
               ns0 = 7
            else
               ns0 = 8
            endif
         endif
      else
         dimx = max( npx, 2*(npy-1) )
      endif
          
      if (grid_type < 4) then
         n0split = nint( ns0*abs(dt_atmos)*dimx/(dt0*dim0) + 0.49 )
      elseif (grid_type == 4 .or. grid_type == 7) then
         n0split = nint( 2.*umax*dt_atmos/sqrt(dx_const**2 + dy_const**2) + 0.49 )
      elseif (grid_type == 5 .or. grid_type == 6) then
         if (grid_type == 6) then
            deglon_start = 0.; deglon_stop  = 360.
         endif
         dl = (deglon_stop-deglon_start)*pi/(180.*(npx-1))
         dp = (deglat_stop-deglat_start)*pi/(180.*(npy-1))

         dxmin=dl*radius*min(cos(deglat_start*pi/180.-ng*dp),   &
                             cos(deglat_stop *pi/180.+ng*dp))
         dymin=dp*radius
         n0split = nint( 2.*umax*dt_atmos/sqrt(dxmin**2 + dymin**2) + 0.49 )
      endif
      n0split = max( 1, n0split )

      if ( n_split == 0 ) then
           n_split = nint( real(n0split)/real(k_split*abs(p_split)) * stretch_fac + 0.5 )
           if(is_master()) write(*,*) 'For k_split (remapping)=', k_split
           if(is_master()) write(*,198) 'n_split is set to ', n_split, ' for resolution-dt=',npx,npy,ntiles,dt_atmos
      else
          if(is_master()) write(*,199) 'Using n_split from the namelist: ', n_split
      endif
      if (is_master() .and. n == 1 .and. abs(p_split) > 1) then
         write(*,199) 'Using p_split = ', p_split
      endif

      if (atm(n)%neststruct%nested) then
         do i=1,n-1
            if (atm(i)%grid_number == parent_grid_num) then
               atm(n)%parent_grid => atm(i)
               exit
            end if
         end do
         if (.not. associated(atm(n)%parent_grid)) then
            write(errstring,'(2(A,I3))')  "Could not find parent grid #", parent_grid_num, ' for grid #', n
            call mpp_error(fatal, errstring)
         end if

         !Note that if a gnomonic grid has a parent it is a NESTED gnomonic grid and therefore only has one tile
         if ( atm(n)%parent_grid%flagstruct%grid_type < 3 .and. &
              .not. associated(atm(n)%parent_grid%parent_grid)) then
            if (parent_tile > 6 .or. parent_tile < 1) then
               call mpp_error(fatal, 'parent tile must be between 1 and 6 if the parent is a cubed-sphere grid')
            end if
         else
            if (parent_tile /= 1) then
               call mpp_error(fatal, 'parent tile must be 1 if the parent is not a cubed-sphere grid')
            end if
         end if

         if ( refinement < 1 ) call mpp_error(fatal, 'grid refinement must be positive')

         if (nestupdate == 1 .or. nestupdate == 2) then

            if (mod(npx-1,refinement) /= 0 .or. mod(npy-1,refinement) /= 0) then
               call mpp_error(warning, 'npx-1 or npy-1 is not evenly divisible by the refinement ratio; averaging update cannot be mass-conservative.')
            end if

         end if

         if ( consv_te > 0.) then
            call mpp_error(fatal, 'The global energy fixer cannot be used on a nested grid. consv_te must be set to 0.')
         end if

         atm(n)%neststruct%refinement_of_global = atm(n)%neststruct%refinement * atm(n)%parent_grid%neststruct%refinement_of_global
         max_refinement_of_global = max(atm(n)%neststruct%refinement_of_global,max_refinement_of_global)
         atm(n)%neststruct%npx_global = atm(n)%neststruct%refinement * atm(n)%parent_grid%neststruct%npx_global

      else
         atm(n)%neststruct%ioffset                = -999
         atm(n)%neststruct%joffset                = -999   
         atm(n)%neststruct%parent_tile            = -1      
         atm(n)%neststruct%refinement             = -1
      end if

      if (atm(n)%neststruct%nested) then
         if (atm(n)%flagstruct%grid_type >= 4 .and. atm(n)%parent_grid%flagstruct%grid_type >= 4) then
            atm(n)%flagstruct%dx_const = atm(n)%parent_grid%flagstruct%dx_const / real(atm(n)%neststruct%refinement)
            atm(n)%flagstruct%dy_const = atm(n)%parent_grid%flagstruct%dy_const / real(atm(n)%neststruct%refinement)
         end if
      end if


!----------------------------------------
! Adjust divergence damping coefficients:
!----------------------------------------
!      d_fac = real(n0split)/real(n_split)
!      dddmp = dddmp * d_fac
!      d2_bg = d2_bg * d_fac
!      d4_bg = d4_bg * d_fac
!      d_ext = d_ext * d_fac
!      vtdm4 = vtdm4 * d_fac
      if (old_divg_damp) then
        if (is_master()) write(*,*) " fv_control: using original values for divergence damping "
        d2_bg_k1 = 6.         ! factor for d2_bg (k=1)  - default(4.)
        d2_bg_k2 = 4.         ! factor for d2_bg (k=2)  - default(2.)
        d2_divg_max_k1 = 0.02 ! d2_divg max value (k=1) - default(0.05)
        d2_divg_max_k2 = 0.01 ! d2_divg max value (k=2) - default(0.02)
        damp_k_k1 = 0.        ! damp_k value (k=1)      - default(0.05)
        damp_k_k2 = 0.        ! damp_k value (k=2)      - default(0.025)
      elseif (n_sponge == 0 ) then
        if ( d2_bg_k1 > 1. ) d2_bg_k1 = 0.20
        if ( d2_bg_k2 > 1. ) d2_bg_k2 = 0.015
      endif

!     if ( beta < 1.e-5 ) beta = 0.   ! beta < 0 is used for non-hydrostatic "one_grad_p"

      if ( .not.hydrostatic ) then
         if ( m_split==0 ) then
            m_split = 1. + abs(dt_atmos)/real(k_split*n_split*abs(p_split))
            if (abs(a_imp) < 0.5) then
               if(is_master()) write(*,199) 'm_split is set to ', m_split
            endif
         endif
         if(is_master()) then
            write(*,*) 'Off center implicit scheme param=', a_imp
            write(*,*) ' p_fac=', p_fac
         endif
      endif

      if(is_master()) then
         if (n_sponge >= 0) write(*,199) 'Using n_sponge : ', n_sponge
         write(*,197) 'Using non_ortho : ', non_ortho
      endif

 197  format(a,l7)
 198  format(a,i2.2,a,i4.4,'x',i4.4,'x',i1.1,'-',f9.3)
 199  format(a,i3.3)

      if (.not. (nested .or. regional)) alpha = alpha*pi


      allocate(atm(n)%neststruct%child_grids(size(atm)))
      atm(n)%neststruct%child_grids = .false.

      !Broadcast data

      !Check layout

   enddo

   !Set pelists
   do n=1,size(atm)
      if (any(atm(n)%pelist == gid)) then
            call mpp_set_current_pelist(atm(n)%pelist)
            call mpp_get_current_pelist(atm(n)%pelist, commid=commid)
            call mp_start(commid,halo_update_type)
      endif

      if (atm(n)%neststruct%nested) then
         atm(n)%neststruct%parent_proc = any(atm(n)%parent_grid%pelist == gid)
         atm(n)%neststruct%child_proc = any(atm(n)%pelist == gid)
      endif
   enddo

   do n=1,size(atm)
      
      call switch_current_atm(atm(n),.false.)
      call setup_pointers(atm(n))
      !! CLEANUP: WARNING not sure what changes to domain_decomp may cause
      call domain_decomp(npx,npy,ntiles,grid_type,nested,atm(n),layout,io_layout)
   enddo

   !!! CLEANUP: This sets the pelist to ALL, which is also
   !!! required for the define_nest_domains step in the next loop.
   !!! Later the pelist must be reset to the 'local' pelist.
   call broadcast_domains(atm)

   do n=1,size(atm)
      call switch_current_atm(atm(n))
      call setup_pointers(atm(n))

      if (nested) then
         if (mod(npx-1 , refinement) /= 0 .or. mod(npy-1, refinement) /= 0) &
              call mpp_error(fatal, 'npx or npy not an even refinement of its coarse grid.')
         
         !Pelist needs to be set to ALL (which should have been done
         !in broadcast_domains) to get this to work
         call mpp_define_nest_domains(atm(n)%neststruct%nest_domain, atm(n)%domain, atm(parent_grid_num)%domain, &
              7, parent_tile, &
              1, npx-1, 1, npy-1,                  & !Grid cells, not points
              ioffset, ioffset + (npx-1)/refinement - 1, &
              joffset, joffset + (npy-1)/refinement - 1,         &
              (/ (i,i=0,mpp_npes()-1)  /), extra_halo = 0, name="nest_domain") !What pelist to use?
         call mpp_define_nest_domains(atm(n)%neststruct%nest_domain, atm(n)%domain, atm(parent_grid_num)%domain, &
              7, parent_tile, &
              1, npx-1, 1, npy-1,                  & !Grid cells, not points
              ioffset, ioffset + (npx-1)/refinement - 1, &
              joffset, joffset + (npy-1)/refinement - 1,         &
              (/ (i,i=0,mpp_npes()-1)  /), extra_halo = 0, name="nest_domain") !What pelist to use?
!              (/ (i,i=0,mpp_npes()-1)  /), extra_halo = 2, name="nest_domain_for_BC") !What pelist to use?

         atm(parent_grid_num)%neststruct%child_grids(n) = .true.

         if (atm(n)%neststruct%nestbctype > 1) then

            call mpp_error(fatal, 'nestbctype > 1 not yet implemented')

            !This check is due to a bug which has not yet been identified. Beware.
!            if (Atm(n)%parent_grid%flagstruct%hord_tr == 7) &
!                 call mpp_error(FATAL, "Flux-form nested  BCs (nestbctype > 1) should not use hord_tr == 7 (on parent grid), since there is no guarantee of tracer mass conservation with this option.")

!!$            if (Atm(n)%flagstruct%q_split > 0 .and. Atm(n)%parent_grid%flagstruct%q_split > 0) then
!!$               if (mod(Atm(n)%flagstruct%q_split,Atm(n)%parent_grid%flagstruct%q_split) /= 0) call mpp_error(FATAL, &
!!$                    "Flux-form nested BCs (nestbctype > 1) require q_split on the nested grid to be evenly divisible by that on the coarse grid.")
!!$            endif
!!$            if (mod((Atm(n)%npx-1),Atm(n)%neststruct%refinement) /= 0 .or. mod((Atm(n)%npy-1),Atm(n)%neststruct%refinement) /= 0) call mpp_error(FATAL, &
!!$                 "Flux-form nested BCs (nestbctype > 1) requires npx and npy to be one more than a multiple of the refinement ratio.")
!!$            Atm(n)%parent_grid%neststruct%do_flux_BCs = .true.
!!$            if (Atm(n)%neststruct%nestbctype == 3 .or. Atm(n)%neststruct%nestbctype == 4) Atm(n)%parent_grid%neststruct%do_2way_flux_BCs = .true.
            atm(n)%neststruct%upoff = 0
         endif

      end if

      do nn=1,size(atm)
         if (n == 1) allocate(atm(nn)%neststruct%nest_domain_all(size(atm)))
         atm(nn)%neststruct%nest_domain_all(n) = atm(n)%neststruct%nest_domain
      enddo

   end do

   do n=1,size(atm)
      if (any(atm(n)%pelist == gid)) then
         call mpp_set_current_pelist(atm(n)%pelist)
      endif
   enddo

  end subroutine run_setup
  subroutine init_nesting(Atm, grids_on_this_pe, p_split)
    
    type(fv_atmos_type), intent(inout), allocatable :: Atm(:)
   logical, allocatable, intent(INOUT) :: grids_on_this_pe(:)
    integer, intent(INOUT) :: p_split
    character(100) :: pe_list_name
    integer :: nest_pes(100)
    integer :: n, npes, ntiles, pecounter, i
    integer, allocatable :: pelist(:)
    integer :: f_unit, ios, ierr

    !This is an OPTIONAL namelist, that needs to be read before everything else
    namelist /nest_nml/ ngrids, ntiles, nest_pes, p_split

    call mp_assign_gid

    nest_pes = 0
    ntiles = -999

#ifdef INTERNAL_FILE_NML
      read (input_nml_file,nest_nml,iostat=ios)
      ierr = check_nml_error(ios,'nest_nml')
#else
      f_unit=open_namelist_file()
      rewind(f_unit)
      read (f_unit,nest_nml,iostat=ios)
      ierr = check_nml_error(ios,'nest_nml')
      call close_file(f_unit)
#endif

      if (ntiles /= -999) ngrids = ntiles
      if (ngrids > 10) call mpp_error(fatal, "More than 10 nested grids not supported")

      allocate(atm(ngrids))
    
      allocate(grids_on_this_pe(ngrids))
      grids_on_this_pe = .false. !initialization

      npes = mpp_npes()

      ! Need to get a global pelist to send data around later?
      allocate( pelist_all(npes) )
      pelist_all = (/ (i,i=0,npes-1) /)
      pelist_all = pelist_all + mpp_root_pe()

      if (ngrids == 1) then

         !Set up the single pelist
         allocate(atm(1)%pelist(npes))
         atm(1)%pelist = (/(i, i=0, npes-1)/)
         atm(1)%pelist = atm(1)%pelist + mpp_root_pe()
         call mpp_declare_pelist(atm(1)%pelist)
         call mpp_set_current_pelist(atm(1)%pelist)
         !Now set in domain_decomp
         !masterproc = Atm(1)%pelist(1)
         call setup_master(atm(1)%pelist)
         grids_on_this_pe(1) = .true.
         atm(1)%npes_this_grid = npes

      else

         pecounter = mpp_root_pe()
         do n=1,ngrids
            if (n == 1) then
               pe_list_name = ''
            else
               write(pe_list_name,'(A4, I2.2)') 'nest', n
            endif

            if (nest_pes(n) == 0) then
               if (n < ngrids) call mpp_error(fatal, 'Only nest_pes(ngrids) in nest_nml can be zero; preceeding values must be nonzero.')
               allocate(atm(n)%pelist(npes-pecounter))
               atm(n)%pelist = (/(i, i=pecounter, npes-1)/)
               if (n > 1) then
                  call mpp_declare_pelist(atm(n)%pelist, trim(pe_list_name))
                  !Make sure nested-grid input file exists
                  if (.not. file_exist('input_'//trim(pe_list_name)//'.nml')) then
                     call mpp_error(fatal, "Could not find nested grid namelist input_"//trim(pe_list_name)//".nml")
                  endif
               endif
               exit
            else
               allocate(atm(n)%pelist(nest_pes(n)))
               atm(n)%pelist = (/ (i, i=pecounter, pecounter+nest_pes(n)-1) /)
               if (atm(n)%pelist(nest_pes(n)) >= npes) then
                  call mpp_error(fatal, 'PEs assigned by nest_pes in nest_nml exceeds number of available PEs.')
               endif

               call mpp_declare_pelist(atm(n)%pelist, trim(pe_list_name))
               !Make sure nested-grid input file exists
               if (n > 1) then
                  if (.not. file_exist('input_'//trim(pe_list_name)//'.nml')) then
                     call mpp_error(fatal, "Could not find nested grid namelist input_"//trim(pe_list_name)//".nml")
                  endif
               endif
               pecounter = pecounter+nest_pes(n)
            endif
         enddo

         !Set pelists
         do n=1,ngrids
            atm(n)%npes_this_grid = size(atm(n)%pelist)
            if (any(gid == atm(n)%pelist)) then
                  call mpp_set_current_pelist(atm(n)%pelist)
                  !now set in domain_decomp
                  !masterproc = Atm(n)%pelist(1)
                  call setup_master(atm(n)%pelist)
                  grids_on_this_pe(n) = .true.
                  exit
               endif
         enddo

         if (pecounter /= npes) then
            call mpp_error(fatal, 'nest_pes in nest_nml does not assign all of the available PEs.')
         endif
      endif

      !Layout is checked later, in fv_control

  end subroutine init_nesting

  subroutine setup_pointers(Atm)

    type(fv_atmos_type), intent(INOUT), target :: Atm

    !This routine associates the MODULE flag pointers with the ARRAY flag variables for the grid active on THIS pe so the flags can be read in from the namelist.

     res_latlon_dynamics           => atm%flagstruct%res_latlon_dynamics
     res_latlon_tracers            => atm%flagstruct%res_latlon_tracers

     grid_type                     => atm%flagstruct%grid_type
     grid_name                     => atm%flagstruct%grid_name
     grid_file                     => atm%flagstruct%grid_file
     hord_mt                       => atm%flagstruct%hord_mt
     kord_mt                       => atm%flagstruct%kord_mt
     kord_wz                       => atm%flagstruct%kord_wz
     hord_vt                       => atm%flagstruct%hord_vt
     hord_tm                       => atm%flagstruct%hord_tm
     hord_dp                       => atm%flagstruct%hord_dp
     kord_tm                       => atm%flagstruct%kord_tm
     hord_tr                       => atm%flagstruct%hord_tr
     kord_tr                       => atm%flagstruct%kord_tr
     scale_z                       => atm%flagstruct%scale_z
     w_max                         => atm%flagstruct%w_max
     z_min                         => atm%flagstruct%z_min
     lim_fac                       => atm%flagstruct%lim_fac
     nord                          => atm%flagstruct%nord
     nord_tr                       => atm%flagstruct%nord_tr
     dddmp                         => atm%flagstruct%dddmp
     d2_bg                         => atm%flagstruct%d2_bg
     d4_bg                         => atm%flagstruct%d4_bg
     vtdm4                         => atm%flagstruct%vtdm4
     trdm2                         => atm%flagstruct%trdm2
     d2_bg_k1                      => atm%flagstruct%d2_bg_k1
     d2_bg_k2                      => atm%flagstruct%d2_bg_k2
     d2_divg_max_k1                => atm%flagstruct%d2_divg_max_k1
     d2_divg_max_k2                => atm%flagstruct%d2_divg_max_k2
     damp_k_k1                     => atm%flagstruct%damp_k_k1
     damp_k_k2                     => atm%flagstruct%damp_k_k2
     n_zs_filter                   => atm%flagstruct%n_zs_filter
     nord_zs_filter                => atm%flagstruct%nord_zs_filter
     full_zs_filter                => atm%flagstruct%full_zs_filter
     rf_fast                       => atm%flagstruct%RF_fast
     consv_am                      => atm%flagstruct%consv_am
     do_sat_adj                    => atm%flagstruct%do_sat_adj
     do_f3d                        => atm%flagstruct%do_f3d
     no_dycore                     => atm%flagstruct%no_dycore
     convert_ke                    => atm%flagstruct%convert_ke
     do_vort_damp                  => atm%flagstruct%do_vort_damp
     use_old_omega                 => atm%flagstruct%use_old_omega
     beta                          => atm%flagstruct%beta
     n_sponge                      => atm%flagstruct%n_sponge
     d_ext                         => atm%flagstruct%d_ext
     nwat                          => atm%flagstruct%nwat
     use_logp                      => atm%flagstruct%use_logp
     warm_start                    => atm%flagstruct%warm_start
     inline_q                      => atm%flagstruct%inline_q
     shift_fac                     => atm%flagstruct%shift_fac
     do_schmidt                    => atm%flagstruct%do_schmidt
     stretch_fac                   => atm%flagstruct%stretch_fac
     target_lat                    => atm%flagstruct%target_lat
     target_lon                    => atm%flagstruct%target_lon
     regional                      => atm%flagstruct%regional
     bc_update_interval            => atm%flagstruct%bc_update_interval 
     reset_eta                     => atm%flagstruct%reset_eta
     p_fac                         => atm%flagstruct%p_fac
     a_imp                         => atm%flagstruct%a_imp
     n_split                       => atm%flagstruct%n_split
     fac_n_spl                     => atm%flagstruct%fac_n_spl
     fhouri                        => atm%flagstruct%fhouri
     m_split                       => atm%flagstruct%m_split
     k_split                       => atm%flagstruct%k_split
     use_logp                      => atm%flagstruct%use_logp
     q_split                       => atm%flagstruct%q_split
     print_freq                    => atm%flagstruct%print_freq
     write_3d_diags                => atm%flagstruct%write_3d_diags
     npx                           => atm%flagstruct%npx
     npy                           => atm%flagstruct%npy
     npz                           => atm%flagstruct%npz
     npz_rst                       => atm%flagstruct%npz_rst
     ncnst                         => atm%flagstruct%ncnst
     pnats                         => atm%flagstruct%pnats
     dnats                         => atm%flagstruct%dnats
     ntiles                        => atm%flagstruct%ntiles
     nf_omega                      => atm%flagstruct%nf_omega
     fv_sg_adj                     => atm%flagstruct%fv_sg_adj
     na_init                       => atm%flagstruct%na_init
     nudge_dz                      => atm%flagstruct%nudge_dz
     p_ref                         => atm%flagstruct%p_ref
     dry_mass                      => atm%flagstruct%dry_mass
     nt_prog                       => atm%flagstruct%nt_prog
     nt_phys                       => atm%flagstruct%nt_phys
     tau_h2o                       => atm%flagstruct%tau_h2o
     delt_max                      => atm%flagstruct%delt_max
     d_con                         => atm%flagstruct%d_con
     ke_bg                         => atm%flagstruct%ke_bg
     consv_te                      => atm%flagstruct%consv_te
     tau                           => atm%flagstruct%tau
     rf_cutoff                     => atm%flagstruct%rf_cutoff
     filter_phys                   => atm%flagstruct%filter_phys
     dwind_2d                      => atm%flagstruct%dwind_2d
     breed_vortex_inline           => atm%flagstruct%breed_vortex_inline
     range_warn                    => atm%flagstruct%range_warn
     fill                          => atm%flagstruct%fill
     fill_dp                       => atm%flagstruct%fill_dp
     fill_wz                       => atm%flagstruct%fill_wz
     check_negative                => atm%flagstruct%check_negative
     non_ortho                     => atm%flagstruct%non_ortho
     adiabatic                     => atm%flagstruct%adiabatic
     moist_phys                    => atm%flagstruct%moist_phys
     do_held_suarez                => atm%flagstruct%do_Held_Suarez
     do_reed_physics               => atm%flagstruct%do_reed_physics
     reed_cond_only                => atm%flagstruct%reed_cond_only
     reproduce_sum                 => atm%flagstruct%reproduce_sum
     adjust_dry_mass               => atm%flagstruct%adjust_dry_mass
     fv_debug                      => atm%flagstruct%fv_debug
     srf_init                      => atm%flagstruct%srf_init
     mountain                      => atm%flagstruct%mountain
     remap_t                       => atm%flagstruct%remap_t
     z_tracer                      => atm%flagstruct%z_tracer
     old_divg_damp                 => atm%flagstruct%old_divg_damp
     fv_land                       => atm%flagstruct%fv_land
     nudge                         => atm%flagstruct%nudge
     nudge_ic                      => atm%flagstruct%nudge_ic
     ncep_ic                       => atm%flagstruct%ncep_ic
     nggps_ic                      => atm%flagstruct%nggps_ic
     ecmwf_ic                      => atm%flagstruct%ecmwf_ic
     gfs_phil                      => atm%flagstruct%gfs_phil
     agrid_vel_rst                 => atm%flagstruct%agrid_vel_rst
     use_new_ncep                  => atm%flagstruct%use_new_ncep
     use_ncep_phy                  => atm%flagstruct%use_ncep_phy
     fv_diag_ic                    => atm%flagstruct%fv_diag_ic
     external_ic                   => atm%flagstruct%external_ic
     external_eta                  => atm%flagstruct%external_eta
     read_increment                => atm%flagstruct%read_increment

     hydrostatic                   => atm%flagstruct%hydrostatic
     phys_hydrostatic              => atm%flagstruct%phys_hydrostatic
     use_hydro_pressure            => atm%flagstruct%use_hydro_pressure
     do_uni_zfull                  => atm%flagstruct%do_uni_zfull !miz
     adj_mass_vmr                  => atm%flagstruct%adj_mass_vmr !f1p
     hybrid_z                      => atm%flagstruct%hybrid_z
     make_nh                       => atm%flagstruct%Make_NH
     make_hybrid_z                 => atm%flagstruct%make_hybrid_z
     nudge_qv                      => atm%flagstruct%nudge_qv
     add_noise                     => atm%flagstruct%add_noise
     a2b_ord                       => atm%flagstruct%a2b_ord
     c2l_ord                       => atm%flagstruct%c2l_ord
     ndims                         => atm%flagstruct%ndims
    
     dx_const                      => atm%flagstruct%dx_const
     dy_const                      => atm%flagstruct%dy_const
     deglon_start                  => atm%flagstruct%deglon_start
     deglon_stop                   => atm%flagstruct%deglon_stop
     deglat_start                  => atm%flagstruct%deglat_start
     deglat_stop                   => atm%flagstruct%deglat_stop

     deglat                        => atm%flagstruct%deglat

     nested                        => atm%neststruct%nested
     twowaynest                    => atm%neststruct%twowaynest
     parent_tile                   => atm%neststruct%parent_tile
     refinement                    => atm%neststruct%refinement
     nestbctype                    => atm%neststruct%nestbctype
     nestupdate                    => atm%neststruct%nestupdate
     nsponge                       => atm%neststruct%nsponge
     s_weight                      => atm%neststruct%s_weight
     ioffset                       => atm%neststruct%ioffset
     joffset                       => atm%neststruct%joffset

     layout                        => atm%layout
     io_layout                     => atm%io_layout
  end subroutine setup_pointers

       
end module fv_control_mod