SCALE-RM
mod_atmos_dyn_driver.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use scale_precision
17  use scale_io
18  use scale_prof
20  use scale_index
21  use scale_tracer
22  !-----------------------------------------------------------------------------
23  implicit none
24  private
25  !-----------------------------------------------------------------------------
26  !
27  !++ Public procedure
28  !
29  public :: atmos_dyn_driver_setup
30  public :: atmos_dyn_driver
31 
32  !-----------------------------------------------------------------------------
33  !
34  !++ Public parameters & variables
35  !
36  character(len=H_SHORT), public :: atmos_dyn_tstep_large_type = 'FVM-HEVE'
37  character(len=H_SHORT), public :: atmos_dyn_tstep_tracer_type = 'FVM-HEVE'
38 
39  character(len=H_SHORT), public :: atmos_dyn_tinteg_large_type = 'EULER' ! Type of time integration
40  ! 'RK3'
41  character(len=H_SHORT), public :: atmos_dyn_tinteg_short_type = 'RK4'
42  ! 'RK3WS2002'
43  ! 'RK3'
44  ! 'RK7s6o' (only for FVM-HEVE)
45  character(len=H_SHORT), public :: atmos_dyn_tinteg_tracer_type = 'RK3WS2002'
46  ! 'EULER'
47 
48  character(len=H_SHORT), public :: atmos_dyn_fvm_flux_type = 'CD4' ! Type of advective flux scheme (FVM)
49  character(len=H_SHORT), public :: atmos_dyn_fvm_flux_tracer_type = 'UD3KOREN1993'
50  ! 'CD2'
51  ! 'UD3'
52  ! 'CD4'
53  ! 'UD5'
54  ! 'CD6'
55 
56  !-----------------------------------------------------------------------------
57  !
58  !++ Private procedure
59  !
60  !-----------------------------------------------------------------------------
61  !
62  !++ Private parameters & variables
63  !
64  ! Numerical filter
65  integer, private :: atmos_dyn_numerical_diff_laplacian_num = 2
66  real(rp), private :: atmos_dyn_numerical_diff_coef = 1.0e-4_rp ! nondimensional numerical diffusion
67  real(rp), private :: atmos_dyn_numerical_diff_coef_tracer = 0.0_rp ! nondimensional numerical diffusion for tracer
68  real(rp), private :: atmos_dyn_numerical_diff_sfc_fact = 1.0_rp
69  logical , private :: atmos_dyn_numerical_diff_use_refstate = .true.
70 
71  real(rp), private :: atmos_dyn_wdamp_tau = -1.0_rp ! maximum tau for Rayleigh damping of w [s]
72  real(rp), private :: atmos_dyn_wdamp_height = -1.0_rp ! height to start apply Rayleigh damping [m]
73  integer, private :: atmos_dyn_wdamp_layer = -1 ! layer number to start apply Rayleigh damping [num]
74 
75  ! Divergence damping
76  real(rp), private :: atmos_dyn_divdmp_coef = 0.0_rp ! Divergence dumping coef
77 
78  ! Flux-Corrected Transport limiter
79  logical, private :: atmos_dyn_flag_tracer_split_tend = .false.
80  logical, private :: atmos_dyn_flag_fct_momentum = .false.
81  logical, private :: atmos_dyn_flag_fct_t = .false.
82  logical, private :: atmos_dyn_flag_fct_tracer = .false.
83  logical, private :: atmos_dyn_flag_fct_along_stream = .true.
84 
85  !-----------------------------------------------------------------------------
86 contains
87  !-----------------------------------------------------------------------------
89  subroutine atmos_dyn_driver_setup
90  use scale_prc, only: &
91  prc_abort
92  use scale_atmos_grid_cartesc, only: &
93  domain_center_y => atmos_grid_cartesc_domain_center_y, &
94  cy => atmos_grid_cartesc_cy, &
95  fz => atmos_grid_cartesc_fz, &
96  cdz => atmos_grid_cartesc_cdz, &
97  cdx => atmos_grid_cartesc_cdx, &
98  cdy => atmos_grid_cartesc_cdy, &
99  fdz => atmos_grid_cartesc_fdz, &
100  fdx => atmos_grid_cartesc_fdx, &
102  use scale_atmos_grid_cartesc_real, only: &
103  real_lat => atmos_grid_cartesc_real_lat
104  use scale_time, only: &
106  use mod_atmos_admin, only: &
107  atmos_sw_dyn, &
109  use mod_atmos_vars, only: &
110  dens, &
111  momz, &
112  momx, &
113  momy, &
114  rhot, &
115  qtrc
116  use mod_atmos_dyn_vars, only: &
117  prog
118  use scale_atmos_dyn, only: &
120  implicit none
121 
122  namelist / param_atmos_dyn / &
128  atmos_dyn_numerical_diff_laplacian_num, &
129  atmos_dyn_numerical_diff_coef, &
130  atmos_dyn_numerical_diff_coef_tracer, &
131  atmos_dyn_numerical_diff_sfc_fact, &
132  atmos_dyn_numerical_diff_use_refstate, &
133  atmos_dyn_wdamp_tau, &
134  atmos_dyn_wdamp_height, &
135  atmos_dyn_wdamp_layer, &
136  atmos_dyn_divdmp_coef, &
137  atmos_dyn_flag_tracer_split_tend, &
138  atmos_dyn_flag_fct_momentum, &
139  atmos_dyn_flag_fct_t, &
140  atmos_dyn_flag_fct_tracer, &
141  atmos_dyn_flag_fct_along_stream
142 
143  real(rp) :: dt
144  integer :: ierr
145  !---------------------------------------------------------------------------
146 
147  log_newline
148  log_info("ATMOS_DYN_driver_setup",*) 'Setup'
149 
150  if ( atmos_sw_dyn ) then
151 
152  !--- read namelist
153  rewind(io_fid_conf)
154  read(io_fid_conf,nml=param_atmos_dyn,iostat=ierr)
155  if( ierr < 0 ) then !--- missing
156  log_info("ATMOS_DYN_driver_setup",*) 'Not found namelist. Default used.'
157  elseif( ierr > 0 ) then !--- fatal error
158  log_error("ATMOS_DYN_driver_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_DYN. Check!'
159  call prc_abort
160  endif
161  log_nml(param_atmos_dyn)
162 
163  dt = real(time_dtsec_atmos_dyn,kind=rp)
164 
165  if ( atmos_dyn_wdamp_layer > kmax ) then
166  log_error("ATMOS_DYN_driver_setup",*) 'ATMOS_DYN_wdamp_layer should be less than total number of vertical layer(KA). Check!'
167  call prc_abort
168  elseif( atmos_dyn_wdamp_layer > 0 ) then
169  atmos_dyn_wdamp_height = fz(atmos_dyn_wdamp_layer+ks-1)
170  endif
171 
172  if ( atmos_dyn_wdamp_tau < 0.0_rp ) then
173  atmos_dyn_wdamp_tau = dt * 10.0_rp
174  elseif ( atmos_dyn_wdamp_tau < dt ) then
175  log_error("ATMOS_DYN_driver_setup",*) 'ATMOS_DYN_wdamp_tau should be larger than TIME_DT_ATMOS_DYN. Check!'
176  call prc_abort
177  end if
178 
179  if ( atmos_sw_dyn ) then
180  log_newline
181  log_info("ATMOS_DYN_driver_setup",*) 'Scheme for Large time step : ', trim(atmos_dyn_tinteg_large_type)
182  log_info("ATMOS_DYN_driver_setup",*) 'Scheme for Short time step : ', trim(atmos_dyn_tinteg_short_type)
183  log_info("ATMOS_DYN_driver_setup",*) 'Scheme for Tracer advection : ', trim(atmos_dyn_tinteg_tracer_type)
184  endif
185 
191  atmos_dyn_type, & ! [IN] Note that ATMOS_DYN_TYPE corresponds to ATMOS_DYN_TSTEP_SHORT_TYPE.
192  atmos_dyn_fvm_flux_type, & ! [IN]
194  dens, momz, momx, momy, rhot, qtrc, & ! [IN]
195  prog, & ! [IN]
196  cdz, cdx, cdy, fdz, fdx, fdy, & ! [IN]
197  atmos_dyn_wdamp_tau, & ! [IN]
198  atmos_dyn_wdamp_height, & ! [IN]
199  fz, & ! [IN]
200  none = atmos_dyn_type=='NONE' ) ! [IN]
201  endif
202 
203  return
204  end subroutine atmos_dyn_driver_setup
205 
206  !-----------------------------------------------------------------------------
208  subroutine atmos_dyn_driver( do_flag )
209  use scale_prc_cartesc, only: &
210  prc_twod
211  use scale_atmos_grid_cartesc, only: &
212  cdz => atmos_grid_cartesc_cdz, &
213  cdx => atmos_grid_cartesc_cdx, &
214  cdy => atmos_grid_cartesc_cdy, &
215  fdz => atmos_grid_cartesc_fdz, &
216  fdx => atmos_grid_cartesc_fdx, &
217  fdy => atmos_grid_cartesc_fdy, &
218  rcdz => atmos_grid_cartesc_rcdz, &
219  rcdx => atmos_grid_cartesc_rcdx, &
220  rcdy => atmos_grid_cartesc_rcdy, &
221  rfdz => atmos_grid_cartesc_rfdz, &
222  rfdx => atmos_grid_cartesc_rfdx, &
224  use scale_atmos_grid_cartesc_real, only: &
225  real_phi => atmos_grid_cartesc_real_phi
232  use scale_time, only: &
233  time_dtsec, &
235  use mod_atmos_admin, only: &
237  use scale_atmos_hydrometeor, only: &
238  i_qv
239  use mod_atmos_vars, only: &
241  dens, &
242  momz, &
243  momx, &
244  momy, &
245  rhot, &
246  qtrc, &
247  dens_av, &
248  momz_av, &
249  momx_av, &
250  momy_av, &
251  rhot_av, &
252  qtrc_av, &
253  dens_tp, &
254  rhou_tp, &
255  rhov_tp, &
256  rhot_tp, &
257  rhoq_tp, &
258  rhoh_p, &
259  momz_tp, &
260  momx_tp, &
261  momy_tp, &
262  cptot, &
263  exner
264  use mod_atmos_dyn_vars, only: &
265  prog
266  use scale_coriolis, only: &
267  coriolis_f
268  use scale_atmos_refstate, only: &
273  use mod_atmos_bnd_driver, only: &
288  bnd_qa, &
289  bnd_iq, &
291  use scale_atmos_dyn, only: &
292  atmos_dyn
293  use scale_comm_cartesc, only: &
294  comm_vars8, &
295  comm_wait
296  implicit none
297 
298  logical, intent(in) :: do_flag
299 
300  integer :: k, i, j, iq
301  !---------------------------------------------------------------------------
302 
303 #if defined DEBUG || defined QUICKDEBUG
304  rhot_tp( 1:ks-1,:,:) = 0.0_rp
305  rhot_tp(ke+1:ka, :,:) = 0.0_rp
306  momx_tp( 1:ks-1,:,:) = 0.0_rp
307  momx_tp(ke+1:ka, :,:) = 0.0_rp
308  momy_tp( 1:ks-1,:,:) = 0.0_rp
309  momy_tp(ke+1:ka, :,:) = 0.0_rp
310 #endif
311 
312  if ( do_flag ) then
313 
314  if ( .not. prc_twod ) &
315  call comm_vars8( rhou_tp, 1 )
316  call comm_vars8( rhov_tp, 2 )
317  call comm_vars8( momz_tp, 3 )
318  do iq = 1, qa
319  call comm_vars8( rhoq_tp(:,:,:,iq), 4+iq)
320  end do
321 
322  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
323  !$omp private(k,i,j) &
324  !$omp shared (KA,KS,KE,IS,IE,JS,JE, &
325  !$omp RHOT_tp,RHOH_p,CPtot,EXNER)
326  do j = js, je
327  do i = is, ie
328  do k = ks, ke
329  rhot_tp(k,i,j) = rhot_tp(k,i,j) &
330  + rhoh_p(k,i,j) / ( cptot(k,i,j) * exner(k,i,j) )
331  end do
332  end do
333  end do
334  call comm_vars8( rhot_tp, 4 )
335 
336  if ( prc_twod ) then
337  !$omp parallel do default(none) OMP_SCHEDULE_ &
338  !$omp private(k,j) &
339  !$omp shared (KA,KS,KE,IS,JS,JE, &
340  !$omp MOMX_tp,RHOU_tp)
341  do j = js, je
342  do k = ks, ke
343  momx_tp(k,is,j) = momx_tp(k,is,j) + rhou_tp(k,is,j)
344  end do
345  end do
346  else
347  call comm_wait ( rhou_tp, 1 )
348  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
349  !$omp private(k,i,j) &
350  !$omp shared (KA,KS,KE,IS,IE,JS,JE, &
351  !$omp MOMX_tp,RHOU_tp)
352  do j = js, je
353  do i = is, ie
354  do k = ks, ke
355  momx_tp(k,i,j) = momx_tp(k,i,j) &
356  + 0.5_rp * ( rhou_tp(k,i,j) + rhou_tp(k,i+1,j) )
357  end do
358  end do
359  end do
360  call comm_vars8( momx_tp, 1 )
361  end if
362 
363  call comm_wait ( rhov_tp, 2 )
364  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
365  !$omp private(k,i,j) &
366  !$omp shared (KA,KS,KE,IS,IE,JS,JE, &
367  !$omp MOMY_tp,RHOV_tp)
368  do j = js, je
369  do i = is, ie
370  do k = ks, ke
371  momy_tp(k,i,j) = momy_tp(k,i,j) &
372  + 0.5_rp * ( rhov_tp(k,i,j) + rhov_tp(k,i,j+1) )
373  end do
374  end do
375  end do
376  call comm_vars8( momy_tp, 2 )
377 
378  call comm_wait ( momz_tp, 3 )
379  call comm_wait ( rhot_tp, 4, .false. )
380  do iq = 1, qa
381  call comm_wait ( rhoq_tp(:,:,:,iq), 4+iq, .false. )
382  end do
383  if ( .not. prc_twod ) &
384  call comm_wait ( momx_tp, 1 )
385  call comm_wait ( momy_tp, 2 )
386 
387 
388  call atmos_dyn( dens, momz, momx, momy, rhot, qtrc, & ! [INOUT]
389  prog, & ! [IN]
390  dens_av, momz_av, momx_av, momy_av, rhot_av, qtrc_av, & ! [INOUT]
392  coriolis_f, & ! [IN]
393  cdz, cdx, cdy, fdz, fdx, fdy, & ! [IN]
394  rcdz, rcdx, rcdy, rfdz, rfdx, rfdy, & ! [IN]
395  real_phi, & ! [IN]
396  gsqrt, j13g, j23g, j33g, mapf, & ! [IN]
398  atmos_refstate_dens, & ! [IN]
399  atmos_refstate_pott, & ! [IN]
400  atmos_refstate_qv, & ! [IN]
401  atmos_refstate_pres, & ! [IN]
402  atmos_dyn_numerical_diff_coef, & ! [IN]
403  atmos_dyn_numerical_diff_coef_tracer, & ! [IN]
404  atmos_dyn_numerical_diff_laplacian_num, & ! [IN]
405  atmos_dyn_numerical_diff_sfc_fact, & ! [IN]
406  atmos_dyn_numerical_diff_use_refstate, & ! [IN]
408  atmos_boundary_dens, & ! [IN]
409  atmos_boundary_velz, & ! [IN]
410  atmos_boundary_velx, & ! [IN]
411  atmos_boundary_vely, & ! [IN]
412  atmos_boundary_pott, & ! [IN]
413  atmos_boundary_qtrc, & ! [IN]
414  atmos_boundary_alpha_dens, & ! [IN]
415  atmos_boundary_alpha_velz, & ! [IN]
416  atmos_boundary_alpha_velx, & ! [IN]
417  atmos_boundary_alpha_vely, & ! [IN]
418  atmos_boundary_alpha_pott, & ! [IN]
419  atmos_boundary_alpha_qtrc, & ! [IN]
422  atmos_dyn_divdmp_coef, & ! [IN]
423  atmos_dyn_flag_tracer_split_tend, & ! [IN]
424  atmos_dyn_flag_fct_momentum, & ! [IN]
425  atmos_dyn_flag_fct_t, & ! [IN]
426  atmos_dyn_flag_fct_tracer, & ! [IN]
427  atmos_dyn_flag_fct_along_stream, & ! [IN]
428  atmos_use_average, & ! [IN]
429  i_qv, & ! [IN]
430  time_dtsec, & ! [IN]
431  time_dtsec_atmos_dyn ) ! [IN]
432 
433  call atmos_vars_check
434  endif
435 
436  return
437  end subroutine atmos_dyn_driver
438 
439 end module mod_atmos_dyn_driver
mod_atmos_vars::momz_av
real(rp), dimension(:,:,:), pointer, public momz_av
Definition: mod_atmos_vars.F90:90
scale_atmos_grid_cartesc_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:52
mod_atmos_bnd_driver::atmos_boundary_alpha_pott
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_pott
Definition: mod_atmos_bnd_driver.F90:56
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
mod_atmos_dyn_vars
module Atmosphere / Dynamics
Definition: mod_atmos_dyn_vars.F90:12
mod_atmos_dyn_driver::atmos_dyn_tstep_large_type
character(len=h_short), public atmos_dyn_tstep_large_type
Definition: mod_atmos_dyn_driver.F90:36
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:34
mod_atmos_vars::momx_av
real(rp), dimension(:,:,:), pointer, public momx_av
Definition: mod_atmos_vars.F90:91
scale_atmos_grid_cartesc::atmos_grid_cartesc_cdz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cdz
z-length of control volume [m]
Definition: scale_atmos_grid_cartesC.F90:42
mod_atmos_vars::rhoq_tp
real(rp), dimension(:,:,:,:), allocatable, public rhoq_tp
Definition: mod_atmos_vars.F90:120
scale_index
module Index
Definition: scale_index.F90:11
scale_tracer::tracer_mass
real(rp), dimension(qa_max), public tracer_mass
Definition: scale_tracer.F90:46
scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdx
reciprocal of face-dx
Definition: scale_atmos_grid_cartesC.F90:67
mod_atmos_dyn_driver::atmos_dyn_tinteg_large_type
character(len=h_short), public atmos_dyn_tinteg_large_type
Definition: mod_atmos_dyn_driver.F90:39
mod_atmos_admin::atmos_use_average
logical, public atmos_use_average
Definition: mod_atmos_admin.F90:49
mod_atmos_vars::qtrc_av
real(rp), dimension(:,:,:,:), pointer, public qtrc_av
Definition: mod_atmos_vars.F90:94
scale_atmos_refstate::atmos_refstate_dens
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_dens
refernce density [kg/m3]
Definition: scale_atmos_refstate.F90:40
mod_atmos_dyn_driver::atmos_dyn_fvm_flux_tracer_type
character(len=h_short), public atmos_dyn_fvm_flux_tracer_type
Definition: mod_atmos_dyn_driver.F90:49
mod_atmos_dyn_vars::prog
real(rp), dimension(:,:,:,:), allocatable, public prog
Definition: mod_atmos_dyn_vars.F90:58
scale_precision
module PRECISION
Definition: scale_precision.F90:14
mod_atmos_vars::rhov_tp
real(rp), dimension(:,:,:), allocatable, public rhov_tp
Definition: mod_atmos_vars.F90:117
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
scale_atmos_dyn
module Atmosphere / Dynamics FENT + FCT
Definition: scale_atmos_dyn.F90:13
mod_atmos_admin
module ATMOS admin
Definition: mod_atmos_admin.F90:11
scale_coriolis
module Coriolis
Definition: scale_coriolis.F90:12
scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdx
reciprocal of center-dx
Definition: scale_atmos_grid_cartesC.F90:65
mod_atmos_vars::cptot
real(rp), dimension(:,:,:), allocatable, target, public cptot
Definition: mod_atmos_vars.F90:142
mod_atmos_admin::atmos_sw_dyn
logical, public atmos_sw_dyn
Definition: mod_atmos_admin.F90:51
scale_atmos_refstate::atmos_refstate_pres
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_pres
refernce pressure [Pa]
Definition: scale_atmos_refstate.F90:38
scale_atmos_grid_cartesc_metric
module Atmosphere Grid CartesianC metirc
Definition: scale_atmos_grid_cartesC_metric.F90:12
mod_atmos_vars::rhot_av
real(rp), dimension(:,:,:), pointer, public rhot_av
Definition: mod_atmos_vars.F90:93
scale_atmos_hydrometeor
module atmosphere / hydrometeor
Definition: scale_atmos_hydrometeor.F90:12
scale_atmos_grid_cartesc::atmos_grid_cartesc_cdy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cdy
y-length of control volume [m]
Definition: scale_atmos_grid_cartesC.F90:61
scale_atmos_refstate
module atmosphere / reference state
Definition: scale_atmos_refstate.F90:12
scale_atmos_refstate::atmos_refstate_pott
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_pott
refernce potential temperature [K]
Definition: scale_atmos_refstate.F90:41
mod_atmos_bnd_driver::atmos_boundary_dens
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_dens
Definition: mod_atmos_bnd_driver.F90:45
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdy
y-length of grid(j+1) to grid(j) [m]
Definition: scale_atmos_grid_cartesC.F90:63
mod_atmos_bnd_driver::atmos_boundary_alpha_dens
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_dens
Definition: mod_atmos_bnd_driver.F90:52
mod_atmos_bnd_driver::atmos_boundary_qtrc
real(rp), dimension(:,:,:,:), allocatable, public atmos_boundary_qtrc
Definition: mod_atmos_bnd_driver.F90:50
mod_atmos_bnd_driver::atmos_boundary_velx
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_velx
Definition: mod_atmos_bnd_driver.F90:47
scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdz
reciprocal of center-dz
Definition: scale_atmos_grid_cartesC.F90:44
mod_atmos_vars::rhot
real(rp), dimension(:,:,:), allocatable, target, public rhot
Definition: mod_atmos_vars.F90:79
mod_atmos_vars::atmos_vars_check
subroutine, public atmos_vars_check(force)
Check variables for atmosphere.
Definition: mod_atmos_vars.F90:1383
scale_atmos_grid_cartesc_real
module Atmosphere GRID CartesC Real(real space)
Definition: scale_atmos_grid_cartesC_real.F90:11
mod_atmos_vars::qtrc
real(rp), dimension(:,:,:,:), allocatable, target, public qtrc
Definition: mod_atmos_vars.F90:80
scale_atmos_refstate::atmos_refstate_qv
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_qv
refernce vapor [kg/kg]
Definition: scale_atmos_refstate.F90:42
scale_atmos_grid_cartesc::atmos_grid_cartesc_domain_center_y
real(rp), public atmos_grid_cartesc_domain_center_y
center position of global domain [m]: y
Definition: scale_atmos_grid_cartesC.F90:91
scale_prc
module PROCESS
Definition: scale_prc.F90:11
mod_atmos_bnd_driver::atmos_boundary_pott
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_pott
Definition: mod_atmos_bnd_driver.F90:49
scale_atmos_dyn::atmos_dyn_setup
subroutine, public atmos_dyn_setup(DYN_Tinteg_Short_TYPE, DYN_Tinteg_Tracer_TYPE, DYN_Tinteg_Large_TYPE, DYN_Tstep_Tracer_TYPE, DYN_Tstep_Large_TYPE, DYN_Tstep_Short_TYPE, DYN_FVM_FLUX_TYPE, DYN_FVM_FLUX_TYPE_TRACER, DENS, MOMZ, MOMX, MOMY, RHOT, QTRC, PROG, CDZ, CDX, CDY, FDZ, FDX, FDY, wdamp_tau, wdamp_height, FZ, none)
Setup.
Definition: scale_atmos_dyn.F90:94
mod_atmos_vars::rhou_tp
real(rp), dimension(:,:,:), allocatable, public rhou_tp
Definition: mod_atmos_vars.F90:116
scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_mapf
real(rp), dimension(:,:,:,:), allocatable, public atmos_grid_cartesc_metric_mapf
map factor
Definition: scale_atmos_grid_cartesC_metric.F90:34
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
scale_atmos_grid_cartesc_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:54
scale_io
module STDIO
Definition: scale_io.F90:10
scale_atmos_grid_cartesc::atmos_grid_cartesc_rcdy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdy
reciprocal of center-dy
Definition: scale_atmos_grid_cartesC.F90:66
mod_atmos_vars::dens
real(rp), dimension(:,:,:), allocatable, target, public dens
Definition: mod_atmos_vars.F90:75
mod_atmos_dyn_driver
module Atmosphere / Dynamics
Definition: mod_atmos_dyn_driver.F90:11
mod_atmos_bnd_driver::atmos_boundary_alpha_vely
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_vely
Definition: mod_atmos_bnd_driver.F90:55
scale_tracer::k
real(rp), public k
Definition: scale_tracer.F90:44
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
mod_atmos_vars::momz
real(rp), dimension(:,:,:), allocatable, target, public momz
Definition: mod_atmos_vars.F90:76
scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_gsqrt
real(rp), dimension(:,:,:,:), allocatable, public atmos_grid_cartesc_metric_gsqrt
transformation metrics from Z to Xi, {G}^1/2
Definition: scale_atmos_grid_cartesC_metric.F90:37
scale_atmos_grid_cartesc_index::kmax
integer, public kmax
Definition: scale_atmos_grid_cartesC_index.F90:36
mod_atmos_bnd_driver::bnd_iq
integer, dimension(:), allocatable, public bnd_iq
Definition: mod_atmos_bnd_driver.F90:43
mod_atmos_bnd_driver::bnd_qa
integer, public bnd_qa
Definition: mod_atmos_bnd_driver.F90:42
mod_atmos_vars::momy_av
real(rp), dimension(:,:,:), pointer, public momy_av
Definition: mod_atmos_vars.F90:92
scale_tracer::tracer_cv
real(rp), dimension(qa_max), public tracer_cv
Definition: scale_tracer.F90:41
scale_prc_cartesc
module process / cartesC
Definition: scale_prc_cartesC.F90:11
mod_atmos_bnd_driver
module ATMOSPHERE / Boundary treatment
Definition: mod_atmos_bnd_driver.F90:13
mod_atmos_bnd_driver::atmos_boundary_smoother_fact
real(rp), public atmos_boundary_smoother_fact
Definition: mod_atmos_bnd_driver.F90:62
scale_prof
module profiler
Definition: scale_prof.F90:11
mod_atmos_vars::momz_tp
real(rp), dimension(:,:,:), allocatable, public momz_tp
Definition: mod_atmos_vars.F90:115
mod_atmos_dyn_driver::atmos_dyn_tinteg_tracer_type
character(len=h_short), public atmos_dyn_tinteg_tracer_type
Definition: mod_atmos_dyn_driver.F90:45
mod_atmos_vars::momx
real(rp), dimension(:,:,:), allocatable, target, public momx
Definition: mod_atmos_vars.F90:77
mod_atmos_bnd_driver::atmos_boundary_alpha_velz
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_velz
Definition: mod_atmos_bnd_driver.F90:53
mod_atmos_vars::exner
real(rp), dimension(:,:,:), allocatable, target, public exner
Definition: mod_atmos_vars.F90:135
scale_atmos_grid_cartesc_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:53
scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_j23g
real(rp), dimension(:,:,:,:), allocatable, public atmos_grid_cartesc_metric_j23g
(2,3) element of Jacobian matrix * {G}^1/2
Definition: scale_atmos_grid_cartesC_metric.F90:39
scale_time::time_dtsec_atmos_dyn
real(dp), public time_dtsec_atmos_dyn
time interval of dynamics [sec]
Definition: scale_time.F90:35
mod_atmos_vars::dens_tp
real(rp), dimension(:,:,:), allocatable, public dens_tp
Definition: mod_atmos_vars.F90:114
mod_atmos_vars::momy
real(rp), dimension(:,:,:), allocatable, target, public momy
Definition: mod_atmos_vars.F90:78
scale_time
module TIME
Definition: scale_time.F90:11
mod_atmos_dyn_driver::atmos_dyn_driver
subroutine, public atmos_dyn_driver(do_flag)
Dynamical Process (Wrapper)
Definition: mod_atmos_dyn_driver.F90:209
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdx
x-length of grid(i+1) to grid(i) [m]
Definition: scale_atmos_grid_cartesC.F90:62
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
mod_atmos_bnd_driver::atmos_boundary_alpha_qtrc
real(rp), dimension(:,:,:,:), allocatable, public atmos_boundary_alpha_qtrc
Definition: mod_atmos_bnd_driver.F90:57
mod_atmos_bnd_driver::atmos_boundary_vely
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_vely
Definition: mod_atmos_bnd_driver.F90:48
scale_atmos_hydrometeor::i_qv
integer, public i_qv
Definition: scale_atmos_hydrometeor.F90:77
mod_atmos_dyn_driver::atmos_dyn_driver_setup
subroutine, public atmos_dyn_driver_setup
Setup.
Definition: mod_atmos_dyn_driver.F90:90
mod_atmos_bnd_driver::atmos_boundary_velz
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_velz
Definition: mod_atmos_bnd_driver.F90:46
mod_atmos_vars::dens_av
real(rp), dimension(:,:,:), pointer, public dens_av
Definition: mod_atmos_vars.F90:89
scale_atmos_grid_cartesc_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:51
mod_atmos_dyn_driver::atmos_dyn_fvm_flux_type
character(len=h_short), public atmos_dyn_fvm_flux_type
Definition: mod_atmos_dyn_driver.F90:48
scale_tracer::tracer_cp
real(rp), dimension(qa_max), public tracer_cp
Definition: scale_tracer.F90:42
mod_atmos_vars::rhoh_p
real(rp), dimension(:,:,:), allocatable, public rhoh_p
Definition: mod_atmos_vars.F90:119
scale_atmos_grid_cartesc::atmos_grid_cartesc_fz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fz
face coordinate [m]: z, local
Definition: scale_atmos_grid_cartesC.F90:41
scale_coriolis::coriolis_f
real(rp), dimension(:,:), allocatable, public coriolis_f
Definition: scale_coriolis.F90:33
mod_atmos_admin::atmos_dyn_type
character(len=h_short), public atmos_dyn_type
Definition: mod_atmos_admin.F90:35
scale_time::time_dtsec
real(dp), public time_dtsec
time interval of model [sec]
Definition: scale_time.F90:33
mod_atmos_dyn_driver::atmos_dyn_tinteg_short_type
character(len=h_short), public atmos_dyn_tinteg_short_type
Definition: mod_atmos_dyn_driver.F90:41
scale_comm_cartesc
module COMMUNICATION
Definition: scale_comm_cartesC.F90:11
mod_atmos_vars
module ATMOSPHERIC Variables
Definition: mod_atmos_vars.F90:12
scale_tracer::tracer_r
real(rp), dimension(qa_max), public tracer_r
Definition: scale_tracer.F90:43
mod_atmos_vars::rhot_tp
real(rp), dimension(:,:,:), allocatable, public rhot_tp
Definition: mod_atmos_vars.F90:118
scale_atmos_grid_cartesc_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:55
scale_atmos_grid_cartesc::atmos_grid_cartesc_cy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cy
center coordinate [m]: y, local
Definition: scale_atmos_grid_cartesC.F90:56
mod_atmos_vars::momy_tp
real(rp), dimension(:,:,:), allocatable, public momy_tp
Definition: mod_atmos_vars.F90:124
scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdz
reciprocal of face-dz
Definition: scale_atmos_grid_cartesC.F90:45
mod_atmos_vars::momx_tp
real(rp), dimension(:,:,:), allocatable, public momx_tp
Definition: mod_atmos_vars.F90:123
scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_j33g
real(rp), public atmos_grid_cartesc_metric_j33g
(3,3) element of Jacobian matrix * {G}^1/2
Definition: scale_atmos_grid_cartesC_metric.F90:40
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_phi
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_phi
geopotential [m2/s2] (cell center)
Definition: scale_atmos_grid_cartesC_real.F90:63
mod_atmos_bnd_driver::atmos_boundary_mflux_offset_y
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_mflux_offset_y
Definition: mod_atmos_bnd_driver.F90:60
mod_atmos_bnd_driver::atmos_boundary_mflux_offset_x
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_mflux_offset_x
Definition: mod_atmos_bnd_driver.F90:59
scale_atmos_grid_cartesc::atmos_grid_cartesc_cdx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cdx
x-length of control volume [m]
Definition: scale_atmos_grid_cartesC.F90:60
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lat
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lat
latitude [rad,-pi,pi]
Definition: scale_atmos_grid_cartesC_real.F90:52
scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_j13g
real(rp), dimension(:,:,:,:), allocatable, public atmos_grid_cartesc_metric_j13g
(1,3) element of Jacobian matrix * {G}^1/2
Definition: scale_atmos_grid_cartesC_metric.F90:38
scale_atmos_grid_cartesc
module atmosphere / grid / cartesC
Definition: scale_atmos_grid_cartesC.F90:12
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdz
z-length of grid(i+1) to grid(i) [m]
Definition: scale_atmos_grid_cartesC.F90:43
mod_atmos_bnd_driver::atmos_boundary_alpha_velx
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_velx
Definition: mod_atmos_bnd_driver.F90:54
scale_atmos_grid_cartesc::atmos_grid_cartesc_rfdy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdy
reciprocal of face-dy
Definition: scale_atmos_grid_cartesC.F90:68
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:56
scale_atmos_dyn::atmos_dyn
subroutine, public atmos_dyn(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC, PROG, DENS_av, MOMZ_av, MOMX_av, MOMY_av, RHOT_av, QTRC_av, DENS_tp, MOMZ_tp, MOMX_tp, MOMY_tp, RHOT_tp, RHOQ_tp, CORIOLIS, CDZ, CDX, CDY, FDZ, FDX, FDY, RCDZ, RCDX, RCDY, RFDZ, RFDX, RFDY, PHI, GSQRT, J13G, J23G, J33G, MAPF, AQ_R, AQ_CV, AQ_CP, AQ_MASS, REF_dens, REF_pott, REF_qv, REF_pres, ND_COEF, ND_COEF_Q, ND_LAPLACIAN_NUM, ND_SFC_FACT, ND_USE_RS, BND_QA, BND_IQ, BND_SMOOTHER_FACT, DAMP_DENS, DAMP_VELZ, DAMP_VELX, DAMP_VELY, DAMP_POTT, DAMP_QTRC, DAMP_alpha_DENS, DAMP_alpha_VELZ, DAMP_alpha_VELX, DAMP_alpha_VELY, DAMP_alpha_POTT, DAMP_alpha_QTRC, MFLUX_OFFSET_X, MFLUX_OFFSET_Y, divdmp_coef, FLAG_TRACER_SPLIT_TEND, FLAG_FCT_MOMENTUM, FLAG_FCT_T, FLAG_FCT_TRACER, FLAG_FCT_ALONG_STREAM, USE_AVERAGE, I_QV, DTSEC, DTSEC_DYN)
Dynamical Process.
Definition: scale_atmos_dyn.F90:260
scale_atmos_grid_cartesc_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:56
scale_prc_cartesc::prc_twod
logical, public prc_twod
2D experiment
Definition: scale_prc_cartesC.F90:55
mod_atmos_dyn_driver::atmos_dyn_tstep_tracer_type
character(len=h_short), public atmos_dyn_tstep_tracer_type
Definition: mod_atmos_dyn_driver.F90:37