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