FE-Project
Loading...
Searching...
No Matches
mod_atmos_component.F90
Go to the documentation of this file.
1!-------------------------------------------------------------------------------
2!> module Atmosphere component
3!!
4!! @par Description
5!! Atmosphere component module
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_prof
20 use scale_prc
21
22 use scale_mesh_base, only: meshbase
27 use scale_localmeshfield_base, only: &
31
32 use mod_atmos_mesh, only: atmosmesh
35
36 use mod_atmos_vars, only: &
37 atmosvars, atmosvarscontainer, &
38 atm_vars_container_primary_id
39
40 use mod_atmos_dyn, only: atmosdyn
48
49 !-----------------------------------------------------------------------------
50 implicit none
51 private
52 !-----------------------------------------------------------------------------
53 !
54 !++ Public type & procedure
55 !
56
57 !> Derived type to manage atmospheric component
58 type, extends(modelcomponent), public :: atmoscomponent
59 type(atmosvars) :: vars !< Object to mange variables with atmospheric component
60
61 character(len=H_SHORT) :: mesh_type !< Type name of mesh atmospheric component
62 class(atmosmesh), pointer :: mesh !< Pointer of mesh atmospheric component
63 type(atmosmeshrm) :: mesh_rm !< Object to manage mesh for the case of regional mode
64 type(atmosmeshgm) :: mesh_gm !< Object to manage mesh for the case of global mode
65
66 type(atmosdyn) :: dyn_proc !< Object to manage dynamical process
67 type(atmosphysfc) :: phy_sfc_proc !< Object to manage surface process
68 type(atmosphytb ) :: phy_tb_proc !< Object to manage sub-grid scale turbulence process
69 type(atmosphymp ) :: phy_mp_proc !< Object to manage cloud microphysics process
70 type(atmosphyrd ) :: phy_rd_proc !< Object to manage radiation process
71 type(atmosphycp ) :: phy_cp_proc !< Object to manage cumulus parameterization process
72 type(atmosphybl ) :: phy_bl_proc !< Object to manage PBL turbulence parameterization process
73
74 type(couplercomponent), pointer :: coupler_ptr !< Pointer of coupler component
75 contains
76 procedure, public :: setup => atmos_setup
77 procedure, public :: setup_vars => atmos_setup_vars
78 procedure, public :: set_coupler => atmos_set_coupler
79 procedure, public :: calc_tendency => atmos_calc_tendency
80 procedure, public :: calc_tendency_from_sflux => atmos_calc_tendency_from_sflux
81 procedure, public :: update => atmos_update
82 procedure, public :: set_surface => atmos_set_surface
83 procedure, public :: get_surface => atmos_get_surface
84 procedure, public :: finalize => atmos_finalize
85 end type atmoscomponent
86
87 !-----------------------------------------------------------------------------
88 !
89 !++ Public parameters & variables
90 !
91 !-----------------------------------------------------------------------------
92 !
93 !++ Private procedure
94 !
95 !-----------------------------------------------------------------------------
96 !
97 !++ Private parameters & variables
98 !
99 !-----------------------------------------------------------------------------
100contains
101
102 !> Setup an object to mange atmospheric component
103!OCL SERIAL
104 subroutine atmos_setup( this )
105 use scale_const, only: &
106 undef8 => const_undef8
107
108 use scale_atmos_hydrometeor, only: &
109 atmos_hydrometeor_dry, &
110 atmos_hydrometeor_regist
111 use scale_atmos_thermodyn, only: &
112 atmos_thermodyn_setup
113 use scale_atmos_saturation, only: &
114 atmos_saturation_setup
115
118 use scale_time_manager, only: &
120
121 implicit none
122
123 class(atmoscomponent), intent(inout), target :: this
124
125 logical :: ACTIVATE_FLAG = .true. !< Flag whether atmospheric component is activated
126
127 real(DP) :: TIME_DT = undef8 !< Timestep value of atmospheric component
128 character(len=H_SHORT) :: TIME_DT_UNIT = 'SEC' !< Timestep unit of atmospheric component
129 real(DP) :: TIME_DT_RESTART = undef8 !< Timestep value when outputting restart file for atmospheric component
130 character(len=H_SHORT) :: TIME_DT_RESTART_UNIT = 'SEC' !< Timestep unit when outputting restart file for atmospheric component
131
132 logical :: ATMOS_DYN_DO = .true. !< Flag whether dynamics process is considered
133 logical :: ATMOS_PHY_SF_DO = .false. !< Flag whether surface process is considered
134 logical :: ATMOS_PHY_TB_DO = .false. !< Flag whether SGS turbulent process is considered
135 logical :: ATMOS_PHY_MP_DO = .false. !< Flag whether cloud microphysics process is considered
136 logical :: ATMOS_PHY_RD_DO = .false. !< Flag whether radiation process is considered
137 logical :: ATMOS_PHY_CP_DO = .false. !< Flag whether cumulus parameterization process is considered
138 logical :: ATMOS_PHY_BL_DO = .false. !< Flag whether PBL turbulence parameterization process is considered
139 character(len=H_SHORT) :: ATMOS_MESH_TYPE = 'REGIONAL' !< Name of mesh type for atmospheric component ('REGIONAL' or 'GLOBAL')
140
141 logical :: ATMOS_USE_QV = .false. !< Flag whether QV is used although cloud microphysics is not considered
142
143
144 namelist / param_atmos / &
145 activate_flag, &
146 time_dt, &
147 time_dt_unit, &
148 time_dt_restart, &
149 time_dt_restart_unit, &
150 atmos_mesh_type, &
151 atmos_dyn_do, &
152 atmos_phy_sf_do, &
153 atmos_phy_tb_do, &
154 atmos_phy_mp_do, &
155 atmos_phy_rd_do, &
156 atmos_phy_cp_do, &
157 atmos_phy_bl_do, &
158 atmos_use_qv
159
160 integer :: ierr
161 !--------------------------------------------------
162 call prof_rapstart( 'ATM_setup', 1)
163 log_info('AtmosComponent_setup',*) 'Atmosphere model components '
164
165 !--- read namelist
166 rewind(io_fid_conf)
167 read(io_fid_conf,nml=param_atmos,iostat=ierr)
168 if( ierr < 0 ) then !--- missing
169 log_info("ATMOS_setup",*) 'Not found namelist. Default used.'
170 elseif( ierr > 0 ) then !--- fatal error
171 log_error("ATM_setup",*) 'Not appropriate names in namelist PARAM_ATMOS. Check!'
172 call prc_abort
173 endif
174 log_nml(param_atmos)
175
176 !************************************************
177 call this%ModelComponent_Init('ATMOS', activate_flag )
178 if ( .not. activate_flag ) return
179
180 !- Setup time manager
181
182 call this%time_manager%Init( this%GetComponentName(), &
183 time_dt, time_dt_unit, &
184 time_dt_restart, time_dt_restart_unit )
185
186 call time_manager_regist_component( this%time_manager )
187
188 !- Setup mesh & file I/O for atmospheric component
189
190 this%mesh_type = atmos_mesh_type
191 select case( this%mesh_type )
192 case('REGIONAL')
193 call this%mesh_rm%Init()
194 call file_history_meshfield_setup( mesh3d_=this%mesh_rm%mesh )
195 this%mesh => this%mesh_rm
196 case('GLOBAL')
197 call this%mesh_gm%Init()
198 call file_history_meshfield_setup( meshcubedsphere3d_=this%mesh_gm%mesh )
199 this%mesh => this%mesh_gm
200 case default
201 log_error("ATM_setup",*) 'Unsupported type of mesh is specified. Check!', this%mesh_type
202 call prc_abort
203 end select
204
205 !- setup common tools for atmospheric model
206
207 call atmos_thermodyn_setup
208 call atmos_saturation_setup
209
210 !- Setup each processes in atmospheric model ------------------------------------
211
212 !- Setup the module for atmosphere / physics / surface
213 call this%phy_sfc_proc%ModelComponentProc_Init( 'AtmosPhysSfc', atmos_phy_sf_do )
214 call this%phy_sfc_proc%setup( this%mesh, this%time_manager )
215
216 !- Setup the module for atmosphere / physics / cloud microphysics
217 call this%phy_mp_proc%ModelComponentProc_Init( 'AtmosPhysMp', atmos_phy_mp_do )
218 call this%phy_mp_proc%setup( this%mesh, this%time_manager )
219
220 !-- Regist qv if needed
221 if ( atmos_hydrometeor_dry .and. atmos_use_qv ) then
222 log_info("ATMOS_setup",*) "Regist QV"
223 call atmos_hydrometeor_regist( 0, 0, & ! (in)
224 (/'QV'/), & ! (in)
225 (/'Ratio of Water Vapor mass to total mass (Specific humidity)'/), & ! (in)
226 (/'kg/kg'/), & ! (in)
227 this%phy_mp_proc%vars%QS ) ! (out)
228
229 this%phy_mp_proc%vars%QA = 1
230 this%phy_mp_proc%vars%QE = this%phy_mp_proc%vars%QS
231 end if
232
233 !- Setup the module for atmosphere / dynamics
234 call this%dyn_proc%ModelComponentProc_Init( 'AtmosDyn', atmos_dyn_do )
235 call this%dyn_proc%setup( this%mesh, this%time_manager )
236
237 !- Setup the module for atmosphere / physics / turbulence
238 call this%phy_tb_proc%ModelComponentProc_Init( 'AtmosPhysTb', atmos_phy_tb_do )
239 call this%phy_tb_proc%setup( this%mesh, this%time_manager )
240 call this%phy_tb_proc%SetDynBC( this%dyn_proc%dyncore_driver%boundary_cond )
241
242 !- Setup the module for atmosphere / physics / radiation
243 call this%phy_rd_proc%ModelComponentProc_Init( 'AtmosPhysRd', atmos_phy_rd_do )
244 call this%phy_rd_proc%setup( this%mesh, this%time_manager )
245
246 !- Setup the module for atmosphere / physics / cumulus parameterization
247 call this%phy_cp_proc%ModelComponentProc_Init( 'AtmosPhysCp', atmos_phy_cp_do )
248 call this%phy_cp_proc%setup( this%mesh, this%time_manager )
249
250 !- Setup the module for atmosphere / physics / PBL turbulence parameterization
251 call this%phy_bl_proc%ModelComponentProc_Init( 'AtmosPhysBl', atmos_phy_bl_do )
252 call this%phy_bl_proc%setup( this%mesh, this%time_manager )
253 call this%phy_bl_proc%SetDynBC( this%dyn_proc%dyncore_driver%boundary_cond )
254
255 !- Setup
256
257 log_newline
258 log_info('AtmosComponent_setup',*) 'Finish setup of each atmospheric component.'
259
260 call prof_rapend( 'ATM_setup', 1)
261
262 return
263 end subroutine atmos_setup
264
265 !> Setup variables with the atmospheric component
266!OCL SERIAL
267 subroutine atmos_setup_vars( this )
268 use mod_atmos_phy_sfc_vars, only: &
269 sfctemp_id => atmos_phy_sf_svar_temp_id, &
270 sfc_alb_id => atmos_phy_sf_svar_alb_id
271 implicit none
272 class(atmoscomponent), intent(inout) :: this
273 !----------------------------------------------------------
274
275 call prof_rapstart( 'ATM_setup_vars', 1)
276
277 log_info('AtmosComponent_setup_vars',*) 'Atmosphere model components '
278
279 call this%vars%Init( this%mesh )
280
281 !- Cloud microphysics component
282 if ( this%phy_mp_proc%IsActivated() ) then
283 call this%phy_mp_proc%vars%Setup( this%mesh )
284 call this%phy_mp_proc%Set_primary_atmvars_container( this%vars%container )
285
286 call this%vars%Regist_physvar_manager( mp_auxvars2d_manager=this%phy_mp_proc%vars%auxvars2D_manager )
287 call this%vars%Setup_container( this%phy_mp_proc%atm_var_container_typeid, this%mesh )
288 end if
289 !- Surface component
290 if ( this%phy_sfc_proc%IsActivated() ) then
291 call this%phy_sfc_proc%vars%Setup( this%mesh )
292
293 call this%vars%Setup_container( this%phy_sfc_proc%atm_var_container_typeid, this%mesh )
294 end if
295 !- Turbulence component
296 if ( this%phy_tb_proc%IsActivated() ) then
297 call this%phy_tb_proc%vars%Setup( this%mesh )
298 end if
299 !- Radiation component
300 if ( this%phy_rd_proc%IsActivated() ) then
301 if ( .not. this%phy_sfc_proc%IsActivated() ) then
302 log_error('ATM_setup_vars',*) 'ATMOS_PHY_RD_DO requires ATMOS_PHY_SF_DO to provide SFC_TEMP.'
303 call prc_abort
304 end if
305 call this%phy_rd_proc%vars%Setup( this%mesh )
306 call this%phy_rd_proc%SetSfcVars( this%phy_sfc_proc%vars%SFC_VARS(sfctemp_id), &
307 this%phy_sfc_proc%vars%SFC_VARS(sfc_alb_id) )
308 end if
309 !- Cumulus parameterization component
310 if ( this%phy_cp_proc%IsActivated() ) then
311 call this%phy_cp_proc%vars%Setup( this%mesh )
312 call this%vars%Regist_physvar_manager( cp_auxvars2d_manager=this%phy_cp_proc%vars%auxvars2D_manager )
313
314 if ( this%phy_mp_proc%IsActivated() ) then
315 call this%phy_mp_proc%Set_CP_tends_manager( this%phy_cp_proc%vars%tends_manager )
316 end if
317 end if
318 !- PBL component
319 if ( this%phy_bl_proc%IsActivated() ) then
320 call this%phy_bl_proc%vars%Setup( this%mesh )
321 end if
322
323 call prof_rapend( 'ATM_setup_vars', 1)
324 return
325 end subroutine atmos_setup_vars
326
327 !> Set coupler component to the atmospheric component
328!OCL SERIAL
329 subroutine atmos_set_coupler( this, coupler )
330 implicit none
331 class(atmoscomponent), intent(inout) :: this
332 class(couplercomponent), target, intent(inout) :: coupler
333 !----------------------------------------------------------
334 this%coupler_ptr => coupler
335
336 if ( this%phy_sfc_proc%IsActivated() ) then
337 call this%phy_sfc_proc%set_coupler_flag( coupler%IsActivated() )
338 end if
339 return
340 end subroutine atmos_set_coupler
341
342 !> Calculate tendencies with the atmospheric component
343!OCL SERIAL
344 subroutine atmos_calc_tendency( this, force )
345 use scale_tracer, only: qa
347 phytend_num1 => phytend_num, &
348 dens_tp => phytend_dens_id, &
349 momx_tp => phytend_momx_id, &
350 momy_tp => phytend_momy_id, &
351 momz_tp => phytend_momz_id, &
352 rhot_tp => phytend_rhot_id, &
353 rhoh_p => phytend_rhoh_id
354 use mod_atmos_vars, only: &
355 atmosvars_getlocalmeshphytends
356
357 implicit none
358 class(atmoscomponent), intent(inout) :: this
359 logical, intent(in) :: force
360
361 class(meshbase), pointer :: mesh
362 class(localmesh3d), pointer :: lcmesh
363 type(localmeshfieldbaselist) :: tp_list(PHYTEND_NUM1)
364 type(localmeshfieldbaselist) :: tp_qtrc(QA)
365
366 integer :: tm_process_id
367 logical :: is_update
368 integer :: n
369 integer :: v
370 integer :: iq
371 integer :: ke, p
372 integer :: Np
373
374 class(atmosvarscontainer), pointer :: vars_primary_container
375 class(atmosvarscontainer), pointer :: vars_container
376
377 !------------------------------------------------------------------
378
379 call prof_rapstart( 'ATM_tendency', 1)
380 !LOG_INFO('AtmosComponent_calc_tendency',*)
381
382 call this%mesh%GetModelMesh( mesh )
383 call this%vars%Get_container( atm_vars_container_primary_id, & ! (in)
384 vars_primary_container ) ! (out)
385
386 !########## Get Surface Boundary from coupler ##########
387 call this%Get_surface()
388
389
390 !########## calculate tendency ##########
391
392 !* Exchange halo data ( for physics )
393 call prof_rapstart( 'ATM_exchange_prgv', 2)
394 call this%vars%container%PROGVARS_manager%MeshFieldComm_Exchange()
395 if ( qa > 0 ) call this%vars%container%QTRCVARS_manager%MeshFieldComm_Exchange()
396 call prof_rapend( 'ATM_exchange_prgv', 2)
397
398
399 !- Reset tendencies of physics
400
401 !$acc data create( tp_list, tp_qtrc )
402
403 do n=1, mesh%LOCAL_MESH_NUM
404 call atmosvars_getlocalmeshphytends( n, mesh, this%vars%container%PHYTENDS_manager , & ! (in)
405 tp_list(dens_tp)%ptr, tp_list(momx_tp)%ptr, tp_list(momy_tp)%ptr, & ! (out)
406 tp_list(momz_tp)%ptr, tp_list(rhot_tp)%ptr, tp_list(rhoh_p )%ptr, tp_qtrc, & ! (out)
407 lcmesh ) ! (out)
408 !$acc enter data attach( tp_list(DENS_tp)%ptr, tp_list(MOMX_tp)%ptr, tp_list(MOMY_tp)%ptr, tp_list(MOMZ_tp)%ptr, tp_list(RHOT_tp)%ptr, tp_list(RHOH_p )%ptr, lcmesh )
409
410 np = lcmesh%refElem%Np
411 !$omp parallel private(v,iq,ke)
412
413 !$omp do collapse(2)
414 do v=1, phytend_num1
415 !$acc parallel loop gang present( tp_list(v)%ptr%val ) async(1)
416 do ke=lcmesh%NeS, lcmesh%NeE
417 !$acc loop vector
418 do p=1, np
419 tp_list(v)%ptr%val(p,ke) = 0.0_rp
420 end do
421 end do
422 end do
423 if ( qa > 0 ) then
424#ifdef _OPENACC
425 do iq=1, qa
426 !$acc enter data attach( tp_qtrc(iq)%ptr )
427 end do
428#endif
429 !$omp do collapse(2)
430 do iq=1, qa
431 !$acc parallel loop gang present( tp_qtrc(iq)%ptr%val ) async(1)
432 do ke=lcmesh%NeS, lcmesh%NeE
433 !$acc loop vector
434 do p=1, np
435 tp_qtrc(iq)%ptr%val(p,ke) = 0.0_rp
436 end do
437 end do
438 end do
439 !$omp end do
440 end if
441 !$omp end parallel
442 end do
443 !$acc wait(1)
444 !$acc end data
445
446 !- Preprocessing for variables before calculating physics tendencies
447
448 call prof_rapstart('ATM_PreOptrForPhys', 1)
449 call this%vars%PreprocOperationForPhys( this%dyn_proc%dyncore_driver )
450 call prof_rapend('ATM_PreOptrForPhys', 1)
451
452 !- Cumulus parameterization
453
454 if ( this%phy_cp_proc%IsActivated() ) then
455 call prof_rapstart('ATM_Cumulus', 1)
456 tm_process_id = this%phy_cp_proc%tm_process_id
457 is_update = this%time_manager%Do_process(tm_process_id) .or. force
458
459 call this%vars%Get_container( this%phy_cp_proc%atm_var_container_typeid, & ! (in)
460 vars_container ) ! (out)
461
462 call this%phy_cp_proc%calc_tendency( &
463 this%mesh, vars_container%PROGVARS_manager, vars_container%QTRCVARS_manager, &
464 vars_container%AUXVARS_manager, vars_primary_container%PHYTENDS_manager, is_update )
465 call prof_rapend('ATM_Cumulus', 1)
466 end if
467
468 !- Cloud Microphysics
469
470 if ( this%phy_mp_proc%IsActivated() ) then
471 call prof_rapstart('ATM_Microphysics', 1)
472 tm_process_id = this%phy_mp_proc%tm_process_id
473 is_update = this%time_manager%Do_process(tm_process_id) .or. force
474
475 call this%vars%Get_container( this%phy_mp_proc%atm_var_container_typeid, & ! (in)
476 vars_container ) ! (out)
477
478 call this%phy_mp_proc%calc_tendency( &
479 this%mesh, vars_container%PROGVARS_manager, vars_container%QTRCVARS_manager, &
480 vars_container%AUXVARS_manager, vars_primary_container%PHYTENDS_manager, is_update )
481 call prof_rapend('ATM_Microphysics', 1)
482 end if
483
484 !- Radiation
485
486 if ( this%phy_rd_proc%IsActivated() ) then
487 call prof_rapstart('ATM_Radiation', 1)
488 tm_process_id = this%phy_rd_proc%tm_process_id
489 is_update = this%time_manager%Do_process(tm_process_id) .or. force
490
491 call this%vars%Get_container( this%phy_rd_proc%atm_var_container_typeid, & ! (in)
492 vars_container ) ! (out)
493
494 call this%phy_rd_proc%calc_tendency( &
495 this%mesh, vars_container%PROGVARS_manager, vars_container%QTRCVARS_manager, &
496 vars_container%AUXVARS_manager, vars_primary_container%PHYTENDS_manager, is_update )
497 call prof_rapend('ATM_Radiation', 1)
498 end if
499
500 !- Turbulence
501
502 if ( this%phy_tb_proc%IsActivated() ) then
503 call prof_rapstart('ATM_Turbulence', 1)
504 tm_process_id = this%phy_tb_proc%tm_process_id
505 is_update = this%time_manager%Do_process(tm_process_id) .or. force
506
507 call this%vars%Get_container( atm_vars_container_primary_id, & ! (in)
508 vars_container ) ! (out)
509
510 call this%phy_tb_proc%calc_tendency( &
511 this%mesh, vars_container%PROGVARS_manager, vars_container%QTRCVARS_manager, &
512 vars_container%AUXVARS_manager, vars_primary_container%PHYTENDS_manager, is_update )
513 call prof_rapend('ATM_Turbulence', 1)
514 end if
515
516
517 if ( .not. this%coupler_ptr%IsActivated() ) then
518
519 !- Surface flux
520
521 if ( this%phy_sfc_proc%IsActivated() ) then
522 call prof_rapstart('ATM_SurfaceFlux', 1)
523 tm_process_id = this%phy_sfc_proc%tm_process_id
524 is_update = this%time_manager%Do_process(tm_process_id) .or. force
525
526 call this%vars%Get_container( this%phy_sfc_proc%atm_var_container_typeid, & ! (in)
527 vars_container ) ! (out)
528
529 call this%phy_sfc_proc%calc_tendency( &
530 this%mesh, vars_container%PROGVARS_manager, vars_container%QTRCVARS_manager, &
531 vars_container%AUXVARS_manager, vars_primary_container%PHYTENDS_manager, is_update )
532 call prof_rapend('ATM_SurfaceFlux', 1)
533 end if
534
535 !- Planetary boundary layer
536
537 if ( this%phy_bl_proc%IsActivated() ) then
538 call prof_rapstart('ATM_PBL', 1)
539 tm_process_id = this%phy_bl_proc%tm_process_id
540 is_update = this%time_manager%Do_process(tm_process_id) .or. force
541
542 call this%vars%Get_container( this%phy_bl_proc%atm_var_container_typeid, & ! (in)
543 vars_container ) ! (out)
544
545 call this%phy_bl_proc%calc_tendency( &
546 this%mesh, vars_container%PROGVARS_manager, vars_container%QTRCVARS_manager, &
547 vars_container%AUXVARS_manager, vars_primary_container%PHYTENDS_manager, is_update )
548 call prof_rapend('ATM_PBL', 1)
549 end if
550
551 end if
552
553 !* setup surface condition
554 call this%set_surface( countup=.true. )
555
556 call prof_rapend( 'ATM_tendency', 1)
557 return
558 end subroutine atmos_calc_tendency
559
560!> Calculate tendencies with surface flux based on surface quantities managed by coupler component
561!OCL SERIAL
562 subroutine atmos_calc_tendency_from_sflux( this, force )
563 use scale_tracer, only: qa
565 phytend_num1 => phytend_num, &
566 dens_tp => phytend_dens_id, &
567 momx_tp => phytend_momx_id, &
568 momy_tp => phytend_momy_id, &
569 momz_tp => phytend_momz_id, &
570 rhot_tp => phytend_rhot_id, &
571 rhoh_p => phytend_rhoh_id
572 use mod_atmos_vars, only: &
573 atmosvars_getlocalmeshphytends
574
575 implicit none
576 class(atmoscomponent), intent(inout) :: this
577 logical, intent(in) :: force
578
579 integer :: tm_process_id
580 logical :: is_update
581
582 class(atmosvarscontainer), pointer :: vars_primary_container
583 class(atmosvarscontainer), pointer :: vars_container
584 !------------------------------------------------------------
585
586 if ( .not. this%coupler_ptr%IsActivated() ) return
587
588 call this%vars%Get_container( atm_vars_container_primary_id, & ! (in)
589 vars_primary_container ) ! (out)
590
591 !########## Get Surface Boundary from coupler ##########
592 call this%Get_surface()
593
594 !- Surface flux
595
596 if ( this%phy_sfc_proc%IsActivated() ) then
597 call prof_rapstart('ATM_SurfaceFlux', 1)
598 tm_process_id = this%phy_sfc_proc%tm_process_id
599 is_update = this%time_manager%Do_process(tm_process_id) .or. force
600
601 call this%vars%Get_container( this%phy_sfc_proc%atm_var_container_typeid, & ! (in)
602 vars_container ) ! (out)
603
604 call this%phy_sfc_proc%calc_tendency( &
605 this%mesh, vars_container%PROGVARS_manager, vars_container%QTRCVARS_manager, &
606 vars_container%AUXVARS_manager, vars_primary_container%PHYTENDS_manager, is_update )
607 call prof_rapend('ATM_SurfaceFlux', 1)
608 end if
609
610 !- Planetary boundary layer
611
612 if ( this%phy_bl_proc%IsActivated() ) then
613 call prof_rapstart('ATM_PBL', 1)
614 tm_process_id = this%phy_bl_proc%tm_process_id
615 is_update = this%time_manager%Do_process(tm_process_id) .or. force
616
617 call this%vars%Get_container( this%phy_bl_proc%atm_var_container_typeid, & ! (in)
618 vars_container ) ! (out)
619
620 call this%phy_bl_proc%calc_tendency( &
621 this%mesh, vars_container%PROGVARS_manager, vars_container%QTRCVARS_manager, &
622 vars_container%AUXVARS_manager, vars_primary_container%PHYTENDS_manager, is_update )
623 call prof_rapend('ATM_PBL', 1)
624 end if
625 return
626 end subroutine atmos_calc_tendency_from_sflux
627
628 !> Update variables with the atmospheric component
629!OCL SERIAL
630 subroutine atmos_update( this )
631 implicit none
632 class(atmoscomponent), intent(inout) :: this
633
634 integer :: tm_process_id
635 logical :: is_update
636 integer :: inner_itr
637
638 class(atmosvarscontainer), pointer :: vars_container
639 !--------------------------------------------------
640 call prof_rapstart( 'ATM_update', 1)
641
642 !########## Dynamics ##########
643
644 call this%vars%Get_container( atm_vars_container_primary_id, & ! (in)
645 vars_container ) ! (out)
646
647 if ( this%dyn_proc%IsActivated() ) then
648 call prof_rapstart('ATM_Dynamics', 1)
649 tm_process_id = this%dyn_proc%tm_process_id
650 is_update = this%time_manager%Do_process( tm_process_id )
651
652 log_progress(*) 'atmosphere / dynamics'
653 do inner_itr=1, this%time_manager%Get_process_inner_itr_num( tm_process_id )
654 call this%dyn_proc%update( &
655 this%mesh, vars_container%PROGVARS_manager, vars_container%QTRCVARS_manager, &
656 vars_container%AUXVARS_manager, vars_container%PHYTENDS_manager, is_update )
657 end do
658 call prof_rapend('ATM_Dynamics', 1)
659 end if
660
661 !########## Calculate diagnostic variables ##########
662
663 call vars_container%Calc_diagnostics()
664 call vars_container%AUXVARS_manager%MeshFieldComm_Exchange()
665
666 !########## Adjustment ##########
667 ! Microphysics
668 ! Aerosol
669 ! Lightning
670
671 !########## Reference State ###########
672
673 !#### Check values #################################
674 call this%vars%Check()
675
676 call prof_rapend('ATM_update', 1)
677 return
678 end subroutine atmos_update
679
680 !> Set atmospheric quantites to coupler component
681!OCL SERIAL
682 subroutine atmos_set_surface( this, countup )
683 use scale_atmos_hydrometeor, only: &
684 atmos_hydrometeor_dry, &
685 i_qv
689 use mod_atmos_vars, only: &
690 atmosvars_getlocalmeshsfcvar
691 use mod_atmos_vars_container, only: &
692 prec_engi_id => atmos_auxvars2d_prec_engi_id
693 use mod_atmos_phy_mp_vars, only: &
695 use mod_atmos_phy_cp_vars, only: &
697 use mod_atmos_phy_rd_vars, only: &
698 rd_sflx_lw_dif_id => atmos_phy_rd_aux2d_sflx_lw_dn_id, &
699 rd_sflx_sw_dir_id => atmos_phy_rd_aux2d_sflx_sw_dn_id
701 implicit none
702 class(atmoscomponent), intent(inout) :: this
703 logical, intent(in) :: countup
704
705 class(meshbase), pointer :: mesh
706 class(meshbase2d), pointer :: mesh2D
707 class(localmesh2d), pointer :: lcmesh
708 integer :: n
709 integer :: ke
710
711 class(localmeshfieldbase), pointer :: PREC, PREC_ENGI
712 class(localmeshfieldbase), pointer :: SFLX_rain_MP, SFLX_snow_MP, SFLX_ENGI_MP
713 class(localmeshfieldbase), pointer :: SFLX_rain_CP, SFLX_snow_CP, SFLX_ENGI_CP
714
715 integer :: iq
716 !--------------------------------------------------
717
718 call prof_rapstart( 'ATM_sfc_exch', 1)
719
720 call this%mesh%GetModelMesh( mesh )
721 select type(mesh)
722 class is (meshbase3d)
723 call mesh%GetMesh2D( mesh2d )
724 end select
725
726 !- Sum up precipitation and energy fluxes from cloud microphysics and cumulus parameterization components
727
728 do n=1, mesh2d%LOCAL_MESH_NUM
730 mesh2d, this%vars%container%AUXVARS2D_manager, & ! (in)
731 prec, prec_engi, lcmesh ) ! (out)
732
733 !$omp parallel do private(ke)
734 do ke=lcmesh%NeS, lcmesh%NeE
735 prec %val(:,ke) = 0.0_rp
736 prec_engi%val(:,ke) = 0.0_rp
737 end do
738
739 if ( this%phy_mp_proc%IsActivated() ) then
741 mesh2d, this%phy_mp_proc%vars%auxvars2D_manager, & ! (in)
742 sflx_rain_mp, sflx_snow_mp, sflx_engi_mp ) ! (out)
743
744 !$omp parallel do private(ke)
745 do ke=lcmesh%NeS, lcmesh%NeE
746 prec %val(:,ke) = prec %val(:,ke) + sflx_rain_mp%val(:,ke) + sflx_snow_mp%val(:,ke)
747 prec_engi%val(:,ke) = prec_engi%val(:,ke) + sflx_engi_mp%val(:,ke)
748 end do
749 end if
750
751 if ( this%phy_cp_proc%IsActivated() ) then
753 mesh2d, this%phy_cp_proc%vars%auxvars2D_manager, & ! (in)
754 sflx_rain_cp, sflx_snow_cp, sflx_engi_cp ) ! (out)
755
756 !$omp parallel do private(ke)
757 do ke=lcmesh%NeS, lcmesh%NeE
758 prec %val(:,ke) = prec %val(:,ke) + sflx_rain_cp%val(:,ke) + sflx_snow_cp%val(:,ke)
759 prec_engi%val(:,ke) = prec_engi%val(:,ke) + sflx_engi_cp%val(:,ke)
760 end do
761 end if
762 end do
763
764 if ( this%coupler_ptr%IsActivated() ) then
765 if ( atmos_hydrometeor_dry ) then
766 iq = 0
767 else
768 iq = i_qv
769 end if
770 call this%coupler_ptr%vars%PutAtm( &
771 this%vars%container%PROG_VARS(prgvar_ddens_id), &
772 this%vars%container%PROG_VARS(prgvar_momz_id), &
773 this%vars%container%PROG_VARS(prgvar_momx_id), &
774 this%vars%container%PROG_VARS(prgvar_momy_id), &
775 this%vars%container%QTRC_VARS(iq), &
776 this%vars%container%AUX_VARS(auxvar_pres_id), &
777 this%vars%container%AUX_VARS(auxvar_rtot_id), &
778 this%vars%container%AUX_VARS(auxvar_denshydro_id), &
779 this%phy_rd_proc%vars%auxvars2D(rd_sflx_sw_dir_id), &
780 this%phy_rd_proc%vars%auxvars2D(rd_sflx_lw_dif_id), &
781 this%vars%container%AUX_VARS2D(prec_engi_id), &
782 countup )
783 end if
784
785 call prof_rapend( 'ATM_sfc_exch', 1)
786
787 return
788 end subroutine atmos_set_surface
789
790 !> Get surface quantities from coupler component
791!OCL SERIAL
792 subroutine atmos_get_surface( this )
793 use mod_atmos_vars, only: &
794 atmosvars_getlocalmeshsfcvar
795 use mod_atmos_phy_sfc_vars, only: &
796 sfctemp_id => atmos_phy_sf_svar_temp_id, &
797 sfcalb_id => atmos_phy_sf_svar_alb_id, &
798 sflx_mw_id => atmos_phy_sf_sflx_mw_id, &
799 sflx_mu_id => atmos_phy_sf_sflx_mu_id, &
800 sflx_mv_id => atmos_phy_sf_sflx_mv_id, &
801 sflx_sh_id => atmos_phy_sf_sflx_sh_id, &
802 sflx_lh_id => atmos_phy_sf_sflx_lh_id, &
803 sflx_qv_id => atmos_phy_sf_sflx_qv_id
805 implicit none
806 class(atmoscomponent), intent(inout), target :: this
807 !--------------------------------------------------
808
809 if ( .not. this%coupler_ptr%IsActivated() ) return
810
811 call prof_rapstart( 'ATM_sfc_exch', 1)
812 call this%coupler_ptr%vars%Get_SFC_ATM( &
813 this%phy_sfc_proc%vars%SFC_VARS(sfctemp_id), &
814 this%phy_sfc_proc%vars%SFC_VARS(sfcalb_id), &
815 this%phy_sfc_proc%vars%SFC_FLX(sflx_mw_id), &
816 this%phy_sfc_proc%vars%SFC_FLX(sflx_mu_id), &
817 this%phy_sfc_proc%vars%SFC_FLX(sflx_mv_id), &
818 this%phy_sfc_proc%vars%SFC_FLX(sflx_sh_id), &
819 this%phy_sfc_proc%vars%SFC_FLX(sflx_lh_id), &
820 this%phy_sfc_proc%vars%SFC_FLX(sflx_qv_id) )
821 call prof_rapend( 'ATM_sfc_exch', 1)
822 return
823 end subroutine atmos_get_surface
824
825 !> Finalize an object to manage the atmospheric component
826!OCL SERIAL
827 subroutine atmos_finalize( this )
828 implicit none
829 class(atmoscomponent), intent(inout) :: this
830 !--------------------------------------------------
831
832 log_info('AtmosComponent_finalize',*)
833
834 if ( .not. this%IsActivated() ) return
835
836 call this%dyn_proc%finalize()
837 call this%phy_sfc_proc%finalize()
838 call this%phy_tb_proc%finalize()
839 call this%phy_mp_proc%finalize()
840 call this%phy_rd_proc%finalize()
841 call this%phy_cp_proc%finalize()
842 call this%phy_bl_proc%finalize()
843 call this%vars%Final()
844
845 select case( this%mesh_type )
846 case('REGIONAL')
847 call this%mesh_rm%Final()
848 case('GLOBAL')
849 call this%mesh_gm%Final()
850 end select
851 this%mesh => null()
852
853 call this%time_manager%Final()
854
855 return
856 end subroutine atmos_finalize
857
858end module mod_atmos_component
module Atmosphere component
subroutine atmos_setup(this)
Setup an object to mange atmospheric component.
module Atmosphere / Dynamics
module Atmosphere / Mesh
module Atmosphere / Mesh
module Atmosphere / Mesh
module Atmosphere / Physics / Planetary Boundary Layer
module Atmosphere / Physics / Cumulus Parameterization
subroutine, public atmosphycpvars_getlocalmeshfields_sfcflx(domid, mesh, sfcflx_list, sflx_rain, sflx_snow, sflx_engi)
module Atmosphere / Physics / Cumulus Parameterization
module Atmosphere / Physics / Cloud Microphysics
subroutine, public atmosphympvars_getlocalmeshfields_sfcflx(domid, mesh, sfcflx_list, sflx_rain, sflx_snow, sflx_engi)
module Atmosphere / Physics / cloud microphysics
module Atmosphere / Physics / Radiation
integer, parameter, public atmos_phy_rd_aux2d_sflx_sw_dn_id
ID of downward shortwave surface flux.
integer, parameter, public atmos_phy_rd_aux2d_sflx_lw_dn_id
ID of downward longwave surface flux.
module Atmosphere / Physics / Radiation
module Atmosphere / Physics / surface process
integer, parameter, public atmos_phy_sf_sflx_mv_id
integer, parameter, public atmos_phy_sf_sflx_qv_id
integer, parameter, public atmos_phy_sf_svar_alb_id
integer, parameter, public atmos_phy_sf_sflx_mu_id
integer, parameter, public atmos_phy_sf_sflx_sh_id
integer, parameter, public atmos_phy_sf_sflx_lh_id
integer, parameter, public atmos_phy_sf_svar_temp_id
integer, parameter, public atmos_phy_sf_sflx_mw_id
module Atmosphere / Physics / surface process
module Atmosphere / Physics / sub-grid scale turbulence process
module Atmosphere / Variables
subroutine, public atmosvars_getlocalmeshsfcvar(domid, mesh, auxvars2d_list, prec, prec_engi, lcmesh2d)
integer, parameter, public atmos_auxvars2d_prec_engi_id
module Atmosphere / Variables
module Coupler component
module FElib / Fluid dyn solver / Atmosphere / Nonhydrostatic model / Common
subroutine, public file_history_meshfield_setup(mesh1d_, mesh2d_, mesh3d_, meshcubedsphere2d_, meshcubedsphere3d_, dim_name_postfix_, registered_comp_id)
Setup a module for file history.
module FElib / Mesh / Local 2D
module FElib / Mesh / Local 3D
module FElib / Mesh / Base 2D
module FElib / Mesh / Base 3D
module FElib / Mesh / Base
FElib / model framework / model component.
FElib / model framework / mesh manager.
Module common / time.
subroutine, public time_manager_regist_component(tmanager_comp)
Derived type to manage atmospheric component.
Derived type to manage a component of atmospheric dynamics.
Derived type to manage a computational mesh (base class)
Derived type to manage a computational mesh of global atmospheric model.
Derived type to manage a computational mesh of regional atmospheric model.
Derived type to manage a component of planetary boundary layer (PBL) turbulence parameterization in a...
Derived type to manage a component of cumulus parameterization in atmospheric model.
Derived type to manage a component of cloud microphysics.
Derived type to manage a component of radiation in atmospheric model.
Derived type to manage a component of surface process.
Derived type to manage a component of sub-grid scale turbulent process.
Derived type to manage variables with atmospheric component.
Derived type to manage coupler component.
Derived type representing a local mesh for 2D domain.
Derived type to manage a local 3D computational domain.
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.