control_mod.F90 coverage: 40.00 %func 15.76 %block
1) #ifdef HAVE_CONFIG_H
2) #include "config.h"
3) #endif
4)
5) ! This module contains constants and namelist variables used through out the model
6) ! to avoid circular dependancies please do not 'use' any further modules here.
7) !
8) module control_mod
9) use kinds, only : real_kind
10) use physical_constants, only: dd_pi
11)
12) implicit none
13)
14) integer, public, parameter :: MAX_STRING_LEN=240
15) integer, public, parameter :: MAX_FILE_LEN=240
16) character(len=MAX_STRING_LEN) , public :: integration ! time integration (explicit, or full imp)
17)
18) ! Tracer transport algorithm type:
19) ! 0 spectral-element Eulerian
20) ! 12 interpolation semi-Lagrangian
21) integer, public :: transport_alg = 0
22) ! Constrained density reconstructor for SL property preservation; not used if
23) ! transport_alg = 0:
24) ! 0 none
25) ! 2 QLT
26) ! 3 CAAS
27) ! 20 QLT with superlevels
28) ! 30 CAAS with superlevels
29) integer, public :: semi_lagrange_cdr_alg = 3
30) ! If true, check mass conservation and shape preservation. The second
31) ! implicitly checks tracer consistency.
32) logical, public :: semi_lagrange_cdr_check = .false.
33) ! If > 0 and nu_q > 0, apply hyperviscosity to tracers 1 through this value,
34) ! rather than just those that couple to the dynamics at the dynamical time
35) ! step. These latter are 'active' tracers, in contrast to 'passive' tracers
36) ! that directly couple only to the physics.
37) integer, public :: semi_lagrange_hv_q = 1
38) ! If >= 1, then the SL algorithm may choose a nearby point inside the element
39) ! halo available to it if the actual point is outside the halo. This is done
40) ! in levels <= this parameter.
41) integer, public :: semi_lagrange_nearest_point_lev = 256
42)
43) ! flag used by preqx, theta-l and theta-c models
44) ! should be renamed to "hydrostatic_mode"
45) logical, public :: theta_hydrostatic_mode
46)
47)
48) integer, public :: tstep_type= 5 ! preqx timestepping options
49) integer, public :: rk_stage_user = 0 ! number of RK stages (shallow water model)
50) integer, public :: ftype = 0 ! Forcing Type
51) ! ftype = 0 HOMME ApplyColumn() type forcing process split
52) ! ftype = -1 ignore forcing (used for testing energy balance)
53)
54) integer, public :: qsplit = 1 ! ratio of dynamics tsteps to tracer tsteps
55) integer, public :: rsplit = 0 ! for vertically lagrangian dynamics, apply remap
56) ! every rsplit tracer timesteps
57)
58) ! These factors replace rsplit and qsplit.
59) ! If dt_remap_factor = 0, use vertically Eulerian dynamics.
60) ! If dt_remap_factor > 0, the vertical remap time step is
61) ! dt_remap_factor*tstep.
62) ! The tracer transport time step is dt_tracer_factor*tstep.
63) ! The smaller of dt_remap_factor and dt_tracer_factor must divide
64) ! the larger.
65) ! If dt_remap_factor >= dt_tracer_factor, then
66) ! new dt_tracer_factor == old qsplit
67) ! new dt_remap_factor == old dt_tracer_factor/dt_remap_factor
68) ! Default values make qsplit and rsplit control the time steps.
69) integer, public :: dt_remap_factor = -1, dt_tracer_factor = -1
70)
71) integer, public :: prim_step_type = -1 ! 1 = old code for EUL, 2 = prim_run_flexible for SL
72) ! -1 means it wasn't set, error
73)
74) integer, public :: LFTfreq=0 ! leapfrog-trapazoidal frequency (shallow water only)
75) ! interspace a lf-trapazoidal step every LFTfreq leapfrogs
76) ! 0 = disabled
77)
78) ! vert_remap_q_alg: -1 PPM remap without monotone filter, used for some test cases
79) ! 0 Zerroukat monotonic splines
80) ! 1 PPM vertical remap with constant extension at the boundaries
81) ! 10 PPM with linear extrapolation at boundaries, with column limiter
82) ! 11 PPM with unlimited linear extrapolation at boundaries
83) integer, public :: vert_remap_q_alg = 0 ! tracers
84) integer, public :: vert_remap_u_alg = -2 ! remap for dynamics. default -2 means inherit vert_remap_q_alg
85)
86) ! advect theta 0: conservation form
87) ! 1: expanded divergence form (less noisy, non-conservative)
88) integer, public :: theta_advect_form = 0
89) real (kind=real_kind), public :: vtheta_thresh = 100.d0 ! threshold for virtual potential temperature minimum limiter
90) real (kind=real_kind), public :: dp3d_thresh = 0.125d0 ! threshold for dp3d minimum limiter
91)
92) integer, public :: pgrad_correction = 0 ! 1=turn on theta model pressure gradient correction
93) integer, public :: hv_ref_profiles = 0 ! 1=turn on theta model HV reference profiles
94) integer, public :: hv_theta_correction=0 ! 1=use HV on p-surface approximation for theta
95) real (kind=real_kind), public :: hv_theta_thresh=.025d0 ! d(theta)/dp max threshold for HV correction term
96)
97) integer, public :: cubed_sphere_map = -1 ! -1 = chosen at run time
98) ! 0 = equi-angle Gnomonic (default)
99) ! 1 = equi-spaced Gnomonic (not yet coded)
100) ! 2 = element-local projection (for var-res)
101) ! 3 = parametric (not yet coded)
102)
103) !tolerance to define smth small, was introduced for lim 8 in 2d and 3d
104) real (kind=real_kind), public, parameter :: tol_limiter=1e-13
105)
106) integer , public :: limiter_option = 0
107) character(len=MAX_STRING_LEN) , public :: precon_method ! if semi_implicit, type of preconditioner:
108) ! choices block_jacobi or identity
109)
110) integer , public :: coord_transform_method ! If zoltan2 is used, various ways of representing the coordinates methods
111) ! Instead of using the sphere coordinates, it is better to use cube or projected 2D coordinates for quality.
112) ! check params_mod for options.
113)
114) integer , public :: z2_map_method ! If zoltan2 is used,
115) ! Task mapping method to be used by zoltan2.
116) ! Z2_NO_TASK_MAPPING (1) - is no task mapping
117) ! Z2_TASK_MAPPING (2) - performs default task mapping of zoltan2.
118) ! Z2_OPTIMIZED_TASK_MAPPING (3) - includes network aware optimizations.
119) ! Use (3) if zoltan2 is enabled.
120)
121) integer , public :: partmethod ! partition methods
122) character(len=MAX_STRING_LEN) , public :: topology = "cube" ! options: "cube", "plane"
123) character(len=MAX_STRING_LEN) , public :: geometry = "sphere" ! options: "sphere", "plane"
124) character(len=MAX_STRING_LEN) , public :: test_case
125) !most tests don't have forcing
126) logical , public :: test_with_forcing = .false.
127) integer , public :: statefreq ! output frequency of synopsis of system state (steps)
128) integer , public :: restartfreq
129) integer , public :: runtype
130) integer , public :: timerdetail
131) integer , public :: numnodes
132) character(len=MAX_STRING_LEN) , public :: restartfile
133) character(len=MAX_STRING_LEN) , public :: restartdir
134)
135) ! flag used for "slice" planar tests (no variation in y-dir)
136) logical, public :: planar_slice
137)
138) ! namelist variable set to dry,notdry,moist
139) ! internally the code should use logical "use_moisture"
140) character(len=MAX_STRING_LEN) , public :: moisture
141)
142) integer, public :: use_cpstar=0 ! use cp or cp* in thermodynamics
143) logical, public :: use_moisture=.false. ! use Q(:,:,:,1) to compute T_v
144)
145)
146) integer , public :: maxits ! max iterations of solver
147) real (kind=real_kind), public :: tol ! solver tolerance (convergence criteria)
148) integer , public :: debug_level ! debug level of CG solver
149)
150)
151) character(len=MAX_STRING_LEN) ,public :: vfile_int="" ! vertical formulation (ecmwf,ccm1)
152) character(len=MAX_STRING_LEN) ,public :: vfile_mid="" ! vertical grid spacing (equal,unequal)
153) integer, public :: vanalytic = 0 ! if 1, test initializes vertical coords
154) real (kind=real_kind), public :: vtop = 0.1 ! top coordinate level for analytic vcoords
155)
156) real (kind=real_kind), public :: nu = 7.0D5 ! viscosity (momentum equ)
157) real (kind=real_kind), public :: nu_div = -1 ! viscsoity (momentum equ, div component)
158) real (kind=real_kind), public :: nu_s = -1 ! default = nu T equ. viscosity
159) real (kind=real_kind), public :: nu_q = -1 ! default = nu tracer viscosity
160) real (kind=real_kind), public :: nu_p = -1 ! default = nu ps equ. viscosity
161) real (kind=real_kind), public :: nu_top = 0.0D5 ! top-of-the-model viscosity
162) real (kind=real_kind), public :: tom_sponge_start=0 ! start of sponge layer, in hPa
163)
164) integer, public :: hypervis_subcycle=1 ! number of subcycles for hyper viscsosity timestep
165) integer, public :: hypervis_subcycle_tom=0 ! number of subcycles for TOM diffusion
166) ! 0 apply together with hyperviscosity
167) ! >1 apply timesplit from hyperviscosity
168) integer, public :: hypervis_subcycle_q=1 ! number of subcycles for hyper viscsosity timestep on TRACERS
169) integer, public :: hypervis_order=0 ! laplace**hypervis_order. 0=not used 1=regular viscosity, 2=grad**4
170)
171) real (kind=real_kind), public :: hypervis_scaling=0 ! use tensor hyperviscosity
172)
173) !three types of hyper viscosity are supported right now:
174) ! (1) const hv: nu * del^2 del^2
175) ! (2) tensor hv, nu * ( \div * tensor * \grad ) * del^2
176) !
177) ! (1) hypervis_scaling=0
178) ! (2) tensor HV var-res grids
179) ! tensor within each element:
180) ! set hypervis_scaling > 0 (typical values would be 3.0)
181) ! (\div * tensor * \grad) operator uses cartesian laplace
182) !
183)
184) ! hyperviscosity parameters used for smoothing topography
185) integer, public :: smooth_phis_numcycle = -1 ! -1 = disable
186) integer, public :: smooth_phis_p2filt = -1 ! -1 = disable
187) real (kind=real_kind), public :: smooth_phis_nudt = 0
188)
189) integer, public :: prescribed_wind=0 ! fix the velocities?
190)
191)
192) integer, public, parameter :: west = 1
193) integer, public, parameter :: east = 2
194) integer, public, parameter :: south = 3
195) integer, public, parameter :: north = 4
196) integer, public, parameter :: swest = 5
197) integer, public, parameter :: seast = 6
198) integer, public, parameter :: nwest = 7
199) integer, public, parameter :: neast = 8
200)
201) logical, public :: disable_diagnostics = .FALSE.
202)
203) ! Physgrid parameters
204) integer, public :: se_fv_phys_remap_alg = 1
205)
206) ! Hommexx-specific parameters
207) integer, public :: internal_diagnostics_level = 0
208)
209)
210) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
211) !
212) ! test case global parameters
213) !
214) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
215) ! generic test case parameter - can be used by any test case to define options
216) integer, public :: sub_case = 1
217)
218) real (kind=real_kind), public :: initial_total_mass = 0 ! initial perturbation in JW test case
219) real (kind=real_kind), public :: u_perturb = 0 ! initial perturbation in JW test case
220) #ifndef CAM
221) real (kind=real_kind), public :: pertlim = 0 !pertibation to temperature [like CESM]
222) #endif
223)
224) ! shallow water advection test paramters
225) ! kmass = level index with density. other levels contain test tracers
226) integer, public :: kmass = -1
227) integer, public :: toy_chemistry = 0 ! 1 = toy chemestry is turned on in 2D advection code
228) real (kind=real_kind), public :: g_sw_output = 9.80616D0 ! m s^-2
229)
230) ! parameters for dcmip12 test 2-0: steady state atmosphere with orography
231) real(real_kind), public :: dcmip2_0_h0 = 2000.d0 ! height of mountain range (meters)
232) real(real_kind), public :: dcmip2_0_Rm = 3.d0*dd_pi/4.d0 ! radius of mountain range (radians)
233) real(real_kind), public :: dcmip2_0_zetam = dd_pi/16.d0 ! mountain oscillation half-width (radians)
234)
235) ! parameters for dcmip12 test 2-x: mountain waves
236) real(real_kind), public :: dcmip2_x_ueq = 20.d0 ! wind speed at equator (m/s)
237) real(real_kind), public :: dcmip2_x_h0 = 250.0d0 ! mountain height (m)
238) real(real_kind), public :: dcmip2_x_d = 5000.0d0 ! mountain half width (m)
239) real(real_kind), public :: dcmip2_x_xi = 4000.0d0 ! mountain wavelength (m)
240)
241) ! for dcmip 2014 test 4:
242) integer, public :: dcmip4_moist = 1
243) real(real_kind), public :: dcmip4_X = 1.0d0
244)
245) ! for dcmip 2016 test 2
246) integer, public :: dcmip16_prec_type = 0;
247) integer, public :: dcmip16_pbl_type = 0;
248)
249) ! for dcmip 2016 test 3
250) real (kind=real_kind), public :: dcmip16_mu = 0 ! additional uniform viscosity (momentum)
251) real (kind=real_kind), public :: dcmip16_mu_s = 0 ! additional uniform viscosity (scalar dynamical variables)
252) real (kind=real_kind), public :: dcmip16_mu_q = -1 ! additional uniform viscosity (scalar tracers); -1 implies it defaults to dcmip16_mu_s value
253) real (kind=real_kind), public :: interp_lon0 = 0.0d0
254)
255) !PLANAR
256) real (kind=real_kind), private, parameter :: tol_zero=1e-10 !tolerance to determine if lx,ly,sx,sy are set
257)
258) real (kind=real_kind), public :: bubble_T0 = 270.0 !bubble ref state
259) real (kind=real_kind), public :: bubble_dT = 0.5 !bubble dTheta
260) real (kind=real_kind), public :: bubble_xycenter = 0.0 !bubble xy position
261) real (kind=real_kind), public :: bubble_zcenter = 3000.0 !bubble z position
262) real (kind=real_kind), public :: bubble_ztop = 10000.0 !bubble z top
263) real (kind=real_kind), public :: bubble_xyradius = 2000.0!bubble radius along x or y axis
264) real (kind=real_kind), public :: bubble_zradius = 1500.0 !bubble radius along z axis
265) logical, public :: bubble_cosine = .TRUE. !bubble uniform or cosine
266) logical, public :: bubble_moist = .FALSE. !
267) real (kind=real_kind), public :: bubble_moist_drh = 0.0 !bubble dRH parameter
268) real (kind=real_kind), public :: bubble_rh_background = 0.0 !bubble RH parameter
269) integer, public :: bubble_prec_type = 0 !0 kessler, 1 rj
270) logical, protected :: case_planar_bubble = .FALSE.
271)
272) public :: set_planar_defaults
273)
274) contains
275)
276) function timestep_make_parameters_consistent(par, rsplit, qsplit, &
277) dt_remap_factor, dt_tracer_factor, tstep, dtime, nsplit, nstep_factor, &
278) abrtf, silent) result(status)
279)
280) ! Current and future development require a more flexibility in
281) ! specifying time steps. This routine analyzes the settings and
282) ! either sets unset ones consistently or provides an error message
283) ! and aborts.
284) ! A return value of 0 means success; <0 means there was an
285) ! error. In the case of error, a message is written to iulog.
286) ! If you want a value to be computed, set it to <0 on input.
287)
288) use parallel_mod, only: abortmp, parallel_t
289) use kinds, only: iulog
290)
291) type (parallel_t), intent(in) :: par
292) integer, intent(inout) :: &
293) ! Old method of specifying subcycles, in which the vertical
294) ! remap time step is restricted to be at least as large as
295) ! the tracer time step.
296) rsplit, qsplit, &
297) ! New method, which permits either time step to be the
298) ! larger, subject to that one must divide the other.
299) dt_remap_factor, dt_tracer_factor, &
300) nsplit
301) integer, intent(out) :: &
302) ! On output, dtime/tstep.
303) nstep_factor
304) real(kind=real_kind), intent(inout) :: &
305) ! Dynamics time step.
306) tstep
307) integer, intent(inout) :: &
308) ! Physics-dynamics coupling time step.
309) dtime
310) logical, intent(in), optional :: abrtf, silent
311) integer :: status
312)
313) real(kind=real_kind), parameter :: &
314) zero = 0.0_real_kind, &
315) eps = epsilon(1.0_real_kind), &
316) divisible_tol = 1e3_real_kind*eps
317)
318) logical :: abort_in, silent_in
319)
320) abort_in = .true.
321) if (present(abrtf)) abort_in = abrtf
322) silent_in = .false.
323) if (present(silent)) silent_in = silent
324)
325) status = timestep_make_subcycle_parameters_consistent( &
326) par, rsplit, qsplit, dt_remap_factor, dt_tracer_factor, &
327) abort_in, silent_in)
328) if (status /= 0) return
329) status = timestep_make_eam_parameters_consistent( &
330) par, dt_remap_factor, dt_tracer_factor, nsplit, nstep_factor, tstep, dtime, &
331) abort_in, silent_in)
332) end function timestep_make_parameters_consistent
333)
334) function timestep_make_subcycle_parameters_consistent(par, rsplit, qsplit, &
335) dt_remap_factor, dt_tracer_factor, abrtf, silent) result(status)
336)
337) use parallel_mod, only: abortmp, parallel_t
338) use kinds, only: iulog
339)
340) type (parallel_t), intent(in) :: par
341) integer, intent(inout) :: rsplit, qsplit, dt_remap_factor, dt_tracer_factor
342) logical, intent(in), optional :: abrtf, silent
343) integer :: status
344)
345) integer :: qsplit_prev, rsplit_prev
346) logical :: split_specified, factor_specified, split_is_master, abort_in, silent_in
347)
348) abort_in = .true.
349) if (present(abrtf)) abort_in = abrtf
350) silent_in = .false.
351) if (present(silent)) silent_in = silent
352)
353) status = -1 ! error value for early returns on error
354)
355) split_specified = rsplit >= 0 .and. qsplit >= 1
356) factor_specified = dt_remap_factor >= 0 .and. dt_tracer_factor >= 1
357)
358) if (.not. split_specified .and. .not. factor_specified) then
359) if (par%masterproc .and. .not. silent_in) then
360) write(iulog,*) 'Neither rsplit,qsplit nor dt_remap_factor,dt_tracer_factor &
361) &are specified; one set must be.'
362) end if
363) if (abort_in) call abortmp('timestep_make_parameters_consistent: input error')
364) return
365) end if
366)
367) !! Process rsplit, qsplit, dt_remap_factor, dt_tracer_factor.
368)
369) ! To support namelists with defaulted qsplit, rsplit values, we
370) ! permit (split_specified .and. factor_specified). In this case,
371) ! factor_specified means factor values are used.
372)
373) split_is_master = .not. factor_specified
374)
375) if (split_is_master) then
376) dt_remap_factor = rsplit*qsplit
377) dt_tracer_factor = qsplit
378) else
379) if (dt_remap_factor > 0) then
380) if (.not. (modulo(dt_remap_factor, dt_tracer_factor) == 0 .or. &
381) modulo(dt_tracer_factor, dt_remap_factor) == 0)) then
382) if (par%masterproc .and. .not. silent_in) then
383) write(iulog,*) 'dt_remap_factor and dt_tracer_factor were specified, &
384) &but neither divides the other.'
385) end if
386) if (abort_in) call abortmp('timestep_make_parameters_consistent: divisibility error')
387) return
388) end if
389) end if
390) qsplit_prev = qsplit
391) rsplit_prev = rsplit
392) qsplit = dt_tracer_factor
393) ! This is the only inconsistent setting. But I want to keep
394) ! this here b/c almost all uses of rsplit is simply for whether
395) ! it's == 0, and I don't want to touch all those lines in this
396) ! PR.
397) if (dt_tracer_factor <= dt_remap_factor) then
398) rsplit = dt_remap_factor/dt_tracer_factor
399) else
400) ! If rsplit cannot be set consistently (because
401) ! dt_tracer_factor < dt_remap_factor), then just preserve
402) ! the sign to distinguish between vertically Eulerian and
403) ! Lagrangian methods.
404) if (dt_remap_factor > 0) then
405) rsplit = 1
406) else
407) rsplit = 0
408) end if
409) end if
410) if (split_specified .and. (qsplit /= qsplit_prev .or. rsplit /= rsplit_prev) .and. &
411) par%masterproc .and. .not. silent_in) then
412) write(iulog,'(a,i2,a,i2,a,i2,a,i2,a)') &
413) 'dt_remap_factor and dt_tracer_factor were specified; changing qsplit from ', &
414) qsplit_prev, ' to ', qsplit, ' and rsplit from ', rsplit_prev, ' to ', rsplit, '.'
415) end if
416) end if
417)
418) status = 0 ! success value
419) end function timestep_make_subcycle_parameters_consistent
420)
421) function timestep_make_eam_parameters_consistent(par, dt_remap_factor, dt_tracer_factor, &
422) nsplit, nstep_factor, tstep, dtime, abrtf, silent) result(status)
423)
424) use parallel_mod, only: abortmp, parallel_t
425) use kinds, only: iulog
426)
427) type (parallel_t), intent(in) :: par
428) integer, intent(in) :: dt_remap_factor, dt_tracer_factor
429) integer, intent(inout) :: nsplit
430) integer, intent(out) :: nstep_factor
431) real(kind=real_kind), intent(inout) :: tstep
432) integer, intent(inout) :: dtime
433) logical, intent(in), optional :: abrtf, silent
434) integer :: status
435)
436) real(kind=real_kind), parameter :: &
437) zero = 0.0_real_kind, &
438) eps = epsilon(1.0_real_kind), &
439) divisible_tol = 1e3_real_kind*eps
440)
441) real(kind=real_kind) :: nsplit_real, tmp
442) integer :: dt_max_factor
443) logical :: abort_in, silent_in
444)
445) abort_in = .true.
446) if (present(abrtf)) abort_in = abrtf
447) silent_in = .false.
448) if (present(silent)) silent_in = silent
449)
450) status = -1 ! error value for early returns on error
451)
452) !! Process dtime, tstep, nsplit.
453) dt_max_factor = max(dt_remap_factor, dt_tracer_factor)
454)
455) ! Every 'if' has an 'else', so every case is covered.
456) if (nsplit > 0) nstep_factor = dt_max_factor*nsplit
457) if (dtime > 0) then
458) if (nsplit > zero) then
459) tmp = real(dtime, real_kind)/real(nstep_factor, real_kind)
460) if (tstep > zero) then
461) if (abs(tstep - tmp) > divisible_tol*tmp) then
462) if (par%masterproc .and. .not. silent_in) then
463) write(iulog,'(a,a,i6,a,i2,a,es11.4,a,i2)') &
464) 'dtime, nsplit, tstep were all >0 on input, but they disagree: ', &
465) 'dtime ', dtime, ' nsplit ', nsplit, ' tstep ', tstep, ' nstep_factor ', nstep_factor
466) end if
467) if (abort_in) call abortmp('timestep_make_parameters_consistent: divisibility error')
468) return
469) end if
470) end if
471) tstep = tmp
472) elseif (tstep > zero) then
473) nsplit_real = real(dtime, real_kind)/(dt_max_factor*tstep)
474) nsplit = idnint(nsplit_real)
475) nstep_factor = dt_max_factor*nsplit
476) if (abs(nsplit_real - nsplit) > divisible_tol*nsplit_real) then
477) if (par%masterproc .and. .not. silent_in) then
478) write(iulog,'(a,es11.4,a,i7,a,es11.4,a,i2,a,i2,a,i2,a)') &
479) 'nsplit was computed as ', nsplit_real, ' based on dtime ', dtime, &
480) ', tstep ', tstep, &
481) ', and dt_max_factor = max(dt_remap_factor, dt_tracer_factor) = max(', &
482) dt_remap_factor, ',', dt_tracer_factor, ') =', dt_max_factor, &
483) ', which is outside the divisibility tolerance. &
484) &Set tstep, dt_remap_factor, and dt_tracer_factor so that &
485) &tstep and dt_max_factor*tstep divide dtime.'
486) end if
487) if (abort_in) call abortmp('timestep_make_parameters_consistent: divisibility error')
488) return
489) end if
490) else
491) if (par%masterproc .and. .not. silent_in) then
492) write(iulog,*) 'If dtime is set to >0, then either nsplit or tstep must be >0.'
493) end if
494) if (abort_in) call abortmp('timestep_make_parameters_consistent: input error')
495) return
496) end if
497) else
498) if (tstep > zero) then
499) if (nsplit > 0) then
500) dtime = tstep*nstep_factor
501) else
502) #ifdef CAM
503) if (par%masterproc .and. .not. silent_in) then
504) write(iulog,*) 'If dtime is set to <=0 and tstep >0, then nsplit must be >0.'
505) end if
506) if (abort_in) call abortmp('timestep_make_parameters_consistent: input error')
507) return
508) #endif
509) end if
510) else
511) if (par%masterproc .and. .not. silent_in) then
512) write(iulog,*) 'If dtime is set to <=0, then tstep must be >0.'
513) end if
514) if (abort_in) call abortmp('timestep_make_parameters_consistent: input error')
515) return
516) end if
517) end if
518)
519) status = 0 ! success value
520) end function timestep_make_eam_parameters_consistent
521)
522) subroutine test_timestep_make_parameters_consistent(par, nerr)
523) ! Test timestep_make_parameters_consistent.
524)
525) use parallel_mod, only: parallel_t
526) use kinds, only: iulog
527)
528) type (parallel_t), intent(in) :: par
529) integer, intent(out) :: nerr
530)
531) real(real_kind), parameter :: eps = epsilon(1.0_real_kind), tol = 1e3_real_kind*eps
532)
533) real(real_kind) :: tstep
534) integer :: i, rs, qs, drf, dtf, ns, nstep_fac, dtime
535) logical :: a, s
536)
537) a = .false.
538) nerr = 0
539)
540) !! Test backwards compatibility.
541) dtime = 1800
542)
543) qs = 3; rs = 0; drf = -1; dtf = -1
544) tstep = -1; ns = 2
545) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a)
546) if (i /= 0 .or. drf /= 0 .or. dtf /= qs .or. nstep_fac /= qs*ns .or. &
547) abs(tstep - dtime/(ns*qs)) > tol) &
548) nerr = nerr + 1
549)
550) qs = 3; rs = 2; drf = -1; dtf = -1
551) tstep = -1; ns = 3
552) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a)
553) if (i /= 0 .or. drf /= qs*rs .or. dtf /= qs .or. nstep_fac /= qs*rs*ns .or. &
554) abs(tstep - dtime/(qs*rs*ns)) > tol) &
555) nerr = nerr + 1
556)
557) !! Test new interface.
558) tstep = 300_real_kind
559)
560) qs = -1; rs = -1; drf = 0; dtf = 6
561) dtime = -1; ns = 2
562) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a)
563) if (i /= 0 .or. rs /= drf .or. qs /= dtf .or. nstep_fac /= dtf*ns .or. &
564) abs(tstep - dtime/(ns*qs)) > tol) &
565) nerr = nerr + 1
566)
567) qs = -1; rs = -1; drf = 12; dtf = 6
568) dtime = -1; ns = 3
569) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a)
570) if (i /= 0 .or. rs /= 2 .or. qs /= 6 .or. nstep_fac /= qs*rs*ns .or. &
571) abs(tstep - dtime/(qs*rs*ns)) > tol) &
572) nerr = nerr + 1
573)
574) qs = -1; rs = -1; drf = 12; dtf = 6
575) tstep = 300_real_kind; dtime = 7200; ns = -1
576) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a)
577) if (i /= 0 .or. rs /= 2 .or. qs /= 6 .or. nstep_fac /= qs*rs*ns .or. ns /= 2 .or. &
578) abs(tstep - dtime/(qs*rs*ns)) > tol) &
579) nerr = nerr + 1
580)
581) !! Test new interface with new time step flexibility.
582) qs = -1; rs = -1; drf = 2; dtf = 6
583) dtime = -1; ns = 3
584) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a)
585) if (i /= 0 .or. rs == 0 .or. qs /= 6 .or. nstep_fac /= dtf*ns .or. &
586) abs(tstep - dtime/(dtf*ns)) > tol) &
587) nerr = nerr + 1
588)
589) !! Test error and warning conditions.
590) ! Silence messages in this unit test since we're forcing them.
591) s = .true.
592)
593) qs = -1; rs = 0; drf = -1; dtf = -1
594) tstep = -1; ns = 2
595) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a,s)
596) if (i == 0) nerr = nerr + 1
597)
598) qs = -1; rs = 0; drf = 3; dtf = 4
599) tstep = -1; ns = 2
600) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a,s)
601) if (i == 0) nerr = nerr + 1
602)
603) qs = -1; rs = 0; drf = 1; dtf = 4
604) tstep = 300; dtime = 700; ns = 1
605) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a,s)
606) if (i == 0) nerr = nerr + 1
607)
608) qs = -1; rs = 0; drf = 1; dtf = 4
609) tstep = 300; dtime = 700; ns = -1
610) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a,s)
611) if (i == 0) nerr = nerr + 1
612)
613) qs = -1; rs = 0; drf = 1; dtf = 4
614) tstep = -1; dtime = 700; ns = -1
615) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a,s)
616) if (i == 0) nerr = nerr + 1
617)
618) qs = -1; rs = 0; drf = 1; dtf = 4
619) tstep = -1; dtime = -1; ns = 2
620) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a,s)
621) if (i == 0) nerr = nerr + 1
622)
623) !! Test warning conditions.
624) qs = 4; rs = 0; drf = 3; dtf = 6
625) tstep = -1; dtime = 1800; ns = 2
626) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a,s)
627) if (i /= 0 .or. qs /= dtf .or. rs /= 1) nerr = nerr + 1
628)
629) qs = 4; rs = 0; drf = 12; dtf = 6
630) tstep = -1; dtime = 1800; ns = 2
631) i = timestep_make_parameters_consistent(par,rs,qs,drf,dtf,tstep,dtime,ns,nstep_fac,a,s)
632) if (i /= 0 .or. qs /= dtf .or. rs /= 2) nerr = nerr + 1
633)
634) if (par%masterproc .and. nerr > 0) &
635) write(iulog,'(a,i2)') 'test_timestep_make_parameters_consistent nerr', nerr
636) end subroutine test_timestep_make_parameters_consistent
637)
638)
639) subroutine set_planar_defaults()
640)
641) use physical_constants, only: Lx, Ly, Sx, Sy
642)
643) !since defaults here depend on test, they cannot be set before ctl_nl is read, unlike some other parameters, bubble_*, etc.
644) !if true, most likely lx,ly,sx,sy weren't set in ctl_nl
645) if ( abs(lx).le.tol_zero .and. abs(ly).le.tol_zero &
646) .and. abs(sx).le.tol_zero .and. abs(sy).le.tol_zero )then
647) if (test_case == "planar_dbl_vrtx") then
648) Lx = 5000.0D0 * 1000.0D0
649) Ly = 5000.0D0 * 1000.0D0
650) Sx = 0.0D0
651) Sy = 0.0D0
652) else if (test_case == "planar_hydro_gravity_wave") then
653) Lx = 6000.0D0 * 1000.0D0
654) Ly = 6000.0D0 * 1000.0D0
655) Sx = -3000.0D0 * 1000.0D0
656) Sy = -3000.0D0 * 1000.0D0
657) else if (test_case == "planar_nonhydro_gravity_wave") then
658) Lx = 300.0D0 * 1000.0D0
659) Ly = 300.0D0 * 1000.0D0
660) Sx = -150.0D0 * 1000.0D0
661) Sy = -150.0D0 * 1000.0D0
662) else if (test_case == "planar_hydro_mtn_wave") then
663) Lx = 240.0D0 * 1000.0D0
664) Ly = 240.0D0 * 1000.0D0
665) Sx = 0.0D0 * 1000.0D0
666) Sy = 0.0D0 * 1000.0D0
667) else if (test_case == "planar_nonhydro_mtn_wave") then
668) Lx = 144.0D0 * 1000.0D0
669) Ly = 144.0D0 * 1000.0D0
670) Sx = 0.0D0 * 1000.0D0
671) Sy = 0.0D0 * 1000.0D0
672) else if (test_case == "planar_schar_mtn_wave") then
673) Lx = 100.0D0 * 1000.0D0
674) Ly = 100.0D0 * 1000.0D0
675) Sx = 0.0D0 * 1000.0D0
676) Sy = 0.0D0 * 1000.0D0
677) else if (test_case == "planar_density_current" .OR. test_case == "planar_moist_density_current") then
678) Lx = 51.2D0 * 1000.0D0
679) Ly = 51.2D0 * 1000.0D0
680) Sx = -25.6D0 * 1000.0D0
681) Sy = -25.6D0 * 1000.0D0
682) else if (test_case == "planar_rising_bubble" ) then
683) Lx = 2.0D0 * 10000.0D0
684) Ly = 2.0D0 * 10000.0D0
685) Sx = -10000.0D0
686) Sy = -10000.0D0
687) ! THESE ARE WRONG AND NEED TO BE FIXED WHEN THESE CASES ARE ACTUALLY IMPLEMENTED....
688) !else if (test_case == "planar_baroclinic_instab" .OR. test_case == "planar_moist_baroclinic_instab") then
689) ! Lx = 5000.0D0 * 1000.0D0
690) ! Ly = 5000.0D0 * 1000.0D0
691) ! Sx = 0.0D0
692) ! Sy = 0.0D0
693) ! else if (test_case == "planar_tropical_cyclone") then
694) ! Lx = 5000.0D0 * 1000.0D0
695) ! Ly = 5000.0D0 * 1000.0D0
696) ! Sx = 0.0D0
697) ! Sy = 0.0D0
698) ! else if (test_case == "planar_supercell") then
699) ! Lx = 5000.0D0 * 1000.0D0
700) ! Ly = 5000.0D0 * 1000.0D0
701) ! Sx = 0.0D0
702) ! Sy = 0.0D0
703)
704) endif
705) endif !if lx,ly,sx,sy are not set in nl
706)
707) if (test_case == "planar_rising_bubble" ) then
708) case_planar_bubble = .TRUE.
709) end if
710)
711) end subroutine set_planar_defaults
712)
713) end module control_mod
