FE-Project
Loading...
Searching...
No Matches
mod_atmos_vars_container.F90
Go to the documentation of this file.
1!-------------------------------------------------------------------------------
2!> module Atmosphere / Variables
3!!
4!! @par Description
5!! Container for atmospheric variables
6!!
7!! @author Yuta Kawai, Team SCALE
8!!
9!<
10!-------------------------------------------------------------------------------
11#include "scaleFElib.h"
13 !-----------------------------------------------------------------------------
14 !
15 !++ Used modules
16 !
17 use scale_precision
18 use scale_io
19 use scale_prc
20 use scale_tracer, only: qa
21
22 use scale_element_base, only: &
27 use scale_localmeshfield_base, only: &
29 use scale_mesh_base, only: meshbase
32
33 use scale_meshfield_base, only: &
35 use scale_model_var_manager, only: &
36 modelvarmanager, variableinfo
37
39 prgvar_num, auxvar_num, phytend_num1 => phytend_num, &
46
47 use mod_atmos_mesh, only: atmosmesh
48 use mod_atmos_phy_preproc, only: &
53 !-----------------------------------------------------------------------------
54 implicit none
55 private
56
57 !-----------------------------------------------------------------------------
58 !
59 !++ Public type & procedures
60 !
61
62 !> Derived type to manage a set of variables (prognostic variables, tracer variables, auxiliary variables, and tendencies of physical processes) with atmospheric component
63 type, public :: atmosvarscontainer
64 class(atmosmesh), pointer :: mesh !< Pointer to an object to manage mesh for atmospheric component
65
66 !- prognostic variables
67 type(meshfield3d), allocatable :: prog_vars(:) !< Array of 3D prognostic variables
68 type(modelvarmanager) :: progvars_manager !< Object to manage 3D prognostic variables
69 integer :: prog_vars_commid
70
71 !- tracer variables
72 type(meshfield3d), allocatable :: qtrc_vars(:) !< Array of 3D tracer variables
73 type(modelvarmanager) :: qtrcvars_manager !< Object to manage 3D tracer variables
74 integer :: qtrc_vars_commid
75
76 !- auxiliary variables
77 type(meshfield3d), allocatable :: aux_vars(:) !< Array of 3D auxiliary variables
78 type(modelvarmanager) :: auxvars_manager !< Object to manage 3D auxiliary variables
79 integer :: aux_vars_commid
80
81 !- auxiliary variables (2D)
82 type(meshfield2d), allocatable :: aux_vars2d(:) !< Array of 2D auxiliary variables
83 type(modelvarmanager) :: auxvars2d_manager !< Object to manage 3D auxiliary variables
84
85 !- Tendency with physics
86 type(meshfield3d), allocatable :: phy_tend(:) !< Array of tendency variables with physics
87 type(modelvarmanager) :: phytends_manager !< Object to manage tendency variables with physics
88 integer :: phytends_commid
89 integer :: phytend_num_tot !< Total number of tendency variables with physics
90
91 !-
92 integer :: container_type
93 integer :: phy_preproc_operation_type
94 class(physpreprocbase), allocatable :: phy_preproc
95
96 contains
97 procedure :: init => atmosvarscontainer_init
98 procedure :: final => atmosvarscontainer_final
99 procedure :: calc_diagnostics => atmosvarscontainer_calculatediagnostics
100 procedure :: calc_diagvar => atmosvarscontainer_calcdiagvar
101 procedure :: calc_specificheat => atmosvarscontainer_calc_specific_heat
102 procedure :: preproc_operation_for_phys => atmosvarscontainer_physics_preoperation
103
104 procedure, private :: setup_phys_preoperation
105 end type atmosvarscontainer
106
107 integer, parameter, public :: atm_vars_container_primary_id = 1
108
118
119 !-----------------------------------------------------------------------------
120 !
121 !++ Public parameters & variables
122 !
123 !-----------------------------------------------------------------------------
124 !
125 !++ Private procedures & variables
126 !
127 private :: vars_calc_diagnosevar_lc
128
129 ! Surface variables
130
131 integer, public, parameter :: atmos_auxvars2d_prec_id = 1
132 integer, public, parameter :: atmos_auxvars2d_prec_engi_id = 2
133 integer, public, parameter :: atmos_auxvars2d_num = 2
134
135 type(variableinfo), public :: atmos_auxvars2d_vinfo(atmos_auxvars2d_num)
136 DATA atmos_auxvars2d_vinfo / &
137 variableinfo( atmos_auxvars2d_prec_id , 'PREC', 'surface precipitaion flux' , 'kg/m2/s', 2, 'XY', 'precipitation_flux' ), &
138 variableinfo( atmos_auxvars2d_prec_engi_id, 'PREC_ENGI', 'internal energy of precipitation' , 'J/m2', 2, 'XY', '' ) /
139
140 !
141 integer, parameter :: phy_preoperation_typeid_none = 0
142 integer, parameter :: phy_preoperation_typeid_modalfilter = 1
143 integer, parameter :: phy_preoperation_typeid_globalfilter = 2
144
145contains
146
147 !> Initalize an object to manage a set of variables with atmospheric component
148!OCL SERIAL
149 subroutine atmosvarscontainer_init( this, &
150 container_type, phy_preproc_file_basename, &
151 atm_mesh )
152 use scale_const, only: &
153 undef => const_undef
154 use scale_tracer, only: &
155 tracer_name, tracer_desc, tracer_unit
159
160 implicit none
161 class(atmosvarscontainer), intent(inout) :: this
162 integer, intent(in) :: container_type
163 character(len=*), intent(in) :: phy_preproc_file_basename
164 class(atmosmesh), target, intent(inout) :: atm_mesh
165
166 integer :: iv
167 integer :: idom
168
169 type(variableinfo) :: prgvar_info(prgvar_num)
170 logical :: do_setup_phytend
171 logical :: do_setup_auxvar2d
172 logical :: reg_file_hist
173
174 class(meshbase3d), pointer :: mesh3d
175 class(meshbase2d), pointer :: mesh2d
176 !---------------------------------------------------------
177
178 if ( container_type == atm_vars_container_primary_id ) then
179 do_setup_auxvar2d = .true.
180 do_setup_phytend = .true.
181 reg_file_hist = .true.
182 else
183 do_setup_auxvar2d = .false.
184 do_setup_phytend = .false.
185 reg_file_hist = .false.
186 end if
187
188 this%mesh => atm_mesh
189 mesh3d => atm_mesh%ptr_mesh
190 call mesh3d%GetMesh2D( mesh2d )
191
192 !-
193 call this%PROGVARS_manager%Init()
194 call this%QTRCVARS_manager%Init()
195 call this%AUXVARS_manager%Init()
196
197 allocate( this%PROG_VARS(prgvar_num) )
198 allocate( this%QTRC_VARS(0:qa) )
199 allocate( this%AUX_VARS(auxvar_num) )
200 !$acc enter data create( this%PROG_VARS, this%QTRC_VARS, this%AUX_VARS )
201
202 if ( do_setup_phytend ) then
203 call this%PHYTENDS_manager%Init()
204
205 this%PHYTEND_NUM_TOT = phytend_num1 + max(1,qa)
206 allocate( this%PHY_TEND(this%PHYTEND_NUM_TOT) )
207 !$acc enter data create( this%PHY_TEND )
208 end if
209
211 this%PROG_VARS, this%QTRC_VARS, this%AUX_VARS, this%PHY_TEND, & ! (inout)
212 this%PROGVARS_manager, this%QTRCVARS_manager, this%AUXVARS_manager, this%PHYTENDS_manager, & ! (inout)
213 reg_file_hist, do_setup_phytend, this%PHYTEND_NUM_TOT, mesh3d, & ! (in)
214 prgvar_info ) ! (out)
215
216 ! Setup communicator
217
218 call atm_mesh%Create_communicator( &
220 this%PROGVARS_manager, & ! (inout)
221 this%PROG_VARS, & ! (in)
222 this%PROG_VARS_commID ) ! (out)
223
224
225 if ( qa > 0 ) then
226 call atm_mesh%Create_communicator( &
227 qa, 0, 0, & ! (in)
228 this%QTRCVARS_manager, & ! (inout)
229 this%QTRC_VARS(1:qa), & ! (in)
230 this%QTRC_VARS_commID ) ! (out)
231 end if
232
233 call atm_mesh%Create_communicator( &
234 auxvar_num, 0, 0, & ! (in)
235 this%AUXVARS_manager, & ! (inout)
236 this%AUX_VARS, & ! (in)
237 this%AUX_VARS_commID ) ! (out)
238
239 ! Output list of prognostic variables
240
241 if ( container_type == atm_vars_container_primary_id ) then
242 log_newline
243 log_info("ATMOS_vars_setup",*) 'List of prognostic variables (ATMOS) '
244 log_info_cont('(1x,A,A24,A,A48,A,A12,A)') &
245 ' |', 'VARNAME ','|', &
246 'DESCRIPTION ', '[', 'UNIT ', ']'
247 do iv = 1, prgvar_num
248 log_info_cont('(1x,A,I3,A,A24,A,A48,A,A12,A)') &
249 'NO.',iv,'|',prgvar_info(iv)%NAME,'|', prgvar_info(iv)%DESC,'[', prgvar_info(iv)%UNIT,']'
250 end do
251 do iv = 1, qa
252 log_info_cont('(1x,A,I3,A,A24,A,A48,A,A12,A)') &
253 'NO.',prgvar_num+iv,'|',tracer_name(iv),'|', tracer_desc(iv),'[', tracer_unit(iv),']'
254 end do
255 log_newline
256 end if
257
258 !- Initialize 2D auxiliary variables
259 if ( do_setup_auxvar2d ) then
260 call this%AUXVARS2D_manager%Init()
261 allocate( this%AUX_VARS2D(atmos_auxvars2d_num) )
262 !$acc enter data create( this%AUX_VARS2D )
263
264 do iv = 1, atmos_auxvars2d_num
265 call this%AUXVARS2D_manager%Regist( &
266 atmos_auxvars2d_vinfo(iv), mesh2d, & ! (in)
267 this%AUX_VARS2D(iv), & ! (inout)
268 reg_file_hist ) ! (in)
269 do idom=1, mesh2d%LOCAL_MESH_NUM
270 this%AUX_VARS2D(iv)%local(idom)%val(:,:) = undef
271 end do
272 end do
273 end if
274
275 !- Setup preoperation before physics
276 this%container_type = container_type
277 call this%Setup_phys_preoperation( phy_preproc_file_basename, mesh3d, mesh3d%refElem3D )
278
279 return
280 end subroutine atmosvarscontainer_init
281
282 !> Finalize an object to manage a set of variables with atmospheric component
283!OCL SERIAL
284 subroutine atmosvarscontainer_final( this )
285 implicit none
286 class(atmosvarscontainer), intent(inout) :: this
287 !----------------------------------------
288
289 !$acc exit data delete( this%PROG_VARS, this%QTRC_VARS, this%AUX_VARS )
290
291 call this%PROGVARS_manager%Final()
292 deallocate( this%PROG_VARS )
293
294 call this%QTRCVARS_manager%Final()
295 deallocate( this%QTRC_VARS )
296
297 call this%AUXVARS_manager%Final()
298 deallocate( this%AUX_VARS )
299
300 if ( this%container_type == atm_vars_container_primary_id ) then
301 !$acc exit data delete( this%PHY_TEND, this%AUX_VARS2D )
302
303 call this%PHYTENDS_manager%Final()
304 deallocate( this%PHY_TEND )
305
306 call this%AUXVARS2D_manager%Final()
307 deallocate( this%AUX_VARS2D )
308 else
309 ! Finalize preoperation before physics
310 call this%phy_preproc%Final()
311 end if
312
313 return
314 end subroutine atmosvarscontainer_final
315
316 !> Calculate diagnostic variables from prognostic variables and auxiliary variables
317!OCL SERIAL
318 subroutine atmosvarscontainer_calculatediagnostics( this )
319 use scale_const, only: &
320 rdry => const_rdry, &
321 cpdry => const_cpdry, &
322 cvdry => const_cvdry, &
323 pres00 => const_pre00
324 use scale_tracer, only: &
325 tracer_mass, tracer_r, tracer_cv, tracer_cp
326 use scale_atmos_thermodyn, only: &
327 atmos_thermodyn_specific_heat
328 implicit none
329 class(atmosvarscontainer), intent(inout), target :: this
330
331 class(localmesh3d), pointer :: lcmesh3d
332 integer :: n
333 integer :: varid
334
335 class(meshfield3d), pointer :: field
336 class(elementbase3d), pointer :: elem3d
337
338 type(localmeshfieldbaselist) :: qtrc(qa)
339 !-------------------------------------------------------
340
341 ! Calculate specific heat
342 call this%Calc_SpecificHeat()
343
344 ! Calculate diagnostic variables
345 do varid=auxvar_thermhydro_id+1, auxvar_pt_id
346 field => this%AUX_VARS(varid)
347 do n=1, field%mesh%LOCAL_MESH_NUM
349 field%mesh, this%QTRCVARS_manager, &
350 1, qtrc, lcmesh3d )
351
352 elem3d => lcmesh3d%refElem3D
353
354 call vars_calc_diagnosevar_lc( &
355 field%varname, field%local(n)%val, &
356 this%PROG_VARS(prgvar_ddens_id)%local(n)%val, &
357 this%PROG_VARS(prgvar_momx_id)%local(n)%val, &
358 this%PROG_VARS(prgvar_momy_id)%local(n)%val, &
359 this%PROG_VARS(prgvar_momz_id)%local(n)%val, &
360 this%AUX_VARS(auxvar_pres_id)%local(n)%val, &
361 this%AUX_VARS(auxvar_qdry_id)%local(n)%val, &
362 qtrc, &
363 this%AUX_VARS(auxvar_denshydro_id)%local(n)%val, &
364 this%AUX_VARS(auxvar_preshydro_id)%local(n)%val, &
365 this%AUX_VARS(auxvar_rtot_id )%local(n)%val, &
366 this%AUX_VARS(auxvar_cvtot_id)%local(n)%val, &
367 this%AUX_VARS(auxvar_cptot_id)%local(n)%val, &
368 lcmesh3d, lcmesh3d%refElem3D )
369 end do
370 end do
371 !$acc wait(1)
372
373 return
374 end subroutine atmosvarscontainer_calculatediagnostics
375
376 !> Calcualte a diagnostic variable from prognostic variables and auxiliary variables
377!OCL SERIAL
378 subroutine atmosvarscontainer_calcdiagvar( this, field_name, field_work )
379 use scale_const, only: &
380 rdry => const_rdry, &
381 cpdry => const_cpdry, &
382 cvdry => const_cvdry, &
383 pres00 => const_pre00
384 use scale_tracer, only: &
385 tracer_mass, tracer_r, tracer_cv, tracer_cp
386 use scale_atmos_thermodyn, only: &
387 atmos_thermodyn_specific_heat
388
389 implicit none
390 class(atmosvarscontainer), intent(inout) :: this
391 character(*), intent(in) :: field_name !< Name of the diagnostic variable to be calculated
392 type(meshfield3d), intent(inout) :: field_work !< A work space for the diagnostic variable to be calculated
393
394 class(localmesh3d), pointer :: lcmesh3d
395 integer :: n
396
397 type(meshfield3d) :: field_work_uvmet(2)
398 logical :: is_uvmet
399 integer :: uvmet_i
400
401 type(localmeshfieldbaselist) :: qtrc(qa)
402 !--------------------------------------------------
403
404 is_uvmet = .false.
405 if ( field_name == 'Umet' ) then
406 is_uvmet = .true.; uvmet_i = 1
407 else if ( field_name == 'Vmet' ) then
408 is_uvmet = .true.; uvmet_i = 2
409 end if
410
411 field_work%varname = field_name
412
413 do n=1, field_work%mesh%LOCAL_MESH_NUM
415 field_work%mesh, this%QTRCVARS_manager, &
416 1, qtrc, lcmesh3d )
417
418 if ( .not. is_uvmet ) then
419 call vars_calc_diagnosevar_lc( field_name, field_work%local(n)%val, &
420 this%PROG_VARS(prgvar_ddens_id)%local(n)%val, &
421 this%PROG_VARS(prgvar_momx_id)%local(n)%val, &
422 this%PROG_VARS(prgvar_momy_id)%local(n)%val, &
423 this%PROG_VARS(prgvar_momz_id)%local(n)%val, &
424 this%AUX_VARS(auxvar_pres_id)%local(n)%val, &
425 this%AUX_VARS(auxvar_qdry_id)%local(n)%val, &
426 qtrc, &
427 this%AUX_VARS(auxvar_denshydro_id)%local(n)%val, &
428 this%AUX_VARS(auxvar_preshydro_id)%local(n)%val, &
429 this%AUX_VARS(auxvar_rtot_id )%local(n)%val, &
430 this%AUX_VARS(auxvar_cvtot_id)%local(n)%val, &
431 this%AUX_VARS(auxvar_cptot_id)%local(n)%val, &
432 lcmesh3d, lcmesh3d%refElem3D )
433 else
434 call field_work_uvmet(1)%Init( 'Umet', '', field_work%mesh )
435 call field_work_uvmet(2)%Init( 'Vmet', '', field_work%mesh )
436
437 call this%mesh%Calc_UVmet( &
438 this%PROG_VARS(prgvar_momx_id), this%PROG_VARS(prgvar_momy_id), & ! (in)
439 field_work_uvmet(1), field_work_uvmet(2) ) ! (inout)
440 call momtovel( field_work%local(n)%val, & ! (out)
441 field_work_uvmet(uvmet_i)%local(n)%val, & ! (in)
442 this%PROG_VARS(prgvar_ddens_id)%local(n)%val, & ! (in)
443 this%AUX_VARS(auxvar_denshydro_id)%local(n)%val, & ! (in)
444 lcmesh3d, lcmesh3d%refElem3D ) ! (in)
445
446 call field_work_uvmet(1)%Final()
447 call field_work_uvmet(2)%Final()
448 end if
449 end do
450 !$acc wait(1)
451 return
452 contains
453 subroutine momtovel( vel, &
454 mom, ddens, dens_hyd, lmesh, elem )
455 implicit none
456 class(localmesh3d), intent(in) :: lmesh
457 class(elementbase3d), intent(in) :: elem
458 real(RP), intent(inout) :: vel(elem%Np,lmesh%NeA)
459 real(RP), intent(in) :: mom(elem%Np,lmesh%NeA)
460 real(RP), intent(in) :: ddens(elem%Np,lmesh%NeA)
461 real(RP), intent(in) :: dens_hyd(elem%Np,lmesh%NeA)
462
463 integer :: ke, p
464 !-----------------------------------------------
465
466 !$omp parallel do
467 !$acc parallel loop collapse(2) present(vel, mom, ddens, dens_hyd) async(1)
468 do ke =lmesh%NeS, lmesh%NeE
469 do p = 1, elem%Np
470 vel(p,ke) = mom(p,ke) / ( ddens(p,ke) + dens_hyd(p,ke) )
471 end do
472 end do
473
474 return
475 end subroutine momtovel
476 end subroutine atmosvarscontainer_calcdiagvar
477
478 !> Calculate specific heat coefficients which are weighted by the mass of dry air and tracers
479!OCL SERIAL
480 subroutine atmosvarscontainer_calc_specific_heat( this )
481 use scale_const, only: &
482 rdry => const_rdry, &
483 cpdry => const_cpdry, &
484 cvdry => const_cvdry, &
485 pres00 => const_pre00
486 use scale_tracer, only: &
487 tracer_mass, tracer_r, tracer_cv, tracer_cp
488 use scale_atmos_thermodyn, only: &
489 atmos_thermodyn_specific_heat
490 implicit none
491 class(atmosvarscontainer), intent(inout), target :: this
492
493 class(meshbase3d), pointer :: mesh3D
494 class(localmesh3d), pointer :: lcmesh3D
495 integer :: n
496 integer :: ke, p
497 integer :: iq
498
499 class(elementbase3d), pointer :: elem3D
500
501 real(RP), allocatable :: q_tmp(:,:)
502 class(localmeshfieldbase), pointer :: Qdry, Rtot, CVtot, CPtot
503 type(localmeshfieldbaselist) :: QTRC(QA)
504 !-------------------------------------------------------
505
506 mesh3d => this%AUX_VARS(1)%mesh
507
508 ! Calculate specific heat
509 do n=1, mesh3d%LOCAL_MESH_NUM
510 lcmesh3d => mesh3d%lcmesh_list(n)
511 elem3d => lcmesh3d%refElem3D
512 !$acc enter data attach(lcmesh3D, elem3D)
513
514 allocate( q_tmp(elem3d%Np,qa) )
515
517 mesh3d, this%QTRCVARS_manager, &
518 1, qtrc, lcmesh3d )
519#ifdef _OPENACC
520 do iq=1, qa
521 !$acc enter data attach(QTRC(iq)%ptr)
522 end do
523#endif
524
525 qdry => this%AUX_VARS(auxvar_qdry_id )%local(n)
526 rtot => this%AUX_VARS(auxvar_rtot_id )%local(n)
527 cvtot => this%AUX_VARS(auxvar_cvtot_id)%local(n)
528 cptot => this%AUX_VARS(auxvar_cptot_id)%local(n)
529 !$acc enter data attach(Qdry, Rtot, CVtot, CPtot)
530
531 !$omp parallel do private(ke, iq, q_tmp)
532 !$acc parallel loop gang private(q_tmp) present(Qdry%val, Rtot%val, CVtot%val, CPtot%val, TRACER_MASS, TRACER_R, TRACER_CV, TRACER_CP, lcmesh3D,elem3D)
533 do ke = lcmesh3d%NeS, lcmesh3d%NeE
534 do iq = 1, qa
535 !$acc loop vector
536 do p=1, elem3d%Np
537 q_tmp(p,iq) = qtrc(iq)%ptr%val(p,ke)
538 end do
539 end do
540
541 call atmos_thermodyn_specific_heat( &
542 elem3d%Np, 1, elem3d%Np, qa, & ! (in)
543 q_tmp, tracer_mass, tracer_r, tracer_cv, tracer_cp, & ! (in)
544 qdry%val(:,ke), rtot%val(:,ke), cvtot%val(:,ke), cptot%val(:,ke) ) ! (out)
545 end do
546
547 deallocate(q_tmp)
548 end do
549 return
550 end subroutine atmosvarscontainer_calc_specific_heat
551
552 !> Perform preprocessing operation for variables used in physics
553!OCL SERIAL
554 subroutine atmosvarscontainer_physics_preoperation( this, &
555 container_ori, dyncore )
559
560 use scale_atmos_hydrometeor, only: &
561 qla, qia
562 use scale_atm_phy_mp_dgm_common, only: &
564 implicit none
565 class(atmosvarscontainer), intent(inout), target :: this
566 class(atmosvarscontainer), intent(in), target :: container_ori
567 class(atmdyndgmdriver_nonhydro3d), intent(in) :: dyncore
568
569 integer :: n
570 integer :: iv, iq
571
572 character(len=H_SHORT) :: varname_ori
573 character(len=H_SHORT) :: typeid_s
574
575 class(meshbase3d), pointer :: mesh3D
576 class(localmesh3d), pointer :: lcmesh3D
577 integer :: trcid_list(QA)
578 type(localmeshfieldbaselist) :: lc_qtrc(QA)
579 !----------------------------------------------
580
581 if ( this%container_type == atm_vars_container_primary_id ) return
582
583 log_info("AtmosVarsContainer_physics_preoperation",*) "..."
584
585 call this%phy_preproc%Operate( this%PROG_VARS, this%QTRC_VARS, this%AUX_VARS, & ! (inout)
586 container_ori%PROG_VARS, container_ori%QTRC_VARS, container_ori%AUX_VARS ) ! (in)
587
588 call this%Calc_SpecificHeat()
589
590 call dyncore%update_therm_hyd( this%AUXVARS_manager )
591 call dyncore%calc_pressure( this%AUX_VARS(auxvar_pres_id), &
592 this%PROGVARS_manager, this%AUXVARS_manager )
593
594 !- Apply negative fixer for prognostic variables and auxiliary variables which are used in physics
595 do iq=1, qa
596 trcid_list(iq) = iq
597 end do
598
599 mesh3d => this%AUX_VARS(1)%mesh
600 do n=1, mesh3d%LOCAL_MESH_NUM
601 call this%QTRCVARS_manager%GetLocalMeshFieldList( trcid_list, n, lc_qtrc )
602
603 lcmesh3d => mesh3d%lcmesh_list(n)
605 lc_qtrc, this%PROG_VARS(prgvar_ddens_id)%local(n)%val, this%AUX_VARS(auxvar_pres_id)%local(n)%val, &
606 this%AUX_VARS(auxvar_cvtot_id)%local(n)%val, this%AUX_VARS(auxvar_cptot_id)%local(n)%val, &
607 this%AUX_VARS(auxvar_rtot_id)%local(n)%val, &
608 this%AUX_VARS(auxvar_denshydro_id)%local(n)%val, this%AUX_VARS(auxvar_preshydro_id)%local(n)%val, &
609 1.0_rp, lcmesh3d, lcmesh3d%refElem3D, qa, qla, qia )
610 end do
611
612 !-
613 call this%Calc_diagnostics()
614
615 !- Tentative : Register the variables for file history
616
617 write(typeid_s,'(I2.2)') this%container_type
618 varname_ori = this%PROG_VARS(prgvar_ddens_id)%varname
619 this%PROG_VARS(prgvar_ddens_id)%varname = trim(varname_ori) // "_"//trim(typeid_s)
620 call file_history_meshfield_in( this%PROG_VARS(prgvar_ddens_id), "" )
621 this%PROG_VARS(prgvar_ddens_id)%varname = varname_ori
622
623 varname_ori = this%AUX_VARS(auxvar_pres_id)%varname
624 this%AUX_VARS(auxvar_pres_id)%varname = trim(varname_ori) // "_"//trim(typeid_s)
625 call file_history_meshfield_in( this%AUX_VARS(auxvar_pres_id), "" )
626 this%AUX_VARS(auxvar_pres_id)%varname = varname_ori
627
628 do iv=1, 3
629 varname_ori = this%QTRC_VARS(iv)%varname
630 this%QTRC_VARS(iv)%varname = trim(varname_ori) // "_"//trim(typeid_s)
631 call file_history_meshfield_in( this%QTRC_VARS(iv), "" )
632 this%QTRC_VARS(iv)%varname = varname_ori
633 end do
634
635 return
636 end subroutine atmosvarscontainer_physics_preoperation
637
638 !---- Getter ---------------------------------------------------------------------------
639
640!OCL SERIAL
641 subroutine atmosvars_getlocalmeshprgvar( domID, mesh, prgvars_list, auxvars_list, &
642 varid, &
643 var, DENS_hyd, PRES_hyd, lcmesh3D )
644
645 implicit none
646
647 integer, intent(in) :: domid
648 class(meshbase), intent(in) :: mesh
649 class(modelvarmanager), intent(inout) :: prgvars_list
650 class(modelvarmanager), intent(inout) :: auxvars_list
651 integer, intent(in) :: varid
652 class(localmeshfieldbase), pointer, intent(out) :: var
653 class(localmeshfieldbase), pointer, intent(out), optional :: dens_hyd, pres_hyd
654 class(localmesh3d), pointer, intent(out), optional :: lcmesh3d
655
656 class(meshfieldbase), pointer :: field
657 class(localmeshbase), pointer :: lcmesh
658 !-------------------------------------------------------
659
660 !--
661 call prgvars_list%Get(varid, field)
662 call field%GetLocalMeshField(domid, var)
663
664 if (present(dens_hyd)) then
665 call auxvars_list%Get(auxvar_denshydro_id, field)
666 call field%GetLocalMeshField(domid, dens_hyd)
667 end if
668 if (present(pres_hyd)) then
669 call auxvars_list%Get(auxvar_preshydro_id, field)
670 call field%GetLocalMeshField(domid, pres_hyd)
671 end if
672
673 if (present(lcmesh3d)) then
674 call mesh%GetLocalMesh( domid, lcmesh )
675 nullify( lcmesh3d )
676
677 select type(lcmesh)
678 type is (localmesh3d)
679 if (present(lcmesh3d)) lcmesh3d => lcmesh
680 end select
681 end if
682
683 return
684 end subroutine atmosvars_getlocalmeshprgvar
685
686!OCL SERIAL
687 subroutine atmosvars_getlocalmeshprgvars( domID, mesh, prgvars_list, auxvars_list, &
688 DDENS, MOMX, MOMY, MOMZ, THERM, &
689 DENS_hyd, PRES_hyd, Rtot, CVtot, CPtot, &
690 lcmesh3D )
691 implicit none
692 integer, intent(in) :: domid
693 class(meshbase), intent(in) :: mesh
694 class(modelvarmanager), intent(inout) :: prgvars_list
695 class(modelvarmanager), intent(inout) :: auxvars_list
696 class(localmeshfieldbase), pointer, intent(out) :: ddens, momx, momy, momz, therm
697 class(localmeshfieldbase), pointer, intent(out) :: dens_hyd, pres_hyd
698 class(localmeshfieldbase), pointer, intent(out) :: rtot, cvtot, cptot
699 class(localmesh3d), pointer, intent(out), optional :: lcmesh3d
700
701 class(meshfieldbase), pointer :: field
702 class(localmeshbase), pointer :: lcmesh
703 !-------------------------------------------------------
704
705 !--
706 call prgvars_list%Get(prgvar_ddens_id, field)
707 call field%GetLocalMeshField(domid, ddens)
708
709 call prgvars_list%Get(prgvar_momx_id, field)
710 call field%GetLocalMeshField(domid, momx)
711
712 call prgvars_list%Get(prgvar_momy_id, field)
713 call field%GetLocalMeshField(domid, momy)
714
715 call prgvars_list%Get(prgvar_momz_id, field)
716 call field%GetLocalMeshField(domid, momz)
717
718 call prgvars_list%Get(prgvar_therm_id, field)
719 call field%GetLocalMeshField(domid, therm)
720
721 !--
722 call auxvars_list%Get(auxvar_denshydro_id, field)
723 call field%GetLocalMeshField(domid, dens_hyd)
724
725 call auxvars_list%Get(auxvar_preshydro_id, field)
726 call field%GetLocalMeshField(domid, pres_hyd)
727
728 call auxvars_list%Get(auxvar_rtot_id, field)
729 call field%GetLocalMeshField(domid, rtot)
730
731 call auxvars_list%Get(auxvar_cvtot_id, field)
732 call field%GetLocalMeshField(domid, cvtot)
733
734 call auxvars_list%Get(auxvar_cptot_id, field)
735 call field%GetLocalMeshField(domid, cptot)
736
737 !---
738
739 if ( present(lcmesh3d) ) then
740 call mesh%GetLocalMesh( domid, lcmesh )
741 nullify( lcmesh3d )
742
743 select type(lcmesh)
744 type is (localmesh3d)
745 if (present(lcmesh3d)) lcmesh3d => lcmesh
746 end select
747 end if
748
749 return
750 end subroutine atmosvars_getlocalmeshprgvars
751
752!OCL SERIAL
753 subroutine atmosvars_getlocalmeshsfcvar( domID, mesh, auxvars2D_list, &
754 PREC, PREC_ENGI, lcmesh2D )
755
756 implicit none
757 integer, intent(in) :: domid
758 class(meshbase), intent(in) :: mesh
759 class(modelvarmanager), intent(inout) :: auxvars2d_list
760 class(localmeshfieldbase), pointer, intent(out) :: prec, prec_engi
761 class(localmesh2d), pointer, intent(out), optional :: lcmesh2d
762
763 class(meshfieldbase), pointer :: field
764 class(localmeshbase), pointer :: lcmesh
765 !-------------------------------------------------------
766
767 !--
768 call auxvars2d_list%Get(atmos_auxvars2d_prec_id, field)
769 call field%GetLocalMeshField(domid, prec)
770
771 call auxvars2d_list%Get(atmos_auxvars2d_prec_engi_id, field)
772 call field%GetLocalMeshField(domid, prec_engi)
773
774 if (present(lcmesh2d)) then
775 call mesh%GetLocalMesh( domid, lcmesh )
776 nullify( lcmesh2d )
777
778 select type(lcmesh)
779 type is (localmesh2d)
780 if (present(lcmesh2d)) lcmesh2d => lcmesh
781 end select
782 end if
783
784 return
785 end subroutine atmosvars_getlocalmeshsfcvar
786
787!OCL SERIAL
788 subroutine atmosvars_getlocalmeshqtrcvar( domID, mesh, trcvars_list, &
789 varid, &
790 var, lcmesh3D )
791
792 implicit none
793 integer, intent(in) :: domid
794 class(meshbase), intent(in) :: mesh
795 class(modelvarmanager), intent(inout) :: trcvars_list
796 integer, intent(in) :: varid
797 class(localmeshfieldbase), pointer, intent(out) :: var
798 class(localmesh3d), pointer, intent(out), optional :: lcmesh3d
799
800 class(meshfieldbase), pointer :: field
801 class(localmeshbase), pointer :: lcmesh
802 !-------------------------------------------------------
803
804 !--
805 call trcvars_list%Get(varid, field)
806 call field%GetLocalMeshField(domid, var)
807
808 if (present(lcmesh3d)) then
809 call mesh%GetLocalMesh( domid, lcmesh )
810 nullify( lcmesh3d )
811
812 select type(lcmesh)
813 type is (localmesh3d)
814 if (present(lcmesh3d)) lcmesh3d => lcmesh
815 end select
816 end if
817
818 return
819 end subroutine atmosvars_getlocalmeshqtrcvar
820
821!OCL SERIAL
822 subroutine atmosvars_getlocalmeshqtrc_qv( domID, mesh, trcvars_list, forcing_list, &
823 var, var_tp, lcmesh3D )
824
825 use scale_atmos_hydrometeor, only: &
826 atmos_hydrometeor_dry, &
827 i_qv
828 implicit none
829 integer, intent(in) :: domid
830 class(meshbase), intent(in) :: mesh
831 class(modelvarmanager), intent(inout) :: trcvars_list
832 class(modelvarmanager), intent(inout) :: forcing_list
833 class(localmeshfieldbase), pointer, intent(out) :: var
834 class(localmeshfieldbase), pointer, intent(out), optional :: var_tp
835 class(localmesh3d), pointer, intent(out), optional :: lcmesh3d
836
837 class(meshfieldbase), pointer :: field
838 class(localmeshbase), pointer :: lcmesh
839
840 integer :: iq, tend_iq
841 !-------------------------------------------------------
842
843 !--
844
845 if ( atmos_hydrometeor_dry ) then
846 iq = 0; tend_iq = phytend_num1+1
847 else
848 iq = i_qv; tend_iq = phytend_num1 + i_qv
849 end if
850
851 call trcvars_list%Get(iq, field)
852 call field%GetLocalMeshField(domid, var)
853
854 call forcing_list%Get(tend_iq, field)
855 if (present(var_tp)) call field%GetLocalMeshField(domid, var_tp)
856
857 if (present(lcmesh3d)) then
858 call mesh%GetLocalMesh( domid, lcmesh )
859 nullify( lcmesh3d )
860
861 select type(lcmesh)
862 type is (localmesh3d)
863 if (present(lcmesh3d)) lcmesh3d => lcmesh
864 end select
865 end if
866
867 return
868 end subroutine atmosvars_getlocalmeshqtrc_qv
869
870!OCL SERIAL
871 subroutine atmosvars_getlocalmeshqtrcvarlist( domID, mesh, trcvars_list, &
872 varid_s, &
873 var_list, lcmesh3D )
874
875 implicit none
876 integer, intent(in) :: domid
877 class(meshbase), intent(in) :: mesh
878 class(modelvarmanager), intent(inout) :: trcvars_list
879 integer, intent(in) :: varid_s
880 type(localmeshfieldbaselist), intent(out) :: var_list(:)
881 class(localmesh3d), pointer, intent(out), optional :: lcmesh3d
882
883 class(meshfieldbase), pointer :: field
884 class(localmeshbase), pointer :: lcmesh
885
886 integer :: iq
887 !-------------------------------------------------------
888
889 !--
890 do iq = varid_s, varid_s + size(var_list) - 1
891 call trcvars_list%Get(iq, field)
892 call field%GetLocalMeshField(domid, var_list(iq-varid_s+1)%ptr)
893 end do
894 if (present(lcmesh3d)) then
895 call mesh%GetLocalMesh( domid, lcmesh )
896 nullify( lcmesh3d )
897
898 select type(lcmesh)
899 type is (localmesh3d)
900 if (present(lcmesh3d)) lcmesh3d => lcmesh
901 end select
902 end if
903
904 return
906
907!OCL SERIAL
908 subroutine atmosvars_getlocalmeshphyauxvars( domID, mesh, phyauxvars_list, &
909 PRES, PT, &
910 lcmesh3D )
911
912 implicit none
913 integer, intent(in) :: domid
914 class(meshbase), intent(in) :: mesh
915 class(modelvarmanager), intent(inout) :: phyauxvars_list
916 class(localmeshfieldbase), pointer, intent(out) :: pres, pt
917 class(localmesh3d), pointer, intent(out), optional :: lcmesh3d
918
919 class(meshfieldbase), pointer :: field
920 class(localmeshbase), pointer :: lcmesh
921 !-------------------------------------------------------
922
923 !--
924 call phyauxvars_list%Get(auxvar_pres_id, field)
925 call field%GetLocalMeshField(domid, pres)
926
927 call phyauxvars_list%Get(auxvar_pt_id, field)
928 call field%GetLocalMeshField(domid, pt)
929
930 !---
931
932 if (present(lcmesh3d)) then
933 call mesh%GetLocalMesh( domid, lcmesh )
934 nullify( lcmesh3d )
935
936 select type(lcmesh)
937 type is (localmesh3d)
938 if (present(lcmesh3d)) lcmesh3d => lcmesh
939 end select
940 end if
941
942 return
944
945!OCL SERIAL
946 subroutine atmosvars_getlocalmeshphytends( domID, mesh, phytends_list, &
947 DENS_tp, MOMX_tp, MOMY_tp, MOMZ_tp, RHOT_tp, RHOH_p, &
948 RHOQ_tp, &
949 lcmesh3D )
950
951 implicit none
952 integer, intent(in) :: domid
953 class(meshbase), intent(in) :: mesh
954 class(modelvarmanager), intent(inout) :: phytends_list
955 class(localmeshfieldbase), pointer, intent(out) :: dens_tp, momx_tp, momy_tp, momz_tp, rhot_tp
956 class(localmeshfieldbase), pointer, intent(out) :: rhoh_p
957 type(localmeshfieldbaselist), intent(inout), optional :: rhoq_tp(qa)
958 class(localmesh3d), pointer, intent(out), optional :: lcmesh3d
959
960 class(meshfieldbase), pointer :: field
961 class(localmeshbase), pointer :: lcmesh
962
963 integer :: iq
964 !-------------------------------------------------------
965
966 !--
967 call phytends_list%Get(phytend_dens_id, field)
968 call field%GetLocalMeshField(domid, dens_tp)
969
970 call phytends_list%Get(phytend_momx_id, field)
971 call field%GetLocalMeshField(domid, momx_tp)
972
973 call phytends_list%Get(phytend_momy_id, field)
974 call field%GetLocalMeshField(domid, momy_tp)
975
976 call phytends_list%Get(phytend_momz_id, field)
977 call field%GetLocalMeshField(domid, momz_tp)
978
979 call phytends_list%Get(phytend_rhot_id, field)
980 call field%GetLocalMeshField(domid, rhot_tp)
981
982 call phytends_list%Get(phytend_rhoh_id, field)
983 call field%GetLocalMeshField(domid, rhoh_p)
984
985 if ( present(rhoq_tp) ) then
986 do iq = 1, qa
987 call phytends_list%Get(phytend_num1+iq, field)
988 call field%GetLocalMeshField(domid, rhoq_tp(iq)%ptr)
989 end do
990 end if
991
992 !---
993 if ( present(lcmesh3d) ) then
994 call mesh%GetLocalMesh( domid, lcmesh )
995 nullify( lcmesh3d )
996
997 select type(lcmesh)
998 type is (localmesh3d)
999 if ( present(lcmesh3d) ) lcmesh3d => lcmesh
1000 end select
1001 end if
1002
1003 return
1004 end subroutine atmosvars_getlocalmeshphytends
1005
1006!OCL SERIAL
1007 subroutine atmosvars_getlocalmeshqtrcphytend( domID, mesh, phytends_list, &
1008 qtrcid, &
1009 RHOQ_tp )
1010
1011 implicit none
1012 integer, intent(in) :: domid
1013 class(meshbase), intent(in) :: mesh
1014 class(modelvarmanager), intent(inout) :: phytends_list
1015 integer, intent(in) :: qtrcid
1016 class(localmeshfieldbase), pointer, intent(out) :: rhoq_tp
1017
1018 class(meshfieldbase), pointer :: field
1019 !-------------------------------------------------------
1020
1021 call phytends_list%Get(phytend_num1 + qtrcid, field)
1022 call field%GetLocalMeshField(domid, rhoq_tp)
1023
1024 return
1025 end subroutine atmosvars_getlocalmeshqtrcphytend
1026
1027!-- private -----------------------------------------------------------------------
1028!OCL SERIAL
1029 subroutine setup_phys_preoperation( this, phy_preproc_file_basename, mesh3D, elem3D )
1030 use scale_prc, only: prc_ismaster
1031 implicit none
1032 class(atmosvarscontainer), intent(inout) :: this
1033 character(len=*), intent(in) :: phy_preproc_file_basename
1034 class(meshbase3d), intent(in) :: mesh3d
1035 class(elementbase3d), intent(in) :: elem3d
1036
1037 integer :: fid
1038 character(len=H_SHORT) :: phy_preproc_operation_type = 'None' ! ModalFilter / GlobalFilter
1039 real(rp) :: mf_alpha_h
1040 integer :: mf_order_h
1041 real(rp) :: mf_alpha_v
1042 integer :: mf_order_v
1043
1044 character(len=H_SHORT) :: glfilteroptrtype
1045 character(len=H_SHORT) :: glfiltershape
1046 real(rp) :: glfilterwidthfac
1047 integer :: nnode_h1d_reconst
1048 namelist / param_atmos_vars_container / &
1049 phy_preproc_operation_type, &
1050 mf_alpha_h, mf_order_h, &
1051 mf_alpha_v, mf_order_v, &
1052 glfilteroptrtype, glfiltershape, glfilterwidthfac, nnode_h1d_reconst
1053
1054 character(len=H_LONG) :: cnfname
1055 integer :: ierr
1056
1057 class(physpreprocbase), pointer :: phys_pp_ptr
1058 !----------------------------------------
1059
1060 log_info("ATMOS_vars_container/setup_phys_preoperation",*) "Setting up physical pre-operation for container type ", this%container_type
1061
1062 if ( this%container_type == atm_vars_container_primary_id ) then
1063 this%phy_preproc_operation_type = phy_preoperation_typeid_none
1064 return
1065 end if
1066
1067 !--
1068 mf_alpha_h = 0.0_rp; mf_order_h = 16
1069 mf_alpha_v = 0.0_rp; mf_order_v = 16
1070
1071 glfilteroptrtype = ''
1072 glfiltershape = 'GAUSSIAN'
1073 glfilterwidthfac = 1.0_rp
1074
1075 nnode_h1d_reconst = -1
1076
1077 write(cnfname,'(A,I2.2,A)') trim(phy_preproc_file_basename), this%container_type, ".conf"
1078 fid = io_cnf_open(trim(cnfname), prc_ismaster)
1079
1080 rewind(fid)
1081 read(fid,nml=param_atmos_vars_container,iostat=ierr)
1082 if( ierr < 0 ) then !--- missing
1083 log_info("ATMOS_vars_container/setup_phys_preoperation",*) 'Not found namelist. Default used.'
1084 elseif( ierr > 0 ) then !--- fatal error
1085 log_error("ATMOS_vars_container/setup_phys_preoperation",*) 'Invalid names in namelist PARAM_ATMOS_VARS_CONTAINER. Check!'
1086 call prc_abort
1087 endif
1088 log_nml(param_atmos_vars_container)
1089 close(fid)
1090
1091 !--
1092 select case( phy_preproc_operation_type )
1093 case( 'None' )
1094 this%phy_preproc_operation_type = phy_preoperation_typeid_none
1095 allocate( physpreprocnone :: this%phy_preproc )
1096 case( 'ModalFilter' )
1097 this%phy_preproc_operation_type = phy_preoperation_typeid_modalfilter
1098 allocate( physpreprocmodalfilter :: this%phy_preproc )
1099 case( 'GlobalFilter' )
1100 this%phy_preproc_operation_type = phy_preoperation_typeid_globalfilter
1101 allocate( physpreprocglobalfilter :: this%phy_preproc )
1102 case default
1103 log_error("ATMOS_vars_container/setup_phys_preoperation",*) 'Unsupported PHY_PREPROC_OPERATION_TYPE is specified. Check!', phy_preproc_operation_type
1104 call prc_abort
1105 end select
1106
1107 select type( phys_pp_ptr => this%phy_preproc )
1108 class is (physpreprocnone)
1109 call phys_pp_ptr%Init( mesh3d )
1110 class is (physpreprocmodalfilter)
1111 call phys_pp_ptr%Init( mf_alpha_h, mf_order_h, mf_alpha_v, mf_order_v, mesh3d )
1112 class is (physpreprocglobalfilter)
1113 if ( nnode_h1d_reconst < 0 ) nnode_h1d_reconst = elem3d%Nnode_h1D
1114 call phys_pp_ptr%Init( glfilteroptrtype, &
1115 glfiltershape, glfilterwidthfac, &
1116 nnode_h1d_reconst, &
1117 mesh3d )
1118 end select
1119
1120 return
1121 end subroutine setup_phys_preoperation
1122
1123!OCL SERIAL
1124 subroutine vars_calc_diagnosevar_lc( field_name, var_out, &
1125 DDENS_, MOMX_, MOMY_, MOMZ_, PRES_, QDRY_, QTRC, &
1126 DENS_hyd, PRES_hyd, Rtot, CVtot, CPTot, &
1127 lcmesh, elem )
1128
1129 use scale_const, only: &
1130 grav => const_grav, &
1131 rdry => const_rdry, &
1132 rvap => const_rvap, &
1133 cpdry => const_cpdry, &
1134 cvdry => const_cvdry, &
1135 pres00 => const_pre00
1136 use scale_tracer, only: &
1137 tracer_inq_id, &
1138 tracer_cv, tracer_engi0
1139 use scale_atmos_hydrometeor, only: &
1140 atmos_hydrometeor_dry
1141 use scale_atmos_saturation, only: &
1142 atmos_saturation_psat_liq
1143 implicit none
1144
1145 class(localmesh3d), intent(in) :: lcmesh
1146 class(elementbase3d), intent(in) :: elem
1147 character(*), intent(in) :: field_name
1148 real(rp), intent(out) :: var_out(elem%np,lcmesh%nea)
1149 real(rp), intent(in) :: ddens_(elem%np,lcmesh%nea)
1150 real(rp), intent(in) :: momx_(elem%np,lcmesh%nea)
1151 real(rp), intent(in) :: momy_(elem%np,lcmesh%nea)
1152 real(rp), intent(in) :: momz_(elem%np,lcmesh%nea)
1153 real(rp), intent(in) :: pres_(elem%np,lcmesh%nea)
1154 real(rp), intent(in) :: qdry_(elem%np,lcmesh%nea)
1155 type(localmeshfieldbaselist), intent(in) :: qtrc(qa)
1156 real(rp), intent(in) :: dens_hyd(elem%np,lcmesh%nea)
1157 real(rp), intent(in) :: pres_hyd(elem%np,lcmesh%nea)
1158 real(rp), intent(in) :: rtot (elem%np,lcmesh%nea)
1159 real(rp), intent(in) :: cvtot(elem%np,lcmesh%nea)
1160 real(rp), intent(in) :: cptot(elem%np,lcmesh%nea)
1161
1162 integer :: ke, ke2d
1163 integer :: p
1164 integer :: iq
1165 real(rp) :: dens
1166 real(rp) :: mom_u1, mom_u2, g_11, g_12, g_22
1167 real(rp) :: temp(elem%np), psat(elem%np)
1168
1169 integer :: iq_qv
1170 integer :: indexh2dto3d(elem%np)
1171
1172 integer :: ne, np
1173 !-------------------------------------------------------------------------
1174
1175 ne = lcmesh%Ne; np = elem%Np
1176
1177 select case(trim(field_name))
1178 case('DENS')
1179 !$omp parallel do
1180 !$acc parallel loop collapse(2) present(DDENS_, DENS_hyd, var_out) async(1)
1181 do ke=1, ne
1182 do p=1, np
1183 var_out(p,ke) = ddens_(p,ke) + dens_hyd(p,ke)
1184 end do
1185 end do
1186
1187 case('U')
1188 !$omp parallel do private (DENS)
1189 !$acc parallel loop collapse(2) present(DDENS_, DENS_hyd, MOMX_, var_out) async(1)
1190 do ke=1, ne
1191 do p=1, np
1192 dens = ddens_(p,ke) + dens_hyd(p,ke)
1193 var_out(p,ke) = momx_(p,ke) / dens
1194 end do
1195 end do
1196
1197 case('V')
1198 !$omp parallel do private (DENS)
1199 !$acc parallel loop collapse(2) present(DDENS_, DENS_hyd, MOMY_, var_out) async(1)
1200 do ke=1, ne
1201 do p=1, np
1202 dens = ddens_(p,ke) + dens_hyd(p,ke)
1203 var_out(p,ke) = momy_(p,ke) / dens
1204 end do
1205 end do
1206
1207 case('W')
1208 !$omp parallel do private (DENS)
1209 !$acc parallel loop collapse(2) present(DDENS_, DENS_hyd, MOMZ_, var_out) async(1)
1210 do ke=1, ne
1211 do p=1, np
1212 dens = ddens_(p,ke) + dens_hyd(p,ke)
1213 var_out(p,ke) = momz_(p,ke) / dens
1214 end do
1215 end do
1216
1217 case ( 'PRES' )
1218 case('PRES_diff')
1219 !$omp parallel do
1220 !$acc parallel loop collapse(2) present(PRES_, PRES_hyd, var_out) async(1)
1221 do ke=1, ne
1222 do p=1, np
1223 var_out(p,ke) = pres_(p,ke) - pres_hyd(p,ke)
1224 end do
1225 end do
1226
1227 case('T')
1228 !$omp parallel do
1229 !$acc parallel loop collapse(2) present(PRES_, Rtot, DDENS_, DENS_hyd, var_out) async(1)
1230 do ke=1, ne
1231 do p=1, np
1232 var_out(p,ke) = pres_(p,ke) / (rtot(p,ke) * (ddens_(p,ke) + dens_hyd(p,ke)) )
1233 end do
1234 end do
1235
1236 case('T_diff')
1237 !$omp parallel do
1238 !$acc parallel loop collapse(2) present(PRES_, Rtot, DDENS_, DENS_hyd, PRES_hyd, var_out) async(1)
1239 do ke=1, ne
1240 do p=1, np
1241 var_out(p,ke) = pres_(p,ke) / ( rtot(p,ke) * (ddens_(p,ke) + dens_hyd(p,ke)) ) &
1242 - pres_hyd(p,ke) / ( rdry * dens_hyd(p,ke) )
1243 end do
1244 end do
1245
1246 case('PT')
1247 !$omp parallel do private(DENS)
1248 !$acc parallel loop collapse(2) present(PRES_, Rtot, CVtot, CPtot, DDENS_, DENS_hyd, var_out) async(1)
1249 do ke=1, ne
1250 do p=1, np
1251 dens = ddens_(p,ke) + dens_hyd(p,ke)
1252 var_out(p,ke) = pres_(p,ke) / (rtot(p,ke) * dens ) * ( pres00 / pres_(p,ke) )**( rtot(p,ke) / cptot(p,ke) )
1253 end do
1254 end do
1255
1256 case('PT_diff')
1257 !$omp parallel do private( DENS )
1258 !$acc parallel loop collapse(2) present(PRES_, Rtot, CVtot, CPtot, DDENS_, DENS_hyd, PRES_hyd, var_out) async(1)
1259 do ke=1, ne
1260 do p=1, np
1261 dens = ddens_(p,ke) + dens_hyd(p,ke)
1262 var_out(p,ke) = pres_(p,ke) / (rtot(p,ke) * dens ) * ( pres00 / pres_(p,ke) )**( rtot(p,ke) / cptot(p,ke) ) &
1263 - pres00/rdry * (pres_hyd(p,ke)/pres00)**(cvdry/cpdry) / dens_hyd(p,ke)
1264 end do
1265 end do
1266
1267 case( 'RH', 'RHL' )
1268 if ( atmos_hydrometeor_dry ) then
1269 !$omp parallel do
1270 !$acc parallel loop collapse(2) present(var_out) async(1)
1271 do ke=1, ne
1272 do p=1, np
1273 var_out(p,ke) = 0.0_rp
1274 end do
1275 end do
1276 else
1277 call tracer_inq_id( "QV", iq_qv )
1278
1279 !$omp parallel do private (TEMP, PSAT)
1280 !$acc parallel loop gang private(TEMP, PSAT) present(PRES_, Rtot, DDENS_, DENS_hyd, var_out) async(1)
1281 do ke=1, ne
1282 !$acc loop vector
1283 do p=1, np
1284 temp(p) = pres_(p,ke) / (rtot(p,ke) * (ddens_(p,ke) + dens_hyd(p,ke)) )
1285#ifdef _OPENACC
1286 call atmos_saturation_psat_liq( temp(p), & ! (in)
1287 psat(p) ) ! (out)
1288#endif
1289 end do
1290
1291#ifndef _OPENACC
1292 call atmos_saturation_psat_liq( &
1293 np, 1, np, temp(:), & ! (in)
1294 psat(:) ) ! (out)
1295#endif
1296
1297 !$acc loop vector
1298 do p=1, np
1299 var_out(p,ke) = ( ddens_(p,ke) + dens_hyd(p,ke) ) * qtrc(iq_qv)%ptr%val(p,ke) &
1300 / psat(p) * rvap * temp(p) * 100.0_rp
1301 end do
1302 end do
1303 end if
1304
1305 case('ENGK')
1306 indexh2dto3d(:) = elem%IndexH2Dto3D(:)
1307
1308 !$omp parallel do private (ke2D, DENS, mom_u1, mom_u2, G_11, G_12, G_22)
1309 !$acc parallel loop collapse(2) present(DDENS_, DENS_hyd, MOMX_, MOMY_, MOMZ_, var_out, lcmesh,elem) copyin(IndexH2Dto3D) async(1)
1310 do ke=1, ne
1311 do p=1, np
1312 ke2d = lcmesh%EMap3Dto2D(ke)
1313
1314 dens = ddens_(p,ke) + dens_hyd(p,ke)
1315 g_11 = lcmesh%G_ij(indexh2dto3d(p),ke2d,1,1)
1316 g_12 = lcmesh%G_ij(indexh2dto3d(p),ke2d,1,2)
1317 g_22 = lcmesh%G_ij(indexh2dto3d(p),ke2d,2,2)
1318
1319 mom_u1 = g_11 * momx_(p,ke) + g_12 * momy_(p,ke)
1320 mom_u2 = g_12 * momx_(p,ke) + g_22 * momy_(p,ke)
1321
1322 var_out(p,ke) = 0.5_rp * ( momx_(p,ke) * mom_u1 + momy_(p,ke) * mom_u2 + momz_(p,ke)**2 ) / dens
1323 end do
1324 end do
1325
1326 case('ENGP')
1327 !$omp parallel do private (DENS)
1328 !$acc parallel loop collapse(2) present(DDENS_, DENS_hyd, var_out, lcmesh) async(1)
1329 do ke=1, ne
1330 do p=1, np
1331 dens = ddens_(p,ke) + dens_hyd(p,ke)
1332 var_out(p,ke) = dens * grav * lcmesh%zlev(p,ke)
1333 end do
1334 end do
1335
1336 case('ENGI')
1337 !$omp parallel do private (DENS, iq)
1338 !$acc parallel loop collapse(2) present(DDENS_, DENS_hyd, PRES_, Rtot, QDRY_, var_out) async(1)
1339 do ke=1, ne
1340 do p=1, np
1341 dens = ddens_(p,ke) + dens_hyd(p,ke)
1342 var_out(p,ke) = qdry_(p,ke) * pres_(p,ke) / rtot(p,ke) * cvdry
1343 !$acc loop seq
1344 do iq = 1, qa
1345 var_out(p,ke) = var_out(p,ke) &
1346 + qtrc(iq)%ptr%val(p,ke) * ( pres_(p,ke) / rtot(p,ke) * tracer_cv(iq) + dens * tracer_engi0(iq) )
1347 end do
1348 end do
1349 end do
1350
1351 case('ENGT')
1352 indexh2dto3d(:) = elem%IndexH2Dto3D(:)
1353
1354 !$omp parallel do private (ke2D, DENS, mom_u1, mom_u2, iq, G_11, G_12, G_22)
1355 !$acc parallel loop collapse(2) present(DDENS_, DENS_hyd, MOMX_, MOMY_, MOMZ_, PRES_, Rtot, QDRY_, var_out, lcmesh, elem) copyin(IndexH2Dto3D) async(1)
1356 do ke=1, ne
1357 do p=1, np
1358 ke2d = lcmesh%EMap3Dto2D(ke)
1359
1360 dens = ddens_(p,ke) + dens_hyd(p,ke)
1361
1362 g_11 = lcmesh%G_ij(indexh2dto3d(p),ke2d,1,1)
1363 g_12 = lcmesh%G_ij(indexh2dto3d(p),ke2d,1,2)
1364 g_22 = lcmesh%G_ij(indexh2dto3d(p),ke2d,2,2)
1365 mom_u1 = g_11 * momx_(p,ke) + g_12 * momy_(p,ke)
1366 mom_u2 = g_12 * momx_(p,ke) + g_22 * momy_(p,ke)
1367
1368 ! ENGI
1369 var_out(p,ke) = qdry_(p,ke) * pres_(p,ke) / rtot(p,ke) * cvdry
1370 !$acc loop seq
1371 do iq = 1, qa
1372 var_out(p,ke) = var_out(p,ke) &
1373 + qtrc(iq)%ptr%val(p,ke) * ( pres_(p,ke) / rtot(p,ke) * tracer_cv(iq) + dens * tracer_engi0(iq) )
1374 end do
1375 ! ENGT
1376 var_out(p,ke) = &
1377 0.5_rp * ( momx_(p,ke) * mom_u1 + momy_(p,ke) * mom_u2 + momz_(p,ke)**2 ) / dens & ! ENGK
1378 + var_out(p,ke) & ! ENGI
1379 + dens * grav * lcmesh%pos_en(p,ke,3) ! ENGP
1380 end do
1381 end do
1382
1383 case default
1384 log_error("AtmosVars_calc_diagnoseVar_lc",*) 'The name of diagnostic variable is not suported. Check!', field_name
1385 call prc_abort
1386
1387 end select
1388
1389 return
1390 end subroutine vars_calc_diagnosevar_lc
1391end module mod_atmos_vars_container
1392
subroutine momtovel(vel, mom, ddens, dens_hyd, lmesh, elem)
module Atmosphere / Mesh
module Atmosphere / Physics / Preprocessing
module Atmosphere / Variables
integer, parameter, public atmos_auxvars2d_num
subroutine, public atmosvars_getlocalmeshphytends(domid, mesh, phytends_list, dens_tp, momx_tp, momy_tp, momz_tp, rhot_tp, rhoh_p, rhoq_tp, lcmesh3d)
integer, parameter, public atmos_auxvars2d_prec_id
subroutine, public atmosvars_getlocalmeshsfcvar(domid, mesh, auxvars2d_list, prec, prec_engi, lcmesh2d)
subroutine, public atmosvars_getlocalmeshqtrc_qv(domid, mesh, trcvars_list, forcing_list, var, var_tp, lcmesh3d)
integer, parameter, public atm_vars_container_primary_id
subroutine, public atmosvars_getlocalmeshphyauxvars(domid, mesh, phyauxvars_list, pres, pt, lcmesh3d)
subroutine, public atmosvars_getlocalmeshprgvars(domid, mesh, prgvars_list, auxvars_list, ddens, momx, momy, momz, therm, dens_hyd, pres_hyd, rtot, cvtot, cptot, lcmesh3d)
integer, parameter, public atmos_auxvars2d_prec_engi_id
subroutine, public atmosvars_getlocalmeshqtrcvarlist(domid, mesh, trcvars_list, varid_s, var_list, lcmesh3d)
type(variableinfo), dimension(atmos_auxvars2d_num), public atmos_auxvars2d_vinfo
subroutine, public atmosvars_getlocalmeshqtrcphytend(domid, mesh, phytends_list, qtrcid, rhoq_tp)
subroutine, public atmosvars_getlocalmeshprgvar(domid, mesh, prgvars_list, auxvars_list, varid, var, dens_hyd, pres_hyd, lcmesh3d)
subroutine, public atmosvars_getlocalmeshqtrcvar(domid, mesh, trcvars_list, varid, var, lcmesh3d)
module FElib / Fluid dyn solver / Atmosphere / driver (3D nonhydrostatic model)
module FElib / Fluid dyn solver / Atmosphere / Nonhydrostatic model / Common
subroutine, public atm_dyn_dgm_nonhydro3d_common_setup_variables(prgvars, qtrcvars, auxvars, phytends, prgvar_manager, qtrcvar_manager, auxvar_manager, phytend_manager, reg_file_hist, do_setup_phytend, phytend_num_tot, mesh3d, prgvar_varinfo)
Setup variable managers for atmospheric nonhydrostatic dynamical core.
module FElib / Atmosphere / Physics cloud microphysics / common
subroutine, public atm_phy_mp_dgm_common_negative_fixer(qtrc, ddens, pres, cvtot, cptot, rtot, dens_hyd, pres_hyd, dt, lmesh, elem, qa, qla, qia, drhot)
module FElib / Element / Base
module FElib / Mesh / Local 2D
module FElib / Mesh / Local 3D
module FElib / Mesh / Local, Base
module FElib / Mesh / Base 2D
module FElib / Mesh / Base 3D
module FElib / Mesh / Base
module FElib / Data / base
FElib / model framework / variable manager.
Derived type to manage a computational mesh (base class)
Base type for preprocessing operations for variables before evaluating physics tendencies.
Derived type to represent quasi-global filtering operation for variables before evaluating physics te...
Derived type to represent modal filtering operation for variables before evaluating physics tendencie...
Derived type to represent no preprocessing operation for variables before evaluating physics tendenci...
Derived type to manage a set of variables (prognostic variables, tracer variables,...
Derived type to provide a driver of dynamical core with the atmospheric nonhydrostatic equations.
Derived type representing a 2D reference element.
Derived type representing a 3D reference element.
Derived type representing an arbitrary finite element.
Derived type representing a local mesh for 2D domain.
Derived type to manage a local 3D computational domain.
Derived type to manage a local computational domain (base type)
Derived type representing a field with local mesh (base type)
Derived type to manage a computational mesh (base type for 2D domain)
Derived type to manage a computational mesh (base type for 3D domain)
Base type to manage a computational mesh.
Derived type representing a field with 2D mesh.
Derived type representing a field with 3D mesh.
Derived type representing a field (base type)