SCALE-RM
mod_atmos_vars.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
20  use scale_debug
22  use scale_index
23  use scale_tracer
24  !-----------------------------------------------------------------------------
25  implicit none
26  private
27  !-----------------------------------------------------------------------------
28  !
29  !++ Public procedure
30  !
31  public :: atmos_vars_setup
32  public :: atmos_vars_fillhalo
33  public :: atmos_vars_restart_read
34  public :: atmos_vars_restart_write
35  public :: atmos_vars_restart_check
37  public :: atmos_vars_history
38  public :: atmos_vars_total
40  public :: atmos_vars_get_diagnostic
41  public :: atmos_vars_monitor
42 
44  public :: atmos_vars_restart_open
47  public :: atmos_vars_restart_close
48 
49  interface atmos_vars_get_diagnostic
53  end interface atmos_vars_get_diagnostic
54 
55  !-----------------------------------------------------------------------------
56  !
57  !++ Public parameters & variables
58  !
59  logical, public :: atmos_restart_output = .false.
60 
61  character(len=H_LONG), public :: atmos_restart_in_basename = ''
62  logical, public :: atmos_restart_in_aggregate
63  logical, public :: atmos_restart_in_postfix_timelabel = .false.
64  character(len=H_LONG), public :: atmos_restart_out_basename = ''
65  logical, public :: atmos_restart_out_aggregate
66  logical, public :: atmos_restart_out_postfix_timelabel = .true.
67  character(len=H_MID), public :: atmos_restart_out_title = 'ATMOS restart'
68  character(len=H_SHORT), public :: atmos_restart_out_dtype = 'DEFAULT'
69 
70  logical, public :: atmos_restart_check = .false.
71  character(len=H_LONG), public :: atmos_restart_check_basename = 'restart_check'
72  real(RP), public :: atmos_restart_check_criterion = 1.e-6_rp
73 
74  ! prognostic variables
75  real(RP), public, target, allocatable :: dens(:,:,:) ! Density [kg/m3]
76  real(RP), public, target, allocatable :: momz(:,:,:) ! momentum z [kg/m2/s]
77  real(RP), public, target, allocatable :: momx(:,:,:) ! momentum x [kg/m2/s]
78  real(RP), public, target, allocatable :: momy(:,:,:) ! momentum y [kg/m2/s]
79  real(RP), public, target, allocatable :: rhot(:,:,:) ! DENS * POTT [K*kg/m3]
80  real(RP), public, target, allocatable :: qtrc(:,:,:,:) ! ratio of mass of tracer to total mass[kg/kg]
81 
82  real(RP), public, target, allocatable :: dens_avw(:,:,:)
83  real(RP), public, target, allocatable :: momz_avw(:,:,:)
84  real(RP), public, target, allocatable :: momx_avw(:,:,:)
85  real(RP), public, target, allocatable :: momy_avw(:,:,:)
86  real(RP), public, target, allocatable :: rhot_avw(:,:,:)
87  real(RP), public, target, allocatable :: qtrc_avw(:,:,:,:)
88 
89  real(RP), public, pointer :: dens_av(:,:,:)
90  real(RP), public, pointer :: momz_av(:,:,:)
91  real(RP), public, pointer :: momx_av(:,:,:)
92  real(RP), public, pointer :: momy_av(:,:,:)
93  real(RP), public, pointer :: rhot_av(:,:,:)
94  real(RP), public, pointer :: qtrc_av(:,:,:,:)
95 
96  real(RP), public, pointer :: qv(:,:,:)
97  real(RP), public, pointer :: qc(:,:,:)
98  real(RP), public, pointer :: qr(:,:,:)
99  real(RP), public, pointer :: qi(:,:,:)
100  real(RP), public, pointer :: qs(:,:,:)
101  real(RP), public, pointer :: qg(:,:,:)
102  real(RP), public, pointer :: qh(:,:,:)
103 
104  real(RP), public, target, allocatable :: qe(:,:,:,:)
105 
106  ! reference state
107  real(RP), public, allocatable :: dens_ref(:,:,:)
108  real(RP), public, allocatable :: pott_ref(:,:,:)
109  real(RP), public, allocatable :: temp_ref(:,:,:)
110  real(RP), public, allocatable :: pres_ref(:,:,:)
111  real(RP), public, allocatable :: qv_ref(:,:,:)
112 
113  ! tendency by physical processes
114  real(RP), public, allocatable :: dens_tp(:,:,:)
115  real(RP), public, allocatable :: momz_tp(:,:,:)
116  real(RP), public, allocatable :: rhou_tp(:,:,:)
117  real(RP), public, allocatable :: rhov_tp(:,:,:)
118  real(RP), public, allocatable :: rhot_tp(:,:,:)
119  real(RP), public, allocatable :: rhoh_p (:,:,:)
120  real(RP), public, allocatable :: rhoq_tp(:,:,:,:)
121 
122  ! (obsolute)
123  real(RP), public, allocatable :: momx_tp(:,:,:)
124  real(RP), public, allocatable :: momy_tp(:,:,:)
125 
126 
127  ! public diagnostic variables
128  real(RP), public, allocatable, target :: w (:,:,:)
129  real(RP), public, allocatable, target :: u (:,:,:)
130  real(RP), public, allocatable, target :: v (:,:,:)
131 
132  real(RP), public, allocatable, target :: pott (:,:,:)
133  real(RP), public, allocatable, target :: temp (:,:,:)
134  real(RP), public, allocatable, target :: pres (:,:,:)
135  real(RP), public, allocatable, target :: exner(:,:,:)
136  real(RP), public, allocatable, target :: phyd (:,:,:)
137  real(RP), public, allocatable, target :: phydh(:,:,:)
138 
139  real(RP), public, allocatable, target :: qdry (:,:,:)
140  real(RP), public, allocatable, target :: rtot (:,:,:)
141  real(RP), public, allocatable, target :: cvtot(:,:,:)
142  real(RP), public, allocatable, target :: cptot(:,:,:)
143 
144  !-----------------------------------------------------------------------------
145  !
146  !++ Private procedure
147  !
148  !-----------------------------------------------------------------------------
149  !
150  !++ Private parameters & variables
151  !
152  logical, private :: atmos_vars_checkrange = .false.
153  real(RP), private :: atmos_vars_checkcfl_soft = 1.0_rp
154  real(RP), private :: atmos_vars_checkcfl_hard = 2.0_rp
155 
156  type vinfo
157  character(len=H_SHORT) :: name
158  character(len=H_MID) :: desc
159  character(len=H_SHORT) :: unit
160  integer :: ndims
161  character(len=H_SHORT) :: dim_type
162  character(len=H_MID) :: stdname
163  end type vinfo
164 
165  ! prognostic variables
166  integer, private, parameter :: pv_nmax = 5
167  type(vinfo), private :: pv_info(pv_nmax)
168  integer, private, allocatable :: pv_id(:)
169 
170  data pv_info / &
171  vinfo( 'DENS', 'density', 'kg/m3', 3, 'ZXY', 'air_density' ), &
172  vinfo( 'MOMZ', 'momentum z', 'kg/m2/s', 3, 'ZHXY', 'upward_mass_flux_of_air' ), &
173  vinfo( 'MOMX', 'momentum x', 'kg/m2/s', 3, 'ZXHY', 'eastward_mass_flux_of_air' ), &
174  vinfo( 'MOMY', 'momentum y', 'kg/m2/s', 3, 'ZXYH', 'northward_mass_flux_of_air' ), &
175  vinfo( 'RHOT', 'rho * theta', 'kg/m3*K', 3, 'ZXY', '' ) /
176 
177 
178  ! private diagnostic variables
179  real(RP), allocatable, target :: lhv (:,:,:)
180  real(RP), allocatable, target :: lhs (:,:,:)
181  real(RP), allocatable, target :: lhf (:,:,:)
182 
183  real(RP), allocatable, target :: potv (:,:,:)
184  real(RP), allocatable, target :: teml (:,:,:)
185  real(RP), allocatable, target :: potl (:,:,:)
186  real(RP), allocatable, target :: pote (:,:,:)
187 
188  real(RP), allocatable, target :: qtot (:,:,:)
189  real(RP), allocatable, target :: qhyd (:,:,:)
190  real(RP), allocatable, target :: qliq (:,:,:)
191  real(RP), allocatable, target :: qice (:,:,:)
192 
193  real(RP), allocatable, target :: lwp (:,:)
194  real(RP), allocatable, target :: iwp (:,:)
195  real(RP), allocatable, target :: pw (:,:)
196 
197  real(RP), allocatable, target :: prec (:,:)
198  real(RP), allocatable, target :: rain (:,:)
199  real(RP), allocatable, target :: snow (:,:)
200 
201  real(RP), allocatable, target :: qsat (:,:,:)
202  real(RP), allocatable, target :: rha (:,:,:)
203  real(RP), allocatable, target :: rhl (:,:,:)
204  real(RP), allocatable, target :: rhi (:,:,:)
205 
206  real(RP), allocatable, target :: vor (:,:,:)
207  real(RP), allocatable, target :: div (:,:,:)
208  real(RP), allocatable, target :: hdiv (:,:,:)
209  real(RP), allocatable, target :: uabs (:,:,:)
210 
211  real(RP), allocatable, target :: n2 (:,:,:)
212  real(RP), allocatable, target :: pblh (:,:)
213 
214  real(RP), allocatable, target :: mse (:,:,:)
215  real(RP), allocatable, target :: tdew (:,:,:)
216 
217  real(RP), allocatable, target :: cape (:,:)
218  real(RP), allocatable, target :: cin (:,:)
219  real(RP), allocatable, target :: lcl (:,:)
220  real(RP), allocatable, target :: lfc (:,:)
221  real(RP), allocatable, target :: lnb (:,:)
222 
223  real(RP), allocatable, target :: engt (:,:,:)
224  real(RP), allocatable, target :: engp (:,:,:)
225  real(RP), allocatable, target :: engk (:,:,:)
226  real(RP), allocatable, target :: engi (:,:,:)
227 
228  real(RP), allocatable, target :: dens_mean(:)
229  real(RP), allocatable, target :: w_mean (:)
230  real(RP), allocatable, target :: u_mean (:)
231  real(RP), allocatable, target :: v_mean (:)
232  real(RP), allocatable, target :: pt_mean (:)
233  real(RP), allocatable, target :: t_mean (:)
234  real(RP), allocatable, target :: qv_mean (:)
235  real(RP), allocatable, target :: qhyd_mean(:)
236  real(RP), allocatable, target :: qliq_mean(:)
237  real(RP), allocatable, target :: qice_mean(:)
238 
239  real(RP), allocatable, target :: dens_prim(:,:,:)
240  real(RP), allocatable, target :: w_prim (:,:,:)
241  real(RP), allocatable, target :: u_prim (:,:,:)
242  real(RP), allocatable, target :: v_prim (:,:,:)
243  real(RP), allocatable, target :: pt_prim (:,:,:)
244  real(RP), allocatable, target :: w_prim2 (:,:,:)
245  real(RP), allocatable, target :: pt_w_prim(:,:,:)
246  real(RP), allocatable, target :: w_prim3 (:,:,:)
247  real(RP), allocatable, target :: tke_rs (:,:,:)
248 
249  real(RP), allocatable, target :: velz (:,:,:)
250  real(RP), allocatable, target :: velx (:,:,:)
251  real(RP), allocatable, target :: vely (:,:,:)
252  real(RP), allocatable, target :: umet (:,:,:)
253  real(RP), allocatable, target :: vmet (:,:,:)
254 
255  ! id of diagnostic variables
256  !! public
257  integer, private, parameter :: i_w = 1
258  integer, private, parameter :: i_u = 2
259  integer, private, parameter :: i_v = 3
260  integer, private, parameter :: i_pott = 4
261  integer, private, parameter :: i_temp = 5
262  integer, private, parameter :: i_pres = 6
263  integer, private, parameter :: i_exner = 7
264  integer, private, parameter :: i_phyd = 8
265  integer, private, parameter :: i_qdry = 9
266  integer, private, parameter :: i_rtot = 10
267  integer, private, parameter :: i_cvtot = 11
268  integer, private, parameter :: i_cptot = 12
269  !! private
270  integer, private, parameter :: i_lhv = 13
271  integer, private, parameter :: i_lhs = 14
272  integer, private, parameter :: i_lhf = 15
273  integer, private, parameter :: i_potv = 16
274  integer, private, parameter :: i_teml = 17
275  integer, private, parameter :: i_potl = 18
276  integer, private, parameter :: i_pote = 19
277  integer, private, parameter :: i_qtot = 20
278  integer, private, parameter :: i_qhyd = 21
279  integer, private, parameter :: i_qliq = 22
280  integer, private, parameter :: i_qice = 23
281  integer, private, parameter :: i_lwp = 24
282  integer, private, parameter :: i_iwp = 25
283  integer, private, parameter :: i_pw = 26
284  integer, private, parameter :: i_prec = 27
285  integer, private, parameter :: i_rain = 28
286  integer, private, parameter :: i_snow = 29
287  integer, private, parameter :: i_qsat = 30
288  integer, private, parameter :: i_rha = 31
289  integer, private, parameter :: i_rhl = 32
290  integer, private, parameter :: i_rhi = 33
291  integer, private, parameter :: i_vor = 34
292  integer, private, parameter :: i_div = 35
293  integer, private, parameter :: i_hdiv = 36
294  integer, private, parameter :: i_uabs = 37
295  integer, private, parameter :: i_n2 = 38
296  integer, private, parameter :: i_pblh = 39
297  integer, private, parameter :: i_mse = 40
298  integer, private, parameter :: i_tdew = 41
299  integer, private, parameter :: i_cape = 42
300  integer, private, parameter :: i_cin = 43
301  integer, private, parameter :: i_lcl = 44
302  integer, private, parameter :: i_lfc = 45
303  integer, private, parameter :: i_lnb = 46
304  integer, private, parameter :: i_engt = 47
305  integer, private, parameter :: i_engp = 48
306  integer, private, parameter :: i_engk = 49
307  integer, private, parameter :: i_engi = 50
308  integer, private, parameter :: i_dens_mean = 51
309  integer, private, parameter :: i_w_mean = 52
310  integer, private, parameter :: i_u_mean = 53
311  integer, private, parameter :: i_v_mean = 54
312  integer, private, parameter :: i_pt_mean = 55
313  integer, private, parameter :: i_t_mean = 56
314  integer, private, parameter :: i_qv_mean = 57
315  integer, private, parameter :: i_qhyd_mean = 58
316  integer, private, parameter :: i_qliq_mean = 59
317  integer, private, parameter :: i_qice_mean = 60
318  integer, private, parameter :: i_dens_prim = 61
319  integer, private, parameter :: i_w_prim = 62
320  integer, private, parameter :: i_u_prim = 63
321  integer, private, parameter :: i_v_prim = 64
322  integer, private, parameter :: i_pt_prim = 65
323  integer, private, parameter :: i_w_prim2 = 66
324  integer, private, parameter :: i_pt_w_prim = 67
325  integer, private, parameter :: i_w_prim3 = 68
326  integer, private, parameter :: i_tke_rs = 69
327  integer, private, parameter :: i_velz = 70
328  integer, private, parameter :: i_velx = 71
329  integer, private, parameter :: i_vely = 72
330  integer, private, parameter :: i_umet = 73
331  integer, private, parameter :: i_vmet = 74
332 
333  integer, private, parameter :: dv_nmax = 74
334  type(vinfo), private :: dv_info(dv_nmax)
335  logical, private :: dv_calculated(dv_nmax)
336 
337  data dv_info / &
338  vinfo( 'W', 'velocity w', 'm/s', 3, 'ZXY', 'upward_air_velocity' ), &
339  vinfo( 'U', 'velocity u', 'm/s', 3, 'ZXY', 'x_wind' ), &
340  vinfo( 'V', 'velocity v', 'm/s', 3, 'ZXY', 'y_wind' ), &
341  vinfo( 'PT', 'potential temp.', 'K', 3, 'ZXY', 'air_potential_temperature' ), &
342  vinfo( 'T', 'temperature', 'K', 3, 'ZXY', 'air_temperature' ), &
343  vinfo( 'PRES', 'pressure', 'Pa', 3, 'ZXY', 'air_pressure' ), &
344  vinfo( 'EXNER', 'Exner function', '1', 3, 'ZXY', 'dimensionless_exner_function' ), &
345  vinfo( 'PHYD', 'hydrostatic pressure', 'Pa', 3, 'ZXY', '' ), &
346  vinfo( 'QDRY', 'dry air', 'kg/kg', 3, 'ZXY', '' ), &
347  vinfo( 'RTOT', 'Total gas constant', 'J/kg/K', 3, 'ZXY', '' ), &
348  vinfo( 'CVTOT', 'Total heat capacity', 'J/kg/K', 3, 'ZXY', '' ), &
349  vinfo( 'CPTOT', 'Total heat capacity', 'J/kg/K', 3, 'ZXY', '' ), &
350  vinfo( 'LHV', 'latent heat for vaporization', 'J/kg', 3, 'ZXY', '' ), &
351  vinfo( 'LHS', 'latent heat for sublimation', 'J/kg', 3, 'ZXY', '' ), &
352  vinfo( 'LHF', 'latent heat for fusion', 'J/kg', 3, 'ZXY', '' ), &
353  vinfo( 'POTV', 'virtual potential temp.', 'K', 3, 'ZXY', '' ), &
354  vinfo( 'TEML', 'liquid water temperature', 'K', 3, 'ZXY', '' ), &
355  vinfo( 'POTL', 'liquid water potential temp.', 'K', 3, 'ZXY', '' ), &
356  vinfo( 'POTE', 'equivalent potential temp.', 'K', 3, 'ZXY', 'pseudo_equivalent_potential_temperature' ), &
357  vinfo( 'QTOT', 'total water', 'kg/kg', 3, 'ZXY', 'mass_fraction_of_water_in_air' ), &
358  vinfo( 'QHYD', 'total hydrometeors', 'kg/kg', 3, 'ZXY', 'mass_fraction_of_cloud_condensed_water_in_air' ), &
359  vinfo( 'QLIQ', 'total liquid water', 'kg/kg', 3, 'ZXY', '' ), &
360  vinfo( 'QICE', 'total ice water', 'kg/kg', 3, 'ZXY', '' ), &
361  vinfo( 'LWP', 'liquid water path', 'g/m2', 2, 'XY', 'atmosphere_mass_content_of_cloud_liquid_water' ), &
362  vinfo( 'IWP', 'ice water path', 'g/m2', 2, 'XY', '' ), &
363  vinfo( 'PW', 'precipitable water', 'g/m2', 2, 'XY', 'atmosphere_mass_content_of_vapor' ), &
364  vinfo( 'PREC', 'surface precipitation flux', 'kg/m2/s', 2, 'XY', 'precipitation_flux' ), &
365  vinfo( 'RAIN', 'surface rain flux', 'kg/m2/s', 2, 'XY', 'rainfall_flux' ), &
366  vinfo( 'SNOW', 'surface snow flux', 'kg/m2/s', 2, 'XY', 'snowfall_flux' ), &
367  vinfo( 'QSAT', 'saturation specific humidity', 'kg/kg', 3, 'ZXY', '' ), &
368  vinfo( 'RHA', 'relative humidity(liq+ice)', '%', 3, 'ZXY', '' ), &
369  vinfo( 'RH', 'relative humidity(liq)', '%', 3, 'ZXY', 'relative_humidity' ), &
370  vinfo( 'RHI', 'relative humidity(ice)', '%', 3, 'ZXY', '' ), &
371  vinfo( 'VOR', 'vertical vorticity', '1/s', 3, 'ZXY', 'atmosphere_relative_vorticity' ), &
372  vinfo( 'DIV', 'divergence', '1/s', 3, 'ZXY', 'divergence_of_wind' ), &
373  vinfo( 'HDIV', 'horizontal divergence', '1/s', 3, 'ZXY', '' ), &
374  vinfo( 'Uabs', 'absolute velocity', 'm/s', 3, 'ZXY', 'wind_speed' ), &
375  vinfo( 'N2', 'squared Brunt-Vaisala frequency', '1/s2', 3, 'ZXY', 'square_of_brunt_vaisala_frequency_in_air' ), &
376  vinfo( 'PBLH', 'PBL height', 'm', 2, 'XY', 'atmosphere_boundary_layer_thickness' ), &
377  vinfo( 'MSE', 'moist static energy', 'm2/s2', 3, 'ZXY', '' ), &
378  vinfo( 'TDEW', 'dew point', 'K', 3, 'ZXY', 'dew_point_temperature' ), &
379  vinfo( 'CAPE', 'convective avail. pot. energy', 'm2/s2', 2, 'XY', 'atmosphere_specific_convective_available_potential_energy' ), &
380  vinfo( 'CIN', 'convection inhibition', 'm2/s2', 2, 'XY', '' ), &
381  vinfo( 'LCL', 'lifted condensation level', 'm', 2, 'XY', 'atmosphere_lifting_condensation_level' ), &
382  vinfo( 'LFC', 'level of free convection', 'm', 2, 'XY', 'atmosphere_level_of_free_convection' ), &
383  vinfo( 'LNB', 'level of neutral buoyancy', 'm', 2, 'XY', '' ), &
384  vinfo( 'ENGT', 'total energy', 'J/m3', 3, 'ZXY', '' ), &
385  vinfo( 'ENGP', 'potential energy', 'J/m3', 3, 'ZXY', '' ), &
386  vinfo( 'ENGK', 'kinetic energy', 'J/m3', 3, 'ZXY', '' ), &
387  vinfo( 'ENGI', 'internal energy', 'J/m3', 3, 'ZXY', '' ), &
388  vinfo( 'DENS_MEAN', 'horiz. mean of density', 'kg/m3', 1, 'Z', '' ), &
389  vinfo( 'W_MEAN', 'horiz. mean of w', 'm/s', 1, 'Z', '' ), &
390  vinfo( 'U_MEAN', 'horiz. mean of u', 'm/s', 1, 'Z', '' ), &
391  vinfo( 'V_MEAN', 'horiz. mean of v', 'm/s', 1, 'Z', '' ), &
392  vinfo( 'PT_MEAN', 'horiz. mean of pot.', 'K', 1, 'Z', '' ), &
393  vinfo( 'T_MEAN', 'horiz. mean of t', 'K', 1, 'Z', '' ), &
394  vinfo( 'QV_MEAN', 'horiz. mean of QV', '1', 1, 'Z', '' ), &
395  vinfo( 'QHYD_MEAN', 'horiz. mean of QHYD', '1', 1, 'Z', '' ), &
396  vinfo( 'QLIQ_MEAN', 'horiz. mean of QLIQ', '1', 1, 'Z', '' ), &
397  vinfo( 'QICE_MEAN', 'horiz. mean of QICE', '1', 1, 'Z', '' ), &
398  vinfo( 'DENS_PRIM', 'horiz. deviation of density', 'kg/m3', 3, 'ZXY', '' ), &
399  vinfo( 'W_PRIM', 'horiz. deviation of w', 'm/s', 3, 'ZXY', '' ), &
400  vinfo( 'U_PRIM', 'horiz. deviation of u', 'm/s', 3, 'ZXY', '' ), &
401  vinfo( 'V_PRIM', 'horiz. deviation of v', 'm/s', 3, 'ZXY', '' ), &
402  vinfo( 'PT_PRIM', 'horiz. deviation of pot. temp.', 'K', 3, 'ZXY', '' ), &
403  vinfo( 'W_PRIM2', 'variance of w', 'm2/s2', 3, 'ZXY', '' ), &
404  vinfo( 'PT_W_PRIM', 'resolved scale heat flux', 'W/s', 3, 'ZXY', '' ), &
405  vinfo( 'W_PRIM3', 'skewness of w', 'm3/s3', 3, 'ZXY', '' ), &
406  vinfo( 'TKE_RS', 'resolved scale TKE', 'm2/s2', 3, 'ZXY', '' ), &
407  vinfo( 'VELZ', 'velocity w at the half level', 'm/s', 3, 'ZHXY','' ), &
408  vinfo( 'VELX', 'velocity u at the half level', 'm/s', 3, 'ZXHY','' ), &
409  vinfo( 'VELY', 'velocity v at the half level', 'm/s', 3, 'ZXYH','' ), &
410  vinfo( 'Umet', 'eastward velocity', 'm/s', 3, 'ZXY', 'eastward_wind' ), &
411  vinfo( 'Vmet', 'northward velocity', 'm/s', 3, 'ZXY', 'northward_wind' ) /
412 
413  ! for history output and monitor
414  integer, private :: pv_hist_id (pv_nmax)
415  integer, private :: pv_monit_id(pv_nmax)
416  integer, private, allocatable :: qp_hist_id (:)
417  integer, private, allocatable :: qp_monit_id(:)
418  integer, private :: dv_hist_id (dv_nmax)
419  integer, private :: hist_id_gph
420 
421  integer, private, parameter :: im_qdry = 1
422  integer, private, parameter :: im_qtot = 2
423  integer, private, parameter :: im_evap = 3
424  integer, private, parameter :: im_prec = 4
425  integer, private, parameter :: im_engt = 5
426  integer, private, parameter :: im_engp = 6
427  integer, private, parameter :: im_engk = 7
428  integer, private, parameter :: im_engi = 8
429  integer, private, parameter :: im_engflxt = 9
430  integer, private, parameter :: im_engsfc_sh = 10
431  integer, private, parameter :: im_engsfc_lh = 11
432  integer, private, parameter :: im_engsfc_rd = 12
433  integer, private, parameter :: im_engtoa_rd = 13
434  integer, private, parameter :: im_engsfc_lw_up = 14
435  integer, private, parameter :: im_engsfc_lw_dn = 15
436  integer, private, parameter :: im_engsfc_sw_up = 16
437  integer, private, parameter :: im_engsfc_sw_dn = 17
438  integer, private, parameter :: im_engtoa_lw_up = 18
439  integer, private, parameter :: im_engtoa_lw_dn = 19
440  integer, private, parameter :: im_engtoa_sw_up = 20
441  integer, private, parameter :: im_engtoa_sw_dn = 21
442  integer, private, parameter :: dvm_nmax = 21
443  integer, private :: dv_monit_id(dvm_nmax)
444 
445 
446  logical, private :: moist
447  real(RP), private, target, allocatable :: zero(:,:,:)
448 
449 
450  ! for restart
451  integer, private :: restart_fid = -1 ! file ID
452  logical, private :: atmos_restart_in_check_coordinates = .true.
453 
454 
455  real(RP), private, allocatable :: work3d(:,:,:)
456  real(RP), private, allocatable :: work2d(:,:)
457  real(RP), private, allocatable :: work1d(:)
458 
459  !-----------------------------------------------------------------------------
460 contains
461  !-----------------------------------------------------------------------------
463  subroutine atmos_vars_setup
464  use scale_const, only: &
465  undef => const_undef
466  use scale_prc, only: &
467  prc_abort
468  use scale_file_history, only: &
470  use scale_monitor, only: &
472  use scale_atmos_hydrometeor, only: &
474  n_hyd, &
475  i_qv, &
476  i_hc, &
477  i_hr, &
478  i_hi, &
479  i_hs, &
480  i_hg, &
481  i_hh
482  use mod_atmos_admin, only: &
484  use mod_atmos_dyn_vars, only: &
486  use mod_atmos_phy_mp_vars, only: &
488  use mod_atmos_phy_ae_vars, only: &
490  use mod_atmos_phy_ch_vars, only: &
492  use mod_atmos_phy_rd_vars, only: &
494  use mod_atmos_phy_sf_vars, only: &
496  use mod_atmos_phy_tb_vars, only: &
498  use mod_atmos_phy_bl_vars, only: &
500  use mod_atmos_phy_cp_vars, only: &
502  implicit none
503 
504  namelist / param_atmos_vars / &
508  atmos_restart_in_check_coordinates, &
518  atmos_vars_checkrange, &
519  atmos_vars_checkcfl_soft, &
520  atmos_vars_checkcfl_hard
521 
522  integer :: ierr
523  integer :: iv, iq
524  !---------------------------------------------------------------------------
525 
526  log_newline
527  log_info("ATMOS_vars_setup",*) 'Setup'
528 
529  allocate( dens(ka,ia,ja) )
530  allocate( momz(ka,ia,ja) )
531  allocate( momx(ka,ia,ja) )
532  allocate( momy(ka,ia,ja) )
533  allocate( rhot(ka,ia,ja) )
534  allocate( qtrc(ka,ia,ja,max(qa,1)) )
535 
536  if ( atmos_use_average ) then
537  allocate( dens_avw(ka,ia,ja) )
538  allocate( momz_avw(ka,ia,ja) )
539  allocate( momx_avw(ka,ia,ja) )
540  allocate( momy_avw(ka,ia,ja) )
541  allocate( rhot_avw(ka,ia,ja) )
542  allocate( qtrc_avw(ka,ia,ja,max(qa,1)) )
543 
544  dens_av => dens_avw
545  momz_av => momz_avw
546  momx_av => momx_avw
547  momy_av => momy_avw
548  rhot_av => rhot_avw
549  qtrc_av => qtrc_avw
550  else
551  dens_av => dens
552  momz_av => momz
553  momx_av => momx
554  momy_av => momy
555  rhot_av => rhot
556  qtrc_av => qtrc
557  endif
558 
559  allocate( dens_tp(ka,ia,ja) )
560  allocate( momz_tp(ka,ia,ja) )
561  allocate( rhou_tp(ka,ia,ja) )
562  allocate( rhov_tp(ka,ia,ja) )
563  allocate( rhot_tp(ka,ia,ja) )
564  allocate( rhoh_p(ka,ia,ja) )
565  allocate( rhoq_tp(ka,ia,ja,max(qa,1)) )
566 
567  allocate( w(ka,ia,ja) )
568  allocate( u(ka,ia,ja) )
569  allocate( v(ka,ia,ja) )
570  w(:,:,:) = undef
571  u(:,:,:) = undef
572  v(:,:,:) = undef
573 
574  allocate( pott(ka,ia,ja) )
575  allocate( temp(ka,ia,ja) )
576  allocate( pres(ka,ia,ja) )
577  allocate( exner(ka,ia,ja) )
578  allocate( phyd(ka,ia,ja) )
579  allocate( phydh(0:ka,ia,ja) )
580  pott(:,:,:) = undef
581  temp(:,:,:) = undef
582  pres(:,:,:) = undef
583  exner(:,:,:) = undef
584  phyd(:,:,:) = undef
585  phydh(:,:,:) = undef
586 
587  allocate( qdry(ka,ia,ja) )
588  allocate( rtot(ka,ia,ja) )
589  allocate( cvtot(ka,ia,ja) )
590  allocate( cptot(ka,ia,ja) )
591  qdry(:,:,:) = undef
592  rtot(:,:,:) = undef
593  cvtot(:,:,:) = undef
594  cptot(:,:,:) = undef
595 
596  ! obsolute
597  allocate( momx_tp(ka,ia,ja) )
598  allocate( momy_tp(ka,ia,ja) )
599 
600 
601  momz(1:ks-1,:,:) = 0.0_rp
602  momz(ke:ka,:,:) = 0.0_rp
603 
604  allocate( work3d(ka,ia,ja) )
605  allocate( work2d( ia,ja) )
606  allocate( work1d(ka ) )
607 
608 
609  !--- read namelist
610  rewind(io_fid_conf)
611  read(io_fid_conf,nml=param_atmos_vars,iostat=ierr)
612  if( ierr < 0 ) then !--- missing
613  log_info("ATMOS_vars_setup",*) 'Not found namelist. Default used.'
614  elseif( ierr > 0 ) then !--- fatal error
615  log_error("ATMOS_vars_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_VARS. Check!'
616  call prc_abort
617  endif
618  log_nml(param_atmos_vars)
619 
620  log_newline
621  log_info("ATMOS_vars_setup",*) 'List of prognostic variables (ATMOS) '
622  log_info_cont('(1x,A,A24,A,A48,A,A12,A)') &
623  ' |', 'VARNAME ','|', &
624  'DESCRIPTION ', '[', 'UNIT ', ']'
625  do iv = 1, pv_nmax
626  log_info_cont('(1x,A,I3,A,A24,A,A48,A,A12,A)') &
627  'NO.',iv,'|',pv_info(iv)%NAME,'|', pv_info(iv)%DESC,'[', pv_info(iv)%UNIT,']'
628  enddo
629  do iq = 1, qa
630  log_info_cont('(1x,A,I3,A,A24,A,A48,A,A12,A)') &
631  'NO.',5+iq,'|',tracer_name(iq),'|', tracer_desc(iq),'[', tracer_unit(iq),']'
632  enddo
633 
634  log_newline
635  if ( atmos_restart_in_basename /= '' ) then
636  log_info("ATMOS_vars_setup",*) 'Restart input? : YES, file = ', trim(atmos_restart_in_basename)
637  log_info("ATMOS_vars_setup",*) 'Add timelabel? : ', atmos_restart_in_postfix_timelabel
638  else
639  log_info("ATMOS_vars_setup",*) 'Restart input? : NO'
640  endif
641  if ( atmos_restart_output &
642  .AND. atmos_restart_out_basename /= '' ) then
643  log_info("ATMOS_vars_setup",*) 'Restart output? : YES, file = ', trim(atmos_restart_out_basename)
644  log_info("ATMOS_vars_setup",*) 'Add timelabel? : ', atmos_restart_out_postfix_timelabel
645  else
646  log_info("ATMOS_vars_setup",*) 'Restart output? : NO'
647  atmos_restart_output = .false.
648  endif
649 
650  if ( atmos_restart_check_basename == '' ) then
651  atmos_restart_check = .false.
652  endif
653 
654  if ( atmos_vars_checkcfl_hard > 0.0_rp ) then
655  atmos_vars_checkcfl_soft = min( atmos_vars_checkcfl_soft, atmos_vars_checkcfl_hard )
656  endif
657 
658  log_newline
659  log_info("ATMOS_vars_setup",*) 'Check restart consistency? : ', atmos_restart_check
660  log_info("ATMOS_vars_setup",*) 'Check value range of variables? : ', atmos_vars_checkrange
661  if ( atmos_vars_checkcfl_soft > 0.0_rp ) then
662  log_info("ATMOS_vars_setup",*) 'Threshold of Courant number to warn : ', atmos_vars_checkcfl_soft
663  else
664  log_info("ATMOS_vars_setup",*) 'Threshold of Courant number to warn : disabled'
665  endif
666  if ( atmos_vars_checkcfl_hard > 0.0_rp ) then
667  log_info("ATMOS_vars_setup",*) 'Threshold of Courant number to stop : ', atmos_vars_checkcfl_hard
668  else
669  log_info("ATMOS_vars_setup",*) 'Threshold of Courant number to stop : disabled'
670  endif
671 
681 
682 
683  ! water content
684  if ( atmos_hydrometeor_dry ) then
685  allocate( zero(ka,ia,ja) )
686 !OCL XFILL
687  zero(:,:,:) = 0.0_rp
688 
689  qv => zero
690  qc => zero
691  qr => zero
692  qi => zero
693  qs => zero
694  qg => zero
695  qh => zero
696 
697  moist = .false.
698  else
699  allocate( qe(ka,ia,ja,n_hyd) )
700 !OCL XFILL
701  qe(:,:,:,:) = undef
702 
703  qv => qtrc_av(:,:,:,i_qv)
704  qc => qe(:,:,:,i_hc)
705  qr => qe(:,:,:,i_hr)
706  qi => qe(:,:,:,i_hi)
707  qs => qe(:,:,:,i_hs)
708  qg => qe(:,:,:,i_hg)
709  qh => qe(:,:,:,i_hh)
710 
711  moist = .true.
712  end if
713 
714 
715  dv_calculated(dv_nmax) = .false.
716 
717  !-----< history output setup >-----
718  allocate( qp_hist_id( max(qa,1) ) )
719  allocate( qp_monit_id( max(qa,1) ) )
720  pv_hist_id(:) = -1
721  pv_monit_id(:) = -1
722  qp_hist_id(:) = -1
723  qp_monit_id(:) = -1
724  dv_hist_id(:) = -1
725  dv_monit_id(:) = -1
726 
727 
728  do iv = 1, pv_nmax
729  call file_history_reg( pv_info(iv)%NAME, pv_info(iv)%DESC, pv_info(iv)%UNIT, pv_hist_id(iv), dim_type=pv_info(iv)%dim_type, standard_name=pv_info(iv)%STDNAME )
730  end do
731 
732  do iq = 1, qa
733  call file_history_reg( tracer_name(iq), tracer_desc(iq), tracer_unit(iq), qp_hist_id(iq), dim_type='ZXY' )
734  enddo
735 
736  do iv = 1, dv_nmax
737  call file_history_reg( dv_info(iv)%NAME, dv_info(iv)%DESC, dv_info(iv)%UNIT, dv_hist_id(iv), dim_type=dv_info(iv)%dim_type, standard_name=dv_info(iv)%STDNAME )
738  end do
739 
740  call file_history_reg( "GPH", "geopotential height", "m", hist_id_gph, dim_type='ZXY', standard_name="geopotential_height" )
741 
742 
743  !-----< monitor output setup >-----
744  do iv = 1, pv_nmax
745  call monitor_reg( pv_info(iv)%NAME, pv_info(iv)%DESC, trim(pv_info(iv)%UNIT)//"*m3", & ! (in)
746  pv_monit_id(iv), & ! (out)
747  dim_type=pv_info(iv)%dim_type, isflux=.false. ) ! (in)
748  end do
749  do iq = 1, qa
750  call monitor_reg( tracer_name(iq), tracer_desc(iq), tracer_unit(iq)//"*kg", & ! (in)
751  qp_monit_id(iq), & ! (out)
752  dim_type='ZXY', isflux=.false. ) ! (in)
753  enddo
754 
755  call monitor_reg( 'QDRY', 'dry air mass', 'kg', & ! (in)
756  dv_monit_id(im_qdry), & ! (out)
757  dim_type='ZXY', isflux=.false. ) ! (in)
758  call monitor_reg( 'QTOT', 'water mass', 'kg', & ! (in)
759  dv_monit_id(im_qtot), & ! (out)
760  dim_type='ZXY', isflux=.false. ) ! (in)
761  call monitor_reg( 'EVAP', 'evaporation at the surface', 'kg', & ! (in)
762  dv_monit_id(im_evap), & ! (out)
763  dim_type='XY', isflux=.true. ) ! (in)
764  call monitor_reg( 'PRCP', 'precipitation', 'kg', & ! (in)
765  dv_monit_id(im_prec), & ! (out)
766  dim_type='XY', isflux=.true. ) ! (in)
767 
768  call monitor_reg( 'ENGT', 'total energy', 'J', & ! (in)
769  dv_monit_id(im_engt), & ! (out)
770  dim_type='ZXY', isflux=.false. ) ! (in)
771  call monitor_reg( 'ENGP', 'potential energy', 'J', & ! (in)
772  dv_monit_id(im_engp), & ! (out)
773  dim_type='ZXY', isflux=.false. ) ! (in)
774  call monitor_reg( 'ENGK', 'kinetic energy', 'J', & ! (in)
775  dv_monit_id(im_engk), & ! (out)
776  dim_type='ZXY', isflux=.false. ) ! (in)
777  call monitor_reg( 'ENGI', 'internal energy', 'J', & ! (in)
778  dv_monit_id(im_engi), & ! (out)
779  dim_type='ZXY', isflux=.false. ) ! (in)
780 
781  call monitor_reg( 'ENGFLXT', 'total energy flux convergence', 'J', & ! (in)
782  dv_monit_id(im_engflxt), & ! (out)
783  dim_type='XY', isflux=.true. ) ! (in)
784  call monitor_reg( 'ENGSFC_SH', 'SFC specific heat flux', 'J', & ! (in)
785  dv_monit_id(im_engsfc_sh), & ! (out)
786  dim_type='XY', isflux=.true. ) ! (in)
787  call monitor_reg( 'ENGSFC_LH', 'SFC latent heat flux', 'J', & ! (in)
788  dv_monit_id(im_engsfc_lh), & ! (out)
789  dim_type='XY', isflux=.true. ) ! (in)
790  call monitor_reg( 'ENGSFC_RD', 'SFC net radiation flux', 'J', & ! (in)
791  dv_monit_id(im_engsfc_rd), & ! (out)
792  dim_type='XY', isflux=.true. ) ! (in)
793  call monitor_reg( 'ENGTOA_RD', 'TOA net radiation flux', 'J', & ! (in)
794  dv_monit_id(im_engtoa_rd), & ! (out)
795  dim_type='XY', isflux=.true. ) ! (in)
796 
797  call monitor_reg( 'ENGSFC_LW_up', 'SFC LW upward flux', 'J', & ! (in)
798  dv_monit_id(im_engsfc_lw_up), & ! (out)
799  dim_type='XY', isflux=.true. ) ! (in)
800  call monitor_reg( 'ENGSFC_LW_dn', 'SFC LW downward flux', 'J', & ! (in)
801  dv_monit_id(im_engsfc_lw_dn), & ! (out)
802  dim_type='XY', isflux=.true. ) ! (in)
803  call monitor_reg( 'ENGSFC_SW_up', 'SFC SW upward flux', 'J', & ! (in)
804  dv_monit_id(im_engsfc_sw_up), & ! (out)
805  dim_type='XY', isflux=.true. ) ! (in)
806  call monitor_reg( 'ENGSFC_SW_dn', 'SFC SW downward flux', 'J', & ! (in)
807  dv_monit_id(im_engsfc_sw_dn), & ! (out)
808  dim_type='XY', isflux=.true. ) ! (in)
809 
810  call monitor_reg( 'ENGTOA_LW_up', 'TOA LW upward flux', 'J', & ! (in)
811  dv_monit_id(im_engtoa_lw_up), & ! (out)
812  dim_type='XY', isflux=.true. ) ! (in)
813  call monitor_reg( 'ENGTOA_LW_dn', 'TOA LW downward flux', 'J', & ! (in)
814  dv_monit_id(im_engtoa_lw_dn), & ! (out)
815  dim_type='XY', isflux=.true. ) ! (in)
816  call monitor_reg( 'ENGTOA_SW_up', 'TOA SW upward flux', 'J', & ! (in)
817  dv_monit_id(im_engtoa_sw_up), & ! (out)
818  dim_type='XY', isflux=.true. ) ! (in)
819  call monitor_reg( 'ENGTOA_SW_dn', 'TOA SW downward flux', 'J', & ! (in)
820  dv_monit_id(im_engtoa_sw_dn), & ! (out)
821  dim_type='XY', isflux=.true. ) ! (in)
822 
823  return
824  end subroutine atmos_vars_setup
825 
826  !-----------------------------------------------------------------------------
828  subroutine atmos_vars_fillhalo( &
829  FILL_BND )
830  use scale_comm_cartesc, only: &
831  comm_vars8, &
832  comm_wait
833  implicit none
834 
835  logical, intent(in), optional :: FILL_BND
836 
837  logical :: FILL_BND_
838  integer :: i, j, iq
839  !---------------------------------------------------------------------------
840 
841  fill_bnd_ = .false.
842  if ( present(fill_bnd) ) fill_bnd_ = fill_bnd
843 
844  !$omp parallel do private(i,j) OMP_SCHEDULE_ collapse(2)
845  do j = jsb, jeb
846  do i = isb, ieb
847  dens( 1:ks-1,i,j) = dens(ks,i,j)
848  momz( 1:ks-2,i,j) = momz(ks-1,i,j)
849  momx( 1:ks-1,i,j) = momx(ks,i,j)
850  momy( 1:ks-1,i,j) = momy(ks,i,j)
851  rhot( 1:ks-1,i,j) = rhot(ks,i,j)
852  dens(ke+1:ka, i,j) = dens(ke,i,j)
853  momz(ke+1:ka, i,j) = momz(ke,i,j)
854  momx(ke+1:ka, i,j) = momx(ke,i,j)
855  momy(ke+1:ka, i,j) = momy(ke,i,j)
856  rhot(ke+1:ka, i,j) = rhot(ke,i,j)
857  enddo
858  enddo
859 
860  !$omp parallel do private(i,j,iq) OMP_SCHEDULE_ collapse(3)
861  do iq = 1, qa
862  do j = jsb, jeb
863  do i = isb, ieb
864  qtrc( 1:ks-1,i,j,iq) = qtrc(ks,i,j,iq)
865  qtrc(ke+1:ka, i,j,iq) = qtrc(ke,i,j,iq)
866  enddo
867  enddo
868  enddo
869 
870  call comm_vars8( dens(:,:,:), 1 )
871  call comm_vars8( momz(:,:,:), 2 )
872  call comm_vars8( momx(:,:,:), 3 )
873  call comm_vars8( momy(:,:,:), 4 )
874  call comm_vars8( rhot(:,:,:), 5 )
875  call comm_wait ( dens(:,:,:), 1, fill_bnd_ )
876  call comm_wait ( momz(:,:,:), 2, fill_bnd_ )
877  call comm_wait ( momx(:,:,:), 3, fill_bnd_ )
878  call comm_wait ( momy(:,:,:), 4, fill_bnd_ )
879  call comm_wait ( rhot(:,:,:), 5, fill_bnd_ )
880 
881  do iq = 1, qa
882  call comm_vars8( qtrc(:,:,:,iq), iq )
883  enddo
884  do iq = 1, qa
885  call comm_wait ( qtrc(:,:,:,iq), iq, fill_bnd_ )
886  enddo
887 
888  return
889  end subroutine atmos_vars_fillhalo
890 
891  !-----------------------------------------------------------------------------
893  subroutine atmos_vars_restart_open
894  use scale_prc, only: &
895  prc_abort
896  use scale_const, only: &
897  grav => const_grav
898  use scale_time, only: &
900  use scale_file_cartesc, only: &
902  file_cartesc_check_coordinates
903  use mod_atmos_admin, only: &
905  atmos_sw_dyn, &
906  atmos_sw_phy_mp, &
907  atmos_sw_phy_ae, &
908  atmos_sw_phy_ch, &
909  atmos_sw_phy_rd, &
910  atmos_sw_phy_sf, &
911  atmos_sw_phy_tb, &
913  use mod_atmos_dyn_vars, only: &
915  use mod_atmos_phy_mp_vars, only: &
917  use mod_atmos_phy_ae_vars, only: &
919  use mod_atmos_phy_ch_vars, only: &
921  use mod_atmos_phy_rd_vars, only: &
923  use mod_atmos_phy_sf_vars, only: &
925  use mod_atmos_phy_tb_vars, only: &
927  use mod_atmos_phy_cp_vars, only: &
929  use mod_cpl_admin, only: &
930  cpl_sw
931  implicit none
932 
933  character(len=19) :: timelabel
934  character(len=H_LONG) :: basename
935  !---------------------------------------------------------------------------
936 
937  log_newline
938  log_info("ATMOS_vars_restart_open",*) 'Open restart file (ATMOS) '
939 
940  if ( atmos_restart_in_basename /= '' ) then
941 
943  call time_gettimelabel( timelabel )
944  basename = trim(atmos_restart_in_basename)//'_'//trim(timelabel)
945  else
946  basename = trim(atmos_restart_in_basename)
947  endif
948 
949  log_info("ATMOS_vars_restart_open",*) 'basename: ', trim(basename)
950 
951  call file_cartesc_open( basename, restart_fid, aggregate=atmos_restart_in_aggregate )
952 
953  if ( atmos_restart_in_check_coordinates ) then
954  call file_cartesc_check_coordinates( restart_fid, atmos=.true. )
955  end if
956 
957  else
958  log_error("ATMOS_vars_restart_open",*) 'restart file for atmosphere is not specified. STOP!'
959  call prc_abort
960  endif
961 
962  if ( atmos_use_average ) then
963  dens_av(:,:,:) = dens(:,:,:)
964  momz_av(:,:,:) = momz(:,:,:)
965  momx_av(:,:,:) = momx(:,:,:)
966  momy_av(:,:,:) = momy(:,:,:)
967  rhot_av(:,:,:) = rhot(:,:,:)
968  qtrc_av(:,:,:,:) = qtrc(:,:,:,:)
969  endif
970 
976  if( atmos_sw_phy_sf .and. (.not. cpl_sw) ) call atmos_phy_sf_vars_restart_open
979 
980  return
981  end subroutine atmos_vars_restart_open
982 
983  !-----------------------------------------------------------------------------
985  subroutine atmos_vars_restart_read
986  use scale_prc, only: &
987  prc_abort
988  use scale_file, only: &
990  use scale_file_cartesc, only: &
991  file_cartesc_read, &
993  use mod_atmos_admin, only: &
995  atmos_sw_dyn, &
996  atmos_sw_phy_mp, &
997  atmos_sw_phy_ae, &
998  atmos_sw_phy_ch, &
999  atmos_sw_phy_rd, &
1000  atmos_sw_phy_sf, &
1001  atmos_sw_phy_tb, &
1003  use mod_atmos_dyn_vars, only: &
1005  use mod_atmos_phy_mp_vars, only: &
1007  use mod_atmos_phy_ae_vars, only: &
1009  use mod_atmos_phy_ch_vars, only: &
1011  use mod_atmos_phy_rd_vars, only: &
1013  use mod_atmos_phy_sf_vars, only: &
1015  use mod_atmos_phy_tb_vars, only: &
1017  use mod_atmos_phy_cp_vars, only: &
1019  use mod_cpl_admin, only: &
1020  cpl_sw
1021  implicit none
1022 
1023  integer :: i, j, iq
1024  !---------------------------------------------------------------------------
1025 
1026  if ( restart_fid /= -1 ) then
1027  log_newline
1028  log_info("ATMOS_vars_restart_read",*) 'Read from restart file (ATMOS) '
1029 
1030  call file_cartesc_read( restart_fid, pv_info(i_dens)%NAME, 'ZXY', & ! [IN]
1031  dens(:,:,:) ) ! [OUT]
1032  call file_cartesc_read( restart_fid, pv_info(i_momz)%NAME, 'ZHXY', & ! [IN]
1033  momz(:,:,:) ) ! [OUT]
1034  call file_cartesc_read( restart_fid, pv_info(i_momx)%NAME, 'ZXHY', & ! [IN]
1035  momx(:,:,:) ) ! [OUT]
1036  call file_cartesc_read( restart_fid, pv_info(i_momy)%NAME, 'ZXYH', & ! [IN]
1037  momy(:,:,:) ) ! [OUT]
1038  call file_cartesc_read( restart_fid, pv_info(i_rhot)%NAME, 'ZXY', & ! [IN]
1039  rhot(:,:,:) ) ! [OUT]
1040 
1041  do iq = 1, qa
1042  call file_cartesc_read( restart_fid, tracer_name(iq), 'ZXY', & ! [IN]
1043  qtrc(:,:,:,iq) ) ! [OUT]
1044  enddo
1045 
1046  if ( file_get_aggregate(restart_fid) ) then
1047  call file_cartesc_flush( restart_fid ) ! X/Y halos have been read from file
1048 
1049  ! fill k halos
1050  do j = 1, ja
1051  do i = 1, ia
1052  dens( 1:ks-1,i,j) = dens(ks,i,j)
1053  momz( 1:ks-2,i,j) = momz(ks-1,i,j)
1054  momx( 1:ks-1,i,j) = momx(ks,i,j)
1055  momy( 1:ks-1,i,j) = momy(ks,i,j)
1056  rhot( 1:ks-1,i,j) = rhot(ks,i,j)
1057  dens(ke+1:ka, i,j) = dens(ke,i,j)
1058  momz(ke+1:ka, i,j) = momz(ke,i,j)
1059  momx(ke+1:ka, i,j) = momx(ke,i,j)
1060  momy(ke+1:ka, i,j) = momy(ke,i,j)
1061  rhot(ke+1:ka, i,j) = rhot(ke,i,j)
1062  enddo
1063  enddo
1064  else
1065  call atmos_vars_fillhalo
1066  end if
1067 
1068  call atmos_vars_total
1069  else
1070  log_error("ATMOS_vars_restart_read",*) 'invalid restart file ID for atmosphere. STOP!'
1071  call prc_abort
1072  endif
1073 
1074  if ( atmos_use_average ) then
1075  dens_av(:,:,:) = dens(:,:,:)
1076  momz_av(:,:,:) = momz(:,:,:)
1077  momx_av(:,:,:) = momx(:,:,:)
1078  momy_av(:,:,:) = momy(:,:,:)
1079  rhot_av(:,:,:) = rhot(:,:,:)
1080  qtrc_av(:,:,:,:) = qtrc(:,:,:,:)
1081  endif
1082 
1088  if ( atmos_sw_phy_sf .and. (.not. cpl_sw) ) call atmos_phy_sf_vars_restart_read
1091 
1092  return
1093  end subroutine atmos_vars_restart_read
1094 
1095  !-----------------------------------------------------------------------------
1097  subroutine atmos_vars_history_setpres
1099  real_cz => atmos_grid_cartesc_real_cz, &
1100  real_z1 => atmos_grid_cartesc_real_z1
1101  use scale_topography, only: &
1102  topo_zsfc
1103  use scale_atmos_bottom, only: &
1104  bottom_estimate => atmos_bottom_estimate
1105  use scale_file_history_cartesc, only: &
1107  implicit none
1108 
1109  real(RP) :: SFC_DENS(ia,ja)
1110  real(RP) :: SFC_PRES(ia,ja)
1111  !---------------------------------------------------------------------------
1112 
1113  call bottom_estimate( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
1114  dens_av(:,:,:), pres(:,:,:), & ! [IN]
1115  real_cz(:,:,:), topo_zsfc(:,:), real_z1(:,:), & ! [IN]
1116  sfc_dens(:,:), sfc_pres(:,:) ) ! [OUT]
1117 
1118  call file_history_cartesc_set_pres( phyd(:,:,:), & ! [IN]
1119  phydh(:,:,:), & ! [IN]
1120  sfc_pres(:,:) ) ! [IN]
1121 
1122  return
1123  end subroutine atmos_vars_history_setpres
1124 
1125  !-----------------------------------------------------------------------------
1127  subroutine atmos_vars_restart_check
1128  use scale_prc, only: &
1129  prc_myrank
1130  use scale_file, only: &
1132  use scale_file_cartesc, only: &
1134  file_cartesc_read, &
1137  implicit none
1138 
1139  real(RP) :: DENS_check(ka,ia,ja) ! Density [kg/m3]
1140  real(RP) :: MOMZ_check(ka,ia,ja) ! momentum z [kg/s/m2]
1141  real(RP) :: MOMX_check(ka,ia,ja) ! momentum x [kg/s/m2]
1142  real(RP) :: MOMY_check(ka,ia,ja) ! momentum y [kg/s/m2]
1143  real(RP) :: RHOT_check(ka,ia,ja) ! DENS * POTT [K*kg/m3]
1144  real(RP) :: QTRC_check(ka,ia,ja,qa) ! tracer mixing ratio [kg/kg]
1145 
1146  character(len=H_LONG) :: basename
1147 
1148  logical :: datacheck
1149  integer :: k, i, j, iq
1150  integer :: fid
1151  !---------------------------------------------------------------------------
1152 
1153  call prof_rapstart('Debug')
1154 
1155  log_info("ATMOS_vars_restart_check",*) 'Compare last Data with ', trim(atmos_restart_check_basename), 'on PE=', prc_myrank
1156  log_info("ATMOS_vars_restart_check",*) 'criterion = ', atmos_restart_check_criterion
1157  datacheck = .true.
1158 
1159  basename = atmos_restart_check_basename
1160 
1161  call file_cartesc_open( basename, fid )
1162 
1163  call file_cartesc_read( fid, 'DENS', 'ZXY' , dens_check(:,:,:) )
1164  call file_cartesc_read( fid, 'MOMZ', 'ZHXY', momz_check(:,:,:) )
1165  call file_cartesc_read( fid, 'MOMX', 'ZXHY', momx_check(:,:,:) )
1166  call file_cartesc_read( fid, 'MOMY', 'ZXYH', momy_check(:,:,:) )
1167  call file_cartesc_read( fid, 'RHOT', 'ZXY' , rhot_check(:,:,:) )
1168  do iq = 1, qa
1169  call file_cartesc_read( fid, tracer_name(iq), 'ZXY', qtrc_check(:,:,:,iq) )
1170  end do
1171  if ( file_get_aggregate(fid) ) call file_cartesc_flush( fid )
1172 
1173  call file_cartesc_close( fid ) ! [IN]
1174 
1175  do k = ks, ke
1176  do j = js, je
1177  do i = is, ie
1178  if ( abs( dens(k,i,j)-dens_check(k,i,j) ) > atmos_restart_check_criterion ) then
1179  log_error("ATMOS_vars_restart_check",*) 'there is the difference : ', dens(k,i,j)-dens_check(k,i,j)
1180  log_error_cont(*) 'at (PE-id,k,i,j,varname) : ', prc_myrank, k, i, j, 'DENS'
1181  datacheck = .false.
1182  endif
1183  enddo
1184  enddo
1185  enddo
1186 
1187  do k = ks-1, ke
1188  do j = js, je
1189  do i = is, ie
1190  if ( abs( momz(k,i,j)-momz_check(k,i,j) ) > atmos_restart_check_criterion ) then
1191  log_error("ATMOS_vars_restart_check",*) 'there is the difference : ', momz(k,i,j)-momz_check(k,i,j)
1192  log_error_cont(*) 'at (PE-id,k,i,j,varname) : ', prc_myrank, k, i, j, 'MOMZ'
1193  datacheck = .false.
1194  endif
1195  enddo
1196  enddo
1197  enddo
1198 
1199  do k = ks, ke
1200  do j = js, je
1201  do i = is, ie
1202  if ( abs( momx(k,i,j)-momx_check(k,i,j) ) > atmos_restart_check_criterion ) then
1203  log_error("ATMOS_vars_restart_check",*) 'there is the difference : ', momx(k,i,j)-momx_check(k,i,j)
1204  log_error_cont(*) 'at (PE-id,k,i,j,varname) : ', prc_myrank, k, i, j, 'MOMX'
1205  datacheck = .false.
1206  endif
1207  enddo
1208  enddo
1209  enddo
1210 
1211  do k = ks, ke
1212  do j = js, je
1213  do i = is, ie
1214  if ( abs( momy(k,i,j)-momy_check(k,i,j) ) > atmos_restart_check_criterion ) then
1215  log_error("ATMOS_vars_restart_check",*) 'there is the difference : ', momy(k,i,j)-momy_check(k,i,j)
1216  log_error_cont(*) 'at (PE-id,k,i,j,varname) : ', prc_myrank, k, i, j, 'MOMY'
1217  datacheck = .false.
1218  endif
1219  enddo
1220  enddo
1221  enddo
1222 
1223  do k = ks, ke
1224  do j = js, je
1225  do i = is, ie
1226  if ( abs( rhot(k,i,j)-rhot_check(k,i,j) ) > atmos_restart_check_criterion ) then
1227  log_error("ATMOS_vars_restart_check",*) 'there is the difference : ', rhot(k,i,j)-rhot_check(k,i,j)
1228  log_error_cont(*) 'at (PE-id,k,i,j,varname) : ', prc_myrank, k, i, j, 'RHOT'
1229  datacheck = .false.
1230  endif
1231  enddo
1232  enddo
1233  enddo
1234 
1235  do iq = 1, qa
1236  do k = ks, ke
1237  do j = js, je
1238  do i = is, ie
1239  if ( abs( qtrc(k,i,j,iq)-qtrc_check(k,i,j,iq) ) > atmos_restart_check_criterion ) then
1240  log_error("ATMOS_vars_restart_check",*) 'there is the difference : ', qtrc(k,i,j,iq)-qtrc_check(k,i,j,iq)
1241  log_error_cont(*) 'at (PE-id,k,i,j,varname) : ', prc_myrank, k, i, j, tracer_name(iq)
1242  datacheck = .false.
1243  endif
1244  enddo
1245  enddo
1246  enddo
1247  enddo
1248 
1249  if (datacheck) then
1250  log_info("ATMOS_vars_restart_check",*) 'Data Check Clear.'
1251  else
1252  log_info("ATMOS_vars_restart_check",*) 'Data Check Failed. See std. output.'
1253  log_error("ATMOS_vars_restart_check",*) 'Data Check Failed.'
1254  endif
1255 
1256  call prof_rapend('Debug')
1257 
1258  return
1259  end subroutine atmos_vars_restart_check
1260 
1261  !-----------------------------------------------------------------------------
1263  subroutine atmos_vars_history
1264  use scale_file_history, only: &
1265  file_history_query, &
1266  file_history_put
1267  use scale_atmos_grid_cartesc_real, only: &
1268  real_cz => atmos_grid_cartesc_real_cz
1269  use mod_atmos_phy_mp_vars, only: &
1271  use mod_atmos_phy_ae_vars, only: &
1273  implicit none
1274 
1275  logical :: do_put
1276  integer :: iq, iv
1277  !---------------------------------------------------------------------------
1278 
1279  call prof_rapstart('ATM_History', 1)
1280 
1281  ! value check for prognostic variables
1282  if ( atmos_vars_checkrange ) then
1283  call valcheck( dens(:,:,:), 0.0_rp, 2.0_rp, pv_info(i_dens)%NAME, __file__, __line__ )
1284  call valcheck( momz(:,:,:), -200.0_rp, 200.0_rp, pv_info(i_momz)%NAME, __file__, __line__ )
1285  call valcheck( momx(:,:,:), -200.0_rp, 200.0_rp, pv_info(i_momx)%NAME, __file__, __line__ )
1286  call valcheck( momy(:,:,:), -200.0_rp, 200.0_rp, pv_info(i_momy)%NAME, __file__, __line__ )
1287  call valcheck( rhot(:,:,:), 0.0_rp, 1000.0_rp, pv_info(i_rhot)%NAME, __file__, __line__ )
1288  endif
1289 
1290  ! history output of prognostic variables
1291  call file_history_put ( pv_hist_id(i_dens), dens(:,:,:) )
1292  call file_history_put ( pv_hist_id(i_momz), momz(:,:,:) )
1293  call file_history_put ( pv_hist_id(i_momx), momx(:,:,:) )
1294  call file_history_put ( pv_hist_id(i_momy), momy(:,:,:) )
1295  call file_history_put ( pv_hist_id(i_rhot), rhot(:,:,:) )
1296  do iq = 1, qa
1297  call file_history_put ( qp_hist_id(iq), qtrc(:,:,:,iq) )
1298  enddo
1299 
1300 
1301  ! history output of diagnostic variables
1302  call file_history_put ( dv_hist_id(i_w ), w(:,:,:) )
1303  call file_history_put ( dv_hist_id(i_u ), u(:,:,:) )
1304  call file_history_put ( dv_hist_id(i_v ), v(:,:,:) )
1305  call file_history_put ( dv_hist_id(i_pott ), pott(:,:,:) )
1306  call file_history_put ( dv_hist_id(i_temp ), temp(:,:,:) )
1307  call file_history_put ( dv_hist_id(i_pres ), pres(:,:,:) )
1308 
1309  call file_history_put ( dv_hist_id(i_exner), exner(:,:,:) )
1310  call file_history_put ( dv_hist_id(i_phyd ), phyd(:,:,:) )
1311 
1312  call file_history_put ( dv_hist_id(i_qdry ), qdry(:,:,:) )
1313  call file_history_put ( dv_hist_id(i_rtot ), rtot(:,:,:) )
1314  call file_history_put ( dv_hist_id(i_cvtot), cvtot(:,:,:) )
1315  call file_history_put ( dv_hist_id(i_cptot), cptot(:,:,:) )
1316 
1317  do iv = i_cptot+1, dv_nmax
1318  if ( dv_hist_id(iv) > 0 ) then
1319  call file_history_query( dv_hist_id(iv), do_put )
1320 
1321  if ( do_put ) then
1322  select case( dv_info(iv)%ndims )
1323  case( 3 )
1324  call atmos_vars_get_diagnostic( dv_info(iv)%NAME, work3d(:,:,:) )
1325  call file_history_put( dv_hist_id(iv), work3d(:,:,:) )
1326  case( 2 )
1327  call atmos_vars_get_diagnostic( dv_info(iv)%NAME, work2d(:,:) )
1328  call file_history_put( dv_hist_id(iv), work2d(:,:) )
1329  case( 1 )
1330  call atmos_vars_get_diagnostic( dv_info(iv)%NAME, work1d(:) )
1331  call file_history_put( dv_hist_id(iv), work1d(:) )
1332  end select
1333  endif
1334  endif
1335  enddo
1336 
1337  call file_history_put( hist_id_gph, real_cz(:,:,:) )
1338 
1339 
1340  if ( moist ) &
1341  call atmos_phy_mp_vars_history( dens_av(:,:,:), temp(:,:,:), qtrc_av(:,:,:,:) )
1342 ! if ( .false. ) then
1343 ! call ATMOS_vars_get_diagnostic( "RH", WORK3D(:,:,:) )
1344 ! call ATMOS_PHY_AE_vars_history( QTRC_av(:,:,:,:), WORK3D(:,:,:) )
1345 ! end if
1346 
1347  call prof_rapend ('ATM_History', 1)
1348 
1349  return
1350  end subroutine atmos_vars_history
1351 
1352  !-----------------------------------------------------------------------------
1354  subroutine atmos_vars_total
1355  use scale_const, only: &
1356  grav => const_grav, &
1357  cvdry => const_cvdry
1358  use scale_statistics, only: &
1360  statistics_total
1361  use scale_atmos_grid_cartesc_real, only: &
1370  implicit none
1371 
1372  real(RP) :: RHOQ(ka,ia,ja)
1373  integer :: iq
1374  !---------------------------------------------------------------------------
1375 
1376  if ( statistics_checktotal ) then
1377 
1378  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1379  dens(:,:,:), pv_info(i_dens)%NAME, & ! (in)
1380  atmos_grid_cartesc_real_vol(:,:,:), & ! (in)
1382  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1383  momz(:,:,:), pv_info(i_momz)%NAME, & ! (in)
1384  atmos_grid_cartesc_real_volwxy(:,:,:), & ! (in)
1386  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1387  momx(:,:,:), pv_info(i_momx)%NAME, & ! (in)
1388  atmos_grid_cartesc_real_volzuy(:,:,:), & ! (in)
1390  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1391  momy(:,:,:), pv_info(i_momy)%NAME, & ! (in)
1392  atmos_grid_cartesc_real_volzxv(:,:,:), & ! (in)
1394  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1395  rhot(:,:,:), pv_info(i_rhot)%NAME, & ! (in)
1396  atmos_grid_cartesc_real_vol(:,:,:), & ! (in)
1398 
1399  do iq = 1, qa
1400  rhoq(:,:,:) = dens(:,:,:) * qtrc(:,:,:,iq)
1401 
1402  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1403  rhoq(:,:,:), tracer_name(iq), & ! (in)
1404  atmos_grid_cartesc_real_vol(:,:,:), & ! (in)
1406  enddo
1407 
1409 
1410 
1411  rhoq(ks:ke,is:ie,js:je) = dens(ks:ke,is:ie,js:je) * qdry(ks:ke,is:ie,js:je)
1412  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1413  rhoq(:,:,:), 'QDRY', & ! (in)
1414  atmos_grid_cartesc_real_vol(:,:,:), & ! (in)
1416 
1417  rhoq(ks:ke,is:ie,js:je) = dens(ks:ke,is:ie,js:je) * ( 1.0_rp - qdry(ks:ke,is:ie,js:je) ) ! Qtotal
1418  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1419  rhoq(:,:,:), 'QTOT', & ! (in)
1420  atmos_grid_cartesc_real_vol(:,:,:), & ! (in)
1422 
1423 
1424  call atmos_vars_get_diagnostic( 'ENGT', work3d(:,:,:) )
1425  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1426  work3d(:,:,:), 'ENGT', & ! (in)
1427  atmos_grid_cartesc_real_vol(:,:,:), & ! (in)
1429  call atmos_vars_get_diagnostic( 'ENGP', work3d(:,:,:) )
1430  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1431  work3d(:,:,:), 'ENGP', & ! (in)
1432  atmos_grid_cartesc_real_vol(:,:,:), & ! (in)
1434  call atmos_vars_get_diagnostic( 'ENGK', work3d(:,:,:) )
1435  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1436  work3d(:,:,:), 'ENGK', & ! (in)
1437  atmos_grid_cartesc_real_vol(:,:,:), & ! (in)
1439  call atmos_vars_get_diagnostic( 'ENGI', work3d(:,:,:) )
1440  call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
1441  work3d(:,:,:), 'ENGI', & ! (in)
1442  atmos_grid_cartesc_real_vol(:,:,:), & ! (in)
1444 
1445  endif
1446 
1447  return
1448  end subroutine atmos_vars_total
1449 
1450  !-----------------------------------------------------------------------------
1452  subroutine atmos_vars_calc_diagnostics
1454  real_cz => atmos_grid_cartesc_real_cz, &
1455  real_fz => atmos_grid_cartesc_real_fz
1456  use scale_atmos_thermodyn, only: &
1457  atmos_thermodyn_specific_heat
1458  use scale_atmos_diagnostic, only: &
1461  use scale_atmos_diagnostic_cartesc, only: &
1463  use scale_comm_cartesc, only: &
1464  comm_vars8, &
1465  comm_wait
1466  use scale_atmos_hydrometeor, only: &
1467  n_hyd
1468  use mod_atmos_phy_mp_vars, only: &
1471  use mod_atmos_phy_ae_vars, only: &
1473  implicit none
1474 
1475  integer :: iq
1476 
1477  call atmos_thermodyn_specific_heat( &
1478  ka, ks, ke, ia, 1, ia, ja, 1, ja, qa, &
1479  qtrc_av(:,:,:,:), & ! (in)
1480  tracer_mass(:), tracer_r(:), tracer_cv(:), tracer_cp(:), & ! (in)
1481  qdry(:,:,:), rtot(:,:,:), cvtot(:,:,:), cptot(:,:,:) ) ! (out)
1482 
1484  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1485  dens_av(:,:,:), momz_av(:,:,:), momx_av(:,:,:), momy_av(:,:,:), & ! (in)
1486  w(:,:,:), u(:,:,:), v(:,:,:) ) ! (out)
1487 
1489  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1490  dens_av(:,:,:), rhot_av(:,:,:), & ! (in)
1491  rtot(:,:,:), cvtot(:,:,:), cptot(:,:,:), & ! (in)
1492  pott(:,:,:), temp(:,:,:), pres(:,:,:), exner(:,:,:) ) ! (out)
1493 
1495  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1496  dens_av(:,:,:), pres(:,:,:), & ! (in)
1497  real_cz(:,:,:), real_fz(:,:,:), & ! (in)
1498  phyd(:,:,:), phydh(:,:,:) ) ! (out)
1499 
1502 
1503  if ( moist ) then
1505  dens_av(:,:,:), temp(:,:,:), qtrc_av(:,:,:,:), & ! (in)
1506  qe=qe(:,:,:,:) ) ! (out)
1507  do iq = 1, n_hyd
1508  call comm_vars8(qe(:,:,:,iq), iq)
1509  end do
1510  do iq = 1, n_hyd
1511  call comm_wait (qe(:,:,:,iq), iq)
1512  end do
1513  end if
1514 
1515  ! reset diagnostic variables
1516  dv_calculated(:) = .false.
1517 
1518  return
1519  end subroutine atmos_vars_calc_diagnostics
1520 
1521  !-----------------------------------------------------------------------------
1523  recursive subroutine atmos_vars_get_diagnostic_3d( &
1524  vname, &
1525  var )
1526  use scale_const, only: &
1527  grav => const_grav, &
1528  rvap => const_rvap, &
1529  cpdry => const_cpdry, &
1530  cvdry => const_cvdry
1531  use scale_prc, only: &
1532  prc_abort
1533  use scale_atmos_grid_cartesc, only: &
1534  rcdx => atmos_grid_cartesc_rcdx, &
1535  rcdy => atmos_grid_cartesc_rcdy
1536  use scale_atmos_grid_cartesc_real, only: &
1537  real_cz => atmos_grid_cartesc_real_cz, &
1538  real_fz => atmos_grid_cartesc_real_fz
1539  use scale_atmos_grid_cartesc_metric, only: &
1541  use scale_comm_cartesc, only: &
1542  comm_vars8, &
1543  comm_wait
1544  use scale_atmos_hydrometeor, only: &
1545  lhvc => lhv, &
1546  lhfc => lhf, &
1547  atmos_hydrometeor_lhv, &
1548  atmos_hydrometeor_lhf, &
1549  atmos_hydrometeor_lhs
1550  use scale_atmos_saturation, only: &
1551  atmos_saturation_dens2qsat_all, &
1552  atmos_saturation_psat_all, &
1553  atmos_saturation_psat_liq, &
1554  atmos_saturation_psat_ice, &
1555  atmos_saturation_tdew_liq, &
1556  atmos_saturation_pote
1557  use scale_atmos_diagnostic, only: &
1561  implicit none
1562  character(len=*), intent(in) :: vname
1563  real(RP), intent(out) :: var(:,:,:)
1564 
1565  real(RP) :: UH (ka,ia,ja)
1566  real(RP) :: VH (ka,ia,ja)
1567 
1568  real(RP) :: WORK(ka,ia,ja)
1569 
1570  integer :: k, i, j, iq
1571 
1572  select case ( vname )
1573  case ( 'W' )
1574  var(:,:,:) = w(:,:,:)
1575 
1576  case ( 'U' )
1577  var(:,:,:) = u(:,:,:)
1578 
1579  case ( 'V' )
1580  var(:,:,:) = v(:,:,:)
1581 
1582  case ( 'PT' )
1583  var(:,:,:) = pott(:,:,:)
1584 
1585  case ( 'T' )
1586  var(:,:,:) = temp(:,:,:)
1587 
1588  case ( 'EXNER' )
1589  var(:,:,:) = exner(:,:,:)
1590 
1591  case ( 'PHYD' )
1592  var(:,:,:) = phyd(:,:,:)
1593 
1594  case ( 'QDRY' )
1595  var(:,:,:) = qdry(:,:,:)
1596 
1597  case ( 'RTOT' )
1598  var(:,:,:) = rtot(:,:,:)
1599 
1600  case ( 'CVTOT' )
1601  var(:,:,:) = cvtot(:,:,:)
1602 
1603  case ( 'CPTOT' )
1604  var(:,:,:) = cptot(:,:,:)
1605 
1606  case ( 'LHV' )
1607  if ( .not. dv_calculated(i_lhv) ) then
1608  call allocate_3d( lhv )
1609  call atmos_hydrometeor_lhv( &
1610  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1611  temp(:,:,:), & ! (in)
1612  lhv(:,:,:) ) ! (out)
1613  dv_calculated(i_lhv) = .true.
1614  end if
1615  var(ks:ke,:,:) = lhv(ks:ke,:,:)
1616 
1617  case ( 'LHS' )
1618  if ( .not. dv_calculated(i_lhs) ) then
1619  call allocate_3d( lhs )
1620  call atmos_hydrometeor_lhs( &
1621  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1622  temp(:,:,:), & ! (in)
1623  lhs(:,:,:) ) ! (out)
1624  dv_calculated(i_lhs) = .true.
1625  end if
1626  var(ks:ke,:,:) = lhs(ks:ke,:,:)
1627 
1628  case ( 'LHF' )
1629  if ( .not. dv_calculated(i_lhf) ) then
1630  call allocate_3d( lhf )
1631  call atmos_hydrometeor_lhf( &
1632  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1633  temp(:,:,:), & ! (in)
1634  lhf(:,:,:) ) ! (out)
1635  dv_calculated(i_lhf) = .true.
1636  end if
1637  var(ks:ke,:,:) = lhf(ks:ke,:,:)
1638 
1639  case ( 'POTV' )
1640  if ( .not. dv_calculated(i_potv) ) then
1641  call allocate_3d( potv )
1643  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1644  pott(:,:,:), rtot(:,:,:), & ! (in)
1645  potv(:,:,:) ) ! (out)
1646  dv_calculated(i_potv) = .true.
1647  end if
1648  var(ks:ke,:,:) = potv(ks:ke,:,:)
1649 
1650  case ( 'TEML' )
1651  if ( .not. dv_calculated(i_teml) ) then
1652  call allocate_3d( teml )
1653  call atmos_vars_get_diagnostic( 'LHV', work3d(:,:,:) )
1654  call atmos_vars_get_diagnostic( 'LHS', work3d(:,:,:) )
1655  call atmos_vars_get_diagnostic( 'QLIQ', work3d(:,:,:) )
1656  call atmos_vars_get_diagnostic( 'QICE', work3d(:,:,:) )
1658  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1659  temp(:,:,:), lhv(:,:,:), lhs(:,:,:), & ! (in)
1660  qc(:,:,:), qi(:,:,:), cptot(:,:,:), & ! (in)
1661  teml(:,:,:) ) ! (out)
1662  dv_calculated(i_teml) = .true.
1663  end if
1664  var(ks:ke,:,:) = teml(ks:ke,:,:)
1665 
1666  case ( 'POTL' )
1667  if ( .not. dv_calculated(i_potl) ) then
1668  call allocate_3d( potl )
1669  call atmos_vars_get_diagnostic( 'TEML', work3d(:,:,:) )
1670 !OCL XFILL
1671  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1672  !$omp private(i,j,k) &
1673  !$omp shared(POTL,TEML,EXNER) &
1674  !$omp shared(KS,KE,IA,JA)
1675  do j = 1, ja
1676  do i = 1, ia
1677  do k = ks, ke
1678  potl(k,i,j) = teml(k,i,j) / exner(k,i,j)
1679  enddo
1680  enddo
1681  enddo
1682  dv_calculated(i_potl) = .true.
1683  end if
1684  var(ks:ke,:,:) = potl(ks:ke,:,:)
1685 
1686  case ( 'POTE' )
1687  if ( .not. dv_calculated(i_pote) ) then
1688  call allocate_3d( pote )
1689  call atmos_saturation_pote( &
1690  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1691  dens(:,:,:), pott(:,:,:), temp(:,:,:), qv(:,:,:), & ! [IN]
1692  pote(:,:,:) ) ! [OUT]
1693  end if
1694  var(ks:ke,:,:) = pote(ks:ke,:,:)
1695  case ( 'QTOT' )
1696  if ( .not. dv_calculated(i_qtot) ) then
1697  call allocate_3d( qtot )
1698  if ( moist ) then
1699  call atmos_vars_get_diagnostic( 'QHYD', work3d(:,:,:) )
1700 !OCL XFILL
1701  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1702  !$omp private(i,j,k) &
1703  !$omp shared(QTOT,QV,QHYD) &
1704  !$omp shared(KS,KE,IA,JA)
1705  do j = 1, ja
1706  do i = 1, ia
1707  do k = ks, ke
1708  qtot(k,i,j) = qv(k,i,j) + qhyd(k,i,j)
1709  enddo
1710  enddo
1711  enddo
1712  else
1713 !OCL XFILL
1714  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1715  !$omp private(i,j,k) &
1716  !$omp shared(QTOT) &
1717  !$omp shared(KS,KE,IA,JA)
1718  do j = 1, ja
1719  do i = 1, ia
1720  do k = ks, ke
1721  qtot(k,i,j) = 0.0_rp
1722  enddo
1723  enddo
1724  enddo
1725  end if
1726  dv_calculated(i_qtot) = .true.
1727  end if
1728  var(ks:ke,:,:) = qtot(ks:ke,:,:)
1729 
1730  case ( 'QHYD' )
1731  if ( .not. dv_calculated(i_qhyd) ) then
1732  call allocate_3d( qhyd )
1733  if ( moist ) then
1734  call atmos_vars_get_diagnostic( 'QLIQ', work3d(:,:,:) )
1735  call atmos_vars_get_diagnostic( 'QICE', work3d(:,:,:) )
1736 !OCL XFILL
1737  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1738  !$omp private(i,j,k) &
1739  !$omp shared(QHYD,QLIQ,QICE) &
1740  !$omp shared(KS,KE,IA,JA)
1741  do j = 1, ja
1742  do i = 1, ia
1743  do k = ks, ke
1744  qhyd(k,i,j) = qliq(k,i,j) + qice(k,i,j)
1745  enddo
1746  enddo
1747  enddo
1748  else
1749 !OCL XFILL
1750  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1751  !$omp private(i,j,k) &
1752  !$omp shared(QHYD) &
1753  !$omp shared(KS,KE,IA,JA)
1754  do j = 1, ja
1755  do i = 1, ia
1756  do k = ks, ke
1757  qhyd(k,i,j) = 0.0_rp
1758  enddo
1759  enddo
1760  enddo
1761  end if
1762  dv_calculated(i_qhyd) = .true.
1763  end if
1764  var(ks:ke,:,:) = qhyd(ks:ke,:,:)
1765 
1766  case ( 'QLIQ' )
1767  if ( .not. dv_calculated(i_qliq) ) then
1768  call allocate_3d( qliq )
1769  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1770  !$omp private(i,j,k,iq) &
1771  !$omp shared(QLIQ,QC,QR) &
1772  !$omp shared(KS,KE,IA,JA)
1773  do j = 1, ja
1774  do i = 1, ia
1775  do k = ks, ke
1776 !OCL XFILL
1777  qliq(k,i,j) = qc(k,i,j) + qr(k,i,j)
1778  enddo
1779  enddo
1780  enddo
1781  dv_calculated(i_qliq) = .true.
1782  end if
1783  var(ks:ke,:,:) = qliq(ks:ke,:,:)
1784 
1785  case ( 'QICE' )
1786  if ( .not. dv_calculated(i_qice) ) then
1787  call allocate_3d( qice )
1788 !OCL XFILL
1789  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1790  !$omp private(i,j,k,iq) &
1791  !$omp shared(QICE,QI,QS,QG,QH) &
1792  !$omp shared(KS,KE,IA,JA)
1793  do j = 1, ja
1794  do i = 1, ia
1795  do k = ks, ke
1796  qice(k,i,j) = qi(k,i,j) + qs(k,i,j) + qg(k,i,j) + qh(k,i,j)
1797  enddo
1798  enddo
1799  enddo
1800  dv_calculated(i_qice) = .true.
1801  end if
1802  var(ks:ke,:,:) = qice(ks:ke,:,:)
1803 
1804  case ( 'QSAT' )
1805  if ( .not. dv_calculated(i_qsat) ) then
1806  call allocate_3d( qsat )
1807  call atmos_saturation_dens2qsat_all( &
1808  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1809  temp(:,:,:), dens_av(:,:,:), & ! (in)
1810  qsat(:,:,:) ) ! (out)
1811  dv_calculated(i_qsat) = .true.
1812  end if
1813  var(ks:ke,:,:) = qsat(ks:ke,:,:)
1814 
1815  case ( 'RHA' )
1816  if ( .not. dv_calculated(i_rha) ) then
1817  call allocate_3d( rha )
1818  if ( moist ) then
1819  call atmos_saturation_psat_all( &
1820  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1821  temp(:,:,:), & ! (in)
1822  work(:,:,:) ) ! (out)
1823 !OCL XFILL
1824  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1825  !$omp private(i,j,k) &
1826  !$omp shared(RHA,DENS_av,QV,WORK,TEMP) &
1827  !$omp shared(KS,KE,IA,JA)
1828  do j = 1, ja
1829  do i = 1, ia
1830  do k = ks, ke
1831  rha(k,i,j) = dens_av(k,i,j) * qv(k,i,j) &
1832  / work(k,i,j) * rvap * temp(k,i,j) &
1833  * 100.0_rp
1834  enddo
1835  enddo
1836  enddo
1837  else
1838 !OCL XFILL
1839  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1840  !$omp private(i,j,k) &
1841  !$omp shared(RHA) &
1842  !$omp shared(KS,KE,IA,JA)
1843  do j = 1, ja
1844  do i = 1, ia
1845  do k = ks, ke
1846  rha(k,i,j) = 0.0_rp
1847  enddo
1848  enddo
1849  enddo
1850  end if
1851  dv_calculated(i_rha) = .true.
1852  end if
1853  var(ks:ke,:,:) = rha(ks:ke,:,:)
1854 
1855  case ( 'RHL', 'RH' )
1856  if ( .not. dv_calculated(i_rhl) ) then
1857  call allocate_3d( rhl )
1858  if ( moist ) then
1859  call atmos_saturation_psat_liq( &
1860  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1861  temp(:,:,:), & ! (in)
1862  work(:,:,:) ) ! (out)
1863 !OCL XFILL
1864  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1865  !$omp private(i,j,k) &
1866  !$omp shared(RHL,DENS_av,QV,WORK,TEMP) &
1867  !$omp shared(KS,KE,IA,JA)
1868  do j = 1, ja
1869  do i = 1, ia
1870  do k = ks, ke
1871  rhl(k,i,j) = dens_av(k,i,j) * qv(k,i,j) &
1872  / work(k,i,j) * rvap * temp(k,i,j) &
1873  * 100.0_rp
1874  enddo
1875  enddo
1876  enddo
1877  else
1878 !OCL XFILL
1879  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1880  !$omp private(i,j,k) &
1881  !$omp shared(RHL) &
1882  !$omp shared(KS,KE,IA,JA)
1883  do j = 1, ja
1884  do i = 1, ia
1885  do k = ks, ke
1886  rhl(k,i,j) = 0.0_rp
1887  enddo
1888  enddo
1889  enddo
1890  end if
1891  dv_calculated(i_rhl) = .true.
1892  end if
1893  var(ks:ke,:,:) = rhl(ks:ke,:,:)
1894 
1895  case ( 'RHI' )
1896  if ( .not. dv_calculated(i_rhi) ) then
1897  call allocate_3d( rhi )
1898  if ( moist ) then
1899  call atmos_saturation_psat_ice( &
1900  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1901  temp(:,:,:), & ! (int)
1902  work(:,:,:) ) ! (out)
1903 !OCL XFILL
1904  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1905  !$omp private(i,j,k) &
1906  !$omp shared(RHI,DENS_av,QV,WORK,TEMP) &
1907  !$omp shared(KS,KE,IA,JA)
1908  do j = 1, ja
1909  do i = 1, ia
1910  do k = ks, ke
1911  rhi(k,i,j) = dens_av(k,i,j) * qv(k,i,j) &
1912  / work(k,i,j) * rvap * temp(k,i,j) &
1913  * 100.0_rp
1914  enddo
1915  enddo
1916  enddo
1917  else
1918 !OCL XFILL
1919  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
1920  !$omp private(i,j,k) &
1921  !$omp shared(RHI) &
1922  !$omp shared(KS,KE,IA,JA)
1923  do j = 1, ja
1924  do i = 1, ia
1925  do k = ks, ke
1926  rhi(k,i,j) = 0.0_rp
1927  enddo
1928  enddo
1929  enddo
1930  end if
1931  dv_calculated(i_rhi) = .true.
1932  end if
1933  var(ks:ke,:,:) = rhi(ks:ke,:,:)
1934 
1935  case ( 'VOR' )
1936  if ( .not. dv_calculated(i_vor) ) then
1937  call allocate_3d( vor )
1938  !!! to move to grid !!!
1939  ! at x, v, layer
1940  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
1941 !OCL XFILL
1942  do j = 1, ja-1
1943  do i = 2, ia
1944  do k = ks, ke
1945  uh(k,i,j) = 0.5_rp * ( momx_av(k,i ,j) + momx_av(k,i ,j+1) &
1946  + momx_av(k,i-1,j) + momx_av(k,i-1,j+1) ) &
1947  / ( dens_av(k,i,j) + dens_av(k,i,j+1) )
1948  enddo
1949  enddo
1950  enddo
1951  ! at u, y, layer
1952  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
1953 !OCL XFILL
1954  do j = 2, ja
1955  do i = 1, ia-1
1956  do k = ks, ke
1957  vh(k,i,j) = 0.5_rp * ( momy_av(k,i,j ) + momy_av(k,i+1,j ) &
1958  + momy_av(k,i,j-1) + momy_av(k,i+1,j-1) ) &
1959  / ( dens_av(k,i,j) + dens_av(k,i+1,j) )
1960  enddo
1961  enddo
1962  enddo
1963  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
1964 !OCL XFILL
1965  do j = 2, ja-1
1966  do i = 2, ia-1
1967  do k = ks, ke
1968  vor(k,i,j) = ( vh(k,i,j ) - vh(k,i-1,j ) ) * rcdx(i) &
1969  - ( uh(k,i ,j) - uh(k,i ,j-1) ) * rcdy(j)
1970  enddo
1971  enddo
1972  enddo
1973  !$omp parallel do private(j,k) OMP_SCHEDULE_
1974  do j = 1, ja
1975  do k = ks, ke
1976  vor(k,1 ,j) = vor(k,2 ,j)
1977  vor(k,ia,j) = vor(k,ia-1,j)
1978  enddo
1979  enddo
1980  !$omp parallel do private(i,k) OMP_SCHEDULE_
1981  do i = 1, ia
1982  do k = ks, ke
1983  vor(k,i,1 ) = vor(k,i,2 )
1984  vor(k,i,ja) = vor(k,i,ja-1)
1985  enddo
1986  enddo
1987  dv_calculated(i_vor) = .true.
1988  end if
1989  var(ks:ke,:,:) = vor(ks:ke,:,:)
1990 
1991  case ( 'DIV' )
1992  if ( .not. dv_calculated(i_div) ) then
1993  call allocate_3d( div )
1994  call atmos_vars_get_diagnostic( 'HDIV', work3d(:,:,:) )
1995  !!!! to move to grid !!!!
1996  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
1997 !OCL XFILL
1998  do j = 1, ja
1999  do i = 1, ia
2000  do k = ks, ke
2001  div(k,i,j) = ( momz_av(k,i,j) - momz_av(k-1,i ,j ) ) * ( real_fz(k,i,j)-real_fz(k-1,i,j) ) &
2002  + hdiv(k,i,j)
2003  enddo
2004  enddo
2005  enddo
2006  dv_calculated(i_div) = .true.
2007  end if
2008  var(ks:ke,:,:) = div(ks:ke,:,:)
2009 
2010  case ( 'HDIV' )
2011  if ( .not. dv_calculated(i_hdiv) ) then
2012  call allocate_3d( hdiv )
2013  !!!! to move to grid !!!!
2014  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2015 !OCL XFILL
2016  do j = 2, ja
2017  do i = 2, ia
2018  do k = ks, ke
2019  hdiv(k,i,j) = ( momx_av(k,i,j) - momx_av(k ,i-1,j ) ) * rcdx(i) &
2020  + ( momy_av(k,i,j) - momy_av(k ,i ,j-1) ) * rcdy(j)
2021  enddo
2022  enddo
2023  enddo
2024  !$omp parallel do private(i,k) OMP_SCHEDULE_
2025  do i = 1, ia
2026  do k = ks, ke
2027  hdiv(k,i,1) = hdiv(k,i,2)
2028  enddo
2029  enddo
2030  !$omp parallel do private(j,k) OMP_SCHEDULE_
2031  do j = 1, ja
2032  do k = ks, ke
2033  hdiv(k,1,j) = hdiv(k,2,j)
2034  enddo
2035  enddo
2036  dv_calculated(i_hdiv) = .true.
2037  end if
2038  var(ks:ke,:,:) = hdiv(ks:ke,:,:)
2039 
2040  case ( 'Uabs' )
2041  if ( .not. dv_calculated(i_uabs) ) then
2042  call allocate_3d( uabs )
2043 !OCL XFILL
2044  !$omp parallel do private(k,i,j) OMP_SCHEDULE_ collapse(2)
2045  do j = 1, ja
2046  do i = 1, ia
2047  do k = ks, ke
2048  uabs(k,i,j) = sqrt( w(k,i,j)**2 + u(k,i,j)**2 + v(k,i,j)**2 )
2049  enddo
2050  enddo
2051  enddo
2052  dv_calculated(i_uabs) = .true.
2053  end if
2054  var(ks:ke,:,:) = uabs(ks:ke,:,:)
2055 
2056  case ( 'N2' )
2057  if ( .not. dv_calculated(i_n2) ) then
2058  call allocate_3d( n2 )
2059  call atmos_diagnostic_get_n2( &
2060  ka, ks, ke, ia, 1, ia, ja, 1, ja, &
2061  pott(:,:,:), rtot(:,:,:), & !(in)
2062  real_cz(:,:,:), & !(in)
2063  n2(:,:,:) ) ! (out)
2064  dv_calculated(i_n2) = .true.
2065  end if
2066  var(ks:ke,:,:) = n2(ks:ke,:,:)
2067 
2068  case ( 'MSE' )
2069  if ( .not. dv_calculated(i_mse) ) then
2070  call allocate_3d( mse )
2071  call atmos_vars_get_diagnostic( 'LHV', work3d(:,:,:) )
2072 !OCL XFILL
2073  !$omp parallel do private(k,i,j) OMP_SCHEDULE_ collapse(2)
2074  do j = 1, ja
2075  do i = 1, ia
2076  do k = ks, ke
2077  mse(k,i,j) = cptot(k,i,j) * temp(k,i,j) &
2078  + grav * ( real_cz(k,i,j) - real_fz(ks-1,i,j) ) &
2079  + lhv(k,i,j) * qv(k,i,j)
2080  enddo
2081  enddo
2082  enddo
2083  dv_calculated(i_mse) = .true.
2084  end if
2085  var(ks:ke,:,:) = mse(ks:ke,:,:)
2086 
2087  case ( 'TDEW' )
2088  if ( .not. dv_calculated(i_tdew) ) then
2089  call allocate_3d( tdew )
2090  call atmos_saturation_tdew_liq( ka, ks, ke, ia, 1, ia, ja, 1, ja, &
2091  dens(:,:,:), temp(:,:,:), qv(:,:,:), & ! [IN]
2092  tdew(:,:,:) ) ! [OUT]
2093  dv_calculated(i_tdew) = .true.
2094  end if
2095  var(ks:ke,:,:) = tdew(ks:ke,:,:)
2096 
2097  case ( 'ENGP' )
2098  if ( .not. dv_calculated(i_engp) ) then
2099  call allocate_3d( engp )
2100  !$omp parallel do private(k,i,j) OMP_SCHEDULE_ collapse(2)
2101  do j = 1, ja
2102  do i = 1, ia
2103  do k = ks, ke
2104  engp(k,i,j) = dens_av(k,i,j) * grav * real_cz(k,i,j)
2105  end do
2106  end do
2107  end do
2108  dv_calculated(i_engp) = .true.
2109  end if
2110  var(ks:ke,:,:) = engp(ks:ke,:,:)
2111 
2112  case ( 'ENGK' )
2113  if ( .not. dv_calculated(i_engk) ) then
2114  call allocate_3d( engk )
2115  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2116  do j = 1, ja
2117  do i = 1, ia
2118  do k = ks, ke
2119  engk(k,i,j) = 0.5_rp * dens_av(k,i,j) &
2120  * ( w(k,i,j)**2 + u(k,i,j)**2 + v(k,i,j)**2 )
2121  end do
2122  end do
2123  end do
2124  dv_calculated(i_engk) = .true.
2125  end if
2126  var(ks:ke,:,:) = engk(ks:ke,:,:)
2127 
2128  case ( 'ENGI' )
2129  if ( .not. dv_calculated(i_engi) ) then
2130  call allocate_3d( engi )
2131  if ( moist ) then
2132  call atmos_vars_get_diagnostic( 'QICE', work3d(:,:,:) )
2133  end if
2134  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2135  do j = 1, ja
2136  do i = 1, ia
2137  do k = ks, ke
2138  engi(k,i,j) = dens_av(k,i,j) * qdry(k,i,j) * temp(k,i,j) * cvdry
2139  do iq = 1, qa
2140  engi(k,i,j) = engi(k,i,j) &
2141  + dens_av(k,i,j) * qtrc_av(k,i,j,iq) * temp(k,i,j) * tracer_cv(iq)
2142  enddo
2143  if ( moist ) then
2144  engi(k,i,j) = engi(k,i,j) &
2145  + dens_av(k,i,j) * ( qv(k,i,j) * lhvc & ! Latent Heat [vapor->liquid]
2146  - qice(k,i,j) * lhfc ) ! Latent Heat [ice->liquid]
2147  end if
2148  end do
2149  end do
2150  end do
2151  dv_calculated(i_engi) = .true.
2152  end if
2153  var(ks:ke,:,:) = engi(ks:ke,:,:)
2154 
2155  case ( 'ENGT' )
2156  if ( .not. dv_calculated(i_engt) ) then
2157  call allocate_3d( engt )
2158  call atmos_vars_get_diagnostic( 'ENGP', work3d(:,:,:) )
2159  call atmos_vars_get_diagnostic( 'ENGK', work3d(:,:,:) )
2160  call atmos_vars_get_diagnostic( 'ENGI', work3d(:,:,:) )
2161  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2162  do j = 1, ja
2163  do i = 1, ia
2164  do k = ks, ke
2165  engt(k,i,j) = engp(k,i,j) + engk(k,i,j) + engi(k,i,j)
2166  enddo
2167  enddo
2168  enddo
2169  dv_calculated(i_engt) = .true.
2170  end if
2171  var(ks:ke,:,:) = engt(ks:ke,:,:)
2172 
2173  case ( 'DENS_PRIM' )
2174  if ( .not. dv_calculated(i_dens_prim) ) then
2175  call allocate_3d( dens_prim )
2176  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2177 !OCL XFILL
2178  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2179  do j = 1, ja
2180  do i = 1, ia
2181  do k = ks, ke
2182  dens_prim(k,i,j) = dens_av(k,i,j) - dens_mean(k)
2183  enddo
2184  enddo
2185  enddo
2186  dv_calculated(i_dens_prim) = .true.
2187  end if
2188  var(ks:ke,:,:) = dens_prim(ks:ke,:,:)
2189 
2190  case ( 'W_PRIM' )
2191  if ( .not. dv_calculated(i_w_prim) ) then
2192  call allocate_3d( w_prim )
2193  call atmos_vars_get_diagnostic( 'W_MEAN', work1d(:) )
2194 !OCL XFILL
2195  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2196  do j = 1, ja
2197  do i = 1, ia
2198  do k = ks, ke
2199  w_prim(k,i,j) = w(k,i,j) - w_mean(k)
2200  enddo
2201  enddo
2202  enddo
2203  dv_calculated(i_w_prim) = .true.
2204  end if
2205  var(ks:ke,:,:) = w_prim(ks:ke,:,:)
2206 
2207  case ( 'U_PRIM' )
2208  if ( .not. dv_calculated(i_u_prim) ) then
2209  call allocate_3d( u_prim )
2210  call atmos_vars_get_diagnostic( 'U_MEAN', work1d(:) )
2211 !OCL XFILL
2212  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2213  do j = 1, ja
2214  do i = 1, ia
2215  do k = ks, ke
2216  u_prim(k,i,j) = u(k,i,j) - u_mean(k)
2217  enddo
2218  enddo
2219  enddo
2220  dv_calculated(i_u_prim) = .true.
2221  end if
2222  var(ks:ke,:,:) = u_prim(ks:ke,:,:)
2223 
2224  case ( 'V_PRIM' )
2225  if ( .not. dv_calculated(i_v_prim) ) then
2226  call allocate_3d( v_prim )
2227  call atmos_vars_get_diagnostic( 'V_MEAN', work1d(:) )
2228 !OCL XFILL
2229  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2230  do j = 1, ja
2231  do i = 1, ia
2232  do k = ks, ke
2233  v_prim(k,i,j) = v(k,i,j) - v_mean(k)
2234  enddo
2235  enddo
2236  enddo
2237  dv_calculated(i_v_prim) = .true.
2238  end if
2239  var(ks:ke,:,:) = v_prim(ks:ke,:,:)
2240 
2241  case ( 'PT_PRIM' )
2242  if ( .not. dv_calculated(i_pt_prim) ) then
2243  call allocate_3d( pt_prim )
2244  call atmos_vars_get_diagnostic( 'PT_MEAN', work1d(:) )
2245 !OCL XFILL
2246  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2247  do j = 1, ja
2248  do i = 1, ia
2249  do k = ks, ke
2250  pt_prim(k,i,j) = pott(k,i,j) - pt_mean(k)
2251  enddo
2252  enddo
2253  enddo
2254  dv_calculated(i_pt_prim) = .true.
2255  end if
2256  var(ks:ke,:,:) = pt_prim(ks:ke,:,:)
2257 
2258  case ( 'W_PRIM2' )
2259  if ( .not. dv_calculated(i_w_prim2) ) then
2260  call allocate_3d( w_prim2 )
2261  call atmos_vars_get_diagnostic( 'W_PRIM', work3d(:,:,:) )
2262 !OCL XFILL
2263  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2264  do j = 1, ja
2265  do i = 1, ia
2266  do k = ks, ke
2267  w_prim2(k,i,j) = w_prim(k,i,j)**2
2268  enddo
2269  enddo
2270  enddo
2271  dv_calculated(i_w_prim2) = .true.
2272  end if
2273  var(ks:ke,:,:) = w_prim2(ks:ke,:,:)
2274 
2275  case ( 'PT_W_PRIM' )
2276  if ( .not. dv_calculated(i_pt_w_prim) ) then
2277  call allocate_3d( pt_w_prim )
2278  call atmos_vars_get_diagnostic( 'W_PRIM', work3d(:,:,:) )
2279  call atmos_vars_get_diagnostic( 'PT_PRIM', work3d(:,:,:) )
2280  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2281  do j = 1, ja
2282  do i = 1, ia
2283  do k = ks, ke
2284  pt_w_prim(k,i,j) = w_prim(k,i,j) * pt_prim(k,i,j) * dens_av(k,i,j) * cpdry
2285  enddo
2286  enddo
2287  enddo
2288  dv_calculated(i_pt_w_prim) = .true.
2289  end if
2290  var(ks:ke,:,:) = pt_w_prim(ks:ke,:,:)
2291 
2292  case ( 'W_PRIM3' )
2293  if ( .not. dv_calculated(i_w_prim3) ) then
2294  call allocate_3d( w_prim3 )
2295  call atmos_vars_get_diagnostic( 'W_PRIM', work3d(:,:,:) )
2296 !OCL XFILL
2297  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2298  do j = 1, ja
2299  do i = 1, ia
2300  do k = ks, ke
2301  w_prim3(k,i,j) = w_prim(k,i,j)**3
2302  enddo
2303  enddo
2304  enddo
2305  dv_calculated(i_w_prim3) = .true.
2306  end if
2307  var(ks:ke,:,:) = w_prim3(ks:ke,:,:)
2308 
2309  case ( 'TKE_RS' )
2310  if ( .not. dv_calculated(i_tke_rs) ) then
2311  call allocate_3d( tke_rs )
2312  call atmos_vars_get_diagnostic( 'W_PRIM', work3d(:,:,:) )
2313  call atmos_vars_get_diagnostic( 'U_PRIM', work3d(:,:,:) )
2314  call atmos_vars_get_diagnostic( 'V_PRIM', work3d(:,:,:) )
2315 !OCL XFILL
2316  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2317  do j = 1, ja
2318  do i = 1, ia
2319  do k = ks, ke
2320  tke_rs(k,i,j) = 0.5_rp * ( w_prim(k,i,j)**2 + u_prim(k,i,j)**2 + v_prim(k,i,j)**2 )
2321  enddo
2322  enddo
2323  enddo
2324  dv_calculated(i_tke_rs) = .true.
2325  end if
2326  var(ks:ke,:,:) = tke_rs(ks:ke,:,:)
2327 
2328  case ( 'VELZ' )
2329  if ( .not. dv_calculated(i_velz) ) then
2330  call allocate_3d( velz )
2331 !OCL XFILL
2332  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2333  do j = 1, ja
2334  do i = 1, ia
2335  velz(ks-1,i,j) = 0.0_rp
2336  do k = ks, ke-1
2337  velz(k,i,j) = momz(k,i,j) * 2.0_rp / ( dens(k,i,j) + dens(k+1,i,j) )
2338  end do
2339  velz(ke,i,j) = 0.0_rp
2340  enddo
2341  enddo
2342  dv_calculated(i_velz) = .true.
2343  end if
2344  var(ks-1:ke,:,:) = velz(ks-1:ke,:,:)
2345 
2346  case ( 'VELX' )
2347  if ( .not. dv_calculated(i_velx) ) then
2348  call allocate_3d( velx )
2349 !OCL XFILL
2350  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2351  do j = 1, ja
2352  do i = 1, ia-1
2353  do k = ks, ke
2354  velx(k,i,j) = momx(k,i,j) * 2.0_rp / ( dens(k,i,j) + dens(k,i+1,j) )
2355  enddo
2356  enddo
2357  enddo
2358 !OCL XFILL
2359  !$omp parallel do private(j,k) OMP_SCHEDULE_
2360  do j = 1, ja
2361  do k = ks, ke
2362  velx(k,ia,j) = momx(k,ia,j) / dens(k,ia,j)
2363  enddo
2364  enddo
2365  call comm_vars8( velx(:,:,:), 1 )
2366  call comm_wait ( velx(:,:,:), 1, .false. )
2367  dv_calculated(i_velx) = .true.
2368  end if
2369  var(ks:ke,:,:) = velx(ks:ke,:,:)
2370 
2371  case ( 'VELY' )
2372  if ( .not. dv_calculated(i_vely) ) then
2373  call allocate_3d( vely )
2374 !OCL XFILL
2375  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2376  do j = 1, ja-1
2377  do i = 1, ia
2378  do k = ks, ke
2379  vely(k,i,j) = momy(k,i,j) * 2.0_rp / ( dens(k,i,j) + dens(k,i,j+1) )
2380  enddo
2381  enddo
2382  enddo
2383 !OCL XFILL
2384  !$omp parallel do private(i,k) OMP_SCHEDULE_
2385  do i = 1, ia
2386  do k = ks, ke
2387  vely(k,i,ja) = momy(k,i,ja) / dens(k,i,ja)
2388  enddo
2389  enddo
2390  call comm_vars8( vely(:,:,:), 1 )
2391  call comm_wait ( vely(:,:,:), 1, .false. )
2392  dv_calculated(i_vely) = .true.
2393  end if
2394  var(ks:ke,:,:) = vely(ks:ke,:,:)
2395 
2396  case ( 'Umet' )
2397  if ( .not. dv_calculated(i_umet) ) then
2398  call allocate_3d( umet )
2399 !OCL XFILL
2400  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2401  do j = 1, ja
2402  do i = 1, ia
2403  do k = ks, ke
2404  umet(k,i,j) = u(k,i,j) * rotc(i,j,1) - v(k,i,j) * rotc(i,j,2)
2405  end do
2406  end do
2407  end do
2408  dv_calculated(i_umet) = .true.
2409  end if
2410  var(ks:ke,:,:) = umet(ks:ke,:,:)
2411 
2412  case ( 'Vmet' )
2413  if ( .not. dv_calculated(i_vmet) ) then
2414  call allocate_3d( vmet )
2415 !OCL XFILL
2416  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2417  do j = 1, ja
2418  do i = 1, ia
2419  do k = ks, ke
2420  vmet(k,i,j) = u(k,i,j) * rotc(i,j,2) + v(k,i,j) * rotc(i,j,1)
2421  end do
2422  end do
2423  end do
2424  dv_calculated(i_vmet) = .true.
2425  end if
2426  var(ks:ke,:,:) = vmet(ks:ke,:,:)
2427 
2428  case default
2429  log_error("ATMOS_vars_calc_diagnostics",*) 'name is invalid for ATMOS_vars_get_diagnostic_3D: ', trim(vname)
2430  call prc_abort
2431  end select
2432 
2433 
2434  return
2435  end subroutine atmos_vars_get_diagnostic_3d
2436 
2437  !-----------------------------------------------------------------------------
2439  recursive subroutine atmos_vars_get_diagnostic_2d( &
2440  vname, &
2441  var )
2442  use scale_prc, only: &
2443  prc_abort
2444  use scale_atmos_grid_cartesc_real, only: &
2445  real_cz => atmos_grid_cartesc_real_cz, &
2446  real_fz => atmos_grid_cartesc_real_fz
2447  use scale_atmos_adiabat, only: &
2448  atmos_adiabat_cape
2449  use mod_atmos_phy_mp_vars, only: &
2450  sflx_rain_mp => atmos_phy_mp_sflx_rain, &
2451  sflx_snow_mp => atmos_phy_mp_sflx_snow
2452  use mod_atmos_phy_cp_vars, only: &
2453  sflx_rain_cp => atmos_phy_cp_sflx_rain
2454  implicit none
2455 
2456  character(len=*), intent(in) :: vname
2457  real(RP), intent(out) :: var(:,:)
2458 
2459  real(RP) :: fact
2460  integer :: k, i, j
2461  !---------------------------------------------------------------------------
2462 
2463  select case ( vname )
2464  case ( 'LWP' )
2465  if ( .not. dv_calculated(i_lwp) ) then
2466  call allocate_2d( lwp )
2467  call atmos_vars_get_diagnostic( 'QLIQ', work3d(:,:,:) )
2468  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
2469  !$omp private(i,j,k) &
2470  !$omp shared(LWP,QLIQ,DENS_av,REAL_FZ) &
2471  !$omp shared(KS,KE,IA,JA)
2472  do j = 1, ja
2473  do i = 1, ia
2474  lwp(i,j) = 0.0_rp
2475  do k = ks, ke
2476  lwp(i,j) = lwp(i,j) &
2477  + qliq(k,i,j) * dens_av(k,i,j) * ( real_fz(k,i,j)-real_fz(k-1,i,j) ) * 1.e3_rp ! [kg/m2->g/m2]
2478  enddo
2479  enddo
2480  enddo
2481  dv_calculated(i_lwp) = .true.
2482  end if
2483  var(:,:) = lwp(:,:)
2484 
2485  case ( 'IWP' )
2486  if ( .not. dv_calculated(i_iwp) ) then
2487  call allocate_2d( iwp )
2488  call atmos_vars_get_diagnostic( 'QICE', work3d(:,:,:) )
2489  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
2490  !$omp private(i,j,k) &
2491  !$omp shared(IWP,QICE,DENS_av,REAL_FZ) &
2492  !$omp shared(KS,KE,IA,JA)
2493  do j = 1, ja
2494  do i = 1, ia
2495  iwp(i,j) = 0.0_rp
2496  do k = ks, ke
2497  iwp(i,j) = iwp(i,j) &
2498  + qice(k,i,j) * dens_av(k,i,j) * ( real_fz(k,i,j)-real_fz(k-1,i,j) ) * 1.e3_rp ! [kg/m2->g/m2]
2499  enddo
2500  enddo
2501  enddo
2502  dv_calculated(i_iwp) = .true.
2503  end if
2504  var(:,:) = iwp(:,:)
2505 
2506  case ( 'PW' )
2507  if ( .not. dv_calculated(i_pw) ) then
2508  call allocate_2d( pw )
2509  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
2510  !$omp private(i,j,k) &
2511  !$omp shared(PW,QV,DENS_av,REAL_FZ) &
2512  !$omp shared(KS,KE,IA,JA)
2513  do j = 1, ja
2514  do i = 1, ia
2515  pw(i,j) = 0.0_rp
2516  do k = ks, ke
2517  pw(i,j) = pw(i,j) &
2518  + qv(k,i,j) * dens_av(k,i,j) * ( real_fz(k,i,j)-real_fz(k-1,i,j) ) * 1.e3_rp ! [kg/m2->g/m2]
2519  enddo
2520  enddo
2521  enddo
2522  dv_calculated(i_pw) = .true.
2523  end if
2524  var(:,:) = pw(:,:)
2525 
2526  case ( 'PBLH' )
2527  if ( .not. dv_calculated(i_pblh) ) then
2528  call allocate_2d( pblh )
2529  call atmos_vars_get_diagnostic( 'POTV', work3d(:,:,:) )
2530  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
2531  !$omp private(k,i,j) &
2532  !$omp private(fact) &
2533  !$omp shared(PBLH,POTV,REAL_CZ,REAL_FZ) &
2534  !$omp shared(KS,KE,IA,JA)
2535  do j = 1, ja
2536  do i = 1, ia
2537  pblh(i,j) = real_cz(ks,i,j) - real_fz(ks-1,i,j)
2538  do k = ks+1, ke
2539  if ( potv(k,i,j) > potv(ks,i,j) ) then
2540  fact = ( potv(ks,i,j) - potv(k-1,i,j) ) &
2541  / ( potv(k,i,j) - potv(k-1,i,j) )
2542  pblh(i,j) = real_cz(k-1,i,j) - real_fz(ks-1,i,j) &
2543  + fact * ( real_cz(k,i,j) - real_cz(k-1,i,j) )
2544 
2545  exit
2546  endif
2547  enddo
2548  enddo
2549  enddo
2550  dv_calculated(i_pblh) = .true.
2551  end if
2552  var(:,:) = pblh(:,:)
2553 
2554  case ( 'CAPE', 'CIN', 'LCL', 'LFC', 'LNB' )
2555  if ( .not. dv_calculated(i_cape) ) then
2556  call allocate_2d( cape )
2557  call allocate_2d( cin )
2558  call allocate_2d( lcl )
2559  call allocate_2d( lfc )
2560  call allocate_2d( lnb )
2561  call atmos_adiabat_cape( &
2562  ka, ks, ke, ia, is, ie, ja, js, je, &
2563  ks, & ! (in)
2564  dens_av(:,:,:), temp(:,:,:), pres(:,:,:), & ! (in)
2565  qv(:,:,:), qc(:,:,:), qdry(:,:,:), & ! (in)
2566  rtot(:,:,:), cptot(:,:,:), & ! (in)
2567  real_cz(:,:,:), real_fz(:,:,:), & ! (in)
2568  cape(:,:), cin(:,:), lcl(:,:), lfc(:,:), lnb(:,:) ) ! (out)
2569  dv_calculated(i_cape) = .true.
2570  end if
2571  select case ( vname )
2572  case ( 'CAPE' )
2573  var(:,:) = cape(:,:)
2574  case ( 'CIN' )
2575  var(:,:) = cin(:,:)
2576  case ( 'LCL' )
2577  var(:,:) = lcl(:,:)
2578  case ( 'LFC' )
2579  var(:,:) = lfc(:,:)
2580  case ( 'LNB' )
2581  var(:,:) = lnb(:,:)
2582  end select
2583 
2584  case ( 'PREC', 'RAIN', 'SNOW' )
2585  if ( .not. dv_calculated(i_prec) ) then
2586  call allocate_2d( prec )
2587  call allocate_2d( rain )
2588  call allocate_2d( snow )
2589  !$omp parallel do private(i,j) OMP_SCHEDULE_
2590  do j = 1, ja
2591  do i = 1, ia
2592  rain(i,j) = sflx_rain_mp(i,j) + sflx_rain_cp(i,j)
2593  snow(i,j) = sflx_snow_mp(i,j)
2594  prec(i,j) = rain(i,j) + snow(i,j)
2595  enddo
2596  enddo
2597  dv_calculated(i_prec) = .true.
2598  end if
2599  select case (vname)
2600  case ( 'RAIN' )
2601  var(:,:) = rain(:,:)
2602  case ( 'SNOW' )
2603  var(:,:) = snow(:,:)
2604  case ( 'PREC' )
2605  var(:,:) = prec(:,:)
2606  end select
2607 
2608  case default
2609  log_error("ATMOS_vars_calc_diagnostics",*) 'name is invalid for ATMOS_vars_get_diagnostic_2D: ', trim(vname)
2610  call prc_abort
2611  end select
2612 
2613 
2614  return
2615  end subroutine atmos_vars_get_diagnostic_2d
2616 
2617  !-----------------------------------------------------------------------------
2619  recursive subroutine atmos_vars_get_diagnostic_1d( &
2620  vname, &
2621  var )
2622  use scale_const, only: &
2623  cpdry => const_cpdry
2624  use scale_prc, only: &
2625  prc_abort
2626  use scale_statistics, only: &
2627  statistics_horizontal_mean
2628  use scale_atmos_grid_cartesc_real, only: &
2630  implicit none
2631 
2632  character(len=*), intent(in) :: vname
2633  real(RP), intent(out) :: var(:)
2634 
2635  real(RP) :: WORK(ka,ia,ja)
2636  integer :: k, i, j
2637  !---------------------------------------------------------------------------
2638 
2639  select case ( vname )
2640  case ( 'DENS_MEAN' )
2641  if ( .not. dv_calculated(i_dens_mean) ) then
2642  call allocate_1d( dens_mean )
2643  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2644  dens(:,:,:), area(:,:), dens_mean(:) )
2645  dv_calculated(i_dens_mean) = .true.
2646  end if
2647  var(:) = dens_mean(:)
2648 
2649  case ( 'W_MEAN' )
2650  if ( .not. dv_calculated(i_w_mean) ) then
2651  call allocate_1d( w_mean )
2652  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2653 !OCL XFILL
2654  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2655  do j = jsb, jeb
2656  do i = isb, ieb
2657  do k = ks, ke
2658  work(k,i,j) = w(k,i,j) * dens_av(k,i,j)
2659  enddo
2660  enddo
2661  enddo
2662  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2663  work(:,:,:), area(:,:), w_mean(:) )
2664  do k = ks, ke
2665  w_mean(k) = w_mean(k) / dens_mean(k)
2666  enddo
2667  dv_calculated(i_w_mean) = .true.
2668  end if
2669  var(:) = w_mean(:)
2670 
2671  case ( 'U_MEAN' )
2672  if ( .not. dv_calculated(i_u_mean) ) then
2673  call allocate_1d( u_mean )
2674  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2675 !OCL XFILL
2676  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2677  do j = jsb, jeb
2678  do i = isb, ieb
2679  do k = ks, ke
2680  work(k,i,j) = u(k,i,j) * dens_av(k,i,j)
2681  enddo
2682  enddo
2683  enddo
2684  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2685  work(:,:,:), area(:,:), u_mean(:) )
2686  do k = ks, ke
2687  u_mean(k) = u_mean(k) / dens_mean(k)
2688  enddo
2689  dv_calculated(i_u_mean) = .true.
2690  end if
2691  var(:) = u_mean(:)
2692 
2693  case ( 'V_MEAN' )
2694  if ( .not. dv_calculated(i_v_mean) ) then
2695  call allocate_1d( v_mean )
2696  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2697 !OCL XFILL
2698  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2699  do j = jsb, jeb
2700  do i = isb, ieb
2701  do k = ks, ke
2702  work(k,i,j) = v(k,i,j) * dens_av(k,i,j)
2703  enddo
2704  enddo
2705  enddo
2706  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2707  work(:,:,:), area(:,:), v_mean(:) )
2708  do k = ks, ke
2709  v_mean(k) = v_mean(k) / dens_mean(k)
2710  enddo
2711  dv_calculated(i_v_mean) = .true.
2712  end if
2713  var(:) = v_mean(:)
2714 
2715  case ( 'PT_MEAN' )
2716  if ( .not. dv_calculated(i_pt_mean) ) then
2717  call allocate_1d( pt_mean )
2718  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2719  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2720  rhot(:,:,:), area(:,:), pt_mean(:) )
2721  do k = ks, ke
2722  pt_mean(k) = pt_mean(k) / dens_mean(k)
2723  enddo
2724  dv_calculated(i_pt_mean) = .true.
2725  end if
2726  var(:) = pt_mean(:)
2727 
2728  case ( 'T_MEAN' )
2729  if ( .not. dv_calculated(i_t_mean) ) then
2730  call allocate_1d( t_mean )
2731  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2732 !OCL XFILL
2733  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2734  do j = jsb, jeb
2735  do i = isb, ieb
2736  do k = ks, ke
2737  work(k,i,j) = temp(k,i,j) * dens_av(k,i,j)
2738  enddo
2739  enddo
2740  enddo
2741  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2742  work(:,:,:), area(:,:), t_mean(:) )
2743  do k = ks, ke
2744  t_mean(k) = t_mean(k) / dens_mean(k)
2745  enddo
2746  dv_calculated(i_t_mean) = .true.
2747  end if
2748  var(:) = t_mean(:)
2749 
2750  case ( 'QV_MEAN' )
2751  if ( .not. dv_calculated(i_qv_mean) ) then
2752  call allocate_1d( qv_mean )
2753  if ( moist ) then
2754  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2755 !OCL XFILL
2756  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2757  do j = jsb, jeb
2758  do i = isb, ieb
2759  do k = ks, ke
2760  work(k,i,j) = qv(k,i,j) * dens_av(k,i,j)
2761  enddo
2762  enddo
2763  enddo
2764  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2765  work(:,:,:), area(:,:), qv_mean(:) )
2766  do k = ks, ke
2767  qv_mean(k) = qv_mean(k) / dens_mean(k)
2768  enddo
2769  else
2770  !$omp parallel do private(k) OMP_SCHEDULE_
2771  do k = ks, ke
2772  qv_mean(k) = 0.0_rp
2773  enddo
2774  end if
2775  dv_calculated(i_qv_mean) = .true.
2776  end if
2777  var(:) = qv_mean(:)
2778 
2779  case ( 'QHYD_MEAN' )
2780  if ( .not. dv_calculated(i_qhyd_mean) ) then
2781  call allocate_1d( qhyd_mean )
2782  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2783  call atmos_vars_get_diagnostic( 'QHYD', work3d(:,:,:) )
2784 !OCL XFILL
2785  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2786  do j = jsb, jeb
2787  do i = isb, ieb
2788  do k = ks, ke
2789  work(k,i,j) = qhyd(k,i,j) * dens_av(k,i,j)
2790  enddo
2791  enddo
2792  enddo
2793  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2794  work(:,:,:), area(:,:), qhyd_mean(:) )
2795  do k = ks, ke
2796  qhyd_mean(k) = qhyd_mean(k) / dens_mean(k)
2797  enddo
2798  dv_calculated(i_qhyd_mean) = .true.
2799  end if
2800  var(:) = qhyd_mean(:)
2801 
2802  case ( 'QLIQ_MEAN' )
2803  if ( .not. dv_calculated(i_qliq_mean) ) then
2804  call allocate_1d( qliq_mean )
2805  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2806  call atmos_vars_get_diagnostic( 'QLIQ', work3d(:,:,:) )
2807 !OCL XFILL
2808  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2809  do j = jsb, jeb
2810  do i = isb, ieb
2811  do k = ks, ke
2812  work(k,i,j) = qliq(k,i,j) * dens_av(k,i,j)
2813  enddo
2814  enddo
2815  enddo
2816  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2817  work(:,:,:), area(:,:), qliq_mean(:) )
2818  do k = ks, ke
2819  qliq_mean(k) = qliq_mean(k) / dens_mean(k)
2820  enddo
2821  dv_calculated(i_qliq_mean) = .true.
2822  end if
2823  var(:) = qliq_mean(:)
2824 
2825  case ( 'QICE_MEAN' )
2826  if ( .not. dv_calculated(i_qice_mean) ) then
2827  call allocate_1d( qice_mean )
2828  call atmos_vars_get_diagnostic( 'DENS_MEAN', work1d(:) )
2829  call atmos_vars_get_diagnostic( 'QICE', work3d(:,:,:) )
2830 !OCL XFILL
2831  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2832  do j = jsb, jeb
2833  do i = isb, ieb
2834  do k = ks, ke
2835  work(k,i,j) = qice(k,i,j) * dens_av(k,i,j)
2836  enddo
2837  enddo
2838  enddo
2839  call statistics_horizontal_mean( ka, ks, ke, ia, is, ie, ja, js, je, &
2840  work(:,:,:), area(:,:), qice_mean(:) )
2841  do k = ks, ke
2842  qice_mean(k) = qice_mean(k) / dens_mean(k)
2843  enddo
2844  dv_calculated(i_qice_mean) = .true.
2845  end if
2846  var(:) = qice_mean(:)
2847 
2848  case default
2849  log_error("ATMOS_vars_calc_diagnostics",*) 'name is invalid for ATMOS_vars_get_diagnostic_1D: ', trim(vname)
2850  call prc_abort
2851  end select
2852 
2853 
2854  return
2855  end subroutine atmos_vars_get_diagnostic_1d
2856 
2857  !-----------------------------------------------------------------------------
2859  subroutine atmos_vars_monitor
2860  use scale_prc, only: &
2861  prc_myrank, &
2862  prc_abort
2863  use scale_const, only: &
2864  grav => const_grav, &
2865  cvdry => const_cvdry
2866  use scale_atmos_grid_cartesc, only: &
2867  rfdx => atmos_grid_cartesc_rfdx, &
2868  rfdy => atmos_grid_cartesc_rfdy
2869  use scale_atmos_grid_cartesc_real, only: &
2870  real_cz => atmos_grid_cartesc_real_cz
2871  use scale_atmos_grid_cartesc_metric, only: &
2873  use scale_statistics, only: &
2875  statistics_total, &
2876  statistics_detail
2877  use scale_monitor, only: &
2878  monitor_put
2879  use scale_time, only: &
2881  use mod_atmos_admin, only: &
2883  use scale_atmos_hydrometeor, only: &
2884  i_qv
2885  use mod_atmos_phy_cp_vars, only: &
2886  sflx_rain_cp => atmos_phy_cp_sflx_rain
2887  use mod_atmos_phy_mp_vars, only: &
2888  sflx_rain_mp => atmos_phy_mp_sflx_rain, &
2889  sflx_snow_mp => atmos_phy_mp_sflx_snow
2890  use mod_atmos_phy_rd_vars, only: &
2891  sflx_lw_up => atmos_phy_rd_sflx_lw_up, &
2892  sflx_lw_dn => atmos_phy_rd_sflx_lw_dn, &
2893  sflx_sw_up => atmos_phy_rd_sflx_sw_up, &
2894  sflx_sw_dn => atmos_phy_rd_sflx_sw_dn, &
2895  toaflx_lw_up => atmos_phy_rd_toaflx_lw_up, &
2896  toaflx_lw_dn => atmos_phy_rd_toaflx_lw_dn, &
2897  toaflx_sw_up => atmos_phy_rd_toaflx_sw_up, &
2898  toaflx_sw_dn => atmos_phy_rd_toaflx_sw_dn
2899  use mod_atmos_phy_sf_vars, only: &
2900  sflx_sh => atmos_phy_sf_sflx_sh, &
2901  sflx_lh => atmos_phy_sf_sflx_lh, &
2902  sflx_qtrc => atmos_phy_sf_sflx_qtrc
2903  implicit none
2904 
2905  real(RP) :: RHOQ(ka,ia,ja)
2906 
2907  real(RP) :: ENGFLXT (ia,ja) ! total flux [J/m2/s]
2908  real(RP) :: SFLX_RD_net(ia,ja) ! net SFC radiation flux [J/m2/s]
2909  real(RP) :: TFLX_RD_net(ia,ja) ! net TOA radiation flux [J/m2/s]
2910 
2911  real(RP) :: WORK (ka,ia,ja,3)
2912  character(len=H_SHORT) :: WNAME(3)
2913  real(RP) :: CFLMAX
2914 
2915  integer :: k, i, j, iq
2916  !---------------------------------------------------------------------------
2917 
2918  call monitor_put( pv_monit_id(i_dens), dens(:,:,:) )
2919  call monitor_put( pv_monit_id(i_momz), momz(:,:,:) )
2920  call monitor_put( pv_monit_id(i_momx), momx(:,:,:) )
2921  call monitor_put( pv_monit_id(i_momy), momy(:,:,:) )
2922  call monitor_put( pv_monit_id(i_rhot), rhot(:,:,:) )
2923 
2924  !##### Mass Budget #####
2925 
2926  do iq = 1, qa
2927  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2928 !OCL XFILL
2929  do j = js, je
2930  do i = is, ie
2931  do k = ks, ke
2932  rhoq(k,i,j) = dens_av(k,i,j) * qtrc_av(k,i,j,iq)
2933  enddo
2934  enddo
2935  enddo
2936 
2937  call monitor_put( qp_monit_id(iq), rhoq(:,:,:) )
2938  enddo
2939 
2940  ! total dry airmass
2941  if ( dv_monit_id(im_qdry) > 0 ) then
2942  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2943 !OCL XFILL
2944  do j = js, je
2945  do i = is, ie
2946  do k = ks, ke
2947  rhoq(k,i,j) = dens(k,i,j) * qdry(k,i,j)
2948  enddo
2949  enddo
2950  enddo
2951  call monitor_put( dv_monit_id(im_qdry), rhoq(:,:,:) )
2952  end if
2953 
2954  ! total vapor,liquid,solid tracers
2955  if ( dv_monit_id(im_qtot) > 0 ) then
2956  call atmos_vars_get_diagnostic( 'QTOT', work3d(:,:,:) )
2957  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
2958 !OCL XFILL
2959  do j = js, je
2960  do i = is, ie
2961  do k = ks, ke
2962  rhoq(k,i,j) = dens(k,i,j) * qtot(k,i,j)
2963  enddo
2964  enddo
2965  enddo
2966  call monitor_put( dv_monit_id(im_qtot), rhoq(:,:,:) )
2967  end if
2968 
2969  ! total evapolation
2970  if ( moist ) call monitor_put( dv_monit_id(im_evap), sflx_qtrc(:,:,i_qv) )
2971 
2972  ! total precipitation
2973  if ( dv_monit_id(im_prec) > 0 ) then
2974  call atmos_vars_get_diagnostic( 'PREC', work2d(:,:) )
2975  call monitor_put( dv_monit_id(im_prec), work2d(:,:) )
2976  end if
2977 
2978 
2979  !##### Energy Budget #####
2980 
2981  if ( dv_monit_id(im_engt) > 0 ) then
2982  call atmos_vars_get_diagnostic( 'ENGT', work3d(:,:,:) )
2983  call monitor_put( dv_monit_id(im_engt), work3d(:,:,:) )
2984  end if
2985  if ( dv_monit_id(im_engp) > 0 ) then
2986  call atmos_vars_get_diagnostic( 'ENGP', work3d(:,:,:) )
2987  call monitor_put( dv_monit_id(im_engp), work3d(:,:,:) )
2988  end if
2989  if ( dv_monit_id(im_engk) > 0 ) then
2990  call atmos_vars_get_diagnostic( 'ENGK', work3d(:,:,:) )
2991  call monitor_put( dv_monit_id(im_engk), work3d(:,:,:) )
2992  end if
2993  if ( dv_monit_id(im_engi) > 0 ) then
2994  call atmos_vars_get_diagnostic( 'ENGI', work3d(:,:,:) )
2995  call monitor_put( dv_monit_id(im_engi), work3d(:,:,:) )
2996  end if
2997 
2998 
2999  ! radiation flux
3000 !OCL XFILL
3001  !$omp parallel do private(i,j) OMP_SCHEDULE_ collapse(2)
3002  do j = js, je
3003  do i = is, ie
3004  sflx_rd_net(i,j) = ( sflx_lw_up(i,j) - sflx_lw_dn(i,j) ) &
3005  + ( sflx_sw_up(i,j) - sflx_sw_dn(i,j) )
3006 
3007  tflx_rd_net(i,j) = ( toaflx_lw_up(i,j) - toaflx_lw_dn(i,j) ) &
3008  + ( toaflx_sw_up(i,j) - toaflx_sw_dn(i,j) )
3009 
3010  engflxt(i,j) = sflx_sh(i,j) + sflx_lh(i,j) &
3011  + sflx_rd_net(i,j) - tflx_rd_net(i,j)
3012  enddo
3013  enddo
3014 
3015  call monitor_put( dv_monit_id(im_engflxt), engflxt(:,:) )
3016 
3017  call monitor_put( dv_monit_id(im_engsfc_sh), sflx_sh(:,:) )
3018  call monitor_put( dv_monit_id(im_engsfc_lh), sflx_lh(:,:) )
3019  call monitor_put( dv_monit_id(im_engsfc_rd), sflx_rd_net(:,:) )
3020  call monitor_put( dv_monit_id(im_engtoa_rd), tflx_rd_net(:,:) )
3021 
3022  call monitor_put( dv_monit_id(im_engsfc_lw_up), sflx_lw_up(:,:) )
3023  call monitor_put( dv_monit_id(im_engsfc_lw_dn), sflx_lw_dn(:,:) )
3024  call monitor_put( dv_monit_id(im_engsfc_sw_up), sflx_sw_up(:,:) )
3025  call monitor_put( dv_monit_id(im_engsfc_sw_dn), sflx_sw_dn(:,:) )
3026 
3027  call monitor_put( dv_monit_id(im_engtoa_lw_up), toaflx_lw_up(:,:) )
3028  call monitor_put( dv_monit_id(im_engtoa_lw_dn), toaflx_lw_dn(:,:) )
3029  call monitor_put( dv_monit_id(im_engtoa_sw_up), toaflx_sw_up(:,:) )
3030  call monitor_put( dv_monit_id(im_engtoa_sw_dn), toaflx_sw_dn(:,:) )
3031 
3032 
3033 
3034  if ( atmos_vars_checkrange ) then
3035 !OCL XFILL
3036  work(:,:,:,1) = w(:,:,:)
3037 !OCL XFILL
3038  work(:,:,:,2) = u(:,:,:)
3039 !OCL XFILL
3040  work(:,:,:,3) = v(:,:,:)
3041 
3042  wname(1) = "W"
3043  wname(2) = "U"
3044  wname(3) = "V"
3045 
3046  call statistics_detail( ka, ks, ke, ia, is, ie, ja, js, je, 3, &
3047  wname(:), work(:,:,:,:) )
3048  endif
3049 
3050  if ( ( atmos_dyn_type /= 'OFF' .AND. atmos_dyn_type /= 'NONE' ) &
3051  .AND. ( atmos_vars_checkcfl_soft > 0.0_rp .OR. atmos_vars_checkcfl_hard > 0.0_rp ) ) then
3052 !OCL XFILL
3053  work(:,:,:,:) = 0.0_rp
3054 
3055  do j = js, je
3056  do i = is, ie
3057  do k = ks, ke
3058  work(k,i,j,1) = 0.5_rp * abs(momz_av(k,i,j)) / ( dens_av(k+1,i,j) + dens_av(k,i,j) ) &
3059  * time_dtsec_atmos_dyn / ( real_cz(k+1,i,j) - real_cz(k,i,j) )
3060  work(k,i,j,2) = 0.5_rp * abs(momx_av(k,i,j)) / ( dens_av(k,i+1,j) + dens_av(k,i,j) ) &
3061  * time_dtsec_atmos_dyn * rfdx(i) * mapf(i,j,1,i_uy)
3062  work(k,i,j,3) = 0.5_rp * abs(momy_av(k,i,j)) / ( dens_av(k,i,j+1) + dens_av(k,i,j) ) &
3063  * time_dtsec_atmos_dyn * rfdy(j) * mapf(i,j,2,i_xv)
3064  enddo
3065  enddo
3066  enddo
3067 
3068  cflmax = maxval( work(:,:,:,:) )
3069 
3070  if ( atmos_vars_checkcfl_hard > 0.0_rp .AND. cflmax > atmos_vars_checkcfl_hard ) then
3071  log_info("ATMOS_vars_monitor",*) "Courant number =", cflmax, " exceeded the hard limit =", atmos_vars_checkcfl_hard
3072  log_error("ATMOS_vars_monitor",*) "Courant number =", cflmax, " exceeded the hard limit =", atmos_vars_checkcfl_hard
3073  log_error_cont(*) "Rank =", prc_myrank
3074  log_error_cont(*) "Please set ATMOS_VARS_CHECKCFL_HARD in the namelist PARAM_ATMOS_VARS when you want to change the limit."
3075 
3076  wname(1) = "Courant num. Z"
3077  wname(2) = "Courant num. X"
3078  wname(3) = "Courant num. Y"
3079  call statistics_detail( ka, ks, ke, ia, is, ie, ja, js, je, 3, &
3080  wname(:), work(:,:,:,:), &
3081  local=.true. )
3082 
3083  call prc_abort
3084  endif
3085 
3086  if ( atmos_vars_checkcfl_soft > 0.0_rp .AND. cflmax > atmos_vars_checkcfl_soft ) then
3087  log_info("ATMOS_vars_monitor",*) "Courant number =", cflmax, " exceeded the soft limit =", atmos_vars_checkcfl_soft
3088  log_error("ATMOS_vars_monitor",*) "Courant number =", cflmax, " exceeded the soft limit =", atmos_vars_checkcfl_soft
3089  log_error_cont(*) "Rank =", prc_myrank
3090 
3091  wname(1) = "Courant num. Z"
3092  wname(2) = "Courant num. X"
3093  wname(3) = "Courant num. Y"
3094  call statistics_detail( ka, ks, ke, ia, is, ie, ja, js, je, 3, &
3095  wname(:), work(:,:,:,:), &
3096  local=.true. )
3097  endif
3098  endif
3099 
3100  return
3101  end subroutine atmos_vars_monitor
3102 
3103  !-----------------------------------------------------------------------------
3105  subroutine atmos_vars_restart_create
3106  use scale_time, only: &
3108  use scale_file_cartesc, only: &
3110  use mod_atmos_admin, only: &
3111  atmos_sw_dyn, &
3112  atmos_sw_phy_mp, &
3113  atmos_sw_phy_ae, &
3114  atmos_sw_phy_ch, &
3115  atmos_sw_phy_rd, &
3116  atmos_sw_phy_sf, &
3117  atmos_sw_phy_tb, &
3119  use mod_cpl_admin, only: &
3120  cpl_sw
3121  use mod_atmos_dyn_vars, only: &
3123  use mod_atmos_phy_mp_vars, only: &
3125  use mod_atmos_phy_ae_vars, only: &
3127  use mod_atmos_phy_ch_vars, only: &
3129  use mod_atmos_phy_rd_vars, only: &
3131  use mod_atmos_phy_sf_vars, only: &
3133  use mod_atmos_phy_tb_vars, only: &
3135  use mod_atmos_phy_cp_vars, only: &
3137 #ifdef SDM
3138  use scale_atmos_phy_mp_sdm, only: &
3139  sd_rest_flg_out, &
3140  atmos_phy_mp_sdm_restart_create
3141  use scale_time, only: &
3142  nowdaysec => time_nowdaysec
3143 #endif
3144  implicit none
3145 
3146  character(len=19) :: timelabel
3147  character(len=H_LONG) :: basename
3148  !---------------------------------------------------------------------------
3149 
3150 #ifdef SDM
3151  if( sd_rest_flg_out ) then
3152  log_info("ATMOS_vars_restart_create",*) 'Output random number for SDM '
3153  call atmos_phy_mp_sdm_restart_create(nowdaysec)
3154  endif
3155 #endif
3156 
3157  if ( atmos_restart_out_basename /= '' ) then
3158 
3159  log_newline
3160  log_info("ATMOS_vars_restart_create",*) 'Create restart file (ATMOS) '
3161 
3163  call time_gettimelabel( timelabel )
3164  basename = trim(atmos_restart_out_basename)//'_'//trim(timelabel)
3165  else
3166  basename = trim(atmos_restart_out_basename)
3167  endif
3168 
3169  log_info("ATMOS_vars_restart_create",*) 'basename: ', trim(basename)
3170 
3171  call file_cartesc_create( &
3173  restart_fid, & ! [OUT]
3174  aggregate=atmos_restart_out_aggregate ) ! [IN]
3175 
3176  allocate( pv_id(pv_nmax+qa) )
3177  endif
3178 
3187 
3188  return
3189  end subroutine atmos_vars_restart_create
3190 
3191  !-----------------------------------------------------------------------------
3193  subroutine atmos_vars_restart_enddef
3194  use scale_file_cartesc, only: &
3196  use mod_atmos_admin, only: &
3197  atmos_sw_dyn, &
3198  atmos_sw_phy_mp, &
3199  atmos_sw_phy_ae, &
3200  atmos_sw_phy_ch, &
3201  atmos_sw_phy_rd, &
3202  atmos_sw_phy_sf, &
3203  atmos_sw_phy_tb, &
3205  use mod_cpl_admin, only: &
3206  cpl_sw
3207  use mod_atmos_dyn_vars, only: &
3209  use mod_atmos_phy_mp_vars, only: &
3211  use mod_atmos_phy_ae_vars, only: &
3213  use mod_atmos_phy_ch_vars, only: &
3215  use mod_atmos_phy_rd_vars, only: &
3217  use mod_atmos_phy_sf_vars, only: &
3219  use mod_atmos_phy_tb_vars, only: &
3221  use mod_atmos_phy_cp_vars, only: &
3223 #ifdef SDM
3224  use scale_atmos_phy_mp_sdm, only: &
3225  sd_rest_flg_out, &
3226  atmos_phy_mp_sdm_restart_enddef
3227 #endif
3228  implicit none
3229 
3230  !---------------------------------------------------------------------------
3231 
3232 #ifdef SDM
3233  if( sd_rest_flg_out ) then
3234  call atmos_phy_mp_sdm_restart_enddef
3235  endif
3236 #endif
3237 
3238  if ( restart_fid /= -1 ) then
3239  call file_cartesc_enddef( restart_fid ) ! [IN]
3240  endif
3241 
3250 
3251  return
3252  end subroutine atmos_vars_restart_enddef
3253 
3254  !-----------------------------------------------------------------------------
3256  subroutine atmos_vars_restart_close
3257  use scale_file_cartesc, only: &
3259  use mod_atmos_admin, only: &
3260  atmos_sw_dyn, &
3261  atmos_sw_phy_mp, &
3262  atmos_sw_phy_ae, &
3263  atmos_sw_phy_ch, &
3264  atmos_sw_phy_rd, &
3265  atmos_sw_phy_sf, &
3266  atmos_sw_phy_tb, &
3268  use mod_cpl_admin, only: &
3269  cpl_sw
3270  use mod_atmos_dyn_vars, only: &
3272  use mod_atmos_phy_mp_vars, only: &
3274  use mod_atmos_phy_ae_vars, only: &
3276  use mod_atmos_phy_ch_vars, only: &
3278  use mod_atmos_phy_rd_vars, only: &
3280  use mod_atmos_phy_sf_vars, only: &
3282  use mod_atmos_phy_tb_vars, only: &
3284  use mod_atmos_phy_cp_vars, only: &
3286 #ifdef SDM
3287  use scale_atmos_phy_mp_sdm, only: &
3288  sd_rest_flg_out, &
3289  atmos_phy_mp_sdm_restart_close
3290 #endif
3291  implicit none
3292  !---------------------------------------------------------------------------
3293 
3294 #ifdef SDM
3295  if( sd_rest_flg_out ) then
3296  call atmos_phy_mp_sdm_restart_close
3297  endif
3298 #endif
3299 
3300  if ( restart_fid /= -1 ) then
3301  log_newline
3302  log_info("ATMOS_vars_restart_close",*) 'Close restart file (ATMOS) '
3303 
3304  call file_cartesc_close( restart_fid ) ! [IN]
3305 
3306  restart_fid = -1
3307 
3308  if ( allocated(pv_id) ) deallocate( pv_id )
3309  endif
3310 
3316  if( atmos_sw_phy_sf .and. (.not. cpl_sw) ) call atmos_phy_sf_vars_restart_close
3319 
3320  return
3321  end subroutine atmos_vars_restart_close
3322 
3323  !-----------------------------------------------------------------------------
3325  subroutine atmos_vars_restart_def_var
3326  use scale_file_cartesc, only: &
3328  use mod_atmos_admin, only: &
3329  atmos_sw_dyn, &
3330  atmos_sw_phy_mp, &
3331  atmos_sw_phy_ae, &
3332  atmos_sw_phy_ch, &
3333  atmos_sw_phy_rd, &
3334  atmos_sw_phy_sf, &
3335  atmos_sw_phy_tb, &
3337  use mod_cpl_admin, only: &
3338  cpl_sw
3339  use mod_atmos_dyn_vars, only: &
3341  use mod_atmos_phy_mp_vars, only: &
3343  use mod_atmos_phy_ae_vars, only: &
3345  use mod_atmos_phy_ch_vars, only: &
3347  use mod_atmos_phy_rd_vars, only: &
3349  use mod_atmos_phy_sf_vars, only: &
3351  use mod_atmos_phy_tb_vars, only: &
3353  use mod_atmos_phy_cp_vars, only: &
3355 #ifdef SDM
3356  use scale_atmos_phy_mp_sdm, only: &
3357  sd_rest_flg_out, &
3358  atmos_phy_mp_sdm_restart_def_var
3359 #endif
3360  implicit none
3361 
3362  integer iq
3363  !---------------------------------------------------------------------------
3364 
3365 #ifdef SDM
3366  if( sd_rest_flg_out ) then
3367  call atmos_phy_mp_sdm_restart_def_var
3368  endif
3369 #endif
3370 
3371  if ( restart_fid /= -1 ) then
3372 
3373  call file_cartesc_def_var( restart_fid, pv_info(i_dens)%NAME, pv_info(i_dens)%DESC, pv_info(i_dens)%UNIT, 'ZXY', atmos_restart_out_dtype, &
3374  pv_id(i_dens), &
3375  standard_name=pv_info(i_dens)%STDNAME )
3376  call file_cartesc_def_var( restart_fid, pv_info(i_momz)%NAME, pv_info(i_momz)%DESC, pv_info(i_momz)%UNIT, 'ZHXY', atmos_restart_out_dtype, &
3377  pv_id(i_momz), &
3378  standard_name=pv_info(i_momz)%STDNAME )
3379  call file_cartesc_def_var( restart_fid, pv_info(i_momx)%NAME, pv_info(i_momx)%DESC, pv_info(i_momx)%UNIT, 'ZXHY', atmos_restart_out_dtype, &
3380  pv_id(i_momx), &
3381  standard_name=pv_info(i_momx)%STDNAME )
3382  call file_cartesc_def_var( restart_fid, pv_info(i_momy)%NAME, pv_info(i_momy)%DESC, pv_info(i_momy)%UNIT, 'ZXYH', atmos_restart_out_dtype, &
3383  pv_id(i_momy), &
3384  standard_name=pv_info(i_momy)%STDNAME )
3385  call file_cartesc_def_var( restart_fid, pv_info(i_rhot)%NAME, pv_info(i_rhot)%DESC, pv_info(i_rhot)%UNIT, 'ZXY', atmos_restart_out_dtype, &
3386  pv_id(i_rhot), &
3387  standard_name=pv_info(i_rhot)%STDNAME )
3388  do iq = 1, qa
3389  call file_cartesc_def_var( restart_fid, tracer_name(iq), tracer_desc(iq), tracer_unit(iq), 'ZXY', atmos_restart_out_dtype, &
3390  pv_id(pv_nmax+iq) )
3391  enddo
3392 
3393  endif
3394 
3403 
3404  return
3405  end subroutine atmos_vars_restart_def_var
3406 
3407  !-----------------------------------------------------------------------------
3409  subroutine atmos_vars_restart_write
3410  use scale_file_cartesc, only: &
3411  file_cartesc_write_var
3412  use mod_atmos_admin, only: &
3413  atmos_sw_dyn, &
3414  atmos_sw_phy_mp, &
3415  atmos_sw_phy_ae, &
3416  atmos_sw_phy_ch, &
3417  atmos_sw_phy_rd, &
3418  atmos_sw_phy_sf, &
3419  atmos_sw_phy_tb, &
3421  use mod_cpl_admin, only: &
3422  cpl_sw
3423  use mod_atmos_dyn_vars, only: &
3425  use mod_atmos_phy_mp_vars, only: &
3427  use mod_atmos_phy_ae_vars, only: &
3429  use mod_atmos_phy_ch_vars, only: &
3431  use mod_atmos_phy_rd_vars, only: &
3433  use mod_atmos_phy_sf_vars, only: &
3435  use mod_atmos_phy_tb_vars, only: &
3437  use mod_atmos_phy_cp_vars, only: &
3439 #ifdef SDM
3440  use scale_atmos_phy_mp_sdm, only: &
3441  sd_rest_flg_out, &
3442  atmos_phy_mp_sdm_restart_write
3443 #endif
3444  implicit none
3445 
3446  integer iq
3447  !---------------------------------------------------------------------------
3448 
3449 #ifdef SDM
3450  if( sd_rest_flg_out ) then
3451  call atmos_phy_mp_sdm_restart_write
3452  endif
3453 #endif
3454 
3455  if ( restart_fid /= -1 ) then
3456 
3457  call atmos_vars_fillhalo
3458 
3459  call atmos_vars_total
3460 
3461  call file_cartesc_write_var( restart_fid, pv_id(i_dens), dens(:,:,:), pv_info(i_dens)%NAME, 'ZXY' ) ! [IN]
3462  call file_cartesc_write_var( restart_fid, pv_id(i_momz), momz(:,:,:), pv_info(i_momz)%NAME, 'ZHXY' ) ! [IN]
3463  call file_cartesc_write_var( restart_fid, pv_id(i_momx), momx(:,:,:), pv_info(i_momx)%NAME, 'ZXHY' ) ! [IN]
3464  call file_cartesc_write_var( restart_fid, pv_id(i_momy), momy(:,:,:), pv_info(i_momy)%NAME, 'ZXYH' ) ! [IN]
3465  call file_cartesc_write_var( restart_fid, pv_id(i_rhot), rhot(:,:,:), pv_info(i_rhot)%NAME, 'ZXY' ) ! [IN]
3466 
3467  do iq = 1, qa
3468  call file_cartesc_write_var( restart_fid, pv_id(pv_nmax+iq), qtrc(:,:,:,iq), tracer_name(iq), 'ZXY' ) ! [IN]
3469  enddo
3470 
3471  endif
3472 
3478  if( atmos_sw_phy_sf .and. (.not. cpl_sw) ) call atmos_phy_sf_vars_restart_write
3481 
3482  return
3483  end subroutine atmos_vars_restart_write
3484 
3485 
3486  ! private
3487  subroutine allocate_3d( ary )
3488  use scale_const, only: &
3489  undef => const_undef
3490  real(RP), intent(inout), allocatable :: ary(:,:,:)
3491 
3492  if ( .not. allocated(ary) ) then
3493  allocate( ary(ka,ia,ja) )
3494  ary(:,:,:) = undef
3495  end if
3496 
3497  return
3498  end subroutine allocate_3d
3499 
3500  subroutine allocate_2d( ary )
3501  use scale_const, only: &
3502  undef => const_undef
3503  real(RP), intent(inout), allocatable :: ary(:,:)
3504 
3505  if ( .not. allocated(ary) ) then
3506  allocate( ary(ia,ja) )
3507  ary(:,:) = undef
3508  end if
3509 
3510  return
3511  end subroutine allocate_2d
3512 
3513  subroutine allocate_1d( ary )
3514  use scale_const, only: &
3515  undef => const_undef
3516  real(RP), intent(inout), allocatable :: ary(:)
3517 
3518  if ( .not. allocated(ary) ) then
3519  allocate( ary(ka) )
3520  ary(:) = undef
3521  end if
3522 
3523  return
3524  end subroutine allocate_1d
3525 
3526 end module mod_atmos_vars
module ATMOS admin
subroutine, public atmos_phy_sf_vars_restart_def_var
Write restart.
real(rp), dimension(:,:,:), allocatable, public dens_tp
integer, parameter, public i_rhot
Definition: scale_index.F90:32
module atmosphere / adiabat
subroutine, public atmos_phy_sf_vars_restart_open
Open restart file for read.
subroutine, public atmos_diagnostic_get_n2(KA, KS, KE, IA, IS, IE, JA, JS, JE, POTT, Rtot, CZ, N2)
ATMOS_DIAGNOSTIC_get_n2 N^2.
module DEBUG
Definition: scale_debug.F90:11
subroutine, public atmos_phy_ae_vars_restart_create
Create restart file.
real(rp), dimension(:,:,:), allocatable, public pres_ref
subroutine, public atmos_dyn_vars_restart_def_var
Define variables in restart file.
subroutine, public atmos_phy_cp_vars_restart_def_var
Write restart.
logical, public atmos_sw_phy_cp
subroutine, public atmos_vars_restart_open
Open restart file for reading atmospheric variables.
real(rp), dimension(:,:,:), allocatable, target, public momz
subroutine, public atmos_phy_rd_vars_restart_close
Close restart file.
real(rp), public const_cvdry
specific heat (dry air,constant volume) [J/kg/K]
Definition: scale_const.F90:57
subroutine, public atmos_phy_tb_vars_restart_enddef
Exit netCDF define mode.
subroutine, public atmos_bottom_estimate(KA, KS, KE, IA, IS, IE, JA, JS, JE, DENS, PRES, CZ, Zsfc, Z1, SFC_DENS, SFC_PRES)
Calc bottom boundary of atmosphere (just above surface)
module Atmosphere / Physics Cumulus
subroutine, public atmos_phy_sf_vars_restart_read
Read restart.
subroutine, public atmos_phy_tb_vars_restart_read
Read restart.
subroutine, public atmos_dyn_vars_restart_open
Open restart file for read.
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
Definition: scale_const.F90:56
real(rp), dimension(:,:,:), allocatable, public dens_ref
module atmosphere / saturation
subroutine, public atmos_phy_rd_vars_restart_create
Create restart file.
subroutine, public atmos_phy_ch_vars_setup
Setup.
real(rp), dimension(:,:,:), pointer, public qc
subroutine, public atmos_phy_ch_vars_restart_close
Close restart file.
recursive subroutine atmos_vars_get_diagnostic_2d(vname, var)
get diagnostic variable 2D
real(rp), dimension(:,:,:), allocatable, target, public phydh
subroutine, public atmos_phy_cp_vars_restart_enddef
Exit netCDF define mode.
logical, public atmos_sw_phy_rd
subroutine, public atmos_phy_mp_vars_get_diagnostic(DENS, TEMP, QTRC, CLDFRAC, Re, Qe, Ne)
real(rp), dimension(:,:,:), allocatable, target, public rhot
real(rp), dimension(:,:,:), allocatable, public momy_tp
subroutine, public atmos_phy_mp_vars_restart_enddef
Exit netCDF define mode.
subroutine, public atmos_vars_restart_close
Close restart file.
subroutine, public atmos_vars_fillhalo(FILL_BND)
HALO Communication.
real(rp), dimension(qa_max), public tracer_r
real(rp), dimension(:,:,:), allocatable, target, public qdry
integer, public ia
of whole cells: x, local, with HALO
subroutine, public atmos_phy_cp_vars_restart_open
Open restart file for read.
module Atmosphere / Physics Cloud Microphysics
integer, parameter, public i_momx
Definition: scale_index.F90:30
integer, parameter, public i_hs
snow
logical, public atmos_restart_in_postfix_timelabel
Add timelabel to the basename of input file?
subroutine, public atmos_phy_cp_vars_restart_write
Write restart.
module atmosphere / bottom boundary extrapolation
subroutine, public atmos_dyn_vars_restart_enddef
Exit netCDF define mode.
module Atmosphere Grid CartesianC metirc
module Atmosphere / Dynamics
subroutine, public atmos_phy_tb_vars_restart_write
Write restart.
integer, parameter, public i_momz
Definition: scale_index.F90:29
subroutine, public atmos_dyn_vars_restart_close
Close restart file.
module ATMOSPHERIC Variables
subroutine allocate_1d(ary)
real(rp), dimension(:,:,:,:), pointer, public qtrc_av
integer, parameter, public i_hr
liquid water rain
real(rp), dimension(:,:,:), allocatable, target, public momx
integer, parameter, public i_hi
ice water cloud
real(dp), public time_nowdaysec
second of current time [sec]
Definition: scale_time.F90:73
subroutine, public atmos_vars_restart_write
Write restart of atmospheric variables.
subroutine, public atmos_phy_ch_vars_restart_enddef
Exit netCDF define mode.
subroutine, public atmos_phy_ch_vars_restart_def_var
Write restart.
real(rp), public atmos_grid_cartesc_real_totvolzxv
total volume (zxv, local) [m3]
character(len=h_short), public atmos_restart_out_dtype
REAL4 or REAL8.
subroutine, public atmos_phy_mp_vars_restart_def_var
Define variables in restart file.
real(rp), dimension(:,:,:), allocatable, public rhot_tp
integer, public qa
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_vol
control volume (zxy) [m3]
real(rp), public atmos_grid_cartesc_real_totvol
total volume (zxy, local) [m3]
subroutine, public atmos_phy_cp_vars_restart_create
Create restart file.
real(rp), public atmos_restart_check_criterion
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_fz
geopotential height [m] (wxy)
logical, public atmos_sw_phy_ae
integer, public ja
of whole cells: y, local, with HALO
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:55
subroutine, public atmos_vars_calc_diagnostics
Calc diagnostic variables.
subroutine, public atmos_phy_ae_vars_reset_diagnostics
subroutine, public file_history_reg(name, desc, unit, itemid, standard_name, ndims, dim_type, cell_measures, fill_halo)
Register/Append variable to history file.
real(rp), dimension(:,:,:), pointer, public qr
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_volzxv
control volume (zxv) [m3]
real(rp), dimension(:,:,:), allocatable, target, public dens
subroutine allocate_3d(ary)
subroutine, public atmos_phy_sf_vars_restart_enddef
Exit netCDF define mode.
integer, parameter, public i_hh
hail
subroutine, public atmos_dyn_vars_restart_write
Write variables to restart file.
logical, public atmos_restart_in_aggregate
Switch to use aggregate file.
subroutine, public file_history_cartesc_set_pres(PRES, PRESH, SFC_PRES)
set hydrostatic pressure for pressure coordinate
subroutine, public atmos_diagnostic_get_potv(KA, KS, KE, IA, IS, IE, JA, JS, JE, POTT, Rtot, POTV)
ATMOS_DIAGNOSTIC_get_potv virtual potential temperature.
recursive subroutine atmos_vars_get_diagnostic_1d(vname, var)
get diagnostic variable 1D
real(rp), dimension(:,:,:), allocatable, public rhov_tp
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_lw_up
character(len=h_short), dimension(qa_max), public tracer_name
integer, parameter, public i_dens
Definition: scale_index.F90:28
real(rp), dimension(:,:,:), pointer, public qg
logical, public statistics_checktotal
calc&report variable totals to logfile?
real(rp), dimension(:,:), allocatable, public atmos_phy_mp_sflx_rain
subroutine, public atmos_phy_ae_vars_history(QTRC, RH)
character(len=h_long), public atmos_restart_check_basename
real(rp), dimension(qa_max), public tracer_cv
integer, parameter, public i_momy
Definition: scale_index.F90:31
subroutine, public atmos_diagnostic_get_phyd(KA, KS, KE, IA, IS, IE, JA, JS, JE, DENS, PRES, CZ, FZ, PHYD, PHYDH)
ATMOS_DIAGNOSTIC_get_phyd hydrostatic pressure.
subroutine, public atmos_phy_sf_vars_setup
Setup.
real(rp), dimension(:,:,:), allocatable, public rhoh_p
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_toaflx_sw_up
real(rp), public const_undef
Definition: scale_const.F90:41
subroutine, public atmos_phy_tb_vars_restart_create
Create restart file.
subroutine, public atmos_diagnostic_cartesc_get_vel(KA, KS, KE, IA, IS, IE, JA, JS, JE, DENS, MOMZ, MOMX, MOMY, W, U, V)
ATMOS_DIAGNOSTIC_CARTESC_get_vel W, U, V.
character(len=h_short), dimension(qa_max), public tracer_unit
real(rp), dimension(:,:,:), pointer, public qi
subroutine, public atmos_phy_cp_vars_restart_close
Close restart file.
module COMMUNICATION
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdy
reciprocal of center-dy
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_lw_dn
logical, public atmos_restart_output
Output restart file?
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_z1
Height of the lowermost grid from surface (cell center) [m].
real(rp), public atmos_grid_cartesc_real_totvolzuy
total volume (zuy, local) [m3]
module Atmosphere / Physics Radiation
subroutine, public atmos_phy_rd_vars_restart_open
Open restart file for read.
integer, public is
start point of inner domain: x, local
real(rp), dimension(:,:,:), allocatable, target, public momz_avw
real(rp), dimension(qa_max), public tracer_cp
module file
Definition: scale_file.F90:15
module ATMOSPHERIC Surface Variables
subroutine, public atmos_phy_sf_vars_restart_write
Write variables to restart file.
subroutine, public atmos_phy_sf_vars_restart_close
Close restart file.
integer, public ie
end point of inner domain: x, local
real(rp), dimension(:,:,:,:), allocatable, target, public qtrc_avw
subroutine, public file_cartesc_create(basename, title, datatype, fid, date, subsec, haszcoord, append, aggregate, single)
Create/open a netCDF file.
subroutine, public atmos_phy_cp_vars_setup
Setup.
real(rp), dimension(:,:,:), pointer, public momx_av
logical, public atmos_sw_phy_tb
module TRACER
module Index
Definition: scale_index.F90:11
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_sw_up
subroutine, public atmos_phy_rd_vars_restart_def_var
Define variables in restart file.
module atmosphere / hydrometeor
recursive subroutine atmos_vars_get_diagnostic_3d(vname, var)
get diagnostic variable 3D
subroutine, public time_gettimelabel(timelabel)
generate time label
Definition: scale_time.F90:94
module atmosphere / grid / cartesC index
integer, public ke
end point of inner domain: z, local
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_volwxy
control volume (wxy) [m3]
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_sw_dn
subroutine, public atmos_phy_mp_vars_reset_diagnostics
module MONITOR
real(rp), dimension(:,:,:), allocatable, public qv_ref
subroutine, public atmos_diagnostic_get_therm_rhot(KA, KS, KE, IA, IS, IE, JA, JS, JE, DENS, RHOT, Rtot, CVtot, CPtot, POTT, TEMP, PRES, EXNER)
ATMOS_DIAGNOSTIC_get_therm_rhot potential temperature, temperature, pressure.
module PROCESS
Definition: scale_prc.F90:11
subroutine, public atmos_phy_mp_vars_restart_create
Create restart file.
real(rp), dimension(:,:,:,:), allocatable, public rhoq_tp
integer, public je
end point of inner domain: y, local
module atmosphere / diagnostic / CartesianC
module atmosphere / diagnostic
real(rp), dimension(:,:,:), allocatable, target, public temp
subroutine, public atmos_vars_setup
Setup.
logical, public atmos_sw_dyn
real(rp), dimension(:,:,:), allocatable, target, public w
subroutine, public atmos_vars_total
Budget monitor for atmosphere.
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sflx_lh
real(rp), public const_grav
standard acceleration of gravity [m/s2]
Definition: scale_const.F90:46
module atmosphere / physics / PBL
logical, public atmos_restart_out_aggregate
Switch to use aggregate file.
subroutine, public file_cartesc_enddef(fid)
Exit netCDF file define mode.
subroutine, public atmos_phy_tb_vars_setup
Setup.
real(rp), dimension(:,:,:), pointer, public qs
module TIME
Definition: scale_time.F90:16
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_toaflx_lw_dn
real(rp), dimension(:,:,:), allocatable, target, public atmos_phy_sf_sflx_qtrc
subroutine, public atmos_dyn_vars_restart_read
Read restart.
module atmosphere / grid / cartesC
integer, public ks
start point of inner domain: z, local
real(dp), public time_dtsec_atmos_dyn
time interval of dynamics [sec]
Definition: scale_time.F90:40
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_metric_rotc
rotation coefficient
logical, public atmos_sw_phy_sf
subroutine, public atmos_phy_rd_vars_setup
Setup.
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:89
real(rp), dimension(:,:,:), allocatable, target, public pott
logical, public atmos_sw_phy_ch
subroutine, public atmos_phy_ae_vars_restart_enddef
Exit netCDF define mode.
module Atmosphere / Physics Turbulence
real(rp), dimension(:,:,:), pointer, public qh
logical, public atmos_restart_out_postfix_timelabel
Add timelabel to the basename of output file?
real(rp), dimension(:,:,:), allocatable, target, public momx_avw
real(rp), dimension(:,:,:), pointer, public dens_av
real(rp), dimension(:,:,:), allocatable, target, public phyd
logical, public cpl_sw
real(rp), public lhf
latent heat of fusion for use [J/kg]
real(rp), parameter, public const_rvap
specific gas constant (water vapor) [J/kg/K]
Definition: scale_const.F90:63
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
real(rp), dimension(:,:,:), allocatable, public temp_ref
real(rp), public lhv
latent heat of vaporization for use [J/kg]
real(rp), dimension(:,:,:), allocatable, pointer, target, public qv
module CONSTANT
Definition: scale_const.F90:11
logical, public atmos_sw_phy_mp
integer, parameter, public i_hc
liquid water cloud
integer, public js
start point of inner domain: y, local
subroutine, public atmos_phy_rd_vars_restart_write
Write variables to restart file.
subroutine, public file_cartesc_def_var(fid, varname, desc, unit, dim_type, datatype, vid, standard_name, timeintv, nsteps, cell_measures)
Define a variable to file.
subroutine, public atmos_dyn_vars_setup
Setup.
subroutine, public atmos_phy_ae_vars_setup
Setup.
subroutine, public atmos_phy_ae_vars_restart_read
Read restart.
real(rp), public atmos_grid_cartesc_real_totvolwxy
total volume (wxy, local) [m3]
real(rp), dimension(:,:,:,:), allocatable, public atmos_grid_cartesc_metric_mapf
map factor
real(rp), dimension(:,:,:), allocatable, public momx_tp
real(rp), dimension(:,:,:), allocatable, target, public cvtot
real(rp), dimension(:,:,:), allocatable, target, public momy
subroutine, public atmos_phy_mp_vars_restart_open
Open restart file for read.
logical function, public file_get_aggregate(fid)
module Atmosphere / Physics Chemistry
real(rp), dimension(:,:,:), allocatable, target, public v
subroutine, public atmos_phy_bl_vars_setup
Setup.
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:157
real(rp), dimension(:,:,:), allocatable, target, public exner
subroutine, public atmos_vars_monitor
monitor output
subroutine, public atmos_vars_restart_create
Create atmospheric restart file.
real(rp), dimension(:,:,:), allocatable, target, public u
real(rp), dimension(:,:), allocatable, public atmos_phy_mp_sflx_snow
real(rp), dimension(:,:,:), allocatable, public momz_tp
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sflx_sh
subroutine, public atmos_vars_restart_enddef
Exit netCDF define mode.
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_cz
geopotential height [m] (zxy)
real(rp), dimension(:,:,:), allocatable, public pott_ref
real(rp), dimension(:,:,:), allocatable, target, public dens_avw
subroutine, public atmos_phy_mp_vars_setup
Setup.
subroutine, public atmos_phy_sf_vars_restart_create
Create restart file.
module profiler
Definition: scale_prof.F90:11
character(len=h_mid), public atmos_restart_out_title
Title of the output file.
logical, public atmos_restart_check
Check value consistency?
subroutine, public atmos_phy_mp_vars_restart_write
Write restart.
subroutine, public atmos_phy_mp_vars_restart_read
Read restart.
subroutine, public atmos_phy_mp_vars_restart_close
Close restart file.
module atmosphere / thermodyn
module Atmosphere GRID CartesC Real(real space)
subroutine, public atmos_phy_rd_vars_restart_enddef
Exit netCDF define mode.
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_toaflx_sw_dn
character(len=h_long), public atmos_restart_in_basename
Basename of the input file.
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rcdx
reciprocal of center-dx
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_area
horizontal area ( xy, normal z) [m2]
subroutine, public atmos_vars_history_setpres
Set pressure for history output.
subroutine, public atmos_phy_tb_vars_restart_def_var
Write restart.
module PRECISION
module file / cartesianC
character(len=h_long), public atmos_restart_out_basename
Basename of the output file.
real(rp), dimension(:,:), allocatable, public topo_zsfc
absolute ground height [m]
subroutine, public atmos_phy_ae_vars_restart_def_var
Write restart.
subroutine, public atmos_phy_ae_vars_restart_write
Write restart.
real(rp), dimension(:,:,:), allocatable, public rhou_tp
integer, public ka
of whole cells: z, local, with HALO
subroutine, public atmos_phy_rd_vars_restart_read
Read restart.
character(len=h_short), public atmos_dyn_type
real(rp), dimension(:,:,:), pointer, public momz_av
module TOPOGRAPHY
character(len=h_mid), dimension(qa_max), public tracer_desc
subroutine, public atmos_phy_ch_vars_restart_write
Write restart.
module file / history_cartesC
subroutine, public atmos_phy_cp_vars_restart_read
Read restart.
real(rp), dimension(:,:,:), allocatable, target, public rhot_avw
module Statistics
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdy
reciprocal of face-dy
real(rp), dimension(:,:,:,:), allocatable, target, public qe
real(rp), dimension(:,:,:), pointer, public rhot_av
real(rp), dimension(:,:,:), allocatable, target, public cptot
subroutine, public atmos_phy_ch_vars_restart_create
Create restart file.
subroutine, public atmos_phy_mp_vars_history(DENS, TEMP, QTRC)
subroutine, public atmos_vars_restart_def_var
Define atmospheric variables in restart file.
module STDIO
Definition: scale_io.F90:10
subroutine allocate_2d(ary)
subroutine, public atmos_phy_ae_vars_restart_close
Close restart file.
subroutine, public file_cartesc_flush(fid)
Flush all pending requests to a netCDF file (PnetCDF only)
subroutine, public atmos_diagnostic_get_teml(KA, KS, KE, IA, IS, IE, JA, JS, JE, TEMP, LHV, LHS, QC, QI, CPtot, TEML)
ATMOS_DIAGNOSTIC_get_teml liqued water temperature.
subroutine, public atmos_vars_history
History output set for atmospheric variables.
integer, parameter, public n_hyd
subroutine, public monitor_reg(name, desc, unit, itemid, ndims, dim_type, isflux)
Search existing item, or matching check between requested and registered item.
subroutine, public atmos_phy_ch_vars_restart_open
Open restart file for read.
module Coupler admin
real(rp), dimension(:,:,:), pointer, public momy_av
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:210
subroutine, public atmos_vars_restart_check
Check and compare between last data and sample data.
real(rp), dimension(:,:,:), allocatable, target, public momy_avw
subroutine, public atmos_phy_ch_vars_restart_read
Read restart.
module ATMOSPHERE / Physics Aerosol Microphysics
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_sflx_rain
subroutine, public file_cartesc_open(basename, fid, aggregate)
open a netCDF file for read
real(rp), dimension(:,:,:), allocatable, target, public pres
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_volzuy
control volume (zuy) [m3]
subroutine, public atmos_dyn_vars_restart_create
Create restart file.
subroutine, public atmos_phy_tb_vars_restart_open
Open restart file for read.
integer, parameter, public i_hg
graupel
subroutine, public file_cartesc_close(fid)
Close a netCDF file.
real(rp), dimension(:,:,:), allocatable, target, public rtot
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_toaflx_lw_up
subroutine, public atmos_phy_tb_vars_restart_close
Close restart file.
real(rp), dimension(qa_max), public tracer_mass
subroutine, public atmos_vars_restart_read
Read restart of atmospheric variables.
subroutine, public atmos_phy_ae_vars_restart_open
Open restart file for read.
module file_history
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_rfdx
reciprocal of face-dx
logical, public atmos_use_average
real(rp), dimension(:,:,:,:), allocatable, target, public qtrc