SCALE-RM
scale_atmos_sub_boundary.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
18 !-------------------------------------------------------------------------------
19 #include "inc_openmp.h"
20 module scale_atmos_boundary
21  !-----------------------------------------------------------------------------
22  !
23  !++ used modules
24  !
25  use scale_precision
26  use scale_stdio
27  use scale_prof
28  use scale_grid_index
29  use scale_index
30  use scale_tracer
31 
32  use gtool_file_h, only: &
33  file_real4, &
34  file_real8
35  !-----------------------------------------------------------------------------
36  implicit none
37  private
38  !-----------------------------------------------------------------------------
39  !
40  !++ Public procedure
41  !
42  public :: atmos_boundary_setup
43  public :: atmos_boundary_resume
44  public :: atmos_boundary_firstsend
45  public :: atmos_boundary_finalize
46  public :: atmos_boundary_update
47 
48  !-----------------------------------------------------------------------------
49  !
50  !++ Public parameters & variables
51  !
52  integer, public :: bnd_qa
53 
54  real(RP), public, allocatable :: atmos_boundary_dens(:,:,:)
55  real(RP), public, allocatable :: atmos_boundary_velz(:,:,:)
56  real(RP), public, allocatable :: atmos_boundary_velx(:,:,:)
57  real(RP), public, allocatable :: atmos_boundary_vely(:,:,:)
58  real(RP), public, allocatable :: atmos_boundary_pott(:,:,:)
59  real(RP), public, allocatable :: atmos_boundary_qtrc(:,:,:,:)
60 
61  real(RP), public, allocatable :: atmos_boundary_alpha_dens(:,:,:)
62  real(RP), public, allocatable :: atmos_boundary_alpha_velz(:,:,:)
63  real(RP), public, allocatable :: atmos_boundary_alpha_velx(:,:,:)
64  real(RP), public, allocatable :: atmos_boundary_alpha_vely(:,:,:)
65  real(RP), public, allocatable :: atmos_boundary_alpha_pott(:,:,:)
66  real(RP), public, allocatable :: atmos_boundary_alpha_qtrc(:,:,:,:)
67 
68 
69  real(RP), public :: atmos_boundary_smoother_fact = 0.2_rp ! fact for smoother to damping
70 
71  logical, public :: atmos_boundary_update_flag = .false.
72 
73  !-----------------------------------------------------------------------------
74  !
75  !++ Private procedure
76  !
77  private :: atmos_boundary_var_fillhalo
78  private :: atmos_boundary_alpha_fillhalo
79  private :: atmos_boundary_ref_fillhalo
80  private :: atmos_boundary_setalpha
81  private :: atmos_boundary_setinitval
82  private :: atmos_boundary_read
83  private :: atmos_boundary_write
84  private :: atmos_boundary_generate
85  private :: atmos_boundary_initialize_file
86  private :: atmos_boundary_initialize_online
87  private :: atmos_boundary_update_file
88  private :: atmos_boundary_update_online_parent
89  private :: atmos_boundary_update_online_daughter
90  private :: atmos_boundary_send
91  private :: atmos_boundary_recv
92 
93  abstract interface
94  subroutine getbnd( &
95  bnd_DENS, &
96  bnd_VELZ, &
97  bnd_VELX, &
98  bnd_VELY, &
99  bnd_POTT, &
100  bnd_QTRC, &
101  now_step, &
102  update_step )
103  use scale_precision
104  implicit none
105 
106  real(RP), intent(out) :: bnd_dens(:,:,:)
107  real(RP), intent(out) :: bnd_velz(:,:,:)
108  real(RP), intent(out) :: bnd_velx(:,:,:)
109  real(RP), intent(out) :: bnd_vely(:,:,:)
110  real(RP), intent(out) :: bnd_pott(:,:,:)
111  real(RP), intent(out) :: bnd_qtrc(:,:,:,:)
112  integer, intent(in) :: now_step
113  integer, intent(in) :: update_step
114  end subroutine getbnd
115  end interface
116 
117  procedure(getbnd), pointer :: get_boundary => null()
118  private :: get_boundary
119  private :: get_boundary_same_parent
120  private :: get_boundary_nearest_neighbor
121  private :: get_boundary_lerp_initpoint
122  private :: get_boundary_lerp_midpoint
123 
124  !
125  !-----------------------------------------------------------------------------
126  !
127  !++ Private parameters & variables
128  !
129  character(len=H_SHORT), private :: atmos_boundary_type = 'NONE'
130  character(len=H_LONG), private :: atmos_boundary_in_basename = ''
131  logical, private :: atmos_boundary_in_check_coordinates = .true.
132  character(len=H_LONG), private :: atmos_boundary_out_basename = ''
133  character(len=H_MID), private :: atmos_boundary_out_title = 'SCALE-RM BOUNDARY CONDITION'
134  character(len=H_SHORT), private :: atmos_boundary_out_dtype = 'DEFAULT'
135 
136  logical, private :: atmos_boundary_use_dens = .false. ! read from file?
137  logical, private :: atmos_boundary_use_velz = .false. ! read from file?
138  logical, private :: atmos_boundary_use_velx = .false. ! read from file?
139  logical, private :: atmos_boundary_use_vely = .false. ! read from file?
140  logical, private :: atmos_boundary_use_pott = .false. ! read from file?
141  logical, private :: atmos_boundary_use_qv = .false. ! read from file?
142  logical, private :: atmos_boundary_use_qhyd = .false. ! read from file?
143 
144  real(RP), private :: atmos_boundary_value_velz = 0.0_rp ! velocity w at boundary, 0 [m/s]
145  real(RP), private :: atmos_boundary_value_velx = 0.0_rp ! velocity u at boundary, 0 [m/s]
146  real(RP), private :: atmos_boundary_value_vely = 0.0_rp ! velocity v at boundary, 0 [m/s]
147  real(RP), private :: atmos_boundary_value_pott = 300.0_rp ! potential temp. at boundary, 300 [K]
148  real(RP), private :: atmos_boundary_value_qtrc = 0.0_rp ! tracer at boundary, 0 [kg/kg]
149 
150  real(RP), private :: atmos_boundary_alphafact_dens = 1.0_rp ! alpha factor again default
151  real(RP), private :: atmos_boundary_alphafact_velz = 1.0_rp ! alpha factor again default
152  real(RP), private :: atmos_boundary_alphafact_velx = 1.0_rp ! alpha factor again default
153  real(RP), private :: atmos_boundary_alphafact_vely = 1.0_rp ! alpha factor again default
154  real(RP), private :: atmos_boundary_alphafact_pott = 1.0_rp ! alpha factor again default
155  real(RP), private :: atmos_boundary_alphafact_qtrc = 1.0_rp ! alpha factor again default
156 
157  real(RP), private :: atmos_boundary_fracz = 1.0_rp ! fraction of boundary region for dumping (z) (0-1)
158  real(RP), private :: atmos_boundary_fracx = 1.0_rp ! fraction of boundary region for dumping (x) (0-1)
159  real(RP), private :: atmos_boundary_fracy = 1.0_rp ! fraction of boundary region for dumping (y) (0-1)
160  real(RP), private :: atmos_boundary_tauz ! maximum value for damping tau (z) [s]
161  real(RP), private :: atmos_boundary_taux ! maximum value for damping tau (x) [s]
162  real(RP), private :: atmos_boundary_tauy ! maximum value for damping tau (y) [s]
163 
164  real(DP), private :: atmos_boundary_update_dt = 0.0_dp ! inteval time of boudary data update [s]
165  integer, private :: update_nstep
166 
167  real(RP), private, allocatable :: atmos_boundary_ref_dens(:,:,:,:) ! reference DENS (with HALO)
168  real(RP), private, allocatable :: atmos_boundary_ref_velz(:,:,:,:) ! reference VELZ (with HALO)
169  real(RP), private, allocatable :: atmos_boundary_ref_velx(:,:,:,:) ! reference VELX (with HALO)
170  real(RP), private, allocatable :: atmos_boundary_ref_vely(:,:,:,:) ! reference VELY (with HALO)
171  real(RP), private, allocatable :: atmos_boundary_ref_pott(:,:,:,:) ! reference POTT (with HALO)
172  real(RP), private, allocatable :: atmos_boundary_ref_qtrc(:,:,:,:,:) ! reference QTRC (with HALO)
173 
174  character(len=H_LONG), private :: atmos_boundary_interp_type = 'lerp_initpoint' ! type of boundary interporation
175 
176  integer, private :: atmos_boundary_start_date(6) = (/ -9999, 0, 0, 0, 0, 0 /) ! boundary initial date
177 
178  integer, private :: atmos_boundary_fid = -1
179 
180  integer, private :: now_step
181  integer, private :: boundary_timestep = 0
182  logical, private :: atmos_boundary_linear_v = .false. ! linear or non-linear profile of relax region
183  logical, private :: atmos_boundary_linear_h = .true. ! linear or non-linear profile of relax region
184  real(RP), private :: atmos_boundary_exp_h = 2.0_rp ! factor of non-linear profile of relax region
185  logical, private :: atmos_boundary_online = .false. ! boundary online update by communicate inter-domain
186  logical, private :: atmos_boundary_online_master = .false. ! master domain in communicate inter-domain
187  logical, private :: do_parent_process = .false.
188  logical, private :: do_daughter_process = .false.
189  logical, private :: l_bnd = .false.
190 
191  real(DP), private :: boundary_time_initdaysec
192 
193  integer, private :: ref_size = 3
194  integer, private :: ref_old = 1
195  integer, private :: ref_now = 2
196  integer, private :: ref_new = 3
197 
198  !-----------------------------------------------------------------------------
199 contains
200  !-----------------------------------------------------------------------------
202  subroutine atmos_boundary_setup
203  use scale_process, only: &
204  prc_mpistop
205  use scale_comm, only: &
206  comm_fill_bnd
207  use scale_const, only: &
208  const_undef
209  use scale_time, only: &
210  dt => time_dtsec
211  use scale_grid_nest, only: &
212  use_nesting, &
213  offline, &
214  online_iam_parent, &
215  online_iam_daughter
216  use scale_atmos_phy_mp, only: &
217  qa_mp
218  implicit none
219 
220  namelist / param_atmos_boundary / &
221  atmos_boundary_type, &
222  atmos_boundary_in_basename, &
223  atmos_boundary_in_check_coordinates, &
224  atmos_boundary_out_basename, &
225  atmos_boundary_out_title, &
226  atmos_boundary_out_dtype, &
227  atmos_boundary_use_velz, &
228  atmos_boundary_use_velx, &
229  atmos_boundary_use_vely, &
230  atmos_boundary_use_pott, &
231  atmos_boundary_use_dens, &
232  atmos_boundary_use_qv, &
233  atmos_boundary_use_qhyd, &
234  atmos_boundary_value_velz, &
235  atmos_boundary_value_velx, &
236  atmos_boundary_value_vely, &
237  atmos_boundary_value_pott, &
238  atmos_boundary_value_qtrc, &
239  atmos_boundary_alphafact_dens, &
240  atmos_boundary_alphafact_velz, &
241  atmos_boundary_alphafact_velx, &
242  atmos_boundary_alphafact_vely, &
243  atmos_boundary_alphafact_pott, &
244  atmos_boundary_alphafact_qtrc, &
245  atmos_boundary_smoother_fact, &
246  atmos_boundary_fracz, &
247  atmos_boundary_fracx, &
248  atmos_boundary_fracy, &
249  atmos_boundary_tauz, &
250  atmos_boundary_taux, &
251  atmos_boundary_tauy, &
252  atmos_boundary_update_dt, &
253  atmos_boundary_start_date, &
254  atmos_boundary_linear_v, &
255  atmos_boundary_linear_h, &
256  atmos_boundary_exp_h, &
257  atmos_boundary_interp_type
258 
259  integer :: ierr
260  !---------------------------------------------------------------------------
261 
262  if( io_l ) write(io_fid_log,*)
263  if( io_l ) write(io_fid_log,*) '++++++ Module[BOUNDARY] / Categ[ATMOS-RM] / Origin[SCALElib]'
264 
265  atmos_boundary_tauz = dt * 10.0_rp
266  atmos_boundary_taux = dt * 10.0_rp
267  atmos_boundary_tauy = dt * 10.0_rp
268 
269  !--- read namelist
270  rewind(io_fid_conf)
271  read(io_fid_conf,nml=param_atmos_boundary,iostat=ierr)
272  if( ierr < 0 ) then !--- missing
273  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
274  elseif( ierr > 0 ) then !--- fatal error
275  write(*,*) 'xxx Not appropriate names in namelist PARAM_ATMOS_BOUNDARY. Check!'
276  call prc_mpistop
277  endif
278  if( io_nml ) write(io_fid_nml,nml=param_atmos_boundary)
279 
280  ! setting switches
281  if( .NOT. use_nesting ) then
282  atmos_boundary_online = .false.
283  else
284  if( offline ) then
285  atmos_boundary_online = .false.
286  else
287  atmos_boundary_online = .true.
288  endif
289  endif
290  do_parent_process = .false.
291  do_daughter_process = .false.
292  atmos_boundary_online_master = .false.
293  if ( atmos_boundary_online ) then
294  if ( online_iam_parent ) then
295  do_parent_process = .true.
296  if ( .NOT. online_iam_daughter ) then
297  atmos_boundary_online_master = .true.
298  endif
299  endif
300  if ( online_iam_daughter ) then
301  do_daughter_process = .true.
302  endif
303  endif
304 
305  if( atmos_boundary_use_qhyd ) then
306  bnd_qa = qa_mp
307  else if ( qa_mp > 0 ) then
308  bnd_qa = 1
309  else
310  bnd_qa = 0
311  end if
312 
313  allocate( atmos_boundary_dens(ka,ia,ja) )
314  allocate( atmos_boundary_velz(ka,ia,ja) )
315  allocate( atmos_boundary_velx(ka,ia,ja) )
316  allocate( atmos_boundary_vely(ka,ia,ja) )
317  allocate( atmos_boundary_pott(ka,ia,ja) )
318  allocate( atmos_boundary_qtrc(ka,ia,ja,bnd_qa) )
319  atmos_boundary_dens(:,:,:) = const_undef
320  atmos_boundary_velz(:,:,:) = const_undef
321  atmos_boundary_velx(:,:,:) = const_undef
322  atmos_boundary_vely(:,:,:) = const_undef
323  atmos_boundary_pott(:,:,:) = const_undef
324  atmos_boundary_qtrc(:,:,:,:) = const_undef
325 
326  allocate( atmos_boundary_alpha_dens(ka,ia,ja) )
327  allocate( atmos_boundary_alpha_velz(ka,ia,ja) )
328  allocate( atmos_boundary_alpha_velx(ka,ia,ja) )
329  allocate( atmos_boundary_alpha_vely(ka,ia,ja) )
330  allocate( atmos_boundary_alpha_pott(ka,ia,ja) )
331  allocate( atmos_boundary_alpha_qtrc(ka,ia,ja,bnd_qa) )
332  atmos_boundary_alpha_dens(:,:,:) = 0.0_rp
333  atmos_boundary_alpha_velz(:,:,:) = 0.0_rp
334  atmos_boundary_alpha_velx(:,:,:) = 0.0_rp
335  atmos_boundary_alpha_vely(:,:,:) = 0.0_rp
336  atmos_boundary_alpha_pott(:,:,:) = 0.0_rp
337  atmos_boundary_alpha_qtrc(:,:,:,:) = 0.0_rp
338 
339  if ( atmos_boundary_type == 'REAL' .OR. do_daughter_process ) then
340  l_bnd = .true.
341  else
342  l_bnd = .false.
343  end if
344 
345  if ( l_bnd ) then
346 
347  select case(atmos_boundary_interp_type)
348  case('same_parent')
349  get_boundary => get_boundary_same_parent
350  case('nearest_neighbor')
351  get_boundary => get_boundary_nearest_neighbor
352  case('lerp_initpoint')
353  get_boundary => get_boundary_lerp_initpoint
354  case('lerp_midpoint')
355  get_boundary => get_boundary_lerp_midpoint
356  case default
357  write(*,*) 'xxx Wrong parameter in ATMOS_BOUNDARY_interp_TYPE. Check!'
358  call prc_mpistop
359  end select
360 
361  comm_fill_bnd = .false.
362 
363  allocate( atmos_boundary_ref_dens(ka,ia,ja,ref_size) )
364  allocate( atmos_boundary_ref_velz(ka,ia,ja,ref_size) )
365  allocate( atmos_boundary_ref_velx(ka,ia,ja,ref_size) )
366  allocate( atmos_boundary_ref_vely(ka,ia,ja,ref_size) )
367  allocate( atmos_boundary_ref_pott(ka,ia,ja,ref_size) )
368  allocate( atmos_boundary_ref_qtrc(ka,ia,ja,bnd_qa,ref_size) )
369  atmos_boundary_ref_dens(:,:,:,:) = const_undef
370  atmos_boundary_ref_velz(:,:,:,:) = const_undef
371  atmos_boundary_ref_velx(:,:,:,:) = const_undef
372  atmos_boundary_ref_vely(:,:,:,:) = const_undef
373  atmos_boundary_ref_pott(:,:,:,:) = const_undef
374  atmos_boundary_ref_qtrc(:,:,:,:,:) = const_undef
375 
376  ! initialize boundary value (reading file or waiting parent domain)
377  if ( do_daughter_process ) then
378  call atmos_boundary_initialize_online
379  else
380  if ( atmos_boundary_in_basename /= '' ) then
381  call atmos_boundary_initialize_file
382  else
383  write(*,*) 'xxx You need specify ATMOS_BOUNDARY_IN_BASENAME'
384  call prc_mpistop
385  endif
386  endif
387 
388  call atmos_boundary_setalpha
389 
390  atmos_boundary_update_flag = .true.
391 
392  elseif ( atmos_boundary_type == 'NONE' ) then
393 
394  atmos_boundary_update_flag = .false.
395 
396  elseif ( atmos_boundary_type == 'CONST' ) then
397 
398  call atmos_boundary_generate
399 
400  call atmos_boundary_setalpha
401 
402  atmos_boundary_update_flag = .false.
403 
404  elseif ( atmos_boundary_type == 'INIT' ) then
405 
406  call atmos_boundary_setalpha
407 
408  atmos_boundary_update_flag = .false.
409 
410  elseif ( atmos_boundary_type == 'FILE' ) then
411 
412  if ( atmos_boundary_in_basename /= '' ) then
413  call atmos_boundary_read
414  else
415  write(*,*) 'xxx You need specify ATMOS_BOUNDARY_IN_BASENAME'
416  call prc_mpistop
417  endif
418 
419  atmos_boundary_update_flag = .false.
420 
421  else
422  write(*,*) 'xxx unsupported ATMOS_BOUNDARY_TYPE. Check!', trim(atmos_boundary_type)
423  call prc_mpistop
424  endif
425 
426  if ( use_nesting ) atmos_boundary_update_flag = .true.
427 
428  !----- report data -----
429  if( io_l ) write(io_fid_log,*)
430  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary parameters ***'
431  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary type : ', atmos_boundary_type
432  if( io_l ) write(io_fid_log,*)
433  if( io_l ) write(io_fid_log,*) '*** Is VELZ used in atmospheric boundary? : ', atmos_boundary_use_velz
434  if( io_l ) write(io_fid_log,*) '*** Is VELX used in atmospheric boundary? : ', atmos_boundary_use_velx
435  if( io_l ) write(io_fid_log,*) '*** Is VELY used in atmospheric boundary? : ', atmos_boundary_use_vely
436  if( io_l ) write(io_fid_log,*) '*** Is POTT used in atmospheric boundary? : ', atmos_boundary_use_pott
437  if( io_l ) write(io_fid_log,*) '*** Is DENS used in atmospheric boundary? : ', atmos_boundary_use_dens
438  if( io_l ) write(io_fid_log,*) '*** Is QV used in atmospheric boundary? : ', atmos_boundary_use_qv
439  if( io_l ) write(io_fid_log,*) '*** Is QHYD used in atmospheric boundary? : ', atmos_boundary_use_qhyd
440  if( io_l ) write(io_fid_log,*)
441  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary VELZ values : ', atmos_boundary_value_velz
442  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary VELX values : ', atmos_boundary_value_velx
443  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary VELY values : ', atmos_boundary_value_vely
444  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary POTT values : ', atmos_boundary_value_pott
445  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary QTRC values : ', atmos_boundary_value_qtrc
446  if( io_l ) write(io_fid_log,*)
447  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary smoother factor : ', atmos_boundary_smoother_fact
448  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary z-fraction : ', atmos_boundary_fracz
449  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary x-fraction : ', atmos_boundary_fracx
450  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary y-fraction : ', atmos_boundary_fracy
451  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary z-relaxation time : ', atmos_boundary_tauz
452  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary x-relaxation time : ', atmos_boundary_taux
453  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary y-relaxation time : ', atmos_boundary_tauy
454  if( io_l ) write(io_fid_log,*)
455  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary update dt : ', atmos_boundary_update_dt
456  if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary start date : ', atmos_boundary_start_date(:)
457  if( io_l ) write(io_fid_log,*)
458  if( io_l ) write(io_fid_log,*) '*** Linear profile in vertically relax region : ', atmos_boundary_linear_v
459  if( io_l ) write(io_fid_log,*) '*** Linear profile in horizontally relax region : ', atmos_boundary_linear_h
460  if( io_l ) write(io_fid_log,*) '*** Non-linear factor in horizontally relax region : ', atmos_boundary_exp_h
461  if( io_l ) write(io_fid_log,*)
462  if( io_l ) write(io_fid_log,*) '*** Online nesting for lateral boundary : ', atmos_boundary_online
463 
464  if( io_l ) write(io_fid_log,*) '*** Does lateral boundary exist in this domain? : ', l_bnd
465  if ( l_bnd ) then
466  if( io_l ) write(io_fid_log,*) '*** Lateral boundary interporation type : ', atmos_boundary_interp_type
467  endif
468 
469  return
470  end subroutine atmos_boundary_setup
471 
472  !-----------------------------------------------------------------------------
474  subroutine atmos_boundary_resume( &
475  DENS, &
476  MOMZ, &
477  MOMX, &
478  MOMY, &
479  RHOT, &
480  QTRC )
481  implicit none
482 
483  real(RP), intent(in) :: dens(ka,ia,ja)
484  real(RP), intent(in) :: momz(ka,ia,ja)
485  real(RP), intent(in) :: momx(ka,ia,ja)
486  real(RP), intent(in) :: momy(ka,ia,ja)
487  real(RP), intent(in) :: rhot(ka,ia,ja)
488  real(RP), intent(in) :: qtrc(ka,ia,ja,qa)
489 
490 
491  call atmos_boundary_firstsend( &
492  dens, momz, momx, momy, rhot, qtrc )
493 
494  if ( l_bnd ) then
495 
496  ! initialize boundary value (reading file or waiting parent domain)
497  if ( do_daughter_process ) then
498  call atmos_boundary_resume_online
499  else
500  if ( atmos_boundary_in_basename /= '' ) then
501  call atmos_boundary_resume_file
502  endif
503  endif
504 
505  elseif ( atmos_boundary_type == 'INIT' ) then
506 
507  call atmos_boundary_setinitval( dens, & ! [IN]
508  momz, & ! [IN]
509  momx, & ! [IN]
510  momy, & ! [IN]
511  rhot, & ! [IN]
512  qtrc ) ! [IN]
513  endif
514 
515  if( atmos_boundary_out_basename /= '' ) then
516  call atmos_boundary_write
517  endif
518 
519  if ( atmos_boundary_update_flag ) then
520 
521  call history_bnd( &
522  atmos_boundary_dens, &
523  atmos_boundary_velz, &
524  atmos_boundary_velx, &
525  atmos_boundary_vely, &
526  atmos_boundary_pott, &
527  atmos_boundary_qtrc )
528  end if
529 
530  return
531  end subroutine atmos_boundary_resume
532 
533  !-----------------------------------------------------------------------------
535  subroutine atmos_boundary_var_fillhalo
536  use scale_comm, only: &
537  comm_vars8, &
538  comm_wait
539  implicit none
540 
541  integer :: i, j, iq
542  !---------------------------------------------------------------------------
543 
544  do j = 1, ja
545  do i = 1, ia
546  atmos_boundary_dens( 1:ks-1,i,j) = atmos_boundary_dens(ks,i,j)
547  atmos_boundary_velz( 1:ks-1,i,j) = atmos_boundary_velz(ks,i,j)
548  atmos_boundary_velx( 1:ks-1,i,j) = atmos_boundary_velx(ks,i,j)
549  atmos_boundary_vely( 1:ks-1,i,j) = atmos_boundary_vely(ks,i,j)
550  atmos_boundary_pott( 1:ks-1,i,j) = atmos_boundary_pott(ks,i,j)
551 
552  atmos_boundary_dens(ke+1:ka, i,j) = atmos_boundary_dens(ke,i,j)
553  atmos_boundary_velz(ke+1:ka, i,j) = atmos_boundary_velz(ke,i,j)
554  atmos_boundary_velx(ke+1:ka, i,j) = atmos_boundary_velx(ke,i,j)
555  atmos_boundary_vely(ke+1:ka, i,j) = atmos_boundary_vely(ke,i,j)
556  atmos_boundary_pott(ke+1:ka, i,j) = atmos_boundary_pott(ke,i,j)
557 
558  do iq = 1, bnd_qa
559  atmos_boundary_qtrc( 1:ks-1,i,j,iq) = atmos_boundary_qtrc(ks,i,j,iq)
560  atmos_boundary_qtrc(ke+1:ka, i,j,iq) = atmos_boundary_qtrc(ke,i,j,iq)
561  end do
562  end do
563  end do
564 
565  call comm_vars8( atmos_boundary_dens(:,:,:), 1 )
566  call comm_vars8( atmos_boundary_velz(:,:,:), 2 )
567  call comm_vars8( atmos_boundary_velx(:,:,:), 3 )
568  call comm_vars8( atmos_boundary_vely(:,:,:), 4 )
569  call comm_vars8( atmos_boundary_pott(:,:,:), 5 )
570  do iq = 1, bnd_qa
571  call comm_vars8( atmos_boundary_qtrc(:,:,:,iq), 5+iq )
572  end do
573 
574  call comm_wait ( atmos_boundary_dens(:,:,:), 1, .false. )
575  call comm_wait ( atmos_boundary_velz(:,:,:), 2, .false. )
576  call comm_wait ( atmos_boundary_velx(:,:,:), 3, .false. )
577  call comm_wait ( atmos_boundary_vely(:,:,:), 4, .false. )
578  call comm_wait ( atmos_boundary_pott(:,:,:), 5, .false. )
579  do iq = 1, bnd_qa
580  call comm_wait ( atmos_boundary_qtrc(:,:,:,iq), 5+iq, .false. )
581  end do
582 
583  return
584  end subroutine atmos_boundary_var_fillhalo
585 
586  !-----------------------------------------------------------------------------
588  subroutine atmos_boundary_alpha_fillhalo
589  use scale_comm, only: &
590  comm_vars8, &
591  comm_wait
592  implicit none
593 
594  integer :: i, j, iq
595  !---------------------------------------------------------------------------
596 
597  do j = 1, ja
598  do i = 1, ia
599  atmos_boundary_alpha_dens( 1:ks-1,i,j) = atmos_boundary_alpha_dens(ks,i,j)
600  atmos_boundary_alpha_velz( 1:ks-1,i,j) = atmos_boundary_alpha_velz(ks,i,j)
601  atmos_boundary_alpha_velx( 1:ks-1,i,j) = atmos_boundary_alpha_velx(ks,i,j)
602  atmos_boundary_alpha_vely( 1:ks-1,i,j) = atmos_boundary_alpha_vely(ks,i,j)
603  atmos_boundary_alpha_pott( 1:ks-1,i,j) = atmos_boundary_alpha_pott(ks,i,j)
604 
605  atmos_boundary_alpha_dens(ke+1:ka, i,j) = atmos_boundary_alpha_dens(ke,i,j)
606  atmos_boundary_alpha_velz(ke+1:ka, i,j) = atmos_boundary_alpha_velz(ke,i,j)
607  atmos_boundary_alpha_velx(ke+1:ka, i,j) = atmos_boundary_alpha_velx(ke,i,j)
608  atmos_boundary_alpha_vely(ke+1:ka, i,j) = atmos_boundary_alpha_vely(ke,i,j)
609  atmos_boundary_alpha_pott(ke+1:ka, i,j) = atmos_boundary_alpha_pott(ke,i,j)
610 
611  do iq = 1, bnd_qa
612  atmos_boundary_alpha_qtrc( 1:ks-1,i,j,iq) = atmos_boundary_alpha_qtrc(ks,i,j,iq)
613  atmos_boundary_alpha_qtrc(ke+1:ka, i,j,iq) = atmos_boundary_alpha_qtrc(ke,i,j,iq)
614  end do
615  enddo
616  enddo
617 
618  call comm_vars8( atmos_boundary_alpha_dens(:,:,:), 1 )
619  call comm_vars8( atmos_boundary_alpha_velz(:,:,:), 2 )
620  call comm_vars8( atmos_boundary_alpha_velx(:,:,:), 3 )
621  call comm_vars8( atmos_boundary_alpha_vely(:,:,:), 4 )
622  call comm_vars8( atmos_boundary_alpha_pott(:,:,:), 5 )
623  do iq = 1, bnd_qa
624  call comm_vars8( atmos_boundary_alpha_qtrc(:,:,:,iq), 5+iq )
625  end do
626 
627  call comm_wait ( atmos_boundary_alpha_dens(:,:,:), 1, .false. )
628  call comm_wait ( atmos_boundary_alpha_velz(:,:,:), 2, .false. )
629  call comm_wait ( atmos_boundary_alpha_velx(:,:,:), 3, .false. )
630  call comm_wait ( atmos_boundary_alpha_vely(:,:,:), 4, .false. )
631  call comm_wait ( atmos_boundary_alpha_pott(:,:,:), 5, .false. )
632  do iq = 1, bnd_qa
633  call comm_wait ( atmos_boundary_alpha_qtrc(:,:,:,iq), 5+iq, .false. )
634  end do
635 
636  return
637  end subroutine atmos_boundary_alpha_fillhalo
638 
639  !-----------------------------------------------------------------------------
641  subroutine atmos_boundary_ref_fillhalo( &
642  ref_idx )
643  use scale_comm, only: &
644  comm_vars8, &
645  comm_wait
646  implicit none
647 
648  ! arguments
649  integer, intent(in) :: ref_idx
650 
651  ! works
652  integer :: i, j, iq
653  !---------------------------------------------------------------------------
654 
655  !$omp parallel do default(none) private(i,j,iq) OMP_SCHEDULE_ collapse(2) &
656  !$omp shared(JSB,JEB,ISB,IEB,ATMOS_BOUNDARY_ref_DENS,ref_idx,ATMOS_BOUNDARY_ref_VELZ) &
657  !$omp shared(ATMOS_BOUNDARY_ref_VELX,ATMOS_BOUNDARY_ref_VELY,ATMOS_BOUNDARY_ref_POTT) &
658  !$omp shared(KA,KS,BND_QA,ATMOS_BOUNDARY_ref_QTRC,KE)
659  do j = jsb, jeb
660  do i = isb, ieb
661  atmos_boundary_ref_dens( 1:ks-1,i,j,ref_idx) = atmos_boundary_ref_dens(ks,i,j,ref_idx)
662  atmos_boundary_ref_velz( 1:ks-1,i,j,ref_idx) = atmos_boundary_ref_velz(ks,i,j,ref_idx)
663  atmos_boundary_ref_velx( 1:ks-1,i,j,ref_idx) = atmos_boundary_ref_velx(ks,i,j,ref_idx)
664  atmos_boundary_ref_vely( 1:ks-1,i,j,ref_idx) = atmos_boundary_ref_vely(ks,i,j,ref_idx)
665  atmos_boundary_ref_pott( 1:ks-1,i,j,ref_idx) = atmos_boundary_ref_pott(ks,i,j,ref_idx)
666 
667  atmos_boundary_ref_dens(ke+1:ka, i,j,ref_idx) = atmos_boundary_ref_dens(ke,i,j,ref_idx)
668  atmos_boundary_ref_velz(ke+1:ka, i,j,ref_idx) = atmos_boundary_ref_velz(ke,i,j,ref_idx)
669  atmos_boundary_ref_velx(ke+1:ka, i,j,ref_idx) = atmos_boundary_ref_velx(ke,i,j,ref_idx)
670  atmos_boundary_ref_vely(ke+1:ka, i,j,ref_idx) = atmos_boundary_ref_vely(ke,i,j,ref_idx)
671  atmos_boundary_ref_pott(ke+1:ka, i,j,ref_idx) = atmos_boundary_ref_pott(ke,i,j,ref_idx)
672 
673  do iq = 1, bnd_qa
674  atmos_boundary_ref_qtrc( 1:ks-1,i,j,iq,ref_idx) = atmos_boundary_ref_qtrc(ks,i,j,iq,ref_idx)
675  atmos_boundary_ref_qtrc(ke+1:ka, i,j,iq,ref_idx) = atmos_boundary_ref_qtrc(ke,i,j,iq,ref_idx)
676  end do
677  end do
678  end do
679 
680  call comm_vars8( atmos_boundary_ref_dens(:,:,:,ref_idx), 1 )
681  call comm_vars8( atmos_boundary_ref_velz(:,:,:,ref_idx), 2 )
682  call comm_vars8( atmos_boundary_ref_velx(:,:,:,ref_idx), 3 )
683  call comm_vars8( atmos_boundary_ref_vely(:,:,:,ref_idx), 4 )
684  call comm_vars8( atmos_boundary_ref_pott(:,:,:,ref_idx), 5 )
685 
686  do iq = 1, bnd_qa
687  call comm_vars8( atmos_boundary_ref_qtrc(:,:,:,iq,ref_idx), 5+iq )
688  end do
689 
690  call comm_wait ( atmos_boundary_ref_dens(:,:,:,ref_idx), 1, .false. )
691  call comm_wait ( atmos_boundary_ref_velz(:,:,:,ref_idx), 2, .false. )
692  call comm_wait ( atmos_boundary_ref_velx(:,:,:,ref_idx), 3, .false. )
693  call comm_wait ( atmos_boundary_ref_vely(:,:,:,ref_idx), 4, .false. )
694  call comm_wait ( atmos_boundary_ref_pott(:,:,:,ref_idx), 5, .false. )
695 
696  do iq = 1, bnd_qa
697  call comm_wait ( atmos_boundary_ref_qtrc(:,:,:,iq,ref_idx), 5+iq, .false. )
698  end do
699 
700  return
701  end subroutine atmos_boundary_ref_fillhalo
702 
703  !-----------------------------------------------------------------------------
705  subroutine atmos_boundary_setalpha
706  use scale_const, only: &
707  eps => const_eps, &
708  pi => const_pi
709  use scale_grid, only: &
710  cbfz => grid_cbfz, &
711  cbfx => grid_cbfx, &
712  cbfy => grid_cbfy, &
713  fbfz => grid_fbfz, &
714  fbfx => grid_fbfx, &
715  fbfy => grid_fbfy
716  use scale_grid_nest, only: &
717  online_use_velz
718 
719  real(RP) :: coef_z, alpha_z1, alpha_z2
720  real(RP) :: coef_x, alpha_x1, alpha_x2
721  real(RP) :: coef_y, alpha_y1, alpha_y2
722  real(RP) :: ee1, ee2
723 
724  integer :: i, j, k, iq
725  !---------------------------------------------------------------------------
726 
727  ! check invalid fraction
728  atmos_boundary_fracz = max( min( atmos_boundary_fracz, 1.0_rp ), eps )
729  atmos_boundary_fracx = max( min( atmos_boundary_fracx, 1.0_rp ), eps )
730  atmos_boundary_fracy = max( min( atmos_boundary_fracy, 1.0_rp ), eps )
731 
732  if ( atmos_boundary_tauz <= 0.0_rp ) then ! invalid tau
733  coef_z = 0.0_rp
734  else
735  coef_z = 1.0_rp / atmos_boundary_tauz
736  endif
737 
738  if ( atmos_boundary_taux <= 0.0_rp ) then ! invalid tau
739  coef_x = 0.0_rp
740  else
741  coef_x = 1.0_rp / atmos_boundary_taux
742  endif
743 
744  if ( atmos_boundary_tauy <= 0.0_rp ) then ! invalid tau
745  coef_y = 0.0_rp
746  else
747  coef_y = 1.0_rp / atmos_boundary_tauy
748  endif
749 
750  !$omp parallel do default(none) &
751  !$omp shared(JA,IA,KA,CBFZ,ATMOS_BOUNDARY_FRACZ,FBFZ,ATMOS_BOUNDARY_LINEAR_V,coef_z,CBFX) &
752  !$omp shared(ATMOS_BOUNDARY_FRACX,PI,FBFX,ATMOS_BOUNDARY_LINEAR_H,coef_x) &
753  !$omp shared(ATMOS_BOUNDARY_EXP_H,CBFY,ATMOS_BOUNDARY_FRACY,FBFY,coef_y,l_bnd) &
754  !$omp shared(do_daughter_process,ONLINE_USE_VELZ,ATMOS_BOUNDARY_USE_VELZ,ATMOS_BOUNDARY_alpha_VELZ) &
755  !$omp shared(ATMOS_BOUNDARY_ALPHAFACT_VELZ,ATMOS_BOUNDARY_USE_DENS,ATMOS_BOUNDARY_alpha_DENS) &
756  !$omp shared(ATMOS_BOUNDARY_ALPHAFACT_DENS,ATMOS_BOUNDARY_USE_VELX,ATMOS_BOUNDARY_alpha_VELX) &
757  !$omp shared(ATMOS_BOUNDARY_USE_VELY,ATMOS_BOUNDARY_alpha_VELY,ATMOS_BOUNDARY_ALPHAFACT_VELY) &
758  !$omp shared(ATMOS_BOUNDARY_USE_POTT,ATMOS_BOUNDARY_alpha_POTT,ATMOS_BOUNDARY_ALPHAFACT_POTT) &
759  !$omp shared(ATMOS_BOUNDARY_USE_QV,ATMOS_BOUNDARY_alpha_QTRC,ATMOS_BOUNDARY_ALPHAFACT_QTRC) &
760  !$omp shared(ATMOS_BOUNDARY_USE_QHYD,BND_QA,ATMOS_BOUNDARY_ALPHAFACT_VELX) &
761  !$omp private(i,j,k,ee1,ee2,alpha_z1,alpha_z2,alpha_x1,alpha_x2,alpha_y1,alpha_y2,iq) OMP_SCHEDULE_ collapse(2)
762  do j = 1, ja
763  do i = 1, ia
764  do k = 1, ka
765  ee1 = cbfz(k)
766  if ( ee1 <= 1.0_rp - atmos_boundary_fracz ) then
767  ee1 = 0.0_rp
768  else
769  ee1 = ( ee1 - 1.0_rp + atmos_boundary_fracz ) / atmos_boundary_fracz
770  endif
771 
772  ee2 = fbfz(k)
773  if ( ee2 <= 1.0_rp - atmos_boundary_fracz ) then
774  ee2 = 0.0_rp
775  else
776  ee2 = ( ee2 - 1.0_rp + atmos_boundary_fracz ) / atmos_boundary_fracz
777  endif
778 
779  alpha_z1 = 0.0_rp
780  alpha_z2 = 0.0_rp
781  if ( atmos_boundary_linear_v ) then
782  alpha_z1 = coef_z * ee1
783  alpha_z2 = coef_z * ee2
784  else
785  if ( ee1 > 0.0_rp .AND. ee1 <= 0.5_rp ) then
786  alpha_z1 = coef_z * 0.5_rp * ( 1.0_rp - cos( ee1*pi ) )
787  elseif( ee1 > 0.5_rp .AND. ee1 <= 1.0_rp ) then
788  alpha_z1 = coef_z * 0.5_rp * ( 1.0_rp + sin( (ee1-0.5_rp)*pi ) )
789  endif
790  if ( ee2 > 0.0_rp .AND. ee2 <= 0.5_rp ) then
791  alpha_z2 = coef_z * 0.5_rp * ( 1.0_rp - cos( ee2*pi ) )
792  elseif( ee2 > 0.5_rp .AND. ee2 <= 1.0_rp ) then
793  alpha_z2 = coef_z * 0.5_rp * ( 1.0_rp + sin( (ee2-0.5_rp)*pi ) )
794  endif
795  endif
796 
797  ee1 = cbfx(i)
798  if ( ee1 <= 1.0_rp - atmos_boundary_fracx ) then
799  ee1 = 0.0_rp
800  else
801  ee1 = ( ee1 - 1.0_rp + atmos_boundary_fracx ) / atmos_boundary_fracx
802  endif
803 
804  ee2 = fbfx(i)
805  if ( ee2 <= 1.0_rp - atmos_boundary_fracx ) then
806  ee2 = 0.0_rp
807  else
808  ee2 = ( ee2 - 1.0_rp + atmos_boundary_fracx ) / atmos_boundary_fracx
809  endif
810 
811  if ( atmos_boundary_linear_h ) then
812  alpha_x1 = coef_x * ee1
813  alpha_x2 = coef_x * ee2
814  else
815  alpha_x1 = coef_x * ee1 * exp( -(1.0_rp-ee1) * atmos_boundary_exp_h )
816  alpha_x2 = coef_x * ee2 * exp( -(1.0_rp-ee2) * atmos_boundary_exp_h )
817  end if
818 
819  ee1 = cbfy(j)
820  if ( ee1 <= 1.0_rp - atmos_boundary_fracy ) then
821  ee1 = 0.0_rp
822  else
823  ee1 = ( ee1 - 1.0_rp + atmos_boundary_fracy ) / atmos_boundary_fracy
824  endif
825 
826  ee2 = fbfy(j)
827  if ( ee2 <= 1.0_rp - atmos_boundary_fracy ) then
828  ee2 = 0.0_rp
829  else
830  ee2 = ( ee2 - 1.0_rp + atmos_boundary_fracy ) / atmos_boundary_fracy
831  endif
832 
833  if ( atmos_boundary_linear_h ) then
834  alpha_y1 = coef_y * ee1
835  alpha_y2 = coef_y * ee2
836  else
837  alpha_y1 = coef_y * ee1 * exp( -(1.0_rp-ee1) * atmos_boundary_exp_h )
838  alpha_y2 = coef_y * ee2 * exp( -(1.0_rp-ee2) * atmos_boundary_exp_h )
839  end if
840 
841 
842  if ( l_bnd ) then
843  if ( do_daughter_process ) then ! online
844  if ( online_use_velz ) then
845  if( atmos_boundary_use_velz ) then
846  atmos_boundary_alpha_velz(k,i,j) = max( alpha_z2, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_velz
847  else
848  atmos_boundary_alpha_velz(k,i,j) = max( alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_velz
849  endif
850  else
851  if ( atmos_boundary_use_velz ) then
852  atmos_boundary_alpha_velz(k,i,j) = alpha_z2 * atmos_boundary_alphafact_velz
853  end if
854  end if
855  else ! offline
856  if ( atmos_boundary_use_velz ) then
857  atmos_boundary_alpha_velz(k,i,j) = max( alpha_z2, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_velz
858  endif
859  end if
860  if ( atmos_boundary_use_dens ) then
861  atmos_boundary_alpha_dens(k,i,j) = max( alpha_z1, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_dens
862  else
863  atmos_boundary_alpha_dens(k,i,j) = 0.0_rp
864 ! ATMOS_BOUNDARY_alpha_DENS(k,i,j) = max( alpha_x1, alpha_y1 ) * ATMOS_BOUNDARY_ALPHAFACT_DENS
865  endif
866  if ( atmos_boundary_use_velx ) then
867  atmos_boundary_alpha_velx(k,i,j) = max( alpha_z1, alpha_x2, alpha_y1 ) * atmos_boundary_alphafact_velx
868  else
869  atmos_boundary_alpha_velx(k,i,j) = max( alpha_x2, alpha_y1 ) * atmos_boundary_alphafact_velx
870  endif
871  if ( atmos_boundary_use_vely ) then
872  atmos_boundary_alpha_vely(k,i,j) = max( alpha_z1, alpha_x1, alpha_y2 ) * atmos_boundary_alphafact_vely
873  else
874  atmos_boundary_alpha_vely(k,i,j) = max( alpha_x1, alpha_y2 ) * atmos_boundary_alphafact_vely
875  endif
876  if ( atmos_boundary_use_pott ) then
877  atmos_boundary_alpha_pott(k,i,j) = max( alpha_z1, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_pott
878  else
879  atmos_boundary_alpha_pott(k,i,j) = max( alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_pott
880  endif
881  if ( atmos_boundary_use_qv ) then
882  atmos_boundary_alpha_qtrc(k,i,j,1) = max( alpha_z1, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_qtrc
883  else
884  atmos_boundary_alpha_qtrc(k,i,j,1) = max( alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_qtrc
885  endif
886  if ( atmos_boundary_use_qhyd ) then
887  do iq = 2, bnd_qa
888  atmos_boundary_alpha_qtrc(k,i,j,iq) = max( alpha_z1, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_qtrc
889  end do
890  else
891  do iq = 2, bnd_qa
892  atmos_boundary_alpha_qtrc(k,i,j,iq) = max( alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_qtrc
893  end do
894  endif
895  else
896  atmos_boundary_alpha_dens(k,i,j) = max( alpha_z1, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_dens
897  atmos_boundary_alpha_velz(k,i,j) = max( alpha_z2, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_velz
898  atmos_boundary_alpha_velx(k,i,j) = max( alpha_z1, alpha_x2, alpha_y1 ) * atmos_boundary_alphafact_velx
899  atmos_boundary_alpha_vely(k,i,j) = max( alpha_z1, alpha_x1, alpha_y2 ) * atmos_boundary_alphafact_vely
900  atmos_boundary_alpha_pott(k,i,j) = max( alpha_z1, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_pott
901  do iq = 1, bnd_qa
902  atmos_boundary_alpha_qtrc(k,i,j,iq) = max( alpha_z1, alpha_x1, alpha_y1 ) * atmos_boundary_alphafact_qtrc
903  end do
904  end if
905  enddo
906  enddo
907  enddo
908 
909  if ( l_bnd ) then
910  if ( .NOT. online_use_velz .AND. .NOT. atmos_boundary_use_velz ) then
911  atmos_boundary_alpha_velz(:,:,:) = 0.0_rp
912  end if
913  else
914  if ( .NOT. atmos_boundary_use_dens ) then
915  atmos_boundary_alpha_dens(:,:,:) = 0.0_rp
916  end if
917  if ( .NOT. atmos_boundary_use_velz ) then
918  atmos_boundary_alpha_velz(:,:,:) = 0.0_rp
919  end if
920  if ( .NOT. atmos_boundary_use_velx ) then
921  atmos_boundary_alpha_velx(:,:,:) = 0.0_rp
922  end if
923  if ( .NOT. atmos_boundary_use_vely ) then
924  atmos_boundary_alpha_vely(:,:,:) = 0.0_rp
925  end if
926  if ( .NOT. atmos_boundary_use_pott ) then
927  atmos_boundary_alpha_pott(:,:,:) = 0.0_rp
928  end if
929  if ( .NOT. atmos_boundary_use_qv ) then
930  if ( bnd_qa > 0 ) atmos_boundary_alpha_qtrc(:,:,:,1) = 0.0_rp
931  end if
932  if ( .NOT. atmos_boundary_use_qhyd ) then
933  do iq = 2, bnd_qa
934  atmos_boundary_alpha_qtrc(:,:,:,iq) = 0.0_rp
935  end do
936  end if
937  end if
938 
939 
940  call atmos_boundary_alpha_fillhalo
941 
942  return
943  end subroutine atmos_boundary_setalpha
944 
945  !-----------------------------------------------------------------------------
947  subroutine atmos_boundary_setinitval( &
948  DENS, MOMZ, MOMX, MOMY, RHOT, QTRC )
949  use scale_atmos_phy_mp, only: &
950  qs_mp
951  implicit none
952 
953  real(RP), intent(in) :: dens(ka,ia,ja)
954  real(RP), intent(in) :: momz(ka,ia,ja)
955  real(RP), intent(in) :: momx(ka,ia,ja)
956  real(RP), intent(in) :: momy(ka,ia,ja)
957  real(RP), intent(in) :: rhot(ka,ia,ja)
958  real(RP), intent(in) :: qtrc(ka,ia,ja,qa)
959 
960  integer :: i, j, k, iq, iqa
961  !---------------------------------------------------------------------------
962 
963  do j = 1, ja
964  do i = 1, ia
965  do k = ks, ke
966  atmos_boundary_dens(k,i,j) = dens(k,i,j)
967  atmos_boundary_velz(k,i,j) = momz(k,i,j) / ( dens(k,i,j)+dens(k+1,i, j ) ) * 2.0_rp
968  atmos_boundary_pott(k,i,j) = rhot(k,i,j) / dens(k,i,j)
969  do iq = 1, bnd_qa
970  iqa = iq + qs_mp - 1
971  atmos_boundary_qtrc(k,i,j,iq) = qtrc(k,i,j,iqa)
972  end do
973  enddo
974  enddo
975  enddo
976 
977  do j = 1, ja
978  do i = 1, ia-1
979  do k = ks, ke
980  atmos_boundary_velx(k,i,j) = momx(k,i,j) / ( dens(k,i,j)+dens(k, i+1,j ) ) * 2.0_rp
981  enddo
982  enddo
983  enddo
984  do j = 1, ja
985  do k = ks, ke
986  atmos_boundary_velx(k,ia,j) = momx(k,ia,j) / dens(k,ia,j)
987  enddo
988  enddo
989 
990  do j = 1, ja-1
991  do i = 1, ia
992  do k = ks, ke
993  atmos_boundary_vely(k,i,j) = momy(k,i,j) / ( dens(k,i,j)+dens(k, i, j+1) ) * 2.0_rp
994  enddo
995  enddo
996  enddo
997  do i = 1, ia
998  do k = ks, ke
999  atmos_boundary_vely(k,i,ja) = momy(k,i,ja) / dens(k,i,ja)
1000  enddo
1001  enddo
1002 
1003  call atmos_boundary_var_fillhalo
1004 
1005  return
1006  end subroutine atmos_boundary_setinitval
1007 
1008  !-----------------------------------------------------------------------------
1010  subroutine atmos_boundary_read
1011  use scale_process, only: &
1012  prc_mpistop
1013  use scale_fileio, only: &
1014  fileio_open, &
1015  fileio_check_coordinates, &
1016  fileio_read, &
1017  fileio_close
1018  use scale_atmos_phy_mp, only: &
1019  aq_name => atmos_phy_mp_name
1020  implicit none
1021 
1022  integer :: fid
1023  integer :: iq
1024  !---------------------------------------------------------------------------
1025 
1026  call fileio_open( fid, atmos_boundary_in_basename )
1027 
1028  if ( atmos_boundary_in_check_coordinates ) then
1029  call fileio_check_coordinates( fid, atmos=.true. )
1030  end if
1031 
1032  if ( atmos_boundary_use_dens &
1033  .OR. atmos_boundary_use_velz &
1034  .OR. atmos_boundary_use_velx &
1035  .OR. atmos_boundary_use_vely &
1036  .OR. atmos_boundary_use_pott &
1037  ) then
1038  call fileio_read( atmos_boundary_dens(:,:,:), fid, 'DENS', 'ZXY', 1 )
1039  end if
1040  if ( atmos_boundary_use_dens ) then
1041  call fileio_read( atmos_boundary_alpha_dens(:,:,:), fid, 'ALPHA_DENS', 'ZXY', 1 )
1042  endif
1043 
1044  if ( atmos_boundary_use_velz ) then
1045  call fileio_read( atmos_boundary_velz(:,:,:), fid, 'VELZ', 'ZXY', 1 )
1046  call fileio_read( atmos_boundary_alpha_velz(:,:,:), fid, 'ALPHA_VELZ', 'ZXY', 1 )
1047  endif
1048 
1049  if ( atmos_boundary_use_velx ) then
1050  call fileio_read( atmos_boundary_velx(:,:,:), fid, 'VELX', 'ZXY', 1 )
1051  call fileio_read( atmos_boundary_alpha_velx(:,:,:), fid, 'ALPHA_VELX', 'ZXY', 1 )
1052  endif
1053 
1054  if ( atmos_boundary_use_vely ) then
1055  call fileio_read( atmos_boundary_vely(:,:,:), fid, 'VELY', 'ZXY', 1 )
1056  call fileio_read( atmos_boundary_alpha_vely(:,:,:), fid, 'ALPHA_VELY', 'ZXY', 1 )
1057  endif
1058 
1059  if ( atmos_boundary_use_pott ) then
1060  call fileio_read( atmos_boundary_pott(:,:,:), fid, 'POTT', 'ZXY', 1 )
1061  call fileio_read( atmos_boundary_alpha_pott(:,:,:), fid, 'ALPHA_POTT', 'ZXY', 1 )
1062  endif
1063 
1064  if ( atmos_boundary_use_qv ) then
1065  call fileio_read( atmos_boundary_qtrc(:,:,:,1), fid, 'QV', 'ZXY', 1 )
1066  call fileio_read( atmos_boundary_alpha_qtrc(:,:,:,1), fid, 'ALPHA_QV', 'ZXY', 1 )
1067  endif
1068 
1069  if ( atmos_boundary_use_qhyd ) then
1070  do iq = 2, bnd_qa
1071  call fileio_read( atmos_boundary_qtrc(:,:,:,iq), fid, aq_name(iq), 'ZXY', 1 )
1072  call fileio_read( atmos_boundary_alpha_qtrc(:,:,:,iq), fid, 'ALPHA_'//trim(aq_name(iq)), 'ZXY', 1 )
1073  end do
1074  endif
1075 
1076  call fileio_close( fid )
1077 
1078 
1079  call atmos_boundary_var_fillhalo
1080  call atmos_boundary_alpha_fillhalo
1081 
1082  return
1083  end subroutine atmos_boundary_read
1084 
1085  !-----------------------------------------------------------------------------
1087  subroutine atmos_boundary_write
1088  use scale_fileio, only: &
1089  fileio_write
1090  use scale_grid_nest, only: &
1091  online_use_velz
1092  use scale_atmos_phy_mp, only: &
1093  aq_name => atmos_phy_mp_name, &
1094  aq_unit => atmos_phy_mp_unit
1095  implicit none
1096 
1097  integer :: iq
1098  !---------------------------------------------------------------------------
1099 
1100  if ( atmos_boundary_use_dens &
1101  .OR. atmos_boundary_use_velz &
1102  .OR. atmos_boundary_use_velx &
1103  .OR. atmos_boundary_use_vely &
1104  .OR. atmos_boundary_use_pott &
1105  ) then
1106  call fileio_write( atmos_boundary_dens(:,:,:), &
1107  atmos_boundary_out_basename, atmos_boundary_out_title, &
1108  'DENS', 'Reference Density', 'kg/m3', 'ZXY', &
1109  atmos_boundary_out_dtype )
1110  end if
1111  if ( atmos_boundary_use_dens .OR. l_bnd ) then
1112  call fileio_write( atmos_boundary_alpha_dens(:,:,:), &
1113  atmos_boundary_out_basename, atmos_boundary_out_title, &
1114  'ALPHA_DENS', 'Alpha for DENS', '1', 'ZXY', &
1115  atmos_boundary_out_dtype )
1116  endif
1117 
1118  if ( atmos_boundary_use_velz .OR. (l_bnd .AND. online_use_velz) ) then
1119  call fileio_write( atmos_boundary_velz(:,:,:), &
1120  atmos_boundary_out_basename, atmos_boundary_out_title, &
1121  'VELZ', 'Reference Velocity w', 'm/s', 'ZXY', &
1122  atmos_boundary_out_dtype )
1123  call fileio_write( atmos_boundary_alpha_velz(:,:,:), &
1124  atmos_boundary_out_basename, atmos_boundary_out_title, &
1125  'ALPHA_VELZ', 'Alpha for VELZ', '1', 'ZXY', &
1126  atmos_boundary_out_dtype )
1127  endif
1128 
1129  if ( atmos_boundary_use_velx .OR. l_bnd ) then
1130  call fileio_write( atmos_boundary_velx(:,:,:), &
1131  atmos_boundary_out_basename, atmos_boundary_out_title, &
1132  'VELX', 'Reference Velocity u', 'm/s', 'ZXY', &
1133  atmos_boundary_out_dtype )
1134  call fileio_write( atmos_boundary_alpha_velx(:,:,:), &
1135  atmos_boundary_out_basename, atmos_boundary_out_title, &
1136  'ALPHA_VELX', 'Alpha for VELX', '1', 'ZXY', &
1137  atmos_boundary_out_dtype )
1138  endif
1139 
1140  if ( atmos_boundary_use_vely .OR. l_bnd ) then
1141  call fileio_write( atmos_boundary_vely(:,:,:), &
1142  atmos_boundary_out_basename, atmos_boundary_out_title, &
1143  'VELY', 'Reference Velocity y', 'm/s', 'ZXY', &
1144  atmos_boundary_out_dtype )
1145  call fileio_write( atmos_boundary_alpha_vely(:,:,:), &
1146  atmos_boundary_out_basename, atmos_boundary_out_title, &
1147  'ALPHA_VELY', 'Alpha for VELY', '1', 'ZXY', &
1148  atmos_boundary_out_dtype )
1149  endif
1150 
1151  if ( atmos_boundary_use_pott .OR. l_bnd ) then
1152  call fileio_write( atmos_boundary_pott(:,:,:), &
1153  atmos_boundary_out_basename, atmos_boundary_out_title, &
1154  'POTT', 'Reference POTT', 'K', 'ZXY', &
1155  atmos_boundary_out_dtype )
1156  call fileio_write( atmos_boundary_alpha_pott(:,:,:), &
1157  atmos_boundary_out_basename, atmos_boundary_out_title, &
1158  'ALPHA_POTT', 'Alpha for POTT', '1', 'ZXY', &
1159  atmos_boundary_out_dtype )
1160  endif
1161 
1162  if ( atmos_boundary_use_qv .OR. l_bnd ) then
1163  call fileio_write( atmos_boundary_qtrc(:,:,:,1), &
1164  atmos_boundary_out_basename, atmos_boundary_out_title, &
1165  'QV', 'Reference QV', 'kg/kg', 'ZXY', &
1166  atmos_boundary_out_dtype )
1167  call fileio_write( atmos_boundary_alpha_qtrc(:,:,:,1), &
1168  atmos_boundary_out_basename, atmos_boundary_out_title, &
1169  'ALPHA_QV', 'Alpha for QV', '1', 'ZXY', &
1170  atmos_boundary_out_dtype )
1171  endif
1172 
1173  if ( atmos_boundary_use_qhyd ) then
1174  do iq = 2, bnd_qa
1175  call fileio_write( atmos_boundary_qtrc(:,:,:,iq), &
1176  atmos_boundary_out_basename, atmos_boundary_out_title, &
1177  aq_name(iq), 'Reference '//trim(aq_name(iq)), aq_unit(iq), 'ZXY', &
1178  atmos_boundary_out_dtype )
1179  call fileio_write( atmos_boundary_alpha_qtrc(:,:,:,iq), &
1180  atmos_boundary_out_basename, atmos_boundary_out_title, &
1181  'ALPHA_'//trim(aq_name(iq)), 'Alpha for '//trim(aq_name(iq)), '1', 'ZXY', &
1182  atmos_boundary_out_dtype )
1183  end do
1184  endif
1185 
1186  return
1187  end subroutine atmos_boundary_write
1188 
1189  !-----------------------------------------------------------------------------
1191  subroutine atmos_boundary_generate
1192  use scale_atmos_refstate, only: &
1193  atmos_refstate_dens
1194  implicit none
1195 
1196  integer :: i, j, k, iq
1197  !---------------------------------------------------------------------------
1198 
1199  do j = 1, ja
1200  do i = 1, ia
1201  do k = 1, ka
1202  atmos_boundary_dens(k,i,j) = atmos_refstate_dens(k,i,j)
1203  atmos_boundary_velz(k,i,j) = atmos_boundary_value_velz
1204  atmos_boundary_velx(k,i,j) = atmos_boundary_value_velx
1205  atmos_boundary_vely(k,i,j) = atmos_boundary_value_vely
1206  atmos_boundary_pott(k,i,j) = atmos_boundary_value_pott
1207  do iq = 1, bnd_qa
1208  atmos_boundary_qtrc(k,i,j,iq) = atmos_boundary_value_qtrc
1209  end do
1210  enddo
1211  enddo
1212  enddo
1213 
1214  call atmos_boundary_var_fillhalo
1215 
1216  return
1217  end subroutine atmos_boundary_generate
1218 
1219  !-----------------------------------------------------------------------------
1221  subroutine atmos_boundary_initialize_file
1222  use scale_calendar, only: &
1223  calendar_date2daysec, &
1224  calendar_combine_daysec, &
1225  calendar_date2char
1226  use scale_time, only: &
1227  time_nowdate
1228  use scale_fileio, only: &
1229  fileio_open, &
1230  fileio_check_coordinates
1231  implicit none
1232 
1233  integer :: boundary_time_startday
1234  real(DP) :: boundary_time_startsec
1235  real(DP) :: boundary_time_startms
1236  integer :: boundary_time_offset_year
1237  character(len=27) :: boundary_chardate
1238 
1239  if ( atmos_boundary_start_date(1) == -9999 ) then
1240  atmos_boundary_start_date = time_nowdate
1241  end if
1242 
1243  !--- calculate time of the initial step in boundary file [no offset]
1244  boundary_time_startms = 0.0_dp
1245  boundary_time_offset_year = 0
1246  call calendar_date2char( boundary_chardate, & ! [OUT]
1247  atmos_boundary_start_date(:), & ! [IN]
1248  boundary_time_startms ) ! [IN]
1249 
1250  call calendar_date2daysec( boundary_time_startday, & ! [OUT]
1251  boundary_time_startsec, & ! [OUT]
1252  atmos_boundary_start_date(:), & ! [IN]
1253  boundary_time_startms, & ! [IN]
1254  boundary_time_offset_year ) ! [IN]
1255 
1256  boundary_time_initdaysec = calendar_combine_daysec( boundary_time_startday, boundary_time_startsec )
1257 
1258  if( io_l ) write(io_fid_log,'(1x,A,A)') '*** BOUNDARY START Date : ', boundary_chardate
1259 
1260  call fileio_open( atmos_boundary_fid, atmos_boundary_in_basename )
1261 
1262  if ( atmos_boundary_in_check_coordinates ) then
1263  call fileio_check_coordinates( atmos_boundary_fid, atmos=.true. )
1264  end if
1265 
1266  return
1267  end subroutine atmos_boundary_initialize_file
1268 
1269  !-----------------------------------------------------------------------------
1271  subroutine atmos_boundary_resume_file
1272  use gtool_file, only: &
1273  fileread
1274  use scale_process, only: &
1275  prc_mpistop
1276  use scale_time, only: &
1277  time_nowdate, &
1278  time_dtsec
1279  use scale_calendar, only: &
1280  calendar_date2daysec, &
1281  calendar_combine_daysec
1282  implicit none
1283 
1284  real(RP) :: bnd_DENS(KA,IA,JA) ! damping coefficient for DENS (0-1)
1285  real(RP) :: bnd_VELZ(KA,IA,JA) ! damping coefficient for VELZ (0-1)
1286  real(RP) :: bnd_VELX(KA,IA,JA) ! damping coefficient for VELX (0-1)
1287  real(RP) :: bnd_VELY(KA,IA,JA) ! damping coefficient for VELY (0-1)
1288  real(RP) :: bnd_POTT(KA,IA,JA) ! damping coefficient for POTT (0-1)
1289  real(RP) :: bnd_QTRC(KA,IA,JA,BND_QA) ! damping coefficient for QTRC (0-1)
1290 
1291  integer :: run_time_startdate(6)
1292  integer :: run_time_startday
1293  real(DP) :: run_time_startsec
1294  real(DP) :: run_time_startms
1295  integer :: run_time_offset_year
1296  real(DP) :: run_time_nowdaysec
1297 
1298  real(DP) :: boundary_diff_daysec
1299  real(RP) :: boundary_inc_offset
1300  integer :: fillgaps_steps
1301 
1302  integer :: i, j, k, iq
1303  !---------------------------------------------------------------------------
1304 
1305  if ( atmos_boundary_update_dt <= 0.0_dp ) then
1306  write(*,*) 'xxx You need specify ATMOS_BOUNDARY_UPDATE_DT as larger than 0.0'
1307  call prc_mpistop
1308  endif
1309  update_nstep = nint( atmos_boundary_update_dt / time_dtsec )
1310  if ( abs(update_nstep * time_dtsec - atmos_boundary_update_dt) > 1e-10_dp ) then
1311  write(*,*) 'xxx ATMOS_BOUNDARY_UPDATE_DT is not multiple of DT'
1312  call prc_mpistop
1313  end if
1314 
1315  !--- recalculate time of the run [no offset]
1316  run_time_startdate(:) = time_nowdate(:)
1317  run_time_startms = 0.0_dp
1318  run_time_offset_year = 0
1319 
1320  call calendar_date2daysec( run_time_startday, & ! [OUT]
1321  run_time_startsec, & ! [OUT]
1322  run_time_startdate(:), & ! [IN]
1323  run_time_startms, & ! [IN]
1324  run_time_offset_year ) ! [IN]
1325 
1326  run_time_nowdaysec = calendar_combine_daysec( run_time_startday, run_time_startsec )
1327 
1328  boundary_diff_daysec = run_time_nowdaysec - boundary_time_initdaysec
1329  boundary_timestep = 1 + int( boundary_diff_daysec / atmos_boundary_update_dt )
1330  boundary_inc_offset = mod( boundary_diff_daysec, atmos_boundary_update_dt )
1331  fillgaps_steps = int( boundary_inc_offset / time_dtsec )
1332 
1333  if( io_l ) write(io_fid_log,*) '+++ BOUNDARY TIMESTEP NUMBER FOR INIT:', boundary_timestep
1334  if( io_l ) write(io_fid_log,*) '+++ BOUNDARY OFFSET:', boundary_inc_offset
1335  if( io_l ) write(io_fid_log,*) '+++ BOUNDARY FILLGAPS STEPS:', fillgaps_steps
1336 
1337  ! read boundary data from input file
1338  call atmos_boundary_update_file( ref_now )
1339 
1340  boundary_timestep = boundary_timestep + 1
1341  call atmos_boundary_update_file( ref_new )
1342 
1343  ! copy now to old
1344  !$omp parallel do default(none) private(i,j,k,iq) OMP_SCHEDULE_ collapse(2) &
1345  !$omp shared(JA,IA,KA,ATMOS_BOUNDARY_ref_DENS,ref_old,ref_now,ATMOS_BOUNDARY_ref_VELX) &
1346  !$omp shared(ATMOS_BOUNDARY_ref_VELY,ATMOS_BOUNDARY_ref_POTT,BND_QA,ATMOS_BOUNDARY_ref_QTRC)
1347  do j = 1, ja
1348  do i = 1, ia
1349  do k = 1, ka
1350  atmos_boundary_ref_dens(k,i,j,ref_old) = atmos_boundary_ref_dens(k,i,j,ref_now)
1351  atmos_boundary_ref_velx(k,i,j,ref_old) = atmos_boundary_ref_velx(k,i,j,ref_now)
1352  atmos_boundary_ref_vely(k,i,j,ref_old) = atmos_boundary_ref_vely(k,i,j,ref_now)
1353  atmos_boundary_ref_pott(k,i,j,ref_old) = atmos_boundary_ref_pott(k,i,j,ref_now)
1354  do iq = 1, bnd_qa
1355  atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
1356  end do
1357  end do
1358  end do
1359  end do
1360 
1361  ! set boundary data
1362  do j = 1, ja
1363  do i = 1, ia
1364  do k = 1, ka
1365  atmos_boundary_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_now)
1366  atmos_boundary_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_now)
1367  atmos_boundary_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_now)
1368  atmos_boundary_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_now)
1369  do iq = 1, bnd_qa
1370  atmos_boundary_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
1371  end do
1372  end do
1373  end do
1374  end do
1375 
1376  if ( atmos_boundary_use_velz ) then
1377  do j = 1, ja
1378  do i = 1, ia
1379  do k = 1, ka
1380  atmos_boundary_velz(k,i,j) = atmos_boundary_value_velz
1381  end do
1382  end do
1383  end do
1384  end if
1385 
1386  now_step = fillgaps_steps
1387 
1388  ! get time boundary
1389  call get_boundary( bnd_dens(:,:,:), & ! [OUT]
1390  bnd_velz(:,:,:), & ! [OUT]
1391  bnd_velx(:,:,:), & ! [OUT]
1392  bnd_vely(:,:,:), & ! [OUT]
1393  bnd_pott(:,:,:), & ! [OUT]
1394  bnd_qtrc(:,:,:,:), & ! [OUT]
1395  now_step, & ! [IN]
1396  update_nstep ) ! [IN]
1397 
1398  ! fill in gaps of the offset
1399  do j = 1, ja
1400  do i = 1, ia
1401  do k = 1, ka
1402  atmos_boundary_dens(k,i,j) = bnd_dens(k,i,j)
1403  atmos_boundary_velx(k,i,j) = bnd_velx(k,i,j)
1404  atmos_boundary_vely(k,i,j) = bnd_vely(k,i,j)
1405  atmos_boundary_pott(k,i,j) = bnd_pott(k,i,j)
1406  do iq = 1, bnd_qa
1407  atmos_boundary_qtrc(k,i,j,iq) = bnd_qtrc(k,i,j,iq)
1408  end do
1409  end do
1410  end do
1411  end do
1412 
1413  return
1414  end subroutine atmos_boundary_resume_file
1415 
1416  !-----------------------------------------------------------------------------
1418  subroutine atmos_boundary_initialize_online
1419  use scale_process, only: &
1420  prc_mpistop
1421  use scale_grid_nest, only: &
1422  nest_comm_recvwait_issue, &
1423  online_use_velz, &
1424  parent_dtsec, &
1425  nestqa => nest_bnd_qa
1426  implicit none
1427 
1428  ! parameters
1429  integer, parameter :: handle = 2
1430 
1431  atmos_boundary_update_dt = parent_dtsec(handle)
1432 
1433  if ( nestqa > bnd_qa ) then
1434  write(*,*) 'xxx ERROR: NEST_BND_QA exceeds BND_QA [initialize/ATMOS_BOUNDARY]'
1435  write(*,*) 'xxx check consistency between'
1436  write(*,*) ' ONLINE_BOUNDARY_USE_QHYD and ATMOS_BOUNDARY_USE_QHYD.'
1437  call prc_mpistop
1438  end if
1439 
1440  call nest_comm_recvwait_issue( handle, nestqa )
1441 
1442  return
1443  end subroutine atmos_boundary_initialize_online
1444 
1445  !-----------------------------------------------------------------------------
1447  subroutine atmos_boundary_resume_online
1448  use scale_process, only: &
1449  prc_mpistop
1450  use scale_time, only: &
1451  time_dtsec, &
1452  time_nstep
1453  use scale_grid_nest, only: &
1454  nest_comm_recvwait_issue, &
1455  online_use_velz, &
1456  parent_nstep
1457  implicit none
1458 
1459  ! parameters
1460  integer, parameter :: handle = 2
1461 
1462  ! works
1463  integer :: i, j, k, iq
1464  !---------------------------------------------------------------------------
1465 
1466  ! import data from parent domain
1467  boundary_timestep = 1
1468  if( io_l ) write(io_fid_log,*) '+++ BOUNDARY TIMESTEP NUMBER FOR INIT:', boundary_timestep
1469 
1470  call atmos_boundary_update_online_daughter( ref_now )
1471 
1472  boundary_timestep = boundary_timestep + 1
1473  if( io_l ) write(io_fid_log,*) '+++ BOUNDARY TIMESTEP NUMBER FOR INIT:', boundary_timestep
1474 
1475  call atmos_boundary_update_online_daughter( ref_new )
1476 
1477  ! copy now to old
1478  do j = 1, ja
1479  do i = 1, ia
1480  do k = 1, ka
1481  atmos_boundary_ref_dens(k,i,j,ref_old) = atmos_boundary_ref_dens(k,i,j,ref_now)
1482  atmos_boundary_ref_velx(k,i,j,ref_old) = atmos_boundary_ref_velx(k,i,j,ref_now)
1483  atmos_boundary_ref_vely(k,i,j,ref_old) = atmos_boundary_ref_vely(k,i,j,ref_now)
1484  atmos_boundary_ref_pott(k,i,j,ref_old) = atmos_boundary_ref_pott(k,i,j,ref_now)
1485  do iq = 1, bnd_qa
1486  atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
1487  end do
1488  end do
1489  end do
1490  end do
1491 
1492  ! set boundary data
1493  do j = 1, ja
1494  do i = 1, ia
1495  do k = 1, ka
1496  atmos_boundary_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_now)
1497  atmos_boundary_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_now)
1498  atmos_boundary_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_now)
1499  atmos_boundary_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_now)
1500  do iq = 1, bnd_qa
1501  atmos_boundary_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
1502  end do
1503  end do
1504  end do
1505  end do
1506 
1507  if ( online_use_velz ) then
1508  do j = 1, ja
1509  do i = 1, ia
1510  do k = 1, ka
1511  atmos_boundary_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_now)
1512  end do
1513  end do
1514  end do
1515  else if ( atmos_boundary_use_velz ) then
1516  do j = 1, ja
1517  do i = 1, ia
1518  do k = 1, ka
1519  atmos_boundary_velz(k,i,j) = atmos_boundary_value_velz
1520  end do
1521  end do
1522  end do
1523  end if
1524 
1525  update_nstep = nint( atmos_boundary_update_dt / time_dtsec )
1526  if ( update_nstep * parent_nstep(handle) /= time_nstep ) then
1527  write(*,*) 'xxx NSTEP is not multiple of PARENT_NSTEP'
1528  call prc_mpistop
1529  end if
1530 
1531  now_step = 0 ! should be set as zero in initialize process
1532 
1533  return
1534  end subroutine atmos_boundary_resume_online
1535 
1536  !-----------------------------------------------------------------------------
1538  subroutine atmos_boundary_firstsend( &
1539  DENS, MOMZ, MOMX, MOMY, RHOT, QTRC )
1540  implicit none
1541 
1542  ! arguments
1543  real(RP), intent(in) :: dens(ka,ia,ja)
1544  real(RP), intent(in) :: momz(ka,ia,ja)
1545  real(RP), intent(in) :: momx(ka,ia,ja)
1546  real(RP), intent(in) :: momy(ka,ia,ja)
1547  real(RP), intent(in) :: rhot(ka,ia,ja)
1548  real(RP), intent(in) :: qtrc(ka,ia,ja,qa)
1549  !---------------------------------------------------------------------------
1550 
1551  ! send data at the first time
1552  if ( do_parent_process ) then !online [parent]
1553  ! issue send
1554  call atmos_boundary_send( dens, momz, momx, momy, rhot, qtrc )
1555  endif
1556 
1557  return
1558  end subroutine atmos_boundary_firstsend
1559 
1560  !-----------------------------------------------------------------------------
1562  subroutine atmos_boundary_finalize
1563  use scale_grid_nest, only: &
1564  nest_comm_recvwait_issue, &
1565  nest_comm_recv_cancel, &
1566  nestqa => nest_bnd_qa
1567  use scale_fileio, only: &
1568  fileio_close
1569  implicit none
1570 
1571  ! works
1572  integer :: handle
1573  !---------------------------------------------------------------------------
1574 
1575  if ( do_parent_process ) then !online [parent]
1576  handle = 1
1577  call nest_comm_recvwait_issue( handle, nestqa )
1578  endif
1579 
1580  if ( do_daughter_process ) then !online [daughter]
1581  handle = 2
1582  call nest_comm_recv_cancel( handle )
1583  endif
1584 
1585  if ( atmos_boundary_fid > 0 ) then
1586  call fileio_close( atmos_boundary_fid )
1587  atmos_boundary_fid = -1
1588  end if
1589 
1590  return
1591  end subroutine atmos_boundary_finalize
1592 
1593  !-----------------------------------------------------------------------------
1595  subroutine atmos_boundary_update( &
1596  DENS, MOMZ, MOMX, MOMY, RHOT, QTRC )
1597  use scale_process, only: &
1598  prc_mpistop
1599  use scale_rm_process, only: &
1600  prc_has_w, &
1601  prc_has_e, &
1602  prc_has_s, &
1603  prc_has_n
1604  use scale_atmos_phy_mp, only: &
1605  qs_mp
1606  use scale_grid_nest, only: &
1607  online_use_velz, &
1608  nest_comm_test
1609  implicit none
1610 
1611  real(RP), intent(inout) :: dens(ka,ia,ja)
1612  real(RP), intent(inout) :: momz(ka,ia,ja)
1613  real(RP), intent(inout) :: momx(ka,ia,ja)
1614  real(RP), intent(inout) :: momy(ka,ia,ja)
1615  real(RP), intent(inout) :: rhot(ka,ia,ja)
1616  real(RP), intent(inout) :: qtrc(ka,ia,ja,qa)
1617 
1618  real(RP) :: bnd_dens(ka,ia,ja) ! damping coefficient for DENS (0-1)
1619  real(RP) :: bnd_velz(ka,ia,ja) ! damping coefficient for VELZ (0-1)
1620  real(RP) :: bnd_velx(ka,ia,ja) ! damping coefficient for VELX (0-1)
1621  real(RP) :: bnd_vely(ka,ia,ja) ! damping coefficient for VELY (0-1)
1622  real(RP) :: bnd_pott(ka,ia,ja) ! damping coefficient for POTT (0-1)
1623  real(RP) :: bnd_qtrc(ka,ia,ja,bnd_qa) ! damping coefficient for QTRC (0-1)
1624 
1625  integer :: handle
1626  integer :: i, j, k, iq, iqa
1627  !---------------------------------------------------------------------------
1628 
1629  if ( do_parent_process ) then !online [parent]
1630  ! should be called every time step
1631  call atmos_boundary_update_online_parent( dens,momz,momx,momy,rhot,qtrc )
1632  endif
1633 
1634  if ( l_bnd ) then
1635  ! update referce vars
1636  if ( now_step >= update_nstep ) then
1637  now_step = 0
1638  boundary_timestep = boundary_timestep + 1
1639 
1640  call update_ref_index
1641 
1642  if ( do_daughter_process ) then !online [daughter]
1643  call atmos_boundary_update_online_daughter( ref_new )
1644  else
1645  call atmos_boundary_update_file( ref_new )
1646  end if
1647  end if
1648 
1649  ! step boundary
1650  now_step = now_step + 1
1651 
1652  ! get boundaryal coefficients
1653  call get_boundary( bnd_dens(:,:,:), & ! [OUT]
1654  bnd_velz(:,:,:), & ! [OUT]
1655  bnd_velx(:,:,:), & ! [OUT]
1656  bnd_vely(:,:,:), & ! [OUT]
1657  bnd_pott(:,:,:), & ! [OUT]
1658  bnd_qtrc(:,:,:,:), & ! [OUT]
1659  now_step, & ! [IN]
1660  update_nstep ) ! [IN]
1661 
1662  ! update boundary vars
1663  do j = 1, ja
1664  do i = 1, ia
1665  do k = 1, ka
1666  atmos_boundary_dens(k,i,j) = bnd_dens(k,i,j)
1667  atmos_boundary_velx(k,i,j) = bnd_velx(k,i,j)
1668  atmos_boundary_vely(k,i,j) = bnd_vely(k,i,j)
1669  atmos_boundary_pott(k,i,j) = bnd_pott(k,i,j)
1670  do iq = 1, bnd_qa
1671  atmos_boundary_qtrc(k,i,j,iq) = bnd_qtrc(k,i,j,iq)
1672  end do
1673  end do
1674  end do
1675  end do
1676  if ( online_use_velz ) then
1677  do j = 1, ja
1678  do i = 1, ia
1679  do k = 1, ka
1680  atmos_boundary_velz(k,i,j) = bnd_velz(k,i,j)
1681  end do
1682  end do
1683  end do
1684  end if
1685 
1686  ! fill HALO in western region
1687  if ( .NOT. prc_has_w ) then
1688  !$omp parallel do default(none) &
1689  !$omp shared(JS,IS,KA,DENS,ATMOS_BOUNDARY_DENS,MOMX,ATMOS_BOUNDARY_VELX,RHOT) &
1690  !$omp shared(ATMOS_BOUNDARY_POTT,ATMOS_BOUNDARY_QTRC,BND_QA,QS_MP,QTRC,QA,JA) &
1691  !$omp private(i,j,k,iq,iqa) OMP_SCHEDULE_ collapse(2)
1692  do j = 1, ja
1693  do i = 1, is-1
1694  do k = 1, ka
1695  dens(k,i,j) = atmos_boundary_dens(k,i,j)
1696  momx(k,i,j) = atmos_boundary_velx(k,i,j) &
1697  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i+1,j) ) * 0.5_rp
1698  rhot(k,i,j) = atmos_boundary_pott(k,i,j) * atmos_boundary_dens(k,i,j)
1699  do iq = 1, bnd_qa
1700  iqa = iq + qs_mp - 1
1701  qtrc(k,i,j,iqa) = atmos_boundary_qtrc(k,i,j,iq)
1702  end do
1703  do iq = 1, qa
1704  if ( iq < qs_mp .or. iq >= bnd_qa + qs_mp ) then
1705  qtrc(k,i,j,iq) = qtrc(k,is,j,iq) &
1706  * ( 0.5_rp - sign(0.5_rp, atmos_boundary_velx(k,is-1,j)) )
1707  end if
1708  end do
1709  end do
1710  end do
1711  end do
1712  do j = 1, ja-1
1713  do i = 1, is-1
1714  do k = 1, ka
1715  momy(k,i,j) = atmos_boundary_vely(k,i,j) &
1716  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i,j+1) ) * 0.5_rp
1717  end do
1718  end do
1719  end do
1720  do i = 1, is-1
1721  do k = 1, ka
1722  momy(k,i,ja) = atmos_boundary_vely(k,i,ja) &
1723  * atmos_boundary_dens(k,i,ja)
1724  end do
1725  end do
1726  if ( online_use_velz ) then
1727  do j = 1, ja
1728  do i = 1, is-1
1729  do k = ks, ke-1
1730  momz(k,i,j) = atmos_boundary_velz(k,i,j) &
1731  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k+1,i,j) ) * 0.5_rp
1732  end do
1733  end do
1734  end do
1735  else
1736  do j = 1, ja
1737  do i = 1, is-1
1738  do k = ks, ke-1
1739  momz(k,i,j) = momz(k,is,j)
1740  end do
1741  end do
1742  end do
1743  end if
1744  end if
1745 
1746  ! fill HALO in eastern region
1747  if ( .NOT. prc_has_e ) then
1748  !$omp parallel do default(none) &
1749  !$omp shared(JA,IE,IA,KA,DENS,ATMOS_BOUNDARY_DENS,ATMOS_BOUNDARY_VELX,RHOT) &
1750  !$omp shared(ATMOS_BOUNDARY_POTT,ATMOS_BOUNDARY_QTRC,BND_QA,QS_MP,QTRC,QA) &
1751  !$omp private(i,j,k,iq,iqa) OMP_SCHEDULE_ collapse(2)
1752  do j = 1, ja
1753  do i = ie+1, ia
1754  do k = 1, ka
1755  dens(k,i,j) = atmos_boundary_dens(k,i,j)
1756  rhot(k,i,j) = atmos_boundary_pott(k,i,j) * atmos_boundary_dens(k,i,j)
1757  do iq = 1, bnd_qa
1758  iqa = iq + qs_mp - 1
1759  qtrc(k,i,j,iqa) = atmos_boundary_qtrc(k,i,j,iq)
1760  end do
1761  do iq = 1, qa
1762  if ( iq < qs_mp .or. iq >= bnd_qa + qs_mp ) then
1763  qtrc(k,i,j,iq) = qtrc(k,ie,j,iq) &
1764  * ( 0.5_rp + sign(0.5_rp, atmos_boundary_velx(k,ie,j)) )
1765  end if
1766  end do
1767  end do
1768  end do
1769  end do
1770  do j = 1, ja
1771  do i = ie, ia-1
1772  do k = 1, ka
1773  momx(k,i,j) = atmos_boundary_velx(k,i,j) &
1774  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i+1,j) ) * 0.5_rp
1775  end do
1776  end do
1777  end do
1778  do j = 1, ja
1779  do k = 1, ka
1780  momx(k,ia,j) = atmos_boundary_velx(k,ia,j) * atmos_boundary_dens(k,ia,j)
1781  end do
1782  end do
1783  do j = 1, ja-1
1784  do i = ie+1, ia
1785  do k = 1, ka
1786  momy(k,i,j) = atmos_boundary_vely(k,i,j) &
1787  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i,j+1) ) * 0.5_rp
1788  end do
1789  end do
1790  end do
1791  do i = ie+1, ia
1792  do k = 1, ka
1793  momy(k,i,ja) = atmos_boundary_vely(k,i,ja) &
1794  * atmos_boundary_dens(k,i,ja)
1795  end do
1796  end do
1797  if ( online_use_velz ) then
1798  do j = 1, ja
1799  do i = ie+1, ia
1800  do k = ks, ke-1
1801  momz(k,i,j) = atmos_boundary_velz(k,i,j) &
1802  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k+1,i,j) ) * 0.5_rp
1803  end do
1804  end do
1805  end do
1806  else
1807  do j = 1, ja
1808  do i = ie+1, ia
1809  do k = ks, ke-1
1810  momz(k,i,j) = momz(k,ie,j)
1811  end do
1812  end do
1813  end do
1814  end if
1815  end if
1816 
1817  ! fill HALO in southern region
1818  if ( .NOT. prc_has_s ) then
1819  !$omp parallel do default(none) &
1820  !$omp shared(JS,IA,KA,DENS,ATMOS_BOUNDARY_DENS,MOMY,ATMOS_BOUNDARY_VELY,RHOT) &
1821  !$omp shared(ATMOS_BOUNDARY_POTT,ATMOS_BOUNDARY_QTRC,BND_QA,QS_MP,QTRC,QA) &
1822  !$omp private(i,j,k,iq,iqa) OMP_SCHEDULE_ collapse(2)
1823  do j = 1, js-1
1824  do i = 1, ia
1825  do k = 1, ka
1826  dens(k,i,j) = atmos_boundary_dens(k,i,j)
1827  momy(k,i,j) = atmos_boundary_vely(k,i,j) &
1828  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i,j+1) ) * 0.5_rp
1829  rhot(k,i,j) = atmos_boundary_pott(k,i,j) * atmos_boundary_dens(k,i,j)
1830  do iq = 1, bnd_qa
1831  iqa = iq + qs_mp - 1
1832  qtrc(k,i,j,iqa) = atmos_boundary_qtrc(k,i,j,iq)
1833  end do
1834  do iq = 1, qa
1835  if ( iq < qs_mp .or. iq >= bnd_qa + qs_mp ) then
1836  qtrc(k,i,j,iq) = qtrc(k,i,js,iq) &
1837  * ( 0.5_rp - sign(0.5_rp, atmos_boundary_vely(k,i,js-1)) )
1838  end if
1839  end do
1840  end do
1841  end do
1842  end do
1843  do j = 1, js-1
1844  do i = 1, ia-1
1845  do k = 1, ka
1846  momx(k,i,j) = atmos_boundary_velx(k,i,j) &
1847  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i+1,j) ) * 0.5_rp
1848  end do
1849  end do
1850  end do
1851  do j = 1, js-1
1852  do k = 1, ka
1853  momx(k,ia,j) = atmos_boundary_velx(k,ia,j) &
1854  * atmos_boundary_dens(k,ia,j)
1855  end do
1856  end do
1857  if ( online_use_velz ) then
1858  do j = 1, js-1
1859  do i = 1, ia
1860  do k = ks, ke-1
1861  momz(k,i,j) = atmos_boundary_velz(k,i,j) &
1862  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k+1,i,j) ) * 0.5_rp
1863  end do
1864  end do
1865  end do
1866  else
1867  do j = 1, js-1
1868  do i = 1, ia
1869  do k = ks, ke-1
1870  momz(k,i,j) = momz(k,i,js)
1871  end do
1872  end do
1873  end do
1874  end if
1875  end if
1876 
1877  ! fill HALO in northern region
1878  if ( .NOT. prc_has_n ) then
1879  !$omp parallel do default(none) &
1880  !$omp shared(JE,JA,IA,KA,DENS,ATMOS_BOUNDARY_DENS,ATMOS_BOUNDARY_VELY,RHOT) &
1881  !$omp shared(ATMOS_BOUNDARY_POTT,ATMOS_BOUNDARY_QTRC,BND_QA,QS_MP,QTRC,QA) &
1882  !$omp private(i,j,k,iq,iqa) OMP_SCHEDULE_ collapse(2)
1883  do j = je+1, ja
1884  do i = 1, ia
1885  do k = 1, ka
1886  dens(k,i,j) = atmos_boundary_dens(k,i,j)
1887  rhot(k,i,j) = atmos_boundary_pott(k,i,j) * atmos_boundary_dens(k,i,j)
1888  do iq = 1, bnd_qa
1889  iqa = iq + qs_mp - 1
1890  qtrc(k,i,j,iqa) = atmos_boundary_qtrc(k,i,j,iq)
1891  end do
1892  do iq = bnd_qa+1, qa
1893  if ( iq < qs_mp .or. iq >= bnd_qa + qs_mp ) then
1894  qtrc(k,i,j,iq) = qtrc(k,i,je,iq) &
1895  * ( 0.5_rp + sign(0.5_rp, atmos_boundary_vely(k,i,je)) )
1896  end if
1897  end do
1898  end do
1899  end do
1900  end do
1901  do j = je, ja-1
1902  do i = 1, ia
1903  do k = 1, ka
1904  momy(k,i,j) = atmos_boundary_vely(k,i,j) &
1905  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i,j+1) ) * 0.5_rp
1906  end do
1907  end do
1908  end do
1909  do i = 1, ia
1910  do k = 1, ka
1911  momy(k,i,ja) = atmos_boundary_vely(k,i,ja) * atmos_boundary_dens(k,i,ja)
1912  end do
1913  end do
1914  do j = je+1, ja
1915  do i = 1, ia-1
1916  do k = 1, ka
1917  momx(k,i,j) = atmos_boundary_velx(k,i,j) &
1918  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i+1,j) ) * 0.5_rp
1919  end do
1920  end do
1921  end do
1922  do j = je+1, ja
1923  do k = 1, ka
1924  momx(k,ia,j) = atmos_boundary_velx(k,ia,j) &
1925  * atmos_boundary_dens(k,ia,j)
1926  end do
1927  end do
1928  if ( online_use_velz ) then
1929  do j = je+1, ja
1930  do i = 1, ia
1931  do k = ks, ke-1
1932  momz(k,i,j) = atmos_boundary_velz(k,i,j) &
1933  * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k+1,i,j) ) * 0.5_rp
1934  end do
1935  end do
1936  end do
1937  else
1938  do j = je+1, ja
1939  do i = 1, ia
1940  do k = ks, ke-1
1941  momz(k,i,j) = momz(k,i,je)
1942  end do
1943  end do
1944  end do
1945  end if
1946  end if
1947 
1948  elseif ( do_parent_process ) then
1949  ! do nothing
1950  else
1951  write(*,*) 'xxx [BUG] invalid path'
1952  call prc_mpistop
1953  end if
1954 
1955  call history_bnd( atmos_boundary_dens, &
1956  atmos_boundary_velz, &
1957  atmos_boundary_velx, &
1958  atmos_boundary_vely, &
1959  atmos_boundary_pott, &
1960  atmos_boundary_qtrc )
1961 
1962  ! To be enable to do asynchronous communicaton
1963  if ( do_parent_process ) then !online [parent]
1964  handle = 1
1965  call nest_comm_test( handle )
1966  endif
1967  if ( do_daughter_process ) then !online [daughter]
1968  handle = 2
1969  call nest_comm_test( handle )
1970  endif
1971 
1972  return
1973  end subroutine atmos_boundary_update
1974 
1975  !-----------------------------------------------------------------------------
1977  subroutine atmos_boundary_update_file( ref )
1978  use scale_fileio, only: &
1979  fileio_read, &
1980  fileio_flush
1981  use scale_atmos_phy_mp, only: &
1982  aq_name => atmos_phy_mp_name
1983  implicit none
1984 
1985  integer, intent(in) :: ref
1986 
1987  integer :: fid, iq
1988  !---------------------------------------------------------------------------
1989 
1990  if( io_l ) write(io_fid_log,*)"*** Atmos Boundary: read from boundary file(timestep=", boundary_timestep, ")"
1991 
1992  fid = atmos_boundary_fid
1993 
1994  call fileio_read( atmos_boundary_ref_dens(:,:,:,ref), fid, 'DENS', 'ZXY', boundary_timestep )
1995  call fileio_read( atmos_boundary_ref_velx(:,:,:,ref), fid, 'VELX', 'ZXY', boundary_timestep )
1996  call fileio_read( atmos_boundary_ref_vely(:,:,:,ref), fid, 'VELY', 'ZXY', boundary_timestep )
1997  call fileio_read( atmos_boundary_ref_pott(:,:,:,ref), fid, 'POTT', 'ZXY', boundary_timestep )
1998  do iq = 1, bnd_qa
1999  call fileio_read( atmos_boundary_ref_qtrc(:,:,:,iq,ref), fid, aq_name(iq), 'ZXY', boundary_timestep )
2000  end do
2001 
2002  call fileio_flush( fid )
2003 
2004  ! fill HALO in reference
2005  call atmos_boundary_ref_fillhalo( ref )
2006 
2007  return
2008  end subroutine atmos_boundary_update_file
2009 
2010  !-----------------------------------------------------------------------------
2012  subroutine atmos_boundary_update_online_parent( &
2013  DENS, & ! [in]
2014  MOMZ, & ! [in]
2015  MOMX, & ! [in]
2016  MOMY, & ! [in]
2017  RHOT, & ! [in]
2018  QTRC ) ! [in]
2019  use scale_grid_nest, only: &
2020  nest_comm_recvwait_issue, &
2021  nestqa => nest_bnd_qa
2022  implicit none
2023 
2024  ! arguments
2025  real(RP), intent(in) :: dens(ka,ia,ja)
2026  real(RP), intent(in) :: momz(ka,ia,ja)
2027  real(RP), intent(in) :: momx(ka,ia,ja)
2028  real(RP), intent(in) :: momy(ka,ia,ja)
2029  real(RP), intent(in) :: rhot(ka,ia,ja)
2030  real(RP), intent(in) :: qtrc(ka,ia,ja,qa)
2031 
2032  integer, parameter :: handle = 1
2033  !---------------------------------------------------------------------------
2034 
2035  if( io_l ) write(io_fid_log,*)"*** ATMOS BOUNDARY update online: PARENT"
2036 
2037  ! issue wait
2038  call nest_comm_recvwait_issue( handle, nestqa )
2039 
2040  ! issue send
2041  call atmos_boundary_send( dens, momz, momx, momy, rhot, qtrc )
2042 
2043  return
2044  end subroutine atmos_boundary_update_online_parent
2045 
2046  !-----------------------------------------------------------------------------
2048  subroutine atmos_boundary_update_online_daughter( &
2049  ref ) ! [in]
2050  use scale_grid_nest, only: &
2051  nest_comm_recvwait_issue, &
2052  nestqa => nest_bnd_qa
2053  implicit none
2054 
2055  ! arguments
2056  integer, intent(in) :: ref
2057 
2058  integer, parameter :: handle = 2
2059  !---------------------------------------------------------------------------
2060 
2061  if( io_l ) write(io_fid_log,'(1X,A,I5)') '*** ATMOS BOUNDARY update online: DAUGHTER', boundary_timestep
2062 
2063  ! issue wait
2064  call atmos_boundary_recv( ref )
2065 
2066  ! fill HALO in reference
2067  call atmos_boundary_ref_fillhalo( ref )
2068 
2069  ! issue receive
2070  call nest_comm_recvwait_issue( handle, nestqa )
2071 
2072  return
2073  end subroutine atmos_boundary_update_online_daughter
2074 
2075  !-----------------------------------------------------------------------------
2077  subroutine atmos_boundary_send( &
2078  DENS, MOMZ, MOMX, MOMY, RHOT, QTRC )
2079  use scale_atmos_phy_mp, only: &
2080  qs_mp
2081  use scale_grid_nest, only: &
2082  nest_comm_nestdown, &
2083  daughter_ka, &
2084  daughter_ia, &
2085  daughter_ja, &
2086  nestqa => nest_bnd_qa
2087  implicit none
2088 
2089  ! parameters
2090  integer, parameter :: handle = 1
2091 
2092  ! arguments
2093  real(RP), intent(in) :: dens(ka,ia,ja)
2094  real(RP), intent(in) :: momz(ka,ia,ja)
2095  real(RP), intent(in) :: momx(ka,ia,ja)
2096  real(RP), intent(in) :: momy(ka,ia,ja)
2097  real(RP), intent(in) :: rhot(ka,ia,ja)
2098  real(RP), intent(in) :: qtrc(ka,ia,ja,qa)
2099 
2100  ! works
2101  real(RP) :: dummy_d( daughter_ka(handle), daughter_ia(handle), daughter_ja(handle), nestqa )
2102  !---------------------------------------------------------------------------
2103 
2104 !OCL XFILL
2105  dummy_d(:,:,:,:) = 0.0_rp
2106 
2107  call nest_comm_nestdown( handle, &
2108  nestqa, &
2109  dens(:,:,:), & !(KA,IA,JA)
2110  momz(:,:,:), & !(KA,IA,JA)
2111  momx(:,:,:), & !(KA,IA,JA)
2112  momy(:,:,:), & !(KA,IA,JA)
2113  rhot(:,:,:), & !(KA,IA,JA)
2114  qtrc(:,:,:,qs_mp:qs_mp+nestqa-1), & !(KA,IA,JA,QA)
2115  dummy_d(:,:,:,1), & !(KA,IA,JA)
2116  dummy_d(:,:,:,1), & !(KA,IA,JA)
2117  dummy_d(:,:,:,1), & !(KA,IA,JA)
2118  dummy_d(:,:,:,1), & !(KA,IA,JA)
2119  dummy_d(:,:,:,1), & !(KA,IA,JA)
2120  dummy_d(:,:,:,1:nestqa) ) !(KA,IA,JA,QA)
2121 
2122  return
2123  end subroutine atmos_boundary_send
2124 
2125  !-----------------------------------------------------------------------------
2127  subroutine atmos_boundary_recv( &
2128  ref_idx )
2129  use scale_grid_nest, only: &
2130  online_boundary_diagqnum, &
2131  nest_comm_nestdown, &
2132  parent_ka, &
2133  parent_ia, &
2134  parent_ja, &
2135  nestqa => nest_bnd_qa
2136  use scale_atmos_hydrometeor, only: &
2137  atmos_hydrometeor_diagnose_number_concentration
2138  use scale_atmos_phy_mp, only: &
2139  qa_mp
2140  implicit none
2141 
2142  ! parameters
2143  integer, parameter :: handle = 2
2144 
2145  ! arguments
2146  integer, intent(in) :: ref_idx
2147 
2148  ! works
2149  real(RP) :: dummy_p( parent_ka(handle), parent_ia(handle), parent_ja(handle), nestqa )
2150  !---------------------------------------------------------------------------
2151 
2152 !OCL XFILL
2153  dummy_p(:,:,:,:) = 0.0_rp
2154 
2155  call nest_comm_nestdown( handle, &
2156  nestqa, &
2157  dummy_p(:,:,:,1), & !(KA,IA,JA)
2158  dummy_p(:,:,:,1), & !(KA,IA,JA)
2159  dummy_p(:,:,:,1), & !(KA,IA,JA)
2160  dummy_p(:,:,:,1), & !(KA,IA,JA)
2161  dummy_p(:,:,:,1), & !(KA,IA,JA)
2162  dummy_p(:,:,:,1:nestqa), & !(KA,IA,JA,QA)
2163  atmos_boundary_ref_dens(:,:,:,ref_idx), & !(KA,IA,JA)
2164  atmos_boundary_ref_velz(:,:,:,ref_idx), & !(KA,IA,JA)
2165  atmos_boundary_ref_velx(:,:,:,ref_idx), & !(KA,IA,JA)
2166  atmos_boundary_ref_vely(:,:,:,ref_idx), & !(KA,IA,JA)
2167  atmos_boundary_ref_pott(:,:,:,ref_idx), & !(KA,IA,JA)
2168  atmos_boundary_ref_qtrc(:,:,:,1:nestqa,ref_idx) ) !(KA,IA,JA,QA)
2169 
2170  if ( online_boundary_diagqnum .AND. qa_mp == 11 ) then
2171  call atmos_hydrometeor_diagnose_number_concentration( atmos_boundary_ref_qtrc(:,:,:,:,ref_idx) ) ! [INOUT]
2172  endif
2173 
2174  return
2175  end subroutine atmos_boundary_recv
2176 
2177  !-----------------------------------------------------------------------------
2179  subroutine get_boundary_same_parent( &
2180  bnd_DENS, &
2181  bnd_VELZ, &
2182  bnd_VELX, &
2183  bnd_VELY, &
2184  bnd_POTT, &
2185  bnd_QTRC, &
2186  now_step, &
2187  update_step )
2188  implicit none
2189 
2190  ! arguments
2191  real(RP), intent(out) :: bnd_dens(:,:,:)
2192  real(RP), intent(out) :: bnd_velz(:,:,:)
2193  real(RP), intent(out) :: bnd_velx(:,:,:)
2194  real(RP), intent(out) :: bnd_vely(:,:,:)
2195  real(RP), intent(out) :: bnd_pott(:,:,:)
2196  real(RP), intent(out) :: bnd_qtrc(:,:,:,:)
2197  integer, intent(in) :: now_step
2198  integer, intent(in) :: update_step
2199 
2200  ! works
2201  integer :: i, j, k, iq
2202  integer :: ref
2203  !---------------------------------------------------------------------------
2204 
2205  if ( now_step == update_step ) then
2206  ref = ref_new
2207  else
2208  ref = ref_now
2209  end if
2210 
2211  do j = 1, ja
2212  do i = 1, ia
2213  do k = 1, ka
2214  bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref)
2215  bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref)
2216  bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref)
2217  bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref)
2218  bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref)
2219  do iq = 1, bnd_qa
2220  bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref)
2221  end do
2222  end do
2223  end do
2224  end do
2225 
2226  return
2227  end subroutine get_boundary_same_parent
2228 
2229  !-----------------------------------------------------------------------------
2231  subroutine get_boundary_nearest_neighbor( &
2232  bnd_DENS, &
2233  bnd_VELZ, &
2234  bnd_VELX, &
2235  bnd_VELY, &
2236  bnd_POTT, &
2237  bnd_QTRC, &
2238  now_step, &
2239  update_step )
2240  implicit none
2241 
2242  ! parameters
2243  real(RP) :: eps = 1.0e-4_rp
2244 
2245  ! arguments
2246  real(RP), intent(out) :: bnd_dens(:,:,:)
2247  real(RP), intent(out) :: bnd_velz(:,:,:)
2248  real(RP), intent(out) :: bnd_velx(:,:,:)
2249  real(RP), intent(out) :: bnd_vely(:,:,:)
2250  real(RP), intent(out) :: bnd_pott(:,:,:)
2251  real(RP), intent(out) :: bnd_qtrc(:,:,:,:)
2252  integer, intent(in) :: now_step
2253  integer, intent(in) :: update_step
2254 
2255  ! works
2256  integer :: i, j, k, iq
2257  integer :: ref_idx
2258 
2259  real(RP) :: real_nstep
2260  real(RP) :: half_nstep
2261  !---------------------------------------------------------------------------
2262 
2263  real_nstep = real( now_step, kind=rp )
2264  half_nstep = real( UPDATE_NSTEP, kind=RP ) * 0.5_rp
2265 
2266  ! this step before half of the parent step
2267  if( ( real_nstep - eps ) < half_nstep ) then
2268  ref_idx = ref_now
2269 
2270  ! this step after half of the parent step
2271  else if( ( real_nstep - 1.0_rp + eps ) > half_nstep ) then
2272  ref_idx = ref_new
2273 
2274  ! this step across half of the parent step
2275  else
2276  ref_idx = ref_now
2277 
2278  end if
2279 
2280  do j = 1, ja
2281  do i = 1, ia
2282  do k = 1, ka
2283  bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_idx)
2284  bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_idx)
2285  bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_idx)
2286  bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_idx)
2287  bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_idx)
2288  do iq = 1, bnd_qa
2289  bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_idx)
2290  end do
2291  end do
2292  end do
2293  end do
2294 
2295  return
2296  end subroutine get_boundary_nearest_neighbor
2297 
2298  !-----------------------------------------------------------------------------
2300  subroutine get_boundary_lerp_initpoint( &
2301  bnd_DENS, &
2302  bnd_VELZ, &
2303  bnd_VELX, &
2304  bnd_VELY, &
2305  bnd_POTT, &
2306  bnd_QTRC, &
2307  now_step, &
2308  update_step )
2309  implicit none
2310 
2311  ! arguments
2312  real(RP), intent(out) :: bnd_dens(:,:,:)
2313  real(RP), intent(out) :: bnd_velz(:,:,:)
2314  real(RP), intent(out) :: bnd_velx(:,:,:)
2315  real(RP), intent(out) :: bnd_vely(:,:,:)
2316  real(RP), intent(out) :: bnd_pott(:,:,:)
2317  real(RP), intent(out) :: bnd_qtrc(:,:,:,:)
2318  integer, intent(in) :: now_step
2319  integer, intent(in) :: update_step
2320 
2321  ! works
2322  integer :: i, j, k, iq
2323 
2324  real(RP) :: fact
2325  !---------------------------------------------------------------------------
2326 
2327  fact = REAL(now_step, kind=RP) / update_step
2328 
2329  !$omp parallel do default(none) private(i,j,k,iq) OMP_SCHEDULE_ collapse(2) &
2330  !$omp shared(JA,IA,KA,bnd_DENS,ATMOS_BOUNDARY_ref_DENS,ref_now,fact,ref_new,bnd_VELZ) &
2331  !$omp shared(ATMOS_BOUNDARY_ref_VELZ,bnd_VELX,ATMOS_BOUNDARY_ref_VELX,bnd_VELY) &
2332  !$omp shared(ATMOS_BOUNDARY_ref_VELY,bnd_POTT,ATMOS_BOUNDARY_ref_POTT,BND_QA,bnd_QTRC,ATMOS_BOUNDARY_ref_QTRC)
2333  do j = 1, ja
2334  do i = 1, ia
2335  do k = 1, ka
2336  bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_now) * ( 1.0_rp-fact ) &
2337  + atmos_boundary_ref_dens(k,i,j,ref_new) * fact
2338  bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_now) * ( 1.0_rp-fact ) &
2339  + atmos_boundary_ref_velz(k,i,j,ref_new) * fact
2340  bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_now) * ( 1.0_rp-fact) &
2341  + atmos_boundary_ref_velx(k,i,j,ref_new) * fact
2342  bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_now) * ( 1.0_rp-fact) &
2343  + atmos_boundary_ref_vely(k,i,j,ref_new) * fact
2344  bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_now) * ( 1.0_rp-fact ) &
2345  + atmos_boundary_ref_pott(k,i,j,ref_new) * fact
2346  do iq = 1, bnd_qa
2347  bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now) * ( 1.0_rp-fact ) &
2348  + atmos_boundary_ref_qtrc(k,i,j,iq,ref_new) * fact
2349  end do
2350  end do
2351  end do
2352  end do
2353 
2354  return
2355  end subroutine get_boundary_lerp_initpoint
2356 
2357  !-----------------------------------------------------------------------------
2359  subroutine get_boundary_lerp_midpoint( &
2360  bnd_DENS, &
2361  bnd_VELZ, &
2362  bnd_VELX, &
2363  bnd_VELY, &
2364  bnd_POTT, &
2365  bnd_QTRC, &
2366  now_step, &
2367  update_step )
2368  use scale_time, only: &
2369  time_dtsec
2370  implicit none
2371 
2372  ! parameters
2373  real(RP) :: eps = 1.0e-4_rp
2374 
2375  ! arguments
2376  real(RP), intent(out) :: bnd_dens(:,:,:)
2377  real(RP), intent(out) :: bnd_velz(:,:,:)
2378  real(RP), intent(out) :: bnd_velx(:,:,:)
2379  real(RP), intent(out) :: bnd_vely(:,:,:)
2380  real(RP), intent(out) :: bnd_pott(:,:,:)
2381  real(RP), intent(out) :: bnd_qtrc(:,:,:,:)
2382  integer, intent(in) :: now_step
2383  integer, intent(in) :: update_step
2384 
2385  ! works
2386  integer :: i, j, k, iq
2387 
2388  real(RP) :: real_nstep
2389  real(RP) :: half_nstep
2390  real(RP) :: t1, t2
2391  !---------------------------------------------------------------------------
2392 
2393  real_nstep = real( now_step, kind=rp )
2394  half_nstep = real( UPDATE_NSTEP, kind=RP ) * 0.5_rp
2395 
2396  ! this step before half of the parent step
2397  if( ( real_nstep - eps ) < half_nstep ) then
2398 
2399  t1 = time_dtsec / atmos_boundary_update_dt * ( real_nstep + half_nstep - 0.5_rp )
2400 
2401  do j = 1, ja
2402  do i = 1, ia
2403  do k = 1, ka
2404  bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_now) * t1 &
2405  - atmos_boundary_ref_dens(k,i,j,ref_old) * ( t1 - 1.0_rp )
2406  bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_now) * t1 &
2407  - atmos_boundary_ref_velz(k,i,j,ref_old) * ( t1 - 1.0_rp )
2408  bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_now) * t1 &
2409  - atmos_boundary_ref_velx(k,i,j,ref_old) * ( t1 - 1.0_rp )
2410  bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_now) * t1 &
2411  - atmos_boundary_ref_vely(k,i,j,ref_old) * ( t1 - 1.0_rp )
2412  bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_now) * t1 &
2413  - atmos_boundary_ref_pott(k,i,j,ref_old) * ( t1 - 1.0_rp )
2414  do iq = 1, bnd_qa
2415  bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now) * t1 &
2416  - atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) * ( t1 - 1.0_rp )
2417  end do
2418  end do
2419  end do
2420  end do
2421 
2422  ! this step after half of the parent step
2423  else if( ( real_nstep - 1.0_rp + eps ) > half_nstep ) then
2424 
2425  t1 = time_dtsec / atmos_boundary_update_dt * ( real_nstep - half_nstep - 0.5_rp )
2426 
2427  do j = 1, ja
2428  do i = 1, ia
2429  do k = 1, ka
2430  bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_new) * t1 &
2431  - atmos_boundary_ref_dens(k,i,j,ref_now) * ( t1 - 1.0_rp )
2432  bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_new) * t1 &
2433  - atmos_boundary_ref_velz(k,i,j,ref_now) * ( t1 - 1.0_rp )
2434  bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_new) * t1 &
2435  - atmos_boundary_ref_velx(k,i,j,ref_now) * ( t1 - 1.0_rp )
2436  bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_new) * t1 &
2437  - atmos_boundary_ref_vely(k,i,j,ref_now) * ( t1 - 1.0_rp )
2438  bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_new) * t1 &
2439  - atmos_boundary_ref_pott(k,i,j,ref_now) * ( t1 - 1.0_rp )
2440  do iq = 1, bnd_qa
2441  bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_new) * t1 &
2442  - atmos_boundary_ref_qtrc(k,i,j,iq,ref_now) * ( t1 - 1.0_rp )
2443  end do
2444  end do
2445  end do
2446  end do
2447 
2448  ! this step across half of the parent step
2449  else
2450 
2451  t1 = time_dtsec / atmos_boundary_update_dt * ( real_nstep + half_nstep - 1.0_rp )
2452  t2 = time_dtsec / atmos_boundary_update_dt * ( real_nstep - half_nstep )
2453 
2454  do j = 1, ja
2455  do i = 1, ia
2456  do k = 1, ka
2457  bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_new) * t2 * 0.25_rp &
2458  + atmos_boundary_ref_dens(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2459  - atmos_boundary_ref_dens(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2460  bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_new) * t2 * 0.25_rp &
2461  + atmos_boundary_ref_velz(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2462  - atmos_boundary_ref_velz(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2463  bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_new) * t2 * 0.25_rp &
2464  + atmos_boundary_ref_velx(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2465  - atmos_boundary_ref_velx(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2466  bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_new) * t2 * 0.25_rp &
2467  + atmos_boundary_ref_vely(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2468  - atmos_boundary_ref_vely(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2469  bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_new) * t2 * 0.25_rp &
2470  + atmos_boundary_ref_pott(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2471  - atmos_boundary_ref_pott(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2472  do iq = 1, bnd_qa
2473  bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_new) * t2 * 0.25_rp &
2474  + atmos_boundary_ref_qtrc(k,i,j,iq,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2475  - atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) * ( t1 - 1.0_rp )
2476  end do
2477  end do
2478  end do
2479  end do
2480 
2481  end if
2482 
2483  return
2484  end subroutine get_boundary_lerp_midpoint
2485 
2486  !-----------------------------------------------------------------------------
2488  subroutine update_ref_index
2489  implicit none
2490 
2491  ! works
2492  integer :: ref_tmp
2493  !---------------------------------------------------------------------------
2494 
2495  ref_tmp = ref_old
2496  ref_old = ref_now
2497  ref_now = ref_new
2498  ref_new = ref_tmp
2499 
2500  return
2501  end subroutine update_ref_index
2502 
2503  subroutine history_bnd( &
2504  ATMOS_BOUNDARY_DENS, &
2505  ATMOS_BOUNDARY_VELZ, &
2506  ATMOS_BOUNDARY_VELX, &
2507  ATMOS_BOUNDARY_VELY, &
2508  ATMOS_BOUNDARY_POTT, &
2509  ATMOS_BOUNDARY_QTRC )
2510  use scale_atmos_phy_mp, only: &
2511  aq_name => atmos_phy_mp_name
2512  use scale_history, only: &
2513  hist_in
2514  implicit none
2515  real(RP), intent(in) :: ATMOS_BOUNDARY_DENS(KA,IA,JA)
2516  real(RP), intent(in) :: ATMOS_BOUNDARY_VELZ(KA,IA,JA)
2517  real(RP), intent(in) :: ATMOS_BOUNDARY_VELX(KA,IA,JA)
2518  real(RP), intent(in) :: ATMOS_BOUNDARY_VELY(KA,IA,JA)
2519  real(RP), intent(in) :: ATMOS_BOUNDARY_POTT(KA,IA,JA)
2520  real(RP), intent(in) :: ATMOS_BOUNDARY_QTRC(KA,IA,JA,BND_QA)
2521 
2522  integer :: iq
2523 
2524  call hist_in( atmos_boundary_dens(:,:,:), 'DENS_BND', 'Boundary Density', 'kg/m3' )
2525  call hist_in( atmos_boundary_velz(:,:,:), 'VELZ_BND', 'Boundary velocity z-direction', 'm/s', zdim='half' )
2526  call hist_in( atmos_boundary_velx(:,:,:), 'VELX_BND', 'Boundary velocity x-direction', 'm/s', xdim='half' )
2527  call hist_in( atmos_boundary_vely(:,:,:), 'VELY_BND', 'Boundary velocity y-direction', 'm/s', ydim='half' )
2528  call hist_in( atmos_boundary_pott(:,:,:), 'POTT_BND', 'Boundary potential temperature', 'K' )
2529  do iq = 1, bnd_qa
2530  call hist_in( atmos_boundary_qtrc(:,:,:,iq), trim(aq_name(iq))//'_BND', 'Boundary '//trim(aq_name(iq)), 'kg/kg' )
2531  enddo
2532 
2533  return
2534  end subroutine history_bnd
2535 
2536 end module scale_atmos_boundary
scale_atmos_boundary::atmos_boundary_velx
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_velx
Definition: scale_atmos_sub_boundary.F90:56
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_nest::parent_ka
integer, dimension(2), public parent_ka
parent max number in z-direction (with halo)
Definition: scale_grid_nest.F90:67
scale_grid_nest::daughter_ka
integer, dimension(2), public daughter_ka
daughter max number in z-direction (with halo)
Definition: scale_grid_nest.F90:77
gtool_file
module GTOOL_FILE
Definition: gtool_file.f90:17
scale_atmos_boundary::atmos_boundary_velz
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_velz
Definition: scale_atmos_sub_boundary.F90:55
scale_grid_nest::parent_dtsec
real(dp), dimension(2), public parent_dtsec
parent DT [sec]
Definition: scale_grid_nest.F90:71
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_rm_process::prc_has_n
logical, public prc_has_n
Definition: scale_rm_process.F90:50
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:267
scale_calendar::calendar_combine_daysec
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
Definition: scale_calendar.F90:347
scale_grid_index::jeb
integer, public jeb
Definition: scale_grid_index.F90:74
scale_atmos_boundary::atmos_boundary_resume_online
subroutine atmos_boundary_resume_online
Resume boundary value for real case experiment [online daughter].
Definition: scale_atmos_sub_boundary.F90:1448
scale_grid_nest
module GRID (nesting system)
Definition: scale_grid_nest.F90:15
scale_calendar::calendar_date2char
subroutine, public calendar_date2char(chardate, ymdhms, subsec)
Convert from gregorian date to absolute day/second.
Definition: scale_calendar.F90:512
scale_atmos_boundary::atmos_boundary_resume
subroutine, public atmos_boundary_resume(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
Resume.
Definition: scale_atmos_sub_boundary.F90:481
scale_time::time_nstep
integer, public time_nstep
total steps [number]
Definition: scale_time.F90:71
scale_stdio::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:61
scale_grid_nest::online_iam_daughter
logical, public online_iam_daughter
a flag to say "I am a daughter"
Definition: scale_grid_nest.F90:109
scale_atmos_boundary::update_ref_index
subroutine update_ref_index
Update indices of array of boundary references.
Definition: scale_atmos_sub_boundary.F90:2489
scale_fileio::fileio_flush
subroutine, public fileio_flush(fid)
Flush all pending requests to a netCDF file (PnetCDF only)
Definition: scale_fileio.F90:1542
scale_atmos_phy_mp
module ATMOSPHERE / Physics Cloud Microphysics
Definition: scale_atmos_phy_mp.F90:17
scale_atmos_refstate
module ATMOSPHERE / Reference state
Definition: scale_atmos_sub_refstate.F90:16
scale_atmos_boundary::atmos_boundary_alpha_pott
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_pott
Definition: scale_atmos_sub_boundary.F90:65
scale_grid::grid_fbfy
real(rp), dimension(:), allocatable, public grid_fbfy
face buffer factor (0-1): y
Definition: scale_grid_cartesian.F90:81
scale_grid_nest::offline
logical, public offline
Definition: scale_grid_nest.F90:107
scale_rm_process::prc_has_e
logical, public prc_has_e
Definition: scale_rm_process.F90:51
scale_stdio
module STDIO
Definition: scale_stdio.F90:12
scale_grid_nest::parent_nstep
integer, dimension(2), public parent_nstep
parent step [number]
Definition: scale_grid_nest.F90:72
scale_grid_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_grid_index.F90:59
scale_atmos_boundary::dens
real(rp), dimension(0-1), allocatable, public dens
Definition: scale_atmos_sub_boundary.F90:54
scale_atmos_boundary::atmos_boundary_update
subroutine, public atmos_boundary_update(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
Update boundary value with a constant time boundary.
Definition: scale_atmos_sub_boundary.F90:1597
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:35
scale_atmos_boundary::atmos_boundary_setup
subroutine, public atmos_boundary_setup
Setup.
Definition: scale_atmos_sub_boundary.F90:203
scale_grid_nest::nest_bnd_qa
integer, public nest_bnd_qa
number of tracer treated in nesting system
Definition: scale_grid_nest.F90:102
scale_grid_nest::nest_comm_nestdown
subroutine, public nest_comm_nestdown(HANDLE, BND_QA, ipt_DENS, ipt_MOMZ, ipt_MOMX, ipt_MOMY, ipt_RHOT, ipt_QTRC, interped_ref_DENS, interped_ref_VELZ, interped_ref_VELX, interped_ref_VELY, interped_ref_POTT, interped_ref_QTRC)
Boundary data transfer from parent to daughter: nestdown.
Definition: scale_grid_nest.F90:1695
scale_atmos_hydrometeor::atmos_hydrometeor_diagnose_number_concentration
subroutine, public atmos_hydrometeor_diagnose_number_concentration(QTRC)
Definition: scale_atmos_sub_hydrometeor.F90:808
scale_atmos_phy_mp::atmos_phy_mp_name
character(len=h_short), dimension(:), pointer, public atmos_phy_mp_name
Definition: scale_atmos_phy_mp.F90:118
scale_atmos_boundary::atmos_boundary_firstsend
subroutine, public atmos_boundary_firstsend(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
First send boundary value.
Definition: scale_atmos_sub_boundary.F90:1540
scale_fileio
module FILE I/O (netcdf)
Definition: scale_fileio.F90:14
scale_rm_process::prc_has_s
logical, public prc_has_s
Definition: scale_rm_process.F90:52
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_atmos_boundary::atmos_boundary_alpha_velz
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_velz
Definition: scale_atmos_sub_boundary.F90:62
scale_grid_index::ieb
integer, public ieb
Definition: scale_grid_index.F90:72
scale_atmos_boundary::qtrc
real(rp), dimension(0-1), allocatable, public qtrc
Definition: scale_atmos_sub_boundary.F90:59
scale_atmos_boundary::atmos_boundary_alpha_vely
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_vely
Definition: scale_atmos_sub_boundary.F90:64
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_atmos_boundary::atmos_boundary_finalize
subroutine, public atmos_boundary_finalize
Finalize boundary value.
Definition: scale_atmos_sub_boundary.F90:1563
scale_stdio::io_nml
logical, public io_nml
output log or not? (for namelist, this process)
Definition: scale_stdio.F90:62
scale_atmos_boundary::atmos_boundary_qtrc
real(rp), dimension(:,:,:,:), allocatable, public atmos_boundary_qtrc
Definition: scale_atmos_sub_boundary.F90:59
scale_tracer
module TRACER
Definition: scale_tracer.F90:15
scale_index
module Index
Definition: scale_index.F90:14
scale_grid_index::ia
integer, public ia
of whole cells: x, local, with HALO
Definition: scale_grid_index.F90:55
scale_grid_nest::daughter_ia
integer, dimension(2), public daughter_ia
daughter max number in x-direction (with halo)
Definition: scale_grid_nest.F90:78
scale_atmos_hydrometeor
module Hydrometeor
Definition: scale_atmos_sub_hydrometeor.F90:14
scale_grid::grid_fbfx
real(rp), dimension(:), allocatable, public grid_fbfx
face buffer factor (0-1): x
Definition: scale_grid_cartesian.F90:80
scale_time::time_dtsec
real(dp), public time_dtsec
time interval of model [sec]
Definition: scale_time.F90:36
scale_atmos_boundary::atmos_boundary_vely
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_vely
Definition: scale_atmos_sub_boundary.F90:57
scale_grid_index::ka
integer, public ka
of whole cells: z, local, with HALO
Definition: scale_grid_index.F90:54
scale_atmos_refstate::atmos_refstate_dens
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_dens
refernce density [kg/m3]
Definition: scale_atmos_sub_refstate.F90:47
scale_grid::grid_fbfz
real(rp), dimension(:), allocatable, public grid_fbfz
face buffer factor (0-1): z
Definition: scale_grid_cartesian.F90:79
scale_grid_nest::online_boundary_diagqnum
logical, public online_boundary_diagqnum
Definition: scale_grid_nest.F90:114
scale_comm
module COMMUNICATION
Definition: scale_comm.F90:23
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_grid::grid_cbfx
real(rp), dimension(:), allocatable, public grid_cbfx
center buffer factor (0-1): x
Definition: scale_grid_cartesian.F90:77
scale_time
module TIME
Definition: scale_time.F90:15
scale_grid_nest::parent_ja
integer, dimension(2), public parent_ja
parent max number in y-direction (with halo)
Definition: scale_grid_nest.F90:69
scale_atmos_phy_mp::qa_mp
integer, public qa_mp
Definition: scale_atmos_phy_mp.F90:114
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_atmos_phy_mp::atmos_phy_mp_unit
character(len=h_short), dimension(:), pointer, public atmos_phy_mp_unit
Definition: scale_atmos_phy_mp.F90:120
scale_comm::comm_fill_bnd
logical, public comm_fill_bnd
switch whether fill boundary data
Definition: scale_comm.F90:119
scale_grid_nest::daughter_ja
integer, dimension(2), public daughter_ja
daughter max number in y-direction (with halo)
Definition: scale_grid_nest.F90:79
scale_grid_nest::nest_comm_recv_cancel
subroutine, public nest_comm_recv_cancel(HANDLE)
Sub-command for data transfer from parent to daughter: nestdown.
Definition: scale_grid_nest.F90:2145
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_grid_nest::parent_ia
integer, dimension(2), public parent_ia
parent max number in x-direction (with halo)
Definition: scale_grid_nest.F90:68
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_grid::grid_cbfz
real(rp), dimension(:), allocatable, public grid_cbfz
center buffer factor (0-1): z
Definition: scale_grid_cartesian.F90:76
scale_grid_nest::use_nesting
logical, public use_nesting
Definition: scale_grid_nest.F90:106
scale_atmos_boundary::atmos_boundary_update_flag
logical, public atmos_boundary_update_flag
Definition: scale_atmos_sub_boundary.F90:71
scale_atmos_boundary::bnd_qa
integer, public bnd_qa
Definition: scale_atmos_sub_boundary.F90:52
scale_grid_nest::nest_comm_recvwait_issue
subroutine, public nest_comm_recvwait_issue(HANDLE, BND_QA)
Sub-command for data transfer from parent to daughter: nestdown.
Definition: scale_grid_nest.F90:2045
scale_grid
module GRID (cartesian)
Definition: scale_grid_cartesian.F90:17
scale_atmos_boundary::atmos_boundary_alpha_dens
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_dens
Definition: scale_atmos_sub_boundary.F90:61
scale_rm_process
module RM PROCESS
Definition: scale_rm_process.F90:10
scale_atmos_boundary::atmos_boundary_dens
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_dens
Definition: scale_atmos_sub_boundary.F90:54
scale_prof
module profiler
Definition: scale_prof.F90:10
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:36
scale_atmos_boundary::atmos_boundary_resume_file
subroutine atmos_boundary_resume_file
Resume boundary value for real case experiment.
Definition: scale_atmos_sub_boundary.F90:1272
scale_grid_nest::online_iam_parent
logical, public online_iam_parent
a flag to say "I am a parent"
Definition: scale_grid_nest.F90:108
scale_fileio::fileio_open
subroutine, public fileio_open(fid, basename)
open a netCDF file for read
Definition: scale_fileio.F90:1326
scale_precision
module PRECISION
Definition: scale_precision.F90:13
gtool_file_h::file_real4
integer, parameter, public file_real4
Definition: gtool_file_h.f90:43
scale_atmos_boundary
module ATMOSPHERE / Boundary treatment
Definition: scale_atmos_sub_boundary.F90:20
scale_grid::grid_cbfy
real(rp), dimension(:), allocatable, public grid_cbfy
center buffer factor (0-1): y
Definition: scale_grid_cartesian.F90:78
scale_atmos_boundary::atmos_boundary_pott
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_pott
Definition: scale_atmos_sub_boundary.F90:58
scale_history
module HISTORY
Definition: scale_history.F90:16
scale_grid_nest::online_use_velz
logical, public online_use_velz
Definition: scale_grid_nest.F90:111
scale_grid_index::isb
integer, public isb
Definition: scale_grid_index.F90:71
scale_const::const_pi
real(rp), public const_pi
pi
Definition: scale_const.F90:34
scale_calendar
module CALENDAR
Definition: scale_calendar.F90:15
scale_time::time_nowdate
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
Definition: scale_time.F90:65
scale_fileio::fileio_close
subroutine, public fileio_close(fid)
Close a netCDF file.
Definition: scale_fileio.F90:1564
gtool_file_h
module FILE I/O HEADER
Definition: gtool_file_h.f90:14
scale_stdio::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
scale_atmos_phy_mp::qs_mp
integer, public qs_mp
Definition: scale_atmos_phy_mp.F90:115
scale_stdio::io_fid_log
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
scale_grid_index::jsb
integer, public jsb
Definition: scale_grid_index.F90:73
scale_rm_process::prc_has_w
logical, public prc_has_w
Definition: scale_rm_process.F90:49
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:43
scale_atmos_boundary::atmos_boundary_alpha_velx
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_velx
Definition: scale_atmos_sub_boundary.F90:63
scale_calendar::calendar_date2daysec
subroutine, public calendar_date2daysec(absday, abssec, ymdhms, subsec, offset_year)
Convert from gregorian date to absolute day/second.
Definition: scale_calendar.F90:117
scale_stdio::io_fid_nml
integer, public io_fid_nml
Log file ID (only for output namelist)
Definition: scale_stdio.F90:57
gtool_file_h::file_real8
integer, parameter, public file_real8
Definition: gtool_file_h.f90:44
scale_atmos_boundary::atmos_boundary_alpha_qtrc
real(rp), dimension(:,:,:,:), allocatable, public atmos_boundary_alpha_qtrc
Definition: scale_atmos_sub_boundary.F90:66
scale_atmos_boundary::atmos_boundary_smoother_fact
real(rp), public atmos_boundary_smoother_fact
Definition: scale_atmos_sub_boundary.F90:69
scale_grid_nest::nest_comm_test
subroutine, public nest_comm_test(HANDLE)
[check communication status] Inter-communication
Definition: scale_grid_nest.F90:2580
scale_grid_index::ja
integer, public ja
of whole cells: y, local, with HALO
Definition: scale_grid_index.F90:56
Generated by   doxygen 1.8.14