SCALE-RM
mod_atmos_driver.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
16 !-------------------------------------------------------------------------------
17 #include "inc_openmp.h"
19  !-----------------------------------------------------------------------------
20  !
21  !++ used modules
22  !
23  use scale_precision
24  use scale_stdio
25  use scale_prof
27  !-----------------------------------------------------------------------------
28  implicit none
29  private
30  !-----------------------------------------------------------------------------
31  !
32  !++ Public procedure
33  !
34  public :: atmos_driver_config
35  public :: atmos_driver_setup
36  public :: atmos_driver_resume1
37  public :: atmos_driver_resume2
38  public :: atmos_driver
39  public :: atmos_driver_finalize
40  public :: atmos_surface_get
41  public :: atmos_surface_set
42 
43  !-----------------------------------------------------------------------------
44  !
45  !++ Public parameters & variables
46  !
47  !-----------------------------------------------------------------------------
48  !
49  !++ Private procedure
50  !
51  !-----------------------------------------------------------------------------
52  !
53  !++ Private parameters & variables
54  !
55  !-----------------------------------------------------------------------------
56 contains
57  !-----------------------------------------------------------------------------
59  subroutine atmos_driver_config
62  use mod_atmos_phy_ae_driver, only: &
64  use mod_atmos_phy_tb_driver, only: &
66  implicit none
67 
71 
72  return
73  end subroutine atmos_driver_config
74 
75  !-----------------------------------------------------------------------------
77  subroutine atmos_driver_setup
78  use scale_time, only: &
80  use scale_atmos_solarins, only: &
82  use scale_atmos_refstate, only: &
84  use scale_atmos_boundary, only: &
86  use mod_atmos_dyn_driver, only: &
88  use mod_atmos_phy_mp_driver, only: &
90  use mod_atmos_phy_rd_driver, only: &
92  use mod_atmos_phy_ch_driver, only: &
94  use mod_atmos_phy_ae_driver, only: &
96  use mod_atmos_phy_sf_driver, only: &
98  use mod_atmos_phy_tb_driver, only: &
100  use mod_atmos_phy_cp_driver, only: &
102  implicit none
103  !---------------------------------------------------------------------------
104 
105  if( io_l ) write(io_fid_log,*)
106  if( io_l ) write(io_fid_log,*) '++++++ Module[DRIVER] / Categ[ATMOS] / Origin[SCALE-RM]'
107 
108  if( io_l ) write(io_fid_log,*)
109  if( io_l ) write(io_fid_log,*) '*** Setup each atmospheric components ...'
110 
111  !--- setup solar insolation
113 
114  call prof_rapstart('ATM_Refstate', 2)
116  call prof_rapend ('ATM_Refstate', 2)
117 
118  call prof_rapstart('ATM_Boundary', 2)
120  call prof_rapend ('ATM_Boundary', 2)
121 
122  ! setup each components
131 
132  if( io_l ) write(io_fid_log,*)
133  if( io_l ) write(io_fid_log,*) '*** Finish setup of each atmospheric components.'
134 
135  return
136  end subroutine atmos_driver_setup
137 
138  !-----------------------------------------------------------------------------
140  subroutine atmos_driver_resume1
141  use mod_atmos_vars, only: &
144  dens, &
145  momz, &
146  momx, &
147  momy, &
148  rhot, &
149  qtrc, &
150  dens_tp, &
151  momz_tp, &
152  momx_tp, &
153  momy_tp, &
154  rhot_tp, &
155  rhoq_tp
156  use scale_atmos_refstate, only: &
158  use scale_atmos_boundary, only: &
160  use mod_atmos_phy_mp_driver, only: &
162  use mod_atmos_phy_rd_driver, only: &
164  use mod_atmos_phy_ch_driver, only: &
166  use mod_atmos_phy_ae_driver, only: &
168  implicit none
169  !---------------------------------------------------------------------------
170 
171  if( io_l ) write(io_fid_log,*)
172  if( io_l ) write(io_fid_log,*) '++++++ Module[DRIVER] / Categ[ATMOS] / Origin[SCALE-RM]'
173 
174  if( io_l ) write(io_fid_log,*)
175  if( io_l ) write(io_fid_log,*) '*** Resume each atmospheric components 1 ...'
176 
177  call prof_rapstart('ATM_Refstate', 2)
179  call prof_rapend ('ATM_Refstate', 2)
180 
181  call prof_rapstart('ATM_Boundary', 2)
183  call prof_rapend ('ATM_Boundary', 2)
184 
185  !########## Get Surface Boundary Condition ##########
186  call prof_rapstart('ATM_SfcExch', 2)
187  call atmos_surface_get
188  call prof_rapend ('ATM_SfcExch', 2)
189 
190  !########## initialize tendencies ##########
191 !OCL XFILL
192  dens_tp(:,:,:) = 0.0_rp
193 !OCL XFILL
194  momz_tp(:,:,:) = 0.0_rp
195 !OCL XFILL
196  momx_tp(:,:,:) = 0.0_rp
197 !OCL XFILL
198  momy_tp(:,:,:) = 0.0_rp
199 !OCL XFILL
200  rhot_tp(:,:,:) = 0.0_rp
201 !OCL XFILL
202  rhoq_tp(:,:,:,:) = 0.0_rp
203 
204  ! setup each components
209 
210  !########## Calculate diagnostic variables ##########
213 
214  !########## Set Surface Boundary Condition ##########
215  call prof_rapstart('ATM_SfcExch', 2)
216  call atmos_surface_set( countup = .false. )
217  call prof_rapend ('ATM_SfcExch', 2)
218 
219  if( io_l ) write(io_fid_log,*)
220  if( io_l ) write(io_fid_log,*) '*** Finish resume of each atmospheric components 1.'
221 
222  return
223  end subroutine atmos_driver_resume1
224 
225  !-----------------------------------------------------------------------------
227  subroutine atmos_driver_resume2
228  use mod_atmos_vars, only: &
231  use mod_atmos_phy_cp_driver, only: &
233  use mod_atmos_phy_sf_driver, only: &
235  use mod_atmos_phy_tb_driver, only: &
237  implicit none
238  !---------------------------------------------------------------------------
239 
240  if( io_l ) write(io_fid_log,*)
241  if( io_l ) write(io_fid_log,*) '++++++ Module[DRIVER] / Categ[ATMOS] / Origin[SCALE-RM]'
242 
243  if( io_l ) write(io_fid_log,*)
244  if( io_l ) write(io_fid_log,*) '*** Resume each atmospheric components 2 ...'
245 
246  !########## Get Surface Boundary Condition ##########
247  call prof_rapstart('ATM_SfcExch', 2)
248  call atmos_surface_get
249  call prof_rapend ('ATM_SfcExch', 2)
250 
251  ! setup each components
255 
256  !########## Set Surface Boundary Condition ##########
257  call prof_rapstart('ATM_SfcExch', 2)
258  call atmos_surface_set( countup = .true. )
259  call prof_rapend ('ATM_SfcExch', 2)
260 
261  !########## History & Monitor ##########
262  call prof_rapstart('ATM_History', 1)
263  call atmos_vars_history
264  call atmos_vars_monitor
265  call prof_rapend ('ATM_History', 1)
266 
267  if( io_l ) write(io_fid_log,*)
268  if( io_l ) write(io_fid_log,*) '*** Finish resume of each atmospheric components 2.'
269 
270  return
271  end subroutine atmos_driver_resume2
272 
273  !-----------------------------------------------------------------------------
275  subroutine atmos_driver
276  use mod_admin_time, only: &
277  do_dyn => time_doatmos_dyn, &
278  do_phy_mp => time_doatmos_phy_mp, &
279  do_phy_ae => time_doatmos_phy_ae, &
280  do_phy_ch => time_doatmos_phy_ch, &
281  do_phy_rd => time_doatmos_phy_rd, &
282  do_phy_sf => time_doatmos_phy_sf, &
283  do_phy_tb => time_doatmos_phy_tb, &
284  do_phy_cp => time_doatmos_phy_cp
285  use scale_atmos_refstate, only: &
288  use scale_atmos_boundary, only: &
291  use mod_atmos_admin, only: &
292  atmos_sw_dyn, &
293  atmos_sw_phy_mp, &
294  atmos_sw_phy_ae, &
295  atmos_sw_phy_ch, &
296  atmos_sw_phy_rd, &
297  atmos_sw_phy_sf, &
298  atmos_sw_phy_tb, &
300  use mod_atmos_vars, only: &
305  dens, &
306  momz, &
307  momx, &
308  momy, &
309  rhot, &
310  qtrc, &
311  dens_tp, &
312  momz_tp, &
313  momx_tp, &
314  momy_tp, &
315  rhot_tp, &
316  rhoq_tp
317  use mod_atmos_dyn_driver, only: &
319  use mod_atmos_phy_mp_driver, only: &
321  use mod_atmos_phy_ae_driver, only: &
323  use mod_atmos_phy_ch_driver, only: &
325  use mod_atmos_phy_rd_driver, only: &
327  use mod_atmos_phy_sf_driver, only: &
329  use mod_atmos_phy_tb_driver, only: &
331  use mod_atmos_phy_cp_driver, only: &
333  implicit none
334  !---------------------------------------------------------------------------
335 
336  !########## Get Surface Boundary Condition ##########
337  call prof_rapstart('ATM_SfcExch', 2)
338  call atmos_surface_get
339  call prof_rapend ('ATM_SfcExch', 2)
340 
341  !########## Dynamics ##########
342  if ( atmos_sw_dyn ) then
343  call prof_rapstart('ATM_Dynamics', 1)
344  call atmos_dyn_driver( do_dyn )
345  call prof_rapend ('ATM_Dynamics', 1)
346  endif
347 
348  !########## Reference State ###########
349  if ( atmos_refstate_update_flag ) then
350  call prof_rapstart('ATM_Refstate', 2)
351  call atmos_refstate_update( dens, rhot, qtrc ) ! [IN]
352  call prof_rapend ('ATM_Refstate', 2)
353  endif
354 
355  !########## Lateral/Top Boundary Condition ###########
356  if ( atmos_boundary_update_flag ) then
357  call prof_rapstart('ATM_Boundary', 2)
358  call atmos_boundary_update( dens, momz, momx, momy, rhot, qtrc ) ! [INOUT]
359  call prof_rapend ('ATM_Boundary', 2)
360  endif
361 
362  !########## reset tendencies ##########
363 !OCL XFILL
364  dens_tp(:,:,:) = 0.0_rp
365 !OCL XFILL
366  momz_tp(:,:,:) = 0.0_rp
367 !OCL XFILL
368  momx_tp(:,:,:) = 0.0_rp
369 !OCL XFILL
370  momy_tp(:,:,:) = 0.0_rp
371 !OCL XFILL
372  rhot_tp(:,:,:) = 0.0_rp
373 !OCL XFILL
374  rhoq_tp(:,:,:,:) = 0.0_rp
375 
376  !########## Calculate diagnostic variables ##########
377  call prof_rapstart('ATM_History', 1)
380  call prof_rapend ('ATM_History', 1)
381 
382  !########## Microphysics ##########
383  if ( atmos_sw_phy_mp ) then
384  call prof_rapstart('ATM_Microphysics', 1)
385  call atmos_phy_mp_driver( update_flag = do_phy_mp )
386  call prof_rapend ('ATM_Microphysics', 1)
387  endif
388 
389  !########## Aerosol ##########
390  if ( atmos_sw_phy_ae ) then
391  call prof_rapstart('ATM_Aerosol', 1)
392  call atmos_phy_ae_driver( update_flag = do_phy_ae )
393  call prof_rapend ('ATM_Aerosol', 1)
394  endif
395 
396  !########## Chemistry ##########
397  if ( atmos_sw_phy_ch ) then
398  call prof_rapstart('ATM_Chemistry', 1)
399  call atmos_phy_ch_driver( update_flag = do_phy_ch )
400  call prof_rapend ('ATM_Chemistry', 1)
401  endif
402 
403  !########## Radiation ##########
404  if ( atmos_sw_phy_rd ) then
405  call prof_rapstart('ATM_Radiation', 1)
406  call atmos_phy_rd_driver( update_flag = do_phy_rd )
407  call prof_rapend ('ATM_Radiation', 1)
408  endif
409 
410  !########## Surface Flux ##########
411  if ( atmos_sw_phy_sf ) then
412  call prof_rapstart('ATM_SurfaceFlux', 1)
413  call atmos_phy_sf_driver( update_flag = do_phy_sf )
414  call prof_rapend ('ATM_SurfaceFlux', 1)
415  endif
416 
417  !########## Turbulence ##########
418  if ( atmos_sw_phy_tb ) then
419  call prof_rapstart('ATM_Turbulence', 1)
420  call atmos_phy_tb_driver( update_flag = do_phy_tb )
421  call prof_rapend ('ATM_Turbulence', 1)
422  endif
423 
424  !########## Cumulus ##########
425  if ( atmos_sw_phy_cp ) then
426  call prof_rapstart('ATM_Cumulus', 1)
427  call atmos_phy_cp_driver( update_flag = do_phy_cp )
428  call prof_rapend ('ATM_Cumulus', 1)
429  endif
430 
431  !########## Set Surface Boundary Condition ##########
432  call prof_rapstart('ATM_SfcExch', 2)
433  call atmos_surface_set( countup = .true. )
434  call prof_rapend ('ATM_SfcExch', 2)
435 
436  !########## History & Monitor ##########
437  call prof_rapstart('ATM_History', 1)
438  call atmos_vars_history
439  call atmos_vars_monitor
440  call prof_rapend ('ATM_History', 1)
441 
442  return
443  end subroutine atmos_driver
444 
445  !-----------------------------------------------------------------------------
447  subroutine atmos_driver_finalize
448  use scale_atmos_boundary, only: &
451  use scale_grid_nest, only: &
453  implicit none
454  !---------------------------------------------------------------------------
455 
456  !########## Lateral/Top Boundary Condition ###########
457  if ( atmos_boundary_update_flag ) then
458  ! If this run is parent of online nesting, boundary data must be sent
460 
461  ! Finialize Inter-Communicators
463  endif
464 
465  return
466  end subroutine atmos_driver_finalize
467 
468  !-----------------------------------------------------------------------------
470  subroutine atmos_surface_get
472  sfc_temp => atmos_phy_sf_sfc_temp, &
473  sfc_albedo => atmos_phy_sf_sfc_albedo, &
474  sfc_z0m => atmos_phy_sf_sfc_z0m, &
475  sfc_z0h => atmos_phy_sf_sfc_z0h, &
476  sfc_z0e => atmos_phy_sf_sfc_z0e, &
477  sflx_mw => atmos_phy_sf_sflx_mw, &
478  sflx_mu => atmos_phy_sf_sflx_mu, &
479  sflx_mv => atmos_phy_sf_sflx_mv, &
480  sflx_sh => atmos_phy_sf_sflx_sh, &
481  sflx_lh => atmos_phy_sf_sflx_lh, &
482  sflx_gh => atmos_phy_sf_sflx_gh, &
483  sflx_qtrc => atmos_phy_sf_sflx_qtrc, &
484  u10 => atmos_phy_sf_u10, &
485  v10 => atmos_phy_sf_v10, &
486  t2 => atmos_phy_sf_t2, &
487  q2 => atmos_phy_sf_q2
488  use mod_cpl_admin, only: &
489  cpl_sw
490  use mod_cpl_vars, only: &
492  implicit none
493  !---------------------------------------------------------------------------
494 
495  if ( cpl_sw ) then
496  call cpl_getsfc_atm( sfc_temp(:,:), & ! [OUT]
497  sfc_albedo(:,:,:), & ! [OUT]
498  sfc_z0m(:,:), & ! [OUT]
499  sfc_z0h(:,:), & ! [OUT]
500  sfc_z0e(:,:), & ! [OUT]
501  sflx_mw(:,:), & ! [OUT]
502  sflx_mu(:,:), & ! [OUT]
503  sflx_mv(:,:), & ! [OUT]
504  sflx_sh(:,:), & ! [OUT]
505  sflx_lh(:,:), & ! [OUT]
506  sflx_gh(:,:), & ! [OUT]
507  sflx_qtrc(:,:,:), & ! [OUT]
508  u10(:,:), & ! [OUT]
509  v10(:,:), & ! [OUT]
510  t2(:,:), & ! [OUT]
511  q2(:,:) ) ! [OUT]
512  endif
513 
514  return
515  end subroutine atmos_surface_get
516 
517  !-----------------------------------------------------------------------------
519  subroutine atmos_surface_set( countup )
520  use scale_grid_real, only: &
521  real_cz, &
522  real_z1
523  use scale_topography, only: &
524  topo_zsfc
525  use scale_atmos_bottom, only: &
526  bottom_estimate => atmos_bottom_estimate
527  use mod_atmos_vars, only: &
528  dens, &
529  qtrc, &
530  temp, &
531  pres, &
532  w, &
533  u, &
534  v
535  use mod_atmos_phy_mp_vars, only: &
536  sflx_rain_mp => atmos_phy_mp_sflx_rain, &
537  sflx_snow_mp => atmos_phy_mp_sflx_snow
538  use mod_atmos_phy_cp_vars, only: &
539  sflx_rain_cp => atmos_phy_cp_sflx_rain
540  use mod_atmos_phy_rd_vars, only: &
541  sflx_rad_dn => atmos_phy_rd_sflx_downall, &
542  cossza => atmos_phy_rd_cossza
543  use mod_cpl_admin, only: &
544  cpl_sw
545  use mod_cpl_vars, only: &
546  cpl_putatm
547  implicit none
548 
549  ! arguments
550  logical, intent(in) :: countup
551 
552  ! works
553  real(RP) :: sfc_dens(ia,ja)
554  real(RP) :: sfc_pres(ia,ja)
555  real(RP) :: atm_pbl (ia,ja)
556 
557  real(RP) :: sflx_rain(ia,ja)
558  real(RP) :: sflx_snow(ia,ja)
559 
560  integer :: i,j
561  !---------------------------------------------------------------------------
562 
563  if ( cpl_sw ) then
564  ! sum of rainfall from mp and cp
565  !$omp parallel do private(i,j) OMP_SCHEDULE_
566  do j = 1, ja
567  do i = 1, ia
568  sflx_rain(i,j) = sflx_rain_mp(i,j) + sflx_rain_cp(i,j)
569  sflx_snow(i,j) = sflx_snow_mp(i,j)
570  enddo
571  enddo
572 
573  ! planetary boundary layer
574  atm_pbl(:,:) = 100.0_rp ! tentative
575 
576  call bottom_estimate( dens(:,:,:), & ! [IN]
577  pres(:,:,:), & ! [IN]
578  real_cz(:,:,:), & ! [IN]
579  topo_zsfc(:,:), & ! [IN]
580  real_z1(:,:), & ! [IN]
581  sfc_dens(:,:), & ! [OUT]
582  sfc_pres(:,:) ) ! [OUT]
583 
584  call cpl_putatm( temp(ks,:,:), & ! [IN]
585  pres(ks,:,:), & ! [IN]
586  w(ks,:,:), & ! [IN]
587  u(ks,:,:), & ! [IN]
588  v(ks,:,:), & ! [IN]
589  dens(ks,:,:), & ! [IN]
590  qtrc(ks,:,:,:), & ! [IN]
591  atm_pbl(:,:), & ! [IN]
592  sfc_pres(:,:), & ! [IN]
593  sflx_rad_dn(:,:,:,:), & ! [IN]
594  cossza(:,:), & ! [IN]
595  sflx_rain(:,:), & ! [IN]
596  sflx_snow(:,:), & ! [IN]
597  countup ) ! [IN]
598  endif
599 
600  return
601  end subroutine atmos_surface_set
602 
603 end module mod_atmos_driver
module ATMOS admin
real(rp), dimension(:,:,:), allocatable, public dens_tp
logical, public atmos_sw_phy_cp
subroutine, public atmos_phy_cp_driver_resume
Redume.
real(rp), dimension(:,:,:), allocatable, target, public momz
module Atmosphere / Physics Cumulus
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_z0e
subroutine, public atmos_surface_set(countup)
Set surface boundary condition.
real(rp), dimension(:,:,:), allocatable, public atmos_phy_sf_sflx_qtrc
logical, public time_doatmos_phy_rd
execute physics in this step? (radiation )
subroutine, public atmos_phy_ae_driver_setup
Setup.
subroutine, public atmos_phy_ae_driver(update_flag)
Driver.
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sflx_mw
module GRID (nesting system)
subroutine, public atmos_phy_tb_driver_config
Config.
logical, public atmos_sw_phy_rd
real(rp), dimension(:,:,:), allocatable, target, public rhot
real(rp), dimension(:,:,:), allocatable, public momy_tp
module ATMOSPHERE / Physics Turbulence
subroutine, public atmos_boundary_resume(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
Resume.
subroutine, public atmos_phy_ch_driver_resume
Resume.
subroutine, public cpl_putatm(TEMP, PRES, W, U, V, DENS, QTRC, PBL, SFC_PRES, SFLX_rad_dn, cosSZA, SFLX_rain, SFLX_snow, countup)
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_v10
module Atmosphere / Physics Cloud Microphysics
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:61
module ATMOSPHERE / Physics Cumulus
module ATMOSPHERE / Bottom boundary treatment
real(rp), dimension(:,:,:), allocatable, public pres
module ATMOSPHERE / Physics Radiation
module ATMOSPHERE / Reference state
subroutine, public atmos_phy_sf_driver_resume
Resume.
module ATMOSPHERIC Variables
subroutine, public atmos_phy_ch_driver(update_flag)
Driver.
module ATMOSPHERE / Physics Surface fluxes
real(rp), dimension(:,:,:), allocatable, target, public momx
subroutine, public atmos_phy_mp_driver(update_flag)
Driver.
module STDIO
Definition: scale_stdio.F90:12
subroutine, public atmos_boundary_update(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
Update boundary value with a constant time boundary.
real(rp), dimension(:,:,:), allocatable, public rhot_tp
module ATMOSPHERE / Physics Chemistry
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_temp
subroutine, public atmos_boundary_setup
Setup.
real(rp), dimension(:,:,:), allocatable, public real_cz
geopotential height [m] (cell center)
logical, public atmos_sw_phy_ae
module Atmosphere / Dynamics
real(rp), dimension(:,:,:), allocatable, target, public dens
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sflx_mv
module ATMOSPHERE / Physics Aerosol Microphysics
subroutine, public atmos_driver_config
Config.
logical, public time_doatmos_phy_mp
execute physics in this step? (microphysics)
real(rp), dimension(:,:), allocatable, public atmos_phy_mp_sflx_rain
subroutine, public atmos_phy_rd_driver_setup
Setup.
subroutine, public cpl_getsfc_atm(SFC_TEMP, SFC_albedo, SFC_Z0M, SFC_Z0H, SFC_Z0E, SFLX_MW, SFLX_MU, SFLX_MV, SFLX_SH, SFLX_LH, SFLX_GH, SFLX_QTRC, U10, V10, T2, Q2)
subroutine, public atmos_dyn_driver(do_flag)
Dynamical Process (Wrapper)
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_cossza
module Atmosphere / Physics Radiation
module grid index
module ATMOSPHERIC Surface Variables
subroutine, public atmos_dyn_driver_setup
Setup.
subroutine, public atmos_boundary_finalize
Finalize boundary value.
logical, public atmos_sw_phy_tb
subroutine, public atmos_surface_get
Get surface boundary condition.
integer, public ia
of whole cells: x, local, with HALO
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_u10
real(rp), dimension(:,:,:), allocatable, public temp
logical, public atmos_refstate_update_flag
real(rp), dimension(:,:), allocatable, public real_z1
Height of the lowermost grid from surface (cell center) [m].
module GRID (real space)
subroutine, public atmos_phy_cp_driver_setup
Setup.
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_z0h
subroutine, public atmos_solarins_setup(iyear)
setup solar incidence module
subroutine, public atmos_refstate_update(DENS, RHOT, QTRC)
Update reference state profile (Horizontal average)
subroutine, public atmos_refstate_setup
Setup.
module COUPLER Variables
real(rp), dimension(:,:,:,:), allocatable, public rhoq_tp
real(rp), dimension(:,:,:), allocatable, public atmos_phy_sf_sfc_albedo
logical, public atmos_sw_dyn
module ATMOSPHERE driver
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sflx_lh
subroutine, public atmos_phy_sf_driver_setup
Setup.
subroutine, public atmos_driver_resume1
Resume.
module TIME
Definition: scale_time.F90:15
logical, public atmos_sw_phy_sf
logical, public time_doatmos_phy_ch
execute physics in this step? (chemistry )
logical, public atmos_sw_phy_ch
subroutine, public atmos_driver_setup
Setup.
subroutine, public atmos_phy_mp_driver_setup
Setup.
logical, public time_doatmos_phy_cp
execute physics in this step? (cumulus )
logical, public cpl_sw
subroutine, public atmos_phy_cp_driver(update_flag)
Driver.
subroutine, public atmos_phy_ae_driver_resume
Resume.
logical, public atmos_sw_phy_mp
subroutine, public atmos_bottom_estimate(DENS, PRES, CZ, Zsfc, Z1, SFC_DENS, SFC_PRES)
Calc bottom boundary of atmosphere (just above surface)
integer, public ks
start point of inner domain: z, local
subroutine, public atmos_phy_tb_driver_setup
Setup.
logical, public atmos_boundary_update_flag
real(rp), dimension(:,:,:), allocatable, public momx_tp
real(rp), dimension(:,:,:), allocatable, target, public momy
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:156
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_rd_sflx_downall
subroutine, public atmos_vars_monitor
monitor output
real(rp), dimension(:,:), allocatable, public atmos_phy_mp_sflx_snow
real(rp), dimension(:,:,:), allocatable, public momz_tp
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sflx_sh
subroutine, public atmos_phy_rd_driver(update_flag)
Driver.
real(rp), dimension(:,:,:), allocatable, public v
module profiler
Definition: scale_prof.F90:10
logical, public time_doatmos_phy_ae
execute physics in this step? (aerosol )
real(rp), dimension(:,:,:), allocatable, public w
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_q2
subroutine, public atmos_phy_ch_driver_setup
Setup.
subroutine, public atmos_driver_finalize
Finalize.
subroutine, public atmos_vars_history_setpres
Set pressure for history output.
module PRECISION
logical, public time_doatmos_phy_tb
execute physics in this step? (turbulence )
real(rp), dimension(:,:), allocatable, public topo_zsfc
absolute ground height [m]
subroutine, public atmos_phy_rd_driver_resume
Resume.
real(rp), dimension(:,:,:), allocatable, public u
module ATMOSPHERE / Boundary treatment
module TOPOGRAPHY
module ADMIN TIME
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_z0m
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_t2
subroutine, public atmos_phy_ae_driver_config
Config.
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
Definition: scale_time.F90:65
subroutine, public atmos_driver
advance atmospheric state
subroutine, public atmos_refstate_resume(DENS, RHOT, QTRC)
Resume.
subroutine, public atmos_phy_tb_driver(update_flag)
Driver.
logical, public time_doatmos_dyn
execute dynamics in this step?
subroutine, public atmos_vars_history
History output set for atmospheric variables.
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
logical, public time_doatmos_phy_sf
execute physics in this step? (surface flux)
module Coupler admin
subroutine, public atmos_phy_mp_driver_resume
resume
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sflx_gh
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sflx_mu
module ATMOSPHERE / Physics Cloud Microphysics
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:204
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_sflx_rain
subroutine, public atmos_driver_resume2
Setup.
subroutine, public atmos_phy_tb_driver_resume
Resume.
subroutine, public atmos_phy_mp_driver_config
Config.
subroutine, public nest_comm_disconnect()
[finalize: disconnect] Inter-communication
subroutine, public atmos_vars_diagnostics
Calc diagnostic variables.
real(rp), dimension(:,:,:,:), allocatable, target, public qtrc
subroutine, public atmos_phy_sf_driver(update_flag)
Driver.
integer, public ja
of whole cells: y, local, with HALO