SCALE-RM
mod_mkinit.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 #include "scalelib.h"
12 module mod_mkinit
13  !-----------------------------------------------------------------------------
14  !
15  !++ used modules
16  !
17  use scale_precision
18  use scale_io
19  use scale_prof
20  use scale_atmos_grid_cartesc_index
21  use scale_tracer
22  use scale_cpl_sfc_index
23 
24  use scale_prc, only: &
25  prc_abort
26  use scale_const, only: &
27  pi => const_pi, &
28  grav => const_grav, &
29  pstd => const_pstd, &
30  rdry => const_rdry, &
31  rvap => const_rvap, &
32  cpdry => const_cpdry, &
33  p00 => const_pre00
34  use scale_random, only: &
35  random_uniform
36  use scale_comm_cartesc, only: &
37  comm_vars8, &
38  comm_wait
39  use scale_atmos_grid_cartesc, only: &
40  cz => atmos_grid_cartesc_cz, &
41  cx => atmos_grid_cartesc_cx, &
42  cy => atmos_grid_cartesc_cy, &
43  fz => atmos_grid_cartesc_fz, &
44  fx => atmos_grid_cartesc_fx, &
45  fy => atmos_grid_cartesc_fy, &
46  cxg => atmos_grid_cartesc_cxg, &
47  fxg => atmos_grid_cartesc_fxg, &
48  fyg => atmos_grid_cartesc_fyg
49  use scale_atmos_grid_cartesc_real, only: &
50  real_cz => atmos_grid_cartesc_real_cz, &
51  real_fz => atmos_grid_cartesc_real_fz, &
52  area => atmos_grid_cartesc_real_area
53  use scale_atmos_profile, only: &
54  profile_isa => atmos_profile_isa
55  use scale_atmos_hydrometeor, only: &
56  hydrometeor_lhv => atmos_hydrometeor_lhv
57  use scale_atmos_hydrostatic, only: &
58  hydrostatic_buildrho => atmos_hydrostatic_buildrho, &
59  hydrostatic_buildrho_atmos => atmos_hydrostatic_buildrho_atmos, &
60  hydrostatic_buildrho_bytemp => atmos_hydrostatic_buildrho_bytemp
61  use scale_atmos_saturation, only: &
62  saturation_pres2qsat_all => atmos_saturation_pres2qsat_all, &
63  saturation_psat_all => atmos_saturation_psat_all
64  use mod_atmos_vars, only: &
65  dens, &
66  momx, &
67  momy, &
68  momz, &
69  rhot, &
70  qtrc
71  use mod_atmos_phy_ae_vars, only: &
72  ccn => atmos_phy_ae_ccn
73  !-----------------------------------------------------------------------------
74  implicit none
75  private
76  !-----------------------------------------------------------------------------
77  !
78  !++ Public procedure
79  !
80  public :: mkinit_setup
81  public :: mkinit_finalize
82  public :: mkinit
83 
84  !-----------------------------------------------------------------------------
85  !
86  !++ Public parameters & variables
87  !
88  integer, public :: mkinit_type = -1
89  integer, public, parameter :: i_ignore = 0
90 
91  integer, public, parameter :: i_planestate = 1
92  integer, public, parameter :: i_tracerbubble = 2
93  integer, public, parameter :: i_coldbubble = 3
94 
95  integer, public, parameter :: i_lambwave = 4
96  integer, public, parameter :: i_gravitywave = 5
97  integer, public, parameter :: i_khwave = 6
98  integer, public, parameter :: i_turbulence = 7
99  integer, public, parameter :: i_mountainwave = 8
100 
101  integer, public, parameter :: i_warmbubble = 9
102  integer, public, parameter :: i_supercell = 10
103  integer, public, parameter :: i_squallline = 11
104  integer, public, parameter :: i_wk1982 = 12
105  integer, public, parameter :: i_dycoms2_rf01 = 13
106  integer, public, parameter :: i_dycoms2_rf02 = 14
107  integer, public, parameter :: i_rico = 15
108 
109  integer, public, parameter :: i_interporation = 16
110 
111  integer, public, parameter :: i_landcouple = 17
112  integer, public, parameter :: i_oceancouple = 18
113  integer, public, parameter :: i_urbancouple = 19
114  integer, public, parameter :: i_triplecouple = 20
115  integer, public, parameter :: i_bubblecouple = 21
116 
117  integer, public, parameter :: i_seabreeze = 22
118  integer, public, parameter :: i_heatisland = 23
119 
120  integer, public, parameter :: i_dycoms2_rf02_dns = 24
121 
122  integer, public, parameter :: i_real = 25
123 
124  integer, public, parameter :: i_grayzone = 26
125  integer, public, parameter :: i_boxaero = 27
126  integer, public, parameter :: i_warmbubbleaero = 28
127 
128  integer, public, parameter :: i_cavityflow = 29
129  integer, public, parameter :: i_barocwave = 30
130  integer, public, parameter :: i_bomex = 31
131 
132  !-----------------------------------------------------------------------------
133  !
134  !++ Private procedure
135  !
136  private :: bubble_setup
137  private :: sbmaero_setup
138  private :: aerosol_setup
139 
140  private :: mkinit_planestate
141  private :: mkinit_tracerbubble
142  private :: mkinit_coldbubble
143  private :: mkinit_lambwave
144  private :: mkinit_gravitywave
145  private :: mkinit_khwave
146  private :: mkinit_turbulence
147  private :: mkinit_cavityflow
148  private :: mkinit_mountainwave
149  private :: mkinit_barocwave
150 
151  private :: mkinit_warmbubble
152  private :: mkinit_supercell
153  private :: mkinit_squallline
154  private :: mkinit_wk1982
155  private :: mkinit_dycoms2_rf01
156  private :: mkinit_dycoms2_rf02
157  private :: mkinit_rico
158  private :: mkinit_bomex
159 
160  private :: mkinit_landcouple
161  private :: mkinit_oceancouple
162  private :: mkinit_urbancouple
163  private :: mkinit_seabreeze
164  private :: mkinit_heatisland
165 
166  private :: mkinit_dycoms2_rf02_dns
167 
168  private :: mkinit_real
169 
170  private :: mkinit_grayzone
171 
172  private :: mkinit_boxaero
173  private :: mkinit_warmbubbleaero
174 
175  !-----------------------------------------------------------------------------
176  !
177  !++ Private parameters & variables
178  !
179  integer, private, parameter :: niter_rh = 4
180  real(rp), private, parameter :: thetastd = 300.0_rp ! [K]
181 
182  real(rp), private, allocatable :: pres (:,:,:) ! pressure [Pa]
183  real(rp), private, allocatable :: temp (:,:,:) ! temperature [K]
184  real(rp), private, allocatable :: pott (:,:,:) ! potential temperature [K]
185  real(rp), private, allocatable :: psat (:,:,:) ! satulated water vapor [kg/kg]
186  real(rp), private, allocatable :: qv (:,:,:) ! water vapor [kg/kg]
187  real(rp), private, allocatable :: qc (:,:,:) ! cloud water [kg/kg]
188  real(rp), private, allocatable :: nc (:,:,:) ! cloud water number density [1/kg]
189  real(rp), private, allocatable :: velx (:,:,:) ! velocity u [m/s]
190  real(rp), private, allocatable :: vely (:,:,:) ! velocity v [m/s]
191  real(rp), private, allocatable :: ptrc (:,:,:) ! passive tracer
192 
193  real(rp), private, allocatable :: pres_sfc(:,:) ! surface pressure [Pa]
194  real(rp), private, allocatable :: temp_sfc(:,:) ! surface temperature [K]
195  real(rp), private, allocatable :: pott_sfc(:,:) ! surface potential temperature [K]
196  real(rp), private, allocatable :: qsat_sfc(:,:) ! surface satulated water vapor [kg/kg]
197  real(rp), private, allocatable :: qv_sfc (:,:) ! surface water vapor [kg/kg]
198  real(rp), private, allocatable :: qc_sfc (:,:) ! surface cloud water [kg/kg]
199 
200  real(rp), private, allocatable :: rndm (:,:,:) ! random number (0-1)
201  real(rp), private, allocatable, target :: bubble (:,:,:) ! bubble factor (0-1)
202  real(rp), private, allocatable, target :: rect (:,:,:) ! rectangle factor (0-1)
203  real(rp), private, allocatable :: gan (:) ! gamma factor (0-1)
204 
205  !-----------------------------------------------------------------------------
206 contains
207  !-----------------------------------------------------------------------------
209  subroutine mkinit_setup
210  implicit none
211 
212  character(len=H_SHORT) :: mkinit_initname = 'NONE'
213 
214  namelist / param_mkinit / &
215  mkinit_initname
216 
217  integer :: ierr
218  !---------------------------------------------------------------------------
219 
220  log_newline
221  log_info("MKINIT_setup",*) 'Setup'
222 
223  !--- read namelist
224  rewind(io_fid_conf)
225  read(io_fid_conf,nml=param_mkinit,iostat=ierr)
226  if( ierr < 0 ) then !--- missing
227  log_info("MKINIT_setup",*) 'Not found namelist. Default used.'
228  elseif( ierr > 0 ) then !--- fatal error
229  log_error("MKINIT_setup",*) 'Not appropriate names in namelist PARAM_MKINIT. Check!'
230  call prc_abort
231  endif
232  log_nml(param_mkinit)
233 
234  allocate( pres(ka,ia,ja) )
235  allocate( temp(ka,ia,ja) )
236  allocate( pott(ka,ia,ja) )
237  allocate( psat(ka,ia,ja) )
238  allocate( qv(ka,ia,ja) )
239  allocate( qc(ka,ia,ja) )
240  allocate( nc(ka,ia,ja) )
241  allocate( velx(ka,ia,ja) )
242  allocate( vely(ka,ia,ja) )
243  allocate( ptrc(ka,ia,ja) )
244 
245  allocate( pres_sfc(ia,ja) )
246  allocate( temp_sfc(ia,ja) )
247  allocate( pott_sfc(ia,ja) )
248  allocate( qsat_sfc(ia,ja) )
249  allocate( qv_sfc(ia,ja) )
250  allocate( qc_sfc(ia,ja) )
251 
252  allocate( rndm(ka,ia,ja) )
253  allocate( bubble(ka,ia,ja) )
254  allocate( rect(ka,ia,ja) )
255 
256  !$acc enter data create(pres,temp,pott,psat,qv,qc,nc,velx,vely,ptrc,pres_sfc,temp_sfc,pott_sfc,qsat_sfc,qv_sfc,qc_sfc,rndm,bubble,rect)
257 
258  select case(trim(mkinit_initname))
259  case('NONE')
260  mkinit_type = i_ignore
261  case('PLANESTATE')
262  mkinit_type = i_planestate
263  case('TRACERBUBBLE')
264  mkinit_type = i_tracerbubble
265  case('COLDBUBBLE')
266  mkinit_type = i_coldbubble
267  call bubble_setup
268  case('LAMBWAVE')
269  mkinit_type = i_lambwave
270  call bubble_setup
271  case('GRAVITYWAVE')
272  mkinit_type = i_gravitywave
273  call bubble_setup
274  case('KHWAVE')
275  mkinit_type = i_khwave
276  case('TURBULENCE')
277  mkinit_type = i_turbulence
278  case('MOUNTAINWAVE')
279  mkinit_type = i_mountainwave
280  call bubble_setup
281  case('WARMBUBBLE')
282  mkinit_type = i_warmbubble
283  call bubble_setup
284  case('SUPERCELL')
285  mkinit_type = i_supercell
286  call bubble_setup
287  case('SQUALLLINE')
288  mkinit_type = i_squallline
289  case('WK1982')
290  mkinit_type = i_wk1982
291  call bubble_setup
292  case('DYCOMS2_RF01')
293  mkinit_type = i_dycoms2_rf01
294  case('DYCOMS2_RF02')
295  mkinit_type = i_dycoms2_rf02
296  case('RICO')
297  mkinit_type = i_rico
298  case('BOMEX')
299  mkinit_type = i_bomex
300  case('INTERPORATION')
301  mkinit_type = i_interporation
302  case('LANDCOUPLE')
303  mkinit_type = i_landcouple
304  case('OCEANCOUPLE')
305  mkinit_type = i_oceancouple
306  case('URBANCOUPLE')
307  mkinit_type = i_urbancouple
308  case('TRIPLECOUPLE')
309  mkinit_type = i_triplecouple
310  case('BUBBLECOUPLE')
311  mkinit_type = i_bubblecouple
312  call bubble_setup
313  case('SEABREEZE')
314  mkinit_type = i_seabreeze
315  case('HEATISLAND')
316  mkinit_type = i_heatisland
317  case('DYCOMS2_RF02_DNS')
318  mkinit_type = i_dycoms2_rf02_dns
319  case('REAL')
320  mkinit_type = i_real
321  case('GRAYZONE')
322  mkinit_type = i_grayzone
323  case('BOXAERO')
324  mkinit_type = i_boxaero
325  case('WARMBUBBLEAERO')
326  mkinit_type = i_warmbubbleaero
327  call bubble_setup
328  case('CAVITYFLOW')
329  mkinit_type = i_cavityflow
330  case('BAROCWAVE')
331  mkinit_type = i_barocwave
332  case default
333  log_error("MKINIT_setup",*) 'Unsupported TYPE:', trim(mkinit_initname)
334  call prc_abort
335  endselect
336 
337  return
338  end subroutine mkinit_setup
339 
340  !-----------------------------------------------------------------------------
342  subroutine mkinit_finalize
343  implicit none
344  !---------------------------------------------------------------------------
345 
346  log_newline
347  log_info("MKINIT_finalize",*) 'Finalize'
348 
349  !$acc exit data delete(pres,temp,pott,psat,qv,qc,nc,velx,vely,ptrc,pres_sfc,temp_sfc,pott_sfc,qsat_sfc,qv_sfc,qc_sfc,rndm,bubble,rect)
350 
351  deallocate( pres )
352  deallocate( temp )
353  deallocate( pott )
354  deallocate( psat )
355  deallocate( qv )
356  deallocate( qc )
357  deallocate( nc )
358  deallocate( velx )
359  deallocate( vely )
360  deallocate( ptrc )
361 
362  deallocate( pres_sfc )
363  deallocate( temp_sfc )
364  deallocate( pott_sfc )
365  deallocate( qsat_sfc )
366  deallocate( qv_sfc )
367  deallocate( qc_sfc )
368 
369  deallocate( rndm )
370  deallocate( bubble )
371  deallocate( rect )
372 
373  return
374  end subroutine mkinit_finalize
375 
376  !-----------------------------------------------------------------------------
378  subroutine mkinit( output )
379  use scale_const, only: &
380  undef => const_undef
381  use scale_atmos_hydrometeor, only: &
382  atmos_hydrometeor_dry, &
383  n_hyd, &
384  i_hc
385  use mod_atmos_phy_mp_vars, only: &
386  qs_mp, &
387  qe_mp
388  use mod_atmos_phy_mp_driver, only: &
389  atmos_phy_mp_driver_qhyd2qtrc
390  implicit none
391  logical, intent(out) :: output
392 
393  real(rp) :: qhyd(ka,ia,ja,n_hyd)
394  real(rp) :: qnum(ka,ia,ja,n_hyd)
395 
396  logical :: convert_qtrc
397  integer :: k, i, j, iq
398  !---------------------------------------------------------------------------
399 
400  if ( mkinit_type == i_ignore ) then
401  log_newline
402  log_progress(*) 'skip making initial data'
403  output = .false.
404  else
405  log_newline
406  log_progress(*) 'start making initial data'
407 
408  !--- Initialize variables
409  !$omp workshare
410  !$acc kernels
411  pres(:,:,:) = undef
412  temp(:,:,:) = undef
413  pott(:,:,:) = undef
414  psat(:,:,:) = undef
415  velx(:,:,:) = undef
416  vely(:,:,:) = undef
417 
418  rndm(:,:,:) = undef
419  !$acc end kernels
420 
421  !$acc kernels
422  pres_sfc(:,:) = undef
423  temp_sfc(:,:) = undef
424  pott_sfc(:,:) = undef
425  qsat_sfc(:,:) = undef
426  !$acc end kernels
427 
428  !$acc kernels
429  qv(:,:,:) = 0.0_rp
430  qc(:,:,:) = 0.0_rp
431  nc(:,:,:) = 0.0_rp
432  !$acc end kernels
433  !$acc kernels
434  qv_sfc(:,:) = 0.0_rp
435  qc_sfc(:,:) = 0.0_rp
436  !$acc end kernels
437 
438  !$acc kernels
439  ptrc(:,:,:) = undef
440  !$acc end kernels
441 
442  !$acc kernels
443 !OCL XFILL
444  qtrc(:,:,:,:) = undef
445 !OCL XFILL
446  qhyd(:,:,:,:) = 0.0_rp
447 !OCL XFILL
448  qnum(:,:,:,:) = 0.0_rp
449  !$acc end kernels
450  !$omp end workshare
451 
452  call prof_rapstart('_MkInit_main',3)
453 
454  convert_qtrc = .true.
455 
456  select case(mkinit_type)
457  case(i_planestate)
458  call mkinit_planestate
459  case(i_tracerbubble)
460  call mkinit_tracerbubble
461  case(i_coldbubble)
462  call mkinit_coldbubble
463  case(i_lambwave)
464  call mkinit_lambwave
465  case(i_gravitywave)
466  call mkinit_gravitywave
467  case(i_khwave)
468  call mkinit_khwave
469  case(i_turbulence)
470  call mkinit_turbulence
471  case(i_mountainwave)
472  call mkinit_mountainwave
473  case(i_warmbubble)
474  call mkinit_warmbubble
475  case(i_supercell)
476  call mkinit_supercell
477  case(i_squallline)
478  call mkinit_squallline
479  case(i_wk1982)
480  call mkinit_wk1982
481  case(i_dycoms2_rf01)
482  call mkinit_dycoms2_rf01
483  case(i_dycoms2_rf02)
484  call mkinit_dycoms2_rf02
485  case(i_rico)
486  call mkinit_rico
487  case(i_bomex)
488  call mkinit_bomex
489  case(i_oceancouple)
490  call mkinit_planestate
491  call mkinit_oceancouple
492  case(i_landcouple)
493  call mkinit_planestate
494  call mkinit_landcouple
495  case(i_urbancouple)
496  call mkinit_planestate
497  call mkinit_urbancouple
498  case(i_triplecouple)
499  call mkinit_planestate
500  call mkinit_oceancouple
501  call mkinit_landcouple
502  call mkinit_urbancouple
503  case(i_bubblecouple)
504  call mkinit_planestate
505  call mkinit_warmbubble
506  call mkinit_oceancouple
507  call mkinit_landcouple
508  call mkinit_urbancouple
509  case(i_seabreeze)
510  call mkinit_planestate
511  call mkinit_seabreeze
512  case(i_heatisland)
513  call mkinit_planestate
514  call mkinit_heatisland
515  case(i_dycoms2_rf02_dns)
516  call mkinit_dycoms2_rf02_dns
517  case(i_real)
518  call mkinit_real
519  convert_qtrc = .false.
520  case(i_grayzone)
521  call mkinit_grayzone
522  case(i_boxaero)
523  call mkinit_boxaero
524  case(i_warmbubbleaero)
525  call mkinit_warmbubbleaero
526  case(i_cavityflow)
527  call mkinit_cavityflow
528  case(i_barocwave)
529  call mkinit_barocwave
530  case default
531  log_error("MKINIT",*) 'Unsupported TYPE:', mkinit_type
532  call prc_abort
533  endselect
534 
535  ! water content
536  if ( ( .not. atmos_hydrometeor_dry ) .AND. convert_qtrc ) then
537  !$acc kernels
538 !OCL XFILL
539  qhyd(:,:,:,i_hc) = qc(:,:,:)
540 !OCL XFILL
541  qnum(:,:,:,i_hc) = nc(:,:,:)
542  !$acc end kernels
543  call atmos_phy_mp_driver_qhyd2qtrc( ka, ks, ke, ia, is, ie, ja, js, je, &
544  qv(:,:,:), qhyd(:,:,:,:), & ! [IN]
545  qtrc(:,:,:,qs_mp:qe_mp), & ! [OUT]
546  qnum=qnum(:,:,:,:) ) ! [IN]
547  end if
548 
549  call tke_setup
550 
551  call aerosol_setup
552 
553  call sbmaero_setup( convert_qtrc ) ! [INOUT]
554 
555  ! passive tracer
556  call tracer_inq_id( "PTracer", iq )
557  if ( iq > 0 ) qtrc(:,:,:,iq) = ptrc(:,:,:)
558 
559  !$omp parallel do collapse(3)
560  !$acc kernels
561  do iq = 1, qa
562  do j = 1, ja
563  do i = 1, ia
564  do k = 1, ka
565  if ( qtrc(k,i,j,iq) == undef ) then
566  qtrc(k,i,j,iq) = 0.0_rp
567  end if
568  end do
569  end do
570  end do
571  end do
572  !$acc end kernels
573 
574  call prof_rapend ('_MkInit_main',3)
575 
576  log_progress(*) 'end making initial data'
577 
578  output = .true.
579 
580  endif
581 
582  return
583  end subroutine mkinit
584 
585  !-----------------------------------------------------------------------------
587  subroutine bubble_setup
588  use scale_const, only: &
589  const_undef8
590  implicit none
591 
592  ! Bubble
593  logical :: bbl_eachnode = .false. ! Arrange bubble at each node? [kg/kg]
594  real(rp) :: bbl_cz = 2.e3_rp ! center location [m]: z
595  real(rp) :: bbl_cx = 2.e3_rp ! center location [m]: x
596  real(rp) :: bbl_cy = 2.e3_rp ! center location [m]: y
597  real(rp) :: bbl_rz = 0.0_rp ! bubble radius [m]: z
598  real(rp) :: bbl_rx = 0.0_rp ! bubble radius [m]: x
599  real(rp) :: bbl_ry = 0.0_rp ! bubble radius [m]: y
600  character(len=H_SHORT) :: bbl_functype = 'COSBELL' ! COSBELL or GAUSSIAN
601 
602  namelist / param_bubble / &
603  bbl_eachnode, &
604  bbl_cz, &
605  bbl_cx, &
606  bbl_cy, &
607  bbl_rz, &
608  bbl_rx, &
609  bbl_ry, &
610  bbl_functype
611 
612  real(rp) :: cz_offset
613  real(rp) :: cx_offset
614  real(rp) :: cy_offset
615  real(rp) :: distx, disty, distz
616 
617  real(rp) :: domain_rx, domain_ry
618 
619  logical :: error
620  integer :: ierr
621  integer :: k, i, j
622  !---------------------------------------------------------------------------
623 
624  log_newline
625  log_info("BUBBLE_setup",*) 'Setup'
626 
627  !--- read namelist
628  rewind(io_fid_conf)
629  read(io_fid_conf,nml=param_bubble,iostat=ierr)
630  if( ierr < 0 ) then !--- missing
631  log_info("BUBBLE_setup",*) 'Not found namelist. Default used.'
632  elseif( ierr > 0 ) then !--- fatal error
633  log_error("BUBBLE_setup",*) 'Not appropriate names in namelist PARAM_BUBBLE. Check!'
634  call prc_abort
635  endif
636  log_nml(param_bubble)
637 
638  if ( abs(bbl_rz*bbl_rx*bbl_ry) <= 0.0_rp ) then
639  log_info("BUBBLE_setup",*) 'no bubble'
640  !$acc kernels
641  bubble(:,:,:) = 0.0_rp
642  !$acc end kernels
643  else
644 
645  !$acc kernels
646  bubble(:,:,:) = const_undef8
647  !$acc end kernels
648 
649  if ( bbl_eachnode ) then
650  cz_offset = cz(ks)
651  cx_offset = cx(is)
652  cy_offset = cy(js)
653  domain_rx = fx(ie) - fx(is-1)
654  domain_ry = fy(je) - fy(js-1)
655  else
656  cz_offset = 0.0_rp
657  cx_offset = 0.0_rp
658  cy_offset = 0.0_rp
659  domain_rx = fxg(iag-ihalo) - fxg(ihalo)
660  domain_ry = fyg(jag-jhalo) - fyg(jhalo)
661  endif
662 
663  error = .false.
664 
665  ! make bubble coefficient
666  !$acc kernels
667  !$acc loop independent collapse(3) reduction(.or.:error)
668  do j = 1, ja
669  do i = 1, ia
670  do k = ks, ke
671 
672  distz = ( (cz(k)-cz_offset-bbl_cz)/bbl_rz )**2
673 
674  distx = min( ( (cx(i)-cx_offset-bbl_cx )/bbl_rx )**2, &
675  ( (cx(i)-cx_offset-bbl_cx-domain_rx)/bbl_rx )**2, &
676  ( (cx(i)-cx_offset-bbl_cx+domain_rx)/bbl_rx )**2 )
677 
678  disty = min( ( (cy(j)-cy_offset-bbl_cy )/bbl_ry )**2, &
679  ( (cy(j)-cy_offset-bbl_cy-domain_ry)/bbl_ry )**2, &
680  ( (cy(j)-cy_offset-bbl_cy+domain_ry)/bbl_ry )**2 )
681 
682  select case(bbl_functype)
683  case('COSBELL')
684  bubble(k,i,j) = cos( 0.5_rp*pi*sqrt( min(distz+distx+disty,1.0_rp) ) )**2
685  case('GAUSSIAN')
686  bubble(k,i,j) = exp( -(distz+distx+disty) )
687  case default
688 #ifdef _OPENACC
689  log_error("BUBBLE_setup",*) 'Not appropriate BBL_functype. Check!', bbl_functype
690 #else
691  log_error("BUBBLE_setup",*) 'Not appropriate BBL_functype. Check!', trim(bbl_functype)
692  call prc_abort
693 #endif
694  end select
695  enddo
696  enddo
697  enddo
698  !$acc end kernels
699  endif
700 
701  if ( error ) call prc_abort
702 
703  return
704  end subroutine bubble_setup
705 
706  !-----------------------------------------------------------------------------
708  subroutine rect_setup
709  use scale_const, only: &
710  const_undef8
711  implicit none
712 
713  ! Bubble
714  logical :: RCT_eachnode = .false. ! Arrange rectangle at each node? [kg/kg]
715  real(RP) :: RCT_CZ = 2.e3_rp ! center location [m]: z
716  real(RP) :: RCT_CX = 2.e3_rp ! center location [m]: x
717  real(RP) :: RCT_CY = 2.e3_rp ! center location [m]: y
718  real(RP) :: RCT_RZ = 2.e3_rp ! rectangle z width [m]: z
719  real(RP) :: RCT_RX = 2.e3_rp ! rectangle x width [m]: x
720  real(RP) :: RCT_RY = 2.e3_rp ! rectangle y width [m]: y
721 
722  namelist / param_rect / &
723  rct_eachnode, &
724  rct_cz, &
725  rct_cx, &
726  rct_cy, &
727  rct_rz, &
728  rct_rx, &
729  rct_ry
730 
731  real(RP) :: CZ_offset
732  real(RP) :: CX_offset
733  real(RP) :: CY_offset
734  real(RP) :: dist
735 
736  integer :: ierr
737  integer :: k, i, j
738  !---------------------------------------------------------------------------
739 
740  log_newline
741  log_info("RECT_setup",*) 'Setup'
742 
743  !--- read namelist
744  rewind(io_fid_conf)
745  read(io_fid_conf,nml=param_rect,iostat=ierr)
746  if( ierr < 0 ) then !--- missing
747  log_error("RECT_setup",*) 'Not found namelist. Check!'
748  call prc_abort
749  elseif( ierr > 0 ) then !--- fatal error
750  log_error("RECT_setup",*) 'Not appropriate names in namelist PARAM_RECT. Check!'
751  call prc_abort
752  endif
753  log_nml(param_rect)
754 
755  !$acc kernels
756  rect(:,:,:) = const_undef8
757  !$acc end kernels
758 
759  if ( rct_eachnode ) then
760  cz_offset = cz(ks)
761  cx_offset = cx(is)
762  cy_offset = cy(js)
763  else
764  cz_offset = 0.0_rp
765  cx_offset = 0.0_rp
766  cy_offset = 0.0_rp
767  endif
768 
769  !$acc kernels
770  do j = 1, ja
771  do i = 1, ia
772  do k = ks, ke
773 
774  ! make tracer rectangle
775  dist = 2.0_rp * max( &
776  abs(cz(k) - cz_offset - rct_cz)/rct_rz, &
777  abs(cx(i) - cx_offset - rct_cx)/rct_rx, &
778  abs(cy(j) - cy_offset - rct_cy)/rct_ry &
779  & )
780  if ( dist <= 1.0_rp ) then
781  rect(k,i,j) = 1.0_rp
782  else
783  rect(k,i,j) = 0.0_rp
784  end if
785  enddo
786  enddo
787  enddo
788  !$acc end kernels
789 
790  return
791  end subroutine rect_setup
792 
793  !-----------------------------------------------------------------------------
795  subroutine aerosol_setup
796  use mod_atmos_admin, only: &
797  atmos_phy_ae_type
798  use scale_atmos_phy_ae_kajino13, only: &
799  atmos_phy_ae_kajino13_mkinit
800  use scale_atmos_phy_ae_offline, only: &
801  atmos_phy_ae_offline_mkinit
802  use mod_atmos_phy_ae_vars, only: &
803  qa_ae, &
804  qs_ae, &
805  qe_ae
806  implicit none
807 
808  real(RP), parameter :: d_min_def = 1.e-9_rp ! default lower bound of 1st size bin
809  real(RP), parameter :: d_max_def = 1.e-5_rp ! upper bound of last size bin
810  integer, parameter :: n_kap_def = 1 ! number of kappa bins
811  real(RP), parameter :: k_min_def = 0.e0_rp ! lower bound of 1st kappa bin
812  real(RP), parameter :: k_max_def = 1.e0_rp ! upper bound of last kappa bin
813 
814  real(RP) :: ccn_init = 50.e+6_rp ! initial cloud condensation nucrei [#/m3]
815 
816  real(RP) :: m0_init = 0.0_rp ! initial total num. conc. of modes (Atk,Acm,Cor) [#/m3]
817  real(RP) :: dg_init = 80.e-9_rp ! initial number equivalen diameters of modes [m]
818  real(RP) :: sg_init = 1.6_rp ! initial standard deviation [-]
819 
820  real(RP) :: d_min_inp(3) = d_min_def
821  real(RP) :: d_max_inp(3) = d_max_def
822  real(RP) :: k_min_inp(3) = k_min_def
823  real(RP) :: k_max_inp(3) = k_max_def
824  integer :: n_kap_inp(3) = n_kap_def
825 
826  real(RP) :: qdry(KA,IA,JA)
827 
828  namelist / param_aero / &
829  ccn_init, &
830  m0_init, &
831  dg_init, &
832  sg_init, &
833  d_min_inp, &
834  d_max_inp, &
835  k_min_inp, &
836  k_max_inp, &
837  n_kap_inp
838 
839  integer :: ierr
840  !---------------------------------------------------------------------------
841 
842  if ( atmos_phy_ae_type /= 'OFF' .AND. atmos_phy_ae_type /= 'NONE' ) then
843 
844  log_newline
845  log_info("AEROSOL_setup",*) 'Setup'
846 
847  !--- read namelist
848  rewind(io_fid_conf)
849  read(io_fid_conf,nml=param_aero,iostat=ierr)
850  if( ierr < 0 ) then !--- missing
851  log_info("AEROSOL_setup",*) 'Not found namelist. Default used!'
852  elseif( ierr > 0 ) then !--- fatal error
853  log_error("AEROSOL_setup",*) 'Not appropriate names in namelist PARAM_AERO. Check!'
854  call prc_abort
855  endif
856  log_nml(param_aero)
857 
858  select case ( atmos_phy_ae_type )
859  case ( 'KAJINO13' )
860  !$acc data create(qdry)
861  !$acc kernels
862  qdry(:,:,:) = 1.0_rp - qv(:,:,:) - qc(:,:,:)
863  !$acc end kernels
864  !$acc update host(dens,temp,pres,qdry,qv)
865  call atmos_phy_ae_kajino13_mkinit( ka, ks, ke, ia, is, ie, ja, js, je, & ! (in)
866  qa_ae, & ! (in)
867  dens(:,:,:), & ! (in)
868  temp(:,:,:), & ! (in)
869  pres(:,:,:), & ! (in)
870  qdry(:,:,:), & ! (in)
871  qv(:,:,:), & ! (in)
872  m0_init, & ! (in)
873  dg_init, & ! (in)
874  sg_init, & ! (in)
875  d_min_inp(:), & ! (in)
876  d_max_inp(:), & ! (in)
877  k_min_inp(:), & ! (in)
878  k_max_inp(:), & ! (in)
879  n_kap_inp(:), & ! (in)
880  qtrc(:,:,:,qs_ae:qe_ae), & ! (out)
881  ccn(:,:,:) ) ! (out)
882  !$acc update device(QTRC(:,:,:,QS_AE:QE_AE),CCN)
883  !$acc end data
884  case ( 'OFFLINE' )
885  call atmos_phy_ae_offline_mkinit ( ka, ks, ke, ia, is, ie, ja, js, je, & ! (in)
886  ccn_init, & ! (in)
887  ccn(:,:,:) ) ! (out)
888  case default
889  !$acc kernels
890  ccn(:,:,:) = ccn_init
891  !$acc end kernels
892  end select
893 
894  endif
895 
896  return
897  end subroutine aerosol_setup
898 
899  !-----------------------------------------------------------------------------
901  subroutine sbmaero_setup( convert_qtrc )
902  use scale_atmos_hydrometeor, only: &
903  i_qv, &
904  qhe
905  use mod_atmos_admin, only: &
906  atmos_phy_mp_type
907  use scale_atmos_phy_mp_suzuki10, only: &
908  nccn
909  implicit none
910 
911  logical, intent(inout) :: convert_qtrc
912 
913  integer :: iq, i, j, k
914  !---------------------------------------------------------------------------
915 
916  if ( atmos_phy_mp_type /= 'SUZUKI10' ) return
917 
918  if ( .not. convert_qtrc ) return
919 
920  !--- Super saturated air at initial
921  !$acc kernels
922  do j = jsb, jeb
923  do i = isb, ieb
924  do k = ks, ke
925  qtrc(k,i,j,i_qv) = qv(k,i,j) + qc(k,i,j)
926  end do
927  end do
928  end do
929  !$acc end kernels
930 
931  !-- Aerosol distribution
932  if ( nccn /= 0 ) then
933  !$acc kernels
934  !$acc loop collapse(4) independent
935  do iq = 1, nccn
936  do j = jsb, jeb
937  do i = isb, ieb
938  do k = ks, ke
939  qtrc(k,i,j,qhe+iq) = gan(iq) / dens(k,i,j) ! [note] gan is never set.
940  enddo
941  enddo
942  enddo
943  enddo
944  !$acc end kernels
945  endif
946 
947  convert_qtrc = .false.
948 
949  return
950  end subroutine sbmaero_setup
951 
952  !-----------------------------------------------------------------------------
953  function faero( f0,r0,x,alpha,rhoa )
954  use scale_const, only: &
955  pi => const_pi
956  implicit none
957 
958  real(rp), intent(in) :: x, f0, r0, alpha, rhoa
959  real(rp) :: faero
960  real(rp) :: rad
961  !---------------------------------------------------------------------------
962 
963  rad = ( exp(x) * 3.0_rp / 4.0_rp / pi / rhoa )**(1.0_rp/3.0_rp)
964 
965  faero = f0 * (rad/r0)**(-alpha)
966 
967  return
968  end function faero
969 
970  !-----------------------------------------------------------------------------
972  subroutine flux_setup
973  use mod_atmos_phy_mp_vars, only: &
974  sflx_rain => atmos_phy_mp_sflx_rain, &
975  sflx_snow => atmos_phy_mp_sflx_snow
976  use mod_atmos_phy_rd_vars, only: &
977  sflx_lw_up => atmos_phy_rd_sflx_lw_up, &
978  sflx_lw_dn => atmos_phy_rd_sflx_lw_dn, &
979  sflx_sw_up => atmos_phy_rd_sflx_sw_up, &
980  sflx_sw_dn => atmos_phy_rd_sflx_sw_dn
981  implicit none
982 
983  ! Flux from Atmosphere
984  real(RP) :: FLX_rain = 0.0_rp ! surface rain flux [kg/m2/s]
985  real(RP) :: FLX_snow = 0.0_rp ! surface snow flux [kg/m2/s]
986  real(RP) :: FLX_IR_dn = 0.0_rp ! surface downwad radiation flux [J/m2/s]
987  real(RP) :: FLX_NIR_dn = 0.0_rp ! surface downwad radiation flux [J/m2/s]
988  real(RP) :: FLX_VIS_dn = 0.0_rp ! surface downwad radiation flux [J/m2/s]
989 
990  namelist / param_mkinit_flux / &
991  flx_rain, &
992  flx_snow, &
993  flx_ir_dn, &
994  flx_nir_dn, &
995  flx_vis_dn
996 
997  integer :: i, j
998  integer :: ierr
999  !---------------------------------------------------------------------------
1000 
1001  !--- read namelist
1002  rewind(io_fid_conf)
1003  read(io_fid_conf,nml=param_mkinit_flux,iostat=ierr)
1004  if( ierr < 0 ) then !--- missing
1005  log_info("flux_setup",*) 'Not found namelist. Default used.'
1006  elseif( ierr > 0 ) then !--- fatal error
1007  log_error("flux_setup",*) 'Not appropriate names in namelist PARAM_MKINIT_FLUX. Check!'
1008  call prc_abort
1009  endif
1010  log_nml(param_mkinit_flux)
1011 
1012  !$acc kernels
1013  do j = jsb, jeb
1014  do i = isb, ieb
1015  sflx_rain(i,j) = flx_rain
1016  sflx_snow(i,j) = flx_snow
1017 
1018  sflx_lw_up(i,j) = 0.0_rp
1019  sflx_lw_dn(i,j) = flx_ir_dn
1020  sflx_sw_up(i,j) = 0.0_rp
1021  sflx_sw_dn(i,j) = flx_nir_dn + flx_vis_dn
1022  enddo
1023  enddo
1024  !$acc end kernels
1025 
1026  return
1027  end subroutine flux_setup
1028 
1029  !-----------------------------------------------------------------------------
1031  subroutine land_setup
1032  use mod_land_vars, only: &
1033  land_temp, &
1034  land_water, &
1035  land_ice, &
1036  land_sfc_temp, &
1037  land_sfc_albedo, &
1038  snow_flag, &
1039  snow_sfc_temp, &
1040  snow_swe, &
1041  snow_depth, &
1042  snow_dzero, &
1043  snow_nosnowsec
1044  implicit none
1045 
1046  real(RP) :: LND_TEMP ! land soil temperature [K]
1047  real(RP) :: LND_WATER = 0.15_rp ! land soil moisture [m3/m3]
1048  real(RP) :: LND_ICE = 0.00_rp ! land soil ice [m3/m3]
1049  real(RP) :: SFC_TEMP ! land skin temperature [K]
1050  real(RP) :: SFC_albedo_LW = 0.01_rp ! land surface albedo for LW (0-1)
1051  real(RP) :: SFC_albedo_SW = 0.20_rp ! land surface albedo for SW (0-1)
1052 
1053  namelist / param_mkinit_land / &
1054  lnd_temp, &
1055  lnd_water, &
1056  lnd_ice, &
1057  sfc_temp, &
1058  sfc_albedo_lw, &
1059  sfc_albedo_sw
1060 
1061  integer :: ierr
1062  !---------------------------------------------------------------------------
1063 
1064  lnd_temp = thetastd
1065  sfc_temp = thetastd
1066 
1067  !--- read namelist
1068  rewind(io_fid_conf)
1069  read(io_fid_conf,nml=param_mkinit_land,iostat=ierr)
1070  if( ierr < 0 ) then !--- missing
1071  log_info("land_setup",*) 'Not found namelist. Default used.'
1072  elseif( ierr > 0 ) then !--- fatal error
1073  log_error("land_setup",*) 'Not appropriate names in namelist PARAM_MKINIT_LAND. Check!'
1074  call prc_abort
1075  endif
1076  log_nml(param_mkinit_land)
1077 
1078  !$acc kernels
1079  land_temp(:,:,:) = lnd_temp
1080  land_water(:,:,:) = lnd_water
1081  land_ice(:,:,:) = lnd_ice
1082  !$acc end kernels
1083 
1084  !$acc kernels
1085  land_sfc_temp(:,:) = sfc_temp
1086  !$acc end kernels
1087  !$acc kernels
1088  land_sfc_albedo(:,:,:,i_r_ir) = sfc_albedo_lw
1089  land_sfc_albedo(:,:,:,i_r_nir) = sfc_albedo_sw
1090  land_sfc_albedo(:,:,:,i_r_vis) = sfc_albedo_sw
1091  !$acc end kernels
1092 
1093  if ( snow_flag ) then
1094  !!!!! Tentative for snow model !!!!!
1095  !$acc kernels
1096  snow_sfc_temp(:,:) = 273.15_rp
1097  snow_swe(:,:) = 0.0_rp
1098  snow_depth(:,:) = 0.0_rp
1099  snow_dzero(:,:) = 0.0_rp
1100  snow_nosnowsec(:,:) = 0.0_rp
1101  !$acc end kernels
1102  end if
1103 
1104  return
1105  end subroutine land_setup
1106 
1107  !-----------------------------------------------------------------------------
1109  subroutine ocean_setup
1110  use mod_ocean_vars, only: &
1111  ice_flag, &
1112  ocean_temp, &
1113  ocean_salt, &
1114  ocean_uvel, &
1115  ocean_vvel, &
1116  ocean_ocn_z0m, &
1117  ocean_ice_temp, &
1118  ocean_ice_mass, &
1119  ocean_sfc_temp, &
1120  ocean_sfc_albedo, &
1121  ocean_sfc_z0m, &
1122  ocean_sfc_z0h, &
1123  ocean_sfc_z0e
1124  implicit none
1125 
1126  real(RP) :: OCN_TEMP ! ocean temperature [K]
1127  real(RP) :: OCN_SALT = 0.0_rp ! ocean salinity [psu]
1128  real(RP) :: OCN_UVEL = 0.0_rp ! ocean u-velocity [m/s]
1129  real(RP) :: OCN_VVEL = 0.0_rp ! ocean v-velocity [m/s]
1130  real(RP) :: ICE_TEMP ! ocean temperature [K]
1131  real(RP) :: ICE_MASS = 0.0_rp ! ocean temperature [K]
1132  real(RP) :: SFC_TEMP ! ocean skin temperature [K]
1133  real(RP) :: SFC_albedo_LW = 0.04_rp ! ocean surface albedo for LW (0-1)
1134  real(RP) :: SFC_albedo_SW = 0.05_rp ! ocean surface albedo for SW (0-1)
1135  real(RP) :: SFC_Z0M = 1.e-4_rp ! ocean surface roughness length (momentum) [m]
1136  real(RP) :: SFC_Z0H = 1.e-4_rp ! ocean surface roughness length (heat) [m]
1137  real(RP) :: SFC_Z0E = 1.e-4_rp ! ocean surface roughness length (vapor) [m]
1138 
1139  namelist / param_mkinit_ocean / &
1140  ocn_temp, &
1141  ocn_salt, &
1142  ocn_uvel, &
1143  ocn_vvel, &
1144  ice_temp, &
1145  ice_mass, &
1146  sfc_temp, &
1147  sfc_albedo_lw, &
1148  sfc_albedo_sw, &
1149  sfc_z0m, &
1150  sfc_z0h, &
1151  sfc_z0e
1152 
1153  integer :: ierr
1154  !---------------------------------------------------------------------------
1155 
1156  ocn_temp = thetastd
1157  ice_temp = 271.35_rp ! freezing point of the ocean
1158  sfc_temp = thetastd
1159 
1160  !--- read namelist
1161  rewind(io_fid_conf)
1162  read(io_fid_conf,nml=param_mkinit_ocean,iostat=ierr)
1163  if( ierr < 0 ) then !--- missing
1164  log_info("ocean_setup",*) 'Not found namelist. Default used.'
1165  elseif( ierr > 0 ) then !--- fatal error
1166  log_error("ocean_setup",*) 'Not appropriate names in namelist PARAM_MKINIT_OCEAN. Check!'
1167  call prc_abort
1168  endif
1169  log_nml(param_mkinit_ocean)
1170 
1171  !$acc kernels
1172  ocean_temp(:,:,:) = ocn_temp
1173  ocean_salt(:,:,:) = ocn_salt
1174  ocean_uvel(:,:,:) = ocn_uvel
1175  ocean_vvel(:,:,:) = ocn_vvel
1176  !$acc end kernels
1177  !$acc kernels
1178  ocean_ocn_z0m(:,:) = sfc_z0m
1179  ocean_sfc_temp(:,:) = sfc_temp
1180  !$acc end kernels
1181  !$acc kernels
1182  ocean_sfc_albedo(:,:,:,i_r_ir) = sfc_albedo_lw
1183  ocean_sfc_albedo(:,:,:,i_r_nir) = sfc_albedo_sw
1184  ocean_sfc_albedo(:,:,:,i_r_vis) = sfc_albedo_sw
1185  !$acc end kernels
1186  !$acc kernels
1187  ocean_sfc_z0m(:,:) = sfc_z0m
1188  ocean_sfc_z0h(:,:) = sfc_z0h
1189  ocean_sfc_z0e(:,:) = sfc_z0e
1190  !$acc end kernels
1191 
1192  if ( ice_flag ) then
1193  !$acc kernels
1194  ocean_ice_temp(:,:) = ice_temp
1195  ocean_ice_mass(:,:) = ice_mass
1196  !$acc end kernels
1197  end if
1198 
1199  return
1200  end subroutine ocean_setup
1201 
1202  !-----------------------------------------------------------------------------
1204  subroutine urban_setup
1205  use mod_urban_vars, only: &
1206  urban_tr, &
1207  urban_tb, &
1208  urban_tg, &
1209  urban_tc, &
1210  urban_qc, &
1211  urban_uc, &
1212  urban_trl, &
1213  urban_tbl, &
1214  urban_tgl, &
1215  urban_rainr, &
1216  urban_rainb, &
1217  urban_raing, &
1218  urban_sfc_temp, &
1219  urban_sfc_albedo
1220  implicit none
1221 
1222  real(RP) :: URB_ROOF_TEMP ! Surface temperature of roof [K]
1223  real(RP) :: URB_BLDG_TEMP ! Surface temperature of building [K]
1224  real(RP) :: URB_GRND_TEMP ! Surface temperature of ground [K]
1225  real(RP) :: URB_CNPY_TEMP ! Diagnostic canopy air temperature [K]
1226  real(RP) :: URB_CNPY_HMDT = 0.0_rp ! Diagnostic canopy humidity [kg/kg]
1227  real(RP) :: URB_CNPY_WIND = 0.0_rp ! Diagnostic canopy wind [m/s]
1228  real(RP) :: URB_ROOF_LAYER_TEMP ! temperature in layer of roof [K]
1229  real(RP) :: URB_BLDG_LAYER_TEMP ! temperature in layer of building [K]
1230  real(RP) :: URB_GRND_LAYER_TEMP ! temperature in layer of ground [K]
1231  real(RP) :: URB_ROOF_RAIN = 0.0_rp ! temperature in layer of roof [kg/m2]
1232  real(RP) :: URB_BLDG_RAIN = 0.0_rp ! temperature in layer of building [kg/m2]
1233  real(RP) :: URB_GRND_RAIN = 0.0_rp ! temperature in layer of ground [kg/m2]
1234  real(RP) :: URB_SFC_TEMP ! Grid average of surface temperature [K]
1235  real(RP) :: URB_ALB_LW = 0.10_rp ! Grid average of surface albedo for LW (0-1)
1236  real(RP) :: URB_ALB_SW = 0.20_rp ! Grid average of surface albedo for SW (0-1)
1237 
1238  namelist / param_mkinit_urban / &
1239  urb_roof_temp, &
1240  urb_bldg_temp, &
1241  urb_grnd_temp, &
1242  urb_cnpy_temp, &
1243  urb_cnpy_hmdt, &
1244  urb_cnpy_wind, &
1245  urb_roof_layer_temp, &
1246  urb_bldg_layer_temp, &
1247  urb_grnd_layer_temp, &
1248  urb_roof_rain, &
1249  urb_bldg_rain, &
1250  urb_grnd_rain, &
1251  urb_sfc_temp, &
1252  urb_alb_lw, &
1253  urb_alb_sw
1254 
1255  integer :: ierr
1256  !---------------------------------------------------------------------------
1257 
1258  urb_roof_temp = thetastd
1259  urb_bldg_temp = thetastd
1260  urb_grnd_temp = thetastd
1261  urb_cnpy_temp = thetastd
1262  urb_roof_layer_temp = thetastd
1263  urb_bldg_layer_temp = thetastd
1264  urb_grnd_layer_temp = thetastd
1265  urb_sfc_temp = thetastd
1266 
1267  !--- read namelist
1268  rewind(io_fid_conf)
1269  read(io_fid_conf,nml=param_mkinit_urban,iostat=ierr)
1270  if( ierr < 0 ) then !--- missing
1271  log_info("urban_setup",*) 'Not found namelist. Default used.'
1272  elseif( ierr > 0 ) then !--- fatal error
1273  log_error("urban_setup",*) 'Not appropriate names in namelist PARAM_MKINIT_URBAN. Check!'
1274  call prc_abort
1275  endif
1276  log_nml(param_mkinit_urban)
1277 
1278  !$acc kernels
1279  urban_trl(:,:,:) = urb_roof_layer_temp
1280  urban_tbl(:,:,:) = urb_bldg_layer_temp
1281  urban_tgl(:,:,:) = urb_grnd_layer_temp
1282  !$acc end kernels
1283 
1284  !$acc kernels
1285  urban_tr(:,:) = urb_roof_temp
1286  urban_tb(:,:) = urb_bldg_temp
1287  urban_tg(:,:) = urb_grnd_temp
1288  urban_tc(:,:) = urb_cnpy_temp
1289  urban_qc(:,:) = urb_cnpy_hmdt
1290  urban_uc(:,:) = urb_cnpy_wind
1291  urban_rainr(:,:) = urb_roof_rain
1292  urban_rainb(:,:) = urb_bldg_rain
1293  urban_raing(:,:) = urb_grnd_rain
1294  urban_sfc_temp(:,:) = urb_sfc_temp
1295  !$acc end kernels
1296  !$acc kernels
1297  urban_sfc_albedo(:,:,:,i_r_ir) = urb_alb_lw
1298  urban_sfc_albedo(:,:,:,i_r_nir) = urb_alb_sw
1299  urban_sfc_albedo(:,:,:,i_r_vis) = urb_alb_sw
1300  !$acc end kernels
1301 
1302  return
1303  end subroutine urban_setup
1304 
1305  !-----------------------------------------------------------------------------
1307  subroutine tke_setup
1308  use scale_const, only: &
1309  eps => const_eps, &
1310  undef => const_undef
1311  use mod_atmos_phy_tb_vars, only: &
1312  i_tke
1313  use mod_atmos_phy_bl_vars, only: &
1314  zi => atmos_phy_bl_zi
1315  use mod_atmos_phy_bl_driver, only: &
1316  atmos_phy_bl_driver_mkinit
1317  implicit none
1318 
1319  real(RP) :: TKE_CONST
1320  real(RP) :: Zi_CONST
1321 
1322  namelist / param_mkinit_tke / &
1323  tke_const, &
1324  zi_const
1325 
1326  integer :: k, i, j
1327  integer :: ierr
1328  !---------------------------------------------------------------------------
1329 
1330  tke_const = eps
1331  zi_const = 100.0_rp
1332 
1333  !--- read namelist
1334  rewind(io_fid_conf)
1335  read(io_fid_conf,nml=param_mkinit_tke,iostat=ierr)
1336  if( ierr < 0 ) then !--- missing
1337  log_info("tke_setup",*) 'Not found namelist. Default used.'
1338  elseif( ierr > 0 ) then !--- fatal error
1339  log_error("tke_setup",*) 'Not appropriate names in namelist PARAM_MKINIT_TKE. Check!'
1340  call prc_abort
1341  endif
1342  log_nml(param_mkinit_tke)
1343 
1344  if ( i_tke > 0 ) then ! TB
1345  !$omp parallel do collapse(2)
1346  !$acc kernels
1347  do j = jsb, jeb
1348  do i = isb, ieb
1349  do k = 1, ka
1350  if ( qtrc(k,i,j,i_tke) == undef ) then
1351  qtrc(k,i,j,i_tke) = tke_const
1352  end if
1353  enddo
1354  enddo
1355  enddo
1356  !$acc end kernels
1357  end if
1358 
1359  !$acc kernels
1360  do j = jsb, jeb
1361  do i = isb, ieb
1362  zi(i,j) = zi_const
1363  end do
1364  end do
1365  !$acc end kernels
1366 
1367  ! BL
1368  call atmos_phy_bl_driver_mkinit( tke_const )
1369 
1370  return
1371  end subroutine tke_setup
1372 
1373  !-----------------------------------------------------------------------------
1375  subroutine read_sounding( &
1376  DENS, VELX, VELY, POTT, QV )
1377  use scale_atmos_hydrometeor, only: &
1378  atmos_hydrometeor_dry
1379  implicit none
1380 
1381  real(RP), intent(out) :: DENS(KA)
1382  real(RP), intent(out) :: VELX(KA)
1383  real(RP), intent(out) :: VELY(KA)
1384  real(RP), intent(out) :: POTT(KA)
1385  real(RP), intent(out) :: QV (KA)
1386 
1387  real(RP) :: TEMP(KA)
1388  real(RP) :: PRES(KA)
1389  real(RP) :: QC (KA)
1390 
1391  character(len=H_LONG) :: ENV_IN_SOUNDING_file = ''
1392 
1393  integer, parameter :: EXP_klim = 100
1394  integer :: EXP_kmax
1395 
1396  real(RP) :: SFC_THETA ! surface potential temperature [K]
1397  real(RP) :: SFC_PRES ! surface pressure [hPa]
1398  real(RP) :: SFC_QV ! surface watervapor [g/kg]
1399 
1400  real(RP) :: EXP_z (EXP_klim+1) ! height [m]
1401  real(RP) :: EXP_pott(EXP_klim+1) ! potential temperature [K]
1402  real(RP) :: EXP_qv (EXP_klim+1) ! water vapor [g/kg]
1403  real(RP) :: EXP_u (EXP_klim+1) ! velocity u [m/s]
1404  real(RP) :: EXP_v (EXP_klim+1) ! velocity v [m/s]
1405 
1406  real(RP) :: fact1, fact2
1407  integer :: k, kref
1408 
1409  integer :: fid
1410  character(len=H_LONG) :: fname
1411 
1412  logical :: converged
1413 
1414 #ifdef _OPENACC
1415  real(RP) :: work1(KA)
1416  real(RP) :: work2(KA)
1417  real(RP) :: work3(KA)
1418 #endif
1419 
1420  integer :: ierr
1421 
1422  namelist / param_mkinit_sounding / &
1423  env_in_sounding_file
1424 
1425  !--- read namelist
1426  rewind(io_fid_conf)
1427  read(io_fid_conf,nml=param_mkinit_sounding,iostat=ierr)
1428 
1429  if( ierr < 0 ) then !--- missing
1430  log_info("read_sounding",*) 'Not found namelist. Default used.'
1431  elseif( ierr > 0 ) then !--- fatal error
1432  log_error("read_sounding",*) 'Not appropriate names in namelist PARAM_MKINIT_SOUNDING. Check!'
1433  call prc_abort
1434  endif
1435  log_nml(param_mkinit_sounding)
1436 
1437  !--- prepare sounding profile
1438  fid = io_get_available_fid()
1439  call io_get_fname(fname, env_in_sounding_file)
1440  log_info("read_sounding",*) 'Input sounding file:', trim(fname)
1441  open( fid, &
1442  file = fname, &
1443  form = 'formatted', &
1444  status = 'old', &
1445  iostat = ierr )
1446 
1447  if ( ierr /= 0 ) then
1448  log_error("read_sounding",*) '[mod_mkinit/read_sounding] Input file not found!'
1449  endif
1450 
1451  !--- read sounding file till end
1452  read(fid,*) sfc_pres, sfc_theta, sfc_qv
1453 
1454  log_info("read_sounding",*) '+ Surface pressure [hPa]', sfc_pres
1455  log_info("read_sounding",*) '+ Surface pot. temp [K]', sfc_theta
1456  log_info("read_sounding",*) '+ Surface water vapor [g/kg]', sfc_qv
1457 
1458  do k = 2, exp_klim
1459  read(fid,*,iostat=ierr) exp_z(k), exp_pott(k), exp_qv(k), exp_u(k), exp_v(k)
1460  if ( ierr /= 0 ) exit
1461  enddo
1462 
1463  exp_kmax = k - 1
1464  close(fid)
1465 
1466  ! Boundary
1467  exp_z(1) = 0.0_rp
1468  exp_pott(1) = sfc_theta
1469  exp_qv(1) = sfc_qv
1470  exp_u(1) = exp_u(2)
1471  exp_v(1) = exp_v(2)
1472  exp_z(exp_kmax+1) = 100.e3_rp
1473  exp_pott(exp_kmax+1) = exp_pott(exp_kmax)
1474  exp_qv(exp_kmax+1) = exp_qv(exp_kmax)
1475  exp_u(exp_kmax+1) = exp_u(exp_kmax)
1476  exp_v(exp_kmax+1) = exp_v(exp_kmax)
1477 
1478  do k = 1, exp_kmax+1
1479  exp_qv(k) = exp_qv(k) * 1.e-3_rp ! [g/kg]->[kg/kg]
1480  enddo
1481 
1482  ! calc in dry condition
1483  pres_sfc(:,:) = sfc_pres * 1.e2_rp ! [hPa]->[Pa]
1484  pott_sfc(:,:) = sfc_theta
1485  if ( .not. atmos_hydrometeor_dry ) then
1486  qv_sfc(:,:) = sfc_qv * 1.e-3_rp ! [g/kg]->[kg/kg]
1487  end if
1488 
1489  !--- linear interpolate to model grid
1490  do k = ks, ke
1491  do kref = 2, exp_kmax+1
1492  if ( cz(k) > exp_z(kref-1) &
1493  .AND. cz(k) <= exp_z(kref ) ) then
1494 
1495  fact1 = ( exp_z(kref) - cz(k) ) / ( exp_z(kref)-exp_z(kref-1) )
1496  fact2 = ( cz(k) - exp_z(kref-1) ) / ( exp_z(kref)-exp_z(kref-1) )
1497 
1498  pott(k) = exp_pott(kref-1) * fact1 &
1499  + exp_pott(kref ) * fact2
1500  qv(k) = exp_qv(kref-1) * fact1 &
1501  + exp_qv(kref ) * fact2
1502  velx(k) = exp_u(kref-1) * fact1 &
1503  + exp_u(kref ) * fact2
1504  vely(k) = exp_v(kref-1) * fact1 &
1505  + exp_v(kref ) * fact2
1506  endif
1507  enddo
1508  enddo
1509  if ( atmos_hydrometeor_dry ) qv(:) = 0.0_rp
1510 
1511  qc(:) = 0.0_rp
1512 
1513  ! make density & pressure profile in moist condition
1514  call hydrostatic_buildrho( ka, ks, ke, &
1515  pott(:), qv(:), qc(:), & ! [IN]
1516  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
1517  cz(:), fz(:), & ! [IN]
1518 #ifdef _OPENACC
1519  work1(:), work2(:), work3(:), & ! [WORK]
1520 #endif
1521  dens(:), temp(:), pres(:), temp_sfc(1,1), & ! [OUT]
1522  converged ) ! [OUT]
1523 
1524  return
1525  end subroutine read_sounding
1526 
1527  !-----------------------------------------------------------------------------
1529  subroutine mkinit_planestate
1530  use scale_atmos_hydrometeor, only: &
1531  atmos_hydrometeor_dry
1532  implicit none
1533 
1534  ! Surface state
1535  real(RP) :: SFC_THETA ! surface potential temperature [K]
1536  real(RP) :: SFC_PRES ! surface pressure [Pa]
1537  real(RP) :: SFC_RH = 0.0_rp ! surface relative humidity [%]
1538  ! Environment state
1539  real(RP) :: ENV_THETA ! potential temperature of environment [K]
1540  real(RP) :: ENV_TLAPS = 0.0_rp ! Lapse rate of THETA [K/m]
1541  real(RP) :: ENV_U = 0.0_rp ! velocity u of environment [m/s]
1542  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
1543  real(RP) :: ENV_RH = 0.0_rp ! relative humidity of environment [%]
1544  ! Disturbance
1545  real(RP) :: RANDOM_THETA = 0.0_rp ! amplitude of random disturbance theta
1546  real(RP) :: RANDOM_U = 0.0_rp ! amplitude of random disturbance u
1547  real(RP) :: RANDOM_V = 0.0_rp ! amplitude of random disturbance v
1548  real(RP) :: RANDOM_RH = 0.0_rp ! amplitude of random disturbance RH
1549 
1550  namelist / param_mkinit_planestate / &
1551  sfc_theta, &
1552  sfc_pres, &
1553  sfc_rh, &
1554  env_theta, &
1555  env_tlaps, &
1556  env_u, &
1557  env_v, &
1558  env_rh, &
1559  random_theta, &
1560  random_u, &
1561  random_v, &
1562  random_rh
1563 
1564  integer :: ierr
1565  integer :: k, i, j, itr
1566  !---------------------------------------------------------------------------
1567 
1568  log_newline
1569  log_info("MKINIT_planestate",*) 'Setup initial state'
1570 
1571  sfc_theta = thetastd
1572  sfc_pres = pstd
1573  env_theta = thetastd
1574 
1575  !--- read namelist
1576  rewind(io_fid_conf)
1577  read(io_fid_conf,nml=param_mkinit_planestate,iostat=ierr)
1578 
1579  if( ierr < 0 ) then !--- missing
1580  log_info("MKINIT_planestate",*) 'Not found namelist. Default used.'
1581  elseif( ierr > 0 ) then !--- fatal error
1582  log_error_cont(*) 'Not appropriate names in namelist PARAM_MKINIT_PLANESTATE. Check!'
1583  call prc_abort
1584  endif
1585  log_nml(param_mkinit_planestate)
1586 
1587  ! calc in dry condition
1588  !$acc kernels
1589  do j = jsb, jeb
1590  do i = isb, ieb
1591  pott_sfc(i,j) = sfc_theta
1592  pres_sfc(i,j) = sfc_pres
1593  enddo
1594  enddo
1595  !$acc end kernels
1596 
1597  if ( env_theta < 0.0_rp ) then ! use isa profile
1598 
1599  call profile_isa( ka, ks, ke, & ! [IN]
1600  ia, isb, ieb, & ! [IN]
1601  ja, jsb, jeb, & ! [IN]
1602  pott_sfc(:,:), & ! [IN]
1603  pres_sfc(:,:), & ! [IN]
1604  real_cz(:,:,:), & ! [IN]
1605  pott(:,:,:) ) ! [OUT]
1606 
1607  else
1608 
1609  !$acc kernels
1610  do j = jsb, jeb
1611  do i = isb, ieb
1612  do k = ks, ke
1613  pott(k,i,j) = env_theta + env_tlaps * real_cz(k,i,j)
1614  enddo
1615  enddo
1616  enddo
1617  !$acc end kernels
1618 
1619  endif
1620 
1621  ! make density & pressure profile in dry condition
1622  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
1623  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
1624  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
1625  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
1626  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
1627 
1628  call random_uniform(rndm) ! make random
1629  !$acc kernels
1630  do j = jsb, jeb
1631  do i = isb, ieb
1632  pott_sfc(i,j) = pott_sfc(i,j) + ( rndm(ks-1,i,j) * 2.0_rp - 1.0_rp ) * random_theta
1633 
1634  do k = ks, ke
1635  pott(k,i,j) = pott(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_theta
1636  enddo
1637  enddo
1638  enddo
1639  !$acc end kernels
1640 
1641  if ( .not. atmos_hydrometeor_dry ) then
1642 
1643  ! Calculate QV from RH.
1644  ! Note that the RH consequently obtained by following calculations is not precisely identical with the RH set by namelist,
1645  ! because the iteration is not performed in the calculation of qv and density is re-built after including moisture.
1646 
1647  call saturation_pres2qsat_all( ia, isb, ieb, ja, jsb, jeb, &
1648  temp_sfc(:,:), pres_sfc(:,:), & ! [IN]
1649  qsat_sfc(:,:) ) ! [OUT]
1650 
1651  call random_uniform(rndm) ! make random
1652  !$acc kernels
1653  do j = jsb, jeb
1654  do i = isb, ieb
1655  qv_sfc(i,j) = max( 0.0_rp, sfc_rh + ( rndm(ks-1,i,j) * 2.0_rp - 1.0_rp ) * random_rh ) * 1.e-2_rp * qsat_sfc(i,j)
1656  enddo
1657  enddo
1658  !$acc end kernels
1659  end if
1660 
1661 
1662  if ( .not. atmos_hydrometeor_dry ) then
1663  do itr = 1, niter_rh
1664  call saturation_psat_all( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
1665  temp(:,:,:), & ! [IN]
1666  psat(:,:,:) ) ! [OUT]
1667 
1668  !$acc kernels
1669  do j = jsb, jeb
1670  do i = isb, ieb
1671  do k = ks, ke
1672  qv(k,i,j) = max( 0.0_rp, env_rh + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_rh ) * 1.e-2_rp * psat(k,i,j) / ( dens(k,i,j) * rvap * temp(k,i,j) )
1673  enddo
1674  enddo
1675  enddo
1676  !$acc end kernels
1677 
1678  ! make density & pressure profile in moist condition
1679  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
1680  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
1681  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
1682  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
1683  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
1684  end do
1685  end if
1686 
1687  call comm_vars8( dens(:,:,:), 1 )
1688  call comm_wait ( dens(:,:,:), 1 )
1689 
1690  call random_uniform(rndm) ! make random
1691  !$acc kernels
1692  !$acc loop collapse(3) independent
1693  do j = jsb, jeb
1694  do i = isb, min(ieb,ia-1)
1695  do k = ks, ke
1696  momx(k,i,j) = ( env_u + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_u ) &
1697  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
1698  enddo
1699  enddo
1700  enddo
1701  !$acc end kernels
1702 
1703  call random_uniform(rndm) ! make random
1704  !$acc kernels
1705  !$acc loop collapse(3) independent
1706  do j = jsb, min(jeb,ja-1)
1707  do i = isb, ieb
1708  do k = ks, ke
1709  momy(k,i,j) = ( env_v + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_v ) &
1710  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
1711  enddo
1712  enddo
1713  enddo
1714  !$acc end kernels
1715 
1716  !$acc kernels
1717  !$acc loop collapse(3) independent
1718  do j = jsb, jeb
1719  do i = isb, ieb
1720  do k = ks, ke
1721  momz(k,i,j) = 0.0_rp
1722  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
1723  enddo
1724  enddo
1725  enddo
1726  !$acc end kernels
1727 
1728  call flux_setup
1729 
1730  return
1731  end subroutine mkinit_planestate
1732 
1733  !-----------------------------------------------------------------------------
1735  subroutine mkinit_tracerbubble
1736  implicit none
1737 
1738 #ifndef DRY
1739  ! Surface state
1740  real(RP) :: SFC_THETA ! surface potential temperature [K]
1741  real(RP) :: SFC_PRES ! surface pressure [Pa]
1742  ! Environment state
1743  real(RP) :: ENV_THETA ! potential temperature of environment [K]
1744  real(RP) :: ENV_U = 0.0_rp ! velocity u of environment [m/s]
1745  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
1746  ! Bubble
1747  character(len=H_SHORT) :: SHAPE_PTracer = 'BUBBLE' ! BUBBLE or RECT
1748  real(RP) :: BBL_PTracer = 1.0_rp ! extremum of passive tracer in bubble [kg/kg]
1749  namelist / param_mkinit_tracerbubble / &
1750  sfc_theta, &
1751  sfc_pres, &
1752  env_theta, &
1753  env_u, &
1754  env_v, &
1755  shape_ptracer, &
1756  bbl_ptracer
1757 
1758  real(RP), pointer :: shapeFac(:,:,:) => null()
1759 
1760  logical :: converged
1761 
1762 #ifdef _OPENACC
1763  real(RP) :: work1(KA)
1764  real(RP) :: work2(KA)
1765  real(RP) :: work3(KA)
1766 #endif
1767 
1768  integer :: k, i, j
1769  integer :: ierr
1770  !---------------------------------------------------------------------------
1771 
1772  log_newline
1773  log_info("MKINIT_tracerbubble",*) 'Setup initial state'
1774 
1775  sfc_theta = thetastd
1776  sfc_pres = pstd
1777  env_theta = thetastd
1778 
1779  !--- read namelist
1780  rewind(io_fid_conf)
1781  read(io_fid_conf,nml=param_mkinit_tracerbubble,iostat=ierr)
1782 
1783  if( ierr < 0 ) then !--- missing
1784  log_info("MKINIT_tracerbubble",*) 'Not found namelist. Default used.'
1785  elseif( ierr > 0 ) then !--- fatal error
1786  log_error("MKINIT_tracerbubble",*) 'Not appropriate names in namelist PARAM_MKINIT_TRACERBUBBLE. Check!'
1787  call prc_abort
1788  endif
1789  log_nml(param_mkinit_tracerbubble)
1790 
1791  ! calc in dry condition
1792  !$acc kernels
1793  pres_sfc(1,1) = sfc_pres
1794  pott_sfc(1,1) = sfc_theta
1795  !$acc end kernels
1796 
1797  !$acc kernels
1798  do k = ks, ke
1799  pott(k,1,1) = env_theta
1800  enddo
1801  !$acc end kernels
1802 
1803  ! make density & pressure profile in dry condition
1804  call hydrostatic_buildrho( ka, ks, ke, &
1805  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
1806  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
1807  cz(:), fz(:), & ! [IN]
1808 #ifdef _OPENACC
1809  work1(:), work2(:), work3(:), & ! [WORK]
1810 #endif
1811  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
1812  converged ) ! [OUT]
1813 
1814  !$acc kernels
1815  !$acc loop collapse(3) independent
1816  do j = jsb, jeb
1817  do i = isb, ieb
1818  do k = ks, ke
1819  dens(k,i,j) = dens(k,1,1)
1820  momz(k,i,j) = 0.0_rp
1821  momx(k,i,j) = env_u * dens(k,1,1)
1822  momy(k,i,j) = env_v * dens(k,1,1)
1823  rhot(k,i,j) = pott(k,1,1) * dens(k,1,1)
1824  enddo
1825  enddo
1826  enddo
1827  !$acc end kernels
1828 
1829  ! make tracer bubble
1830  select case(shape_ptracer)
1831  case('BUBBLE')
1832  call bubble_setup
1833  shapefac => bubble
1834  case('RECT')
1835  call rect_setup
1836  shapefac => rect
1837  case default
1838  log_error("MKINIT_tracerbubble",*) 'SHAPE_PTracer=', trim(shape_ptracer), ' cannot be used on advect. Check!'
1839  call prc_abort
1840  end select
1841 
1842  !$acc kernels
1843  do j = jsb, jeb
1844  do i = isb, ieb
1845  do k = ks, ke
1846  ptrc(k,i,j) = bbl_ptracer * shapefac(k,i,j)
1847  enddo
1848  enddo
1849  enddo
1850  !$acc end kernels
1851 
1852 #endif
1853 
1854  return
1855  end subroutine mkinit_tracerbubble
1856 
1857  !-----------------------------------------------------------------------------
1867  subroutine mkinit_coldbubble
1868  implicit none
1869 
1870  ! Surface state
1871  real(RP) :: SFC_THETA ! surface potential temperature [K]
1872  real(RP) :: SFC_PRES ! surface pressure [Pa]
1873  ! Environment state
1874  real(RP) :: ENV_THETA ! potential temperature of environment [K]
1875  ! Bubble
1876  real(RP) :: BBL_TEMP = -15.0_rp ! extremum of temperature in bubble [K]
1877 
1878  namelist / param_mkinit_coldbubble / &
1879  sfc_theta, &
1880  sfc_pres, &
1881  env_theta, &
1882  bbl_temp
1883 
1884  real(RP) :: RovCP
1885 
1886  logical :: converged
1887 
1888 #ifdef _OPENACC
1889  real(RP) :: work1(KA)
1890  real(RP) :: work2(KA)
1891  real(RP) :: work3(KA)
1892 #endif
1893 
1894  integer :: ierr
1895  integer :: k, i, j
1896  !---------------------------------------------------------------------------
1897 
1898  log_newline
1899  log_info("MKINIT_coldbubble",*) 'Setup initial state'
1900 
1901  sfc_theta = thetastd
1902  sfc_pres = pstd
1903  env_theta = thetastd
1904 
1905  !--- read namelist
1906  rewind(io_fid_conf)
1907  read(io_fid_conf,nml=param_mkinit_coldbubble,iostat=ierr)
1908 
1909  if( ierr < 0 ) then !--- missing
1910  log_info("MKINIT_coldbubble",*) 'Not found namelist. Default used.'
1911  elseif( ierr > 0 ) then !--- fatal error
1912  log_error("MKINIT_coldbubble",*) 'Not appropriate names in namelist PARAM_MKINIT_COLDBUBBLE. Check!'
1913  call prc_abort
1914  endif
1915  log_nml(param_mkinit_coldbubble)
1916 
1917  rovcp = rdry / cpdry
1918 
1919  ! calc in dry condition
1920  !$acc kernels
1921  pres_sfc(1,1) = sfc_pres
1922  pott_sfc(1,1) = sfc_theta
1923  !$acc end kernels
1924 
1925  !$acc kernels
1926  do k = ks, ke
1927  pott(k,1,1) = env_theta
1928  enddo
1929  !$acc end kernels
1930 
1931  ! make density & pressure profile in dry condition
1932  call hydrostatic_buildrho( ka, ks, ke, &
1933  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
1934  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
1935  cz(:), fz(:), & ! [IN]
1936 #ifdef _OPENACC
1937  work1(:), work2(:), work3(:), & ! [WORK]
1938 #endif
1939  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
1940  converged ) ! [OUT]
1941 
1942  !$acc kernels
1943  !$acc loop collapse(3) independent
1944  do j = 1, ja
1945  do i = 1, ia
1946  do k = ks, ke
1947  dens(k,i,j) = dens(k,1,1)
1948  momz(k,i,j) = 0.0_rp
1949  momx(k,i,j) = 0.0_rp
1950  momy(k,i,j) = 0.0_rp
1951 
1952  ! make cold bubble
1953  rhot(k,i,j) = dens(k,1,1) * ( pott(k,1,1) &
1954  + bbl_temp * ( p00/pres(k,1,1) )**rovcp * bubble(k,i,j) )
1955  enddo
1956  enddo
1957  enddo
1958  !$acc end kernels
1959 
1960  return
1961  end subroutine mkinit_coldbubble
1962 
1963  !-----------------------------------------------------------------------------
1965  subroutine mkinit_lambwave
1966  implicit none
1967 
1968  ! Surface state
1969  real(RP) :: SFC_PRES ! surface pressure [Pa]
1970  ! Environment state
1971  real(RP) :: ENV_U = 0.0_rp ! velocity u of environment [m/s]
1972  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
1973  real(RP) :: ENV_TEMP = 300.0_rp ! temperature of environment [K]
1974  ! Bubble
1975  real(RP) :: BBL_PRES = 100._rp ! extremum of pressure in bubble [Pa]
1976 
1977  namelist / param_mkinit_lambwave / &
1978  sfc_pres, &
1979  env_u, &
1980  env_v, &
1981  env_temp, &
1982  bbl_pres
1983 
1984  real(RP) :: RovCP
1985 
1986  integer :: ierr
1987  integer :: k, i, j
1988  !---------------------------------------------------------------------------
1989 
1990  log_newline
1991  log_info("MKINIT_lambwave",*) 'Setup initial state'
1992 
1993  sfc_pres = pstd
1994 
1995  !--- read namelist
1996  rewind(io_fid_conf)
1997  read(io_fid_conf,nml=param_mkinit_lambwave,iostat=ierr)
1998 
1999  if( ierr < 0 ) then !--- missing
2000  log_info("MKINIT_lambwave",*) 'Not found namelist. Default used.'
2001  elseif( ierr > 0 ) then !--- fatal error
2002  log_error("MKINIT_lambwave",*) 'Not appropriate names in namelist PARAM_MKINIT_LAMBWAVE. Check!'
2003  call prc_abort
2004  endif
2005  log_nml(param_mkinit_lambwave)
2006 
2007  rovcp = rdry / cpdry
2008 
2009  !$acc kernels
2010  !$acc loop collapse(3) independent
2011  do j = jsb, jeb
2012  do i = isb, ieb
2013  do k = ks, ke
2014  dens(k,i,j) = sfc_pres/(rdry*env_temp) * exp( - grav/(rdry*env_temp) * cz(k) )
2015  momz(k,i,j) = 0.0_rp
2016  momx(k,i,j) = env_u * dens(k,i,j)
2017  momy(k,i,j) = env_v * dens(k,i,j)
2018 
2019  ! make pressure bubble
2020  pres(k,i,j) = dens(k,i,j) * env_temp * rdry + bbl_pres * bubble(k,i,j)
2021 
2022  rhot(k,i,j) = dens(k,i,j) * env_temp * ( p00/pres(k,i,j) )**rovcp
2023  enddo
2024  enddo
2025  enddo
2026  !$acc end kernels
2027 
2028  return
2029  end subroutine mkinit_lambwave
2030 
2031  !-----------------------------------------------------------------------------
2034  subroutine mkinit_gravitywave
2035  implicit none
2036 
2037  ! Surface state
2038  real(RP) :: SFC_THETA ! surface potential temperature [K]
2039  real(RP) :: SFC_PRES ! surface pressure [Pa]
2040  ! Environment state
2041  real(RP) :: ENV_U = 20.0_rp ! velocity u of environment [m/s]
2042  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
2043  real(RP) :: ENV_BVF = 0.01_rp ! Brunt Vaisala frequencies of environment [1/s]
2044  ! Bubble
2045  real(RP) :: BBL_THETA = 0.01_rp ! extremum of potential temperature in bubble [K]
2046 
2047  namelist / param_mkinit_gravitywave / &
2048  sfc_theta, &
2049  sfc_pres, &
2050  env_u, &
2051  env_v, &
2052  env_bvf, &
2053  bbl_theta
2054 
2055  logical :: converged
2056 
2057 #ifdef _OPENACC
2058  real(RP) :: work1(KA)
2059  real(RP) :: work2(KA)
2060  real(RP) :: work3(KA)
2061 #endif
2062 
2063  integer :: ierr
2064  integer :: k, i, j
2065  !---------------------------------------------------------------------------
2066 
2067  log_newline
2068  log_info("MKINIT_gravitywave",*) 'Setup initial state'
2069 
2070  sfc_theta = thetastd
2071  sfc_pres = pstd
2072 
2073  !--- read namelist
2074  rewind(io_fid_conf)
2075  read(io_fid_conf,nml=param_mkinit_gravitywave,iostat=ierr)
2076 
2077  if( ierr < 0 ) then !--- missing
2078  log_info("MKINIT_gravitywave",*) 'Not found namelist. Default used.'
2079  elseif( ierr > 0 ) then !--- fatal error
2080  log_error("MKINIT_gravitywave",*) 'Not appropriate names in namelist PARAM_MKINIT_GRAVITYWAVE. Check!'
2081  call prc_abort
2082  endif
2083  log_nml(param_mkinit_gravitywave)
2084 
2085  ! calc in dry condition
2086  !$acc kernels
2087  pres_sfc(1,1) = sfc_pres
2088  pott_sfc(1,1) = sfc_theta
2089  !$acc end kernels
2090 
2091  !$acc kernels
2092  do k = ks, ke
2093  pott(k,1,1) = sfc_theta * exp( env_bvf*env_bvf / grav * cz(k) )
2094  enddo
2095  !$acc end kernels
2096 
2097  ! make density & pressure profile in dry condition
2098  call hydrostatic_buildrho( ka, ks, ke, &
2099  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
2100  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
2101  cz(:), fz(:), & ! [IN]
2102 #ifdef _OPENACC
2103  work1(:), work2(:), work3(:), & ! [WORK]
2104 #endif
2105  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
2106  converged ) ! [OUT]
2107 
2108  !$acc kernels
2109  !$acc loop collapse(3) independent
2110  do j = jsb, jeb
2111  do i = isb, ieb
2112  do k = ks, ke
2113  dens(k,i,j) = dens(k,1,1)
2114  momz(k,i,j) = 0.0_rp
2115  momx(k,i,j) = env_u * dens(k,1,1)
2116  momy(k,i,j) = env_v * dens(k,1,1)
2117 
2118  ! make warm bubble
2119  rhot(k,i,j) = dens(k,1,1) * ( pott(k,1,1) + bbl_theta * bubble(k,i,j) )
2120 
2121  enddo
2122  enddo
2123  enddo
2124  !$acc end kernels
2125 
2126  return
2127  end subroutine mkinit_gravitywave
2128 
2129  !-----------------------------------------------------------------------------
2131  subroutine mkinit_khwave
2132  implicit none
2133 
2134  ! Surface state
2135  real(RP) :: SFC_THETA ! surface potential temperature [K]
2136  real(RP) :: SFC_PRES ! surface pressure [Pa]
2137  ! Environment state
2138  real(RP) :: ENV_L1_ZTOP = 1900.0_rp ! top height of the layer1 (low THETA) [m]
2139  real(RP) :: ENV_L3_ZBOTTOM = 2100.0_rp ! bottom height of the layer3 (high THETA) [m]
2140  real(RP) :: ENV_L1_THETA = 300.0_rp ! THETA in the layer1 (low THETA) [K]
2141  real(RP) :: ENV_L3_THETA = 301.0_rp ! THETA in the layer3 (high THETA) [K]
2142  real(RP) :: ENV_L1_U = 0.0_rp ! velocity u in the layer1 (low THETA) [K]
2143  real(RP) :: ENV_L3_U = 20.0_rp ! velocity u in the layer3 (high THETA) [K]
2144  ! Disturbance
2145  real(RP) :: RANDOM_U = 0.0_rp ! amplitude of random disturbance u
2146 
2147  namelist / param_mkinit_khwave / &
2148  sfc_theta, &
2149  sfc_pres, &
2150  env_l1_ztop, &
2151  env_l3_zbottom, &
2152  env_l1_theta, &
2153  env_l3_theta, &
2154  env_l1_u, &
2155  env_l3_u, &
2156  random_u
2157 
2158  real(RP) :: fact
2159 
2160  logical :: converged
2161 
2162 #ifdef _OPENACC
2163  real(RP) :: work1(KA)
2164  real(RP) :: work2(KA)
2165  real(RP) :: work3(KA)
2166 #endif
2167 
2168  integer :: ierr
2169  integer :: k, i, j
2170  !---------------------------------------------------------------------------
2171 
2172  log_newline
2173  log_info("MKINIT_khwave",*) 'Setup initial state'
2174 
2175  sfc_theta = thetastd
2176  sfc_pres = pstd
2177 
2178  !--- read namelist
2179  rewind(io_fid_conf)
2180  read(io_fid_conf,nml=param_mkinit_khwave,iostat=ierr)
2181 
2182  if( ierr < 0 ) then !--- missing
2183  log_info("MKINIT_khwave",*) 'Not found namelist. Default used.'
2184  elseif( ierr > 0 ) then !--- fatal error
2185  log_error("MKINIT_khwave",*) 'Not appropriate names in namelist PARAM_MKINIT_KHWAVE. Check!'
2186  call prc_abort
2187  endif
2188  log_nml(param_mkinit_khwave)
2189 
2190  ! calc in dry condition
2191  !$acc kernels
2192  pres_sfc(1,1) = sfc_pres
2193  pott_sfc(1,1) = sfc_theta
2194  !$acc end kernels
2195 
2196  !$acc kernels
2197  do k = ks, ke
2198  fact = ( cz(k)-env_l1_ztop ) / ( env_l3_zbottom-env_l1_ztop )
2199  fact = max( min( fact, 1.0_rp ), 0.0_rp )
2200 
2201  pott(k,1,1) = env_l1_theta * ( 1.0_rp - fact ) &
2202  + env_l3_theta * ( fact )
2203  enddo
2204  !$acc end kernels
2205 
2206  ! make density & pressure profile in dry condition
2207  call hydrostatic_buildrho( ka, ks, ke, &
2208  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
2209  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
2210  cz(:), fz(:), & ! [IN]
2211 #ifdef _OPENACC
2212  work1(:), work2(:), work3(:), & ! [WORK]
2213 #endif
2214  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
2215  converged ) ! [OUT]
2216 
2217  !$acc kernels
2218  !$acc loop collapse(3) independent
2219  do j = jsb, jeb
2220  do i = isb, ieb
2221  do k = ks, ke
2222  dens(k,i,j) = dens(k,1,1)
2223  momz(k,i,j) = 0.0_rp
2224  momy(k,i,j) = 0.0_rp
2225  rhot(k,i,j) = dens(k,1,1) * pott(k,1,1)
2226  enddo
2227  enddo
2228  enddo
2229  !$acc end kernels
2230 
2231  call random_uniform(rndm) ! make random
2232  !$acc kernels
2233  !$acc loop collapse(3) independent
2234  do j = jsb, jeb
2235  do i = isb, ieb
2236  do k = ks, ke
2237  fact = ( cz(k)-env_l1_ztop ) / ( env_l3_zbottom-env_l1_ztop )
2238  fact = max( min( fact, 1.0_rp ), 0.0_rp )
2239 
2240  momx(k,i,j) = ( env_l1_u * ( 1.0_rp - fact ) &
2241  + env_l3_u * ( fact ) &
2242  + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_u &
2243  ) * dens(k,i,j)
2244  enddo
2245  enddo
2246  enddo
2247  !$acc end kernels
2248 
2249  return
2250  end subroutine mkinit_khwave
2251 
2252  !-----------------------------------------------------------------------------
2254  subroutine mkinit_turbulence
2255  use scale_atmos_hydrometeor, only: &
2256  atmos_hydrometeor_dry
2257  implicit none
2258 
2259  ! Surface state
2260  real(RP) :: SFC_THETA ! surface potential temperature [K]
2261  real(RP) :: SFC_PRES ! surface pressure [Pa]
2262  real(RP) :: SFC_RH = 0.0_rp ! surface relative humidity [%]
2263  ! Environment state
2264  real(RP) :: ENV_THETA ! potential temperature of environment [K]
2265  real(RP) :: ENV_TLAPS = 4.e-3_rp ! Lapse rate of THETA [K/m]
2266  real(RP) :: ENV_U = 5.0_rp ! velocity u of environment [m/s]
2267  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
2268  real(RP) :: ENV_RH = 0.0_rp ! relative humidity of environment [%]
2269  ! Disturbance
2270  real(RP) :: RANDOM_THETA = 1.0_rp ! amplitude of random disturbance theta
2271  real(RP) :: RANDOM_U = 0.0_rp ! amplitude of random disturbance u
2272  real(RP) :: RANDOM_V = 0.0_rp ! amplitude of random disturbance v
2273  real(RP) :: RANDOM_RH = 0.0_rp ! amplitude of random disturbance RH
2274 
2275  namelist / param_mkinit_turbulence / &
2276  sfc_theta, &
2277  sfc_pres, &
2278  sfc_rh, &
2279  env_theta, &
2280  env_tlaps, &
2281  env_u, &
2282  env_v, &
2283  env_rh, &
2284  random_theta, &
2285  random_u, &
2286  random_v, &
2287  random_rh
2288 
2289  logical :: converged
2290 
2291 #ifdef _OPENACC
2292  real(RP) :: work1(KA)
2293  real(RP) :: work2(KA)
2294  real(RP) :: work3(KA)
2295 #endif
2296 
2297  integer :: ierr
2298  integer :: k, i, j, itr
2299  !---------------------------------------------------------------------------
2300 
2301  log_newline
2302  log_info("MKINIT_turbulence",*) 'Setup initial state'
2303 
2304  sfc_theta = thetastd
2305  sfc_pres = pstd
2306  env_theta = thetastd
2307 
2308  !--- read namelist
2309  rewind(io_fid_conf)
2310  read(io_fid_conf,nml=param_mkinit_turbulence,iostat=ierr)
2311 
2312  if( ierr < 0 ) then !--- missing
2313  log_info("MKINIT_turbulence",*) 'Not found namelist. Default used.'
2314  elseif( ierr > 0 ) then !--- fatal error
2315  log_error("MKINIT_turbulence",*) 'Not appropriate names in namelist PARAM_MKINIT_TURBULENCE. Check!'
2316  call prc_abort
2317  endif
2318  log_nml(param_mkinit_turbulence)
2319 
2320  ! calc in dry condition
2321  !$acc kernels
2322  pres_sfc(1,1) = sfc_pres
2323  pott_sfc(1,1) = sfc_theta
2324  !$acc end kernels
2325 
2326  !$acc kernels
2327  do k = ks, ke
2328  pott(k,1,1) = env_theta + env_tlaps * cz(k)
2329  enddo
2330  !$acc end kernels
2331 
2332  ! make density & pressure profile in dry condition
2333  call hydrostatic_buildrho( ka, ks, ke, &
2334  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
2335  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
2336  cz(:), fz(:), & ! [IN]
2337 #ifdef _OPENACC
2338  work1(:), work2(:), work3(:), & ! [WORK]
2339 #endif
2340  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
2341  converged ) ! [OUT]
2342 
2343  call random_uniform(rndm) ! make random
2344  !$acc kernels
2345  do j = jsb, jeb
2346  do i = isb, ieb
2347  pres_sfc(i,j) = sfc_pres
2348  pott_sfc(i,j) = sfc_theta + ( rndm(ks-1,i,j) * 2.0_rp - 1.0_rp ) * random_theta
2349 
2350  do k = ks, ke
2351  pott(k,i,j) = env_theta + env_tlaps * cz(k) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_theta
2352  enddo
2353  enddo
2354  enddo
2355  !$acc end kernels
2356 
2357  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2358  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
2359  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
2360  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
2361  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
2362 
2363  if ( .not. atmos_hydrometeor_dry ) then
2364  ! calc QV from RH
2365  call saturation_pres2qsat_all( ia, isb, ieb, ja, jsb, jeb, &
2366  temp_sfc(:,:), pres_sfc(:,:), & ! [IN]
2367  qsat_sfc(:,:) ) ! [OUT]
2368 
2369  call random_uniform(rndm) ! make random
2370  !$acc kernels
2371  !$acc loop collapse(2) independent
2372  do j = jsb, jeb
2373  do i = isb, ieb
2374  qv_sfc(i,j) = min( 0.0_rp, sfc_rh + ( rndm(ks-1,i,j) * 2.0_rp - 1.0_rp ) * random_rh ) * 1.e-2_rp * qsat_sfc(1,1)
2375  enddo
2376  enddo
2377  !$acc end kernels
2378 
2379  do itr = 1, niter_rh
2380  call saturation_psat_all( ka, ks, ke, ia, is, je, ja, js, je, &
2381  temp(:,:,:), & ! [IN]
2382  psat(:,:,:) ) ! [OUT]
2383 
2384  !$acc kernels
2385  !$acc loop collapse(2) independent
2386  do j = jsb, jeb
2387  do i = isb, ieb
2388  do k = ks, ke
2389  qv(k,i,j) = min( 0.0_rp, env_rh + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_rh ) * 1.e-2_rp * psat(k,i,j) / ( dens(k,i,j) * rvap * temp(k,i,j) )
2390  enddo
2391  enddo
2392  enddo
2393  !$acc end kernels
2394 
2395  ! make density & pressure profile in moist condition
2396  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2397  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
2398  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
2399  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
2400  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
2401  end do
2402  end if
2403 
2404  call comm_vars8( dens(:,:,:), 1 )
2405  call comm_wait ( dens(:,:,:), 1 )
2406 
2407  call random_uniform(rndm) ! make random
2408  !$acc kernels
2409  !$acc loop collapse(3) independent
2410  do j = jsb, jeb
2411  do i = isb, ieb
2412  do k = ks, ke
2413  momx(k,i,j) = ( env_u + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_u ) &
2414  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
2415  enddo
2416  enddo
2417  enddo
2418  !$acc end kernels
2419 
2420  call random_uniform(rndm) ! make random
2421  !$acc kernels
2422  !$acc loop collapse(3) independent
2423  do j = jsb, jeb
2424  do i = isb, ieb
2425  do k = ks, ke
2426  momy(k,i,j) = ( env_v + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_v ) &
2427  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
2428  enddo
2429  enddo
2430  enddo
2431  !$acc end kernels
2432 
2433  !$acc kernels
2434  !$acc loop collapse(3) independent
2435  do j = jsb, jeb
2436  do i = isb, ieb
2437  do k = ks, ke
2438  momz(k,i,j) = 0.0_rp
2439  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
2440  enddo
2441  enddo
2442  enddo
2443  !$acc end kernels
2444 
2445  return
2446  end subroutine mkinit_turbulence
2447 
2448  !-----------------------------------------------------------------------------
2450  subroutine mkinit_cavityflow
2451  implicit none
2452 
2453  ! Nondimenstional numbers for a cavity flow problem
2454  real(RP) :: REYNOLDS_NUM = 1.d03
2455  real(RP) :: MACH_NUM = 3.d-2
2456  real(RP) :: Ulid = 1.d01
2457  real(RP) :: PRES0 = 1.d05
2458 
2459  namelist / param_mkinit_cavityflow / &
2460  ulid , &
2461  pres0 , &
2462  reynolds_num, &
2463  mach_num
2464 
2465  real(RP) :: DENS0
2466  real(RP) :: TEMP
2467  real(RP) :: Gam
2468  real(RP) :: Cs2
2469 
2470  integer :: k, i, j
2471  integer :: ierr
2472  !---------------------------------------------------------------------------
2473 
2474  log_newline
2475  log_info("MKINIT_cavityflow",*) 'Setup initial state'
2476 
2477  !--- read namelist
2478  rewind(io_fid_conf)
2479  read(io_fid_conf,nml=param_mkinit_cavityflow,iostat=ierr)
2480 
2481  if( ierr < 0 ) then !--- missing
2482  log_info("MKINIT_cavityflow",*) 'Not found namelist. Default used.'
2483  elseif( ierr > 0 ) then !--- fatal error
2484  log_error("MKINIT_cavityflow",*) 'Not appropriate names in namelist PARAM_MKINIT_CAVITYFLOW. Check!'
2485  call prc_abort
2486  endif
2487  log_nml(param_mkinit_cavityflow)
2488 
2489  gam = cpdry / ( cpdry - rdry )
2490  cs2 = ( ulid / mach_num )**2
2491  temp = cs2 / ( gam * rdry )
2492  dens0 = pres0 / ( rdry * temp )
2493 
2494  log_info("MKINIT_cavityflow",*) "DENS = ", dens0
2495  log_info("MKINIT_cavityflow",*) "PRES = ", pres0
2496  log_info("MKINIT_cavityflow",*) "TEMP = ", rhot(10,10,4)/dens0, temp
2497  log_info("MKINIT_cavityflow",*) "Ulid = ", ulid
2498  log_info("MKINIT_cavityflow",*) "Cs = ", sqrt(cs2)
2499 
2500  !$acc kernels
2501  !$acc loop collapse(3) independent
2502  do j = 1, ja
2503  do i = 1, ia
2504  do k = ks, ke
2505  dens(k,i,j) = dens0
2506  momz(k,i,j) = 0.0_rp
2507  momx(k,i,j) = 0.0_rp
2508  momy(k,i,j) = 0.0_rp
2509  pres(k,i,j) = pres0
2510  rhot(k,i,j) = p00/rdry * (p00/pres0)**((rdry - cpdry)/cpdry)
2511  enddo
2512  enddo
2513  enddo
2514  !$acc end kernels
2515 
2516  !$acc kernels
2517  momx(ke+1:ka,:,:) = dens0 * ulid
2518  !$acc end kernels
2519 
2520  return
2521  end subroutine mkinit_cavityflow
2522 
2523  !-----------------------------------------------------------------------------
2525  subroutine mkinit_mountainwave
2526  implicit none
2527 
2528  ! Surface state
2529  real(RP) :: SFC_THETA ! surface potential temperature [K]
2530  real(RP) :: SFC_PRES ! surface pressure [Pa]
2531  ! Environment state
2532  real(RP) :: ENV_U = 0.0_rp ! velocity u of environment [m/s]
2533  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
2534 
2535  real(RP) :: SCORER = 2.e-3_rp ! Scorer parameter (~=N/U) [1/m]
2536  real(RP) :: BBL_PTracer = 0.0_rp ! extremum of passive tracer in bubble [kg/kg]
2537 
2538  namelist / param_mkinit_mountainwave / &
2539  sfc_theta, &
2540  sfc_pres, &
2541  env_u, &
2542  env_v, &
2543  scorer, &
2544  bbl_ptracer
2545 
2546  real(RP) :: Ustar2, N2
2547 
2548  integer :: ierr
2549  integer :: k, i, j
2550  !---------------------------------------------------------------------------
2551 
2552  log_newline
2553  log_info("MKINIT_mountainwave",*) 'Setup initial state'
2554 
2555  sfc_theta = thetastd
2556  sfc_pres = pstd
2557 
2558  !--- read namelist
2559  rewind(io_fid_conf)
2560  read(io_fid_conf,nml=param_mkinit_mountainwave,iostat=ierr)
2561 
2562  if( ierr < 0 ) then !--- missing
2563  log_info("MKINIT_mountainwave",*) 'Not found namelist. Default used.'
2564  elseif( ierr > 0 ) then !--- fatal error
2565  log_error("MKINIT_mountainwave",*) 'Not appropriate names in namelist PARAM_MKINIT_MOUNTAINWAVE. Check!'
2566  call prc_abort
2567  endif
2568  log_nml(param_mkinit_mountainwave)
2569 
2570  ! calc in dry condition
2571  !$acc kernels
2572  do j = jsb, jeb
2573  do i = isb, ieb
2574  pres_sfc(i,j) = sfc_pres
2575  pott_sfc(i,j) = sfc_theta
2576  enddo
2577  enddo
2578  !$acc end kernels
2579 
2580  !$acc kernels
2581  do j = jsb, jeb
2582  do i = isb, ieb
2583  do k = ks, ke
2584  ustar2 = env_u * env_u + env_v * env_v
2585  n2 = ustar2 * (scorer*scorer)
2586 
2587  pott(k,i,j) = sfc_theta * exp( n2 / grav * real_cz(k,i,j) )
2588  enddo
2589  enddo
2590  enddo
2591  !$acc end kernels
2592 
2593  ! make density & pressure profile in dry condition
2594  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2595  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
2596  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
2597  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
2598  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
2599 
2600  !$acc kernels
2601  !$acc loop collapse(3) independent
2602  do j = jsb, jeb
2603  do i = isb, ieb
2604  do k = ks, ke
2605  dens(k,i,j) = dens(k,i,j)
2606  momz(k,i,j) = 0.0_rp
2607  momx(k,i,j) = env_u * dens(k,i,j)
2608  momy(k,i,j) = env_v * dens(k,i,j)
2609  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
2610  enddo
2611  enddo
2612  enddo
2613  !$acc end kernels
2614 
2615  ! optional : add tracer bubble
2616  if ( bbl_ptracer > 0.0_rp ) then
2617  !$acc kernels
2618  do j = jsb, jeb
2619  do i = isb, ieb
2620  do k = ks, ke
2621  ptrc(k,i,j) = bbl_ptracer * bubble(k,i,j)
2622  enddo
2623  enddo
2624  enddo
2625  !$acc end kernels
2626  endif
2627 
2628  return
2629  end subroutine mkinit_mountainwave
2630 
2631  !-----------------------------------------------------------------------------
2636  subroutine mkinit_barocwave
2637  use scale_const, only: &
2638  ohm => const_ohm, &
2639  rplanet => const_radius, &
2640  grav => const_grav
2641  use scale_prc
2642  use scale_atmos_grid_cartesc, only: &
2643  y0 => atmos_grid_cartesc_domain_center_y, &
2644  fyg => atmos_grid_cartesc_fyg
2645  implicit none
2646 
2647  ! Parameters for global domain size
2648  real(RP) :: Ly ! The domain size in y-direction [m]
2649 
2650  ! Parameters for inital stratification
2651  real(RP) :: REF_TEMP = 288.e0_rp ! The reference temperature [K]
2652  real(RP) :: REF_PRES = 1.e5_rp ! The reference pressure [Pa]
2653  real(RP) :: LAPSE_RATE = 5.e-3_rp ! The lapse rate [K/m]
2654 
2655  ! Parameters associated with coriolis parameter on a beta-plane
2656  real(RP) :: Phi0Deg = 45.e0_rp ! The central latitude [degree_north]
2657 
2658  ! Parameters for background zonal jet
2659  real(RP) :: U0 = 35.e0_rp ! The parameter associated with zonal jet maximum amplitude [m/s]
2660  real(RP) :: b = 2.e0_rp ! The vertical half-width [1]
2661 
2662  ! Parameters for inital perturbation of zonal wind with a Gaussian profile
2663  !
2664  real(RP) :: Up = 1.e0_rp ! The maximum amplitude of zonal wind perturbation [m/s]
2665  real(RP) :: Lp = 600.e3_rp ! The width of Gaussian profile
2666  real(RP) :: Xc = 2000.e3_rp ! The center point (x) of inital perturbation
2667  real(RP) :: Yc = 2500.e3_rp ! The center point (y) of inital perturbation
2668 
2669  namelist / param_mkinit_barocwave / &
2670  ref_temp, ref_pres, lapse_rate, &
2671  phi0deg, &
2672  u0, b, &
2673  up, lp, xc, yc
2674 
2675  real(RP) :: f0, beta0
2676 
2677  real(RP) :: geopot(KA,IA,JA)
2678  real(RP) :: eta(KA,IA,JA)
2679  real(RP) :: temp(KA,IA,JA)
2680 
2681  real(RP) :: y
2682  real(RP) :: ln_eta
2683  real(RP) :: del_eta
2684  real(RP) :: yphase
2685  real(RP) :: temp_vfunc
2686  real(RP) :: geopot_hvari
2687 
2688  logical :: converged
2689 
2690  integer :: ierr
2691  integer :: k, i, j
2692 
2693  integer :: itr
2694 
2695 #ifdef _OPENACC
2696  real(RP) :: work1(KA)
2697  real(RP) :: work2(KA)
2698  real(RP) :: work3(KA)
2699 #endif
2700 
2701  logical :: error
2702 
2703  integer, parameter :: ITRMAX = 1000
2704  real(RP), parameter :: CONV_EPS = 1e-15_rp
2705  !---------------------------------------------------------------------------
2706 
2707  log_newline
2708  log_info("MKINIT_barocwave",*) 'Setup initial state'
2709 
2710  !--- read namelist
2711  rewind(io_fid_conf)
2712  read(io_fid_conf,nml=param_mkinit_barocwave,iostat=ierr)
2713 
2714  if( ierr < 0 ) then !--- missing
2715  log_info("MKINIT_barocwave",*) 'Not found namelist. Default used.'
2716  elseif( ierr > 0 ) then !--- fatal error
2717  log_error("MKINIT_barocwave",*) 'Not appropriate names in namelist PARAM_MKINIT_BAROCWAVE. Check!'
2718  call prc_abort
2719  endif
2720  log_nml(param_mkinit_barocwave)
2721 
2722  ly = fyg(jag-jhalo) - fyg(jhalo)
2723 
2724  ! Set coriolis parameters
2725  f0 = 2.0_rp*ohm*sin(phi0deg*pi/180.0_rp)
2726  beta0 = (2.0_rp*ohm/rplanet)*cos(phi0deg*pi/180.0_rp)
2727 
2728  ! Calculate eta(=p/p_s) level corresponding to z level of each (y,z) grid point
2729  ! using Newton's iteration method
2730 
2731  !$acc data create(eta)
2732 
2733  !$omp workshare
2734  !$acc kernels
2735  eta(:,:,:) = 1.0e-8_rp ! Set first guess of eta
2736  !$acc end kernels
2737  !$omp end workshare
2738 
2739  error = .false.
2740 
2741  !$omp parallel do private(y,yphase,geopot_hvari,del_eta,itr,ln_eta,temp_vfunc) reduction(.or.:error)
2742  !$acc kernels
2743  !$acc loop independent collapse(2) &
2744  !$acc private(work1,work2,work3) reduction(.or.:error)
2745  do j = jsb, jeb
2746  do i = isb, ieb ! Note that initial fields are zonaly symmetric
2747 
2748  y = cy(j)
2749  yphase = 2.0_rp*pi*y/ly
2750 
2751  ! Calc horizontal variation of geopotential height
2752  geopot_hvari = 0.5_rp*u0*( &
2753  (f0 - beta0*y0)*(y - 0.5_rp*ly*(1.0_rp + sin(yphase)/pi)) &
2754  + 0.5_rp*beta0*( y**2 - ly*y/pi*sin(yphase) - 0.5_rp*(ly/pi)**2*(cos(yphase) + 1.0_rp) &
2755  - ly**2/3.0_rp ) &
2756  )
2757 
2758  ! Set surface pressure and temperature
2759  pres_sfc(i,j) = ref_pres
2760  pott_sfc(i,j) = ref_temp - geopot_hvari/rdry
2761 
2762  do k = ks, ke
2763  del_eta = 1.0_rp
2764 
2765  !-- The loop for iteration
2766  itr = 0
2767  do while( abs(del_eta) > conv_eps )
2768  ln_eta = log(eta(k,i,j))
2769 
2770  temp_vfunc = eta(k,i,j)**(rdry*lapse_rate/grav)
2771  temp(k,i,j) = &
2772  ref_temp*temp_vfunc &
2773  + geopot_hvari/rdry*(2.0_rp*(ln_eta/b)**2 - 1.0_rp)*exp(-(ln_eta/b)**2)
2774  geopot(k,i,j) = &
2775  ref_temp*grav/lapse_rate*(1.0_rp - temp_vfunc) &
2776  + geopot_hvari*ln_eta*exp(-(ln_eta/b)**2)
2777 
2778  del_eta = - ( - grav*cz(k) + geopot(k,i,j) ) & ! <- F
2779  & *( - eta(k,i,j)/(rdry*temp(k,i,j)) ) ! <- (dF/deta)^-1
2780 
2781  eta(k,i,j) = eta(k,i,j) + del_eta
2782  itr = itr + 1
2783 
2784  if ( itr > itrmax ) then
2785  log_error("MKINIT_barocwave",*) "Fail the convergence of iteration. Check!"
2786  log_error_cont(*) "* (X,Y,Z)=", cx(i), cy(j), cz(k)
2787  log_error_cont(*) "itr=", itr, "del_eta=", del_eta, "eta=", eta(k,i,j), "temp=", temp(k,i,j)
2788 #ifdef _OPENACC
2789  error = .true.
2790 #else
2791  call prc_abort
2792 #endif
2793  end if
2794  enddo !- End of loop for iteration ----------------------------
2795 
2796  pres(k,i,j) = eta(k,i,j)*ref_pres
2797  dens(k,i,j) = pres(k,i,j)/(rdry*temp(k,i,j))
2798  pott(k,i,j) = temp(k,i,j)*eta(k,i,j)**(-rdry/cpdry)
2799 
2800  enddo
2801 
2802  ! Make density & pressure profile in dry condition using the profile of
2803  ! potential temperature calculated above.
2804  call hydrostatic_buildrho( ka, ks, ke, &
2805  pott(:,i,j), qv(:,i,j), qc(:,i,j), & ! [IN]
2806  pres_sfc(i,j), pott_sfc(i,j), qv_sfc(i,j), qc_sfc(i,j), & ! [IN]
2807  real_cz(:,i,j), real_fz(:,i,j), & ! [IN]
2808 #ifdef _OPENACC
2809  work1(:), work2(:), work3(:), & ! [WORK]
2810 #endif
2811  dens(:,i,j), temp(:,i,j), pres(:,i,j), temp_sfc(i,j), & ! [OUT]
2812  converged ) ! [OUT]
2813  enddo
2814  enddo
2815  !$acc end kernels
2816 
2817  if ( error ) then
2818  call prc_abort
2819  end if
2820 
2821  !-----------------------------------------------------------------------------------
2822 
2823  !$acc kernels
2824  !$acc loop collapse(2) independent
2825  do j = jsb, jeb
2826  do k = ks, ke
2827 
2828  eta(k,is,j) = pres(k,is,j)/ref_pres
2829  ln_eta = log(eta(k,is,j))
2830  yphase = 2.0_rp*pi*cy(j)/ly
2831 !!$ PRES(k,IS:IE,j) = eta(k,IS,j)*REF_PRES
2832 !!$ DENS(k,IS:IE,j) = PRES(k,IS,j)/(Rdry*temp(k,IS,j))
2833  !$acc loop independent
2834  do i = is, ie
2835  dens(k,i,j) = dens(k,is,j)
2836  pres(k,i,j) = pres(k,is,j)
2837  rhot(k,i,j) = dens(k,is,j)*pott(k,is,j) !temp(k,IS,j)*eta(k,IS,j)**(-Rdry/CPdry)
2838  end do
2839  !$acc loop independent
2840  do i = is-1, ie
2841  momx(k,i,j) = dens(k,is,j)*(-u0*sin(0.5_rp*yphase)**2*ln_eta*exp(-(ln_eta/b)**2))
2842  end do
2843  enddo
2844  enddo
2845  !$acc end kernels
2846 
2847  !$acc kernels
2848  momy(:,:,:) = 0.0_rp
2849  momz(:,:,:) = 0.0_rp
2850  !$acc end kernels
2851 
2852  !---------------------------------------------------------------------------------------
2853 
2854  ! Add the inital perturbation for zonal velocity
2855  !$acc kernels
2856  !$acc loop collapse(3) independent
2857  do j = jsb, jeb
2858  do i = max(isb-1,1), ieb
2859  do k = ks, ke
2860  momx(k,i,j) = momx(k,i,j) &
2861  + dens(k,i,j)* up*exp( - ((fx(i) - xc)**2 + (cy(j) - yc)**2)/lp**2 )
2862  enddo
2863  enddo
2864  enddo
2865  !$acc end kernels
2866 
2867  !$acc end data
2868 
2869  return
2870  end subroutine mkinit_barocwave
2871 
2872  !-----------------------------------------------------------------------------
2874  subroutine mkinit_warmbubble
2875  use scale_atmos_hydrometeor, only: &
2876  atmos_hydrometeor_dry
2877  implicit none
2878 
2879  ! Surface state
2880  real(RP) :: SFC_THETA ! surface potential temperature [K]
2881  real(RP) :: SFC_PRES ! surface pressure [Pa]
2882  real(RP) :: SFC_RH = 80.0_rp ! surface relative humidity [%]
2883  ! Environment state
2884  real(RP) :: ENV_U = 0.0_rp ! velocity u of environment [m/s]
2885  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
2886  real(RP) :: ENV_RH = 80.0_rp ! Relative Humidity of environment [%]
2887  real(RP) :: ENV_L1_ZTOP = 1.e3_rp ! top height of the layer1 (constant THETA) [m]
2888  real(RP) :: ENV_L2_ZTOP = 14.e3_rp ! top height of the layer2 (small THETA gradient) [m]
2889  real(RP) :: ENV_L2_TLAPS = 4.e-3_rp ! Lapse rate of THETA in the layer2 (small THETA gradient) [K/m]
2890  real(RP) :: ENV_L3_TLAPS = 3.e-2_rp ! Lapse rate of THETA in the layer3 (large THETA gradient) [K/m]
2891  ! Bubble
2892  real(RP) :: BBL_THETA = 1.0_rp ! extremum of temperature in bubble [K]
2893 
2894  namelist / param_mkinit_warmbubble / &
2895  sfc_theta, &
2896  sfc_pres, &
2897  env_u, &
2898  env_v, &
2899  env_rh, &
2900  env_l1_ztop, &
2901  env_l2_ztop, &
2902  env_l2_tlaps, &
2903  env_l3_tlaps, &
2904  bbl_theta
2905 
2906  logical :: converged
2907 
2908 #ifdef _OPENACC
2909  real(RP) :: work1(KA)
2910  real(RP) :: work2(KA)
2911  real(RP) :: work3(KA)
2912 #endif
2913 
2914  integer :: ierr
2915  integer :: k, i, j, itr
2916  !---------------------------------------------------------------------------
2917 
2918  log_newline
2919  log_info("MKINIT_warmbubble",*) 'Setup initial state'
2920 
2921  if ( atmos_hydrometeor_dry ) then
2922  log_error("MKINIT_warmbubble",*) 'QV is not registered'
2923  call prc_abort
2924  end if
2925 
2926  sfc_theta = thetastd
2927  sfc_pres = pstd
2928 
2929  !--- read namelist
2930  rewind(io_fid_conf)
2931  read(io_fid_conf,nml=param_mkinit_warmbubble,iostat=ierr)
2932 
2933  if( ierr < 0 ) then !--- missing
2934  log_info("MKINIT_warmbubble",*) 'Not found namelist. Default used.'
2935  elseif( ierr > 0 ) then !--- fatal error
2936  log_error("MKINIT_warmbubble",*) 'Not appropriate names in namelist PARAM_MKINIT_WARMBUBBLE. Check!'
2937  call prc_abort
2938  endif
2939  log_nml(param_mkinit_warmbubble)
2940 
2941  ! calc in dry condition
2942  !$acc kernels
2943  pres_sfc(1,1) = sfc_pres
2944  pott_sfc(1,1) = sfc_theta
2945  !$acc end kernels
2946 
2947  !$acc kernels
2948  !$acc loop seq
2949  do k = ks, ke
2950  if ( cz(k) <= env_l1_ztop ) then ! Layer 1
2951  pott(k,1,1) = sfc_theta
2952  elseif( cz(k) < env_l2_ztop ) then ! Layer 2
2953  pott(k,1,1) = pott(k-1,1,1) + env_l2_tlaps * ( cz(k)-cz(k-1) )
2954  else ! Layer 3
2955  pott(k,1,1) = pott(k-1,1,1) + env_l3_tlaps * ( cz(k)-cz(k-1) )
2956  endif
2957  enddo
2958  !$acc end kernels
2959 
2960  ! make density & pressure profile in dry condition
2961  call hydrostatic_buildrho( ka, ks, ke, &
2962  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
2963  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
2964  cz(:), fz(:), & ! [IN]
2965 #ifdef _OPENACC
2966  work1(:), work2(:), work3(:), & ! [WORK]
2967 #endif
2968  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
2969  converged ) ! [OUT]
2970 
2971  ! calc QV from RH
2972  call saturation_pres2qsat_all( temp_sfc(1,1), pres_sfc(1,1), & ! [IN]
2973  qsat_sfc(1,1) ) ! [OUT]
2974  !$acc kernels
2975  qv_sfc(1,1) = sfc_rh * 1.e-2_rp * qsat_sfc(1,1)
2976  !$acc end kernels
2977 
2978  do itr = 1, niter_rh
2979  call saturation_psat_all( ka, ks, ke, &
2980  temp(:,1,1), & ! [IN]
2981  psat(:,1,1) ) ! [OUT]
2982  !$acc kernels
2983  do k = ks, ke
2984  if( cz(k) <= env_l2_ztop ) then ! Layer 1 and 2
2985  qv(k,1,1) = env_rh * 1.e-2_rp * psat(k,1,1) / ( dens(k,1,1) * rvap * temp(k,1,1) )
2986  else ! Layer 3
2987  qv(k,1,1) = 0.0_rp
2988  endif
2989  enddo
2990  !$acc end kernels
2991 
2992  ! make density & pressure profile in moist condition
2993  call hydrostatic_buildrho( ka, ks, ke, &
2994  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
2995  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
2996  cz(:), fz(:), & ! [IN]
2997 #ifdef _OPENACC
2998  work1(:), work2(:), work3(:), & ! [WORK]
2999 #endif
3000  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
3001  converged ) ! [OUT]
3002  end do
3003 
3004  !$acc kernels
3005  !$acc loop collapse(3) independent
3006  do j = jsb, jeb
3007  do i = isb, ieb
3008  do k = ks, ke
3009  dens(k,i,j) = dens(k,1,1)
3010  momz(k,i,j) = 0.0_rp
3011  momx(k,i,j) = env_u * dens(k,i,j)
3012  momy(k,i,j) = env_v * dens(k,i,j)
3013 
3014  ! make warm bubble
3015  rhot(k,i,j) = dens(k,1,1) * ( pott(k,1,1) + bbl_theta * bubble(k,i,j) )
3016 
3017  qv(k,i,j) = qv(k,1,1)
3018  enddo
3019  enddo
3020  enddo
3021  !$acc end kernels
3022 
3023  call flux_setup
3024 
3025  return
3026  end subroutine mkinit_warmbubble
3027 
3028  !-----------------------------------------------------------------------------
3030  subroutine mkinit_supercell
3031  use scale_atmos_hydrometeor, only: &
3032  atmos_hydrometeor_dry
3033  implicit none
3034 
3035  real(RP) :: RHO(KA)
3036  real(RP) :: VELX(KA)
3037  real(RP) :: VELY(KA)
3038  real(RP) :: POTT(KA)
3039  real(RP) :: QV1D(KA)
3040 
3041  ! Bubble
3042  real(RP) :: BBL_THETA = 3.d0 ! extremum of temperature in bubble [K]
3043 
3044  namelist / param_mkinit_supercell / &
3045  bbl_theta
3046 
3047  integer :: ierr
3048  integer :: k, i, j
3049  !---------------------------------------------------------------------------
3050 
3051  log_newline
3052  log_info("MKINIT_supercell",*) 'Setup initial state'
3053 
3054  if ( atmos_hydrometeor_dry ) then
3055  log_error("MKINIT_supercell",*) 'QV is not registered'
3056  call prc_abort
3057  end if
3058 
3059  !--- read namelist
3060  rewind(io_fid_conf)
3061  read(io_fid_conf,nml=param_mkinit_supercell,iostat=ierr)
3062 
3063  if( ierr < 0 ) then !--- missing
3064  log_info("MKINIT_supercell",*) 'Not found namelist. Default used.'
3065  elseif( ierr > 0 ) then !--- fatal error
3066  log_error("MKINIT_supercell",*) 'Not appropriate names in namelist PARAM_MKINIT_SUPERCELL. Check!'
3067  call prc_abort
3068  endif
3069  log_nml(param_mkinit_supercell)
3070 
3071  call read_sounding( rho, velx, vely, pott, qv1d ) ! (out)
3072 
3073  !$acc kernels
3074  !$acc loop collapse(3) independent
3075  do j = jsb, jeb
3076  do i = isb, ieb
3077  do k = ks, ke
3078  dens(k,i,j) = rho(k)
3079  momz(k,i,j) = 0.0_rp
3080  momx(k,i,j) = rho(k) * velx(k)
3081  momy(k,i,j) = rho(k) * vely(k)
3082 
3083  ! make warm bubble
3084  rhot(k,i,j) = rho(k) * ( pott(k) + bbl_theta * bubble(k,i,j) )
3085 
3086  qv(k,i,j) = qv1d(k)
3087  enddo
3088  enddo
3089  enddo
3090  !$acc end kernels
3091 
3092  call flux_setup
3093 
3094  return
3095  end subroutine mkinit_supercell
3096 
3097  !-----------------------------------------------------------------------------
3099  subroutine mkinit_squallline
3100  use scale_atmos_hydrometeor, only: &
3101  atmos_hydrometeor_dry
3102  implicit none
3103 
3104  real(RP) :: RHO(KA)
3105  real(RP) :: VELX(KA)
3106  real(RP) :: VELY(KA)
3107  real(RP) :: POTT(KA)
3108  real(RP) :: QV1D(KA)
3109 
3110  real(RP) :: RANDOM_THETA = 0.01_rp
3111  real(RP) :: OFFSET_velx = 12.0_rp
3112  real(RP) :: OFFSET_vely = -2.0_rp
3113 
3114  namelist / param_mkinit_squallline / &
3115  random_theta, &
3116  offset_velx, &
3117  offset_vely
3118 
3119  integer :: ierr
3120  integer :: k, i, j
3121  !---------------------------------------------------------------------------
3122 
3123  log_newline
3124  log_info("MKINIT_squallline",*) 'Setup initial state'
3125 
3126  if ( atmos_hydrometeor_dry ) then
3127  log_error("MKINIT_squallline",*) 'QV is not registered'
3128  call prc_abort
3129  end if
3130 
3131  !--- read namelist
3132  rewind(io_fid_conf)
3133  read(io_fid_conf,nml=param_mkinit_squallline,iostat=ierr)
3134 
3135  if( ierr < 0 ) then !--- missing
3136  log_info("MKINIT_squallline",*) 'Not found namelist. Default used.'
3137  elseif( ierr > 0 ) then !--- fatal error
3138  log_error("MKINIT_squallline",*) 'Not appropriate names in namelist PARAM_MKINIT_SQUALLLINE. Check!'
3139  call prc_abort
3140  endif
3141  log_nml(param_mkinit_squallline)
3142 
3143  call read_sounding( rho, velx, vely, pott, qv1d ) ! (out)
3144 
3145  call random_uniform(rndm) ! make random
3146  !$acc kernels
3147  !$acc loop collapse(3) independent
3148  do j = jsb, jeb
3149  do i = isb, ieb
3150  do k = ks, ke
3151  dens(k,i,j) = rho(k)
3152  momz(k,i,j) = 0.0_rp
3153  momx(k,i,j) = ( velx(k) - offset_velx ) * rho(k)
3154  momy(k,i,j) = ( vely(k) - offset_vely ) * rho(k)
3155  rhot(k,i,j) = rho(k) * ( pott(k) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_theta )
3156  qv(k,i,j) = qv1d(k)
3157  enddo
3158  enddo
3159  enddo
3160  !$acc end kernels
3161 
3162  call flux_setup
3163 
3164  return
3165  end subroutine mkinit_squallline
3166 
3167  !-----------------------------------------------------------------------------
3169  subroutine mkinit_wk1982
3170  use scale_atmos_hydrometeor, only: &
3171  atmos_hydrometeor_dry
3172  implicit none
3173 
3174  ! Surface state
3175  real(RP) :: SFC_THETA = 300.0_rp ! surface pot. temperature [K]
3176  real(RP) :: SFC_PRES ! surface pressure [Pa]
3177  ! Parameter in Weisman and Klemp (1982)
3178  real(RP) :: TR_Z = 12000.0_rp ! height of tropopause [m]
3179  real(RP) :: TR_THETA = 343.0_rp ! pot. temperature at tropopause [K]
3180  real(RP) :: TR_TEMP = 213.0_rp ! temperature at tropopause [K]
3181  real(RP) :: SHEAR_Z = 3000.0_rp ! center height of shear layer [m]
3182  real(RP) :: SHEAR_U = 15.0_rp ! velocity u over the shear layer [m/s]
3183  real(RP) :: QV0 = 14.0_rp ! maximum vapor mixing ration [g/kg]
3184  ! Bubble
3185  real(RP) :: BBL_THETA = 3.d0 ! extremum of temperature in bubble [K]
3186 
3187  namelist / param_mkinit_wk1982 / &
3188  sfc_theta, &
3189  sfc_pres, &
3190  tr_z, &
3191  tr_theta, &
3192  tr_temp, &
3193  shear_z, &
3194  shear_u, &
3195  qv0, &
3196  bbl_theta
3197 
3198  real(RP) :: rh (KA,IA,JA)
3199  real(RP) :: rh_sfc( IA,JA)
3200 
3201  integer :: ierr
3202  integer :: k, i, j, itr
3203  !---------------------------------------------------------------------------
3204 
3205  log_newline
3206  log_info("MKINIT_wk1982",*) 'Setup initial state'
3207 
3208  if ( atmos_hydrometeor_dry ) then
3209  log_error("MKINIT_wk1982",*) 'QV is not registered'
3210  call prc_abort
3211  end if
3212 
3213  sfc_pres = pstd
3214 
3215  rewind(io_fid_conf)
3216  read(io_fid_conf,nml=param_mkinit_wk1982,iostat=ierr)
3217  if( ierr < 0 ) then !--- missing
3218  log_info("MKINIT_wk1982",*) 'Not found namelist. Default used.'
3219  elseif( ierr > 0 ) then !--- fatal error
3220  log_error("MKINIT_wk1982",*) 'Not appropriate names in namelist PARAM_MKINIT_WK1982. Check!'
3221  call prc_abort
3222  endif
3223  log_nml(param_mkinit_wk1982)
3224 
3225  ! calc in dry condition
3226  !$acc kernels
3227  do j = jsb, jeb
3228  do i = isb, ieb
3229  pres_sfc(i,j) = sfc_pres
3230  pott_sfc(i,j) = sfc_theta
3231 
3232  do k = ks, ke
3233  if ( real_cz(k,i,j) <= tr_z ) then ! below initial cloud top
3234  pott(k,i,j) = pott_sfc(i,j) &
3235  + ( tr_theta - pott_sfc(i,j) ) * ( real_cz(k,i,j) / tr_z )**1.25_rp
3236  else
3237  pott(k,i,j) = tr_theta * exp( grav * ( real_cz(k,i,j) - tr_z ) / cpdry / tr_temp )
3238  endif
3239  enddo
3240  enddo
3241  enddo
3242  !$acc end kernels
3243 
3244  ! make density & pressure profile in dry condition
3245  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3246  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3247  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3248  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3249  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3250 
3251  !$acc data create(rh,rh_sfc)
3252 
3253  ! calc QV from RH
3254  !$acc kernels
3255  do j = jsb, jeb
3256  do i = isb, ieb
3257  rh_sfc(i,j) = 1.0_rp - 0.75_rp * ( real_fz(ks-1,i,j) / tr_z )**1.25_rp
3258 
3259  do k = ks, ke
3260  if ( real_cz(k,i,j) <= tr_z ) then ! below initial cloud top
3261  rh(k,i,j) = 1.0_rp - 0.75_rp * ( real_cz(k,i,j) / tr_z )**1.25_rp
3262  else
3263  rh(k,i,j) = 0.25_rp
3264  endif
3265  enddo
3266  enddo
3267  enddo
3268  !$acc end kernels
3269 
3270  qv0 = qv0 * 1e-3_rp ! g/kg to kg/kg
3271  qv0 = qv0 / ( 1.0_rp + qv0 ) ! mixing ratio to specicic humidity
3272 
3273  call saturation_pres2qsat_all( ia, isb, ieb, ja, jsb, jeb, &
3274  temp_sfc(:,:), pres_sfc(:,:), & ! [IN]
3275  qsat_sfc(:,:) ) ! [OUT]
3276  !$acc kernels
3277  do j = jsb, jeb
3278  do i = isb, ieb
3279  qv_sfc(i,j) = min( rh_sfc(i,j) * qsat_sfc(i,j), qv0 )
3280  enddo
3281  enddo
3282  !$acc end kernels
3283 
3284  do itr = 1, niter_rh
3285  call saturation_psat_all( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3286  temp(:,:,:), & ! [IN]
3287  psat(:,:,:) ) ! [OUT]
3288  !$acc kernels
3289  do j = jsb, jeb
3290  do i = isb, ieb
3291  do k = ks, ke
3292  qv(k,i,j) = min( rh(k,i,j) * psat(k,i,j) / ( dens(k,i,j) * rdry * temp(k,i,j) ), qv0 )
3293  enddo
3294  enddo
3295  enddo
3296  !$acc end kernels
3297 
3298  ! make density & pressure profile in moist condition
3299  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3300  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3301  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3302  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3303  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3304  end do
3305 
3306  !$acc update host(pres(:,IS,JS),pott(:,IS,JS),rh(:,IS,JS),qv(:,IS,JS))
3307  do k = ks, ke
3308  log_info("MKINIT_wk1982",*) k, real_cz(k,is,js), pres(k,is,js), pott(k,is,js), rh(k,is,js), qv(k,is,js)*1000
3309  enddo
3310 
3311  call comm_vars8( dens(:,:,:), 1 )
3312  call comm_wait ( dens(:,:,:), 1 )
3313 
3314  !$acc kernels
3315  !$acc loop collapse(3) independent
3316  do j = jsb, jeb
3317  do i = isb, ieb
3318  do k = ks, ke
3319  momx(k,i,j) = shear_u * tanh( real_cz(k,i,j) / shear_z ) &
3320  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3321  enddo
3322  enddo
3323  enddo
3324  !$acc end kernels
3325 
3326  !$acc kernels
3327  !$acc loop collapse(3) independent
3328  do j = jsb, jeb
3329  do i = isb, ieb
3330  do k = ks, ke
3331  momy(k,i,j) = 0.0_rp
3332  momz(k,i,j) = 0.0_rp
3333  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
3334 
3335  ! make warm bubble
3336  rhot(k,i,j) = dens(k,i,j) * ( pott(k,i,j) + bbl_theta * bubble(k,i,j) )
3337  enddo
3338  enddo
3339  enddo
3340  !$acc end kernels
3341 
3342  call flux_setup
3343 
3344  !$acc end data
3345 
3346  return
3347  end subroutine mkinit_wk1982
3348 
3349  !-----------------------------------------------------------------------------
3351  subroutine mkinit_dycoms2_rf01
3352  use scale_const, only: &
3353  rdry => const_rdry, &
3354  rvap => const_rvap, &
3355  cpdry => const_cpdry, &
3356  cpvap => const_cpvap, &
3357  cl => const_cl
3358  use scale_atmos_hydrometeor, only: &
3359  atmos_hydrometeor_dry
3360  implicit none
3361 
3362 #ifndef DRY
3363  real(RP) :: PERTURB_AMP = 0.0_rp
3364  integer :: RANDOM_LIMIT = 5
3365  integer :: RANDOM_FLAG = 0 ! 0 -> no perturbation
3366  ! 1 -> petrurbation for pt
3367  ! 2 -> perturbation for u, v, w
3368  logical :: USE_LWSET = .false. ! use liq. water. static energy temp.?
3369 
3370  namelist / param_mkinit_rf01 / &
3371  perturb_amp, &
3372  random_limit, &
3373  random_flag, &
3374  use_lwset
3375 
3376  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
3377  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
3378 
3379  real(RP) :: qall ! QV+QC
3380  real(RP) :: fact
3381  real(RP) :: pi2
3382  real(RP) :: sint
3383  real(RP) :: GEOP_sw ! switch for geopotential energy correction
3384 
3385  real(RP) :: qdry, Rtot, CPtot
3386 
3387  integer :: ierr
3388  integer :: k, i, j
3389  !---------------------------------------------------------------------------
3390 
3391  pi2 = atan(1.0_rp) * 2.0_rp ! pi/2
3392 
3393  log_newline
3394  log_info("MKINIT_DYCOMS2_RF01",*) 'Setup initial state'
3395 
3396  rewind(io_fid_conf)
3397 
3398  if ( atmos_hydrometeor_dry ) then
3399  log_error("MKINIT_DYCOMS2_RF01",*) 'QV is not registered'
3400  call prc_abort
3401  end if
3402 
3403  read(io_fid_conf,nml=param_mkinit_rf01,iostat=ierr)
3404  if( ierr < 0 ) then !--- missing
3405  log_info("MKINIT_DYCOMS2_RF01",*) 'Not found namelist. Default used.'
3406  elseif( ierr > 0 ) then !--- fatal error
3407  log_error("MKINIT_DYCOMS2_RF01",*) 'Not appropriate names in namelist PARAM_MKINIT_RF01. Check!'
3408  call prc_abort
3409  endif
3410  log_nml(param_mkinit_rf01)
3411 
3412  if ( use_lwset ) then
3413  geop_sw = 1.0_rp
3414  else
3415  geop_sw = 0.0_rp
3416  endif
3417 
3418  !$acc data create(potl,lhv)
3419 
3420  ! calc in dry condition
3421  !$acc kernels
3422  do j = jsb, jeb
3423  do i = isb, ieb
3424 
3425  pres_sfc(i,j) = 1017.8e2_rp ! [Pa]
3426  pott_sfc(i,j) = 289.0_rp ! [K]
3427 
3428  do k = ks, ke
3429  velx(k,i,j) = 7.0_rp
3430  vely(k,i,j) = -5.5_rp
3431  if ( cz(k) < 820.0_rp ) then ! below initial cloud top
3432  potl(k,i,j) = 289.0_rp - grav / cpdry * cz(k) * geop_sw
3433  elseif( cz(k) <= 860.0_rp ) then
3434  sint = sin( pi2 * ( cz(k)-840.0_rp ) / 20.0_rp ) * 0.5_rp
3435  potl(k,i,j) = ( 289.0_rp - grav / cpdry * cz(k) * geop_sw ) * (0.5_rp-sint) &
3436  + ( 297.5_rp+sign(abs(cz(k)-840.0_rp)**(1.0_rp/3.0_rp),cz(k)-840.0_rp) &
3437  - grav / cpdry * cz(k) * geop_sw ) * (0.5_rp+sint)
3438  else
3439  potl(k,i,j) = 297.5_rp + ( cz(k)-840.0_rp )**(1.0_rp/3.0_rp) &
3440  - grav / cpdry * cz(k) * geop_sw
3441  endif
3442  enddo
3443 
3444  enddo
3445  enddo
3446  !$acc end kernels
3447 
3448  ! make density & pressure profile in dry condition
3449  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3450  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3451  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3452  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3453  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3454 
3455  ! calc in moist condition
3456  !$acc kernels
3457  do j = jsb, jeb
3458  do i = isb, ieb
3459  qv_sfc(i,j) = 9.0e-3_rp ! [kg/kg]
3460 
3461  do k = ks, ke
3462  if ( cz(k) < 820.0_rp ) then ! below initial cloud top
3463  qall = 9.0e-3_rp
3464  elseif( cz(k) <= 860.0_rp ) then ! boundary
3465  sint = sin( pi2 * ( cz(k)-840.0_rp ) / 20.0_rp ) * 0.5_rp
3466  qall = 9.0e-3_rp * (0.5_rp-sint) &
3467  + 1.5e-3_rp * (0.5_rp+sint)
3468  elseif( cz(k) <= 5000.0_rp ) then
3469  qall = 1.5e-3_rp
3470  else
3471  qall = 0.0_rp
3472  endif
3473 
3474  if ( cz(k) <= 600.0_rp ) then
3475  qc(k,i,j) = 0.0_rp
3476  elseif( cz(k) < 820.0_rp ) then ! in the cloud
3477  fact = ( cz(k)-600.0_rp ) / ( 840.0_rp-600.0_rp )
3478  qc(k,i,j) = 0.45e-3_rp * fact
3479  elseif( cz(k) <= 860.0_rp ) then ! boundary
3480  sint = sin( pi2 * ( cz(k)-840.0_rp ) / 20.0_rp ) * 0.5_rp
3481  fact = ( cz(k)-600.0_rp ) / ( 840.0_rp-600.0_rp )
3482  qc(k,i,j) = 0.45e-3_rp * fact * (0.5_rp-sint)
3483  else
3484  qc(k,i,j) = 0.0_rp
3485  endif
3486 
3487  qv(k,i,j) = qall - qc(k,i,j)
3488  enddo
3489 
3490  enddo
3491  enddo
3492  !$acc end kernels
3493 
3494  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3495  temp(:,:,:), lhv(:,:,:) )
3496 
3497  !$acc kernels
3498  do j = jsb, jeb
3499  do i = isb, ieb
3500  do k = ks, ke
3501  temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
3502  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
3503  rtot = rdry * qdry + rvap * qv(k,i,j)
3504  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
3505  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
3506  enddo
3507  enddo
3508  enddo
3509  !$acc end kernels
3510 
3511  ! make density & pressure profile in moist condition
3512  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3513  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3514  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3515  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3516  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3517 
3518  !$acc kernels
3519  !$acc loop collapse(2) independent
3520  do j = jsb, jeb
3521  do i = isb, ieb
3522  dens( 1:ks-1,i,j) = dens(ks,i,j)
3523  dens(ke+1:ka, i,j) = dens(ke,i,j)
3524  enddo
3525  enddo
3526  !$acc end kernels
3527 
3528  call comm_vars8( dens(:,:,:), 1 )
3529  call comm_wait ( dens(:,:,:), 1 )
3530 
3531  call random_uniform(rndm) ! make random
3532  !$acc kernels
3533  !$acc loop collapse(3) independent
3534  do j = jsb, jeb
3535  do i = isb, ieb
3536  do k = ks, ke
3537  if ( random_flag == 2 .and. k <= random_limit ) then ! below initial cloud top
3538  momz(k,i,j) = ( ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3539  * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
3540  else
3541  momz(k,i,j) = 0.0_rp
3542  endif
3543  enddo
3544  enddo
3545  enddo
3546  !$acc end kernels
3547 
3548  call random_uniform(rndm) ! make random
3549  !$acc kernels
3550  !$acc loop collapse(3) independent
3551  do j = jsb, jeb
3552  do i = isb, ieb
3553  do k = ks, ke
3554  if ( random_flag == 2 .AND. k <= random_limit ) then ! below initial cloud top
3555  momx(k,i,j) = ( velx(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3556  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3557  else
3558  momx(k,i,j) = velx(k,i,j) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3559  endif
3560  enddo
3561  enddo
3562  enddo
3563  !$acc end kernels
3564 
3565  call random_uniform(rndm) ! make random
3566  !$acc kernels
3567  !$acc loop collapse(3) independent
3568  do j = jsb, jeb
3569  do i = isb, ieb
3570  do k = ks, ke
3571  if ( random_flag == 2 .AND. k <= random_limit ) then ! below initial cloud top
3572  momy(k,i,j) = ( vely(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3573  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
3574  else
3575  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
3576  endif
3577  enddo
3578  enddo
3579  enddo
3580  !$acc end kernels
3581 
3582  call random_uniform(rndm) ! make random
3583  !$acc kernels
3584  !$acc loop collapse(3) independent
3585  do j = jsb, jeb
3586  do i = isb, ieb
3587  do k = ks, ke
3588  if ( random_flag == 1 .and. k <= random_limit ) then ! below initial cloud top
3589  rhot(k,i,j) = ( pott(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3590  * dens(k,i,j)
3591  else
3592  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
3593  endif
3594  enddo
3595  enddo
3596  enddo
3597  !$acc end kernels
3598 
3599  !$acc kernels
3600  do j = jsb, jeb
3601  do i = isb, ieb
3602  do k = ks, ke
3603  if ( qc(k,i,j) > 0.0_rp ) then
3604  nc(k,i,j) = 120.e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
3605  end if
3606  enddo
3607  enddo
3608  enddo
3609  !$acc end kernels
3610 
3611  !$acc end data
3612 
3613 #endif
3614  return
3615  end subroutine mkinit_dycoms2_rf01
3616 
3617  !-----------------------------------------------------------------------------
3619  subroutine mkinit_dycoms2_rf02
3620  use scale_const, only: &
3621  rdry => const_rdry, &
3622  rvap => const_rvap, &
3623  cpdry => const_cpdry, &
3624  cpvap => const_cpvap, &
3625  cl => const_cl
3626  use scale_atmos_hydrometeor, only: &
3627  atmos_hydrometeor_dry
3628  implicit none
3629 
3630 #ifndef DRY
3631  real(RP) :: PERTURB_AMP = 0.0_rp
3632  integer :: RANDOM_LIMIT = 5
3633  integer :: RANDOM_FLAG = 0 ! 0 -> no perturbation
3634  ! 1 -> perturbation for PT
3635  ! 2 -> perturbation for u,v,w
3636 
3637  namelist / param_mkinit_rf02 / &
3638  perturb_amp, &
3639  random_limit, &
3640  random_flag
3641 
3642  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
3643  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
3644 
3645  real(RP) :: qall ! QV+QC
3646  real(RP) :: fact
3647  real(RP) :: pi2
3648  real(RP) :: sint
3649  real(RP) :: qdry, Rtot, CPtot
3650 
3651  integer :: ierr
3652  integer :: k, i, j
3653  !---------------------------------------------------------------------------
3654 
3655  pi2 = atan(1.0_rp) * 2.0_rp ! pi/2
3656  log_newline
3657  log_info("MKINIT_DYCOMS2_RF02",*) 'Setup initial state'
3658 
3659  if ( atmos_hydrometeor_dry ) then
3660  log_error("MKINIT_DYCOMS2_RF02",*) 'QV is not registered'
3661  call prc_abort
3662  end if
3663 
3664  rewind(io_fid_conf)
3665  read(io_fid_conf,nml=param_mkinit_rf02,iostat=ierr)
3666  if( ierr < 0 ) then !--- missing
3667  log_info("MKINIT_DYCOMS2_RF02",*) 'Not found namelist. Default used.'
3668  elseif( ierr > 0 ) then !--- fatal error
3669  log_error("MKINIT_DYCOMS2_RF02",*) 'Not appropriate names in namelist PARAM_MKINIT_RF02. Check!'
3670  call prc_abort
3671  endif
3672  log_nml(param_mkinit_rf02)
3673 
3674  !$acc data create(potl,LHV)
3675 
3676  ! calc in dry condition
3677  call random_uniform(rndm) ! make random
3678  !$acc kernels
3679  do j = jsb, jeb
3680  do i = isb, ieb
3681 
3682  pres_sfc(i,j) = 1017.8e2_rp ! [Pa]
3683  pott_sfc(i,j) = 288.3_rp ! [K]
3684 
3685  do k = ks, ke
3686  velx(k,i,j) = 3.0_rp + 4.3 * cz(k)*1.e-3_rp
3687  vely(k,i,j) = -9.0_rp + 5.6 * cz(k)*1.e-3_rp
3688 
3689  if ( cz(k) < 775.0_rp ) then ! below initial cloud top
3690  potl(k,i,j) = 288.3_rp ! [K]
3691  else if ( cz(k) <= 815.0_rp ) then
3692  sint = sin( pi2 * (cz(k) - 795.0_rp)/20.0_rp )
3693  potl(k,i,j) = 288.3_rp * (1.0_rp-sint)*0.5_rp &
3694  + ( 295.0_rp+sign(abs(cz(k)-795.0_rp)**(1.0_rp/3.0_rp),cz(k)-795.0_rp) ) &
3695  * (1.0_rp+sint)*0.5_rp
3696  else
3697  potl(k,i,j) = 295.0_rp + ( cz(k)-795.0_rp )**(1.0_rp/3.0_rp)
3698  endif
3699  enddo
3700  enddo
3701  enddo
3702  !$acc end kernels
3703 
3704  ! make density & pressure profile in dry condition
3705  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3706  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3707  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3708  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3709  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3710 
3711  ! calc in moist condition
3712  !$acc kernels
3713  do j = jsb, jeb
3714  do i = isb, ieb
3715  qv_sfc(i,j) = 9.45e-3_rp
3716 
3717  do k = ks, ke
3718  if ( cz(k) < 775.0_rp ) then ! below initial cloud top
3719  qall = 9.45e-3_rp ! [kg/kg]
3720  else if ( cz(k) <= 815.0_rp ) then
3721  sint = sin( pi2 * (cz(k) - 795.0_rp)/20.0_rp )
3722  qall = 9.45e-3_rp * (1.0_rp-sint)*0.5_rp + &
3723  ( 5.e-3_rp - 3.e-3_rp * ( 1.0_rp - exp( (795.0_rp-cz(k))/500.0_rp ) ) ) * (1.0_rp+sint)*0.5_rp
3724  else
3725  qall = 5.e-3_rp - 3.e-3_rp * ( 1.0_rp - exp( (795.0_rp-cz(k))/500.0_rp ) ) ! [kg/kg]
3726  endif
3727 
3728  if( cz(k) < 400.0_rp ) then
3729  qc(k,i,j) = 0.0_rp
3730  elseif( cz(k) < 775.0_rp ) then
3731  fact = ( cz(k)-400.0_rp ) / ( 795.0_rp-400.0_rp )
3732  qc(k,i,j) = 0.65e-3_rp * fact
3733  elseif( cz(k) <= 815.0_rp ) then
3734  sint = sin( pi2 * ( cz(k)-795.0_rp )/20.0_rp )
3735  fact = ( cz(k)-400.0_rp ) / ( 795.0_rp-400.0_rp )
3736  qc(k,i,j) = 0.65e-3_rp * fact * (1.0_rp-sint) * 0.5_rp
3737  else
3738  qc(k,i,j) = 0.0_rp
3739  endif
3740  qv(k,i,j) = qall - qc(k,i,j)
3741  enddo
3742 
3743  enddo
3744  enddo
3745  !$acc end kernels
3746 
3747  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3748  temp(:,:,:), lhv(:,:,:) )
3749 
3750  !$acc kernels
3751  do j = jsb, jeb
3752  do i = isb, ieb
3753  do k = ks, ke
3754  temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
3755  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
3756  rtot = rdry * qdry + rvap * qv(k,i,j)
3757  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
3758  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
3759  enddo
3760  enddo
3761  enddo
3762  !$acc end kernels
3763 
3764  ! make density & pressure profile in moist condition
3765  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3766  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3767  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3768  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3769  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3770 
3771  !$acc kernels
3772  !$acc loop collapse(2) independent
3773  do j = jsb, jeb
3774  do i = isb, ieb
3775  dens( 1:ks-1,i,j) = dens(ks,i,j)
3776  dens(ke+1:ka, i,j) = dens(ke,i,j)
3777  enddo
3778  enddo
3779  !$acc end kernels
3780 
3781  call comm_vars8( dens(:,:,:), 1 )
3782  call comm_wait ( dens(:,:,:), 1 )
3783 
3784  call random_uniform(rndm) ! make random
3785  !$acc kernels
3786  !$acc loop collapse(3) independent
3787  do j = jsb, jeb
3788  do i = isb, ieb
3789  do k = ks, ke
3790  if( random_flag == 2 .and. k <= random_limit ) then
3791  momz(k,i,j) = ( 0.0_rp + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3792  * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
3793  else
3794  momz(k,i,j) = 0.0_rp
3795  endif
3796  enddo
3797  enddo
3798  enddo
3799  !$acc end kernels
3800 
3801  call random_uniform(rndm) ! make random
3802  !$acc kernels
3803  !$acc loop collapse(3) independent
3804  do j = jsb, jeb
3805  do i = isb, ieb
3806  do k = ks, ke
3807  if( random_flag == 2 .and. k <= random_limit ) then
3808  momx(k,i,j) = ( velx(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3809  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3810  else
3811  momx(k,i,j) = ( velx(k,i,j) ) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3812  endif
3813  enddo
3814  enddo
3815  enddo
3816  !$acc end kernels
3817 
3818  call random_uniform(rndm) ! make random
3819  !$acc kernels
3820  !$acc loop collapse(3) independent
3821  do j = jsb, jeb
3822  do i = isb, ieb
3823  do k = ks, ke
3824  if( random_flag == 2 .and. k <= random_limit ) then
3825  momy(k,i,j) = ( vely(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3826  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
3827  else
3828  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
3829  endif
3830  enddo
3831  enddo
3832  enddo
3833  !$acc end kernels
3834 
3835  call random_uniform(rndm) ! make random
3836  !$acc kernels
3837  !$acc loop collapse(3) independent
3838  do j = jsb, jeb
3839  do i = isb, ieb
3840  do k = ks, ke
3841  if( random_flag == 1 .and. k <= random_limit ) then
3842  rhot(k,i,j) = ( pott(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3843  * dens(k,i,j)
3844  else
3845  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
3846  endif
3847  enddo
3848  enddo
3849  enddo
3850  !$acc end kernels
3851 
3852  !$acc kernels
3853  do j = jsb, jeb
3854  do i = isb, ieb
3855  do k = ks, ke
3856  if ( qc(k,i,j) > 0.0_rp ) then
3857  nc(k,i,j) = 55.0e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
3858  endif
3859  enddo
3860  enddo
3861  enddo
3862  !$acc end kernels
3863 
3864  !$acc end data
3865 
3866 #endif
3867  return
3868  end subroutine mkinit_dycoms2_rf02
3869 
3870  !-----------------------------------------------------------------------------
3872  subroutine mkinit_dycoms2_rf02_dns
3873  use scale_const, only: &
3874  rdry => const_rdry, &
3875  rvap => const_rvap, &
3876  cpdry => const_cpdry, &
3877  cpvap => const_cpvap, &
3878  cl => const_cl
3879  use scale_atmos_hydrometeor, only: &
3880  atmos_hydrometeor_dry
3881  implicit none
3882 
3883 #ifndef DRY
3884  real(RP) :: ZB = 750.0_rp ! domain bottom
3885 ! real(RP) :: ZT = 900.0_RP ! domain top
3886  real(RP) :: CONST_U = 0.0_rp
3887  real(RP) :: CONST_V = 0.0_rp
3888  real(RP) :: PRES_ZB = 93060.0_rp
3889  real(RP) :: PERTURB_AMP = 0.0_rp
3890  integer :: RANDOM_LIMIT = 5
3891  integer :: RANDOM_FLAG = 0 ! 0 -> no perturbation
3892  ! 1 -> perturbation for PT
3893  ! 2 -> perturbation for u,v,w
3894 
3895  namelist / param_mkinit_rf02_dns / &
3896  zb, const_u, const_v,pres_zb,&
3897  perturb_amp, &
3898  random_limit, &
3899  random_flag
3900 
3901  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
3902  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
3903 
3904  real(RP) :: qall ! QV+QC
3905  real(RP) :: fact
3906  real(RP) :: pi2
3907 
3908  real(RP) :: qdry, Rtot, CPtot
3909 
3910  integer :: ierr
3911  integer :: k, i, j
3912  !---------------------------------------------------------------------------
3913 
3914  pi2 = atan(1.0_rp) * 2.0_rp ! pi/2
3915 
3916  log_newline
3917  log_info("MKINIT_DYCOMS2_RF02_DNS",*) 'Setup initial state'
3918 
3919  if ( atmos_hydrometeor_dry ) then
3920  log_error("MKINIT_DYCOMS2_RF02_DNS",*) 'QV is not registered'
3921  call prc_abort
3922  end if
3923 
3924  rewind(io_fid_conf)
3925  read(io_fid_conf,nml=param_mkinit_rf02_dns,iostat=ierr)
3926  if( ierr < 0 ) then !--- missing
3927  log_info("MKINIT_DYCOMS2_RF02_DNS",*) 'Not found namelist. Default used.'
3928  elseif( ierr > 0 ) then !--- fatal error
3929  log_error("MKINIT_DYCOMS2_RF02_DNS",*) 'Not appropriate names in namelist PARAM_MKINIT_RF02_DNS. Check!'
3930  call prc_abort
3931  endif
3932  log_nml(param_mkinit_rf02_dns)
3933 
3934  !$acc data create(potl,LHV)
3935 
3936  ! calc in dry condition
3937  call random_uniform(rndm) ! make random
3938  !$acc kernels
3939  do j = jsb, jeb
3940  do i = isb, ieb
3941 
3942  pres_sfc(i,j) = pres_zb
3943 ! pott_sfc(i,j) = 288.3_RP ! [K]
3944 ! qv_sfc (i,j) = 9.45E-3_RP
3945 
3946  do k = ks, ke
3947 
3948  velx(k,i,j) = const_u
3949  vely(k,i,j) = const_v
3950 
3951 ! if ( ZB+CZ(k) < 775.0_RP ) then ! below initial cloud top
3952  if ( zb+cz(k) <= 795.0_rp ) then ! below initial cloud top
3953  potl(k,i,j) = 288.3_rp ! [K]
3954  qall = 9.45e-3_rp ! [kg/kg]
3955 ! necessary?
3956 ! else if ( CZ(k) <= 815.0_RP ) then
3957 ! sint = sin( pi2 * (CZ(k) - 795.0_RP)/20.0_RP )
3958 ! potl(k,i,j) = 288.3_RP * (1.0_RP-sint)*0.5_RP + &
3959 ! ( 295.0_RP+sign(abs(CZ(k)-795.0_RP)**(1.0_RP/3.0_RP),CZ(k)-795.0_RP) ) * (1.0_RP+sint)*0.5_RP
3960 ! qall = 9.45E-3_RP * (1.0_RP-sint)*0.5_RP + &
3961 ! ( 5.E-3_RP - 3.E-3_RP * ( 1.0_RP - exp( (795.0_RP-CZ(k))/500.0_RP ) ) ) * (1.0_RP+sint)*0.5_RP
3962  else
3963  potl(k,i,j) = 295.0_rp + ( zb+cz(k)-795.0_rp )**(1.0_rp/3.0_rp)
3964  qall = 5.e-3_rp - 3.e-3_rp * ( 1.0_rp - exp( (795.0_rp-(zb+cz(k)))/500.0_rp ) ) ! [kg/kg]
3965  endif
3966 
3967  if( zb+cz(k) < 400.0_rp ) then
3968  qc(k,i,j) = 0.0_rp
3969  elseif( zb+cz(k) <= 795.0_rp ) then
3970  fact = ( (zb+cz(k))-400.0_rp ) / ( 795.0_rp-400.0_rp )
3971  qc(k,i,j) = 0.8e-3_rp * fact
3972  else
3973  qc(k,i,j) = 0.0_rp
3974  endif
3975  qv(k,i,j) = qall - qc(k,i,j)
3976 
3977  !if(i==is.and.j==js)LOG_INFO("MKINIT_DYCOMS2_RF02_DNS",*)'chkk',k,cz(k)+zb,qc(k,i,j),qv(k,i,j)
3978  enddo
3979  enddo
3980  enddo
3981  !$acc end kernels
3982 
3983  !LOG_INFO("MKINIT_DYCOMS2_RF02_DNS",*)'chk3',ks,ke
3984  ! extrapolation (temtative)
3985  !$acc kernels
3986  pott_sfc(:,:) = potl(ks,:,:)-0.5*(potl(ks+1,:,:)-potl(ks,:,:))
3987  qv_sfc(:,:) = qv(ks,:,:)-0.5*(qv(ks+1,:,:)-qv(ks,:,:))
3988  qc_sfc(:,:) = qc(ks,:,:)-0.5*(qc(ks+1,:,:)-qc(ks,:,:))
3989  !$acc end kernels
3990 
3991  ! make density & pressure profile in moist condition
3992  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3993  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3994  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3995  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3996  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3997 
3998  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3999  temp(:,:,:), lhv(:,:,:) )
4000 
4001  !$acc kernels
4002  do j = jsb, jeb
4003  do i = isb, ieb
4004  do k = ks, ke
4005  temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
4006  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
4007  rtot = rdry * qdry + rvap * qv(k,i,j)
4008  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
4009  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
4010  enddo
4011  enddo
4012  enddo
4013  !$acc end kernels
4014 
4015  ! make density & pressure profile in moist condition
4016  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4017  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4018  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4019  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4020  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4021 
4022  !$acc kernels
4023  !$acc loop collapse(2) independent
4024  do j = jsb, jeb
4025  do i = isb, ieb
4026  dens( 1:ks-1,i,j) = dens(ks,i,j)
4027  dens(ke+1:ka, i,j) = dens(ke,i,j)
4028  enddo
4029  enddo
4030  !$acc end kernels
4031 
4032  call comm_vars8( dens(:,:,:), 1 )
4033  call comm_wait ( dens(:,:,:), 1 )
4034 
4035  call random_uniform(rndm) ! make random
4036  !$acc kernels
4037  !$acc loop collapse(3) independent
4038  do j = jsb, jeb
4039  do i = isb, ieb
4040  do k = ks, ke
4041  if( random_flag == 2 .and. k <= random_limit ) then
4042  momz(k,i,j) = ( 0.0_rp + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4043  * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
4044  else
4045  momz(k,i,j) = 0.0_rp
4046  endif
4047  enddo
4048  enddo
4049  enddo
4050  !$acc end kernels
4051 
4052  !LOG_INFO("MKINIT_DYCOMS2_RF02_DNS",*)'chk8'
4053  call random_uniform(rndm) ! make random
4054  !$acc kernels
4055  !$acc loop collapse(3) independent
4056  do j = jsb, jeb
4057  do i = isb, ieb
4058  do k = ks, ke
4059  if( random_flag == 2 .and. k <= random_limit ) then
4060  momx(k,i,j) = ( velx(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4061  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4062  else
4063  momx(k,i,j) = ( velx(k,i,j) ) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4064  endif
4065  enddo
4066  enddo
4067  enddo
4068  !$acc end kernels
4069  !LOG_INFO("MKINIT_DYCOMS2_RF02_DNS",*)'chk9'
4070 
4071  call random_uniform(rndm) ! make random
4072  !$acc kernels
4073  !$acc loop collapse(3) independent
4074  do j = jsb, jeb
4075  do i = isb, ieb
4076  do k = ks, ke
4077  if( random_flag == 2 .and. k <= random_limit ) then
4078  momy(k,i,j) = ( vely(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4079  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4080  else
4081  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4082  endif
4083  enddo
4084  enddo
4085  enddo
4086  !$acc end kernels
4087 
4088  call random_uniform(rndm) ! make random
4089  !$acc kernels
4090  !$acc loop collapse(3) independent
4091  do j = jsb, jeb
4092  do i = isb, ieb
4093  do k = ks, ke
4094  if( random_flag == 1 .and. k <= random_limit ) then
4095  rhot(k,i,j) = ( pott(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4096  * dens(k,i,j)
4097  else
4098  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
4099  endif
4100  enddo
4101  enddo
4102  enddo
4103  !$acc end kernels
4104 
4105  !$acc kernels
4106  do j = jsb, jeb
4107  do i = isb, ieb
4108  do k = ks, ke
4109  if ( qc(k,i,j) > 0.0_rp ) then
4110  nc(k,i,j) = 55.0e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
4111  endif
4112  enddo
4113  enddo
4114  enddo
4115  !$acc end kernels
4116 
4117  !$acc end data
4118 
4119 #endif
4120  return
4121  end subroutine mkinit_dycoms2_rf02_dns
4122 
4123  !-----------------------------------------------------------------------------
4125  subroutine mkinit_rico
4126  use scale_const, only: &
4127  rdry => const_rdry, &
4128  rvap => const_rvap, &
4129  cpdry => const_cpdry, &
4130  cpvap => const_cpvap, &
4131  cl => const_cl
4132  use scale_atmos_hydrometeor, only: &
4133  atmos_hydrometeor_dry
4134  implicit none
4135 
4136 #ifndef DRY
4137  real(RP):: PERTURB_AMP_PT = 0.1_rp
4138  real(RP):: PERTURB_AMP_QV = 2.5e-5_rp
4139 
4140  namelist / param_mkinit_rico / &
4141  perturb_amp_pt, &
4142  perturb_amp_qv
4143 
4144  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
4145  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
4146  real(RP) :: qall ! QV+QC
4147  real(RP) :: fact
4148 
4149  real(RP) :: qdry, Rtot, CPtot
4150 
4151  integer :: ierr
4152  integer :: k, i, j
4153  !---------------------------------------------------------------------------
4154 
4155  log_newline
4156  log_info("MKINIT_RICO",*) 'Setup initial state'
4157 
4158  if ( atmos_hydrometeor_dry ) then
4159  log_error("MKINIT_RICO",*) 'QV is not registered'
4160  call prc_abort
4161  end if
4162 
4163  rewind(io_fid_conf)
4164  read(io_fid_conf,nml=param_mkinit_rico,iostat=ierr)
4165  if( ierr < 0 ) then !--- missing
4166  log_info("MKINIT_RICO",*) 'Not found namelist. Default used.'
4167  elseif( ierr > 0 ) then !--- fatal error
4168  log_error("MKINIT_RICO",*) 'Not appropriate names in namelist PARAM_MKINIT_RICO. Check!'
4169  call prc_abort
4170  endif
4171  log_nml(param_mkinit_rico)
4172 
4173  !$acc data create(potl,LHV)
4174 
4175  ! calc in moist condition
4176  !$acc kernels
4177  do j = jsb, jeb
4178  do i = isb, ieb
4179 
4180  pres_sfc(i,j) = 1015.4e2_rp ! [Pa]
4181  pott_sfc(i,j) = 297.9_rp
4182 
4183  do k = ks, ke
4184  !--- potential temperature
4185  if ( cz(k) < 740.0_rp ) then ! below initial cloud top
4186  potl(k,i,j) = 297.9_rp
4187  else
4188  fact = ( cz(k)-740.0_rp ) * ( 317.0_rp-297.9_rp ) / ( 4000.0_rp-740.0_rp )
4189  potl(k,i,j) = 297.9_rp + fact
4190  endif
4191 
4192  !--- horizontal wind velocity
4193  if ( cz(k) <= 4000.0_rp ) then ! below initial cloud top
4194  fact = ( cz(k)-0.0_rp ) * ( -1.9_rp+9.9_rp ) / ( 4000.0_rp-0.0_rp )
4195  velx(k,i,j) = -9.9_rp + fact
4196  vely(k,i,j) = -3.8_rp
4197  else
4198  velx(k,i,j) = -1.9_rp
4199  vely(k,i,j) = -3.8_rp
4200  endif
4201  enddo
4202 
4203  enddo
4204  enddo
4205  !$acc end kernels
4206 
4207  ! make density & pressure profile in moist condition
4208  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4209  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4210  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4211  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4212  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4213 
4214 
4215  !$acc kernels
4216  do j = jsb, jeb
4217  do i = isb, ieb
4218  qv_sfc(i,j) = 16.0e-3_rp ! [kg/kg]
4219 
4220  do k = ks, ke
4221  !--- mixing ratio of vapor
4222  if ( cz(k) <= 740.0_rp ) then ! below initial cloud top
4223  fact = ( cz(k)-0.0_rp ) * ( 13.8e-3_rp-16.0e-3_rp ) / ( 740.0_rp-0.0_rp )
4224  qall = 16.0e-3_rp + fact
4225  elseif ( cz(k) <= 3260.0_rp ) then ! boundary
4226  fact = ( cz(k)-740.0_rp ) * ( 2.4e-3_rp-13.8e-3_rp ) / ( 3260.0_rp-740.0_rp )
4227  qall = 13.8e-3_rp + fact
4228  elseif( cz(k) <= 4000.0_rp ) then
4229  fact = ( cz(k)-3260.0_rp ) * ( 1.8e-3_rp-2.4e-3_rp ) / ( 4000.0_rp-3260.0_rp )
4230  qall = 2.4e-3_rp + fact
4231  else
4232  qall = 0.0_rp
4233  endif
4234 
4235  qv(k,i,j) = qall - qc(k,i,j)
4236  enddo
4237 
4238  enddo
4239  enddo
4240  !$acc end kernels
4241 
4242  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4243  temp(:,:,:), lhv(:,:,:) )
4244 
4245  !$acc kernels
4246  do j = jsb, jeb
4247  do i = isb, ieb
4248  do k = ks, ke
4249  temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
4250  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
4251  rtot = rdry * qdry + rvap * qv(k,i,j)
4252  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
4253  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
4254  enddo
4255  enddo
4256  enddo
4257  !$acc end kernels
4258 
4259  ! make density & pressure profile in moist condition
4260  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4261  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4262  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4263  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4264  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4265 
4266 
4267  !$acc kernels
4268  !$acc loop collapse(2) independent
4269  do j = jsb, jeb
4270  do i = isb, ieb
4271  dens( 1:ks-1,i,j) = dens(ks,i,j)
4272  dens(ke+1:ka ,i,j) = dens(ke,i,j)
4273  enddo
4274  enddo
4275  !$acc end kernels
4276 
4277  call comm_vars8( dens(:,:,:), 1 )
4278  call comm_wait ( dens(:,:,:), 1 )
4279 
4280  !$acc kernels
4281  do j = jsb, jeb
4282  do i = isb, ieb
4283  do k = ks, ke
4284  momz(k,i,j) = 0.0_rp
4285  enddo
4286  enddo
4287  enddo
4288  !$acc end kernels
4289 
4290  !$acc kernels
4291  !$acc loop collapse(3) independent
4292  do j = jsb, jeb
4293  do i = isb, ieb
4294  do k = ks, ke
4295  momx(k,i,j) = velx(k,i,j) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4296  enddo
4297  enddo
4298  enddo
4299  !$acc end kernels
4300 
4301  !$acc kernels
4302  !$acc loop collapse(3) independent
4303  do j = jsb, jeb
4304  do i = isb, ieb
4305  do k = ks, ke
4306  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4307  enddo
4308  enddo
4309  enddo
4310  !$acc end kernels
4311 
4312  call random_uniform(rndm) ! make random
4313  !$acc kernels
4314  !$acc loop collapse(3) independent
4315  do j = jsb, jeb
4316  do i = isb, ieb
4317  do k = ks, ke
4318  rhot(k,i,j) = ( pott(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp )*perturb_amp_pt ) * dens(k,i,j)
4319  enddo
4320  enddo
4321  enddo
4322  !$acc end kernels
4323 
4324  call random_uniform(rndm) ! make random
4325  !$acc kernels
4326  do j = jsb, jeb
4327  do i = isb, ieb
4328  do k = ks, ke
4329  qv(k,i,j) = qv(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp_qv
4330  enddo
4331  enddo
4332  enddo
4333  !$acc end kernels
4334 
4335  !$acc kernels
4336  do j = jsb, jeb
4337  do i = isb, ieb
4338  do k = ks, ke
4339  if ( qc(k,i,j) > 0.0_rp ) then
4340  nc(k,i,j) = 70.e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
4341  endif
4342  enddo
4343  enddo
4344  enddo
4345  !$acc end kernels
4346 
4347  !$acc end data
4348 
4349 #endif
4350  return
4351  end subroutine mkinit_rico
4352 
4353  !-----------------------------------------------------------------------------
4355  subroutine mkinit_bomex
4356  use scale_const, only: &
4357  rdry => const_rdry, &
4358  rvap => const_rvap, &
4359  cpdry => const_cpdry, &
4360  cpvap => const_cpvap, &
4361  cl => const_cl
4362  use scale_atmos_hydrometeor, only: &
4363  atmos_hydrometeor_dry
4364  implicit none
4365 
4366 #ifndef DRY
4367  real(RP):: PERTURB_AMP_PT = 0.1_rp
4368  real(RP):: PERTURB_AMP_QV = 2.5e-5_rp
4369 
4370  namelist / param_mkinit_bomex / &
4371  perturb_amp_pt, &
4372  perturb_amp_qv
4373 
4374  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
4375  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
4376  real(RP) :: qall ! QV+QC
4377  real(RP) :: fact
4378 
4379  real(RP) :: qdry, Rtot, CPtot
4380 
4381  integer :: ierr
4382  integer :: k, i, j
4383  !---------------------------------------------------------------------------
4384 
4385  log_newline
4386  log_info("MKINIT_BOMEX",*) 'Setup initial state'
4387 
4388  if ( atmos_hydrometeor_dry ) then
4389  log_error("MKINIT_BOMEX",*) 'QV is not registered'
4390  call prc_abort
4391  end if
4392 
4393  rewind(io_fid_conf)
4394  read(io_fid_conf,nml=param_mkinit_bomex,iostat=ierr)
4395  if( ierr < 0 ) then !--- missing
4396  log_info("MKINIT_BOMEX",*) 'Not found namelist. Default used.'
4397  elseif( ierr > 0 ) then !--- fatal error
4398  log_error("MKINIT_BOMEX",*) 'Not appropriate names in namelist PARAM_MKINIT_BOMEX. Check!'
4399  call prc_abort
4400  endif
4401  log_nml(param_mkinit_bomex)
4402 
4403  !$acc data create(potl,LHV)
4404 
4405  ! calc in moist condition
4406  !$acc kernels
4407  do j = jsb, jeb
4408  do i = isb, ieb
4409 
4410  pres_sfc(i,j) = 1015.e2_rp ! [Pa]
4411  pott_sfc(i,j) = 299.1_rp
4412 
4413  do k = ks, ke
4414  !--- potential temperature
4415  if ( cz(k) < 520.0_rp ) then ! below initial cloud top
4416  potl(k,i,j) = 298.7_rp
4417  elseif( cz(k) < 1480.0_rp ) then
4418  fact = ( cz(k)-520.0_rp ) * ( 302.4_rp-298.7_rp ) / ( 1480.0_rp-520.0_rp )
4419  potl(k,i,j) = 298.7_rp + fact
4420  elseif( cz(k) < 2000.0_rp ) then
4421  fact = ( cz(k)-1480.0_rp ) * ( 308.2_rp-302.4_rp ) / ( 2000.0_rp-1480.0_rp )
4422  potl(k,i,j) = 302.4_rp + fact
4423  else
4424  fact = ( cz(k)-2000.0_rp ) * 3.65e-3_rp
4425  potl(k,i,j) = 308.2_rp + fact
4426  endif
4427 
4428  !--- horizontal wind velocity
4429  if ( cz(k) <= 700.0_rp ) then ! below initial cloud top
4430  velx(k,i,j) = -8.75_rp
4431  vely(k,i,j) = 0.0_rp
4432  else
4433  fact = 1.8e-3_rp * ( cz(k)-700.0_rp )
4434  velx(k,i,j) = -8.75_rp + fact
4435  vely(k,i,j) = 0.0_rp
4436  endif
4437  enddo
4438 
4439  enddo
4440  enddo
4441  !$acc end kernels
4442 
4443  ! make density & pressure profile in moist condition
4444  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4445  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4446  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4447  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4448  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4449 
4450 
4451  !$acc kernels
4452  do j = jsb, jeb
4453  do i = isb, ieb
4454  qv_sfc(i,j) = 22.45e-3_rp ! [kg/kg]
4455 
4456  do k = ks, ke
4457  !--- mixing ratio of vapor
4458  if ( cz(k) <= 520.0_rp ) then ! below initial cloud top
4459  fact = ( cz(k)-0.0_rp ) * ( 16.3e-3_rp-17.0e-3_rp ) / ( 520.0_rp-0.0_rp )
4460  qall = 17.0e-3_rp + fact
4461  elseif ( cz(k) <= 1480.0_rp ) then ! boundary
4462  fact = ( cz(k)-520.0_rp ) * ( 10.7e-3_rp-16.3e-3_rp ) / ( 1480.0_rp-520.0_rp )
4463  qall = 16.3e-3_rp + fact
4464  elseif( cz(k) <= 2000.0_rp ) then
4465  fact = ( cz(k)-1480.0_rp ) * ( 4.2e-3_rp-10.7e-3_rp ) / ( 2000.0_rp-1480.0_rp )
4466  qall = 10.7e-3_rp + fact
4467  else
4468  fact = ( cz(k)-2000.0_rp ) * ( -1.2e-6_rp )
4469  qall = 4.2e-3_rp + fact
4470  endif
4471 
4472  qv(k,i,j) = qall - qc(k,i,j)
4473  enddo
4474 
4475  enddo
4476  enddo
4477  !$acc end kernels
4478 
4479  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4480  temp(:,:,:), lhv(:,:,:) )
4481 
4482  !$acc kernels
4483  do j = jsb, jeb
4484  do i = isb, ieb
4485  do k = ks, ke
4486  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
4487  rtot = rdry * qdry + rvap * qv(k,i,j)
4488  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
4489  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
4490  enddo
4491  enddo
4492  enddo
4493  !$acc end kernels
4494 
4495  ! make density & pressure profile in moist condition
4496  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4497  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4498  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4499  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4500  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4501 
4502 
4503  !$acc kernels
4504  !$acc loop collapse(2) independent
4505  do j = jsb, jeb
4506  do i = isb, ieb
4507  dens( 1:ks-1,i,j) = dens(ks,i,j)
4508  dens(ke+1:ka ,i,j) = dens(ke,i,j)
4509  enddo
4510  enddo
4511  !$acc end kernels
4512 
4513  call comm_vars8( dens(:,:,:), 1 )
4514  call comm_wait ( dens(:,:,:), 1 )
4515 
4516  !$acc kernels
4517  do j = jsb, jeb
4518  do i = isb, ieb
4519  do k = ks, ke
4520  momz(k,i,j) = 0.0_rp
4521  enddo
4522  enddo
4523  enddo
4524  !$acc end kernels
4525 
4526  !$acc kernels
4527  !$acc loop collapse(3) independent
4528  do j = jsb, jeb
4529  do i = isb, ieb
4530  do k = ks, ke
4531  momx(k,i,j) = velx(k,i,j) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4532  enddo
4533  enddo
4534  enddo
4535  !$acc end kernels
4536 
4537  !$acc kernels
4538  !$acc loop collapse(3) independent
4539  do j = jsb, jeb
4540  do i = isb, ieb
4541  do k = ks, ke
4542  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4543  enddo
4544  enddo
4545  enddo
4546  !$acc end kernels
4547 
4548  call random_uniform(rndm) ! make random
4549  !$acc kernels
4550  !$acc loop collapse(3) independent
4551  do j = jsb, jeb
4552  do i = isb, ieb
4553  do k = ks, ke
4554  if( cz(k) <= 1600.0_rp ) then !--- lowest 40 model layer when dz=40m
4555  rhot(k,i,j) = ( pott(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp_pt ) * dens(k,i,j)
4556  else
4557  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
4558  endif
4559  enddo
4560  enddo
4561  enddo
4562  !$acc end kernels
4563 
4564  call random_uniform(rndm) ! make random
4565  !$acc kernels
4566  !$acc loop collapse(3) independent
4567  do j = jsb, jeb
4568  do i = isb, ieb
4569  do k = ks, ke
4570  if( cz(k) <= 1600.0_rp ) then !--- lowest 40 model layer when dz=40m
4571  qv(k,i,j) = qv(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp_qv
4572  endif
4573  enddo
4574  enddo
4575  enddo
4576  !$acc end kernels
4577 
4578  !$acc kernels
4579  do j = jsb, jeb
4580  do i = isb, ieb
4581  do k = ks, ke
4582  if ( qc(k,i,j) > 0.0_rp ) then
4583  nc(k,i,j) = 70.e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
4584  endif
4585  enddo
4586  enddo
4587  enddo
4588  !$acc end kernels
4589 
4590  !$acc end data
4591 
4592 #endif
4593  return
4594  end subroutine mkinit_bomex
4595 
4596  !-----------------------------------------------------------------------------
4598  subroutine mkinit_oceancouple
4599  implicit none
4600 
4601  log_newline
4602  log_info("MKINIT_oceancouple",*) 'Setup initial state'
4603 
4604  call flux_setup
4605 
4606  call ocean_setup
4607 
4608  return
4609  end subroutine mkinit_oceancouple
4610 
4611  !-----------------------------------------------------------------------------
4613  subroutine mkinit_landcouple
4614  implicit none
4615 
4616  log_newline
4617  log_info("MKINIT_landcouple",*) 'Setup initial state'
4618 
4619  call flux_setup
4620 
4621  call land_setup
4622 
4623  return
4624  end subroutine mkinit_landcouple
4625 
4626  !-----------------------------------------------------------------------------
4628  subroutine mkinit_urbancouple
4629  implicit none
4630 
4631  log_newline
4632  log_info("MKINIT_urbancouple",*) 'Setup initial state'
4633 
4634  call flux_setup
4635 
4636  call urban_setup
4637 
4638  return
4639  end subroutine mkinit_urbancouple
4640 
4641  !-----------------------------------------------------------------------------
4643  subroutine mkinit_seabreeze
4644  use scale_landuse, only: &
4645  landuse_frac_land, &
4646  landuse_calc_fact, &
4647  landuse_fillhalo
4648  use scale_atmos_grid_cartesc, only: &
4649  domain_center_x => atmos_grid_cartesc_domain_center_x
4650  use scale_land_grid_cartesc_real, only: &
4651  land_grid_cartesc_real_set_areavol
4652  use scale_ocean_grid_cartesc_real, only: &
4653  ocean_grid_cartesc_real_set_areavol
4654  implicit none
4655 
4656  real(RP) :: LAND_SIZE
4657 
4658  namelist / param_mkinit_seabreeze / &
4659  land_size
4660 
4661  integer :: ierr
4662  integer :: i, j
4663  !---------------------------------------------------------------------------
4664 
4665  log_newline
4666  log_info("MKINIT_seabreeze",*) 'Setup initial state'
4667 
4668  land_size = 0.0_rp
4669 
4670  !--- read namelist
4671  rewind(io_fid_conf)
4672  read(io_fid_conf,nml=param_mkinit_seabreeze,iostat=ierr)
4673 
4674  if( ierr < 0 ) then !--- missing
4675  log_info("MKINIT_seabreeze",*) 'Not found namelist. Default used.'
4676  elseif( ierr > 0 ) then !--- fatal error
4677  log_error("MKINIT_seabreeze",*) 'Not appropriate names in namelist PARAM_MKINIT_SEABREEZE. Check!'
4678  call prc_abort
4679  endif
4680  log_nml(param_mkinit_seabreeze)
4681 
4682  call flux_setup
4683 
4684  call land_setup
4685 
4686  call ocean_setup
4687 
4688  ! make landuse conditions
4689  !$acc kernels
4690  do j = jsb, jeb
4691  do i = isb, ieb
4692  if ( abs( cx(i) - domain_center_x ) < land_size ) then
4693  landuse_frac_land(i,j) = 1.0_rp
4694  else
4695  landuse_frac_land(i,j) = 0.0_rp
4696  endif
4697  enddo
4698  enddo
4699  !$acc end kernels
4700 
4701  ! calculate landuse factors
4702  call landuse_fillhalo( fill_bnd=.true. )
4703  call landuse_calc_fact
4704 
4705  call land_grid_cartesc_real_set_areavol
4706  call ocean_grid_cartesc_real_set_areavol
4707 
4708  return
4709  end subroutine mkinit_seabreeze
4710 
4711  !-----------------------------------------------------------------------------
4713  subroutine mkinit_heatisland
4714  use scale_prc_cartesc, only: &
4715  prc_num_x
4716  use scale_landuse, only: &
4717  landuse_frac_land, &
4718  landuse_frac_urban, &
4719  landuse_calc_fact, &
4720  landuse_fillhalo
4721  implicit none
4722 
4723  real(RP) :: dist
4724 
4725  integer :: i, j
4726  !---------------------------------------------------------------------------
4727 
4728  log_newline
4729  log_info("MKINIT_heatisland",*) 'Setup initial state'
4730 
4731  call flux_setup
4732 
4733  call land_setup
4734 
4735  call urban_setup
4736 
4737  ! 1/9 size of domain
4738  dist = ( cxg(imax*prc_num_x) - cxg(1) ) / 9.0_rp
4739 
4740  ! make landuse conditions
4741  !$acc kernels
4742  do j = jsb, jeb
4743  do i = isb, ieb
4744  if ( cx(i) >= dist * 4.0_rp &
4745  .AND. cx(i) < dist * 5.0_rp ) then
4746  landuse_frac_land(i,j) = 1.0_rp
4747  landuse_frac_urban(i,j) = 1.0_rp
4748  else
4749  landuse_frac_land(i,j) = 1.0_rp
4750  landuse_frac_urban(i,j) = 0.0_rp
4751  endif
4752  enddo
4753  enddo
4754  !$acc end kernels
4755 
4756  ! calculate landuse factors
4757  call landuse_fillhalo( fill_bnd=.true. )
4758  call landuse_calc_fact
4759 
4760  return
4761  end subroutine mkinit_heatisland
4762 
4763  !-----------------------------------------------------------------------------
4765  subroutine mkinit_grayzone
4766  use scale_atmos_hydrometeor, only: &
4767  atmos_hydrometeor_dry
4768  implicit none
4769 
4770  real(RP) :: RHO(KA)
4771  real(RP) :: VELX(KA)
4772  real(RP) :: VELY(KA)
4773  real(RP) :: POTT(KA)
4774  real(RP) :: QV1D(KA)
4775 
4776  real(RP) :: PERTURB_AMP = 0.0_rp
4777  integer :: RANDOM_LIMIT = 0
4778  integer :: RANDOM_FLAG = 0 ! 0 -> no perturbation
4779  ! 1 -> petrurbation for pt
4780  ! 2 -> perturbation for u, v, w
4781 
4782  namelist / param_mkinit_grayzone / &
4783  perturb_amp, &
4784  random_limit, &
4785  random_flag
4786 
4787  integer :: ierr
4788  integer :: k, i, j
4789  !---------------------------------------------------------------------------
4790 
4791  log_newline
4792  log_info("MKINIT_grayzone",*) 'Setup initial state'
4793 
4794  if ( atmos_hydrometeor_dry ) then
4795  log_error("MKINIT_grayzone",*) 'QV is not registered'
4796  call prc_abort
4797  end if
4798 
4799  !--- read namelist
4800  rewind(io_fid_conf)
4801  read(io_fid_conf,nml=param_mkinit_grayzone,iostat=ierr)
4802 
4803  if( ierr < 0 ) then !--- missing
4804  log_info("MKINIT_grayzone",*) 'Not found namelist. Default used.'
4805  elseif( ierr > 0 ) then !--- fatal error
4806  log_error("MKINIT_grayzone",*) 'Not appropriate names in namelist PARAM_MKINIT_GRAYZONE. Check!'
4807  call prc_abort
4808  endif
4809  log_nml(param_mkinit_grayzone)
4810 
4811  call read_sounding( rho, velx, vely, pott, qv1d ) ! (out)
4812 
4813  !$acc kernels
4814 ! do j = JS, JE
4815 ! do i = IS, IE
4816  do j = 1, ja
4817  do i = 1, ia
4818  do k = ks, ke
4819  dens(k,i,j) = rho(k)
4820 ! MOMZ(k,i,j) = 0.0_RP
4821 ! MOMX(k,i,j) = RHO(k) * VELX(k)
4822 ! MOMY(k,i,j) = RHO(k) * VELY(k)
4823 
4824 ! RHOT(k,i,j) = RHO(k) * POTT(k)
4825  qv(k,i,j) = qv1d(k)
4826  enddo
4827  enddo
4828  enddo
4829  !$acc end kernels
4830 
4831  !$acc kernels
4832  !$acc loop collapse(2) independent
4833  do j = jsb, jeb
4834  do i = isb, ieb
4835  dens( 1:ks-1,i,j) = dens(ks,i,j)
4836  dens(ke+1:ka, i,j) = dens(ke,i,j)
4837  enddo
4838  enddo
4839  !$acc end kernels
4840 
4841  call random_uniform(rndm) ! make random
4842  !$acc kernels
4843  !$acc loop collapse(3) independent
4844  do j = jsb, jeb
4845  do i = isb, ieb
4846  do k = ks, ke
4847  if ( random_flag == 2 .and. k <= random_limit ) then ! below initial cloud top
4848  momz(k,i,j) = ( ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4849  * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
4850  else
4851  momz(k,i,j) = 0.0_rp
4852  endif
4853  enddo
4854  enddo
4855  enddo
4856  !$acc end kernels
4857 
4858  call random_uniform(rndm) ! make random
4859  !$acc kernels
4860  !$acc loop collapse(3) independent
4861  do j = jsb, jeb
4862  do i = isb, ieb
4863  do k = ks, ke
4864  if ( random_flag == 2 .AND. k <= random_limit ) then ! below initial cloud top
4865  momx(k,i,j) = ( velx(k) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4866  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4867  else
4868  momx(k,i,j) = velx(k) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4869  endif
4870  enddo
4871  enddo
4872  enddo
4873  !$acc end kernels
4874 
4875  call random_uniform(rndm) ! make random
4876  !$acc kernels
4877  !$acc loop collapse(3) independent
4878  do j = jsb, jeb
4879  do i = isb, ieb
4880  do k = ks, ke
4881  if ( random_flag == 2 .AND. k <= random_limit ) then ! below initial cloud top
4882  momy(k,i,j) = ( vely(k) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4883  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4884  else
4885  momy(k,i,j) = vely(k) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4886  endif
4887  enddo
4888  enddo
4889  enddo
4890  !$acc end kernels
4891 
4892  call random_uniform(rndm) ! make random
4893  !$acc kernels
4894  !$acc loop collapse(3) independent
4895  do j = jsb, jeb
4896  do i = isb, ieb
4897  do k = ks, ke
4898  if ( random_flag == 1 .and. k <= random_limit ) then ! below initial cloud top
4899  rhot(k,i,j) = ( pott(k) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4900  * dens(k,i,j)
4901  else
4902  rhot(k,i,j) = pott(k) * dens(k,i,j)
4903  endif
4904  enddo
4905  enddo
4906  enddo
4907  !$acc end kernels
4908 
4909  return
4910  end subroutine mkinit_grayzone
4911 
4912  !-----------------------------------------------------------------------------
4914  subroutine mkinit_boxaero
4915  use scale_const, only: &
4916  rdry => const_rdry, &
4917  rvap => const_rvap, &
4918  cvdry => const_cvdry, &
4919  cvvap => const_cvvap, &
4920  cpdry => const_cpdry, &
4921  cpvap => const_cpvap
4922  use scale_atmos_hydrometeor, only: &
4923  atmos_hydrometeor_dry
4924  use scale_atmos_thermodyn, only: &
4925  atmos_thermodyn_rhot2temp_pres
4926  use mod_atmos_admin, only: &
4927  atmos_phy_ae_type
4928  implicit none
4929 
4930  real(RP) :: init_dens = 1.12_rp ![kg/m3]
4931  real(RP) :: init_temp = 298.18_rp ![K]
4932  real(RP) :: init_pres = 1.e+5_rp ![Pa]
4933  real(RP) :: init_ssliq = 0.01_rp ![%]
4934 
4935  namelist / param_mkinit_boxaero / &
4936  init_dens, &
4937  init_temp, &
4938  init_pres, &
4939  init_ssliq
4940 
4941  real(RP) :: rtot (KA,IA,JA)
4942  real(RP) :: cvtot(KA,IA,JA)
4943  real(RP) :: cptot(KA,IA,JA)
4944  real(RP) :: qdry
4945  real(RP) :: qsat
4946  integer :: i, j, k, ierr
4947  !---------------------------------------------------------------------------
4948 
4949  if ( atmos_phy_ae_type /= 'KAJINO13' ) then
4950  log_info("MKINIT_boxaero",*) 'For [Box model of aerosol],'
4951  log_info("MKINIT_boxaero",*) 'ATMOS_PHY_AE_TYPE should be KAJINO13. Stop! ', trim(atmos_phy_ae_type)
4952  call prc_abort
4953  endif
4954 
4955  if ( atmos_hydrometeor_dry ) then
4956  log_error("MKINIT_boxaero",*) 'QV is not registered'
4957  call prc_abort
4958  end if
4959 
4960  log_newline
4961  log_info("MKINIT_boxaero",*) 'Setup initial state'
4962 
4963  !--- read namelist
4964  rewind(io_fid_conf)
4965  read(io_fid_conf,nml=param_mkinit_boxaero,iostat=ierr)
4966  if( ierr < 0 ) then !--- missing
4967  log_info("MKINIT_boxaero",*) 'Not found namelist. Default used.'
4968  elseif( ierr > 0 ) then !--- fatal error
4969  log_error("MKINIT_boxaero",*) 'Not appropriate names in namelist PARAM_MKINIT_BOXAERO. Check!'
4970  call prc_abort
4971  endif
4972  log_nml(param_mkinit_boxaero)
4973 
4974  call saturation_pres2qsat_all( init_temp, init_pres, qsat )
4975 
4976  !$acc data create(rtot,cvtot,cptot)
4977 
4978  !$acc kernels
4979  !$acc loop collapse(3) independent
4980  do j = 1, ja
4981  do i = 1, ia
4982  do k = 1, ka
4983  dens(k,i,j) = init_dens
4984  momx(k,i,j) = 0.0_rp
4985  momy(k,i,j) = 0.0_rp
4986  momz(k,i,j) = 0.0_rp
4987  pott(k,i,j) = init_temp * ( p00/init_pres )**(rdry/cpdry)
4988  rhot(k,i,j) = init_dens * pott(k,i,j)
4989 
4990  qv(k,i,j) = ( init_ssliq + 1.0_rp ) * qsat
4991 
4992  qdry = 1.0 - qv(k,i,j)
4993  rtot(k,i,j) = rdry * qdry + rvap * qv(i,i,j)
4994  cvtot(k,i,j) = cvdry * qdry + cvvap * qv(i,i,j)
4995  cptot(k,i,j) = cpdry * qdry + cpvap * qv(i,i,j)
4996  enddo
4997  enddo
4998  enddo
4999  !$acc end kernels
5000 
5001  call atmos_thermodyn_rhot2temp_pres( ka, 1, ka, ia, 1, ia, ja, 1, ja, &
5002  dens(:,:,:), rhot(:,:,:), & ! (in)
5003  rtot(:,:,:), cvtot(:,:,:), cptot(:,:,:), & ! (in)
5004  temp(:,:,:), pres(:,:,:) ) ! (out)
5005 
5006  !$acc end data
5007 
5008  return
5009  end subroutine mkinit_boxaero
5010 
5011  !-----------------------------------------------------------------------------
5013  subroutine mkinit_warmbubbleaero
5014  use scale_atmos_hydrometeor, only: &
5015  atmos_hydrometeor_dry
5016  implicit none
5017 
5018  ! Surface state
5019  real(RP) :: SFC_THETA ! surface potential temperature [K]
5020  real(RP) :: SFC_PRES ! surface pressure [Pa]
5021  real(RP) :: SFC_RH = 80.0_rp ! surface relative humidity [%]
5022  ! Environment state
5023  real(RP) :: ENV_U = 0.0_rp ! velocity u of environment [m/s]
5024  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
5025  real(RP) :: ENV_RH = 80.0_rp ! Relative Humidity of environment [%]
5026  real(RP) :: ENV_L1_ZTOP = 1.e3_rp ! top height of the layer1 (constant THETA) [m]
5027  real(RP) :: ENV_L2_ZTOP = 14.e3_rp ! top height of the layer2 (small THETA gradient) [m]
5028  real(RP) :: ENV_L2_TLAPS = 4.e-3_rp ! Lapse rate of THETA in the layer2 (small THETA gradient) [K/m]
5029  real(RP) :: ENV_L3_TLAPS = 3.e-2_rp ! Lapse rate of THETA in the layer3 (large THETA gradient) [K/m]
5030  ! Bubble
5031  real(RP) :: BBL_THETA = 1.0_rp ! extremum of temperature in bubble [K]
5032 
5033  namelist / param_mkinit_warmbubble / &
5034  sfc_theta, &
5035  sfc_pres, &
5036  env_u, &
5037  env_v, &
5038  env_rh, &
5039  env_l1_ztop, &
5040  env_l2_ztop, &
5041  env_l2_tlaps, &
5042  env_l3_tlaps, &
5043  bbl_theta
5044 
5045  logical :: converged
5046 
5047 #ifdef _OPENACC
5048  real(RP) :: work1(KA)
5049  real(RP) :: work2(KA)
5050  real(RP) :: work3(KA)
5051 #endif
5052 
5053  integer :: ierr
5054  integer :: k, i, j, itr
5055  !---------------------------------------------------------------------------
5056 
5057  log_newline
5058  log_info("MKINIT_warmbubbleaero",*) 'Setup initial state'
5059 
5060  if ( atmos_hydrometeor_dry ) then
5061  log_error("MKINIT_warmbubbleaero",*) 'QV is not registerd'
5062  call prc_abort
5063  end if
5064 
5065 
5066  sfc_theta = thetastd
5067  sfc_pres = pstd
5068 
5069  !--- read namelist
5070  rewind(io_fid_conf)
5071  read(io_fid_conf,nml=param_mkinit_warmbubble,iostat=ierr)
5072 
5073  if( ierr < 0 ) then !--- missing
5074  log_info("MKINIT_warmbubbleaero",*) 'Not found namelist. Default used.'
5075  elseif( ierr > 0 ) then !--- fatal error
5076  log_error("MKINIT_warmbubbleaero",*) 'Not appropriate names in namelist PARAM_MKINIT_WARMBUBBLE. Check!'
5077  call prc_abort
5078  endif
5079  log_nml(param_mkinit_warmbubble)
5080 
5081  ! calc in dry condition
5082  !$acc kernels
5083  pres_sfc(1,1) = sfc_pres
5084  pott_sfc(1,1) = sfc_theta
5085  !$acc end kernels
5086 
5087  !$acc kernels
5088  !$acc loop seq
5089  do k = ks, ke
5090  if ( cz(k) <= env_l1_ztop ) then ! Layer 1
5091  pott(k,1,1) = sfc_theta
5092  elseif( cz(k) < env_l2_ztop ) then ! Layer 2
5093  pott(k,1,1) = pott(k-1,1,1) + env_l2_tlaps * ( cz(k)-cz(k-1) )
5094  else ! Layer 3
5095  pott(k,1,1) = pott(k-1,1,1) + env_l3_tlaps * ( cz(k)-cz(k-1) )
5096  endif
5097  enddo
5098  !$acc end kernels
5099 
5100  ! make density & pressure profile in dry condition
5101  call hydrostatic_buildrho( ka, ks, ke, &
5102  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
5103  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
5104  cz(:), fz(:), & ! [IN]
5105 #ifdef _OPENACC
5106  work1(:), work2(:), work3(:), & ! [WORK]
5107 #endif
5108  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
5109  converged ) ! [OUT]
5110 
5111  ! calc QV from RH
5112  call saturation_pres2qsat_all( temp_sfc(1,1), pres_sfc(1,1), & ! [IN]
5113  qsat_sfc(1,1) ) ! [OUT]
5114  !$acc kernels
5115  qv_sfc(1,1) = sfc_rh * 1.e-2_rp * qsat_sfc(1,1)
5116  !$acc end kernels
5117 
5118  do itr = 1, niter_rh
5119  call saturation_psat_all( ka, ks, ke, &
5120  temp(:,1,1), & ! [IN]
5121  psat(:,1,1) ) ! [OUT]
5122  !$acc kernels
5123  do k = ks, ke
5124  if( cz(k) <= env_l2_ztop ) then ! Layer 1 and 2
5125  qv(k,1,1) = env_rh * 1.e-2_rp * psat(k,1,1) / ( dens(k,1,1) * rvap * temp(k,1,1) )
5126  else ! Layer 3
5127  qv(k,1,1) = 0.0_rp
5128  endif
5129  enddo
5130  !$acc end kernels
5131 
5132  ! make density & pressure profile in moist condition
5133  call hydrostatic_buildrho( ka, ks, ke, &
5134  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
5135  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
5136  cz(:), fz(:), & ! [IN]
5137 #ifdef _OPENACC
5138  work1(:), work2(:), work3(:), & ! [WORK]
5139 #endif
5140  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
5141  converged ) ! [OUT]
5142  end do
5143 
5144  !$acc kernels
5145  !$acc loop collapse(3) independent
5146  do j = jsb, jeb
5147  do i = isb, ieb
5148  do k = ks, ke
5149  dens(k,i,j) = dens(k,1,1)
5150  momz(k,i,j) = 0.0_rp
5151  momx(k,i,j) = env_u * dens(k,i,j)
5152  momy(k,i,j) = env_v * dens(k,i,j)
5153 
5154  ! make warm bubble
5155  rhot(k,i,j) = dens(k,1,1) * ( pott(k,1,1) + bbl_theta * bubble(k,i,j) )
5156 
5157  qv(k,i,j) = qv(k,1,1)
5158  enddo
5159  enddo
5160  enddo
5161  !$acc end kernels
5162 
5163  call flux_setup
5164 
5165  return
5166  end subroutine mkinit_warmbubbleaero
5167 
5168  !-----------------------------------------------------------------------------
5170  subroutine mkinit_real
5171  use mod_realinput, only: &
5172  realinput_atmos, &
5173  realinput_surface
5174  implicit none
5175 
5176  call prof_rapstart('__Real_Atmos',2)
5177 
5178  call realinput_atmos
5179 
5180  call prof_rapend ('__Real_Atmos',2)
5181  call prof_rapstart('__Real_Surface',2)
5182 
5183  call realinput_surface
5184 
5185  call prof_rapend ('__Real_Surface',2)
5186 
5187  call flux_setup
5188 
5189  return
5190  end subroutine mkinit_real
5191 
5192 end module mod_mkinit
scale_const::const_grav
real(rp), public const_grav
standard acceleration of gravity [m/s2]
Definition: scale_const.F90:49
mod_mkinit::i_tracerbubble
integer, parameter, public i_tracerbubble
Definition: mod_mkinit.F90:92
scale_atmos_grid_cartesc_index::isb
integer, public isb
Definition: scale_atmos_grid_cartesC_index.F90:64
scale_atmos_phy_ae_kajino13
module atmosphere / physics / aerosol / Kajino13
Definition: scale_atmos_phy_ae_kajino13.F90:12
mod_mkinit::mkinit_type
integer, public mkinit_type
Definition: mod_mkinit.F90:88
mod_mkinit::i_cavityflow
integer, parameter, public i_cavityflow
Definition: mod_mkinit.F90:128
mod_atmos_phy_mp_vars
module Atmosphere / Physics Cloud Microphysics
Definition: mod_atmos_phy_mp_vars.F90:12
mod_ocean_vars::ocean_ocn_z0m
real(rp), dimension(:,:), allocatable, public ocean_ocn_z0m
surface roughness length for momentum, open ocean [m]
Definition: mod_ocean_vars.F90:66
mod_land_vars::land_temp
real(rp), dimension(:,:,:), allocatable, public land_temp
temperature of each soil layer [K]
Definition: mod_land_vars.F90:62
scale_atmos_grid_cartesc_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:52
mod_urban_vars::urban_sfc_temp
real(rp), dimension(:,:), allocatable, public urban_sfc_temp
Definition: mod_urban_vars.F90:75
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:349
mod_ocean_vars::ocean_ice_temp
real(rp), dimension(:,:), allocatable, public ocean_ice_temp
sea ice temperature [K]
Definition: mod_ocean_vars.F90:74
mod_mkinit::i_boxaero
integer, parameter, public i_boxaero
Definition: mod_mkinit.F90:125
mod_land_vars::snow_sfc_temp
real(rp), dimension(:,:), allocatable, public snow_sfc_temp
snow surface temperature [K]
Definition: mod_land_vars.F90:69
mod_mkinit::land_setup
subroutine land_setup
Land setup.
Definition: mod_mkinit.F90:1032
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:35
mod_urban_vars::urban_tb
real(rp), dimension(:,:), allocatable, public urban_tb
Definition: mod_urban_vars.F90:65
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_cz
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_cz
geopotential height [m] (zxy)
Definition: scale_atmos_grid_cartesC_real.F90:39
scale_atmos_grid_cartesc_index::ihalo
integer, public ihalo
Definition: scale_atmos_grid_cartesC_index.F90:44
mod_ocean_vars::ocean_sfc_z0e
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0e
ocean surface roughness length for vapor [m]
Definition: mod_ocean_vars.F90:72
scale_landuse::landuse_calc_fact
subroutine, public landuse_calc_fact
Definition: scale_landuse.F90:238
mod_land_vars::land_sfc_albedo
real(rp), dimension(:,:,:,:), allocatable, public land_sfc_albedo
land surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
Definition: mod_land_vars.F90:66
scale_tracer::tracer_inq_id
subroutine, public tracer_inq_id(NAME, ID)
Inquire tracer ID.
Definition: scale_tracer.F90:186
scale_const::const_undef8
real(dp), parameter, public const_undef8
undefined value (REAL8)
Definition: scale_const.F90:42
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
mod_atmos_phy_bl_vars::atmos_phy_bl_zi
real(rp), dimension(:,:), allocatable, public atmos_phy_bl_zi
Definition: mod_atmos_phy_bl_vars.F90:67
mod_ocean_vars::ice_flag
logical, public ice_flag
Definition: mod_ocean_vars.F90:142
mod_atmos_admin
module ATMOS admin
Definition: mod_atmos_admin.F90:11
mod_mkinit::faero
real(rp) function faero(f0, r0, x, alpha, rhoa)
Definition: mod_mkinit.F90:954
mod_urban_vars::urban_sfc_albedo
real(rp), dimension(:,:,:,:), allocatable, public urban_sfc_albedo
Definition: mod_urban_vars.F90:76
mod_mkinit::i_grayzone
integer, parameter, public i_grayzone
Definition: mod_mkinit.F90:124
mod_mkinit::i_warmbubbleaero
integer, parameter, public i_warmbubbleaero
Definition: mod_mkinit.F90:126
mod_atmos_phy_mp_vars::qs_mp
integer, public qs_mp
Definition: mod_atmos_phy_mp_vars.F90:79
mod_mkinit::i_wk1982
integer, parameter, public i_wk1982
Definition: mod_mkinit.F90:104
scale_const::const_rvap
real(rp), parameter, public const_rvap
specific gas constant (water vapor) [J/kg/K]
Definition: scale_const.F90:68
scale_atmos_profile
module atmosphere / vertical profile
Definition: scale_atmos_profile.F90:12
mod_land_vars::land_water
real(rp), dimension(:,:,:), allocatable, public land_water
moisture of each soil layer [m3/m3]
Definition: mod_land_vars.F90:63
mod_mkinit::i_landcouple
integer, parameter, public i_landcouple
Definition: mod_mkinit.F90:111
scale_cpl_sfc_index::i_r_ir
integer, parameter, public i_r_ir
Definition: scale_cpl_sfc_index.F90:29
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:35
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level, disable_barrier)
Start raptime.
Definition: scale_prof.F90:174
mod_urban_vars::urban_trl
real(rp), dimension(:,:,:), allocatable, public urban_trl
Definition: mod_urban_vars.F90:61
scale_atmos_hydrometeor
module atmosphere / hydrometeor
Definition: scale_atmos_hydrometeor.F90:12
scale_atmos_grid_cartesc::atmos_grid_cartesc_fyg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fyg
face coordinate [m]: y, global
Definition: scale_atmos_grid_cartesC.F90:79
scale_atmos_grid_cartesc::atmos_grid_cartesc_fx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fx
face coordinate [m]: x, local
Definition: scale_atmos_grid_cartesC.F90:58
mod_atmos_phy_rd_vars
module Atmosphere / Physics Radiation
Definition: mod_atmos_phy_rd_vars.F90:12
mod_atmos_phy_mp_vars::atmos_phy_mp_sflx_rain
real(rp), dimension(:,:), allocatable, public atmos_phy_mp_sflx_rain
Definition: mod_atmos_phy_mp_vars.F90:74
mod_urban_vars::urban_raing
real(rp), dimension(:,:), allocatable, public urban_raing
Definition: mod_urban_vars.F90:72
scale_random
module RANDOM
Definition: scale_random.F90:11
scale_io::io_get_available_fid
integer function, public io_get_available_fid()
search & get available file ID
Definition: scale_io.F90:373
mod_urban_vars::urban_qc
real(rp), dimension(:,:), allocatable, public urban_qc
Definition: mod_urban_vars.F90:68
mod_ocean_vars::ocean_sfc_z0m
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0m
ocean surface roughness length for momentum [m]
Definition: mod_ocean_vars.F90:70
scale_atmos_hydrometeor::atmos_hydrometeor_dry
logical, public atmos_hydrometeor_dry
Definition: scale_atmos_hydrometeor.F90:114
mod_mkinit::flux_setup
subroutine flux_setup
flux setup
Definition: mod_mkinit.F90:973
mod_mkinit::i_seabreeze
integer, parameter, public i_seabreeze
Definition: mod_mkinit.F90:117
mod_atmos_vars::rhot
real(rp), dimension(:,:,:), allocatable, target, public rhot
Definition: mod_atmos_vars.F90:80
scale_atmos_grid_cartesc_real
module Atmosphere GRID CartesC Real(real space)
Definition: scale_atmos_grid_cartesC_real.F90:11
mod_mkinit::mkinit_finalize
subroutine, public mkinit_finalize
Finalize.
Definition: mod_mkinit.F90:343
mod_atmos_vars::qtrc
real(rp), dimension(:,:,:,:), allocatable, target, public qtrc
Definition: mod_atmos_vars.F90:81
scale_atmos_grid_cartesc_index::imax
integer, public imax
Definition: scale_atmos_grid_cartesC_index.F90:37
scale_atmos_grid_cartesc::atmos_grid_cartesc_domain_center_y
real(rp), public atmos_grid_cartesc_domain_center_y
center position of global domain [m]: y
Definition: scale_atmos_grid_cartesC.F90:92
scale_atmos_grid_cartesc_index::jeb
integer, public jeb
Definition: scale_atmos_grid_cartesC_index.F90:67
mod_mkinit::i_dycoms2_rf02_dns
integer, parameter, public i_dycoms2_rf02_dns
Definition: mod_mkinit.F90:120
mod_atmos_phy_mp_driver
module atmosphere / physics / cloud microphysics
Definition: mod_atmos_phy_mp_driver.F90:12
scale_const::const_cpvap
real(rp), parameter, public const_cpvap
specific heat (water vapor, constant pressure) [J/kg/K]
Definition: scale_const.F90:69
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
mod_mkinit::read_sounding
subroutine read_sounding(DENS, VELX, VELY, POTT, QV)
Read sounding data from file.
Definition: mod_mkinit.F90:1377
scale_landuse::landuse_frac_urban
real(rp), dimension(:,:), allocatable, public landuse_frac_urban
urban fraction
Definition: scale_landuse.F90:56
scale_atmos_grid_cartesc_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:54
scale_io::io_get_fname
subroutine, public io_get_fname(outstr, instr, rank, ext, len)
generate process specific filename
Definition: scale_io.F90:421
mod_mkinit::mkinit
subroutine, public mkinit(output)
Driver.
Definition: mod_mkinit.F90:379
scale_io
module STDIO
Definition: scale_io.F90:10
scale_const::const_pstd
real(rp), public const_pstd
standard pressure [Pa]
Definition: scale_const.F90:96
scale_atmos_grid_cartesc_index::jag
integer, public jag
Definition: scale_atmos_grid_cartesC_index.F90:75
mod_atmos_phy_rd_vars::atmos_phy_rd_sflx_lw_dn
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_lw_dn
Definition: mod_atmos_phy_rd_vars.F90:62
mod_realinput::realinput_surface
subroutine, public realinput_surface
Definition: mod_realinput.F90:499
scale_atmos_grid_cartesc_index::iag
integer, public iag
Definition: scale_atmos_grid_cartesC_index.F90:74
mod_atmos_phy_bl_vars
module atmosphere / physics / PBL
Definition: mod_atmos_phy_bl_vars.F90:12
mod_atmos_phy_rd_vars::atmos_phy_rd_sflx_sw_dn
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_sw_dn
Definition: mod_atmos_phy_rd_vars.F90:64
mod_atmos_vars::dens
real(rp), dimension(:,:,:), allocatable, target, public dens
Definition: mod_atmos_vars.F90:76
scale_cpl_sfc_index::i_r_nir
integer, parameter, public i_r_nir
Definition: scale_cpl_sfc_index.F90:30
scale_ocean_grid_cartesc_real::ocean_grid_cartesc_real_set_areavol
subroutine, public ocean_grid_cartesc_real_set_areavol
Definition: scale_ocean_grid_cartesC_real.F90:80
mod_ocean_vars::ocean_sfc_z0h
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0h
ocean surface roughness length for heat [m]
Definition: mod_ocean_vars.F90:71
scale_atmos_grid_cartesc::atmos_grid_cartesc_cxg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cxg
center coordinate [m]: x, global
Definition: scale_atmos_grid_cartesC.F90:76
mod_mkinit::i_ignore
integer, parameter, public i_ignore
Definition: mod_mkinit.F90:89
scale_atmos_hydrometeor::qhe
integer, public qhe
Definition: scale_atmos_hydrometeor.F90:133
scale_tracer::k
real(rp), public k
Definition: scale_tracer.F90:45
scale_atmos_grid_cartesc::atmos_grid_cartesc_domain_center_x
real(rp), public atmos_grid_cartesc_domain_center_x
center position of global domain [m]: x
Definition: scale_atmos_grid_cartesC.F90:91
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
mod_atmos_phy_bl_driver::atmos_phy_bl_driver_mkinit
subroutine, public atmos_phy_bl_driver_mkinit(TKE_CONST)
make initial state
Definition: mod_atmos_phy_bl_driver.F90:191
mod_ocean_vars::ocean_uvel
real(rp), dimension(:,:,:), allocatable, public ocean_uvel
ocean zonal velocity [m/s]
Definition: mod_ocean_vars.F90:63
mod_atmos_phy_rd_vars::atmos_phy_rd_sflx_sw_up
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_sw_up
Definition: mod_atmos_phy_rd_vars.F90:63
mod_atmos_phy_ae_vars::qa_ae
integer, public qa_ae
Definition: mod_atmos_phy_ae_vars.F90:67
mod_atmos_phy_rd_vars::atmos_phy_rd_sflx_lw_up
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_lw_up
Definition: mod_atmos_phy_rd_vars.F90:61
mod_mkinit::i_real
integer, parameter, public i_real
Definition: mod_mkinit.F90:122
scale_landuse::landuse_frac_land
real(rp), dimension(:,:), allocatable, public landuse_frac_land
land fraction
Definition: scale_landuse.F90:55
mod_atmos_vars::momz
real(rp), dimension(:,:,:), allocatable, target, public momz
Definition: mod_atmos_vars.F90:77
mod_urban_vars::urban_tgl
real(rp), dimension(:,:,:), allocatable, public urban_tgl
Definition: mod_urban_vars.F90:63
mod_atmos_phy_tb_vars
module Atmosphere / Physics Turbulence
Definition: mod_atmos_phy_tb_vars.F90:12
scale_const::const_cvdry
real(rp), public const_cvdry
specific heat (dry air,constant volume) [J/kg/K]
Definition: scale_const.F90:61
scale_land_grid_cartesc_real
module land / grid / cartesianC / real
Definition: scale_land_grid_cartesC_real.F90:11
mod_mkinit::i_dycoms2_rf01
integer, parameter, public i_dycoms2_rf01
Definition: mod_mkinit.F90:105
scale_atmos_grid_cartesc::atmos_grid_cartesc_fy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fy
face coordinate [m]: y, local
Definition: scale_atmos_grid_cartesC.F90:59
mod_mkinit::i_interporation
integer, parameter, public i_interporation
Definition: mod_mkinit.F90:109
mod_mkinit::i_heatisland
integer, parameter, public i_heatisland
Definition: mod_mkinit.F90:118
mod_land_vars
module LAND Variables
Definition: mod_land_vars.F90:11
scale_prc_cartesc
module process / cartesC
Definition: scale_prc_cartesC.F90:11
scale_const::const_cpdry
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
Definition: scale_const.F90:60
scale_atmos_phy_ae_kajino13::atmos_phy_ae_kajino13_mkinit
subroutine, public atmos_phy_ae_kajino13_mkinit(KA, KS, KE, IA, IS, IE, JA, JS, JE, QA_AE, DENS, TEMP, PRES, QDRY, QV, m0_init, dg_init, sg_init, d_min_inp, d_max_inp, k_min_inp, k_max_inp, n_kap_inp, QTRC, CCN)
Definition: scale_atmos_phy_ae_kajino13.F90:991
mod_mkinit::tke_setup
subroutine tke_setup
TKE setup.
Definition: mod_mkinit.F90:1308
scale_atmos_phy_ae_offline::atmos_phy_ae_offline_mkinit
subroutine, public atmos_phy_ae_offline_mkinit(KA, KS, KE, IA, IS, IE, JA, JS, JE, ccn_init, CCN)
Definition: scale_atmos_phy_ae_offline.F90:329
scale_prof
module profiler
Definition: scale_prof.F90:11
mod_land_vars::snow_nosnowsec
real(rp), dimension(:,:), allocatable, public snow_nosnowsec
sec while no snow [s]
Definition: mod_land_vars.F90:73
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_area
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_area
horizontal area ( xy, normal z) [m2]
Definition: scale_atmos_grid_cartesC_real.F90:66
mod_mkinit::rect_setup
subroutine rect_setup
Bubble.
Definition: mod_mkinit.F90:709
mod_atmos_vars::momx
real(rp), dimension(:,:,:), allocatable, target, public momx
Definition: mod_atmos_vars.F90:78
mod_mkinit::i_urbancouple
integer, parameter, public i_urbancouple
Definition: mod_mkinit.F90:113
scale_atmos_grid_cartesc_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:53
mod_mkinit::i_gravitywave
integer, parameter, public i_gravitywave
Definition: mod_mkinit.F90:96
mod_ocean_vars
module OCEAN Variables
Definition: mod_ocean_vars.F90:12
scale_atmos_grid_cartesc_index::jhalo
integer, public jhalo
Definition: scale_atmos_grid_cartesC_index.F90:45
scale_atmos_phy_ae_offline
module atmosphere / physics / aerosol / offline
Definition: scale_atmos_phy_ae_offline.F90:12
scale_atmos_phy_mp_suzuki10
module Spectran Bin Microphysics
Definition: scale_atmos_phy_mp_suzuki10.F90:23
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
mod_mkinit::i_rico
integer, parameter, public i_rico
Definition: mod_mkinit.F90:107
mod_atmos_vars::momy
real(rp), dimension(:,:,:), allocatable, target, public momy
Definition: mod_atmos_vars.F90:79
mod_mkinit::i_barocwave
integer, parameter, public i_barocwave
Definition: mod_mkinit.F90:129
mod_atmos_admin::atmos_phy_ae_type
character(len=h_short), public atmos_phy_ae_type
Definition: mod_atmos_admin.F90:37
scale_const::const_pi
real(rp), parameter, public const_pi
pi
Definition: scale_const.F90:32
mod_land_vars::snow_swe
real(rp), dimension(:,:), allocatable, public snow_swe
snow water equivalent [kg/m2]
Definition: mod_land_vars.F90:70
scale_atmos_hydrometeor::i_hc
integer, parameter, public i_hc
liquid water cloud
Definition: scale_atmos_hydrometeor.F90:97
mod_mkinit::mkinit_setup
subroutine, public mkinit_setup
Setup.
Definition: mod_mkinit.F90:210
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
mod_mkinit::i_dycoms2_rf02
integer, parameter, public i_dycoms2_rf02
Definition: mod_mkinit.F90:106
mod_urban_vars::urban_tc
real(rp), dimension(:,:), allocatable, public urban_tc
Definition: mod_urban_vars.F90:67
mod_urban_vars::urban_tg
real(rp), dimension(:,:), allocatable, public urban_tg
Definition: mod_urban_vars.F90:66
mod_atmos_phy_ae_vars::atmos_phy_ae_ccn
real(rp), dimension(:,:,:), allocatable, public atmos_phy_ae_ccn
Definition: mod_atmos_phy_ae_vars.F90:63
scale_atmos_hydrometeor::i_qv
integer, public i_qv
Definition: scale_atmos_hydrometeor.F90:93
mod_mkinit::i_mountainwave
integer, parameter, public i_mountainwave
Definition: mod_mkinit.F90:99
mod_mkinit::i_supercell
integer, parameter, public i_supercell
Definition: mod_mkinit.F90:102
scale_atmos_grid_cartesc::atmos_grid_cartesc_fxg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fxg
face coordinate [m]: x, global
Definition: scale_atmos_grid_cartesC.F90:78
mod_urban_vars::urban_uc
real(rp), dimension(:,:), allocatable, public urban_uc
Definition: mod_urban_vars.F90:69
mod_realinput::realinput_atmos
subroutine, public realinput_atmos
Definition: mod_realinput.F90:205
mod_realinput
module REAL input
Definition: mod_realinput.F90:11
scale_atmos_grid_cartesc_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:51
mod_mkinit::i_bomex
integer, parameter, public i_bomex
Definition: mod_mkinit.F90:130
mod_atmos_phy_bl_driver
module atmosphere / physics / PBL
Definition: mod_atmos_phy_bl_driver.F90:12
mod_atmos_phy_tb_vars::i_tke
integer, public i_tke
Definition: mod_atmos_phy_tb_vars.F90:62
mod_land_vars::land_sfc_temp
real(rp), dimension(:,:), allocatable, public land_sfc_temp
land surface skin temperature [K]
Definition: mod_land_vars.F90:65
mod_ocean_vars::ocean_ice_mass
real(rp), dimension(:,:), allocatable, public ocean_ice_mass
sea ice mass [kg]
Definition: mod_ocean_vars.F90:75
scale_atmos_hydrostatic
module atmosphere / hydrostatic barance
Definition: scale_atmos_hydrostatic.F90:12
scale_atmos_grid_cartesc::atmos_grid_cartesc_fz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fz
face coordinate [m]: z, local
Definition: scale_atmos_grid_cartesC.F90:42
mod_ocean_vars::ocean_vvel
real(rp), dimension(:,:,:), allocatable, public ocean_vvel
ocean meridional velocity [m/s]
Definition: mod_ocean_vars.F90:64
scale_comm_cartesc
module COMMUNICATION
Definition: scale_comm_cartesC.F90:11
scale_const::const_cl
real(rp), parameter, public const_cl
specific heat (liquid water) [J/kg/K]
Definition: scale_const.F90:71
mod_atmos_vars
module ATMOSPHERIC Variables
Definition: mod_atmos_vars.F90:12
scale_cpl_sfc_index
module coupler / surface-atmospehre
Definition: scale_cpl_sfc_index.F90:11
scale_const::const_cvvap
real(rp), public const_cvvap
specific heat (water vapor, constant volume) [J/kg/K]
Definition: scale_const.F90:70
scale_land_grid_cartesc_real::land_grid_cartesc_real_set_areavol
subroutine, public land_grid_cartesc_real_set_areavol
Definition: scale_land_grid_cartesC_real.F90:77
mod_land_vars::snow_depth
real(rp), dimension(:,:), allocatable, public snow_depth
snow depth [m]
Definition: mod_land_vars.F90:71
scale_const::const_radius
real(rp), public const_radius
radius of the planet [m]
Definition: scale_const.F90:47
mod_mkinit::i_triplecouple
integer, parameter, public i_triplecouple
Definition: mod_mkinit.F90:114
mod_urban_vars::urban_rainb
real(rp), dimension(:,:), allocatable, public urban_rainb
Definition: mod_urban_vars.F90:71
scale_atmos_grid_cartesc_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:55
mod_mkinit::i_bubblecouple
integer, parameter, public i_bubblecouple
Definition: mod_mkinit.F90:115
scale_cpl_sfc_index::i_r_vis
integer, parameter, public i_r_vis
Definition: scale_cpl_sfc_index.F90:31
mod_atmos_phy_ae_vars::qs_ae
integer, public qs_ae
Definition: mod_atmos_phy_ae_vars.F90:68
mod_land_vars::snow_flag
logical, public snow_flag
Definition: mod_land_vars.F90:133
scale_atmos_grid_cartesc::atmos_grid_cartesc_cy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cy
center coordinate [m]: y, local
Definition: scale_atmos_grid_cartesC.F90:57
mod_ocean_vars::ocean_sfc_albedo
real(rp), dimension(:,:,:,:), allocatable, public ocean_sfc_albedo
ocean surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
Definition: mod_ocean_vars.F90:69
mod_atmos_phy_mp_vars::atmos_phy_mp_sflx_snow
real(rp), dimension(:,:), allocatable, public atmos_phy_mp_sflx_snow
Definition: mod_atmos_phy_mp_vars.F90:75
scale_atmos_phy_mp_suzuki10::nccn
integer, public nccn
Definition: scale_atmos_phy_mp_suzuki10.F90:140
mod_mkinit::i_coldbubble
integer, parameter, public i_coldbubble
Definition: mod_mkinit.F90:93
mod_urban_vars::urban_tr
real(rp), dimension(:,:), allocatable, public urban_tr
Definition: mod_urban_vars.F90:64
mod_ocean_vars::ocean_sfc_temp
real(rp), dimension(:,:), allocatable, public ocean_sfc_temp
ocean surface skin temperature [K]
Definition: mod_ocean_vars.F90:68
scale_atmos_grid_cartesc_index::ieb
integer, public ieb
Definition: scale_atmos_grid_cartesC_index.F90:65
mod_mkinit::i_khwave
integer, parameter, public i_khwave
Definition: mod_mkinit.F90:97
mod_atmos_phy_ae_vars
module ATMOSPHERE / Physics Aerosol Microphysics
Definition: mod_atmos_phy_ae_vars.F90:12
mod_mkinit::i_warmbubble
integer, parameter, public i_warmbubble
Definition: mod_mkinit.F90:101
mod_atmos_admin::atmos_phy_mp_type
character(len=h_short), public atmos_phy_mp_type
Definition: mod_atmos_admin.F90:36
scale_atmos_thermodyn
module atmosphere / thermodyn
Definition: scale_atmos_thermodyn.F90:11
scale_const::const_rdry
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
Definition: scale_const.F90:59
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level, disable_barrier)
Save raptime.
Definition: scale_prof.F90:246
scale_ocean_grid_cartesc_real
module ocean / grid / cartesianC / real
Definition: scale_ocean_grid_cartesC_real.F90:12
mod_atmos_phy_mp_vars::qe_mp
integer, public qe_mp
Definition: mod_atmos_phy_mp_vars.F90:80
scale_prc_cartesc::prc_num_x
integer, public prc_num_x
x length of 2D processor topology
Definition: scale_prc_cartesC.F90:42
mod_mkinit::urban_setup
subroutine urban_setup
Urban setup.
Definition: mod_mkinit.F90:1205
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_fz
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_fz
geopotential height [m] (wxy)
Definition: scale_atmos_grid_cartesC_real.F90:43
mod_ocean_vars::ocean_salt
real(rp), dimension(:,:,:), allocatable, public ocean_salt
ocean salinity [PSU]
Definition: mod_ocean_vars.F90:62
mod_urban_vars::urban_tbl
real(rp), dimension(:,:,:), allocatable, public urban_tbl
Definition: mod_urban_vars.F90:62
scale_atmos_grid_cartesc
module atmosphere / grid / cartesC
Definition: scale_atmos_grid_cartesC.F90:12
scale_landuse
module LANDUSE
Definition: scale_landuse.F90:19
scale_atmos_grid_cartesc::atmos_grid_cartesc_cz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cz
center coordinate [m]: z, local
Definition: scale_atmos_grid_cartesC.F90:41
mod_land_vars::land_ice
real(rp), dimension(:,:,:), allocatable, public land_ice
ice of each soil layer [m3/m3]
Definition: mod_land_vars.F90:64
mod_mkinit::i_lambwave
integer, parameter, public i_lambwave
Definition: mod_mkinit.F90:95
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_atmos_grid_cartesc_index::jsb
integer, public jsb
Definition: scale_atmos_grid_cartesC_index.F90:66
mod_mkinit::ocean_setup
subroutine ocean_setup
Ocean setup.
Definition: mod_mkinit.F90:1110
scale_atmos_saturation
module atmosphere / saturation
Definition: scale_atmos_saturation.F90:12
mod_atmos_phy_mp_driver::atmos_phy_mp_driver_qhyd2qtrc
subroutine, public atmos_phy_mp_driver_qhyd2qtrc(KA, KS, KE, IA, IS, IE, JA, JS, JE, QV, QHYD, QTRC, QNUM)
Definition: mod_atmos_phy_mp_driver.F90:1553
mod_mkinit
module INITIAL
Definition: mod_mkinit.F90:12
scale_const::const_ohm
real(rp), public const_ohm
angular velocity of the planet [1/s]
Definition: scale_const.F90:48
mod_urban_vars::urban_rainr
real(rp), dimension(:,:), allocatable, public urban_rainr
Definition: mod_urban_vars.F90:70
scale_const::const_pre00
real(rp), public const_pre00
pressure reference [Pa]
Definition: scale_const.F90:97
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_atmos_grid_cartesc_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:56
scale_atmos_hydrometeor::n_hyd
integer, parameter, public n_hyd
Definition: scale_atmos_hydrometeor.F90:95
mod_atmos_phy_ae_vars::qe_ae
integer, public qe_ae
Definition: mod_atmos_phy_ae_vars.F90:69
mod_urban_vars
module URBAN Variables
Definition: mod_urban_vars.F90:12
mod_mkinit::i_turbulence
integer, parameter, public i_turbulence
Definition: mod_mkinit.F90:98
mod_land_vars::snow_dzero
real(rp), dimension(:,:), allocatable, public snow_dzero
snow depth at melting point [m]
Definition: mod_land_vars.F90:72
scale_landuse::landuse_fillhalo
subroutine, public landuse_fillhalo(FILL_BND)
HALO Communication.
Definition: scale_landuse.F90:275
scale_atmos_grid_cartesc::atmos_grid_cartesc_cx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cx
center coordinate [m]: x, local
Definition: scale_atmos_grid_cartesC.F90:56
mod_mkinit::i_planestate
integer, parameter, public i_planestate
Definition: mod_mkinit.F90:91
mod_ocean_vars::ocean_temp
real(rp), dimension(:,:,:), allocatable, public ocean_temp
ocean temperature [K]
Definition: mod_ocean_vars.F90:61
mod_mkinit::i_squallline
integer, parameter, public i_squallline
Definition: mod_mkinit.F90:103
mod_mkinit::i_oceancouple
integer, parameter, public i_oceancouple
Definition: mod_mkinit.F90:112
Generated by   doxygen 1.8.17