FE-Project
Loading...
Searching...
No Matches
mod_atmos_phy_mp.F90
Go to the documentation of this file.
1!-------------------------------------------------------------------------------
2!> module Atmosphere / Physics / cloud microphysics
3!!
4!! @par Description
5!! Module for cloud microphysics
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_prc
19 use scale_io
20 use scale_prof
21 use scale_const, only: &
22 undef8 => const_undef8
23 use scale_tracer, only: qa
24
25 use scale_sparsemat, only: sparsemat
28
29 use scale_mesh_base, only: meshbase
32
38
39 use scale_meshfield_base, only: &
41 use scale_localmeshfield_base, only: &
43
44 use scale_model_mesh_manager, only: modelmeshbase
47
49
53
54 use mod_atmos_vars_container, only: &
56
57 !-----------------------------------------------------------------------------
58 implicit none
59 private
60 !-----------------------------------------------------------------------------
61 !
62 !++ Public type & procedure
63 !
64
65 !> Derived type to manage a component of cloud microphysics
66 !!
67 type, extends(modelcomponentproc), public :: atmosphymp
68 integer :: mp_typeid !< Type id of cloud microphysics scheme
69 type(atmosphympvars) :: vars !< Object to manage variables with cloud microphysics
70
71 integer :: atm_var_container_typeid !< Type ID of variable container for cloud microphysics
72
73 logical, private :: do_precipitation !< Apply sedimentation (precipitation)?
74 logical, private :: do_negative_fixer !< Apply negative fixer?
75 ! real(RP), private :: limit_negative !< Abort if abs(fixed negative value) > abs(MP_limit_negative)
76 integer, private :: ntmax_sedimentation !< Number of time step for sedimentation
77 real(rp), private :: max_term_vel !< Terminal velocity for calculate dt of sedimentation
78 real(rp), private :: cldfrac_threshold !< Threshold for cloud fraction
79
80 real(dp), private :: dtsec !< Timestep with cloud microphysics component
81 integer, private :: nstep_sedimentation !< Number of substep for sedimentation
82 real(rp), private :: rnstep_sedimentation !< Reciprocal of nstep_sedimentation
83 real(dp), private :: dtsec_sedimentation !< Timestep for sedimentation
84
85 type(sparsemat) :: dz !< Object to manage a sparse matrix for vertical derivative for sedimentation
86 type(sparsemat) :: lift !< Object to manage a sparse matrix for lifting for sedimentation
87 type(hexahedralelement) :: elem !< Object to manage a hexahedral element for sedimentation
88 type(lineelement) :: elem_v1d !< Object to manage a 1D element for sedimentation
89
90 type(atmosvarscontainer), pointer :: primary_atmvars_container !< Pointer to the primary atmospheric variable container
91
92 logical :: gfilter_flag !< Flag whether the post quasi-global filter is applied or not
93 type(meshfieldfilteroperation3d) :: gfilter_phy_mp !< Filter for cloud microphysics variables
94
95 logical :: modalfilter_flag !< Flag whether the post modal filter is applied or not
96 type(modalfilter) :: modalfilter_h2d !< Modal filter in horizontal direction
97 type(modalfilter) :: modalfilter_3d !< Modal filter in 3D
98
99 logical :: postfilteronlyapplyrhoh !< Flag whether the post filter is applied only to RHOH or not
100
101 logical :: cp_flag
102 class(meshfieldbase), pointer :: ptr_cp_rhot_t
103
104 contains
105 procedure, public :: setup => atmosphymp_setup
106 procedure, public :: calc_tendency => atmosphymp_calc_tendency
107 procedure, public :: update => atmosphymp_update
108 procedure, public :: finalize => atmosphymp_finalize
109 procedure, public :: set_primary_atmvars_container => atmosphymp_set_primary_atmvars_container
110 procedure, public :: set_cp_tends_manager => atmosphymp_set_cp_tends_manager
111 procedure, private :: calc_tendency_core => atmosphymp_calc_tendency_core
112!-
113 procedure, private :: create_postfilter => atmosphymp_create_postfilter
114 end type atmosphymp
115
116 !-----------------------------------------------------------------------------
117 !++ Public parameters & variables
118 !
119 !-----------------------------------------------------------------------------
120 !
121 !++ Private procedure
122 !
123 !-----------------------------------------------------------------------------
124 !
125 !++ Private parameters & variables
126 !
127 integer, parameter :: mp_typeid_kessler = 1 !< Type ID of a 3-class 1 moment bulk scheme (Kessler, 1969)
128 integer, parameter :: mp_typeid_tomita08 = 2 !< Type ID of a 6-class 1 moment bulk scheme (Tomita, 2008)
129 integer, parameter :: mp_typeid_sn14 = 3 !< Type ID of a 6-class 2 moment bulk scheme (Seiki and Nakajima, 2014)
130 integer, parameter :: mp_typeid_lscond = 4 !< Type ID of a large-scale condensation scheme
131
132 logical :: flag_lt = .false. ! Tentative
133
134contains
135
136!> Setup a component of cloud microphysics
137!!
138!! @param model_mesh Object to manage computational mesh of atmospheric model
139!! @param tm_parent_comp Object to mange a temporal scheme in a parent component
140!!
141 subroutine atmosphymp_setup( this, model_mesh, tm_parent_comp )
142 use scale_const, only: &
143 eps => const_eps
144 use scale_tracer, only: &
145 tracer_regist
146 use scale_atmos_hydrometeor, only: &
147 atmos_hydrometeor_regist
148 use scale_atmos_phy_mp_kessler, only: &
149 atmos_phy_mp_kessler_setup, &
150 atmos_phy_mp_kessler_ntracers, &
151 atmos_phy_mp_kessler_nwaters, &
152 atmos_phy_mp_kessler_nices, &
153 atmos_phy_mp_kessler_tracer_names, &
154 atmos_phy_mp_kessler_tracer_descriptions, &
155 atmos_phy_mp_kessler_tracer_units
156 use scale_atmos_phy_mp_tomita08, only: &
157 atmos_phy_mp_tomita08_setup, &
158 atmos_phy_mp_tomita08_ntracers, &
159 atmos_phy_mp_tomita08_nwaters, &
160 atmos_phy_mp_tomita08_nices, &
161 atmos_phy_mp_tomita08_tracer_names, &
162 atmos_phy_mp_tomita08_tracer_descriptions, &
163 atmos_phy_mp_tomita08_tracer_units
164 use scale_atmos_phy_mp_sn14, only: &
165 atmos_phy_mp_sn14_setup, &
166 atmos_phy_mp_sn14_ntracers, &
167 atmos_phy_mp_sn14_nwaters, &
168 atmos_phy_mp_sn14_nices, &
169 atmos_phy_mp_sn14_tracer_names, &
170 atmos_phy_mp_sn14_tracer_descriptions, &
171 atmos_phy_mp_sn14_tracer_units
172 use scale_atm_phy_mp_lscond, only: &
180 !------------------------------
182 use mod_atmos_mesh, only: atmosmesh
185
186 implicit none
187 class(atmosphymp), intent(inout) :: this
188 class(modelmeshbase), target, intent(in) :: model_mesh
189 class(time_manager_component), intent(inout) :: tm_parent_comp
190
191 real(dp) :: time_dt = undef8 !< Timestep for cloud microphysics
192 character(len=H_SHORT) :: time_dt_unit = 'SEC' !< Unit of timestep
193
194 character(len=H_MID) :: mp_type = 'KESSLER' !< Type of a cloud microphysics scheme
195
196 logical :: do_precipitation !< Flag whether sedimentation (precipitation) is applied
197 logical :: do_negative_fixer !< Flag whether negative fixer is applied
198 ! real(RP) :: limit_negative
199 integer :: ntmax_sedimentation !< Number of time step for sedimentation
200 real(rp) :: max_term_vel !< Maximum terminal velocity of sedimentation
201 real(rp) :: cldfrac_threshold
202
203 integer :: atm_var_container_typeid !< ID of variable container for cloud microphysics
204 character(len=H_SHORT) :: postglfilter_type = 'None'
205 character(len=H_SHORT) :: postglfilter_convfiltershape = 'GAUSSIAN'
206 integer :: postglfilter_nnodeh1d_reconst = -1
207 real(rp) :: postglfilter_gaussinwidthfac = 1.5_rp
208 real(rp) :: postmodalfilter_alpha_h = 0.0_rp
209 real(rp) :: postmodalfilter_etac_h = 0.0_rp
210 integer :: postmodalfilter_order_h = 16
211 real(rp) :: postmodalfilter_alpha_v = 0.0_rp
212 integer :: postmodalfilter_order_v = 16
213 logical :: postfilteronlyapplyrhoh = .false.
214
215 namelist /param_atmos_phy_mp/ &
216 time_dt, &
217 time_dt_unit, &
218 mp_type, &
219 do_precipitation, &
220 do_negative_fixer, &
221 ! limit_negative, &
222 ntmax_sedimentation, &
223 max_term_vel, &
224 cldfrac_threshold, &
225 atm_var_container_typeid, &
226 postglfilter_type, &
227 postglfilter_nnodeh1d_reconst, &
228 postglfilter_gaussinwidthfac, &
229 postmodalfilter_alpha_h, &
230 postmodalfilter_etac_h, &
231 postmodalfilter_order_h, &
232 postmodalfilter_alpha_v, &
233 postmodalfilter_order_v, &
234 postfilteronlyapplyrhoh
235
236 integer :: ierr
237
238 class(atmosmesh), pointer :: atm_mesh
239 class(meshbase), pointer :: ptr_mesh
240 class(localmesh3d), pointer :: lcmesh3d
241 class(elementbase3d), pointer :: elem3d
242
243 integer :: qs_mp, qe_mp, qa_mp
244
245 integer :: nstep_max
246
247 integer :: postfilteredtendnum
248 type(quadrilateralelement) :: elemh2d
249 !--------------------------------------------------
250
251 if (.not. this%IsActivated()) return
252
253 log_newline
254 log_info("ATMOS_PHY_MP_setup",*) 'Setup'
255
256 cldfrac_threshold = eps
257
258 do_precipitation = .true.
259 do_negative_fixer = .true.
260! limit_negative = 0.1_RP
261 ntmax_sedimentation = 1
262 max_term_vel = 10.0_rp
263
264 atm_var_container_typeid = atm_vars_container_primary_id
265
266 !--- read namelist
267 rewind(io_fid_conf)
268 read(io_fid_conf,nml=param_atmos_phy_mp,iostat=ierr)
269 if( ierr < 0 ) then !--- missing
270 log_info("ATMOS_PHY_MP_setup",*) 'Not found namelist. Default used.'
271 elseif( ierr > 0 ) then !--- fatal error
272 log_error("ATMOS_PHY_MP_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_PHY_MP. Check!'
273 call prc_abort
274 endif
275 log_nml(param_atmos_phy_mp)
276
277 this%cldfrac_threshold = cldfrac_threshold
278 this%do_precipitation = do_precipitation
279 this%do_negative_fixer = do_negative_fixer
280 this%ntmax_sedimentation = ntmax_sedimentation
281 this%max_term_vel = max_term_vel
282 ! this%limit_negative = limit_negative
283
284 this%atm_var_container_typeid = atm_var_container_typeid
285
286 log_newline
287 log_info("ATMOS_PHY_MP_setup",*) 'Enable negative fixer? : ', this%do_negative_fixer
288 ! LOG_INFO("ATMOS_PHY_MP_setup",*) 'Value limit of negative fixer (abs) : ', abs(this%limit_negative)
289 log_info("ATMOS_PHY_MP_setup",*) 'Enable sedimentation (precipitation)? : ', this%do_precipitation
290
291 !- Get atmospheric mesh --------------------------------------------------
292
293 call model_mesh%GetModelMesh( ptr_mesh )
294 select type(model_mesh)
295 class is (atmosmesh)
296 atm_mesh => model_mesh
297 end select
298
299 !--- Register this component in the time manager
300
301 call tm_parent_comp%Regist_process( 'ATMOS_PHY_MP', time_dt, time_dt_unit, & ! (in)
302 this%tm_process_id ) ! (out)
303
304 this%dtsec = tm_parent_comp%process_list(this%tm_process_id)%dtsec
305 nstep_max = 0 ! ceiling( this%dtsec * this%max_term_vel / maxval( CDZ) )
306 this%ntmax_sedimentation = max( ntmax_sedimentation, nstep_max )
307
308 this%nstep_sedimentation = ntmax_sedimentation
309 this%rnstep_sedimentation = 1.0_rp / real(ntmax_sedimentation,kind=rp)
310 this%dtsec_sedimentation = this%dtsec * this%rnstep_sedimentation
311
312 log_newline
313 log_info("ATMOS_PHY_MP_setup",*) 'Enable negative fixer? : ', this%do_negative_fixer
314 !LOG_INFO("ATMOS_PHY_MP_setup",*) 'Value limit of negative fixer (abs) : ', abs(MP_limit_negative)
315 log_info("ATMOS_PHY_MP_setup",*) 'Enable sedimentation (precipitation)? : ', this%do_precipitation
316 log_info("ATMOS_PHY_MP_setup",*) 'Timestep of sedimentation is divided into : ', this%ntmax_sedimentation, 'step'
317 log_info("ATMOS_PHY_MP_setup",*) 'DT of sedimentation : ', this%dtsec_sedimentation, '[s]'
318
319 !--- Set the type of microphysics scheme
320
321 select case( mp_type )
322 case ('KESSLER')
323 this%MP_TYPEID = mp_typeid_kessler
324 call atmos_hydrometeor_regist( &
325 atmos_phy_mp_kessler_nwaters, & ! (in)
326 atmos_phy_mp_kessler_nices, & ! (in)
327 atmos_phy_mp_kessler_tracer_names(:), & ! (in)
328 atmos_phy_mp_kessler_tracer_descriptions(:), & ! (in)
329 atmos_phy_mp_kessler_tracer_units(:), & ! (in)
330 qs_mp ) ! (out)
331 qa_mp = atmos_phy_mp_kessler_ntracers
332 case ( 'TOMITA08' )
333 this%MP_TYPEID = mp_typeid_tomita08
334 call atmos_hydrometeor_regist( &
335 atmos_phy_mp_tomita08_nwaters, & ! (in)
336 atmos_phy_mp_tomita08_nices, & ! (in)
337 atmos_phy_mp_tomita08_tracer_names(:), & ! (in)
338 atmos_phy_mp_tomita08_tracer_descriptions(:), & ! (in)
339 atmos_phy_mp_tomita08_tracer_units(:), & ! (in)
340 qs_mp ) ! (out)
341 qa_mp = atmos_phy_mp_tomita08_ntracers
342 ! case( 'SN14' )
343 ! this%MP_TYPEID = MP_TYPEID_SN14
344 ! call ATMOS_HYDROMETEOR_regist( &
345 ! ATMOS_PHY_MP_SN14_nwaters, & ! (in)
346 ! ATMOS_PHY_MP_SN14_nices, & ! (in)
347 ! ATMOS_PHY_MP_SN14_tracer_names(1:6), & ! (in)
348 ! ATMOS_PHY_MP_SN14_tracer_descriptions(1:6), & ! (in)
349 ! ATMOS_PHY_MP_SN14_tracer_units(1:6), & ! (in)
350 ! QS_MP ) ! (out)
351
352 ! call TRACER_regist( QS2, & ! (out)
353 ! 5, & ! (in)
354 ! ATMOS_PHY_MP_SN14_tracer_names(7:11), & ! (in)
355 ! ATMOS_PHY_MP_SN14_tracer_descriptions(7:11), & ! (in)
356 ! ATMOS_PHY_MP_SN14_tracer_units(7:11) ) ! (in)
357 ! QA_MP = ATMOS_PHY_MP_SN14_ntracers
358 case ( 'LSCOND' )
359 this%MP_TYPEID = mp_typeid_lscond
360 call atmos_hydrometeor_regist( &
366 qs_mp ) ! (out)
368 case default
369 log_error("ATMOS_PHY_MP_setup",*) 'Not appropriate names of MP_TYPE in namelist PARAM_ATMOS_PHY_MP. Check!'
370 call prc_abort
371 end select
372
373 qe_mp = qs_mp + qa_mp - 1
374
375 !- Initialize the variables
376 call this%vars%Init( model_mesh, qs_mp, qe_mp, qa_mp )
377
378 !- Setup a module for cloud microphysics
379
380 lcmesh3d => atm_mesh%ptr_mesh%lcmesh_list(1)
381 elem3d => lcmesh3d%refElem3D
382
383 select case( this%MP_TYPEID )
384 case( mp_typeid_kessler )
385 call atmos_phy_mp_kessler_setup()
386 case( mp_typeid_tomita08 )
387 call atmos_phy_mp_tomita08_setup( &
388 elem3d%Nnode_v*lcmesh3d%NeZ, 1, elem3d%Nnode_v*lcmesh3d%NeZ, elem3d%Nnode_h1D**2, 1, elem3d%Nnode_h1D**2, lcmesh3d%Ne2D, 1, lcmesh3d%Ne2D, &
389 flag_lt )
390 case( mp_typeid_sn14 )
391 case( mp_typeid_lscond )
393 end select
394
395 !- Initialize objects for precipitation processes
396
397 call this%elem%Init( elem3d%PolyOrder_h, elem3d%PolyOrder_v, .true. )
398 call this%Dz%Init( this%elem%Dx3, storage_format='ELL' )
399 call this%Lift%Init( this%elem%Lift, storage_format='ELL' )
400
401 call this%elem_v1D%Init( elem3d%PolyOrder_v, .false. )
402
403
404 !-
405 select case( trim(postglfilter_type) )
406 case ('ConvolFilter', 'Reconstruction', 'Reconstruction2')
407 this%gFilter_flag = .true.
408 case ('None', 'ModalFilter')
409 this%gFilter_flag = .false.
410 case default
411 log_info("ATMOS_PHY_MP_setup",*) 'Not appropriate names of PostGLFilter_Type in namelist PARAM_ATMOS_PHY_MP. Check!'
412 call prc_abort
413 end select
414
415 !- Setup filtering for cloud microphysics variables
416
417 this%PostFilterOnlyApplyRHOH = postfilteronlyapplyrhoh
418 if ( this%PostFilterOnlyApplyRHOH ) then
419 postfilteredtendnum = 1
420 else
421 postfilteredtendnum = this%vars%TENDS_NUM_TOT
422 end if
423 if ( this%gFilter_flag ) then
424 call this%gFilter_phy_mp%Init( postglfilter_type, &
425 postglfilter_convfiltershape, postglfilter_gaussinwidthfac, &
426 postglfilter_nnodeh1d_reconst, &
427 postfilteredtendnum, 0, 0, atm_mesh%ptr_mesh )
428 end if
429
430 if ( postmodalfilter_alpha_h > 0.0_rp .or. postmodalfilter_alpha_v > 0.0_rp ) then
431 this%modalFilter_flag = .true.
432 call elemh2d%Init( elem3d%PolyOrder_h, .true. )
433 call this%modalfilter_h2D%Init( elemh2d, postmodalfilter_etac_h, postmodalfilter_alpha_h, postmodalfilter_order_h )
434 call this%modalfilter_3D%Init( this%elem, postmodalfilter_etac_h, postmodalfilter_alpha_h, postmodalfilter_order_h, 0.0_rp, postmodalfilter_alpha_v, postmodalfilter_order_v )
435 call elemh2d%Final()
436 else
437 this%modalFilter_flag = .false.
438 end if
439
440 !
441 this%CP_flag = .false.
442 this%ptr_CP_RHOT_t => null()
443
444 return
445 end subroutine atmosphymp_setup
446
447 !> Set a pointer to the primary atmospheric variable container
448 !!
449 subroutine atmosphymp_set_primary_atmvars_container( this, primary_atmvars_container )
450 implicit none
451 class(atmosphymp), intent(inout) :: this
452 type(atmosvarscontainer), intent(in), target :: primary_atmvars_container
453 !--------------------------------------------------
454
455 this%primary_atmvars_container => primary_atmvars_container
456 return
457 end subroutine atmosphymp_set_primary_atmvars_container
458
459 subroutine atmosphymp_set_cp_tends_manager( this, CP_tends_manager )
460 use mod_atmos_phy_cp_vars, only: &
461 cp_rhot_t_id => atmos_phy_cp_rhot_t_id
462 implicit none
463 class(atmosphymp), intent(inout) :: this
464 class(modelvarmanager), intent(inout) :: cp_tends_manager
465 !--------------------------------------------------
466
467 this%CP_flag = .true.
468 call cp_tends_manager%Get( cp_rhot_t_id, this%ptr_CP_RHOT_t )
469 return
470 end subroutine atmosphymp_set_cp_tends_manager
471
472!> Calculate tendencies associated with cloud microphysics
473!!
474!!
475!! @param model_mesh Object to manage computational mesh of atmospheric model
476!! @param prgvars_list Object to manage prognostic variables with atmospheric dynamical core
477!! @param trcvars_list Object to manage auxiliary variables
478!! @param forcing_list Object to manage forcing terms
479!! @param is_update Flag to speicfy whether the tendencies are updated in this call
480!!
481!OCL SERIAL
482 subroutine atmosphymp_calc_tendency( &
483 this, model_mesh, prgvars_list, trcvars_list, &
484 auxvars_list, forcing_list, is_update )
485
486 use mod_atmos_vars, only: &
491 use mod_atmos_phy_mp_vars, only: &
495 implicit none
496
497 class(atmosphymp), intent(inout) :: this
498 class(modelmeshbase), intent(in) :: model_mesh
499 class(modelvarmanager), intent(inout) :: prgvars_list
500 class(modelvarmanager), intent(inout) :: trcvars_list
501 class(modelvarmanager), intent(inout) :: auxvars_list
502 class(modelvarmanager), intent(inout) :: forcing_list
503 logical, intent(in) :: is_update
504
505 class(meshbase), pointer :: mesh
506 class(localmesh3d), pointer :: lcmesh
507 class(localmesh2d), pointer :: lcmesh2d
508 class(elementbase3d), pointer :: refelem3d
509 class(elementbase2d), pointer :: refelem2d
510
511 class(localmeshfieldbase), pointer :: ddens, momx, momy, momz, drhot
512 class(localmeshfieldbase), pointer :: rtot, cvtot, cptot
513 class(localmeshfieldbase), pointer :: ddens_pri, momx_pri, momy_pri, momz_pri, drhot_pri
514 class(localmeshfieldbase), pointer :: rtot_pri, cvtot_pri, cptot_pri
515 type(localmeshfieldbaselist) :: qtrc(this%vars%qs:this%vars%qe)
516 type(localmeshfieldbaselist) :: qtrc_pri(this%vars%qs:this%vars%qe)
517 class(localmeshfieldbase), pointer :: dens_hyd, pres_hyd
518 class(localmeshfieldbase), pointer :: dens_hyd_pri, pres_hyd_pri
519 class(localmeshfieldbase), pointer :: pres, pt
520 class(localmeshfieldbase), pointer :: pres_pri, pt_pri
521 class(localmeshfieldbase), pointer :: dens_tp, momx_tp, momy_tp, momz_tp, rhot_tp, rhoh_p
522 type(localmeshfieldbaselist) :: rhoq_tp(qa)
523 class(localmeshfieldbase), pointer :: mp_dens_t, mp_momx_t, mp_momy_t, mp_momz_t, mp_rhot_t, mp_rhoh, mp_evap
524 type(localmeshfieldbaselist) :: mp_rhoq_t(this%vars%qs:this%vars%qe)
525 class(localmeshfieldbase), pointer :: sflx_rain, sflx_snow, sflx_engi
526
527 class(localmeshfieldbase), pointer :: cp_rhot_t
528 logical, allocatable :: cp_mask(:,:)
529
530 integer :: n
531 integer :: ke
532 integer :: iq
533
534 real(rp), allocatable :: filtermat(:,:)
535 real(rp), allocatable :: filtermat2d(:,:)
536 !--------------------------------------------------
537
538 if (.not. this%IsActivated()) return
539
540 log_progress(*) 'atmosphere / physics / cloud microphysics'
541
542 call model_mesh%GetModelMesh( mesh )
543
544 if (is_update) then
545
546 do n=1, mesh%LOCAL_MESH_NUM
547 call prof_rapstart('ATM_PHY_MP_get_localmesh_ptr', 2)
548
549 !- Get pointers to the fields in the variable container for cloud microphysics
551 mesh, prgvars_list, auxvars_list, &
552 ddens, momx, momy, momz, drhot, &
553 dens_hyd, pres_hyd, rtot, cvtot, cptot, &
554 lcmesh )
555
557 mesh, trcvars_list, this%vars%QS, qtrc(:) )
558
560 mesh, auxvars_list, &
561 pres, pt )
562
563 !- Get pointers to the fields in the primary variable container
564
566 mesh, this%primary_atmvars_container%PROGVARS_manager, this%primary_atmvars_container%AUXVARS_manager, &
567 ddens_pri, momx_pri, momy_pri, momz_pri, drhot_pri, &
568 dens_hyd_pri, pres_hyd_pri, rtot_pri, cvtot_pri, cptot_pri, &
569 lcmesh )
570
572 mesh, this%primary_atmvars_container%QTRCVARS_manager, this%vars%QS, qtrc_pri(:) )
573
575 mesh, this%primary_atmvars_container%AUXVARS_manager, &
576 pres_pri, pt_pri )
577
578 !- Get pointers to the tendency fields in the variable container for cloud microphysics
579
581 mesh, forcing_list, &
582 dens_tp, momx_tp, momy_tp, momz_tp, rhot_tp, &
583 rhoh_p, rhoq_tp )
584
586 mesh, this%vars%tends_manager, &
587 mp_dens_t, mp_momx_t, mp_momy_t, mp_momz_t, mp_rhot_t, mp_rhoh, mp_evap, &
588 mp_rhoq_t )
589
591 mesh, this%vars%auxvars2D_manager, &
592 sflx_rain, sflx_snow, sflx_engi )
593
594 !-
595 allocate( cp_mask(lcmesh%refElem3D%Np,lcmesh%Ne) )
596 if ( this%CP_flag ) then
597 call this%ptr_CP_RHOT_t%GetLocalMeshField( n, cp_rhot_t )
598 where ( abs(cp_rhot_t%val(:,lcmesh%NeS:lcmesh%NeE)) > 1.0e-12_rp )
599 cp_mask(:,:) = .true.
600 elsewhere
601 cp_mask(:,:) = .false.
602 end where
603 end if
604 call prof_rapend('ATM_PHY_MP_get_localmesh_ptr', 2)
605
606 !- Calculate tendencies associated with cloud microphysics
607
608 call prof_rapstart('ATM_PHY_MP_cal_tend', 2)
609 call this%calc_tendency_core( &
610 mp_dens_t%val, mp_momx_t%val, mp_momy_t%val, mp_momz_t%val, mp_rhoq_t, & ! (out)
611 mp_rhoh%val, mp_evap%val, sflx_rain%val, sflx_snow%val, sflx_engi%val, & ! (out)
612 ddens%val, ddens_pri%val, momx_pri%val, momy_pri%val, momz_pri%val, pt%val, qtrc, qtrc_pri, & ! (in)
613 pres%val, pres_pri%val, pres_hyd%val, dens_hyd%val, & ! (in)
614 rtot%val, rtot_pri%val, cvtot%val, cvtot_pri%val, cptot%val, cptot_pri%val, & ! (in)
615 cp_mask, & ! (in)
616 model_mesh%DOptrMat(3), model_mesh%LiftOptrMat, & ! (in)
617 lcmesh, lcmesh%refElem3D, lcmesh%lcmesh2D, lcmesh%lcmesh2D%refElem2D, this%elem_v1D ) ! (in)
618 call prof_rapend('ATM_PHY_MP_cal_tend', 2)
619
620 deallocate( cp_mask )
621 end do
622
623 if ( this%gFilter_flag ) then
624 if ( this%PostFilterOnlyApplyRHOH ) then
625 call this%gFilter_phy_mp%Apply( this%vars%tends(atmos_phy_mp_rhoh_id:atmos_phy_mp_rhoh_id), this%vars%tends(1)%mesh )
626 else
627 call this%gFilter_phy_mp%Apply( this%vars%tends, this%vars%tends(1)%mesh )
628 ! call this%gFilter2D_phy_mp%Apply( this%vars%auxvars2D(1:1), this%vars%auxvars2D(1)%mesh )
629 end if
630 end if
631
632 if ( this%modalFilter_flag ) then
633 do n=1, mesh%LOCAL_MESH_NUM
635 mesh, this%vars%tends_manager, &
636 mp_dens_t, mp_momx_t, mp_momy_t, mp_momz_t, mp_rhot_t, mp_rhoh, mp_evap, &
637 mp_rhoq_t, lcmesh )
638
639 lcmesh2d => lcmesh%lcmesh2D
640 refelem3d => lcmesh%refElem3D
641 refelem2d => lcmesh2d%refElem2D
642
643 allocate( filtermat(refelem3d%Np,refelem3d%Np) )
644 allocate( filtermat2d(refelem2d%Np,refelem2d%Np) )
645
646 !$omp parallel private(ke, iq, FilterMat, FilterMat2D)
647 !$omp do
648 do ke=lcmesh%NeS, lcmesh%NeE
649 call this%create_PostFilter( filtermat, & ! (out)
650 this%modalfilter_3D%FilterMat, lcmesh%Gsqrt(:,ke), refelem3d%Np ) ! (in)
651
652 if ( .not. this%PostFilterOnlyApplyRHOH ) then
653 mp_dens_t%val(:,ke) = matmul( filtermat, mp_dens_t%val(:,ke) )
654 mp_momx_t%val(:,ke) = matmul( filtermat, mp_momx_t%val(:,ke) )
655 mp_momy_t%val(:,ke) = matmul( filtermat, mp_momy_t%val(:,ke) )
656 mp_momz_t%val(:,ke) = matmul( filtermat, mp_momz_t%val(:,ke) )
657
658 do iq=this%vars%QS, this%vars%QE
659 mp_rhoq_t(iq)%ptr%val(:,ke) = matmul( filtermat, mp_rhoq_t(iq)%ptr%val(:,ke) )
660 end do
661 end if
662
663 mp_rhoh %val(:,ke) = matmul( filtermat, mp_rhoh %val(:,ke) )
664 end do
665 if ( .not. this%PostFilterOnlyApplyRHOH ) then
666 !$omp do
667 do ke=lcmesh2d%NeS, lcmesh2d%NeE
668 call this%create_PostFilter( filtermat2d, & ! (out)
669 this%modalfilter_h2D%FilterMat, lcmesh2d%Gsqrt(:,ke), refelem2d%Np ) ! (in)
670
671 this%vars%auxvars2D(1)%local(n)%val(:,ke) = matmul( filtermat2d, this%vars%auxvars2D(1)%local(n)%val(:,ke) )
672 end do
673 !$omp end do
674 end if
675 !$omp end parallel
676
677 deallocate( filtermat, filtermat2d )
678 end do
679 end if
680
681 end if
682
683 !- Add tendencies calculated in this component to the total tendencies
684
685 do n=1, mesh%LOCAL_MESH_NUM
687 mesh, forcing_list, &
688 dens_tp, momx_tp, momy_tp, momz_tp, rhot_tp, &
689 rhoh_p, rhoq_tp )
690
692 mesh, this%vars%tends_manager, &
693 mp_dens_t, mp_momx_t, mp_momy_t, mp_momz_t, mp_rhot_t, mp_rhoh, mp_evap, &
694 mp_rhoq_t, lcmesh )
695
696 !$omp parallel private(ke, iq)
697 !$omp do
698 do ke = lcmesh%NeS, lcmesh%NeE
699 dens_tp%val(:,ke) = dens_tp%val(:,ke) + mp_dens_t%val(:,ke)
700 momx_tp%val(:,ke) = momx_tp%val(:,ke) + mp_momx_t%val(:,ke)
701 momy_tp%val(:,ke) = momy_tp%val(:,ke) + mp_momy_t%val(:,ke)
702 momz_tp%val(:,ke) = momz_tp%val(:,ke) + mp_momz_t%val(:,ke)
703 rhoh_p %val(:,ke) = rhoh_p %val(:,ke) + mp_rhoh %val(:,ke)
704 end do
705 !$omp end do
706 !$omp do collapse(2)
707 do iq = this%vars%QS, this%vars%QE
708 do ke = lcmesh%NeS, lcmesh%NeE
709 rhoq_tp(iq)%ptr%val(:,ke) = rhoq_tp(iq)%ptr%val(:,ke) &
710 + mp_rhoq_t(iq)%ptr%val(:,ke)
711 end do
712 end do
713 !$omp end do
714 !$omp end parallel
715 end do
716
717 return
718 end subroutine atmosphymp_calc_tendency
719
720!> Update variables in a component of cloud microphysics
721!!
722!! @param model_mesh Object to manage computational mesh of atmospheric model
723!! @param prgvars_list Object to manage prognostic variables with atmospheric dynamical core
724!! @param trcvars_list Object to manage auxiliary variables
725!! @param forcing_list Object to manage forcing terms
726!! @param is_update Flag to speicfy whether the tendencies are updated in this call
727!!
728!OCL SERIAL
729 subroutine atmosphymp_update( this, model_mesh, &
730 prgvars_list, trcvars_list, &
731 auxvars_list, forcing_list, is_update )
732
733 implicit none
734 class(atmosphymp), intent(inout) :: this
735 class(modelmeshbase), intent(in) :: model_mesh
736 class(modelvarmanager), intent(inout) :: prgvars_list
737 class(modelvarmanager), intent(inout) :: trcvars_list
738 class(modelvarmanager), intent(inout) :: auxvars_list
739 class(modelvarmanager), intent(inout) :: forcing_list
740 logical, intent(in) :: is_update
741 !--------------------------------------------------
742 return
743 end subroutine atmosphymp_update
744
745!> Finalize a component of cloud microphysics
746!!
747!OCL SERIAL
748 subroutine atmosphymp_finalize( this )
749 implicit none
750 class(atmosphymp), intent(inout) :: this
751
752 !--------------------------------------------------
753 if (.not. this%IsActivated()) return
754
755 select case ( this%MP_TYPEID )
756 case( mp_typeid_kessler )
757 case( mp_typeid_tomita08 )
758 case( mp_typeid_sn14 )
759 case( mp_typeid_lscond )
760 end select
761
762 call this%vars%Final()
763
764 !- Finalize objects for precipitation processes
765 call this%elem%Final()
766 call this%Dz%Final(); call this%Lift%Final()
767 call this%elem_v1D%Final()
768
769 return
770 end subroutine atmosphymp_finalize
771
772!- private ------------------------------------------------
773
774 !> Calculate tendencies associated with cloud microphysics and precipitation for each local mesh
775!OCL SERIAL
776 subroutine atmosphymp_calc_tendency_core( this, &
777 DENS_t_MP, RHOU_t_MP, RHOV_t_MP, MOMZ_t_MP, RHOQ_t_MP, & ! (out)
778 rhoh_mp, evaporate, sflx_rain, sflx_snow, sflx_engi, & ! (out)
779 ddens, ddens_pri, rhou, rhov, momz, pt, qtrc, qtrc_pri, & ! (in)
780 pres, pres_pri, pres_hyd, dens_hyd, & ! (in)
781 rtot, rtot_pri, cvtot, cvtot_pri, cptot, cptot_pri, & ! (in)
782 cp_mask, & ! (in)
783 dz, lift, & ! (in)
784 lcmesh, elem3d, lcmesh2d, elem2d, elem_v1d ) ! (in)
785
786 use scale_const, only: &
787 pre00 => const_pre00
788 use scale_const, only: &
789 cvdry => const_cvdry, &
790 cpdry => const_cpdry
791 use scale_atmos_hydrometeor, only: &
792 lhf, &
793 qha, qla, qia
794 use scale_atmos_phy_mp_kessler, only: &
795 atmos_phy_mp_kessler_terminal_velocity
796 use scale_atmos_phy_mp_tomita08, only: &
797 atmos_phy_mp_tomita08_terminal_velocity
798 use scale_atmos_phy_mp_sn14, only: &
799 atmos_phy_mp_sn14_terminal_velocity
800
801 use scale_sparsemat, only: sparsemat
802
803 use scale_atm_phy_mp_dgm_common, only: &
807 use scale_atm_phy_mp_lscond, only: &
810 implicit none
811
812 class(atmosphymp), intent(inout) :: this
813 class(localmesh3d), intent(in) :: lcmesh
814 class(elementbase3d), intent(in) :: elem3d
815 class(localmesh2d), intent(in) :: lcmesh2d
816 class(elementbase2d), intent(in) :: elem2d
817 class(elementbase1d), intent(in) :: elem_v1d
818 real(rp), intent(out) :: dens_t_mp(elem3d%np,lcmesh%nea)
819 real(rp), intent(out) :: rhou_t_mp(elem3d%np,lcmesh%nea)
820 real(rp), intent(out) :: rhov_t_mp(elem3d%np,lcmesh%nea)
821 real(rp), intent(out) :: momz_t_mp(elem3d%np,lcmesh%nea)
822 type(localmeshfieldbaselist), intent(inout) :: rhoq_t_mp(this%vars%qs:this%vars%qe)
823 real(rp), intent(out) :: rhoh_mp(elem3d%np,lcmesh%nea)
824 real(rp), intent(out) :: evaporate(elem3d%np,lcmesh%nea)
825 real(rp), intent(out) :: sflx_rain(elem2d%np,lcmesh2d%nea)
826 real(rp), intent(out) :: sflx_snow(elem2d%np,lcmesh2d%nea)
827 real(rp), intent(out) :: sflx_engi(elem2d%np,lcmesh2d%nea)
828 real(rp), intent(in) :: ddens(elem3d%np,lcmesh%nea)
829 real(rp), intent(in) :: ddens_pri(elem3d%np,lcmesh%nea)
830 real(rp), intent(in) :: rhou(elem3d%np,lcmesh%nea)
831 real(rp), intent(in) :: rhov(elem3d%np,lcmesh%nea)
832 real(rp), intent(in) :: momz(elem3d%np,lcmesh%nea)
833 real(rp), intent(in) :: pt (elem3d%np,lcmesh%nea)
834 type(localmeshfieldbaselist), intent(in) :: qtrc(this%vars%qs:this%vars%qe)
835 type(localmeshfieldbaselist), intent(in) :: qtrc_pri(this%vars%qs:this%vars%qe)
836 real(rp), intent(in) :: pres(elem3d%np,lcmesh%nea)
837 real(rp), intent(in) :: pres_pri(elem3d%np,lcmesh%nea)
838 real(rp), intent(in) :: pres_hyd(elem3d%np,lcmesh%nea)
839 real(rp), intent(in) :: dens_hyd(elem3d%np,lcmesh%nea)
840 real(rp), intent(in) :: rtot (elem3d%np,lcmesh%nea)
841 real(rp), intent(in) :: rtot_pri(elem3d%np,lcmesh%nea)
842 real(rp), intent(in) :: cvtot(elem3d%np,lcmesh%nea)
843 real(rp), intent(in) :: cvtot_pri(elem3d%np,lcmesh%nea)
844 real(rp), intent(in) :: cptot(elem3d%np,lcmesh%nea)
845 real(rp), intent(in) :: cptot_pri(elem3d%np,lcmesh%nea)
846 logical, intent(in) :: cp_mask(elem3d%np,lcmesh%ne)
847 class(sparsemat), intent(in) :: dz
848 class(sparsemat), intent(in) :: lift
849
850 real(rp) :: dens (elem3d%np,lcmesh%nea)
851 real(rp) :: dens_pri(elem3d%np,lcmesh%nea)
852
853 real(rp) :: rhoe_t(elem3d%np,lcmesh%nea)
854
855 real(rp) :: cptot_t(elem3d%np,lcmesh%nea)
856 real(rp) :: cvtot_t(elem3d%np,lcmesh%nea)
857
858 real(rp) :: vterm(elem3d%np,lcmesh%nez,lcmesh%ne2d,this%vars%qs+1:this%vars%qe)
859
860 real(rp) :: dens0_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d)
861 real(rp) :: dens2_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d)
862 real(rp) :: rhou2_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d)
863 real(rp) :: rhov2_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d)
864 real(rp) :: momz2_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d)
865 real(rp) :: temp2_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d)
866 real(rp) :: cptot2_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d)
867 real(rp) :: cvtot2_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d)
868 real(rp) :: rhoe_pri (elem3d%np,lcmesh%nez,lcmesh%ne2d)
869 real(rp) :: rhoe2_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d)
870
871 real(rp) :: rhoq_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d,this%vars%qs+1:this%vars%qe)
872 real(rp) :: rhoq2(elem3d%np,lcmesh%nez,lcmesh%ne2d,this%vars%qs+1:this%vars%qe)
873 real(rp) :: rhoq2_pri(elem3d%np,lcmesh%nez,lcmesh%ne2d,this%vars%qs+1:this%vars%qe)
874
875 real(rp) :: rhoq2_tmp(elem3d%nnode_v,lcmesh%nez,this%vars%qs+1:this%vars%qe)
876 real(rp) :: dens2_tmp(elem3d%nnode_v,lcmesh%nez)
877 real(rp) :: temp2_tmp(elem3d%nnode_v,lcmesh%nez)
878 real(rp) :: pres2_tmp(elem3d%nnode_v,lcmesh%nez)
879 real(rp) :: ref_dens_tmp(elem3d%nnode_v,lcmesh%nez)
880 real(rp) :: vterm_tmp(elem3d%nnode_v,lcmesh%nez,this%vars%qs+1:this%vars%qe)
881
882 real(rp) :: flx_hydro(elem3d%np,lcmesh%nez,lcmesh%ne2d)
883 real(rp) :: cp_t(elem3d%np), cv_t(elem3d%np)
884
885 integer :: iq
886 integer :: domid
887 integer :: ke
888 integer :: ke2d, ke_z
889 integer :: p2d
890 integer :: colmask(elem3d%nnode_v)
891
892 integer :: step
893 real(rp) :: rdt_mp
894
895 integer :: vmapm(elem3d%nfptot,lcmesh%nez)
896 integer :: vmapp(elem3d%nfptot,lcmesh%nez)
897 real(rp) :: intweight(elem3d%nfaces,elem3d%nfptot)
898 real(rp) :: nz(elem3d%nfptot,lcmesh%nez,lcmesh%ne2d)
899
900 logical :: lscond_flag
901 !----------------------------------------------
902
903 rdt_mp = 1.0_rp / this%dtsec
904 domid = lcmesh%lcdomID
905
906 call lcmesh%GetVmapZ1D( vmapm, vmapp ) ! (out)
907
908 call atm_phy_mp_dgm_common_gen_intweight( intweight, & ! (out)
909 lcmesh ) ! (in)
910
911 !$omp parallel do private(ke)
912 do ke = lcmesh%NeS, lcmesh%NeE
913 dens(:,ke) = dens_hyd(:,ke) + ddens(:,ke)
914 dens_pri(:,ke) = dens_hyd(:,ke) + ddens_pri(:,ke)
915 end do
916
917
918 lscond_flag = .false.
919
920 !- Calculate tendencies of cloud microphysics processes ----------------------
921
922 select case( this%MP_TYPEID )
923 case( mp_typeid_kessler )
924 call calc_tendency_kessler( this, &
925 rhoq_t_mp, cptot_t, cvtot_t, rhoe_t, evaporate, & ! (out)
926 dens, qtrc, pres, dens_hyd, rtot, cvtot, cptot, & ! (in)
927 dens_pri, qtrc_pri, & ! (in)
928 rdt_mp, lcmesh, elem3d ) ! (in)
929
930 case( mp_typeid_tomita08 )
931 call calc_tendency_tomita08( this, &
932 rhoq_t_mp, cptot_t, cvtot_t, rhoe_t, evaporate, & ! (out)
933 dens, qtrc, pres, dens_hyd, rtot, cvtot, cptot, & ! (in)
934 rdt_mp, lcmesh, elem3d ) ! (in)
935
936 case( mp_typeid_sn14 )
937 call calc_tendency_sn14( this, &
938 rhoq_t_mp, cptot_t, cvtot_t, rhoe_t, evaporate, & ! (out)
939 dens, qtrc, pres, dens_hyd, rtot, cvtot, cptot, & ! (in)
940 rdt_mp, lcmesh, elem3d ) ! (in)
941
942 case( mp_typeid_lscond )
943 call calc_tendency_lscond( this, &
944 rhoq_t_mp, cptot_t, cvtot_t, rhoe_t, evaporate, & ! (out)
945 dens, qtrc, pres, dens_hyd, rtot, cvtot, cptot, & ! (in)
946 cp_mask, & ! (in)
947 rdt_mp, lcmesh, elem3d ) ! (in)
948
949 lscond_flag = .true.
950 end select
951
952 !$omp parallel do
953 do ke = lcmesh%NeS, lcmesh%NeE
954 rhoh_mp(:,ke) = rhoe_t(:,ke) &
955 - ( cptot_t(:,ke) + log( pres_pri(:,ke) / pre00 ) * ( cvtot_pri(:,ke) / cptot_pri(:,ke) * cptot_t(:,ke) - cvtot_t(:,ke) ) ) &
956 * pres_pri(:,ke) / rtot_pri(:,ke)
957 end do
958
959 !- Calculate precipitation processes if enabled ----------------------
960
961 if ( this%do_precipitation ) then
962
963 !$omp parallel private(ke,ke2D,ke_z,iq)
964 !$omp do collapse(2)
965 do ke2d = 1, lcmesh%Ne2D
966 do ke_z = 1, lcmesh%NeZ
967 ke = ke2d + (ke_z-1)*lcmesh%Ne2D
968
969 dens0_pri(:,ke_z,ke2d) = dens_hyd(:,ke) + ddens_pri(:,ke)
970 dens2_pri(:,ke_z,ke2d) = dens_hyd(:,ke) + ddens_pri(:,ke)
971
972 rhou2_pri(:,ke_z,ke2d) = rhou(:,ke)
973 rhov2_pri(:,ke_z,ke2d) = rhov(:,ke)
974 momz2_pri(:,ke_z,ke2d) = momz(:,ke)
975
976 temp2_pri(:,ke_z,ke2d) = pres_pri(:,ke) / ( dens0_pri(:,ke_z,ke2d) * rtot_pri(:,ke) )
977 cptot2_pri(:,ke_z,ke2d) = cptot_pri(:,ke)
978 cvtot2_pri(:,ke_z,ke2d) = cvtot_pri(:,ke)
979 rhoe_pri(:,ke_z,ke2d) = temp2_pri(:,ke_z,ke2d) * cvtot_pri(:,ke) * dens0_pri(:,ke_z,ke2d)
980 rhoe2_pri(:,ke_z,ke2d) = rhoe_pri(:,ke_z,ke2d)
981
982 nz(:,ke_z,ke2d) = lcmesh%normal_fn(:,ke,3)
983 flx_hydro(:,ke_z,ke2d) = 0.0_rp
984 end do
985 end do
986 !$omp end do
987 !$omp do collapse(3)
988 do iq = this%vars%QS+1, this%vars%QE
989 do ke2d = 1, lcmesh%Ne2D
990 do ke_z = 1, lcmesh%NeZ
991 ke = ke2d + (ke_z-1)*lcmesh%Ne2D
992 rhoq2(:,ke_z,ke2d,iq) = dens(:,ke) * qtrc(iq)%ptr%val(:,ke) &
993 + rhoq_t_mp(iq)%ptr%val(:,ke) * this%dtsec
994 rhoq_pri(:,ke_z,ke2d,iq) = dens0_pri(:,ke_z,ke2d) * qtrc_pri(iq)%ptr%val(:,ke) &
995 + rhoq_t_mp(iq)%ptr%val(:,ke) * this%dtsec
996 rhoq2_pri(:,ke_z,ke2d,iq) = rhoq_pri(:,ke_z,ke2d,iq)
997 end do
998 end do
999 end do
1000 !$omp end do
1001 !$omp workshare
1002 sflx_rain(:,:) = 0.0_rp
1003 sflx_snow(:,:) = 0.0_rp
1004 sflx_engi(:,:) = 0.0_rp
1005 !$omp end workshare
1006 !$omp end parallel
1007
1008 !- Calculate terminal velocity which is diagnosed using coarse-grained MP variables
1009
1010 do ke2d = 1, lcmesh%Ne2D
1011 !$omp parallel do private( &
1012 !$omp p2D, ke_z, iq, ColMask, &
1013 !$omp DENS2_tmp, REF_DENS_tmp, RHOQ2_tmp, TEMP2_tmp, PRES2_tmp, &
1014 !$omp vterm_tmp )
1015 do p2d = 1, elem3d%Nnode_h1D**2
1016 colmask(:) = elem3d%Colmask(:,p2d)
1017 do ke_z = 1, lcmesh%NeZ
1018 ke = ke2d + (ke_z-1)*lcmesh%Ne2D
1019
1020 dens2_tmp(:,ke_z) = dens(colmask(:),ke)
1021 ref_dens_tmp(:,ke_z) = dens_hyd(colmask(:),ke)
1022 pres2_tmp(:,ke_z) = pres(colmask(:),ke)
1023
1024 temp2_tmp(:,ke_z) = pres2_tmp(:,ke_z) / ( dens2_tmp(:,ke_z) * rtot(colmask(:),ke) )
1025 end do
1026 do iq = this%vars%QS+1, this%vars%QE
1027 do ke_z = 1, lcmesh%NeZ
1028! RHOQ2_tmp(:,ke_z,iq) = RHOQ2_pri(ColMask(:),ke_z,ke2D,iq)
1029 rhoq2_tmp(:,ke_z,iq) = rhoq2(colmask(:),ke_z,ke2d,iq)
1030 end do
1031 end do
1032
1033 select case( this%MP_TYPEID )
1034 case( mp_typeid_kessler )
1035 call atmos_phy_mp_kessler_terminal_velocity( &
1036 elem3d%Nnode_v*lcmesh%NeZ, 1, elem3d%Nnode_v*lcmesh%NeZ, & ! (in)
1037 dens2_tmp(:,:), rhoq2_tmp(:,:,:), ref_dens_tmp(:,:), & ! (in)
1038 vterm_tmp(:,:,:) ) ! (out)
1039 case( mp_typeid_tomita08 )
1040 call atmos_phy_mp_tomita08_terminal_velocity( &
1041 elem3d%Nnode_v*lcmesh%NeZ, 1, elem3d%Nnode_v*lcmesh%NeZ, & ! (in)
1042 dens2_tmp(:,:), temp2_tmp(:,:), rhoq2_tmp(:,:,:), & ! (in)
1043 vterm_tmp(:,:,:) ) ! (out)
1044 case( mp_typeid_sn14 )
1045 call atmos_phy_mp_sn14_terminal_velocity( &
1046 elem3d%Nnode_v*lcmesh%NeZ, 1, elem3d%Nnode_v*lcmesh%NeZ, & ! (in)
1047 dens2_tmp(:,:), temp2_tmp(:,:), rhoq2_tmp(:,:,:), pres2_tmp(:,:), & ! (in)
1048 vterm_tmp(:,:,:) ) ! (out)
1049 end select
1050
1051 do iq = this%vars%QS+1, this%vars%QE
1052 do ke_z = 1, lcmesh%NeZ
1053 vterm(colmask(:),ke_z,ke2d,iq) = vterm_tmp(:,ke_z,iq)
1054 end do
1055 end do
1056 end do
1057 end do
1058
1059 do iq = this%vars%QS+1, this%vars%QE
1060 if ( this%vars%vterm_hist_id(iq) > 0 ) then
1061 !$omp parallel do collapse(2) private(ke2D, ke_z, ke)
1062 do ke2d = 1, lcmesh%Ne2D
1063 do ke_z = 1, lcmesh%NeZ
1064 ke = ke2d + (ke_z-1)*lcmesh%Ne2D
1065 this%vars%vterm_hist(iq)%local(domid)%val(:,ke) = vterm(:,ke_z,ke2d,iq)
1066 end do
1067 end do
1068 end if
1069 end do
1070
1071
1072 !- Sedimentation of hydrometers
1073
1074 do step = 1, this%nstep_sedimentation
1075
1076 if ( lscond_flag ) then
1078 dens2_pri, rhoq2_pri, cptot2_pri, cvtot2_pri, rhoe2_pri, & ! (inout)
1079 sflx_rain, sflx_snow, sflx_engi, & ! (inout)
1080 temp2_pri, this%dtsec_sedimentation, & ! (in)
1081 this%vars%QE - this%vars%QS, qla, qia, & ! (in)
1082 lcmesh, elem3d, elem_v1d ) ! (in)
1083 else
1085 dens2_pri, rhoq2_pri, cptot2_pri, cvtot2_pri, rhoe2_pri, & ! (inout)
1086 flx_hydro, sflx_rain, sflx_snow, sflx_engi, & ! (inout)
1087 temp2_pri, vterm, & ! (in)
1088 this%dtsec_sedimentation, this%rnstep_sedimentation, & ! (in)
1089 this%Dz, this%Lift, nz, vmapm, vmapp, intweight, & ! (in)
1090 this%vars%QE - this%vars%QS, qla, qia, & ! (in)
1091 lcmesh, elem3d ) ! (in)
1092 end if
1093
1094 !$omp parallel do private(ke2D, ke_z, ke) collapse(2)
1095 do ke2d = 1, lcmesh%Ne2D
1096 do ke_z = 1, lcmesh%NeZ
1097 ke = ke2d + (ke_z-1)*lcmesh%Ne2D
1098 temp2_pri(:,ke_z,ke2d) = rhoe2_pri(:,ke_z,ke2d) / ( dens2_pri(:,ke_z,ke2d) * cvtot2_pri(:,ke_z,ke2d) )
1099 end do
1100 end do
1101
1102 end do ! end loop for step
1103
1104 !$omp parallel private(ke2D, ke_z, iq, ke, CP_t, CV_t)
1105 !$omp workshare
1106 sflx_engi(:,:) = sflx_engi(:,:) - sflx_snow(:,:) * lhf ! moist internal energy
1107 !$omp end workshare
1108 !$omp do collapse(2)
1109 do ke2d = 1, lcmesh%Ne2D
1110 do ke_z = 1, lcmesh%NeZ
1111 ke = ke2d + (ke_z-1)*lcmesh%Ne2D
1112 dens_t_mp(:,ke) = ( dens2_pri(:,ke_z,ke2d) - dens0_pri(:,ke_z,ke2d) ) * rdt_mp
1113
1114 cp_t(:) = ( cptot2_pri(:,ke_z,ke2d) - cptot_pri(:,ke) ) * rdt_mp
1115 cv_t(:) = ( cvtot2_pri(:,ke_z,ke2d) - cvtot_pri(:,ke) ) * rdt_mp
1116 rhoh_mp(:,ke) = rhoh_mp(:,ke) &
1117 + ( rhoe2_pri(:,ke_z,ke2d) - rhoe_pri(:,ke_z,ke2d) ) * rdt_mp &
1118 - ( cp_t(:) &
1119 + log( pres_pri(:,ke) / pre00 ) * ( cvtot_pri(:,ke) / cptot_pri(:,ke) * cp_t(:) - cv_t(:) ) &
1120 ) * pres_pri(:,ke) / rtot_pri(:,ke)
1121 end do
1122 end do
1123 !$omp end do
1124 !$omp do collapse(2)
1125 do iq = this%vars%QS+1, this%vars%QE
1126 do ke2d = 1, lcmesh%Ne2D
1127 do ke_z = 1, lcmesh%NeZ
1128 ke = ke2d + (ke_z-1)*lcmesh%Ne2D
1129 rhoq_t_mp(iq)%ptr%val(:,ke) = rhoq_t_mp(iq)%ptr%val(:,ke) &
1130 + ( rhoq2_pri(:,ke_z,ke2d,iq) - rhoq_pri(:,ke_z,ke2d,iq) ) * rdt_mp
1131 end do
1132 end do
1133 end do
1134 !$omp end do
1135 !$omp end parallel
1136
1137 !- Sedimentation of momentum
1138
1139 if ( lscond_flag ) then
1141 rhou_t_mp, rhov_t_mp, momz_t_mp, & ! (out)
1142 dens0_pri, rhou2_pri, rhov2_pri, momz2_pri, dens2_pri, & ! (in)
1143 rdt_mp, lcmesh, elem3d ) ! (in)
1144 else
1146 rhou_t_mp, rhov_t_mp, momz_t_mp, & ! (out)
1147 dens0_pri, rhou2_pri, rhov2_pri, momz2_pri, flx_hydro, & ! (in)
1148 this%Dz, this%Lift, nz, vmapm, vmapp, & ! (in)
1149 lcmesh, elem3d ) ! (in)
1150 end if
1151 end if ! end if do_precipitation
1152
1153 return
1154 end subroutine atmosphymp_calc_tendency_core
1155
1156 !> Calculate tendencies of cloud microphysics processes with Kessler scheme
1157 !!
1158!OCL SERIAL
1159 subroutine calc_tendency_kessler( this, &
1160 RHOQ_t_MP, CPtot_t, CVtot_t, RHOE_t, EVAPORATE, & ! (out)
1161 dens, qtrc, pres, dens_hyd, rtot, cvtot, cptot, & ! (in)
1162 dens_pri, qtrc_pri, & ! (in)
1163 rdt_mp, lcmesh, elem3d ) ! (in)
1164
1165 use scale_atmos_hydrometeor, only: &
1166 lhv
1167 use scale_atmos_phy_mp_kessler, only: &
1168 atmos_phy_mp_kessler_adjustment
1169 implicit none
1170
1171 class(atmosphymp), intent(in) :: this
1172 class(localmesh3d), intent(in) :: lcmesh
1173 class(elementbase3d), intent(in) :: elem3d
1174 type(localmeshfieldbaselist), intent(inout) :: rhoq_t_mp(this%vars%qs:this%vars%qe)
1175 real(rp), intent(out) :: cptot_t(elem3d%np,lcmesh%nea)
1176 real(rp), intent(out) :: cvtot_t(elem3d%np,lcmesh%nea)
1177 real(rp), intent(out) :: rhoe_t(elem3d%np,lcmesh%nea)
1178 real(rp), intent(out) :: evaporate(elem3d%np,lcmesh%nea)
1179 real(rp), intent(in) :: dens(elem3d%np,lcmesh%nea)
1180 type(localmeshfieldbaselist), intent(in) :: qtrc(this%vars%qs:this%vars%qe)
1181 real(rp), intent(in) :: pres(elem3d%np,lcmesh%nea)
1182 real(rp), intent(in) :: dens_hyd(elem3d%np,lcmesh%nea)
1183 real(rp), intent(in) :: rtot (elem3d%np,lcmesh%nea)
1184 real(rp), intent(in) :: cvtot(elem3d%np,lcmesh%nea)
1185 real(rp), intent(in) :: cptot(elem3d%np,lcmesh%nea)
1186 type(localmeshfieldbaselist), intent(in) :: qtrc_pri(this%vars%qs:this%vars%qe)
1187 real(rp), intent(in) :: dens_pri(elem3d%np,lcmesh%nea)
1188 real(rp), intent(in) :: rdt_mp
1189
1190 real(rp) :: temp1(elem3d%np,lcmesh%nea)
1191 real(rp) :: cptot1(elem3d%np,lcmesh%nea)
1192 real(rp) :: cvtot1(elem3d%np,lcmesh%nea)
1193 real(rp) :: qtrc1(elem3d%np,lcmesh%nea,this%vars%qs:this%vars%qe)
1194
1195 integer :: ke
1196 integer :: iq
1197
1198 real(rp) :: rhoq_t(elem3d%np)
1199 real(rp) :: rhoq_pri(elem3d%np)
1200 real(rp) :: rhoq_t_cor(elem3d%np)
1201 real(rp) :: rhoqv_t(elem3d%np,lcmesh%ne)
1202 !------------------------------------------------------------
1203
1204 !$omp parallel private(ke, iq)
1205 !$omp do
1206 do ke = lcmesh%NeS, lcmesh%NeE
1207 temp1(:,ke) = pres(:,ke) / ( dens(:,ke) * rtot(:,ke) )
1208 cptot1(:,ke) = cptot(:,ke)
1209 cvtot1(:,ke) = cvtot(:,ke)
1210
1211 rhoqv_t(:,ke) = 0.0_rp
1212 end do
1213 !$omp end do
1214 !$omp do collapse(2)
1215 do iq = this%vars%QS, this%vars%QE
1216 do ke = lcmesh%NeS, lcmesh%NeE
1217 qtrc1(:,ke,iq) = qtrc(iq)%ptr%val(:,ke)
1218 end do
1219 end do
1220 !$omp end do
1221 !$omp end parallel
1222
1223 call atmos_phy_mp_kessler_adjustment( &
1224 elem3d%Np, 1, elem3d%Np, lcmesh%NeA, lcmesh%NeS, lcmesh%NeE, 1, 1, 1, & ! (in)
1225 dens, pres, this%dtsec, & ! (in)
1226 temp1, qtrc1, cptot1, cvtot1, & ! (inout)
1227 rhoe_t, evaporate ) ! (out)
1228
1229 !$omp parallel private(ke, iq, RHOQ_t, RHOQ_t_cor, RHOQ_pri)
1230 !$omp do collapse(2)
1231 do ke = lcmesh%NeS, lcmesh%NeE
1232 do iq = this%vars%QS+1, this%vars%QE
1233 rhoq_t(:) = ( qtrc1(:,ke,iq) - qtrc(iq)%ptr%val(:,ke) ) * dens(:,ke) * rdt_mp
1234
1235 rhoq_pri(:) = dens_pri(:,ke) * qtrc_pri(iq)%ptr%val(:,ke)
1236 rhoq_t_cor(:) = max( rhoq_t(:), - rhoq_pri(:) * rdt_mp )
1237
1238 rhoqv_t(:,ke) = rhoqv_t(:,ke) - rhoq_t_cor(:)
1239 rhoe_t(:,ke) = rhoe_t(:,ke) + lhv * ( rhoq_t_cor(:) - rhoq_t(:) )
1240 rhoq_t_mp(iq)%ptr%val(:,ke) = rhoq_t_cor(:)
1241 end do
1242 end do
1243 !$omp end do
1244 !$omp do
1245 do ke = lcmesh%NeS, lcmesh%NeE
1246 rhoq_t_mp(this%vars%QS)%ptr%val(:,ke) = rhoqv_t(:,ke)
1247
1248 cptot_t(:,ke) = ( cptot1(:,ke) - cptot(:,ke) ) * rdt_mp
1249 cvtot_t(:,ke) = ( cvtot1(:,ke) - cvtot(:,ke) ) * rdt_mp
1250 end do
1251 !$omp end do
1252 !$omp end parallel
1253 return
1254 end subroutine calc_tendency_kessler
1255
1256 !> Calculate tendencies of cloud microphysics processes with Tomita (2008)
1257 !!
1258!OCL SERIAL
1259 subroutine calc_tendency_tomita08( this, &
1260 RHOQ_t_MP, CPtot_t, CVtot_t, RHOE_t, EVAPORATE, & ! (out)
1261 dens, qtrc, pres, dens_hyd, rtot, cvtot, cptot, & ! (in)
1262 rdt_mp, lcmesh, elem3d ) ! (in)
1263
1264 use scale_const, only: &
1265 undef => const_undef
1266 use scale_atmos_phy_mp_tomita08, only: &
1267 atmos_phy_mp_tomita08_adjustment
1268 implicit none
1269
1270 class(atmosphymp), intent(in) :: this
1271 class(localmesh3d), intent(in) :: lcmesh
1272 class(elementbase3d), intent(in) :: elem3d
1273 type(localmeshfieldbaselist), intent(inout) :: rhoq_t_mp(this%vars%qs:this%vars%qe)
1274 real(rp), intent(out) :: cptot_t(elem3d%np,lcmesh%nea)
1275 real(rp), intent(out) :: cvtot_t(elem3d%np,lcmesh%nea)
1276 real(rp), intent(out) :: rhoe_t(elem3d%np,lcmesh%nea)
1277 real(rp), intent(out) :: evaporate(elem3d%np,lcmesh%nea)
1278 real(rp), intent(in) :: dens(elem3d%np,lcmesh%nea)
1279 type(localmeshfieldbaselist), intent(in) :: qtrc(this%vars%qs:this%vars%qe)
1280 real(rp), intent(in) :: pres(elem3d%np,lcmesh%nea)
1281 real(rp), intent(in) :: dens_hyd(elem3d%np,lcmesh%nea)
1282 real(rp), intent(in) :: rtot (elem3d%np,lcmesh%nea)
1283 real(rp), intent(in) :: cvtot(elem3d%np,lcmesh%nea)
1284 real(rp), intent(in) :: cptot(elem3d%np,lcmesh%nea)
1285 real(rp), intent(in) :: rdt_mp
1286
1287 real(rp) :: dens_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1288 real(rp) :: pres_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1289 real(rp) :: ccn_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1290 real(rp) :: temp1_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1291 real(rp) :: cptot1_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1292 real(rp) :: cvtot1_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1293 real(rp) :: qtrc1_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d,this%vars%qs:this%vars%qe)
1294 real(rp) :: rhoe_t_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1295 real(rp) :: evaporate_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1296
1297 integer :: ke, ke_xy, ke_z
1298 integer :: p,p_xy, p_z
1299 integer :: iq
1300 !------------------------------------------------------------
1301
1302 !$omp parallel do collapse(2) private(p_z,p_xy,iq, ke,p)
1303 do ke_z=1, lcmesh%NeZ
1304 do ke_xy=1, lcmesh%Ne2D
1305 ke = ke_xy + (ke_z-1)*lcmesh%Ne2D
1306 do p_z=1, elem3d%Nnode_v
1307 do p_xy=1, elem3d%Nnode_h1D**2
1308 p = p_xy + (p_z-1)*elem3d%Nnode_h1D**2
1309 dens_z(p_z,ke_z,p_xy,ke_xy) = dens(p,ke)
1310 pres_z(p_z,ke_z,p_xy,ke_xy) = pres(p,ke)
1311 temp1_z(p_z,ke_z,p_xy,ke_xy) = pres(p,ke) / ( dens(p,ke) * rtot(p,ke) )
1312 cptot1_z(p_z,ke_z,p_xy,ke_xy) = cptot(p,ke)
1313 cvtot1_z(p_z,ke_z,p_xy,ke_xy) = cvtot(p,ke)
1314
1315 ccn_z(p_z,ke_z,p_xy,ke_xy) = undef
1316 end do
1317 end do
1318 do iq = this%vars%QS, this%vars%QE
1319 do p_z=1, elem3d%Nnode_v
1320 do p_xy=1, elem3d%Nnode_h1D**2
1321 p = p_xy + (p_z-1)*elem3d%Nnode_h1D**2
1322 qtrc1_z(p_z,ke_z,p_xy,ke_xy,iq) = qtrc(iq)%ptr%val(p,ke)
1323 end do
1324 end do
1325 end do
1326 end do
1327 end do
1328
1329 call atmos_phy_mp_tomita08_adjustment( &
1330 elem3d%Nnode_v*lcmesh%NeZ, 1, elem3d%Nnode_v*lcmesh%NeZ, elem3d%Nnode_h1D**2, 1, elem3d%Nnode_h1D**2, lcmesh%Ne2D, 1, lcmesh%Ne2D, & ! (in)
1331 dens_z, pres_z, ccn_z, this%dtsec, & ! (in)
1332 temp1_z, qtrc1_z, cptot1_z, cvtot1_z, & ! (inout)
1333 rhoe_t_z, evaporate_z ) ! (out)
1334
1335 !$omp parallel do collapse(2) private(p_z,p_xy,iq, ke,p)
1336 do ke_z=1, lcmesh%NeZ
1337 do ke_xy=1, lcmesh%Ne2D
1338 ke = ke_xy + (ke_z-1)*lcmesh%Ne2D
1339 do p_z=1, elem3d%Nnode_v
1340 do p_xy=1, elem3d%Nnode_h1D**2
1341 p = p_xy + (p_z-1)*elem3d%Nnode_h1D**2
1342 cptot_t(p,ke) = ( cptot1_z(p_z,ke_z,p_xy,ke_xy) - cptot(p,ke) ) * rdt_mp
1343 cvtot_t(p,ke) = ( cvtot1_z(p_z,ke_z,p_xy,ke_xy) - cvtot(p,ke) ) * rdt_mp
1344 rhoe_t(p,ke) = rhoe_t_z(p_z,ke_z,p_xy,ke_xy)
1345 evaporate(p,ke) = evaporate_z(p_z,ke_z,p_xy,ke_xy)
1346 end do
1347 end do
1348 do iq = this%vars%QS, this%vars%QE
1349 do p_z=1, elem3d%Nnode_v
1350 do p_xy=1, elem3d%Nnode_h1D**2
1351 p = p_xy + (p_z-1)*elem3d%Nnode_h1D**2
1352 rhoq_t_mp(iq)%ptr%val(p,ke) = ( qtrc1_z(p_z,ke_z,p_xy,ke_xy,iq) - qtrc(iq)%ptr%val(p,ke) ) * dens(p,ke) * rdt_mp
1353 end do
1354 end do
1355 end do
1356 end do
1357 end do
1358
1359 return
1360 end subroutine calc_tendency_tomita08
1361
1362 !> Calculate tendencies of cloud microphysics processes with Seiki and Nakajima (2014)
1363 !!
1364!OCL SERIAL
1365 subroutine calc_tendency_sn14( this, &
1366 RHOQ_t_MP, CPtot_t, CVtot_t, RHOE_t, EVAPORATE, & ! (out)
1367 dens, qtrc, pres, dens_hyd, rtot, cvtot, cptot, & ! (in)
1368 rdt_mp, lcmesh, elem3d ) ! (in)
1369
1370 use scale_const, only: &
1371 undef => const_undef
1372 use scale_atmos_phy_mp_sn14, only: &
1373 atmos_phy_mp_sn14_tendency
1374 implicit none
1375
1376 class(atmosphymp), intent(in) :: this
1377 class(localmesh3d), intent(in) :: lcmesh
1378 class(elementbase3d), intent(in) :: elem3d
1379 type(localmeshfieldbaselist), intent(inout) :: rhoq_t_mp(this%vars%qs:this%vars%qe)
1380 real(rp), intent(out) :: cptot_t(elem3d%np,lcmesh%nea)
1381 real(rp), intent(out) :: cvtot_t(elem3d%np,lcmesh%nea)
1382 real(rp), intent(out) :: rhoe_t(elem3d%np,lcmesh%nea)
1383 real(rp), intent(out) :: evaporate(elem3d%np,lcmesh%nea)
1384 real(rp), intent(in) :: dens(elem3d%np,lcmesh%nea)
1385 type(localmeshfieldbaselist), intent(in) :: qtrc(this%vars%qs:this%vars%qe)
1386 real(rp), intent(in) :: pres(elem3d%np,lcmesh%nea)
1387 real(rp), intent(in) :: dens_hyd(elem3d%np,lcmesh%nea)
1388 real(rp), intent(in) :: rtot (elem3d%np,lcmesh%nea)
1389 real(rp), intent(in) :: cvtot(elem3d%np,lcmesh%nea)
1390 real(rp), intent(in) :: cptot(elem3d%np,lcmesh%nea)
1391 real(rp), intent(in) :: rdt_mp
1392
1393 real(rp) :: dens_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1394 real(rp) :: pres_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1395 real(rp) :: ccn_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1396 real(rp) :: temp1_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1397 real(rp) :: cptot1_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1398 real(rp) :: cvtot1_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1399 real(rp) :: qtrc1_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d,this%vars%qs:this%vars%qe)
1400 real(rp) :: rhoq_t_mp_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d,this%vars%qs:this%vars%qe)
1401 real(rp) :: rhoe_t_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1402 real(rp) :: evaporate_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1403 real(rp) :: cptot_t_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1404 real(rp) :: cvtot_t_z(elem3d%nnode_v,lcmesh%nez,elem3d%nnode_h1d**2,lcmesh%ne2d)
1405
1406 integer :: ke, ke_xy, ke_z
1407 integer :: p,p_xy, p_z
1408 integer :: iq
1409 !------------------------------------------------------------
1410
1411 !$omp parallel do collapse(2) private(p_z,p_xy,iq, ke,p)
1412 do ke_z=1, lcmesh%NeZ
1413 do ke_xy=1, lcmesh%Ne2D
1414 ke = ke_xy + (ke_z-1)*lcmesh%Ne2D
1415 do p_z=1, elem3d%Nnode_v
1416 do p_xy=1, elem3d%Nnode_h1D**2
1417 p = p_xy + (p_z-1)*elem3d%Nnode_h1D**2
1418 dens_z(p_z,ke_z,p_xy,ke_xy) = dens(p,ke)
1419 pres_z(p_z,ke_z,p_xy,ke_xy) = pres(p,ke)
1420 temp1_z(p_z,ke_z,p_xy,ke_xy) = pres(p,ke) / ( dens(p,ke) * rtot(p,ke) )
1421 cptot1_z(p_z,ke_z,p_xy,ke_xy) = cptot(p,ke)
1422 cvtot1_z(p_z,ke_z,p_xy,ke_xy) = cvtot(p,ke)
1423
1424 ccn_z(p_z,ke_z,p_xy,ke_xy) = undef
1425 end do
1426 end do
1427 do iq = this%vars%QS, this%vars%QE
1428 do p_z=1, elem3d%Nnode_v
1429 do p_xy=1, elem3d%Nnode_h1D**2
1430 p = p_xy + (p_z-1)*elem3d%Nnode_h1D**2
1431 qtrc1_z(p_z,ke_z,p_xy,ke_xy,iq) = qtrc(iq)%ptr%val(p,ke)
1432 end do
1433 end do
1434 end do
1435 end do
1436 end do
1437
1438 ! call ATMOS_PHY_MP_sn14_tendency( &
1439 ! elem3D%Nnode_v*lcmesh%NeZ, 1, elem3D%Nnode_v*lcmesh%NeZ, elem3D%Nnode_h1D**2, 1, elem3D%Nnode_h1D**2, lcmesh%Ne2D, 1, lcmesh%Ne2D, & ! (in)
1440 ! DENS_z, W_z, QTRC1_z, PRES_z, TEMP_z, Qdry_z, CPtot1_z, CVtot1_z, CCN_z, this%dtsec, REAL_CZ, REAL_FZ, & ! (in)
1441 ! RHOQ_t_MP_z, RHOE_t_z, CPtot_t_z, CVtot_t_z, EVAPORATE_z ) ! (out)
1442
1443
1444 !$omp parallel do collapse(2) private(p_z,p_xy,iq, ke,p)
1445 do ke_z=1, lcmesh%NeZ
1446 do ke_xy=1, lcmesh%Ne2D
1447 ke = ke_xy + (ke_z-1)*lcmesh%Ne2D
1448 do p_z=1, elem3d%Nnode_v
1449 do p_xy=1, elem3d%Nnode_h1D**2
1450 p = p_xy + (p_z-1)*elem3d%Nnode_h1D**2
1451 cptot_t(p,ke) = cptot_t_z(p_z,ke_z,p_xy,ke_xy)
1452 cvtot_t(p,ke) = cvtot_t_z(p_z,ke_z,p_xy,ke_xy)
1453 end do
1454 end do
1455 do iq = this%vars%QS, this%vars%QE
1456 do p_z=1, elem3d%Nnode_v
1457 do p_xy=1, elem3d%Nnode_h1D**2
1458 p = p_xy + (p_z-1)*elem3d%Nnode_h1D**2
1459 rhoq_t_mp(iq)%ptr%val(p,ke) = rhoq_t_mp_z(p_z,ke_z,p_xy,ke_xy,iq)
1460 end do
1461 end do
1462 end do
1463 end do
1464 end do
1465
1466 return
1467 end subroutine calc_tendency_sn14
1468
1469 !> Calculate tendencies of large-scale condensation processes
1470 !!
1471!OCL SERIAL
1472 subroutine calc_tendency_lscond( this, &
1473 RHOQ_t_MP, CPtot_t, CVtot_t, RHOE_t, EVAPORATE, & ! (out)
1474 dens, qtrc, pres, dens_hyd, rtot, cvtot, cptot, & ! (in)
1475 cp_mask, & ! (in)
1476 rdt_mp, lcmesh, elem3d ) ! (in)
1477
1478 use scale_atm_phy_mp_lscond, only: &
1480 implicit none
1481
1482 class(atmosphymp), intent(in) :: this
1483 class(localmesh3d), intent(in) :: lcmesh
1484 class(elementbase3d), intent(in) :: elem3d
1485 type(localmeshfieldbaselist), intent(inout) :: rhoq_t_mp(this%vars%qs:this%vars%qe)
1486 real(rp), intent(out) :: cptot_t(elem3d%np,lcmesh%nea)
1487 real(rp), intent(out) :: cvtot_t(elem3d%np,lcmesh%nea)
1488 real(rp), intent(out) :: rhoe_t(elem3d%np,lcmesh%nea)
1489 real(rp), intent(out) :: evaporate(elem3d%np,lcmesh%nea)
1490 real(rp), intent(in) :: dens(elem3d%np,lcmesh%nea)
1491 type(localmeshfieldbaselist), intent(in) :: qtrc(this%vars%qs:this%vars%qe)
1492 real(rp), intent(in) :: pres(elem3d%np,lcmesh%nea)
1493 real(rp), intent(in) :: dens_hyd(elem3d%np,lcmesh%nea)
1494 real(rp), intent(in) :: rtot (elem3d%np,lcmesh%nea)
1495 real(rp), intent(in) :: cvtot(elem3d%np,lcmesh%nea)
1496 real(rp), intent(in) :: cptot(elem3d%np,lcmesh%nea)
1497 logical, intent(in) :: cp_mask(elem3d%np,lcmesh%ne)
1498 real(rp), intent(in) :: rdt_mp
1499
1500 real(rp) :: temp1(elem3d%np,lcmesh%nea)
1501 real(rp) :: cptot1(elem3d%np,lcmesh%nea)
1502 real(rp) :: cvtot1(elem3d%np,lcmesh%nea)
1503 real(rp) :: dqc_cp(elem3d%np,lcmesh%nea)
1504 real(rp) :: qtrc1(elem3d%np,lcmesh%nea,this%vars%qs:this%vars%qe)
1505
1506 integer :: ke
1507 integer :: iq
1508
1509 real(rp) :: sw(elem3d%np,lcmesh%ne)
1510 !------------------------------------------------------------
1511
1512 !$omp parallel private(ke, iq)
1513 !$omp do
1514 do ke = lcmesh%NeS, lcmesh%NeE
1515 temp1(:,ke) = pres(:,ke) / ( dens(:,ke) * rtot(:,ke) )
1516 cptot1(:,ke) = cptot(:,ke)
1517 cvtot1(:,ke) = cvtot(:,ke)
1518
1519 sw(:,ke) = 1.0_rp
1520 end do
1521 if ( this%CP_flag ) then
1522 !$omp do
1523 do ke = lcmesh%NeS, lcmesh%NeE
1524 where (cp_mask(:,ke))
1525 sw(:,ke) = 0.0_rp
1526 end where
1527 end do
1528 end if
1529 !$omp do collapse(2)
1530 do iq = this%vars%QS, this%vars%QE
1531 do ke = lcmesh%NeS, lcmesh%NeE
1532 qtrc1(:,ke,iq) = qtrc(iq)%ptr%val(:,ke)
1533 end do
1534 end do
1535 !$omp end do
1536 !$omp end parallel
1537
1539 elem3d%Np, 1, elem3d%Np, lcmesh%NeA, lcmesh%NeS, lcmesh%NeE, 1, 1, 1, & ! (in)
1540 dens, pres, this%dtsec, & ! (in)
1541 temp1, qtrc1, cptot1, cvtot1, & ! (inout)
1542 rhoe_t, evaporate ) ! (out)
1543
1544 !$omp parallel private(ke, iq)
1545 !$omp do collapse(2)
1546 do iq = this%vars%QS, this%vars%QE
1547 do ke = lcmesh%NeS, lcmesh%NeE
1548 rhoq_t_mp(iq)%ptr%val(:,ke) = sw(:,ke) * ( qtrc1(:,ke,iq) - qtrc(iq)%ptr%val(:,ke) ) * dens(:,ke) * rdt_mp
1549 end do
1550 end do
1551 !$omp end do
1552 !$omp do
1553 do ke = lcmesh%NeS, lcmesh%NeE
1554 cptot_t(:,ke) = sw(:,ke) * ( cptot1(:,ke) - cptot(:,ke) ) * rdt_mp
1555 cvtot_t(:,ke) = sw(:,ke) * ( cvtot1(:,ke) - cvtot(:,ke) ) * rdt_mp
1556
1557 rhoe_t(:,ke) = sw(:,ke) * rhoe_t(:,ke)
1558 end do
1559 !$omp end do
1560 !$omp end parallel
1561
1562 return
1563 end subroutine calc_tendency_lscond
1564
1565!OCL SERIAL
1566 subroutine atmosphymp_create_postfilter( this, FilterMat, &
1567 MFilter, Gsqrt, Np )
1568 implicit none
1569 class(atmosphymp), intent(inout) :: this
1570 integer, intent(in) :: np
1571 real(rp), intent(out) :: filtermat(np,np)
1572 real(rp), intent(in) :: mfilter(np,np)
1573 real(rp), intent(in) :: gsqrt(np)
1574
1575 integer :: p
1576 !------------------------------------------------------------
1577
1578 filtermat(:,:) = mfilter(:,:)
1579 do p=1, np
1580 filtermat(:,p) = filtermat(:,p) * gsqrt(p)
1581 end do
1582 do p=1, np
1583 filtermat(p,:) = filtermat(p,:) / gsqrt(p)
1584 end do
1585 return
1586 end subroutine atmosphymp_create_postfilter
1587end module mod_atmos_phy_mp
module Atmosphere / Mesh
module Atmosphere / Physics / Cumulus Parameterization
integer, parameter, public atmos_phy_cp_rhot_t_id
module Atmosphere / Physics / Cloud Microphysics
subroutine, public atmosphympvars_getlocalmeshfields_tend(domid, mesh, mp_tends_list, mp_dens_t, mp_momx_t, mp_momy_t, mp_momz_t, mp_rhot_t, mp_rhoh, mp_evap, mp_rhoq_t, lcmesh3d)
subroutine, public atmosphympvars_getlocalmeshfields_sfcflx(domid, mesh, sfcflx_list, sflx_rain, sflx_snow, sflx_engi)
integer, parameter, public atmos_phy_mp_rhoh_id
module Atmosphere / Physics / cloud microphysics
integer, parameter mp_typeid_kessler
Type ID of a 3-class 1 moment bulk scheme (Kessler, 1969)
module Atmosphere / Variables
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 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)
subroutine, public atmosvars_getlocalmeshqtrcvarlist(domid, mesh, trcvars_list, varid_s, var_list, lcmesh3d)
module Atmosphere / Variables
module FElib / Atmosphere / Physics cloud microphysics / common
subroutine, public atm_phy_mp_dgm_common_gen_intweight(intweight, lcmesh)
subroutine, public atm_phy_mp_dgm_common_precipitation(dens, rhoq, cptot, cvtot, rhoe, flx_hydro, sflx_rain, sflx_snow, esflx, temp, vterm, dt, rnstep, dz, lift, nz, vmapm, vmapp, intweight, qha, qla, qia, lcmesh, elem)
subroutine, public atm_phy_mp_dgm_common_precipitation_momentum(momu_t, momv_t, momz_t, dens, momu, momv, momz, mflx, dz, lift, nz, vmapm, vmapp, lcmesh, elem)
module FElib / Atmosphere / Physics cloud microphysics / Large-scale condensation
subroutine, public atmos_phy_mp_lscond_adjustment(ka, ks, ke, ia, is, ie, ja, js, je, dens, pres, dt, temp, qtrc, cptot, cvtot, rhoe_t, evaporate)
Calculate a state after the saturation process.
integer, parameter, public atmos_phy_mp_lscond_ntracers
character(len=h_short), dimension(qa_mp), parameter, public atmos_phy_mp_lscond_tracer_units
character(len=h_mid), dimension(qa_mp), parameter, public atmos_phy_mp_lscond_tracer_descriptions
subroutine, public atmos_phy_mp_lscond_setup
Setup a module for a large-scale condensation scheme.
character(len=h_short), dimension(qa_mp), parameter, public atmos_phy_mp_lscond_tracer_names
subroutine, public atmos_phy_mp_lscond_precipitation(dens, rhoq, cptot, cvtot, rhoe, sflx_rain, sflx_snow, esflx, temp, dt, qha, qla, qia, lcmesh, elem, elem1d)
Calculate a state after the precipitation process.
integer, parameter, public atmos_phy_mp_lscond_nices
subroutine, public atmos_phy_mp_lscond_precipitation_momentum(momu_t, momv_t, momz_t, dens, momu, momv, momz, dens_new, rdt_mp, lcmesh, elem)
Calculate a tendency of momentum due to the precipitation process.
integer, parameter, public atmos_phy_mp_lscond_nwaters
module FElib / Element / Base
module FElib / Element / hexahedron
module FElib / Element / line
module FElib / Element/ ModalFilter
module FElib / Element / Quadrilateral
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 / physics process.
FElib / model framework / mesh manager.
FElib / model framework / variable manager.
Module common / sparsemat.
Module common / time.
Derived type to manage a computational mesh (base class)
Derived type to manage a component of cloud microphysics.
Derived type to manage variables with cloud microphysics component.
Derived type to manage a set of variables (prognostic variables, tracer variables,...
Derived type representing a 1D reference element.
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 hexahedral element.
Derived type representing a line element.
Derived type representing a modal filter.
Derived type representing a quadrilateral 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 3D mesh.
Derived type representing a field (base type)
Derived type to represent filter operation for 3D mesh field.
Derived type to manage a sparse matrix.