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,converged) 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  if ( .not. converged ) then
2814  log_error("MKINIT_barocwave",*) "failed to obtain a state in hydrostatic balance", i, j
2815 #ifdef _OPENACC
2816  error = .true.
2817 #else
2818  call prc_abort
2819 #endif
2820  end if
2821 
2822  enddo
2823  enddo
2824  !$acc end kernels
2825 
2826  if ( error ) then
2827  call prc_abort
2828  end if
2829 
2830  !-----------------------------------------------------------------------------------
2831 
2832  !$acc kernels
2833  !$acc loop collapse(2) independent
2834  do j = jsb, jeb
2835  do k = ks, ke
2836 
2837  eta(k,is,j) = pres(k,is,j)/ref_pres
2838  ln_eta = log(eta(k,is,j))
2839  yphase = 2.0_rp*pi*cy(j)/ly
2840 !!$ PRES(k,IS:IE,j) = eta(k,IS,j)*REF_PRES
2841 !!$ DENS(k,IS:IE,j) = PRES(k,IS,j)/(Rdry*temp(k,IS,j))
2842  !$acc loop independent
2843  do i = isb, ieb
2844  if ( i .ne. is ) then
2845  dens(k,i,j) = dens(k,is,j)
2846  pres(k,i,j) = pres(k,is,j)
2847  end if
2848  rhot(k,i,j) = dens(k,is,j)*pott(k,is,j) !temp(k,IS,j)*eta(k,IS,j)**(-Rdry/CPdry)
2849  end do
2850  !$acc loop independent
2851  do i = isb, ieb
2852  momx(k,i,j) = dens(k,is,j)*(-u0*sin(0.5_rp*yphase)**2*ln_eta*exp(-(ln_eta/b)**2))
2853  end do
2854  enddo
2855  enddo
2856  !$acc end kernels
2857 
2858  !$acc kernels
2859  momy(:,:,:) = 0.0_rp
2860  momz(:,:,:) = 0.0_rp
2861  !$acc end kernels
2862 
2863  !---------------------------------------------------------------------------------------
2864 
2865  ! Add the inital perturbation for zonal velocity
2866  !$acc kernels
2867  !$acc loop collapse(3) independent
2868  do j = jsb, jeb
2869  do i = isb, ieb
2870  do k = ks, ke
2871  momx(k,i,j) = momx(k,i,j) &
2872  + dens(k,i,j)* up*exp( - ((fx(i) - xc)**2 + (cy(j) - yc)**2)/lp**2 )
2873  enddo
2874  enddo
2875  enddo
2876  !$acc end kernels
2877 
2878  !$acc end data
2879 
2880  return
2881  end subroutine mkinit_barocwave
2882 
2883  !-----------------------------------------------------------------------------
2885  subroutine mkinit_warmbubble
2886  use scale_atmos_hydrometeor, only: &
2887  atmos_hydrometeor_dry
2888  implicit none
2889 
2890  ! Surface state
2891  real(RP) :: SFC_THETA ! surface potential temperature [K]
2892  real(RP) :: SFC_PRES ! surface pressure [Pa]
2893  real(RP) :: SFC_RH = 80.0_rp ! surface relative humidity [%]
2894  ! Environment state
2895  real(RP) :: ENV_U = 0.0_rp ! velocity u of environment [m/s]
2896  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
2897  real(RP) :: ENV_RH = 80.0_rp ! Relative Humidity of environment [%]
2898  real(RP) :: ENV_L1_ZTOP = 1.e3_rp ! top height of the layer1 (constant THETA) [m]
2899  real(RP) :: ENV_L2_ZTOP = 14.e3_rp ! top height of the layer2 (small THETA gradient) [m]
2900  real(RP) :: ENV_L2_TLAPS = 4.e-3_rp ! Lapse rate of THETA in the layer2 (small THETA gradient) [K/m]
2901  real(RP) :: ENV_L3_TLAPS = 3.e-2_rp ! Lapse rate of THETA in the layer3 (large THETA gradient) [K/m]
2902  ! Bubble
2903  real(RP) :: BBL_THETA = 1.0_rp ! extremum of temperature in bubble [K]
2904 
2905  namelist / param_mkinit_warmbubble / &
2906  sfc_theta, &
2907  sfc_pres, &
2908  env_u, &
2909  env_v, &
2910  env_rh, &
2911  env_l1_ztop, &
2912  env_l2_ztop, &
2913  env_l2_tlaps, &
2914  env_l3_tlaps, &
2915  bbl_theta
2916 
2917  logical :: converged
2918 
2919 #ifdef _OPENACC
2920  real(RP) :: work1(KA)
2921  real(RP) :: work2(KA)
2922  real(RP) :: work3(KA)
2923 #endif
2924 
2925  integer :: ierr
2926  integer :: k, i, j, itr
2927  !---------------------------------------------------------------------------
2928 
2929  log_newline
2930  log_info("MKINIT_warmbubble",*) 'Setup initial state'
2931 
2932  if ( atmos_hydrometeor_dry ) then
2933  log_error("MKINIT_warmbubble",*) 'QV is not registered'
2934  call prc_abort
2935  end if
2936 
2937  sfc_theta = thetastd
2938  sfc_pres = pstd
2939 
2940  !--- read namelist
2941  rewind(io_fid_conf)
2942  read(io_fid_conf,nml=param_mkinit_warmbubble,iostat=ierr)
2943 
2944  if( ierr < 0 ) then !--- missing
2945  log_info("MKINIT_warmbubble",*) 'Not found namelist. Default used.'
2946  elseif( ierr > 0 ) then !--- fatal error
2947  log_error("MKINIT_warmbubble",*) 'Not appropriate names in namelist PARAM_MKINIT_WARMBUBBLE. Check!'
2948  call prc_abort
2949  endif
2950  log_nml(param_mkinit_warmbubble)
2951 
2952  ! calc in dry condition
2953  !$acc kernels
2954  pres_sfc(1,1) = sfc_pres
2955  pott_sfc(1,1) = sfc_theta
2956  !$acc end kernels
2957 
2958  !$acc kernels
2959  !$acc loop seq
2960  do k = ks, ke
2961  if ( cz(k) <= env_l1_ztop ) then ! Layer 1
2962  pott(k,1,1) = sfc_theta
2963  elseif( cz(k) < env_l2_ztop ) then ! Layer 2
2964  pott(k,1,1) = pott(k-1,1,1) + env_l2_tlaps * ( cz(k)-cz(k-1) )
2965  else ! Layer 3
2966  pott(k,1,1) = pott(k-1,1,1) + env_l3_tlaps * ( cz(k)-cz(k-1) )
2967  endif
2968  enddo
2969  !$acc end kernels
2970 
2971  ! make density & pressure profile in dry condition
2972  call hydrostatic_buildrho( ka, ks, ke, &
2973  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
2974  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
2975  cz(:), fz(:), & ! [IN]
2976 #ifdef _OPENACC
2977  work1(:), work2(:), work3(:), & ! [WORK]
2978 #endif
2979  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
2980  converged ) ! [OUT]
2981 
2982  ! calc QV from RH
2983  call saturation_pres2qsat_all( temp_sfc(1,1), pres_sfc(1,1), & ! [IN]
2984  qsat_sfc(1,1) ) ! [OUT]
2985  !$acc kernels
2986  qv_sfc(1,1) = sfc_rh * 1.e-2_rp * qsat_sfc(1,1)
2987  !$acc end kernels
2988 
2989  do itr = 1, niter_rh
2990  call saturation_psat_all( ka, ks, ke, &
2991  temp(:,1,1), & ! [IN]
2992  psat(:,1,1) ) ! [OUT]
2993  !$acc kernels
2994  do k = ks, ke
2995  if( cz(k) <= env_l2_ztop ) then ! Layer 1 and 2
2996  qv(k,1,1) = env_rh * 1.e-2_rp * psat(k,1,1) / ( dens(k,1,1) * rvap * temp(k,1,1) )
2997  else ! Layer 3
2998  qv(k,1,1) = 0.0_rp
2999  endif
3000  enddo
3001  !$acc end kernels
3002 
3003  ! make density & pressure profile in moist condition
3004  call hydrostatic_buildrho( ka, ks, ke, &
3005  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
3006  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
3007  cz(:), fz(:), & ! [IN]
3008 #ifdef _OPENACC
3009  work1(:), work2(:), work3(:), & ! [WORK]
3010 #endif
3011  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
3012  converged ) ! [OUT]
3013  end do
3014 
3015  !$acc kernels
3016  !$acc loop collapse(3) independent
3017  do j = jsb, jeb
3018  do i = isb, ieb
3019  do k = ks, ke
3020  dens(k,i,j) = dens(k,1,1)
3021  momz(k,i,j) = 0.0_rp
3022  momx(k,i,j) = env_u * dens(k,i,j)
3023  momy(k,i,j) = env_v * dens(k,i,j)
3024 
3025  ! make warm bubble
3026  rhot(k,i,j) = dens(k,1,1) * ( pott(k,1,1) + bbl_theta * bubble(k,i,j) )
3027 
3028  qv(k,i,j) = qv(k,1,1)
3029  enddo
3030  enddo
3031  enddo
3032  !$acc end kernels
3033 
3034  call flux_setup
3035 
3036  return
3037  end subroutine mkinit_warmbubble
3038 
3039  !-----------------------------------------------------------------------------
3041  subroutine mkinit_supercell
3042  use scale_atmos_hydrometeor, only: &
3043  atmos_hydrometeor_dry
3044  implicit none
3045 
3046  real(RP) :: RHO(KA)
3047  real(RP) :: VELX(KA)
3048  real(RP) :: VELY(KA)
3049  real(RP) :: POTT(KA)
3050  real(RP) :: QV1D(KA)
3051 
3052  ! Bubble
3053  real(RP) :: BBL_THETA = 3.d0 ! extremum of temperature in bubble [K]
3054 
3055  namelist / param_mkinit_supercell / &
3056  bbl_theta
3057 
3058  integer :: ierr
3059  integer :: k, i, j
3060  !---------------------------------------------------------------------------
3061 
3062  log_newline
3063  log_info("MKINIT_supercell",*) 'Setup initial state'
3064 
3065  if ( atmos_hydrometeor_dry ) then
3066  log_error("MKINIT_supercell",*) 'QV is not registered'
3067  call prc_abort
3068  end if
3069 
3070  !--- read namelist
3071  rewind(io_fid_conf)
3072  read(io_fid_conf,nml=param_mkinit_supercell,iostat=ierr)
3073 
3074  if( ierr < 0 ) then !--- missing
3075  log_info("MKINIT_supercell",*) 'Not found namelist. Default used.'
3076  elseif( ierr > 0 ) then !--- fatal error
3077  log_error("MKINIT_supercell",*) 'Not appropriate names in namelist PARAM_MKINIT_SUPERCELL. Check!'
3078  call prc_abort
3079  endif
3080  log_nml(param_mkinit_supercell)
3081 
3082  call read_sounding( rho, velx, vely, pott, qv1d ) ! (out)
3083 
3084  !$acc kernels
3085  !$acc loop collapse(3) independent
3086  do j = jsb, jeb
3087  do i = isb, ieb
3088  do k = ks, ke
3089  dens(k,i,j) = rho(k)
3090  momz(k,i,j) = 0.0_rp
3091  momx(k,i,j) = rho(k) * velx(k)
3092  momy(k,i,j) = rho(k) * vely(k)
3093 
3094  ! make warm bubble
3095  rhot(k,i,j) = rho(k) * ( pott(k) + bbl_theta * bubble(k,i,j) )
3096 
3097  qv(k,i,j) = qv1d(k)
3098  enddo
3099  enddo
3100  enddo
3101  !$acc end kernels
3102 
3103  call flux_setup
3104 
3105  return
3106  end subroutine mkinit_supercell
3107 
3108  !-----------------------------------------------------------------------------
3110  subroutine mkinit_squallline
3111  use scale_atmos_hydrometeor, only: &
3112  atmos_hydrometeor_dry
3113  implicit none
3114 
3115  real(RP) :: RHO(KA)
3116  real(RP) :: VELX(KA)
3117  real(RP) :: VELY(KA)
3118  real(RP) :: POTT(KA)
3119  real(RP) :: QV1D(KA)
3120 
3121  real(RP) :: RANDOM_THETA = 0.01_rp
3122  real(RP) :: OFFSET_velx = 12.0_rp
3123  real(RP) :: OFFSET_vely = -2.0_rp
3124 
3125  namelist / param_mkinit_squallline / &
3126  random_theta, &
3127  offset_velx, &
3128  offset_vely
3129 
3130  integer :: ierr
3131  integer :: k, i, j
3132  !---------------------------------------------------------------------------
3133 
3134  log_newline
3135  log_info("MKINIT_squallline",*) 'Setup initial state'
3136 
3137  if ( atmos_hydrometeor_dry ) then
3138  log_error("MKINIT_squallline",*) 'QV is not registered'
3139  call prc_abort
3140  end if
3141 
3142  !--- read namelist
3143  rewind(io_fid_conf)
3144  read(io_fid_conf,nml=param_mkinit_squallline,iostat=ierr)
3145 
3146  if( ierr < 0 ) then !--- missing
3147  log_info("MKINIT_squallline",*) 'Not found namelist. Default used.'
3148  elseif( ierr > 0 ) then !--- fatal error
3149  log_error("MKINIT_squallline",*) 'Not appropriate names in namelist PARAM_MKINIT_SQUALLLINE. Check!'
3150  call prc_abort
3151  endif
3152  log_nml(param_mkinit_squallline)
3153 
3154  call read_sounding( rho, velx, vely, pott, qv1d ) ! (out)
3155 
3156  call random_uniform(rndm) ! make random
3157  !$acc kernels
3158  !$acc loop collapse(3) independent
3159  do j = jsb, jeb
3160  do i = isb, ieb
3161  do k = ks, ke
3162  dens(k,i,j) = rho(k)
3163  momz(k,i,j) = 0.0_rp
3164  momx(k,i,j) = ( velx(k) - offset_velx ) * rho(k)
3165  momy(k,i,j) = ( vely(k) - offset_vely ) * rho(k)
3166  rhot(k,i,j) = rho(k) * ( pott(k) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * random_theta )
3167  qv(k,i,j) = qv1d(k)
3168  enddo
3169  enddo
3170  enddo
3171  !$acc end kernels
3172 
3173  call flux_setup
3174 
3175  return
3176  end subroutine mkinit_squallline
3177 
3178  !-----------------------------------------------------------------------------
3180  subroutine mkinit_wk1982
3181  use scale_atmos_hydrometeor, only: &
3182  atmos_hydrometeor_dry
3183  implicit none
3184 
3185  ! Surface state
3186  real(RP) :: SFC_THETA = 300.0_rp ! surface pot. temperature [K]
3187  real(RP) :: SFC_PRES ! surface pressure [Pa]
3188  ! Parameter in Weisman and Klemp (1982)
3189  real(RP) :: TR_Z = 12000.0_rp ! height of tropopause [m]
3190  real(RP) :: TR_THETA = 343.0_rp ! pot. temperature at tropopause [K]
3191  real(RP) :: TR_TEMP = 213.0_rp ! temperature at tropopause [K]
3192  real(RP) :: SHEAR_Z = 3000.0_rp ! center height of shear layer [m]
3193  real(RP) :: SHEAR_U = 15.0_rp ! velocity u over the shear layer [m/s]
3194  real(RP) :: QV0 = 14.0_rp ! maximum vapor mixing ration [g/kg]
3195  ! Bubble
3196  real(RP) :: BBL_THETA = 3.d0 ! extremum of temperature in bubble [K]
3197 
3198  namelist / param_mkinit_wk1982 / &
3199  sfc_theta, &
3200  sfc_pres, &
3201  tr_z, &
3202  tr_theta, &
3203  tr_temp, &
3204  shear_z, &
3205  shear_u, &
3206  qv0, &
3207  bbl_theta
3208 
3209  real(RP) :: rh (KA,IA,JA)
3210  real(RP) :: rh_sfc( IA,JA)
3211 
3212  integer :: ierr
3213  integer :: k, i, j, itr
3214  !---------------------------------------------------------------------------
3215 
3216  log_newline
3217  log_info("MKINIT_wk1982",*) 'Setup initial state'
3218 
3219  if ( atmos_hydrometeor_dry ) then
3220  log_error("MKINIT_wk1982",*) 'QV is not registered'
3221  call prc_abort
3222  end if
3223 
3224  sfc_pres = pstd
3225 
3226  rewind(io_fid_conf)
3227  read(io_fid_conf,nml=param_mkinit_wk1982,iostat=ierr)
3228  if( ierr < 0 ) then !--- missing
3229  log_info("MKINIT_wk1982",*) 'Not found namelist. Default used.'
3230  elseif( ierr > 0 ) then !--- fatal error
3231  log_error("MKINIT_wk1982",*) 'Not appropriate names in namelist PARAM_MKINIT_WK1982. Check!'
3232  call prc_abort
3233  endif
3234  log_nml(param_mkinit_wk1982)
3235 
3236  ! calc in dry condition
3237  !$acc kernels
3238  do j = jsb, jeb
3239  do i = isb, ieb
3240  pres_sfc(i,j) = sfc_pres
3241  pott_sfc(i,j) = sfc_theta
3242 
3243  do k = ks, ke
3244  if ( real_cz(k,i,j) <= tr_z ) then ! below initial cloud top
3245  pott(k,i,j) = pott_sfc(i,j) &
3246  + ( tr_theta - pott_sfc(i,j) ) * ( real_cz(k,i,j) / tr_z )**1.25_rp
3247  else
3248  pott(k,i,j) = tr_theta * exp( grav * ( real_cz(k,i,j) - tr_z ) / cpdry / tr_temp )
3249  endif
3250  enddo
3251  enddo
3252  enddo
3253  !$acc end kernels
3254 
3255  ! make density & pressure profile in dry condition
3256  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3257  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3258  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3259  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3260  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3261 
3262  !$acc data create(rh,rh_sfc)
3263 
3264  ! calc QV from RH
3265  !$acc kernels
3266  do j = jsb, jeb
3267  do i = isb, ieb
3268  rh_sfc(i,j) = 1.0_rp - 0.75_rp * ( real_fz(ks-1,i,j) / tr_z )**1.25_rp
3269 
3270  do k = ks, ke
3271  if ( real_cz(k,i,j) <= tr_z ) then ! below initial cloud top
3272  rh(k,i,j) = 1.0_rp - 0.75_rp * ( real_cz(k,i,j) / tr_z )**1.25_rp
3273  else
3274  rh(k,i,j) = 0.25_rp
3275  endif
3276  enddo
3277  enddo
3278  enddo
3279  !$acc end kernels
3280 
3281  qv0 = qv0 * 1e-3_rp ! g/kg to kg/kg
3282  qv0 = qv0 / ( 1.0_rp + qv0 ) ! mixing ratio to specicic humidity
3283 
3284  call saturation_pres2qsat_all( ia, isb, ieb, ja, jsb, jeb, &
3285  temp_sfc(:,:), pres_sfc(:,:), & ! [IN]
3286  qsat_sfc(:,:) ) ! [OUT]
3287  !$acc kernels
3288  do j = jsb, jeb
3289  do i = isb, ieb
3290  qv_sfc(i,j) = min( rh_sfc(i,j) * qsat_sfc(i,j), qv0 )
3291  enddo
3292  enddo
3293  !$acc end kernels
3294 
3295  do itr = 1, niter_rh
3296  call saturation_psat_all( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3297  temp(:,:,:), & ! [IN]
3298  psat(:,:,:) ) ! [OUT]
3299  !$acc kernels
3300  do j = jsb, jeb
3301  do i = isb, ieb
3302  do k = ks, ke
3303  qv(k,i,j) = min( rh(k,i,j) * psat(k,i,j) / ( dens(k,i,j) * rdry * temp(k,i,j) ), qv0 )
3304  enddo
3305  enddo
3306  enddo
3307  !$acc end kernels
3308 
3309  ! make density & pressure profile in moist condition
3310  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3311  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3312  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3313  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3314  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3315  end do
3316 
3317  !$acc update host(pres(:,IS,JS),pott(:,IS,JS),rh(:,IS,JS),qv(:,IS,JS))
3318  do k = ks, ke
3319  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
3320  enddo
3321 
3322  call comm_vars8( dens(:,:,:), 1 )
3323  call comm_wait ( dens(:,:,:), 1 )
3324 
3325  !$acc kernels
3326  !$acc loop collapse(3) independent
3327  do j = jsb, jeb
3328  do i = isb, ieb
3329  do k = ks, ke
3330  momx(k,i,j) = shear_u * tanh( real_cz(k,i,j) / shear_z ) &
3331  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3332  enddo
3333  enddo
3334  enddo
3335  !$acc end kernels
3336 
3337  !$acc kernels
3338  !$acc loop collapse(3) independent
3339  do j = jsb, jeb
3340  do i = isb, ieb
3341  do k = ks, ke
3342  momy(k,i,j) = 0.0_rp
3343  momz(k,i,j) = 0.0_rp
3344  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
3345 
3346  ! make warm bubble
3347  rhot(k,i,j) = dens(k,i,j) * ( pott(k,i,j) + bbl_theta * bubble(k,i,j) )
3348  enddo
3349  enddo
3350  enddo
3351  !$acc end kernels
3352 
3353  call flux_setup
3354 
3355  !$acc end data
3356 
3357  return
3358  end subroutine mkinit_wk1982
3359 
3360  !-----------------------------------------------------------------------------
3362  subroutine mkinit_dycoms2_rf01
3363  use scale_const, only: &
3364  rdry => const_rdry, &
3365  rvap => const_rvap, &
3366  cpdry => const_cpdry, &
3367  cpvap => const_cpvap, &
3368  cl => const_cl
3369  use scale_atmos_hydrometeor, only: &
3370  atmos_hydrometeor_dry
3371  implicit none
3372 
3373 #ifndef DRY
3374  real(RP) :: PERTURB_AMP = 0.0_rp
3375  integer :: RANDOM_LIMIT = 5
3376  integer :: RANDOM_FLAG = 0 ! 0 -> no perturbation
3377  ! 1 -> petrurbation for pt
3378  ! 2 -> perturbation for u, v, w
3379  logical :: USE_LWSET = .false. ! use liq. water. static energy temp.?
3380 
3381  namelist / param_mkinit_rf01 / &
3382  perturb_amp, &
3383  random_limit, &
3384  random_flag, &
3385  use_lwset
3386 
3387  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
3388  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
3389 
3390  real(RP) :: qall ! QV+QC
3391  real(RP) :: fact
3392  real(RP) :: pi2
3393  real(RP) :: sint
3394  real(RP) :: GEOP_sw ! switch for geopotential energy correction
3395 
3396  real(RP) :: qdry, Rtot, CPtot
3397 
3398  integer :: ierr
3399  integer :: k, i, j
3400  !---------------------------------------------------------------------------
3401 
3402  pi2 = atan(1.0_rp) * 2.0_rp ! pi/2
3403 
3404  log_newline
3405  log_info("MKINIT_DYCOMS2_RF01",*) 'Setup initial state'
3406 
3407  rewind(io_fid_conf)
3408 
3409  if ( atmos_hydrometeor_dry ) then
3410  log_error("MKINIT_DYCOMS2_RF01",*) 'QV is not registered'
3411  call prc_abort
3412  end if
3413 
3414  read(io_fid_conf,nml=param_mkinit_rf01,iostat=ierr)
3415  if( ierr < 0 ) then !--- missing
3416  log_info("MKINIT_DYCOMS2_RF01",*) 'Not found namelist. Default used.'
3417  elseif( ierr > 0 ) then !--- fatal error
3418  log_error("MKINIT_DYCOMS2_RF01",*) 'Not appropriate names in namelist PARAM_MKINIT_RF01. Check!'
3419  call prc_abort
3420  endif
3421  log_nml(param_mkinit_rf01)
3422 
3423  if ( use_lwset ) then
3424  geop_sw = 1.0_rp
3425  else
3426  geop_sw = 0.0_rp
3427  endif
3428 
3429  !$acc data create(potl,lhv)
3430 
3431  ! calc in dry condition
3432  !$acc kernels
3433  do j = jsb, jeb
3434  do i = isb, ieb
3435 
3436  pres_sfc(i,j) = 1017.8e2_rp ! [Pa]
3437  pott_sfc(i,j) = 289.0_rp ! [K]
3438 
3439  do k = ks, ke
3440  velx(k,i,j) = 7.0_rp
3441  vely(k,i,j) = -5.5_rp
3442  if ( cz(k) < 820.0_rp ) then ! below initial cloud top
3443  potl(k,i,j) = 289.0_rp - grav / cpdry * cz(k) * geop_sw
3444  elseif( cz(k) <= 860.0_rp ) then
3445  sint = sin( pi2 * ( cz(k)-840.0_rp ) / 20.0_rp ) * 0.5_rp
3446  potl(k,i,j) = ( 289.0_rp - grav / cpdry * cz(k) * geop_sw ) * (0.5_rp-sint) &
3447  + ( 297.5_rp+sign(abs(cz(k)-840.0_rp)**(1.0_rp/3.0_rp),cz(k)-840.0_rp) &
3448  - grav / cpdry * cz(k) * geop_sw ) * (0.5_rp+sint)
3449  else
3450  potl(k,i,j) = 297.5_rp + ( cz(k)-840.0_rp )**(1.0_rp/3.0_rp) &
3451  - grav / cpdry * cz(k) * geop_sw
3452  endif
3453  enddo
3454 
3455  enddo
3456  enddo
3457  !$acc end kernels
3458 
3459  ! make density & pressure profile in dry condition
3460  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3461  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3462  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3463  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3464  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3465 
3466  ! calc in moist condition
3467  !$acc kernels
3468  do j = jsb, jeb
3469  do i = isb, ieb
3470  qv_sfc(i,j) = 9.0e-3_rp ! [kg/kg]
3471 
3472  do k = ks, ke
3473  if ( cz(k) < 820.0_rp ) then ! below initial cloud top
3474  qall = 9.0e-3_rp
3475  elseif( cz(k) <= 860.0_rp ) then ! boundary
3476  sint = sin( pi2 * ( cz(k)-840.0_rp ) / 20.0_rp ) * 0.5_rp
3477  qall = 9.0e-3_rp * (0.5_rp-sint) &
3478  + 1.5e-3_rp * (0.5_rp+sint)
3479  elseif( cz(k) <= 5000.0_rp ) then
3480  qall = 1.5e-3_rp
3481  else
3482  qall = 0.0_rp
3483  endif
3484 
3485  if ( cz(k) <= 600.0_rp ) then
3486  qc(k,i,j) = 0.0_rp
3487  elseif( cz(k) < 820.0_rp ) then ! in the cloud
3488  fact = ( cz(k)-600.0_rp ) / ( 840.0_rp-600.0_rp )
3489  qc(k,i,j) = 0.45e-3_rp * fact
3490  elseif( cz(k) <= 860.0_rp ) then ! boundary
3491  sint = sin( pi2 * ( cz(k)-840.0_rp ) / 20.0_rp ) * 0.5_rp
3492  fact = ( cz(k)-600.0_rp ) / ( 840.0_rp-600.0_rp )
3493  qc(k,i,j) = 0.45e-3_rp * fact * (0.5_rp-sint)
3494  else
3495  qc(k,i,j) = 0.0_rp
3496  endif
3497 
3498  qv(k,i,j) = qall - qc(k,i,j)
3499  enddo
3500 
3501  enddo
3502  enddo
3503  !$acc end kernels
3504 
3505  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3506  temp(:,:,:), lhv(:,:,:) )
3507 
3508  !$acc kernels
3509  do j = jsb, jeb
3510  do i = isb, ieb
3511  do k = ks, ke
3512  temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
3513  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
3514  rtot = rdry * qdry + rvap * qv(k,i,j)
3515  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
3516  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
3517  enddo
3518  enddo
3519  enddo
3520  !$acc end kernels
3521 
3522  ! make density & pressure profile in moist condition
3523  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3524  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3525  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3526  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3527  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3528 
3529  !$acc kernels
3530  !$acc loop collapse(2) independent
3531  do j = jsb, jeb
3532  do i = isb, ieb
3533  dens( 1:ks-1,i,j) = dens(ks,i,j)
3534  dens(ke+1:ka, i,j) = dens(ke,i,j)
3535  enddo
3536  enddo
3537  !$acc end kernels
3538 
3539  call comm_vars8( dens(:,:,:), 1 )
3540  call comm_wait ( dens(:,:,:), 1 )
3541 
3542  call random_uniform(rndm) ! make random
3543  !$acc kernels
3544  !$acc loop collapse(3) independent
3545  do j = jsb, jeb
3546  do i = isb, ieb
3547  do k = ks, ke
3548  if ( random_flag == 2 .and. k <= random_limit ) then ! below initial cloud top
3549  momz(k,i,j) = ( ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3550  * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
3551  else
3552  momz(k,i,j) = 0.0_rp
3553  endif
3554  enddo
3555  enddo
3556  enddo
3557  !$acc end kernels
3558 
3559  call random_uniform(rndm) ! make random
3560  !$acc kernels
3561  !$acc loop collapse(3) independent
3562  do j = jsb, jeb
3563  do i = isb, ieb
3564  do k = ks, ke
3565  if ( random_flag == 2 .AND. k <= random_limit ) then ! below initial cloud top
3566  momx(k,i,j) = ( velx(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3567  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3568  else
3569  momx(k,i,j) = velx(k,i,j) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3570  endif
3571  enddo
3572  enddo
3573  enddo
3574  !$acc end kernels
3575 
3576  call random_uniform(rndm) ! make random
3577  !$acc kernels
3578  !$acc loop collapse(3) independent
3579  do j = jsb, jeb
3580  do i = isb, ieb
3581  do k = ks, ke
3582  if ( random_flag == 2 .AND. k <= random_limit ) then ! below initial cloud top
3583  momy(k,i,j) = ( vely(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3584  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
3585  else
3586  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
3587  endif
3588  enddo
3589  enddo
3590  enddo
3591  !$acc end kernels
3592 
3593  call random_uniform(rndm) ! make random
3594  !$acc kernels
3595  !$acc loop collapse(3) independent
3596  do j = jsb, jeb
3597  do i = isb, ieb
3598  do k = ks, ke
3599  if ( random_flag == 1 .and. k <= random_limit ) then ! below initial cloud top
3600  rhot(k,i,j) = ( pott(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3601  * dens(k,i,j)
3602  else
3603  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
3604  endif
3605  enddo
3606  enddo
3607  enddo
3608  !$acc end kernels
3609 
3610  !$acc kernels
3611  do j = jsb, jeb
3612  do i = isb, ieb
3613  do k = ks, ke
3614  if ( qc(k,i,j) > 0.0_rp ) then
3615  nc(k,i,j) = 120.e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
3616  end if
3617  enddo
3618  enddo
3619  enddo
3620  !$acc end kernels
3621 
3622  !$acc end data
3623 
3624 #endif
3625  return
3626  end subroutine mkinit_dycoms2_rf01
3627 
3628  !-----------------------------------------------------------------------------
3630  subroutine mkinit_dycoms2_rf02
3631  use scale_const, only: &
3632  rdry => const_rdry, &
3633  rvap => const_rvap, &
3634  cpdry => const_cpdry, &
3635  cpvap => const_cpvap, &
3636  cl => const_cl
3637  use scale_atmos_hydrometeor, only: &
3638  atmos_hydrometeor_dry
3639  implicit none
3640 
3641 #ifndef DRY
3642  real(RP) :: PERTURB_AMP = 0.0_rp
3643  integer :: RANDOM_LIMIT = 5
3644  integer :: RANDOM_FLAG = 0 ! 0 -> no perturbation
3645  ! 1 -> perturbation for PT
3646  ! 2 -> perturbation for u,v,w
3647 
3648  namelist / param_mkinit_rf02 / &
3649  perturb_amp, &
3650  random_limit, &
3651  random_flag
3652 
3653  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
3654  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
3655 
3656  real(RP) :: qall ! QV+QC
3657  real(RP) :: fact
3658  real(RP) :: pi2
3659  real(RP) :: sint
3660  real(RP) :: qdry, Rtot, CPtot
3661 
3662  integer :: ierr
3663  integer :: k, i, j
3664  !---------------------------------------------------------------------------
3665 
3666  pi2 = atan(1.0_rp) * 2.0_rp ! pi/2
3667  log_newline
3668  log_info("MKINIT_DYCOMS2_RF02",*) 'Setup initial state'
3669 
3670  if ( atmos_hydrometeor_dry ) then
3671  log_error("MKINIT_DYCOMS2_RF02",*) 'QV is not registered'
3672  call prc_abort
3673  end if
3674 
3675  rewind(io_fid_conf)
3676  read(io_fid_conf,nml=param_mkinit_rf02,iostat=ierr)
3677  if( ierr < 0 ) then !--- missing
3678  log_info("MKINIT_DYCOMS2_RF02",*) 'Not found namelist. Default used.'
3679  elseif( ierr > 0 ) then !--- fatal error
3680  log_error("MKINIT_DYCOMS2_RF02",*) 'Not appropriate names in namelist PARAM_MKINIT_RF02. Check!'
3681  call prc_abort
3682  endif
3683  log_nml(param_mkinit_rf02)
3684 
3685  !$acc data create(potl,LHV)
3686 
3687  ! calc in dry condition
3688  call random_uniform(rndm) ! make random
3689  !$acc kernels
3690  do j = jsb, jeb
3691  do i = isb, ieb
3692 
3693  pres_sfc(i,j) = 1017.8e2_rp ! [Pa]
3694  pott_sfc(i,j) = 288.3_rp ! [K]
3695 
3696  do k = ks, ke
3697  velx(k,i,j) = 3.0_rp + 4.3 * cz(k)*1.e-3_rp
3698  vely(k,i,j) = -9.0_rp + 5.6 * cz(k)*1.e-3_rp
3699 
3700  if ( cz(k) < 775.0_rp ) then ! below initial cloud top
3701  potl(k,i,j) = 288.3_rp ! [K]
3702  else if ( cz(k) <= 815.0_rp ) then
3703  sint = sin( pi2 * (cz(k) - 795.0_rp)/20.0_rp )
3704  potl(k,i,j) = 288.3_rp * (1.0_rp-sint)*0.5_rp &
3705  + ( 295.0_rp+sign(abs(cz(k)-795.0_rp)**(1.0_rp/3.0_rp),cz(k)-795.0_rp) ) &
3706  * (1.0_rp+sint)*0.5_rp
3707  else
3708  potl(k,i,j) = 295.0_rp + ( cz(k)-795.0_rp )**(1.0_rp/3.0_rp)
3709  endif
3710  enddo
3711  enddo
3712  enddo
3713  !$acc end kernels
3714 
3715  ! make density & pressure profile in dry condition
3716  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3717  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3718  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3719  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3720  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3721 
3722  ! calc in moist condition
3723  !$acc kernels
3724  do j = jsb, jeb
3725  do i = isb, ieb
3726  qv_sfc(i,j) = 9.45e-3_rp
3727 
3728  do k = ks, ke
3729  if ( cz(k) < 775.0_rp ) then ! below initial cloud top
3730  qall = 9.45e-3_rp ! [kg/kg]
3731  else if ( cz(k) <= 815.0_rp ) then
3732  sint = sin( pi2 * (cz(k) - 795.0_rp)/20.0_rp )
3733  qall = 9.45e-3_rp * (1.0_rp-sint)*0.5_rp + &
3734  ( 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
3735  else
3736  qall = 5.e-3_rp - 3.e-3_rp * ( 1.0_rp - exp( (795.0_rp-cz(k))/500.0_rp ) ) ! [kg/kg]
3737  endif
3738 
3739  if( cz(k) < 400.0_rp ) then
3740  qc(k,i,j) = 0.0_rp
3741  elseif( cz(k) < 775.0_rp ) then
3742  fact = ( cz(k)-400.0_rp ) / ( 795.0_rp-400.0_rp )
3743  qc(k,i,j) = 0.65e-3_rp * fact
3744  elseif( cz(k) <= 815.0_rp ) then
3745  sint = sin( pi2 * ( cz(k)-795.0_rp )/20.0_rp )
3746  fact = ( cz(k)-400.0_rp ) / ( 795.0_rp-400.0_rp )
3747  qc(k,i,j) = 0.65e-3_rp * fact * (1.0_rp-sint) * 0.5_rp
3748  else
3749  qc(k,i,j) = 0.0_rp
3750  endif
3751  qv(k,i,j) = qall - qc(k,i,j)
3752  enddo
3753 
3754  enddo
3755  enddo
3756  !$acc end kernels
3757 
3758  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3759  temp(:,:,:), lhv(:,:,:) )
3760 
3761  !$acc kernels
3762  do j = jsb, jeb
3763  do i = isb, ieb
3764  do k = ks, ke
3765  temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
3766  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
3767  rtot = rdry * qdry + rvap * qv(k,i,j)
3768  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
3769  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
3770  enddo
3771  enddo
3772  enddo
3773  !$acc end kernels
3774 
3775  ! make density & pressure profile in moist condition
3776  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
3777  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
3778  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
3779  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
3780  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
3781 
3782  !$acc kernels
3783  !$acc loop collapse(2) independent
3784  do j = jsb, jeb
3785  do i = isb, ieb
3786  dens( 1:ks-1,i,j) = dens(ks,i,j)
3787  dens(ke+1:ka, i,j) = dens(ke,i,j)
3788  enddo
3789  enddo
3790  !$acc end kernels
3791 
3792  call comm_vars8( dens(:,:,:), 1 )
3793  call comm_wait ( dens(:,:,:), 1 )
3794 
3795  call random_uniform(rndm) ! make random
3796  !$acc kernels
3797  !$acc loop collapse(3) independent
3798  do j = jsb, jeb
3799  do i = isb, ieb
3800  do k = ks, ke
3801  if( random_flag == 2 .and. k <= random_limit ) then
3802  momz(k,i,j) = ( 0.0_rp + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3803  * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
3804  else
3805  momz(k,i,j) = 0.0_rp
3806  endif
3807  enddo
3808  enddo
3809  enddo
3810  !$acc end kernels
3811 
3812  call random_uniform(rndm) ! make random
3813  !$acc kernels
3814  !$acc loop collapse(3) independent
3815  do j = jsb, jeb
3816  do i = isb, ieb
3817  do k = ks, ke
3818  if( random_flag == 2 .and. k <= random_limit ) then
3819  momx(k,i,j) = ( velx(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3820  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3821  else
3822  momx(k,i,j) = ( velx(k,i,j) ) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
3823  endif
3824  enddo
3825  enddo
3826  enddo
3827  !$acc end kernels
3828 
3829  call random_uniform(rndm) ! make random
3830  !$acc kernels
3831  !$acc loop collapse(3) independent
3832  do j = jsb, jeb
3833  do i = isb, ieb
3834  do k = ks, ke
3835  if( random_flag == 2 .and. k <= random_limit ) then
3836  momy(k,i,j) = ( vely(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3837  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
3838  else
3839  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
3840  endif
3841  enddo
3842  enddo
3843  enddo
3844  !$acc end kernels
3845 
3846  call random_uniform(rndm) ! make random
3847  !$acc kernels
3848  !$acc loop collapse(3) independent
3849  do j = jsb, jeb
3850  do i = isb, ieb
3851  do k = ks, ke
3852  if( random_flag == 1 .and. k <= random_limit ) then
3853  rhot(k,i,j) = ( pott(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
3854  * dens(k,i,j)
3855  else
3856  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
3857  endif
3858  enddo
3859  enddo
3860  enddo
3861  !$acc end kernels
3862 
3863  !$acc kernels
3864  do j = jsb, jeb
3865  do i = isb, ieb
3866  do k = ks, ke
3867  if ( qc(k,i,j) > 0.0_rp ) then
3868  nc(k,i,j) = 55.0e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
3869  endif
3870  enddo
3871  enddo
3872  enddo
3873  !$acc end kernels
3874 
3875  !$acc end data
3876 
3877 #endif
3878  return
3879  end subroutine mkinit_dycoms2_rf02
3880 
3881  !-----------------------------------------------------------------------------
3883  subroutine mkinit_dycoms2_rf02_dns
3884  use scale_const, only: &
3885  rdry => const_rdry, &
3886  rvap => const_rvap, &
3887  cpdry => const_cpdry, &
3888  cpvap => const_cpvap, &
3889  cl => const_cl
3890  use scale_atmos_hydrometeor, only: &
3891  atmos_hydrometeor_dry
3892  implicit none
3893 
3894 #ifndef DRY
3895  real(RP) :: ZB = 750.0_rp ! domain bottom
3896 ! real(RP) :: ZT = 900.0_RP ! domain top
3897  real(RP) :: CONST_U = 0.0_rp
3898  real(RP) :: CONST_V = 0.0_rp
3899  real(RP) :: PRES_ZB = 93060.0_rp
3900  real(RP) :: PERTURB_AMP = 0.0_rp
3901  integer :: RANDOM_LIMIT = 5
3902  integer :: RANDOM_FLAG = 0 ! 0 -> no perturbation
3903  ! 1 -> perturbation for PT
3904  ! 2 -> perturbation for u,v,w
3905 
3906  namelist / param_mkinit_rf02_dns / &
3907  zb, const_u, const_v,pres_zb,&
3908  perturb_amp, &
3909  random_limit, &
3910  random_flag
3911 
3912  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
3913  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
3914 
3915  real(RP) :: qall ! QV+QC
3916  real(RP) :: fact
3917  real(RP) :: pi2
3918 
3919  real(RP) :: qdry, Rtot, CPtot
3920 
3921  integer :: ierr
3922  integer :: k, i, j
3923  !---------------------------------------------------------------------------
3924 
3925  pi2 = atan(1.0_rp) * 2.0_rp ! pi/2
3926 
3927  log_newline
3928  log_info("MKINIT_DYCOMS2_RF02_DNS",*) 'Setup initial state'
3929 
3930  if ( atmos_hydrometeor_dry ) then
3931  log_error("MKINIT_DYCOMS2_RF02_DNS",*) 'QV is not registered'
3932  call prc_abort
3933  end if
3934 
3935  rewind(io_fid_conf)
3936  read(io_fid_conf,nml=param_mkinit_rf02_dns,iostat=ierr)
3937  if( ierr < 0 ) then !--- missing
3938  log_info("MKINIT_DYCOMS2_RF02_DNS",*) 'Not found namelist. Default used.'
3939  elseif( ierr > 0 ) then !--- fatal error
3940  log_error("MKINIT_DYCOMS2_RF02_DNS",*) 'Not appropriate names in namelist PARAM_MKINIT_RF02_DNS. Check!'
3941  call prc_abort
3942  endif
3943  log_nml(param_mkinit_rf02_dns)
3944 
3945  !$acc data create(potl,LHV)
3946 
3947  ! calc in dry condition
3948  call random_uniform(rndm) ! make random
3949  !$acc kernels
3950  do j = jsb, jeb
3951  do i = isb, ieb
3952 
3953  pres_sfc(i,j) = pres_zb
3954 ! pott_sfc(i,j) = 288.3_RP ! [K]
3955 ! qv_sfc (i,j) = 9.45E-3_RP
3956 
3957  do k = ks, ke
3958 
3959  velx(k,i,j) = const_u
3960  vely(k,i,j) = const_v
3961 
3962 ! if ( ZB+CZ(k) < 775.0_RP ) then ! below initial cloud top
3963  if ( zb+cz(k) <= 795.0_rp ) then ! below initial cloud top
3964  potl(k,i,j) = 288.3_rp ! [K]
3965  qall = 9.45e-3_rp ! [kg/kg]
3966 ! necessary?
3967 ! else if ( CZ(k) <= 815.0_RP ) then
3968 ! sint = sin( pi2 * (CZ(k) - 795.0_RP)/20.0_RP )
3969 ! potl(k,i,j) = 288.3_RP * (1.0_RP-sint)*0.5_RP + &
3970 ! ( 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
3971 ! qall = 9.45E-3_RP * (1.0_RP-sint)*0.5_RP + &
3972 ! ( 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
3973  else
3974  potl(k,i,j) = 295.0_rp + ( zb+cz(k)-795.0_rp )**(1.0_rp/3.0_rp)
3975  qall = 5.e-3_rp - 3.e-3_rp * ( 1.0_rp - exp( (795.0_rp-(zb+cz(k)))/500.0_rp ) ) ! [kg/kg]
3976  endif
3977 
3978  if( zb+cz(k) < 400.0_rp ) then
3979  qc(k,i,j) = 0.0_rp
3980  elseif( zb+cz(k) <= 795.0_rp ) then
3981  fact = ( (zb+cz(k))-400.0_rp ) / ( 795.0_rp-400.0_rp )
3982  qc(k,i,j) = 0.8e-3_rp * fact
3983  else
3984  qc(k,i,j) = 0.0_rp
3985  endif
3986  qv(k,i,j) = qall - qc(k,i,j)
3987 
3988  !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)
3989  enddo
3990  enddo
3991  enddo
3992  !$acc end kernels
3993 
3994  !LOG_INFO("MKINIT_DYCOMS2_RF02_DNS",*)'chk3',ks,ke
3995  ! extrapolation (temtative)
3996  !$acc kernels
3997  pott_sfc(:,:) = potl(ks,:,:)-0.5*(potl(ks+1,:,:)-potl(ks,:,:))
3998  qv_sfc(:,:) = qv(ks,:,:)-0.5*(qv(ks+1,:,:)-qv(ks,:,:))
3999  qc_sfc(:,:) = qc(ks,:,:)-0.5*(qc(ks+1,:,:)-qc(ks,:,:))
4000  !$acc end kernels
4001 
4002  ! make density & pressure profile in moist condition
4003  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4004  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4005  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4006  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4007  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4008 
4009  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4010  temp(:,:,:), lhv(:,:,:) )
4011 
4012  !$acc kernels
4013  do j = jsb, jeb
4014  do i = isb, ieb
4015  do k = ks, ke
4016  temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
4017  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
4018  rtot = rdry * qdry + rvap * qv(k,i,j)
4019  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
4020  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
4021  enddo
4022  enddo
4023  enddo
4024  !$acc end kernels
4025 
4026  ! make density & pressure profile in moist condition
4027  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4028  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4029  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4030  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4031  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4032 
4033  !$acc kernels
4034  !$acc loop collapse(2) independent
4035  do j = jsb, jeb
4036  do i = isb, ieb
4037  dens( 1:ks-1,i,j) = dens(ks,i,j)
4038  dens(ke+1:ka, i,j) = dens(ke,i,j)
4039  enddo
4040  enddo
4041  !$acc end kernels
4042 
4043  call comm_vars8( dens(:,:,:), 1 )
4044  call comm_wait ( dens(:,:,:), 1 )
4045 
4046  call random_uniform(rndm) ! make random
4047  !$acc kernels
4048  !$acc loop collapse(3) independent
4049  do j = jsb, jeb
4050  do i = isb, ieb
4051  do k = ks, ke
4052  if( random_flag == 2 .and. k <= random_limit ) then
4053  momz(k,i,j) = ( 0.0_rp + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4054  * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
4055  else
4056  momz(k,i,j) = 0.0_rp
4057  endif
4058  enddo
4059  enddo
4060  enddo
4061  !$acc end kernels
4062 
4063  !LOG_INFO("MKINIT_DYCOMS2_RF02_DNS",*)'chk8'
4064  call random_uniform(rndm) ! make random
4065  !$acc kernels
4066  !$acc loop collapse(3) independent
4067  do j = jsb, jeb
4068  do i = isb, ieb
4069  do k = ks, ke
4070  if( random_flag == 2 .and. k <= random_limit ) then
4071  momx(k,i,j) = ( velx(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4072  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4073  else
4074  momx(k,i,j) = ( velx(k,i,j) ) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4075  endif
4076  enddo
4077  enddo
4078  enddo
4079  !$acc end kernels
4080  !LOG_INFO("MKINIT_DYCOMS2_RF02_DNS",*)'chk9'
4081 
4082  call random_uniform(rndm) ! make random
4083  !$acc kernels
4084  !$acc loop collapse(3) independent
4085  do j = jsb, jeb
4086  do i = isb, ieb
4087  do k = ks, ke
4088  if( random_flag == 2 .and. k <= random_limit ) then
4089  momy(k,i,j) = ( vely(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4090  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4091  else
4092  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4093  endif
4094  enddo
4095  enddo
4096  enddo
4097  !$acc end kernels
4098 
4099  call random_uniform(rndm) ! make random
4100  !$acc kernels
4101  !$acc loop collapse(3) independent
4102  do j = jsb, jeb
4103  do i = isb, ieb
4104  do k = ks, ke
4105  if( random_flag == 1 .and. k <= random_limit ) then
4106  rhot(k,i,j) = ( pott(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4107  * dens(k,i,j)
4108  else
4109  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
4110  endif
4111  enddo
4112  enddo
4113  enddo
4114  !$acc end kernels
4115 
4116  !$acc kernels
4117  do j = jsb, jeb
4118  do i = isb, ieb
4119  do k = ks, ke
4120  if ( qc(k,i,j) > 0.0_rp ) then
4121  nc(k,i,j) = 55.0e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
4122  endif
4123  enddo
4124  enddo
4125  enddo
4126  !$acc end kernels
4127 
4128  !$acc end data
4129 
4130 #endif
4131  return
4132  end subroutine mkinit_dycoms2_rf02_dns
4133 
4134  !-----------------------------------------------------------------------------
4136  subroutine mkinit_rico
4137  use scale_const, only: &
4138  rdry => const_rdry, &
4139  rvap => const_rvap, &
4140  cpdry => const_cpdry, &
4141  cpvap => const_cpvap, &
4142  cl => const_cl
4143  use scale_atmos_hydrometeor, only: &
4144  atmos_hydrometeor_dry
4145  implicit none
4146 
4147 #ifndef DRY
4148  real(RP):: PERTURB_AMP_PT = 0.1_rp
4149  real(RP):: PERTURB_AMP_QV = 2.5e-5_rp
4150 
4151  namelist / param_mkinit_rico / &
4152  perturb_amp_pt, &
4153  perturb_amp_qv
4154 
4155  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
4156  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
4157  real(RP) :: qall ! QV+QC
4158  real(RP) :: fact
4159 
4160  real(RP) :: qdry, Rtot, CPtot
4161 
4162  integer :: ierr
4163  integer :: k, i, j
4164  !---------------------------------------------------------------------------
4165 
4166  log_newline
4167  log_info("MKINIT_RICO",*) 'Setup initial state'
4168 
4169  if ( atmos_hydrometeor_dry ) then
4170  log_error("MKINIT_RICO",*) 'QV is not registered'
4171  call prc_abort
4172  end if
4173 
4174  rewind(io_fid_conf)
4175  read(io_fid_conf,nml=param_mkinit_rico,iostat=ierr)
4176  if( ierr < 0 ) then !--- missing
4177  log_info("MKINIT_RICO",*) 'Not found namelist. Default used.'
4178  elseif( ierr > 0 ) then !--- fatal error
4179  log_error("MKINIT_RICO",*) 'Not appropriate names in namelist PARAM_MKINIT_RICO. Check!'
4180  call prc_abort
4181  endif
4182  log_nml(param_mkinit_rico)
4183 
4184  !$acc data create(potl,LHV)
4185 
4186  ! calc in moist condition
4187  !$acc kernels
4188  do j = jsb, jeb
4189  do i = isb, ieb
4190 
4191  pres_sfc(i,j) = 1015.4e2_rp ! [Pa]
4192  pott_sfc(i,j) = 297.9_rp
4193 
4194  do k = ks, ke
4195  !--- potential temperature
4196  if ( cz(k) < 740.0_rp ) then ! below initial cloud top
4197  potl(k,i,j) = 297.9_rp
4198  else
4199  fact = ( cz(k)-740.0_rp ) * ( 317.0_rp-297.9_rp ) / ( 4000.0_rp-740.0_rp )
4200  potl(k,i,j) = 297.9_rp + fact
4201  endif
4202 
4203  !--- horizontal wind velocity
4204  if ( cz(k) <= 4000.0_rp ) then ! below initial cloud top
4205  fact = ( cz(k)-0.0_rp ) * ( -1.9_rp+9.9_rp ) / ( 4000.0_rp-0.0_rp )
4206  velx(k,i,j) = -9.9_rp + fact
4207  vely(k,i,j) = -3.8_rp
4208  else
4209  velx(k,i,j) = -1.9_rp
4210  vely(k,i,j) = -3.8_rp
4211  endif
4212  enddo
4213 
4214  enddo
4215  enddo
4216  !$acc end kernels
4217 
4218  ! make density & pressure profile in moist condition
4219  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4220  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4221  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4222  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4223  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4224 
4225 
4226  !$acc kernels
4227  do j = jsb, jeb
4228  do i = isb, ieb
4229  qv_sfc(i,j) = 16.0e-3_rp ! [kg/kg]
4230 
4231  do k = ks, ke
4232  !--- mixing ratio of vapor
4233  if ( cz(k) <= 740.0_rp ) then ! below initial cloud top
4234  fact = ( cz(k)-0.0_rp ) * ( 13.8e-3_rp-16.0e-3_rp ) / ( 740.0_rp-0.0_rp )
4235  qall = 16.0e-3_rp + fact
4236  elseif ( cz(k) <= 3260.0_rp ) then ! boundary
4237  fact = ( cz(k)-740.0_rp ) * ( 2.4e-3_rp-13.8e-3_rp ) / ( 3260.0_rp-740.0_rp )
4238  qall = 13.8e-3_rp + fact
4239  elseif( cz(k) <= 4000.0_rp ) then
4240  fact = ( cz(k)-3260.0_rp ) * ( 1.8e-3_rp-2.4e-3_rp ) / ( 4000.0_rp-3260.0_rp )
4241  qall = 2.4e-3_rp + fact
4242  else
4243  qall = 0.0_rp
4244  endif
4245 
4246  qv(k,i,j) = qall - qc(k,i,j)
4247  enddo
4248 
4249  enddo
4250  enddo
4251  !$acc end kernels
4252 
4253  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4254  temp(:,:,:), lhv(:,:,:) )
4255 
4256  !$acc kernels
4257  do j = jsb, jeb
4258  do i = isb, ieb
4259  do k = ks, ke
4260  temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
4261  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
4262  rtot = rdry * qdry + rvap * qv(k,i,j)
4263  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
4264  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
4265  enddo
4266  enddo
4267  enddo
4268  !$acc end kernels
4269 
4270  ! make density & pressure profile in moist condition
4271  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4272  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4273  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4274  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4275  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4276 
4277 
4278  !$acc kernels
4279  !$acc loop collapse(2) independent
4280  do j = jsb, jeb
4281  do i = isb, ieb
4282  dens( 1:ks-1,i,j) = dens(ks,i,j)
4283  dens(ke+1:ka ,i,j) = dens(ke,i,j)
4284  enddo
4285  enddo
4286  !$acc end kernels
4287 
4288  call comm_vars8( dens(:,:,:), 1 )
4289  call comm_wait ( dens(:,:,:), 1 )
4290 
4291  !$acc kernels
4292  do j = jsb, jeb
4293  do i = isb, ieb
4294  do k = ks, ke
4295  momz(k,i,j) = 0.0_rp
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  momx(k,i,j) = velx(k,i,j) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4307  enddo
4308  enddo
4309  enddo
4310  !$acc end kernels
4311 
4312  !$acc kernels
4313  !$acc loop collapse(3) independent
4314  do j = jsb, jeb
4315  do i = isb, ieb
4316  do k = ks, ke
4317  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4318  enddo
4319  enddo
4320  enddo
4321  !$acc end kernels
4322 
4323  call random_uniform(rndm) ! make random
4324  !$acc kernels
4325  !$acc loop collapse(3) independent
4326  do j = jsb, jeb
4327  do i = isb, ieb
4328  do k = ks, ke
4329  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)
4330  enddo
4331  enddo
4332  enddo
4333  !$acc end kernels
4334 
4335  call random_uniform(rndm) ! make random
4336  !$acc kernels
4337  do j = jsb, jeb
4338  do i = isb, ieb
4339  do k = ks, ke
4340  qv(k,i,j) = qv(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp_qv
4341  enddo
4342  enddo
4343  enddo
4344  !$acc end kernels
4345 
4346  !$acc kernels
4347  do j = jsb, jeb
4348  do i = isb, ieb
4349  do k = ks, ke
4350  if ( qc(k,i,j) > 0.0_rp ) then
4351  nc(k,i,j) = 70.e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
4352  endif
4353  enddo
4354  enddo
4355  enddo
4356  !$acc end kernels
4357 
4358  !$acc end data
4359 
4360 #endif
4361  return
4362  end subroutine mkinit_rico
4363 
4364  !-----------------------------------------------------------------------------
4366  subroutine mkinit_bomex
4367  use scale_const, only: &
4368  rdry => const_rdry, &
4369  rvap => const_rvap, &
4370  cpdry => const_cpdry, &
4371  cpvap => const_cpvap, &
4372  cl => const_cl
4373  use scale_atmos_hydrometeor, only: &
4374  atmos_hydrometeor_dry
4375  implicit none
4376 
4377 #ifndef DRY
4378  real(RP):: PERTURB_AMP_PT = 0.1_rp
4379  real(RP):: PERTURB_AMP_QV = 2.5e-5_rp
4380 
4381  namelist / param_mkinit_bomex / &
4382  perturb_amp_pt, &
4383  perturb_amp_qv
4384 
4385  real(RP) :: LHV (KA,IA,JA) ! latent heat of vaporization [J/kg]
4386  real(RP) :: potl(KA,IA,JA) ! liquid potential temperature
4387  real(RP) :: qall ! QV+QC
4388  real(RP) :: fact
4389 
4390  real(RP) :: qdry, Rtot, CPtot
4391 
4392  integer :: ierr
4393  integer :: k, i, j
4394  !---------------------------------------------------------------------------
4395 
4396  log_newline
4397  log_info("MKINIT_BOMEX",*) 'Setup initial state'
4398 
4399  if ( atmos_hydrometeor_dry ) then
4400  log_error("MKINIT_BOMEX",*) 'QV is not registered'
4401  call prc_abort
4402  end if
4403 
4404  rewind(io_fid_conf)
4405  read(io_fid_conf,nml=param_mkinit_bomex,iostat=ierr)
4406  if( ierr < 0 ) then !--- missing
4407  log_info("MKINIT_BOMEX",*) 'Not found namelist. Default used.'
4408  elseif( ierr > 0 ) then !--- fatal error
4409  log_error("MKINIT_BOMEX",*) 'Not appropriate names in namelist PARAM_MKINIT_BOMEX. Check!'
4410  call prc_abort
4411  endif
4412  log_nml(param_mkinit_bomex)
4413 
4414  !$acc data create(potl,LHV)
4415 
4416  ! calc in moist condition
4417  !$acc kernels
4418  do j = jsb, jeb
4419  do i = isb, ieb
4420 
4421  pres_sfc(i,j) = 1015.e2_rp ! [Pa]
4422  pott_sfc(i,j) = 299.1_rp
4423 
4424  do k = ks, ke
4425  !--- potential temperature
4426  if ( cz(k) < 520.0_rp ) then ! below initial cloud top
4427  potl(k,i,j) = 298.7_rp
4428  elseif( cz(k) < 1480.0_rp ) then
4429  fact = ( cz(k)-520.0_rp ) * ( 302.4_rp-298.7_rp ) / ( 1480.0_rp-520.0_rp )
4430  potl(k,i,j) = 298.7_rp + fact
4431  elseif( cz(k) < 2000.0_rp ) then
4432  fact = ( cz(k)-1480.0_rp ) * ( 308.2_rp-302.4_rp ) / ( 2000.0_rp-1480.0_rp )
4433  potl(k,i,j) = 302.4_rp + fact
4434  else
4435  fact = ( cz(k)-2000.0_rp ) * 3.65e-3_rp
4436  potl(k,i,j) = 308.2_rp + fact
4437  endif
4438 
4439  !--- horizontal wind velocity
4440  if ( cz(k) <= 700.0_rp ) then ! below initial cloud top
4441  velx(k,i,j) = -8.75_rp
4442  vely(k,i,j) = 0.0_rp
4443  else
4444  fact = 1.8e-3_rp * ( cz(k)-700.0_rp )
4445  velx(k,i,j) = -8.75_rp + fact
4446  vely(k,i,j) = 0.0_rp
4447  endif
4448  enddo
4449 
4450  enddo
4451  enddo
4452  !$acc end kernels
4453 
4454  ! make density & pressure profile in moist condition
4455  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4456  potl(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4457  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4458  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4459  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4460 
4461 
4462  !$acc kernels
4463  do j = jsb, jeb
4464  do i = isb, ieb
4465  qv_sfc(i,j) = 22.45e-3_rp ! [kg/kg]
4466 
4467  do k = ks, ke
4468  !--- mixing ratio of vapor
4469  if ( cz(k) <= 520.0_rp ) then ! below initial cloud top
4470  fact = ( cz(k)-0.0_rp ) * ( 16.3e-3_rp-17.0e-3_rp ) / ( 520.0_rp-0.0_rp )
4471  qall = 17.0e-3_rp + fact
4472  elseif ( cz(k) <= 1480.0_rp ) then ! boundary
4473  fact = ( cz(k)-520.0_rp ) * ( 10.7e-3_rp-16.3e-3_rp ) / ( 1480.0_rp-520.0_rp )
4474  qall = 16.3e-3_rp + fact
4475  elseif( cz(k) <= 2000.0_rp ) then
4476  fact = ( cz(k)-1480.0_rp ) * ( 4.2e-3_rp-10.7e-3_rp ) / ( 2000.0_rp-1480.0_rp )
4477  qall = 10.7e-3_rp + fact
4478  else
4479  fact = ( cz(k)-2000.0_rp ) * ( -1.2e-6_rp )
4480  qall = 4.2e-3_rp + fact
4481  endif
4482 
4483  qv(k,i,j) = qall - qc(k,i,j)
4484  enddo
4485 
4486  enddo
4487  enddo
4488  !$acc end kernels
4489 
4490  call hydrometeor_lhv( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4491  temp(:,:,:), lhv(:,:,:) )
4492 
4493  !$acc kernels
4494  do j = jsb, jeb
4495  do i = isb, ieb
4496  do k = ks, ke
4497  qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
4498  rtot = rdry * qdry + rvap * qv(k,i,j)
4499  cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
4500  pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
4501  enddo
4502  enddo
4503  enddo
4504  !$acc end kernels
4505 
4506  ! make density & pressure profile in moist condition
4507  call hydrostatic_buildrho( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
4508  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
4509  pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), & ! [IN]
4510  real_cz(:,:,:), real_fz(:,:,:), area(:,:), & ! [IN]
4511  dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) ) ! [OUT]
4512 
4513 
4514  !$acc kernels
4515  !$acc loop collapse(2) independent
4516  do j = jsb, jeb
4517  do i = isb, ieb
4518  dens( 1:ks-1,i,j) = dens(ks,i,j)
4519  dens(ke+1:ka ,i,j) = dens(ke,i,j)
4520  enddo
4521  enddo
4522  !$acc end kernels
4523 
4524  call comm_vars8( dens(:,:,:), 1 )
4525  call comm_wait ( dens(:,:,:), 1 )
4526 
4527  !$acc kernels
4528  do j = jsb, jeb
4529  do i = isb, ieb
4530  do k = ks, ke
4531  momz(k,i,j) = 0.0_rp
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  momx(k,i,j) = velx(k,i,j) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4543  enddo
4544  enddo
4545  enddo
4546  !$acc end kernels
4547 
4548  !$acc kernels
4549  !$acc loop collapse(3) independent
4550  do j = jsb, jeb
4551  do i = isb, ieb
4552  do k = ks, ke
4553  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4554  enddo
4555  enddo
4556  enddo
4557  !$acc end kernels
4558 
4559  call random_uniform(rndm) ! make random
4560  !$acc kernels
4561  !$acc loop collapse(3) independent
4562  do j = jsb, jeb
4563  do i = isb, ieb
4564  do k = ks, ke
4565  if( cz(k) <= 1600.0_rp ) then !--- lowest 40 model layer when dz=40m
4566  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)
4567  else
4568  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
4569  endif
4570  enddo
4571  enddo
4572  enddo
4573  !$acc end kernels
4574 
4575  call random_uniform(rndm) ! make random
4576  !$acc kernels
4577  !$acc loop collapse(3) independent
4578  do j = jsb, jeb
4579  do i = isb, ieb
4580  do k = ks, ke
4581  if( cz(k) <= 1600.0_rp ) then !--- lowest 40 model layer when dz=40m
4582  qv(k,i,j) = qv(k,i,j) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp_qv
4583  endif
4584  enddo
4585  enddo
4586  enddo
4587  !$acc end kernels
4588 
4589  !$acc kernels
4590  do j = jsb, jeb
4591  do i = isb, ieb
4592  do k = ks, ke
4593  if ( qc(k,i,j) > 0.0_rp ) then
4594  nc(k,i,j) = 70.e6_rp / dens(k,i,j) ! [number/m3] / [kg/m3]
4595  endif
4596  enddo
4597  enddo
4598  enddo
4599  !$acc end kernels
4600 
4601  !$acc end data
4602 
4603 #endif
4604  return
4605  end subroutine mkinit_bomex
4606 
4607  !-----------------------------------------------------------------------------
4609  subroutine mkinit_oceancouple
4610  implicit none
4611 
4612  log_newline
4613  log_info("MKINIT_oceancouple",*) 'Setup initial state'
4614 
4615  call flux_setup
4616 
4617  call ocean_setup
4618 
4619  return
4620  end subroutine mkinit_oceancouple
4621 
4622  !-----------------------------------------------------------------------------
4624  subroutine mkinit_landcouple
4625  implicit none
4626 
4627  log_newline
4628  log_info("MKINIT_landcouple",*) 'Setup initial state'
4629 
4630  call flux_setup
4631 
4632  call land_setup
4633 
4634  return
4635  end subroutine mkinit_landcouple
4636 
4637  !-----------------------------------------------------------------------------
4639  subroutine mkinit_urbancouple
4640  implicit none
4641 
4642  log_newline
4643  log_info("MKINIT_urbancouple",*) 'Setup initial state'
4644 
4645  call flux_setup
4646 
4647  call urban_setup
4648 
4649  return
4650  end subroutine mkinit_urbancouple
4651 
4652  !-----------------------------------------------------------------------------
4654  subroutine mkinit_seabreeze
4655  use scale_landuse, only: &
4656  landuse_frac_land, &
4657  landuse_calc_fact, &
4658  landuse_fillhalo
4659  use scale_atmos_grid_cartesc, only: &
4660  domain_center_x => atmos_grid_cartesc_domain_center_x
4661  use scale_land_grid_cartesc_real, only: &
4662  land_grid_cartesc_real_set_areavol
4663  use scale_ocean_grid_cartesc_real, only: &
4664  ocean_grid_cartesc_real_set_areavol
4665  implicit none
4666 
4667  real(RP) :: LAND_SIZE
4668 
4669  namelist / param_mkinit_seabreeze / &
4670  land_size
4671 
4672  integer :: ierr
4673  integer :: i, j
4674  !---------------------------------------------------------------------------
4675 
4676  log_newline
4677  log_info("MKINIT_seabreeze",*) 'Setup initial state'
4678 
4679  land_size = 0.0_rp
4680 
4681  !--- read namelist
4682  rewind(io_fid_conf)
4683  read(io_fid_conf,nml=param_mkinit_seabreeze,iostat=ierr)
4684 
4685  if( ierr < 0 ) then !--- missing
4686  log_info("MKINIT_seabreeze",*) 'Not found namelist. Default used.'
4687  elseif( ierr > 0 ) then !--- fatal error
4688  log_error("MKINIT_seabreeze",*) 'Not appropriate names in namelist PARAM_MKINIT_SEABREEZE. Check!'
4689  call prc_abort
4690  endif
4691  log_nml(param_mkinit_seabreeze)
4692 
4693  call flux_setup
4694 
4695  call land_setup
4696 
4697  call ocean_setup
4698 
4699  ! make landuse conditions
4700  !$acc kernels
4701  do j = jsb, jeb
4702  do i = isb, ieb
4703  if ( abs( cx(i) - domain_center_x ) < land_size ) then
4704  landuse_frac_land(i,j) = 1.0_rp
4705  else
4706  landuse_frac_land(i,j) = 0.0_rp
4707  endif
4708  enddo
4709  enddo
4710  !$acc end kernels
4711 
4712  ! calculate landuse factors
4713  call landuse_fillhalo( fill_bnd=.true. )
4714  call landuse_calc_fact
4715 
4716  call land_grid_cartesc_real_set_areavol
4717  call ocean_grid_cartesc_real_set_areavol
4718 
4719  return
4720  end subroutine mkinit_seabreeze
4721 
4722  !-----------------------------------------------------------------------------
4724  subroutine mkinit_heatisland
4725  use scale_prc_cartesc, only: &
4726  prc_num_x
4727  use scale_landuse, only: &
4728  landuse_frac_land, &
4729  landuse_frac_urban, &
4730  landuse_calc_fact, &
4731  landuse_fillhalo
4732  implicit none
4733 
4734  real(RP) :: dist
4735 
4736  integer :: i, j
4737  !---------------------------------------------------------------------------
4738 
4739  log_newline
4740  log_info("MKINIT_heatisland",*) 'Setup initial state'
4741 
4742  call flux_setup
4743 
4744  call land_setup
4745 
4746  call urban_setup
4747 
4748  ! 1/9 size of domain
4749  dist = ( cxg(imax*prc_num_x) - cxg(1) ) / 9.0_rp
4750 
4751  ! make landuse conditions
4752  !$acc kernels
4753  do j = jsb, jeb
4754  do i = isb, ieb
4755  if ( cx(i) >= dist * 4.0_rp &
4756  .AND. cx(i) < dist * 5.0_rp ) then
4757  landuse_frac_land(i,j) = 1.0_rp
4758  landuse_frac_urban(i,j) = 1.0_rp
4759  else
4760  landuse_frac_land(i,j) = 1.0_rp
4761  landuse_frac_urban(i,j) = 0.0_rp
4762  endif
4763  enddo
4764  enddo
4765  !$acc end kernels
4766 
4767  ! calculate landuse factors
4768  call landuse_fillhalo( fill_bnd=.true. )
4769  call landuse_calc_fact
4770 
4771  return
4772  end subroutine mkinit_heatisland
4773 
4774  !-----------------------------------------------------------------------------
4776  subroutine mkinit_grayzone
4777  use scale_atmos_hydrometeor, only: &
4778  atmos_hydrometeor_dry
4779  implicit none
4780 
4781  real(RP) :: RHO(KA)
4782  real(RP) :: VELX(KA)
4783  real(RP) :: VELY(KA)
4784  real(RP) :: POTT(KA)
4785  real(RP) :: QV1D(KA)
4786 
4787  real(RP) :: PERTURB_AMP = 0.0_rp
4788  integer :: RANDOM_LIMIT = 0
4789  integer :: RANDOM_FLAG = 0 ! 0 -> no perturbation
4790  ! 1 -> petrurbation for pt
4791  ! 2 -> perturbation for u, v, w
4792 
4793  namelist / param_mkinit_grayzone / &
4794  perturb_amp, &
4795  random_limit, &
4796  random_flag
4797 
4798  integer :: ierr
4799  integer :: k, i, j
4800  !---------------------------------------------------------------------------
4801 
4802  log_newline
4803  log_info("MKINIT_grayzone",*) 'Setup initial state'
4804 
4805  if ( atmos_hydrometeor_dry ) then
4806  log_error("MKINIT_grayzone",*) 'QV is not registered'
4807  call prc_abort
4808  end if
4809 
4810  !--- read namelist
4811  rewind(io_fid_conf)
4812  read(io_fid_conf,nml=param_mkinit_grayzone,iostat=ierr)
4813 
4814  if( ierr < 0 ) then !--- missing
4815  log_info("MKINIT_grayzone",*) 'Not found namelist. Default used.'
4816  elseif( ierr > 0 ) then !--- fatal error
4817  log_error("MKINIT_grayzone",*) 'Not appropriate names in namelist PARAM_MKINIT_GRAYZONE. Check!'
4818  call prc_abort
4819  endif
4820  log_nml(param_mkinit_grayzone)
4821 
4822  call read_sounding( rho, velx, vely, pott, qv1d ) ! (out)
4823 
4824  !$acc kernels
4825 ! do j = JS, JE
4826 ! do i = IS, IE
4827  do j = 1, ja
4828  do i = 1, ia
4829  do k = ks, ke
4830  dens(k,i,j) = rho(k)
4831 ! MOMZ(k,i,j) = 0.0_RP
4832 ! MOMX(k,i,j) = RHO(k) * VELX(k)
4833 ! MOMY(k,i,j) = RHO(k) * VELY(k)
4834 
4835 ! RHOT(k,i,j) = RHO(k) * POTT(k)
4836  qv(k,i,j) = qv1d(k)
4837  enddo
4838  enddo
4839  enddo
4840  !$acc end kernels
4841 
4842  !$acc kernels
4843  !$acc loop collapse(2) independent
4844  do j = jsb, jeb
4845  do i = isb, ieb
4846  dens( 1:ks-1,i,j) = dens(ks,i,j)
4847  dens(ke+1:ka, i,j) = dens(ke,i,j)
4848  enddo
4849  enddo
4850  !$acc end kernels
4851 
4852  call random_uniform(rndm) ! make random
4853  !$acc kernels
4854  !$acc loop collapse(3) independent
4855  do j = jsb, jeb
4856  do i = isb, ieb
4857  do k = ks, ke
4858  if ( random_flag == 2 .and. k <= random_limit ) then ! below initial cloud top
4859  momz(k,i,j) = ( ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4860  * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
4861  else
4862  momz(k,i,j) = 0.0_rp
4863  endif
4864  enddo
4865  enddo
4866  enddo
4867  !$acc end kernels
4868 
4869  call random_uniform(rndm) ! make random
4870  !$acc kernels
4871  !$acc loop collapse(3) independent
4872  do j = jsb, jeb
4873  do i = isb, ieb
4874  do k = ks, ke
4875  if ( random_flag == 2 .AND. k <= random_limit ) then ! below initial cloud top
4876  momx(k,i,j) = ( velx(k) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4877  * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4878  else
4879  momx(k,i,j) = velx(k) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
4880  endif
4881  enddo
4882  enddo
4883  enddo
4884  !$acc end kernels
4885 
4886  call random_uniform(rndm) ! make random
4887  !$acc kernels
4888  !$acc loop collapse(3) independent
4889  do j = jsb, jeb
4890  do i = isb, ieb
4891  do k = ks, ke
4892  if ( random_flag == 2 .AND. k <= random_limit ) then ! below initial cloud top
4893  momy(k,i,j) = ( vely(k) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4894  * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4895  else
4896  momy(k,i,j) = vely(k) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
4897  endif
4898  enddo
4899  enddo
4900  enddo
4901  !$acc end kernels
4902 
4903  call random_uniform(rndm) ! make random
4904  !$acc kernels
4905  !$acc loop collapse(3) independent
4906  do j = jsb, jeb
4907  do i = isb, ieb
4908  do k = ks, ke
4909  if ( random_flag == 1 .and. k <= random_limit ) then ! below initial cloud top
4910  rhot(k,i,j) = ( pott(k) + ( rndm(k,i,j) * 2.0_rp - 1.0_rp ) * perturb_amp ) &
4911  * dens(k,i,j)
4912  else
4913  rhot(k,i,j) = pott(k) * dens(k,i,j)
4914  endif
4915  enddo
4916  enddo
4917  enddo
4918  !$acc end kernels
4919 
4920  return
4921  end subroutine mkinit_grayzone
4922 
4923  !-----------------------------------------------------------------------------
4925  subroutine mkinit_boxaero
4926  use scale_const, only: &
4927  rdry => const_rdry, &
4928  rvap => const_rvap, &
4929  cvdry => const_cvdry, &
4930  cvvap => const_cvvap, &
4931  cpdry => const_cpdry, &
4932  cpvap => const_cpvap
4933  use scale_atmos_hydrometeor, only: &
4934  atmos_hydrometeor_dry
4935  use scale_atmos_thermodyn, only: &
4936  atmos_thermodyn_rhot2temp_pres
4937  use mod_atmos_admin, only: &
4938  atmos_phy_ae_type
4939  implicit none
4940 
4941  real(RP) :: init_dens = 1.12_rp ![kg/m3]
4942  real(RP) :: init_temp = 298.18_rp ![K]
4943  real(RP) :: init_pres = 1.e+5_rp ![Pa]
4944  real(RP) :: init_ssliq = 0.01_rp ![%]
4945 
4946  namelist / param_mkinit_boxaero / &
4947  init_dens, &
4948  init_temp, &
4949  init_pres, &
4950  init_ssliq
4951 
4952  real(RP) :: rtot (KA,IA,JA)
4953  real(RP) :: cvtot(KA,IA,JA)
4954  real(RP) :: cptot(KA,IA,JA)
4955  real(RP) :: qdry
4956  real(RP) :: qsat
4957  integer :: i, j, k, ierr
4958  !---------------------------------------------------------------------------
4959 
4960  if ( atmos_phy_ae_type /= 'KAJINO13' ) then
4961  log_info("MKINIT_boxaero",*) 'For [Box model of aerosol],'
4962  log_info("MKINIT_boxaero",*) 'ATMOS_PHY_AE_TYPE should be KAJINO13. Stop! ', trim(atmos_phy_ae_type)
4963  call prc_abort
4964  endif
4965 
4966  if ( atmos_hydrometeor_dry ) then
4967  log_error("MKINIT_boxaero",*) 'QV is not registered'
4968  call prc_abort
4969  end if
4970 
4971  log_newline
4972  log_info("MKINIT_boxaero",*) 'Setup initial state'
4973 
4974  !--- read namelist
4975  rewind(io_fid_conf)
4976  read(io_fid_conf,nml=param_mkinit_boxaero,iostat=ierr)
4977  if( ierr < 0 ) then !--- missing
4978  log_info("MKINIT_boxaero",*) 'Not found namelist. Default used.'
4979  elseif( ierr > 0 ) then !--- fatal error
4980  log_error("MKINIT_boxaero",*) 'Not appropriate names in namelist PARAM_MKINIT_BOXAERO. Check!'
4981  call prc_abort
4982  endif
4983  log_nml(param_mkinit_boxaero)
4984 
4985  call saturation_pres2qsat_all( init_temp, init_pres, qsat )
4986 
4987  !$acc data create(rtot,cvtot,cptot)
4988 
4989  !$acc kernels
4990  !$acc loop collapse(3) independent
4991  do j = 1, ja
4992  do i = 1, ia
4993  do k = 1, ka
4994  dens(k,i,j) = init_dens
4995  momx(k,i,j) = 0.0_rp
4996  momy(k,i,j) = 0.0_rp
4997  momz(k,i,j) = 0.0_rp
4998  pott(k,i,j) = init_temp * ( p00/init_pres )**(rdry/cpdry)
4999  rhot(k,i,j) = init_dens * pott(k,i,j)
5000 
5001  qv(k,i,j) = ( init_ssliq + 1.0_rp ) * qsat
5002 
5003  qdry = 1.0 - qv(k,i,j)
5004  rtot(k,i,j) = rdry * qdry + rvap * qv(i,i,j)
5005  cvtot(k,i,j) = cvdry * qdry + cvvap * qv(i,i,j)
5006  cptot(k,i,j) = cpdry * qdry + cpvap * qv(i,i,j)
5007  enddo
5008  enddo
5009  enddo
5010  !$acc end kernels
5011 
5012  call atmos_thermodyn_rhot2temp_pres( ka, 1, ka, ia, 1, ia, ja, 1, ja, &
5013  dens(:,:,:), rhot(:,:,:), & ! (in)
5014  rtot(:,:,:), cvtot(:,:,:), cptot(:,:,:), & ! (in)
5015  temp(:,:,:), pres(:,:,:) ) ! (out)
5016 
5017  !$acc end data
5018 
5019  return
5020  end subroutine mkinit_boxaero
5021 
5022  !-----------------------------------------------------------------------------
5024  subroutine mkinit_warmbubbleaero
5025  use scale_atmos_hydrometeor, only: &
5026  atmos_hydrometeor_dry
5027  implicit none
5028 
5029  ! Surface state
5030  real(RP) :: SFC_THETA ! surface potential temperature [K]
5031  real(RP) :: SFC_PRES ! surface pressure [Pa]
5032  real(RP) :: SFC_RH = 80.0_rp ! surface relative humidity [%]
5033  ! Environment state
5034  real(RP) :: ENV_U = 0.0_rp ! velocity u of environment [m/s]
5035  real(RP) :: ENV_V = 0.0_rp ! velocity v of environment [m/s]
5036  real(RP) :: ENV_RH = 80.0_rp ! Relative Humidity of environment [%]
5037  real(RP) :: ENV_L1_ZTOP = 1.e3_rp ! top height of the layer1 (constant THETA) [m]
5038  real(RP) :: ENV_L2_ZTOP = 14.e3_rp ! top height of the layer2 (small THETA gradient) [m]
5039  real(RP) :: ENV_L2_TLAPS = 4.e-3_rp ! Lapse rate of THETA in the layer2 (small THETA gradient) [K/m]
5040  real(RP) :: ENV_L3_TLAPS = 3.e-2_rp ! Lapse rate of THETA in the layer3 (large THETA gradient) [K/m]
5041  ! Bubble
5042  real(RP) :: BBL_THETA = 1.0_rp ! extremum of temperature in bubble [K]
5043 
5044  namelist / param_mkinit_warmbubble / &
5045  sfc_theta, &
5046  sfc_pres, &
5047  env_u, &
5048  env_v, &
5049  env_rh, &
5050  env_l1_ztop, &
5051  env_l2_ztop, &
5052  env_l2_tlaps, &
5053  env_l3_tlaps, &
5054  bbl_theta
5055 
5056  logical :: converged
5057 
5058 #ifdef _OPENACC
5059  real(RP) :: work1(KA)
5060  real(RP) :: work2(KA)
5061  real(RP) :: work3(KA)
5062 #endif
5063 
5064  integer :: ierr
5065  integer :: k, i, j, itr
5066  !---------------------------------------------------------------------------
5067 
5068  log_newline
5069  log_info("MKINIT_warmbubbleaero",*) 'Setup initial state'
5070 
5071  if ( atmos_hydrometeor_dry ) then
5072  log_error("MKINIT_warmbubbleaero",*) 'QV is not registerd'
5073  call prc_abort
5074  end if
5075 
5076 
5077  sfc_theta = thetastd
5078  sfc_pres = pstd
5079 
5080  !--- read namelist
5081  rewind(io_fid_conf)
5082  read(io_fid_conf,nml=param_mkinit_warmbubble,iostat=ierr)
5083 
5084  if( ierr < 0 ) then !--- missing
5085  log_info("MKINIT_warmbubbleaero",*) 'Not found namelist. Default used.'
5086  elseif( ierr > 0 ) then !--- fatal error
5087  log_error("MKINIT_warmbubbleaero",*) 'Not appropriate names in namelist PARAM_MKINIT_WARMBUBBLE. Check!'
5088  call prc_abort
5089  endif
5090  log_nml(param_mkinit_warmbubble)
5091 
5092  ! calc in dry condition
5093  !$acc kernels
5094  pres_sfc(1,1) = sfc_pres
5095  pott_sfc(1,1) = sfc_theta
5096  !$acc end kernels
5097 
5098  !$acc kernels
5099  !$acc loop seq
5100  do k = ks, ke
5101  if ( cz(k) <= env_l1_ztop ) then ! Layer 1
5102  pott(k,1,1) = sfc_theta
5103  elseif( cz(k) < env_l2_ztop ) then ! Layer 2
5104  pott(k,1,1) = pott(k-1,1,1) + env_l2_tlaps * ( cz(k)-cz(k-1) )
5105  else ! Layer 3
5106  pott(k,1,1) = pott(k-1,1,1) + env_l3_tlaps * ( cz(k)-cz(k-1) )
5107  endif
5108  enddo
5109  !$acc end kernels
5110 
5111  ! make density & pressure profile in dry condition
5112  call hydrostatic_buildrho( ka, ks, ke, &
5113  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
5114  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
5115  cz(:), fz(:), & ! [IN]
5116 #ifdef _OPENACC
5117  work1(:), work2(:), work3(:), & ! [WORK]
5118 #endif
5119  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
5120  converged ) ! [OUT]
5121 
5122  ! calc QV from RH
5123  call saturation_pres2qsat_all( temp_sfc(1,1), pres_sfc(1,1), & ! [IN]
5124  qsat_sfc(1,1) ) ! [OUT]
5125  !$acc kernels
5126  qv_sfc(1,1) = sfc_rh * 1.e-2_rp * qsat_sfc(1,1)
5127  !$acc end kernels
5128 
5129  do itr = 1, niter_rh
5130  call saturation_psat_all( ka, ks, ke, &
5131  temp(:,1,1), & ! [IN]
5132  psat(:,1,1) ) ! [OUT]
5133  !$acc kernels
5134  do k = ks, ke
5135  if( cz(k) <= env_l2_ztop ) then ! Layer 1 and 2
5136  qv(k,1,1) = env_rh * 1.e-2_rp * psat(k,1,1) / ( dens(k,1,1) * rvap * temp(k,1,1) )
5137  else ! Layer 3
5138  qv(k,1,1) = 0.0_rp
5139  endif
5140  enddo
5141  !$acc end kernels
5142 
5143  ! make density & pressure profile in moist condition
5144  call hydrostatic_buildrho( ka, ks, ke, &
5145  pott(:,1,1), qv(:,1,1), qc(:,1,1), & ! [IN]
5146  pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), & ! [IN]
5147  cz(:), fz(:), & ! [IN]
5148 #ifdef _OPENACC
5149  work1(:), work2(:), work3(:), & ! [WORK]
5150 #endif
5151  dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1), & ! [OUT]
5152  converged ) ! [OUT]
5153  end do
5154 
5155  !$acc kernels
5156  !$acc loop collapse(3) independent
5157  do j = jsb, jeb
5158  do i = isb, ieb
5159  do k = ks, ke
5160  dens(k,i,j) = dens(k,1,1)
5161  momz(k,i,j) = 0.0_rp
5162  momx(k,i,j) = env_u * dens(k,i,j)
5163  momy(k,i,j) = env_v * dens(k,i,j)
5164 
5165  ! make warm bubble
5166  rhot(k,i,j) = dens(k,1,1) * ( pott(k,1,1) + bbl_theta * bubble(k,i,j) )
5167 
5168  qv(k,i,j) = qv(k,1,1)
5169  enddo
5170  enddo
5171  enddo
5172  !$acc end kernels
5173 
5174  call flux_setup
5175 
5176  return
5177  end subroutine mkinit_warmbubbleaero
5178 
5179  !-----------------------------------------------------------------------------
5181  subroutine mkinit_real
5182  use mod_realinput, only: &
5183  realinput_atmos, &
5184  realinput_surface
5185  implicit none
5186 
5187  call prof_rapstart('__Real_Atmos',2)
5188 
5189  call realinput_atmos
5190 
5191  call prof_rapend ('__Real_Atmos',2)
5192  call prof_rapstart('__Real_Surface',2)
5193 
5194  call realinput_surface
5195 
5196  call prof_rapend ('__Real_Surface',2)
5197 
5198  call flux_setup
5199 
5200  return
5201  end subroutine mkinit_real
5202 
5203 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:350
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