FV3 Bundle
fv_control_nlm.F90
Go to the documentation of this file.
1 !***********************************************************************
2 !* GNU General Public License *
3 !* This file is a part of fvGFS. *
4 !* *
5 !* fvGFS is free software; you can redistribute it and/or modify it *
6 !* and are expected to follow the terms of the GNU General Public *
7 !* License as published by the Free Software Foundation; either *
8 !* version 2 of the License, or (at your option) any later version. *
9 !* *
10 !* fvGFS is distributed in the hope that it will be useful, but *
11 !* WITHOUT ANY WARRANTY; without even the implied warranty of *
12 !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
13 !* General Public License for more details. *
14 !* *
15 !* For the full text of the GNU General Public License, *
16 !* write to: Free Software Foundation, Inc., *
17 !* 675 Mass Ave, Cambridge, MA 02139, USA. *
18 !* or see: http://www.gnu.org/licenses/gpl.html *
19 !***********************************************************************
20 !
21 !----------------
22 ! FV contro panel
23 !----------------
24 
26 
27  use constants_mod, only: pi=>pi_8, kappa, radius, grav, rdgas
29  use fms_mod, only: write_version_number, open_namelist_file, &
30  check_nml_error, close_file, file_exist
31  use mpp_mod, only: fatal, mpp_error, mpp_pe, stdlog, &
32  mpp_npes, mpp_get_current_pelist, &
33  input_nml_file, get_unit, warning, &
34  read_ascii_file, input_str_length
36  use tracer_manager_mod, only: tm_get_number_tracers => get_number_tracers, &
37  tm_get_tracer_index => get_tracer_index, &
38  tm_get_tracer_indices => get_tracer_indices, &
39  tm_set_tracer_profile => set_tracer_profile, &
40  tm_get_tracer_names => get_tracer_names, &
41  tm_check_if_prognostic=> check_if_prognostic,&
42  tm_register_tracers => register_tracers
43 
44  use fv_io_nlm_mod, only: fv_io_exit
47  r_grid
49  use fv_eta_nlm_mod, only: set_eta
51  use fv_mp_nlm_mod, only: mp_start, mp_assign_gid, domain_decomp
52  use fv_mp_nlm_mod, only: ng, switch_current_atm
53  use fv_mp_nlm_mod, only: broadcast_domains, mp_barrier, is_master, setup_master
54 !!! CLEANUP: should be replaced by a getter function?
57  use mpp_domains_mod, only: domain2d
58  use mpp_domains_mod, only: mpp_define_nest_domains, nest_domain_type, mpp_get_global_domain
59  use mpp_domains_mod, only: mpp_get_c2f_index, mpp_get_f2c_index, mpp_broadcast_domain
60  use mpp_domains_mod, only: center, corner, north, east, west, south
61  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
63 
64  implicit none
65  private
66 
67 !-----------------------------------------------------------------------
68 ! Grid descriptor file setup
69 !-----------------------------------------------------------------------
70 !------------------------------------------
71 ! Model Domain parameters
72 ! See fv_arrays_nlm.F90 for descriptions
73 !------------------------------------------
74 !CLEANUP module pointers
75  character(len=80) , pointer :: grid_name
76  character(len=120), pointer :: grid_file
77  integer, pointer :: grid_type
78  integer , pointer :: hord_mt
79  integer , pointer :: kord_mt
80  integer , pointer :: kord_wz
81  integer , pointer :: hord_vt
82  integer , pointer :: hord_tm
83  integer , pointer :: hord_dp
84  integer , pointer :: kord_tm
85  integer , pointer :: hord_tr
86  integer , pointer :: kord_tr
87  real , pointer :: scale_z
88  real , pointer :: w_max
89  real , pointer :: z_min
90 
91  integer , pointer :: nord
92  integer , pointer :: nord_tr
93  real , pointer :: dddmp
94  real , pointer :: d2_bg
95  real , pointer :: d4_bg
96  real , pointer :: vtdm4
97  real , pointer :: trdm2
98  real , pointer :: d2_bg_k1
99  real , pointer :: d2_bg_k2
100  real , pointer :: d2_divg_max_k1
101  real , pointer :: d2_divg_max_k2
102  real , pointer :: damp_k_k1
103  real , pointer :: damp_k_k2
104  integer , pointer :: n_zs_filter
105  integer , pointer :: nord_zs_filter
106  logical , pointer :: full_zs_filter
107 
108  logical , pointer :: consv_am
109  logical , pointer :: do_sat_adj
110  logical , pointer :: do_f3d
111  logical , pointer :: no_dycore
112  logical , pointer :: convert_ke
113  logical , pointer :: do_vort_damp
114  logical , pointer :: use_old_omega
115 ! PG off centering:
116  real , pointer :: beta
117  integer , pointer :: n_zfilter
118  integer , pointer :: n_sponge
119  real , pointer :: d_ext
120  integer , pointer :: nwat
121  logical , pointer :: warm_start
122  logical , pointer :: inline_q
123  real , pointer :: shift_fac
124  logical , pointer :: do_schmidt
125  real(kind=R_GRID) , pointer :: stretch_fac
126  real(kind=R_GRID) , pointer :: target_lat
127  real(kind=R_GRID) , pointer :: target_lon
128 
129  logical , pointer :: reset_eta
130  real , pointer :: p_fac
131  real , pointer :: a_imp
132  integer , pointer :: n_split
133  ! Default
134  integer , pointer :: m_split
135  integer , pointer :: k_split
136  logical , pointer :: use_logp
137 
138  integer , pointer :: q_split
139  integer , pointer :: print_freq
140 
141  integer , pointer :: npx
142  integer , pointer :: npy
143  integer , pointer :: npz
144  integer , pointer :: npz_rst
145 
146  integer , pointer :: ncnst
147  integer , pointer :: pnats
148  integer , pointer :: dnats
149  integer , pointer :: ntiles
150  integer , pointer :: nf_omega
151  integer , pointer :: fv_sg_adj
152 
153  integer , pointer :: na_init
154  real , pointer :: p_ref
155  real , pointer :: dry_mass
156  integer , pointer :: nt_prog
157  integer , pointer :: nt_phys
158  real , pointer :: tau_h2o
159 
160  real , pointer :: delt_max
161  real , pointer :: d_con
162  real , pointer :: ke_bg
163  real , pointer :: consv_te
164  real , pointer :: tau
165  real , pointer :: rf_cutoff
166  logical , pointer :: filter_phys
167  logical , pointer :: dwind_2d
168  logical , pointer :: breed_vortex_inline
169  logical , pointer :: range_warn
170  logical , pointer :: fill
171  logical , pointer :: fill_dp
172  logical , pointer :: fill_wz
173  logical , pointer :: check_negative
174  logical , pointer :: non_ortho
175  logical , pointer :: adiabatic
176  logical , pointer :: moist_phys
177  logical , pointer :: do_held_suarez
178  logical , pointer :: do_reed_physics
179  logical , pointer :: reed_cond_only
180  logical , pointer :: reproduce_sum
181  logical , pointer :: adjust_dry_mass
182  logical , pointer :: fv_debug
183  logical , pointer :: srf_init
184  logical , pointer :: mountain
185  integer , pointer :: remap_option
186  logical , pointer :: z_tracer
187 
188  logical , pointer :: old_divg_damp
189  logical , pointer :: fv_land
190  logical , pointer :: nudge
191  logical , pointer :: nudge_ic
192  logical , pointer :: ncep_ic
193  logical , pointer :: nggps_ic
194  logical , pointer :: ecmwf_ic
195  logical , pointer :: gfs_phil
196  logical , pointer :: agrid_vel_rst
197  logical , pointer :: use_new_ncep
198  logical , pointer :: use_ncep_phy
199  logical , pointer :: fv_diag_ic
200  logical , pointer :: external_ic
201  character(len=128) , pointer :: res_latlon_dynamics
202  character(len=128) , pointer :: res_latlon_tracers
203  logical , pointer :: hydrostatic
204  logical , pointer :: phys_hydrostatic
205  logical , pointer :: use_hydro_pressure
206  logical , pointer :: do_uni_zfull !miz
207  logical , pointer :: adj_mass_vmr ! f1p
208  logical , pointer :: hybrid_z
209  logical , pointer :: make_nh
210  logical , pointer :: make_hybrid_z
211  logical , pointer :: nudge_qv
212  real, pointer :: add_noise
213 
214  integer , pointer :: a2b_ord
215  integer , pointer :: c2l_ord
216 
217  integer, pointer :: ndims
218 
219  real(kind=R_GRID), pointer :: dx_const
220  real(kind=R_GRID), pointer :: dy_const
221  real(kind=R_GRID), pointer :: deglon_start, deglon_stop, & ! boundaries of latlon patch
223  real(kind=R_GRID), pointer :: deglat
224 
225  logical, pointer :: nested, twowaynest
227  real, pointer :: s_weight
228 
229  integer, pointer :: layout(:), io_layout(:)
230 
231  integer :: ntilesme ! Number of tiles on this process =1 for now
232 
233 #ifdef OVERLOAD_R4
234  real :: too_big = 1.e8
235 #else
236  real :: too_big = 1.e35
237 #endif
238  public :: fv_init, fv_end
239 
240  integer, public :: ngrids = 1
241  integer, public, allocatable :: pelist_all(:)
243  integer :: gid
244 
245 #ifdef MAPL_MODE
246  real :: dyn_timer, comm_timer
247  public :: dyn_timer, comm_timer
248 #endif
249 
250  real :: umax = 350. ! max wave speed for grid_type>3
251  integer :: parent_grid_num = -1
252 
253  integer :: halo_update_type = 1 ! 1 for two-interfaces non-block
254  ! 2 for block
255  ! 3 for four-interfaces non-block
256 
257  contains
258 
259 !-------------------------------------------------------------------------------
260  subroutine fv_init(Atm, dt_atmos, grids_on_this_pe, p_split)
262  type(fv_atmos_type), allocatable, intent(inout), target :: atm(:)
263  real, intent(in) :: dt_atmos
264  logical, allocatable, intent(INOUT) :: grids_on_this_pe(:)
265  integer, intent(INOUT) :: p_split
266 
267  integer :: i, j, k, n, p
268  real :: sdt
269 
270 ! tracers
271  integer :: num_family ! output of register_tracers
272 
273  integer :: isc_p, iec_p, jsc_p, jec_p, isg, ieg, jsg, jeg, upoff, jind
274  integer :: ic, jc
275 
276  gid = mpp_pe()
277 
278  call init_nesting(atm, grids_on_this_pe, p_split)
279 
280  !This call is needed to set up the pointers for fv_current_grid, even for a single-grid run
281  !call switch_current_Atm(Atm(1), .false.)
282  call setup_pointers(atm(1))
283 
284 ! Start up MPI
285 
286  !call mp_assign_gid
287 
288  ! Initialize timing routines
289  call timing_init
290  call timing_on('TOTAL')
291 
292  ! Setup the run from namelist
293  ntilesme = size(atm(:)) !Full number of Atm arrays; one less than number of grids, if multiple grids
294 
295  call run_setup(atm,dt_atmos, grids_on_this_pe, p_split) ! initializes domain_decomp
296 
297  do n=1,ntilesme
298 
299  !In a single-grid run this will still be needed to correctly set the domain
300  call switch_current_atm(atm(n))
301  call setup_pointers(atm(n))
302 
303  target_lon = target_lon * pi/180.
304  target_lat = target_lat * pi/180.
305 
306 !--------------------------------------------------
307 ! override number of tracers by reading field_table
308 !--------------------------------------------------
309 
310  !not sure if this works with multiple grids
311  call tm_register_tracers (model_atmos, ncnst, nt_prog, pnats, num_family)
312  if(is_master()) then
313  write(*,*) 'ncnst=', ncnst,' num_prog=',nt_prog,' pnats=',pnats,' dnats=',dnats,' num_family=',num_family
314  print*, ''
315  endif
316 
317  if (grids_on_this_pe(n)) then
318  call allocate_fv_atmos_type(atm(n), atm(n)%bd%isd, atm(n)%bd%ied, atm(n)%bd%jsd, atm(n)%bd%jed, &
319  atm(n)%bd%isc, atm(n)%bd%iec, atm(n)%bd%jsc, atm(n)%bd%jec, &
320  npx, npy, npz, ndims, ncnst, ncnst-pnats, ng, .false., grids_on_this_pe(n), ngrids)
321 
322  if (grids_on_this_pe(n)) then
323 
324  call switch_current_atm(atm(n))
325  call setup_pointers(atm(n))
326 
327  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
328  if (is_master()) write(*,'(6I6)') atm(n)%bd%isc, atm(n)%bd%iec, atm(n)%bd%jsc, atm(n)%bd%jec, n
329  call mpp_error(fatal,'Domain Decomposition: Cubed Sphere compute domain has a &
330  &minium requirement of 4 points in X and Y, respectively')
331  end if
332 
333  endif
334 
335  !!CLEANUP: Convenience pointers
336  atm(n)%gridstruct%nested => atm(n)%neststruct%nested
337  atm(n)%gridstruct%grid_type => atm(n)%flagstruct%grid_type
338  atm(n)%flagstruct%grid_number => atm(n)%grid_number
339 
340 
341  atm(n)%gridstruct%sw_corner = .false.
342  atm(n)%gridstruct%se_corner = .false.
343  atm(n)%gridstruct%ne_corner = .false.
344  atm(n)%gridstruct%nw_corner = .false.
345 
346  if (atm(n)%gridstruct%grid_type < 3 .and. .not. atm(n)%neststruct%nested) then
347  if ( atm(n)%bd%is ==1 .and. atm(n)%bd%js ==1 ) atm(n)%gridstruct%sw_corner = .true.
348  if ( (atm(n)%bd%ie+1)==npx .and. atm(n)%bd%js ==1 ) atm(n)%gridstruct%se_corner = .true.
349  if ( (atm(n)%bd%ie+1)==npx .and. (atm(n)%bd%je+1)==npy ) atm(n)%gridstruct%ne_corner = .true.
350  if ( atm(n)%bd%is ==1 .and. (atm(n)%bd%je+1)==npy ) atm(n)%gridstruct%nw_corner = .true.
351  endif
352 
353  call init_grid(atm(n), grid_name, grid_file, npx, npy, npz, ndims, ntiles, ng)
354 
355  ! Initialize the SW (2D) part of the model
356  !!!CLEANUP: this call could definitely use some cleaning up
358 
359  !!!CLEANUP: Are these correctly writing out on all pes?
360  if ( is_master() ) then
361  sdt = dt_atmos/real(n_split*k_split*abs(p_split))
362  write(*,*) ' '
363  write(*,*) 'Divergence damping Coefficients'
364  write(*,*) 'For small dt=', sdt
365  write(*,*) 'External mode del-2 (m**2/s)=', d_ext*atm(n)%gridstruct%da_min_c/sdt
366  write(*,*) 'Internal mode del-2 SMAG dimensionless coeff=', dddmp
367  write(*,*) 'Internal mode del-2 background diff=', d2_bg*atm(n)%gridstruct%da_min_c/sdt
368 
369  if (nord==1) then
370  write(*,*) 'Internal mode del-4 background diff=', d4_bg
371  write(*,*) 'Vorticity del-4 (m**4/s)=', (vtdm4*atm(n)%gridstruct%da_min)**2/sdt*1.e-6
372  endif
373  if (nord==2) write(*,*) 'Internal mode del-6 background diff=', d4_bg
374  if (nord==3) write(*,*) 'Internal mode del-8 background diff=', d4_bg
375  write(*,*) 'tracer del-2 diff=', trdm2
376 
377  write(*,*) 'Vorticity del-4 (m**4/s)=', (vtdm4*atm(n)%gridstruct%da_min)**2/sdt*1.e-6
378  write(*,*) 'beta=', beta
379  write(*,*) ' '
380  endif
381 
382 
383  atm(n)%ts = 300.
384  atm(n)%phis = too_big
385  ! The following statements are to prevent the phatom corner regions from
386  ! growing instability
387  atm(n)%u = 0.
388  atm(n)%v = 0.
389  atm(n)%ua = too_big
390  atm(n)%va = too_big
391 
392  else !this grid is NOT defined on this pe
393 
394  !Allocate dummy arrays
395  call allocate_fv_atmos_type(atm(n), atm(n)%bd%isd, atm(n)%bd%ied, atm(n)%bd%jsd, atm(n)%bd%jed, &
396  atm(n)%bd%isc, atm(n)%bd%iec, atm(n)%bd%jsc, atm(n)%bd%jec, &
397  npx, npy, npz, ndims, ncnst, ncnst-pnats, ng, .true., .false., ngrids)
398 
399  !Need to SEND grid_global to any child grids; this is received in setup_aligned_nest in fv_grid_tools
400  if (atm(n)%neststruct%nested) then
401 
402  call mpp_get_global_domain( atm(n)%parent_grid%domain, &
403  isg, ieg, jsg, jeg)
404 
405  !FIXME: Should replace this by generating the global grid (or at least one face thereof) on the
406  ! nested PEs instead of sending it around.
407  if (gid == atm(n)%parent_grid%pelist(1)) then
408  call mpp_send(atm(n)%parent_grid%grid_global(isg-ng:ieg+1+ng,jsg-ng:jeg+1+ng,1:2,parent_tile), &
409  size(atm(n)%parent_grid%grid_global(isg-ng:ieg+1+ng,jsg-ng:jeg+1+ng,1:2,parent_tile)), &
410  atm(n)%pelist(1)) !send to p_ind in setup_aligned_nest
411  call mpp_sync_self()
412  endif
413 
414  if (atm(n)%neststruct%twowaynest) then
415 
416  !This in reality should be very simple. With the
417  ! restriction that only the compute domain data is
418  ! sent from the coarse grid, we can compute
419  ! exactly which coarse grid cells should use
420  ! which nested-grid data. We then don't need to send around p_ind.
421 
422  atm(n)%neststruct%ind_update_h = -99999
423 
424  if (atm(n)%parent_grid%tile == atm(n)%neststruct%parent_tile) then
425 
426  isc_p = atm(n)%parent_grid%bd%isc
427  iec_p = atm(n)%parent_grid%bd%iec
428  jsc_p = atm(n)%parent_grid%bd%jsc
429  jec_p = atm(n)%parent_grid%bd%jec
430  upoff = atm(n)%neststruct%upoff
431 
432  atm(n)%neststruct%jsu = jsc_p
433  atm(n)%neststruct%jeu = jsc_p-1
434  do j=jsc_p,jec_p+1
435  if (j < joffset+upoff) then
436  do i=isc_p,iec_p+1
437  atm(n)%neststruct%ind_update_h(i,j,2) = -9999
438  enddo
439  atm(n)%neststruct%jsu = atm(n)%neststruct%jsu + 1
440  elseif (j > joffset + (npy-1)/refinement - upoff) then
441  do i=isc_p,iec_p+1
442  atm(n)%neststruct%ind_update_h(i,j,2) = -9999
443  enddo
444  else
445  jind = (j - joffset)*refinement + 1
446  do i=isc_p,iec_p+1
447  atm(n)%neststruct%ind_update_h(i,j,2) = jind
448  enddo
449  if ( (j < joffset + (npy-1)/refinement - upoff) .and. j <= jec_p) atm(n)%neststruct%jeu = j
450  endif
451  !write(mpp_pe()+4000,*) j, joffset, upoff, Atm(n)%neststruct%ind_update_h(isc_p,j,2)
452  enddo
453 
454  atm(n)%neststruct%isu = isc_p
455  atm(n)%neststruct%ieu = isc_p-1
456  do i=isc_p,iec_p+1
457  if (i < ioffset+upoff) then
458  atm(n)%neststruct%ind_update_h(i,:,1) = -9999
459  atm(n)%neststruct%isu = atm(n)%neststruct%isu + 1
460  elseif (i > ioffset + (npx-1)/refinement - upoff) then
461  atm(n)%neststruct%ind_update_h(i,:,1) = -9999
462  else
463  atm(n)%neststruct%ind_update_h(i,:,1) = (i-ioffset)*refinement + 1
464  if ( (i < ioffset + (npx-1)/refinement - upoff) .and. i <= iec_p) atm(n)%neststruct%ieu = i
465  end if
466  !write(mpp_pe()+5000,*) i, ioffset, upoff, Atm(n)%neststruct%ind_update_h(i,jsc_p,1)
467  enddo
468 
469  end if
470 
471 
472  end if
473 
474  endif
475  endif
476  end do
477 
478  ! Initialize restart functions
479  call fv_restart_init()
480 
481 ! if ( reset_eta ) then
482 ! do n=1, ntilesMe
483 ! call set_eta(npz, Atm(n)%ks, ptop, Atm(n)%ak, Atm(n)%bk)
484 ! enddo
485 ! if(is_master()) write(*,*) "Hybrid sigma-p coordinate has been reset"
486 ! endif
487 
488  if (ntilesme > 1) call switch_current_atm(atm(1))
489  if (ntilesme > 1) call setup_pointers(atm(1))
490 
491  end subroutine fv_init
492 !-------------------------------------------------------------------------------
493 
494 !-------------------------------------------------------------------------------
495 
496  subroutine fv_end(Atm, grids_on_this_pe, restarts)
498  type(fv_atmos_type), intent(inout) :: atm(:)
499  logical, intent(INOUT) :: grids_on_this_pe(:)
500  logical, intent(IN) :: restarts
501 
502  integer :: n
503 
504  call timing_off('TOTAL')
505  call timing_prt( gid )
506 
507  if (restarts) call fv_restart_end(atm, grids_on_this_pe)
508  call fv_io_exit()
509 
510  ! Free temporary memory from sw_core routines
511 
512  ! Deallocate
513  call grid_utils_end
514 
515  do n = 1, ntilesme
516  call deallocate_fv_atmos_type(atm(n))
517  end do
518 
519 
520  end subroutine fv_end
521 !-------------------------------------------------------------------------------
522 
523 !-------------------------------------------------------------------------------
524 !
525 ! run_setup :: initialize run from namelist
526 !
527  subroutine run_setup(Atm, dt_atmos, grids_on_this_pe, p_split)
528  type(fv_atmos_type), intent(inout), target :: Atm(:)
529  real, intent(in) :: dt_atmos
530  logical, intent(INOUT) :: grids_on_this_pe(:)
531  integer, intent(INOUT) :: p_split
532 
533  character(len=80) :: filename, tracerName, errString, nested_grid_filename
534  integer :: ios, ierr, f_unit, unit
535  logical :: exists
536 
537  real :: dim0 = 180. ! base dimension
538  real :: dt0 = 1800. ! base time step
539  real :: ns0 = 5. ! base nsplit for base dimension
540  ! For cubed sphere 5 is better
541  !real :: umax = 350. ! max wave speed for grid_type>3 ! Now defined above
542  real :: dimx, dl, dp, dxmin, dymin, d_fac
543 
544  integer :: n0split
545  integer :: n, nn, i
546 
547  integer :: pe_counter
548 
549 ! local version of these variables to allow PGI compiler to compile
550  character(len=128) :: res_latlon_dynamics = ''
551  character(len=128) :: res_latlon_tracers = ''
552  character(len=80) :: grid_name = ''
553  character(len=120) :: grid_file = ''
554 
555  namelist /fv_grid_nml/ grid_name, grid_file
556  namelist /fv_core_nml/npx, npy, ntiles, npz, npz_rst, layout, io_layout, ncnst, nwat, &
561  res_latlon_dynamics, res_latlon_tracers, scale_z, w_max, z_min, &
577 
578  namelist /test_case_nml/test_case, bubble_do, alpha, nsolitons, soliton_umax, soliton_size
579 
580 #ifdef GFS_PHYS
581  real, dimension(2048) :: fdiag = 0.
582  namelist /nggps_diag_nml/ fdiag
583 #endif
584 
585  pe_counter = mpp_root_pe()
586 
587 ! Make alpha = 0 the default:
588  alpha = 0.
589  bubble_do = .false.
590  test_case = 11 ! (USGS terrain)
591 
592  filename = "input.nml"
593 
594  inquire(file=filename,exist=exists)
595  if (.not. exists) then ! This will be replaced with fv_error wrapper
596  if(is_master()) write(*,*) "file ",trim(filename)," doesn't exist"
597  call mpp_error(fatal,'FV core terminating 1')
598  endif
599 
600 #ifdef INTERNAL_FILE_NML
601 ! rewind (f_unit)
602  ! Read Main namelist
603  read (input_nml_file,fv_grid_nml,iostat=ios)
604  ierr = check_nml_error(ios,'fv_grid_nml')
605  ! Read Test_Case namelist
606  read (input_nml_file,test_case_nml,iostat=ios)
607  ierr = check_nml_error(ios,'test_case_nml')
608 #else
609  f_unit=open_namelist_file()
610  rewind(f_unit)
611  ! Read Main namelist
612  read (f_unit,fv_grid_nml,iostat=ios)
613  ierr = check_nml_error(ios,'fv_grid_nml')
614  rewind(f_unit)
615  call close_file(f_unit)
616 #endif
617 
618  unit = stdlog()
619  write(unit, nml=fv_grid_nml)
620 
621  do n=1,size(atm)
622 
623  call switch_current_atm(atm(n), .false.)
624  call setup_pointers(atm(n))
625  atm(n)%grid_number = n
626  if (grids_on_this_pe(n)) then
627  call fv_diag_init_gn(atm(n))
628  endif
629 
630 #ifdef INTERNAL_FILE_NML
631  if (size(atm) > 1) then
632  call mpp_error(fatal, "Nesting not implemented with INTERNAL_FILE_NML")
633  endif
634  ! Read FVCORE namelist
635  read (input_nml_file,fv_core_nml,iostat=ios)
636  ierr = check_nml_error(ios,'fv_core_nml')
637  ! Read Test_Case namelist
638  read (input_nml_file,test_case_nml,iostat=ios)
639  ierr = check_nml_error(ios,'test_case_nml')
640 #ifdef GFS_PHYS
641  ! Read NGGPS_DIAG namelist
642  read (input_nml_file,nggps_diag_nml,iostat=ios)
643  ierr = check_nml_error(ios,'nggps_diag_nml')
644 !--- check fdiag to see if it is an interval or a list
645  if (nint(fdiag(2)) == 0) then
646  atm(n)%fdiag(1) = fdiag(1)
647  do i = 2, size(fdiag,1)
648  atm(n)%fdiag(i) = atm(n)%fdiag(i-1) + fdiag(1)
649  enddo
650  else
651  atm(n)%fdiag = fdiag
652  endif
653 #endif
654 #else
655  if (size(atm) == 1) then
656  f_unit = open_namelist_file()
657  else if (n == 1) then
658  f_unit = open_namelist_file('input.nml')
659  else
660  write(nested_grid_filename,'(A10, I2.2, A4)') 'input_nest', n, '.nml'
661  f_unit = open_namelist_file(nested_grid_filename)
662  endif
663 
664  ! Read FVCORE namelist
665  read (f_unit,fv_core_nml,iostat=ios)
666  ierr = check_nml_error(ios,'fv_core_nml')
667 
668  ! Read Test_Case namelist
669  rewind(f_unit)
670  read (f_unit,test_case_nml,iostat=ios)
671  ierr = check_nml_error(ios,'test_case_nml')
672 #ifdef GFS_PHYS
673  ! Read NGGPS_DIAG namelist
674  rewind(f_unit)
675  read (f_unit,nggps_diag_nml,iostat=ios)
676  ierr = check_nml_error(ios,'nggps_diag_nml')
677 !--- check fdiag to see if it is an interval or a list
678  if (nint(fdiag(2)) == 0) then
679  atm(n)%fdiag(1) = fdiag(1)
680  do i = 2, size(fdiag,1)
681  atm(n)%fdiag(i) = atm(n)%fdiag(i-1) + fdiag(1)
682  enddo
683  else
684  atm(n)%fdiag = fdiag
685  endif
686 #endif
687  call close_file(f_unit)
688 #endif
689  if (len_trim(grid_file) /= 0) atm(n)%flagstruct%grid_file = grid_file
690  if (len_trim(grid_name) /= 0) atm(n)%flagstruct%grid_name = grid_name
691  if (len_trim(res_latlon_dynamics) /= 0) atm(n)%flagstruct%res_latlon_dynamics = res_latlon_dynamics
692  if (len_trim(res_latlon_tracers) /= 0) atm(n)%flagstruct%res_latlon_tracers = res_latlon_tracers
693 
694  write(unit, nml=fv_core_nml)
695  write(unit, nml=test_case_nml)
696 #ifdef GFS_PHYS
697  write(unit, nml=nggps_diag_nml)
698 #endif
699 
700  !*** single tile for Cartesian grids
701  if (grid_type>3) then
702  ntiles=1
703  non_ortho = .false.
704  nf_omega = 0
705  endif
706 
707  if (.not. nested) atm(n)%neststruct%npx_global = npx
708 
709  ! Define n_split if not in namelist
710  if (ntiles==6) then
711  dimx = 4.0*(npx-1)
712 #ifndef MAPL_MODE
713  if ( hydrostatic ) then
714  if ( npx >= 120 ) ns0 = 6
715  else
716  if ( npx <= 45 ) then
717  ns0 = 6
718  elseif ( npx <=90 ) then
719  ns0 = 7
720  else
721  ns0 = 8
722  endif
723  endif
724 #endif
725  else
726  dimx = max( npx, 2*(npy-1) )
727  endif
728 
729  if (grid_type < 4) then
730  n0split = nint( ns0*abs(dt_atmos)*dimx/(dt0*dim0) + 0.49 )
731  elseif (grid_type == 4 .or. grid_type == 7) then
732  n0split = nint( 2.*umax*dt_atmos/sqrt(dx_const**2 + dy_const**2) + 0.49 )
733  elseif (grid_type == 5 .or. grid_type == 6) then
734  if (grid_type == 6) then
735  deglon_start = 0.; deglon_stop = 360.
736  endif
737  dl = (deglon_stop-deglon_start)*pi/(180.*(npx-1))
738  dp = (deglat_stop-deglat_start)*pi/(180.*(npy-1))
739 
740  dxmin=dl*radius*min(cos(deglat_start*pi/180.-ng*dp), &
741  cos(deglat_stop *pi/180.+ng*dp))
742  dymin=dp*radius
743  n0split = nint( 2.*umax*dt_atmos/sqrt(dxmin**2 + dymin**2) + 0.49 )
744  endif
745  n0split = max( 1, n0split )
746 
747  if ( n_split == 0 ) then
748  n_split = nint( real(n0split)/real(k_split*abs(p_split)) * stretch_fac + 0.5 )
749  if(is_master()) write(*,*) 'For k_split (remapping)=', k_split
750  if(is_master()) write(*,198) 'n_split is set to ', n_split, ' for resolution-dt=',npx,npy,ntiles,dt_atmos
751  else
752  if(is_master()) write(*,199) 'Using n_split from the namelist: ', n_split
753  endif
754  if (is_master() .and. n == 1 .and. abs(p_split) > 1) then
755  write(*,199) 'Using p_split = ', p_split
756  endif
757 
758  if (atm(n)%neststruct%nested) then
759  do i=1,n-1
760  if (atm(i)%grid_number == parent_grid_num) then
761  atm(n)%parent_grid => atm(i)
762  exit
763  end if
764  end do
765  if (.not. associated(atm(n)%parent_grid)) then
766  write(errstring,'(2(A,I3))') "Could not find parent grid #", parent_grid_num, ' for grid #', n
767  call mpp_error(fatal, errstring)
768  end if
769 
770  !Note that if a gnomonic grid has a parent it is a NESTED gnomonic grid and therefore only has one tile
771  if ( atm(n)%parent_grid%flagstruct%grid_type < 3 .and. &
772  .not. associated(atm(n)%parent_grid%parent_grid)) then
773  if (parent_tile > 6 .or. parent_tile < 1) then
774  call mpp_error(fatal, 'parent tile must be between 1 and 6 if the parent is a cubed-sphere grid')
775  end if
776  else
777  if (parent_tile /= 1) then
778  call mpp_error(fatal, 'parent tile must be 1 if the parent is not a cubed-sphere grid')
779  end if
780  end if
781 
782  if ( refinement < 1 ) call mpp_error(fatal, 'grid refinement must be positive')
783 
784  if (nestupdate == 1 .or. nestupdate == 2) then
785 
786  if (mod(npx-1,refinement) /= 0 .or. mod(npy-1,refinement) /= 0) then
787  call mpp_error(warning, 'npx-1 or npy-1 is not evenly divisible by the refinement ratio; averaging update cannot be mass-conservative.')
788  end if
789 
790  end if
791 
792  if ( consv_te > 0.) then
793  call mpp_error(fatal, 'The global energy fixer cannot be used on a nested grid. consv_te must be set to 0.')
794  end if
795 
796  atm(n)%neststruct%refinement_of_global = atm(n)%neststruct%refinement * atm(n)%parent_grid%neststruct%refinement_of_global
797  max_refinement_of_global = max(atm(n)%neststruct%refinement_of_global,max_refinement_of_global)
798  atm(n)%neststruct%npx_global = atm(n)%neststruct%refinement * atm(n)%parent_grid%neststruct%npx_global
799 
800  else
801  atm(n)%neststruct%ioffset = -999
802  atm(n)%neststruct%joffset = -999
803  atm(n)%neststruct%parent_tile = -1
804  atm(n)%neststruct%refinement = -1
805  end if
806 
807  if (atm(n)%neststruct%nested) then
808  if (atm(n)%flagstruct%grid_type >= 4 .and. atm(n)%parent_grid%flagstruct%grid_type >= 4) then
809  atm(n)%flagstruct%dx_const = atm(n)%parent_grid%flagstruct%dx_const / real(Atm(n)%neststruct%refinement)
810  atm(n)%flagstruct%dy_const = atm(n)%parent_grid%flagstruct%dy_const / real(Atm(n)%neststruct%refinement)
811  end if
812  end if
813 
814 
815 !----------------------------------------
816 ! Adjust divergence damping coefficients:
817 !----------------------------------------
818 ! d_fac = real(n0split)/real(n_split)
819 ! dddmp = dddmp * d_fac
820 ! d2_bg = d2_bg * d_fac
821 ! d4_bg = d4_bg * d_fac
822 ! d_ext = d_ext * d_fac
823 ! vtdm4 = vtdm4 * d_fac
824  if (old_divg_damp) then
825  if (is_master()) write(*,*) " fv_control: using original values for divergence damping "
826  d2_bg_k1 = 6. ! factor for d2_bg (k=1) - default(4.)
827  d2_bg_k2 = 4. ! factor for d2_bg (k=2) - default(2.)
828  d2_divg_max_k1 = 0.02 ! d2_divg max value (k=1) - default(0.05)
829  d2_divg_max_k2 = 0.01 ! d2_divg max value (k=2) - default(0.02)
830  damp_k_k1 = 0. ! damp_k value (k=1) - default(0.05)
831  damp_k_k2 = 0. ! damp_k value (k=2) - default(0.025)
832  elseif (n_sponge == 0 ) then
833  if ( d2_bg_k1 > 1. ) d2_bg_k1 = 0.20
834  if ( d2_bg_k2 > 1. ) d2_bg_k2 = 0.015
835  endif
836 
837 ! if ( beta < 1.e-5 ) beta = 0. ! beta < 0 is used for non-hydrostatic "one_grad_p"
838 
839  if ( .not.hydrostatic ) then
840  if ( m_split==0 ) then
841  m_split = 1. + abs(dt_atmos)/real(k_split*n_split*abs(p_split))
842  if (abs(a_imp) < 0.5) then
843  if(is_master()) write(*,199) 'm_split is set to ', m_split
844  endif
845  endif
846  if(is_master()) then
847  write(*,*) 'Off center implicit scheme param=', a_imp
848  write(*,*) ' p_fac=', p_fac
849  endif
850  endif
851 
852  if(is_master()) then
853  if (n_zfilter >= 0) write(*,199) 'Using n_zfilter : ', n_zfilter
854  if (n_sponge >= 0) write(*,199) 'Using n_sponge : ', n_sponge
855  write(*,197) 'Using non_ortho : ', non_ortho
856  endif
857 
858  197 format(a,l7)
859  198 format(a,i2.2,a,i4.4,'x',i4.4,'x',i1.1,'-',f9.3)
860  199 format(a,i3.3)
861 
862  if (.not. nested) alpha = alpha*pi
863 
864 
865  allocate(atm(n)%neststruct%child_grids(size(atm)))
866  atm(n)%neststruct%child_grids = .false.
867 
868  !Broadcast data
869 
870  !Check layout
871 
872  enddo
873 
874  !Set pelists
875  do n=1,size(atm)
876  if (any(atm(n)%pelist == gid)) then
877  call mpp_set_current_pelist(atm(n)%pelist)
878  call mpp_get_current_pelist(atm(n)%pelist, commid=commid)
879  call mp_start(commid,halo_update_type)
880  endif
881 
882  if (atm(n)%neststruct%nested) then
883  atm(n)%neststruct%parent_proc = any(atm(n)%parent_grid%pelist == gid)
884  atm(n)%neststruct%child_proc = any(atm(n)%pelist == gid)
885  endif
886  enddo
887 
888  do n=1,size(atm)
889 
890  call switch_current_atm(atm(n),.false.)
891  call setup_pointers(atm(n))
892  !! CLEANUP: WARNING not sure what changes to domain_decomp may cause
893  call domain_decomp(npx,npy,ntiles,grid_type,nested,atm(n),layout,io_layout)
894  enddo
895 
896  !!! CLEANUP: This sets the pelist to ALL, which is also
897  !!! required for the define_nest_domains step in the next loop.
898  !!! Later the pelist must be reset to the 'local' pelist.
899  call broadcast_domains(atm)
900 
901  do n=1,size(atm)
902  call switch_current_atm(atm(n))
903  call setup_pointers(atm(n))
904 
905  if (nested) then
906  if (mod(npx-1 , refinement) /= 0 .or. mod(npy-1, refinement) /= 0) &
907  call mpp_error(fatal, 'npx or npy not an even refinement of its coarse grid.')
908 
909  !Pelist needs to be set to ALL (which should have been done
910  !in broadcast_domains) to get this to work
911  call mpp_define_nest_domains(atm(n)%neststruct%nest_domain, atm(n)%domain, atm(parent_grid_num)%domain, &
912  7, parent_tile, &
913  1, npx-1, 1, npy-1, & !Grid cells, not points
914  ioffset, ioffset + (npx-1)/refinement - 1, &
915  joffset, joffset + (npy-1)/refinement - 1, &
916  (/ (i,i=0,mpp_npes()-1) /), extra_halo = 0, name="nest_domain") !What pelist to use?
917  call mpp_define_nest_domains(atm(n)%neststruct%nest_domain, atm(n)%domain, atm(parent_grid_num)%domain, &
918  7, parent_tile, &
919  1, npx-1, 1, npy-1, & !Grid cells, not points
920  ioffset, ioffset + (npx-1)/refinement - 1, &
921  joffset, joffset + (npy-1)/refinement - 1, &
922  (/ (i,i=0,mpp_npes()-1) /), extra_halo = 0, name="nest_domain") !What pelist to use?
923 ! (/ (i,i=0,mpp_npes()-1) /), extra_halo = 2, name="nest_domain_for_BC") !What pelist to use?
924 
925  atm(parent_grid_num)%neststruct%child_grids(n) = .true.
926 
927  if (atm(n)%neststruct%nestbctype > 1) then
928 
929  call mpp_error(fatal, 'nestbctype > 1 not yet implemented')
930 
931  !This check is due to a bug which has not yet been identified. Beware.
932 ! if (Atm(n)%parent_grid%flagstruct%hord_tr == 7) &
933 ! 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.")
934 
935 !!$ if (Atm(n)%flagstruct%q_split > 0 .and. Atm(n)%parent_grid%flagstruct%q_split > 0) then
936 !!$ if (mod(Atm(n)%flagstruct%q_split,Atm(n)%parent_grid%flagstruct%q_split) /= 0) call mpp_error(FATAL, &
937 !!$ "Flux-form nested BCs (nestbctype > 1) require q_split on the nested grid to be evenly divisible by that on the coarse grid.")
938 !!$ endif
939 !!$ 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, &
940 !!$ "Flux-form nested BCs (nestbctype > 1) requires npx and npy to be one more than a multiple of the refinement ratio.")
941 !!$ Atm(n)%parent_grid%neststruct%do_flux_BCs = .true.
942 !!$ if (Atm(n)%neststruct%nestbctype == 3 .or. Atm(n)%neststruct%nestbctype == 4) Atm(n)%parent_grid%neststruct%do_2way_flux_BCs = .true.
943  atm(n)%neststruct%upoff = 0
944  endif
945 
946  end if
947 
948  do nn=1,size(atm)
949  if (n == 1) allocate(atm(nn)%neststruct%nest_domain_all(size(atm)))
950  atm(nn)%neststruct%nest_domain_all(n) = atm(n)%neststruct%nest_domain
951  enddo
952 
953  end do
954 
955  do n=1,size(atm)
956  if (any(atm(n)%pelist == gid)) then
957  call mpp_set_current_pelist(atm(n)%pelist)
958  endif
959  enddo
960 
961  end subroutine run_setup
962 
963  subroutine init_nesting(Atm, grids_on_this_pe, p_split)
964 
965  type(fv_atmos_type), intent(inout), allocatable :: Atm(:)
966  logical, allocatable, intent(INOUT) :: grids_on_this_pe(:)
967  integer, intent(INOUT) :: p_split
968  character(100) :: pe_list_name
969  integer :: nest_pes(100)
970  integer :: n, npes, ntiles, pecounter, i
971  integer, allocatable :: pelist(:)
972  integer :: f_unit, ios, ierr
973 
974  !This is an OPTIONAL namelist, that needs to be read before everything else
975  namelist /nest_nml/ ngrids, ntiles, nest_pes, p_split
976 
977  call mp_assign_gid
978 
979  nest_pes = 0
980  ntiles = -999
981 
982 #ifdef INTERNAL_FILE_NML
983  read (input_nml_file,nest_nml,iostat=ios)
984  ierr = check_nml_error(ios,'nest_nml')
985 #else
986  f_unit=open_namelist_file()
987  rewind(f_unit)
988  read (f_unit,nest_nml,iostat=ios)
989  ierr = check_nml_error(ios,'nest_nml')
990  call close_file(f_unit)
991 #endif
992 
993  if (ntiles /= -999) ngrids = ntiles
994  if (ngrids > 10) call mpp_error(fatal, "More than 10 nested grids not supported")
995 
996  allocate(atm(ngrids))
997 
998  allocate(grids_on_this_pe(ngrids))
999  grids_on_this_pe = .false. !initialization
1000 
1001  npes = mpp_npes()
1002 
1003  ! Need to get a global pelist to send data around later?
1004  allocate( pelist_all(npes) )
1005  pelist_all = (/ (i,i=0,npes-1) /)
1006  pelist_all = pelist_all + mpp_root_pe()
1007 
1008  if (ngrids == 1) then
1009 
1010  !Set up the single pelist
1011  allocate(atm(1)%pelist(npes))
1012  atm(1)%pelist = (/(i, i=0, npes-1)/)
1013  atm(1)%pelist = atm(1)%pelist + mpp_root_pe()
1014  call mpp_declare_pelist(atm(1)%pelist)
1015  call mpp_set_current_pelist(atm(1)%pelist)
1016  !Now set in domain_decomp
1017  !masterproc = Atm(1)%pelist(1)
1018  call setup_master(atm(1)%pelist)
1019  grids_on_this_pe(1) = .true.
1020  atm(1)%npes_this_grid = npes
1021 
1022  else
1023 
1024  pecounter = mpp_root_pe()
1025  do n=1,ngrids
1026  if (n == 1) then
1027  pe_list_name = ''
1028  else
1029  write(pe_list_name,'(A4, I2.2)') 'nest', n
1030  endif
1031 
1032  if (nest_pes(n) == 0) then
1033  if (n < ngrids) call mpp_error(fatal, 'Only nest_pes(ngrids) in nest_nml can be zero; preceeding values must be nonzero.')
1034  allocate(atm(n)%pelist(npes-pecounter))
1035  atm(n)%pelist = (/(i, i=pecounter, npes-1)/)
1036  if (n > 1) then
1037  call mpp_declare_pelist(atm(n)%pelist, trim(pe_list_name))
1038  !Make sure nested-grid input file exists
1039  if (.not. file_exist('input_'//trim(pe_list_name)//'.nml')) then
1040  call mpp_error(fatal, "Could not find nested grid namelist input_"//trim(pe_list_name)//".nml")
1041  endif
1042  endif
1043  exit
1044  else
1045  allocate(atm(n)%pelist(nest_pes(n)))
1046  atm(n)%pelist = (/ (i, i=pecounter, pecounter+nest_pes(n)-1) /)
1047  if (atm(n)%pelist(nest_pes(n)) >= npes) then
1048  call mpp_error(fatal, 'PEs assigned by nest_pes in nest_nml exceeds number of available PEs.')
1049  endif
1050 
1051  call mpp_declare_pelist(atm(n)%pelist, trim(pe_list_name))
1052  !Make sure nested-grid input file exists
1053  if (n > 1) then
1054  if (.not. file_exist('input_'//trim(pe_list_name)//'.nml')) then
1055  call mpp_error(fatal, "Could not find nested grid namelist input_"//trim(pe_list_name)//".nml")
1056  endif
1057  endif
1058  pecounter = pecounter+nest_pes(n)
1059  endif
1060  enddo
1061 
1062  !Set pelists
1063  do n=1,ngrids
1064  atm(n)%npes_this_grid = size(atm(n)%pelist)
1065  if (any(gid == atm(n)%pelist)) then
1066  call mpp_set_current_pelist(atm(n)%pelist)
1067  !now set in domain_decomp
1068  !masterproc = Atm(n)%pelist(1)
1069  call setup_master(atm(n)%pelist)
1070  grids_on_this_pe(n) = .true.
1071 #if defined (INTERNAL_FILE_NML)
1072  if (n > 1) call read_input_nml
1073 #else
1074  !Namelist file read in fv_control_nlm.F90
1075 #endif
1076  exit
1077  endif
1078  enddo
1079 
1080  if (pecounter /= npes) then
1081  call mpp_error(fatal, 'nest_pes in nest_nml does not assign all of the available PEs.')
1082  endif
1083  endif
1084 
1085  !Layout is checked later, in fv_control
1086 
1087  end subroutine init_nesting
1088 
1089  subroutine setup_pointers(Atm)
1091  type(fv_atmos_type), intent(INOUT), target :: Atm
1092 
1093  !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.
1094 
1095  res_latlon_dynamics => atm%flagstruct%res_latlon_dynamics
1096  res_latlon_tracers => atm%flagstruct%res_latlon_tracers
1097 
1098  grid_type => atm%flagstruct%grid_type
1099  grid_name => atm%flagstruct%grid_name
1100  grid_file => atm%flagstruct%grid_file
1101  hord_mt => atm%flagstruct%hord_mt
1102  kord_mt => atm%flagstruct%kord_mt
1103  kord_wz => atm%flagstruct%kord_wz
1104  hord_vt => atm%flagstruct%hord_vt
1105  hord_tm => atm%flagstruct%hord_tm
1106  hord_dp => atm%flagstruct%hord_dp
1107  kord_tm => atm%flagstruct%kord_tm
1108  hord_tr => atm%flagstruct%hord_tr
1109  kord_tr => atm%flagstruct%kord_tr
1110  scale_z => atm%flagstruct%scale_z
1111  w_max => atm%flagstruct%w_max
1112  z_min => atm%flagstruct%z_min
1113  nord => atm%flagstruct%nord
1114  nord_tr => atm%flagstruct%nord_tr
1115  dddmp => atm%flagstruct%dddmp
1116  d2_bg => atm%flagstruct%d2_bg
1117  d4_bg => atm%flagstruct%d4_bg
1118  vtdm4 => atm%flagstruct%vtdm4
1119  trdm2 => atm%flagstruct%trdm2
1120  d2_bg_k1 => atm%flagstruct%d2_bg_k1
1121  d2_bg_k2 => atm%flagstruct%d2_bg_k2
1122  d2_divg_max_k1 => atm%flagstruct%d2_divg_max_k1
1123  d2_divg_max_k2 => atm%flagstruct%d2_divg_max_k2
1124  damp_k_k1 => atm%flagstruct%damp_k_k1
1125  damp_k_k2 => atm%flagstruct%damp_k_k2
1126  n_zs_filter => atm%flagstruct%n_zs_filter
1127  nord_zs_filter => atm%flagstruct%nord_zs_filter
1128  full_zs_filter => atm%flagstruct%full_zs_filter
1129  consv_am => atm%flagstruct%consv_am
1130  do_sat_adj => atm%flagstruct%do_sat_adj
1131  do_f3d => atm%flagstruct%do_f3d
1132  no_dycore => atm%flagstruct%no_dycore
1133  convert_ke => atm%flagstruct%convert_ke
1134  do_vort_damp => atm%flagstruct%do_vort_damp
1135  use_old_omega => atm%flagstruct%use_old_omega
1136  beta => atm%flagstruct%beta
1137  n_zfilter => atm%flagstruct%n_zfilter
1138  n_sponge => atm%flagstruct%n_sponge
1139  d_ext => atm%flagstruct%d_ext
1140  nwat => atm%flagstruct%nwat
1141  use_logp => atm%flagstruct%use_logp
1142  warm_start => atm%flagstruct%warm_start
1143  inline_q => atm%flagstruct%inline_q
1144  shift_fac => atm%flagstruct%shift_fac
1145  do_schmidt => atm%flagstruct%do_schmidt
1146  stretch_fac => atm%flagstruct%stretch_fac
1147  target_lat => atm%flagstruct%target_lat
1148  target_lon => atm%flagstruct%target_lon
1149  reset_eta => atm%flagstruct%reset_eta
1150  p_fac => atm%flagstruct%p_fac
1151  a_imp => atm%flagstruct%a_imp
1152  n_split => atm%flagstruct%n_split
1153  m_split => atm%flagstruct%m_split
1154  k_split => atm%flagstruct%k_split
1155  use_logp => atm%flagstruct%use_logp
1156  q_split => atm%flagstruct%q_split
1157  print_freq => atm%flagstruct%print_freq
1158  npx => atm%flagstruct%npx
1159  npy => atm%flagstruct%npy
1160  npz => atm%flagstruct%npz
1161  npz_rst => atm%flagstruct%npz_rst
1162  ncnst => atm%flagstruct%ncnst
1163  pnats => atm%flagstruct%pnats
1164  dnats => atm%flagstruct%dnats
1165  ntiles => atm%flagstruct%ntiles
1166  nf_omega => atm%flagstruct%nf_omega
1167  fv_sg_adj => atm%flagstruct%fv_sg_adj
1168  na_init => atm%flagstruct%na_init
1169  p_ref => atm%flagstruct%p_ref
1170  dry_mass => atm%flagstruct%dry_mass
1171  nt_prog => atm%flagstruct%nt_prog
1172  nt_phys => atm%flagstruct%nt_phys
1173  tau_h2o => atm%flagstruct%tau_h2o
1174  delt_max => atm%flagstruct%delt_max
1175  d_con => atm%flagstruct%d_con
1176  ke_bg => atm%flagstruct%ke_bg
1177  consv_te => atm%flagstruct%consv_te
1178  tau => atm%flagstruct%tau
1179  rf_cutoff => atm%flagstruct%rf_cutoff
1180  filter_phys => atm%flagstruct%filter_phys
1181  dwind_2d => atm%flagstruct%dwind_2d
1182  breed_vortex_inline => atm%flagstruct%breed_vortex_inline
1183  range_warn => atm%flagstruct%range_warn
1184  fill => atm%flagstruct%fill
1185  fill_dp => atm%flagstruct%fill_dp
1186  fill_wz => atm%flagstruct%fill_wz
1187  check_negative => atm%flagstruct%check_negative
1188  non_ortho => atm%flagstruct%non_ortho
1189  adiabatic => atm%flagstruct%adiabatic
1190  moist_phys => atm%flagstruct%moist_phys
1191  do_held_suarez => atm%flagstruct%do_Held_Suarez
1192  do_reed_physics => atm%flagstruct%do_reed_physics
1193  reed_cond_only => atm%flagstruct%reed_cond_only
1194  reproduce_sum => atm%flagstruct%reproduce_sum
1195  adjust_dry_mass => atm%flagstruct%adjust_dry_mass
1196  fv_debug => atm%flagstruct%fv_debug
1197  srf_init => atm%flagstruct%srf_init
1198  mountain => atm%flagstruct%mountain
1199  remap_option => atm%flagstruct%remap_option
1200  z_tracer => atm%flagstruct%z_tracer
1201  old_divg_damp => atm%flagstruct%old_divg_damp
1202  fv_land => atm%flagstruct%fv_land
1203  nudge => atm%flagstruct%nudge
1204  nudge_ic => atm%flagstruct%nudge_ic
1205  ncep_ic => atm%flagstruct%ncep_ic
1206  nggps_ic => atm%flagstruct%nggps_ic
1207  ecmwf_ic => atm%flagstruct%ecmwf_ic
1208  gfs_phil => atm%flagstruct%gfs_phil
1209  agrid_vel_rst => atm%flagstruct%agrid_vel_rst
1210  use_new_ncep => atm%flagstruct%use_new_ncep
1211  use_ncep_phy => atm%flagstruct%use_ncep_phy
1212  fv_diag_ic => atm%flagstruct%fv_diag_ic
1213  external_ic => atm%flagstruct%external_ic
1214 
1215  hydrostatic => atm%flagstruct%hydrostatic
1216  phys_hydrostatic => atm%flagstruct%phys_hydrostatic
1217  use_hydro_pressure => atm%flagstruct%use_hydro_pressure
1218  do_uni_zfull => atm%flagstruct%do_uni_zfull !miz
1219  adj_mass_vmr => atm%flagstruct%adj_mass_vmr !f1p
1220  hybrid_z => atm%flagstruct%hybrid_z
1221  make_nh => atm%flagstruct%Make_NH
1222  make_hybrid_z => atm%flagstruct%make_hybrid_z
1223  nudge_qv => atm%flagstruct%nudge_qv
1224  add_noise => atm%flagstruct%add_noise
1225  a2b_ord => atm%flagstruct%a2b_ord
1226  c2l_ord => atm%flagstruct%c2l_ord
1227  ndims => atm%flagstruct%ndims
1228 
1229  dx_const => atm%flagstruct%dx_const
1230  dy_const => atm%flagstruct%dy_const
1231  deglon_start => atm%flagstruct%deglon_start
1232  deglon_stop => atm%flagstruct%deglon_stop
1233  deglat_start => atm%flagstruct%deglat_start
1234  deglat_stop => atm%flagstruct%deglat_stop
1235 
1236  deglat => atm%flagstruct%deglat
1237 
1238  nested => atm%neststruct%nested
1239  twowaynest => atm%neststruct%twowaynest
1240  parent_tile => atm%neststruct%parent_tile
1241  refinement => atm%neststruct%refinement
1242  nestbctype => atm%neststruct%nestbctype
1243  nestupdate => atm%neststruct%nestupdate
1244  nsponge => atm%neststruct%nsponge
1245  s_weight => atm%neststruct%s_weight
1246  ioffset => atm%neststruct%ioffset
1247  joffset => atm%neststruct%joffset
1248 
1249  layout => atm%layout
1250  io_layout => atm%io_layout
1251  end subroutine setup_pointers
1252 
1253 
1254 end module fv_control_nlm_mod
Definition: fms.F90:20
subroutine, public fv_restart_end(Atm, grids_on_this_pe)
real(kind=r_grid), pointer dy_const
real, pointer damp_k_k2
subroutine init_nesting(Atm, grids_on_this_pe, p_split)
real, pointer dry_mass
real, parameter, public radius
Radius of the Earth [m].
Definition: constants.F90:72
subroutine, public grid_utils_end
logical, pointer make_hybrid_z
integer, parameter, public model_atmos
integer, pointer nsponge
logical, pointer warm_start
real, pointer shift_fac
logical, pointer nudge_qv
logical, pointer gfs_phil
integer, pointer kord_wz
integer max_refinement_of_global
logical, pointer use_hydro_pressure
integer, pointer kord_tr
real, parameter, public ptop_min
logical, pointer reset_eta
logical, pointer do_vort_damp
logical, pointer breed_vortex_inline
character(len=128), pointer res_latlon_tracers
integer, parameter, public input_str_length
Definition: mpp.F90:1376
integer, pointer hord_tm
subroutine setup_pointers(Atm)
real(kind=8), parameter, public pi_8
Ratio of circle circumference to diameter [N/A].
Definition: constants.F90:73
integer, pointer n_sponge
logical, pointer moist_phys
logical, pointer adjust_dry_mass
integer, pointer k_split
logical, pointer convert_ke
integer, pointer n_zfilter
subroutine, public set_eta(km, ks, ptop, ak, bk)
Definition: fv_eta_nlm.F90:392
logical, pointer do_held_suarez
subroutine allocate_fv_atmos_type(Atm, isd_in, ied_in, jsd_in, jed_in, is_in, ie_in, js_in, je_in, npx_in, npy_in, npz_in, ndims_in, ncnst_in, nq_in, ng_in, dummy, alloc_2d, ngrids_in)
subroutine, public fv_end(Atm, grids_on_this_pe, restarts)
character(len=128), pointer res_latlon_dynamics
logical, pointer fill_dp
integer, pointer nestupdate
real(kind=r_grid), pointer target_lat
subroutine, public get_tracer_indices(model, ind, prog_ind, diag_ind, fam_ind)
real(kind=r_grid), pointer deglat_start
integer, pointer remap_option
logical, pointer check_negative
integer, pointer refinement
integer, dimension(:), allocatable, public pelist_all
real(kind=r_grid), pointer dx_const
real, pointer d4_bg
real(kind=r_grid), pointer target_lon
real, parameter, public rdgas
Gas constant for dry air [J/kg/deg].
Definition: constants.F90:77
logical, pointer inline_q
subroutine, public get_number_tracers(model, num_tracers, num_prog, num_diag, num_family)
real, pointer s_weight
integer, pointer print_freq
logical, pointer nudge
real, pointer d2_divg_max_k1
logical, pointer no_dycore
integer, pointer nt_prog
real, pointer d2_bg
logical, pointer reproduce_sum
logical, pointer nudge_ic
Definition: mpp.F90:39
real(kind=r_grid), pointer deglon_stop
character(len=80), pointer grid_name
integer function, public check_nml_error(IOSTAT, NML_NAME)
Definition: fms.F90:658
logical, pointer range_warn
real, pointer damp_k_k1
subroutine timing_prt(gid)
integer, pointer dnats
integer, pointer na_init
integer, pointer c2l_ord
real(kind=r_grid), pointer deglat
integer, pointer n_split
integer, pointer hord_mt
logical, pointer agrid_vel_rst
integer, pointer nwat
character(len=input_str_length), dimension(:), allocatable, target, public input_nml_file
Definition: mpp.F90:1378
integer, pointer m_split
logical, pointer filter_phys
integer, pointer npx
integer, pointer joffset
real(kind=r_grid), pointer deglon_start
logical, pointer use_logp
integer, pointer nord_tr
integer, pointer kord_mt
integer, pointer nord_zs_filter
subroutine, public set_tracer_profile(model, n, tracer, err_msg)
real, pointer scale_z
integer, pointer a2b_ord
integer, pointer hord_tr
integer, pointer fv_sg_adj
logical, pointer mountain
subroutine, public fv_init(Atm, dt_atmos, grids_on_this_pe, p_split)
logical, pointer consv_am
real, pointer consv_te
integer, parameter, public ng
real, public soliton_size
subroutine timing_on(blk_name)
logical, pointer fv_diag_ic
real, pointer dddmp
logical, pointer srf_init
logical, pointer hybrid_z
integer, pointer kord_tm
integer, pointer hord_dp
real, pointer rf_cutoff
real, pointer tau_h2o
integer, pointer nestbctype
logical, pointer hydrostatic
logical, pointer z_tracer
real(kind=r_grid), pointer deglat_stop
logical, pointer old_divg_damp
integer, parameter, public r_grid
subroutine, public fv_diag_init_gn(Atm)
real, pointer d2_bg_k1
logical function, public check_if_prognostic(model, n, err_msg)
real, pointer z_min
logical, pointer full_zs_filter
integer, public nsolitons
subroutine, public fv_io_exit
Definition: fv_io_nlm.F90:97
integer, pointer pnats
subroutine run_setup(Atm, dt_atmos, grids_on_this_pe, p_split)
logical, pointer fill
real, public soliton_umax
logical, pointer make_nh
logical, pointer do_uni_zfull
integer, dimension(:), pointer io_layout
real, pointer d2_divg_max_k2
real, parameter, public grav
Acceleration due to gravity [m/s^2].
Definition: constants.F90:76
logical, pointer do_f3d
integer, pointer q_split
integer, pointer nt_phys
logical, pointer fill_wz
real(kind=r_grid), pointer stretch_fac
integer, pointer ioffset
logical, pointer fv_debug
logical, public bubble_do
subroutine, public grid_utils_init(Atm, npx, npy, npz, non_ortho, grid_type, c2l_order)
logical, pointer use_new_ncep
character(len=120), pointer grid_file
#define max(a, b)
Definition: mosaic_util.h:33
real, pointer d2_bg_k2
subroutine, public get_tracer_names(model, n, name, longname, units, err_msg)
logical, pointer do_sat_adj
subroutine, public fv_restart_init()
real, pointer trdm2
integer, pointer npz
subroutine deallocate_fv_atmos_type(Atm)
logical, pointer nested
logical, pointer use_old_omega
logical, pointer fv_land
integer, pointer nf_omega
logical, pointer twowaynest
integer, public test_case
integer, pointer n_zs_filter
logical, pointer ecmwf_ic
integer, public ngrids
subroutine, public init_grid(Atm, grid_name, grid_file, npx, npy, npz, ndims, nregions, ng)
logical, pointer external_ic
integer, pointer ndims
integer, pointer npz_rst
real, pointer vtdm4
integer, dimension(:), pointer layout
logical, pointer ncep_ic
logical, pointer phys_hydrostatic
#define min(a, b)
Definition: mosaic_util.h:32
logical, pointer use_ncep_phy
real, pointer w_max
integer, pointer npy
integer, pointer ncnst
integer, pointer ntiles
logical, pointer reed_cond_only
logical, pointer do_schmidt
real, parameter, public kappa
RDGAS / CP_AIR [dimensionless].
Definition: constants.F90:82
integer, pointer hord_vt
real, pointer add_noise
logical, pointer nggps_ic
logical, pointer adj_mass_vmr
Derived type containing the data.
subroutine timing_init
logical, pointer do_reed_physics
real, pointer delt_max
real(fp), parameter, public pi
subroutine timing_off(blk_name)
integer, pointer parent_tile
logical, pointer dwind_2d
integer, pointer nord
logical, pointer non_ortho
subroutine, public register_tracers(model, num_tracers, num_prog, num_diag, num_family)
logical, pointer adiabatic