SCALE-RM
mod_atmos_phy_cp_driver.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 #include "scalelib.h"
13  !-----------------------------------------------------------------------------
14  !
15  !++ used modules
16  !
17  use scale_precision
18  use scale_io
19  use scale_prof
21  use scale_tracer
22  !-----------------------------------------------------------------------------
23  implicit none
24  private
25  !-----------------------------------------------------------------------------
26  !
27  !++ Public procedure
28  !
31 
32  !-----------------------------------------------------------------------------
33  !
34  !++ Public parameters & variables
35  !
36  !-----------------------------------------------------------------------------
37  !
38  !++ Private procedure
39  !
40  !-----------------------------------------------------------------------------
41  !
42  !++ Private parameters & variables
43  !
44  !-----------------------------------------------------------------------------
45 contains
46  !-----------------------------------------------------------------------------
48  subroutine atmos_phy_cp_driver_setup
49  use scale_prc, only: &
50  prc_abort
51  use scale_atmos_phy_cp_common, only: &
53  use scale_atmos_phy_cp_kf, only: &
55  use mod_atmos_admin, only: &
58  use scale_time , only :&
59  time_dtsec, &
64  use scale_atmos_hydrometeor, only: &
66  implicit none
67 
68  logical :: warmrain
69  !---------------------------------------------------------------------------
70 
71  log_newline
72  log_info("ATMOS_PHY_CP_driver_setup",*) 'Setup'
73 
74  if ( atmos_sw_phy_cp ) then
75 
76  ! setup library component
78  select case ( atmos_phy_cp_type )
79  case ( 'KF' )
80  warmrain = ( .not. atmos_hydrometeor_ice_phase )
81  call atmos_phy_cp_kf_setup( ka, ks, ke, ia, is, ie, ja, js, je, &
83  warmrain )
84  case default
85  log_error("ATMOS_PHY_CP_driver_setup",*) 'ATMOS_PHY_CP_TYPE (', trim(atmos_phy_cp_type), ') is invalid. Check!'
86  call prc_abort
87  end select
88 
89  else
90  log_info("ATMOS_PHY_CP_driver_setup",*) 'this component is never called.'
91  endif
92 
93  return
94  end subroutine atmos_phy_cp_driver_setup
95 
96  !-----------------------------------------------------------------------------
98  subroutine atmos_phy_cp_driver_calc_tendency( update_flag )
99  use scale_const, only: &
100  pre00 => const_pre00
101  use scale_statistics, only: &
103  statistics_total
104  use scale_atmos_grid_cartesc_real, only: &
113  use scale_file_history, only: &
114  file_history_in
115  use scale_time , only :&
116  time_dtsec, &
118  use scale_atmos_grid_cartesc_real, only: &
120  use scale_atmos_hydrometeor, only: &
121  hyd_name, &
122  cv_water
123  use scale_atmos_phy_cp_kf, only: &
125  use scale_atmos_phy_cp_common, only: &
127  use mod_atmos_phy_mp_vars, only: &
128  qs_mp, &
129  qe_mp
130  use mod_atmos_phy_mp_driver, only: &
132  use mod_atmos_admin, only: &
134  use mod_atmos_vars, only: &
135  dens => dens_av, &
136  momz => momz_av, &
137  momx => momx_av, &
138  momy => momy_av, &
139  rhot => rhot_av, &
140  qtrc => qtrc_av, &
141  dens_t => dens_tp, &
142  momz_t => momz_tp, &
143  momx_t => momx_tp, &
144  momy_t => momy_tp, &
145  rhot_t => rhot_tp, &
146  rhoq_t => rhoq_tp, &
147  u, &
148  v, &
149  w, &
150  temp, &
151  pres, &
152  qdry, &
153  qv
154  use scale_atmos_hydrometeor, only: &
155  n_hyd
156  use mod_atmos_phy_cp_vars, only: &
157  dens_t_cp => atmos_phy_cp_dens_t, &
158  rhot_t_cp => atmos_phy_cp_rhot_t, &
159  rhoqv_t_cp => atmos_phy_cp_rhoqv_t, &
160  rhohyd_t_cp => atmos_phy_cp_rhohyd_t, &
161  mflx_cloudbase => atmos_phy_cp_mflx_cloudbase, &
162  sflx_rain => atmos_phy_cp_sflx_rain, & ! convective rain [kg/m2/s]
163  sflx_snow => atmos_phy_cp_sflx_snow, & ! convective snow [kg/m2/s]
164  sflx_engi => atmos_phy_cp_sflx_engi, & ! internal energy flux [J/m2/s]
165  cloudtop => atmos_phy_cp_cloudtop, & ! cloud top height [m]
166  cloudbase => atmos_phy_cp_cloudbase, & ! cloud base height [m]
167  cldfrac_dp => atmos_phy_cp_cldfrac_dp, & ! cloud fraction (deep convection) (0-1)
168  cldfrac_sh => atmos_phy_cp_cldfrac_sh, & ! cloud fraction (shallow convection) (0-1)
169  w0mean => atmos_phy_cp_w0mean, & ! running mean vertical wind velocity [m/s]
170  kf_nca => atmos_phy_cp_kf_nca ! advection/cumulus convection timescale/dt for KF [step]
171  implicit none
172 
173  logical, intent(in) :: update_flag
174 
175  real(rp) :: rhoq_t_cp(ka,ia,ja,qs_mp:qe_mp)
176 
177  real(rp) :: sflx_prec(ia,ja)
178 
179  integer :: k, i, j, iq
180  !---------------------------------------------------------------------------
181 
182  ! temporal running mean of vertical velocity
183  call atmos_phy_cp_common_wmean( ka, ks, ke, ia, is, ie, ja, js, je, &
184  w(:,:,:), & ! [IN]
186  w0mean(:,:,:) ) ! [INOUT]
187  call file_history_in( w0mean(:,:,:), 'w0mean', 'running mean vertical wind velocity', 'kg/m2/s', fill_halo=.true. )
188 
189  if ( update_flag ) then ! update
190  select case ( atmos_phy_cp_type )
191  case ( 'KF' )
192  call atmos_phy_cp_kf_tendency( ka, ks, ke, ia, is, ie, ja, js, je, &
193  dens(:,:,:), & ! [IN]
194  u(:,:,:), v(:,:,:), & ! [IN]
195  rhot(:,:,:), temp(:,:,:), pres(:,:,:), & ! [IN]
196  qdry(:,:,:), qv(:,:,:), & ! [IN]
197  w0mean(:,:,:), & ! [IN]
198  fz(:,:,:), & ! [IN]
199  time_dtsec_atmos_phy_cp, & ! [IN]
200  dens_t_cp(:,:,:), & ! [INOUT]
201  rhot_t_cp(:,:,:), & ! [INOUT]
202  rhoqv_t_cp(:,:,:), rhohyd_t_cp(:,:,:,:), & ! [INOUT]
203  kf_nca(:,:), & ! [INOUT]
204  sflx_rain(:,:), sflx_snow(:,:), & ! [INOUT]
205  sflx_engi(:,:), & ! [INOUT]
206  cloudtop(:,:), cloudbase(:,:), & ! [INOUT]
207  cldfrac_dp(:,:,:), cldfrac_sh(:,:,:) ) ! [INOUT]
208 
209  end select
210 
211 !OCL XFILL
212  !$omp parallel do
213  do j = js, je
214  do i = is, ie
215  mflx_cloudbase(i,j) = 0.0_rp
216  enddo
217  enddo
218 
219  ! diagnose tendency of number concentration
220 
221  !$omp parallel do
222  do j = js, je
223  do i = is, ie
224  sflx_prec(i,j) = sflx_rain(i,j) + sflx_snow(i,j)
225  end do
226  end do
227 
228  call file_history_in( mflx_cloudbase(:,:), 'CBMFX', 'cloud base mass flux', 'kg/m2/s', fill_halo=.true. )
229  call file_history_in( sflx_rain(:,:), 'RAIN_CP', 'surface rain rate by CP', 'kg/m2/s', fill_halo=.true. )
230  call file_history_in( sflx_snow(:,:), 'SNOW_CP', 'surface snow rate by CP', 'kg/m2/s', fill_halo=.true. )
231  call file_history_in( sflx_prec(:,:), 'PREC_CP', 'surface precipitation rate by CP', 'kg/m2/s', fill_halo=.true. )
232  call file_history_in( cloudtop(:,:), 'CUMHGT', 'CP cloud top height', 'm', fill_halo=.true. )
233  call file_history_in( cloudbase(:,:), 'CUBASE', 'CP cloud base height', 'm', fill_halo=.true. )
234  call file_history_in( cldfrac_dp(:,:,:), 'CUMFRC_DP', 'CP cloud fraction (deep)', '1', fill_halo=.true. )
235  call file_history_in( cldfrac_sh(:,:,:), 'CUMFRC_SH', 'CP cloud fraction (shallow)', '1', fill_halo=.true. )
236  call file_history_in( kf_nca(:,:), 'kf_nca', 'advection or cumulus convection timescale for KF', 's', fill_halo=.true. )
237 
238  call file_history_in( dens_t_cp(:,:,:), 'DENS_t_CP', 'tendency DENS in CP', 'kg/m3/s' , fill_halo=.true. )
239  call file_history_in( rhot_t_cp(:,:,:), 'RHOT_t_CP', 'tendency RHOT in CP', 'K*kg/m3/s', fill_halo=.true. )
240 
241  call file_history_in( rhoqv_t_cp(:,:,:), 'QV_t_CP', 'tendency rho*QV in CP', 'kg/m3/s', fill_halo=.true. )
242  do iq = 1, n_hyd
243  call file_history_in( rhohyd_t_cp(:,:,:,iq), trim(hyd_name(iq))//'_t_CP', &
244  'tendency rho*'//trim(hyd_name(iq))//' in CP', 'kg/m3/s', fill_halo=.true. )
245  enddo
246 
247  endif ! update
248 
249  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
250  do j = jsb, jeb
251  do i = isb, ieb
252  do k = ks, ke
253  dens_t(k,i,j) = dens_t(k,i,j) + dens_t_cp(k,i,j)
254  rhot_t(k,i,j) = rhot_t(k,i,j) + rhot_t_cp(k,i,j)
255  enddo
256  enddo
257  enddo
258 
259  call atmos_phy_mp_driver_qhyd2qtrc( ka, ks, ke, ia, is, ie, ja, js, je, &
260  rhoqv_t_cp(:,:,:), rhohyd_t_cp(:,:,:,:), & ! [IN]
261  rhoq_t_cp(:,:,:,qs_mp:qe_mp) ) ! [OUT]
262 
263  do iq = qs_mp, qe_mp
264  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(3)
265  do j = js, je
266  do i = is, ie
267  do k = ks, ke
268  rhoq_t(k,i,j,iq) = rhoq_t(k,i,j,iq) + rhoq_t_cp(k,i,j,iq)
269  enddo
270  enddo
271  enddo
272  enddo
273 
274  if ( statistics_checktotal ) then
275  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
276  dens_t_cp(:,:,:), 'DENS_t_CP', &
277  atmos_grid_cartesc_real_vol(:,:,:), &
278  atmos_grid_cartesc_real_totvol )
279  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
280  rhot_t_cp(:,:,:), 'RHOT_t_CP', &
281  atmos_grid_cartesc_real_vol(:,:,:), &
282  atmos_grid_cartesc_real_totvol )
283 
284  do iq = qs_mp, qe_mp
285  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
286  rhoq_t_cp(:,:,:,iq), trim(tracer_name(iq))//'_t_CP', &
287  atmos_grid_cartesc_real_vol(:,:,:), &
288  atmos_grid_cartesc_real_totvol )
289  enddo
290  endif
291 
292  return
293  end subroutine atmos_phy_cp_driver_calc_tendency
294 
295 end module mod_atmos_phy_cp_driver
mod_atmos_vars::momz_av
real(rp), dimension(:,:,:), pointer, public momz_av
Definition: mod_atmos_vars.F90:90
scale_atmos_grid_cartesc_index::isb
integer, public isb
Definition: scale_atmos_grid_cartesC_index.F90:63
mod_atmos_phy_cp_vars::atmos_phy_cp_mflx_cloudbase
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_mflx_cloudbase
Definition: mod_atmos_phy_cp_vars.F90:69
scale_statistics
module Statistics
Definition: scale_statistics.F90:11
mod_atmos_phy_mp_vars
module Atmosphere / Physics Cloud Microphysics
Definition: mod_atmos_phy_mp_vars.F90:12
scale_atmos_grid_cartesc_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:52
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_atmos_phy_cp_kf::atmos_phy_cp_kf_setup
subroutine, public atmos_phy_cp_kf_setup(KA, KS, KE, IA, IS, IE, JA, JS, JE, CZ, AREA, WARMRAIN_in)
Setup initial setup for Kain-Fritsch Cumulus Parameterization.
Definition: scale_atmos_phy_cp_kf.F90:179
mod_atmos_vars::momx_av
real(rp), dimension(:,:,:), pointer, public momx_av
Definition: mod_atmos_vars.F90:91
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_totvolzxv
real(rp), public atmos_grid_cartesc_real_totvolzxv
total volume (zxv, local) [m3]
Definition: scale_atmos_grid_cartesC_real.F90:90
mod_atmos_vars::rhoq_tp
real(rp), dimension(:,:,:,:), allocatable, public rhoq_tp
Definition: mod_atmos_vars.F90:120
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_cz
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_cz
geopotential height [m] (zxy)
Definition: scale_atmos_grid_cartesC_real.F90:38
scale_atmos_hydrometeor::hyd_name
character(len=h_short), dimension(n_hyd), parameter, public hyd_name
Definition: scale_atmos_hydrometeor.F90:88
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_volwxy
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_volwxy
control volume (wxy) [m3]
Definition: scale_atmos_grid_cartesC_real.F90:84
mod_atmos_vars::qtrc_av
real(rp), dimension(:,:,:,:), pointer, public qtrc_av
Definition: mod_atmos_vars.F90:94
scale_atmos_phy_cp_common
module atmosphere / physics / cumulus / Common
Definition: scale_atmos_phy_cp_common.F90:13
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
mod_atmos_admin
module ATMOS admin
Definition: mod_atmos_admin.F90:11
mod_atmos_vars::qdry
real(rp), dimension(:,:,:), allocatable, target, public qdry
Definition: mod_atmos_vars.F90:139
mod_atmos_phy_mp_vars::qs_mp
integer, public qs_mp
Definition: mod_atmos_phy_mp_vars.F90:78
scale_atmos_phy_cp_kf::atmos_phy_cp_kf_tendency
subroutine, public atmos_phy_cp_kf_tendency(KA, KS, KE, IA, IS, IE, JA, JS, JE, DENS, U, V, RHOT, TEMP, PRES, QDRY, QV_in, w0avg, FZ, KF_DTSECD, DENS_t, RHOT_t, RHOQV_t, RHOQ_t, nca, SFLX_rain, SFLX_snow, SFLX_engi, cloudtop, cloudbase, cldfrac_dp, cldfrac_sh)
ATMOS_PHY_CP_kf calculate Kain-Fritsch Cumulus Parameterization.
Definition: scale_atmos_phy_cp_kf.F90:503
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_totvolwxy
real(rp), public atmos_grid_cartesc_real_totvolwxy
total volume (wxy, local) [m3]
Definition: scale_atmos_grid_cartesC_real.F90:88
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
mod_atmos_phy_cp_vars::atmos_phy_cp_rhoqv_t
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_rhoqv_t
Definition: mod_atmos_phy_cp_vars.F90:60
scale_atmos_phy_cp_kf
module atmosphere / physics / cumulus / Kain-Fritsch
Definition: scale_atmos_phy_cp_kf.F90:45
mod_atmos_vars::rhot
real(rp), dimension(:,:,:), allocatable, target, public rhot
Definition: mod_atmos_vars.F90:79
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_file_history
module file_history
Definition: scale_file_history.F90:15
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_volzuy
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_volzuy
control volume (zuy) [m3]
Definition: scale_atmos_grid_cartesC_real.F90:85
scale_atmos_grid_cartesc_index::jeb
integer, public jeb
Definition: scale_atmos_grid_cartesC_index.F90:66
mod_atmos_phy_mp_driver
module atmosphere / physics / cloud microphysics
Definition: mod_atmos_phy_mp_driver.F90:12
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_time::time_dtsec_atmos_phy_cp
real(dp), public time_dtsec_atmos_phy_cp
time interval of physics(cumulus ) [sec]
Definition: scale_time.F90:37
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
mod_atmos_vars::dens
real(rp), dimension(:,:,:), allocatable, target, public dens
Definition: mod_atmos_vars.F90:75
scale_tracer::k
real(rp), public k
Definition: scale_tracer.F90:44
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_volzxv
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_volzxv
control volume (zxv) [m3]
Definition: scale_atmos_grid_cartesC_real.F90:86
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_vol
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_vol
control volume (zxy) [m3]
Definition: scale_atmos_grid_cartesC_real.F90:83
mod_atmos_vars::momz
real(rp), dimension(:,:,:), allocatable, target, public momz
Definition: mod_atmos_vars.F90:76
mod_atmos_vars::momy_av
real(rp), dimension(:,:,:), pointer, public momy_av
Definition: mod_atmos_vars.F90:92
mod_atmos_phy_cp_vars::atmos_phy_cp_rhot_t
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_rhot_t
Definition: mod_atmos_phy_cp_vars.F90:59
mod_atmos_vars::v
real(rp), dimension(:,:,:), allocatable, target, public v
Definition: mod_atmos_vars.F90:130
scale_tracer::tracer_name
character(len=h_short), dimension(qa_max), public tracer_name
Definition: scale_tracer.F90:38
mod_atmos_vars::w
real(rp), dimension(:,:,:), allocatable, target, public w
Definition: mod_atmos_vars.F90:128
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_area
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_area
horizontal area ( xy, normal z) [m2]
Definition: scale_atmos_grid_cartesC_real.F90:65
mod_atmos_vars::momz_tp
real(rp), dimension(:,:,:), allocatable, public momz_tp
Definition: mod_atmos_vars.F90:115
mod_atmos_vars::momx
real(rp), dimension(:,:,:), allocatable, target, public momx
Definition: mod_atmos_vars.F90:77
scale_atmos_grid_cartesc_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:53
mod_atmos_admin::atmos_sw_phy_cp
logical, public atmos_sw_phy_cp
Definition: mod_atmos_admin.F90:59
mod_atmos_vars::temp
real(rp), dimension(:,:,:), allocatable, target, public temp
Definition: mod_atmos_vars.F90:133
mod_atmos_vars::dens_tp
real(rp), dimension(:,:,:), allocatable, public dens_tp
Definition: mod_atmos_vars.F90:114
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_totvolzuy
real(rp), public atmos_grid_cartesc_real_totvolzuy
total volume (zuy, local) [m3]
Definition: scale_atmos_grid_cartesC_real.F90:89
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
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_vars::qv
real(rp), dimension(:,:,:), allocatable, pointer, target, public qv
Definition: mod_atmos_vars.F90:96
mod_atmos_phy_cp_driver
module ATMOSPHERE / Physics Cumulus
Definition: mod_atmos_phy_cp_driver.F90:12
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
mod_atmos_admin::atmos_phy_cp_type
character(len=h_short), public atmos_phy_cp_type
Definition: mod_atmos_admin.F90:43
mod_atmos_vars::pres
real(rp), dimension(:,:,:), allocatable, target, public pres
Definition: mod_atmos_vars.F90:134
mod_atmos_vars::dens_av
real(rp), dimension(:,:,:), pointer, public dens_av
Definition: mod_atmos_vars.F90:89
mod_atmos_vars::u
real(rp), dimension(:,:,:), allocatable, target, public u
Definition: mod_atmos_vars.F90:129
scale_atmos_grid_cartesc_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:51
scale_atmos_hydrometeor::atmos_hydrometeor_ice_phase
logical, public atmos_hydrometeor_ice_phase
Definition: scale_atmos_hydrometeor.F90:74
scale_atmos_phy_cp_common::atmos_phy_cp_common_wmean
subroutine, public atmos_phy_cp_common_wmean(KA, KS, KE, IA, IS, IE, JA, JS, JE, W, TIME_DTSEC, CP_DTSEC, W0_mean)
ATMOS_PHY_CP_wmean running mean vertical wind velocity comment for W0 imported from WRF.
Definition: scale_atmos_phy_cp_common.F90:102
mod_atmos_phy_cp_driver::atmos_phy_cp_driver_setup
subroutine, public atmos_phy_cp_driver_setup
Setup.
Definition: mod_atmos_phy_cp_driver.F90:49
scale_statistics::statistics_checktotal
logical, public statistics_checktotal
calc&report variable totals to logfile?
Definition: scale_statistics.F90:64
mod_atmos_phy_cp_vars::atmos_phy_cp_rhohyd_t
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_cp_rhohyd_t
Definition: mod_atmos_phy_cp_vars.F90:61
scale_time::time_dtsec
real(dp), public time_dtsec
time interval of model [sec]
Definition: scale_time.F90:33
mod_atmos_vars
module ATMOSPHERIC Variables
Definition: mod_atmos_vars.F90:12
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
mod_atmos_phy_cp_vars::atmos_phy_cp_sflx_rain
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_sflx_rain
Definition: mod_atmos_phy_cp_vars.F90:70
mod_atmos_vars::momy_tp
real(rp), dimension(:,:,:), allocatable, public momy_tp
Definition: mod_atmos_vars.F90:124
mod_atmos_phy_cp_driver::atmos_phy_cp_driver_calc_tendency
subroutine, public atmos_phy_cp_driver_calc_tendency(update_flag)
Driver.
Definition: mod_atmos_phy_cp_driver.F90:99
scale_atmos_grid_cartesc_index::ieb
integer, public ieb
Definition: scale_atmos_grid_cartesC_index.F90:64
mod_atmos_vars::momx_tp
real(rp), dimension(:,:,:), allocatable, public momx_tp
Definition: mod_atmos_vars.F90:123
mod_atmos_phy_mp_vars::qe_mp
integer, public qe_mp
Definition: mod_atmos_phy_mp_vars.F90:79
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_fz
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_fz
geopotential height [m] (wxy)
Definition: scale_atmos_grid_cartesC_real.F90:42
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_totvol
real(rp), public atmos_grid_cartesc_real_totvol
total volume (zxy, local) [m3]
Definition: scale_atmos_grid_cartesC_real.F90:87
scale_atmos_phy_cp_common::atmos_phy_cp_common_setup
subroutine, public atmos_phy_cp_common_setup
Setup.
Definition: scale_atmos_phy_cp_common.F90:52
scale_atmos_grid_cartesc_index::jsb
integer, public jsb
Definition: scale_atmos_grid_cartesC_index.F90:65
mod_atmos_phy_mp_driver::atmos_phy_mp_driver_qhyd2qtrc
subroutine, public atmos_phy_mp_driver_qhyd2qtrc(KA, KS, KE, IA, IS, IE, JA, JS, JE, QV, QHYD, QTRC, QNUM)
Definition: mod_atmos_phy_mp_driver.F90:1361
mod_atmos_phy_cp_vars
module Atmosphere / Physics Cumulus
Definition: mod_atmos_phy_cp_vars.F90:12
scale_const::const_pre00
real(rp), public const_pre00
pressure reference [Pa]
Definition: scale_const.F90:88
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_atmos_hydrometeor::n_hyd
integer, parameter, public n_hyd
Definition: scale_atmos_hydrometeor.F90:79
mod_atmos_phy_cp_vars::atmos_phy_cp_dens_t
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_dens_t
Definition: mod_atmos_phy_cp_vars.F90:57
scale_atmos_hydrometeor::cv_water
real(rp), public cv_water
CV for water [J/kg/K].
Definition: scale_atmos_hydrometeor.F90:132