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
105 real(RP),
intent(out) :: bnd_dens(:,:,:)
106 real(RP),
intent(out) :: bnd_velz(:,:,:)
107 real(RP),
intent(out) :: bnd_velx(:,:,:)
108 real(RP),
intent(out) :: bnd_vely(:,:,:)
109 real(RP),
intent(out) :: bnd_pott(:,:,:)
110 real(RP),
intent(out) :: bnd_qtrc(:,:,:,:)
111 integer,
intent(in) :: now_step
112 integer,
intent(in) :: update_step
113 end subroutine getbnd
116 procedure(getbnd),
pointer :: get_boundary => null()
117 private :: get_boundary
118 private :: get_boundary_same_parent
119 private :: get_boundary_nearest_neighbor
120 private :: get_boundary_lerp_initpoint
121 private :: get_boundary_lerp_midpoint
128 character(len=H_LONG),
private :: atmos_boundary_type =
'NONE' 129 character(len=H_LONG),
private :: atmos_boundary_in_basename =
'' 130 character(len=H_LONG),
private :: atmos_boundary_out_basename =
'' 131 character(len=H_MID),
private :: atmos_boundary_out_title =
'SCALE-RM BOUNDARY CONDITION' 132 character(len=H_MID),
private :: atmos_boundary_out_dtype =
'DEFAULT' 134 logical,
private :: atmos_boundary_use_dens = .false.
135 logical,
private :: atmos_boundary_use_velz = .false.
136 logical,
private :: atmos_boundary_use_velx = .false.
137 logical,
private :: atmos_boundary_use_vely = .false.
138 logical,
private :: atmos_boundary_use_pott = .false.
139 logical,
private :: atmos_boundary_use_qv = .false.
140 logical,
private :: atmos_boundary_use_qhyd = .false.
142 real(RP),
private :: atmos_boundary_value_velz = 0.0_rp
143 real(RP),
private :: atmos_boundary_value_velx = 0.0_rp
144 real(RP),
private :: atmos_boundary_value_vely = 0.0_rp
145 real(RP),
private :: atmos_boundary_value_pott = 300.0_rp
146 real(RP),
private :: atmos_boundary_value_qtrc = 0.0_rp
148 real(RP),
private :: atmos_boundary_alphafact_dens = 1.0_rp
149 real(RP),
private :: atmos_boundary_alphafact_velz = 1.0_rp
150 real(RP),
private :: atmos_boundary_alphafact_velx = 1.0_rp
151 real(RP),
private :: atmos_boundary_alphafact_vely = 1.0_rp
152 real(RP),
private :: atmos_boundary_alphafact_pott = 1.0_rp
153 real(RP),
private :: atmos_boundary_alphafact_qtrc = 1.0_rp
155 real(RP),
private :: atmos_boundary_fracz = 1.0_rp
156 real(RP),
private :: atmos_boundary_fracx = 1.0_rp
157 real(RP),
private :: atmos_boundary_fracy = 1.0_rp
158 real(RP),
private :: atmos_boundary_tauz
159 real(RP),
private :: atmos_boundary_taux
160 real(RP),
private :: atmos_boundary_tauy
162 real(DP),
private :: atmos_boundary_update_dt = 0.0_dp
163 integer,
private :: update_nstep
165 real(RP),
private,
allocatable :: atmos_boundary_ref_dens(:,:,:,:)
166 real(RP),
private,
allocatable :: atmos_boundary_ref_velz(:,:,:,:)
167 real(RP),
private,
allocatable :: atmos_boundary_ref_velx(:,:,:,:)
168 real(RP),
private,
allocatable :: atmos_boundary_ref_vely(:,:,:,:)
169 real(RP),
private,
allocatable :: atmos_boundary_ref_pott(:,:,:,:)
170 real(RP),
private,
allocatable :: atmos_boundary_ref_qtrc(:,:,:,:,:)
172 character(len=H_LONG),
private :: atmos_boundary_interp_type =
'lerp_initpoint' 174 integer,
private :: atmos_boundary_start_date(6) = (/ -9999, 0, 0, 0, 0, 0 /)
176 integer,
private :: now_step
177 integer,
private :: boundary_timestep = 0
178 logical,
private :: atmos_boundary_linear_v = .false.
179 logical,
private :: atmos_boundary_linear_h = .true.
180 real(RP),
private :: atmos_boundary_exp_h = 2.0_rp
181 logical,
private :: atmos_boundary_online = .false.
182 logical,
private :: atmos_boundary_online_master = .false.
183 logical,
private :: do_parent_process = .false.
184 logical,
private :: do_daughter_process = .false.
185 logical,
private :: l_bnd = .false.
187 real(DP),
private :: boundary_time_initdaysec
189 integer,
private :: ref_size = 3
190 integer,
private :: ref_old = 1
191 integer,
private :: ref_now = 2
192 integer,
private :: ref_new = 3
214 namelist / param_atmos_boundary / &
215 atmos_boundary_type, &
216 atmos_boundary_in_basename, &
217 atmos_boundary_out_basename, &
218 atmos_boundary_out_title, &
219 atmos_boundary_use_velz, &
220 atmos_boundary_use_velx, &
221 atmos_boundary_use_vely, &
222 atmos_boundary_use_pott, &
223 atmos_boundary_use_dens, &
224 atmos_boundary_use_qv, &
225 atmos_boundary_use_qhyd, &
226 atmos_boundary_value_velz, &
227 atmos_boundary_value_velx, &
228 atmos_boundary_value_vely, &
229 atmos_boundary_value_pott, &
230 atmos_boundary_value_qtrc, &
231 atmos_boundary_alphafact_dens, &
232 atmos_boundary_alphafact_velz, &
233 atmos_boundary_alphafact_velx, &
234 atmos_boundary_alphafact_vely, &
235 atmos_boundary_alphafact_pott, &
236 atmos_boundary_alphafact_qtrc, &
238 atmos_boundary_fracz, &
239 atmos_boundary_fracx, &
240 atmos_boundary_fracy, &
241 atmos_boundary_tauz, &
242 atmos_boundary_taux, &
243 atmos_boundary_tauy, &
244 atmos_boundary_update_dt, &
245 atmos_boundary_start_date, &
246 atmos_boundary_linear_v, &
247 atmos_boundary_linear_h, &
248 atmos_boundary_exp_h, &
249 atmos_boundary_interp_type
255 if(
io_l )
write(
io_fid_log,*)
'+++ Module[Boundary]/Categ[ATMOS]' 257 atmos_boundary_tauz = dt * 10.0_rp
258 atmos_boundary_taux = dt * 10.0_rp
259 atmos_boundary_tauy = dt * 10.0_rp
263 read(
io_fid_conf,nml=param_atmos_boundary,iostat=ierr)
265 if(
io_l )
write(
io_fid_log,*)
'*** Not found namelist. Default used.' 266 elseif( ierr > 0 )
then 267 write(*,*)
'xxx Not appropriate names in namelist PARAM_ATMOS_BOUNDARY. Check!' 274 atmos_boundary_online = .false.
277 atmos_boundary_online = .false.
279 atmos_boundary_online = .true.
282 do_parent_process = .false.
283 do_daughter_process = .false.
284 atmos_boundary_online_master = .false.
285 if ( atmos_boundary_online )
then 287 do_parent_process = .true.
289 atmos_boundary_online_master = .true.
293 do_daughter_process = .true.
297 if( atmos_boundary_use_qhyd )
then 329 if ( atmos_boundary_type ==
'REAL' .OR. do_daughter_process )
then 337 select case(atmos_boundary_interp_type)
339 get_boundary => get_boundary_same_parent
340 case (
'nearest_neighbor')
341 get_boundary => get_boundary_nearest_neighbor
342 case (
'lerp_initpoint')
343 get_boundary => get_boundary_lerp_initpoint
344 case (
'lerp_midpoint')
345 get_boundary => get_boundary_lerp_midpoint
347 write(*,*)
'xxx Wrong parameter in ATMOS_BOUNDARY_interp_TYPE. Check!' 353 allocate( atmos_boundary_ref_dens(
ka,
ia,
ja,ref_size) )
354 allocate( atmos_boundary_ref_velz(
ka,
ia,
ja,ref_size) )
355 allocate( atmos_boundary_ref_velx(
ka,
ia,
ja,ref_size) )
356 allocate( atmos_boundary_ref_vely(
ka,
ia,
ja,ref_size) )
357 allocate( atmos_boundary_ref_pott(
ka,
ia,
ja,ref_size) )
358 allocate( atmos_boundary_ref_qtrc(
ka,
ia,
ja,
bnd_qa,ref_size) )
367 if ( do_daughter_process )
then 368 call atmos_boundary_initialize_online
370 if ( atmos_boundary_in_basename /=
'' )
then 371 call atmos_boundary_initialize_file
373 write(*,*)
'xxx You need specify ATMOS_BOUNDARY_IN_BASENAME' 378 call atmos_boundary_setalpha
382 elseif ( atmos_boundary_type ==
'CONST' )
then 384 call atmos_boundary_generate
386 call atmos_boundary_setalpha
390 elseif ( atmos_boundary_type ==
'INIT' )
then 392 call atmos_boundary_setalpha
396 elseif ( atmos_boundary_type ==
'FILE' )
then 398 if ( atmos_boundary_in_basename /=
'' )
then 399 call atmos_boundary_read
401 write(*,*)
'xxx You need specify ATMOS_BOUNDARY_IN_BASENAME' 408 write(*,*)
'xxx unsupported ATMOS_BOUNDARY_TYPE. Check!', trim(atmos_boundary_type)
416 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary parameters' 417 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary type : ', atmos_boundary_type
419 if(
io_l )
write(
io_fid_log,*)
'*** is VELZ used in atmospheric boundary? : ', atmos_boundary_use_velz
420 if(
io_l )
write(
io_fid_log,*)
'*** is VELX used in atmospheric boundary? : ', atmos_boundary_use_velx
421 if(
io_l )
write(
io_fid_log,*)
'*** is VELY used in atmospheric boundary? : ', atmos_boundary_use_vely
422 if(
io_l )
write(
io_fid_log,*)
'*** is POTT used in atmospheric boundary? : ', atmos_boundary_use_pott
423 if(
io_l )
write(
io_fid_log,*)
'*** is DENS used in atmospheric boundary? : ', atmos_boundary_use_dens
424 if(
io_l )
write(
io_fid_log,*)
'*** is QV used in atmospheric boundary? : ', atmos_boundary_use_qv
425 if(
io_l )
write(
io_fid_log,*)
'*** is QHYD used in atmospheric boundary? : ', atmos_boundary_use_qhyd
427 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary VELZ values : ', atmos_boundary_value_velz
428 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary VELX values : ', atmos_boundary_value_velx
429 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary VELY values : ', atmos_boundary_value_vely
430 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary POTT values : ', atmos_boundary_value_pott
431 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary QTRC values : ', atmos_boundary_value_qtrc
434 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary z-fraction : ', atmos_boundary_fracz
435 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary x-fraction : ', atmos_boundary_fracx
436 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary y-fraction : ', atmos_boundary_fracy
437 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary z-relaxation time : ', atmos_boundary_tauz
438 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary x-relaxation time : ', atmos_boundary_taux
439 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary y-relaxation time : ', atmos_boundary_tauy
441 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary update dt : ', atmos_boundary_update_dt
442 if(
io_l )
write(
io_fid_log,*)
'*** atmospheric boundary start date : ', atmos_boundary_start_date(:)
444 if(
io_l )
write(
io_fid_log,*)
'*** linear profile in vertically relax region : ', atmos_boundary_linear_v
445 if(
io_l )
write(
io_fid_log,*)
'*** linear profile in horizontally relax region : ', atmos_boundary_linear_h
446 if(
io_l )
write(
io_fid_log,*)
'*** non-linear factor in horizontally relax region : ', atmos_boundary_exp_h
448 if(
io_l )
write(
io_fid_log,*)
'*** online nesting for lateral boundary : ', atmos_boundary_online
450 if(
io_l )
write(
io_fid_log,*)
'*** does lateral boundary exist in this domain? : ', l_bnd
452 if(
io_l )
write(
io_fid_log,*)
'*** lateral boundary interporation type : ', atmos_boundary_interp_type
469 real(RP),
intent(in) :: DENS(
ka,
ia,
ja)
470 real(RP),
intent(in) :: MOMZ(
ka,
ia,
ja)
471 real(RP),
intent(in) :: MOMX(
ka,
ia,
ja)
472 real(RP),
intent(in) :: MOMY(
ka,
ia,
ja)
473 real(RP),
intent(in) :: RHOT(
ka,
ia,
ja)
474 real(RP),
intent(in) :: QTRC(
ka,
ia,
ja,
qa)
478 dens, momz, momx, momy, rhot, qtrc )
483 if ( do_daughter_process )
then 486 if ( atmos_boundary_in_basename /=
'' )
then 491 elseif ( atmos_boundary_type ==
'INIT' )
then 493 call atmos_boundary_setinitval( dens, &
501 if( atmos_boundary_out_basename /=
'' )
then 502 call atmos_boundary_write
521 subroutine atmos_boundary_var_fillhalo
570 end subroutine atmos_boundary_var_fillhalo
574 subroutine atmos_boundary_alpha_fillhalo
623 end subroutine atmos_boundary_alpha_fillhalo
627 subroutine atmos_boundary_ref_fillhalo( &
635 integer,
intent(in) :: ref_idx
643 atmos_boundary_ref_dens( 1:
ks-1,i,j,ref_idx) = atmos_boundary_ref_dens(
ks,i,j,ref_idx)
644 atmos_boundary_ref_velz( 1:
ks-1,i,j,ref_idx) = atmos_boundary_ref_velz(
ks,i,j,ref_idx)
645 atmos_boundary_ref_velx( 1:
ks-1,i,j,ref_idx) = atmos_boundary_ref_velx(
ks,i,j,ref_idx)
646 atmos_boundary_ref_vely( 1:
ks-1,i,j,ref_idx) = atmos_boundary_ref_vely(
ks,i,j,ref_idx)
647 atmos_boundary_ref_pott( 1:
ks-1,i,j,ref_idx) = atmos_boundary_ref_pott(
ks,i,j,ref_idx)
649 atmos_boundary_ref_dens(
ke+1:
ka, i,j,ref_idx) = atmos_boundary_ref_dens(
ke,i,j,ref_idx)
650 atmos_boundary_ref_velz(
ke+1:
ka, i,j,ref_idx) = atmos_boundary_ref_velz(
ke,i,j,ref_idx)
651 atmos_boundary_ref_velx(
ke+1:
ka, i,j,ref_idx) = atmos_boundary_ref_velx(
ke,i,j,ref_idx)
652 atmos_boundary_ref_vely(
ke+1:
ka, i,j,ref_idx) = atmos_boundary_ref_vely(
ke,i,j,ref_idx)
653 atmos_boundary_ref_pott(
ke+1:
ka, i,j,ref_idx) = atmos_boundary_ref_pott(
ke,i,j,ref_idx)
656 atmos_boundary_ref_qtrc( 1:
ks-1,i,j,iq,ref_idx) = atmos_boundary_ref_qtrc(
ks,i,j,iq,ref_idx)
657 atmos_boundary_ref_qtrc(
ke+1:
ka, i,j,iq,ref_idx) = atmos_boundary_ref_qtrc(
ke,i,j,iq,ref_idx)
662 call comm_vars8( atmos_boundary_ref_dens(:,:,:,ref_idx), 1 )
663 call comm_vars8( atmos_boundary_ref_velz(:,:,:,ref_idx), 2 )
664 call comm_vars8( atmos_boundary_ref_velx(:,:,:,ref_idx), 3 )
665 call comm_vars8( atmos_boundary_ref_vely(:,:,:,ref_idx), 4 )
666 call comm_vars8( atmos_boundary_ref_pott(:,:,:,ref_idx), 5 )
669 call comm_vars8( atmos_boundary_ref_qtrc(:,:,:,iq,ref_idx), 5+iq )
672 call comm_wait ( atmos_boundary_ref_dens(:,:,:,ref_idx), 1, .false. )
673 call comm_wait ( atmos_boundary_ref_velz(:,:,:,ref_idx), 2, .false. )
674 call comm_wait ( atmos_boundary_ref_velx(:,:,:,ref_idx), 3, .false. )
675 call comm_wait ( atmos_boundary_ref_vely(:,:,:,ref_idx), 4, .false. )
676 call comm_wait ( atmos_boundary_ref_pott(:,:,:,ref_idx), 5, .false. )
679 call comm_wait ( atmos_boundary_ref_qtrc(:,:,:,iq,ref_idx), 5+iq, .false. )
683 end subroutine atmos_boundary_ref_fillhalo
687 subroutine atmos_boundary_setalpha
701 real(RP) :: coef_z, alpha_z1, alpha_z2
702 real(RP) :: coef_x, alpha_x1, alpha_x2
703 real(RP) :: coef_y, alpha_y1, alpha_y2
706 integer :: i, j, k, iq
710 atmos_boundary_fracz = max( min( atmos_boundary_fracz, 1.0_rp ), eps )
711 atmos_boundary_fracx = max( min( atmos_boundary_fracx, 1.0_rp ), eps )
712 atmos_boundary_fracy = max( min( atmos_boundary_fracy, 1.0_rp ), eps )
714 if ( atmos_boundary_tauz <= 0.0_rp )
then 717 coef_z = 1.0_rp / atmos_boundary_tauz
720 if ( atmos_boundary_taux <= 0.0_rp )
then 723 coef_x = 1.0_rp / atmos_boundary_taux
726 if ( atmos_boundary_tauy <= 0.0_rp )
then 729 coef_y = 1.0_rp / atmos_boundary_tauy
736 if ( ee1 <= 1.0_rp - atmos_boundary_fracz )
then 739 ee1 = ( ee1 - 1.0_rp + atmos_boundary_fracz ) / atmos_boundary_fracz
743 if ( ee2 <= 1.0_rp - atmos_boundary_fracz )
then 746 ee2 = ( ee2 - 1.0_rp + atmos_boundary_fracz ) / atmos_boundary_fracz
751 if ( atmos_boundary_linear_v )
then 752 alpha_z1 = coef_z * ee1
753 alpha_z2 = coef_z * ee2
755 if ( ee1 > 0.0_rp .AND. ee1 <= 0.5_rp )
then 756 alpha_z1 = coef_z * 0.5_rp * ( 1.0_rp - cos( ee1*pi ) )
757 elseif( ee1 > 0.5_rp .AND. ee1 <= 1.0_rp )
then 758 alpha_z1 = coef_z * 0.5_rp * ( 1.0_rp + sin( (ee1-0.5_rp)*pi ) )
760 if ( ee2 > 0.0_rp .AND. ee2 <= 0.5_rp )
then 761 alpha_z2 = coef_z * 0.5_rp * ( 1.0_rp - cos( ee2*pi ) )
762 elseif( ee2 > 0.5_rp .AND. ee2 <= 1.0_rp )
then 763 alpha_z2 = coef_z * 0.5_rp * ( 1.0_rp + sin( (ee2-0.5_rp)*pi ) )
768 if ( ee1 <= 1.0_rp - atmos_boundary_fracx )
then 771 ee1 = ( ee1 - 1.0_rp + atmos_boundary_fracx ) / atmos_boundary_fracx
775 if ( ee2 <= 1.0_rp - atmos_boundary_fracx )
then 778 ee2 = ( ee2 - 1.0_rp + atmos_boundary_fracx ) / atmos_boundary_fracx
781 if ( atmos_boundary_linear_h )
then 782 alpha_x1 = coef_x * ee1
783 alpha_x2 = coef_x * ee2
785 alpha_x1 = coef_x * ee1 * exp( -(1.0_rp-ee1) * atmos_boundary_exp_h )
786 alpha_x2 = coef_x * ee2 * exp( -(1.0_rp-ee2) * atmos_boundary_exp_h )
790 if ( ee1 <= 1.0_rp - atmos_boundary_fracy )
then 793 ee1 = ( ee1 - 1.0_rp + atmos_boundary_fracy ) / atmos_boundary_fracy
797 if ( ee2 <= 1.0_rp - atmos_boundary_fracy )
then 800 ee2 = ( ee2 - 1.0_rp + atmos_boundary_fracy ) / atmos_boundary_fracy
803 if ( atmos_boundary_linear_h )
then 804 alpha_y1 = coef_y * ee1
805 alpha_y2 = coef_y * ee2
807 alpha_y1 = coef_y * ee1 * exp( -(1.0_rp-ee1) * atmos_boundary_exp_h )
808 alpha_y2 = coef_y * ee2 * exp( -(1.0_rp-ee2) * atmos_boundary_exp_h )
814 if ( atmos_boundary_use_velz )
then 822 if ( atmos_boundary_use_dens )
then 828 if ( atmos_boundary_use_velx )
then 833 if ( atmos_boundary_use_vely )
then 838 if ( atmos_boundary_use_pott )
then 843 if ( atmos_boundary_use_qv )
then 848 if ( atmos_boundary_use_qhyd )
then 876 if ( .NOT. atmos_boundary_use_dens )
then 879 if ( .NOT. atmos_boundary_use_velz )
then 882 if ( .NOT. atmos_boundary_use_velx )
then 885 if ( .NOT. atmos_boundary_use_vely )
then 888 if ( .NOT. atmos_boundary_use_pott )
then 891 if ( .NOT. atmos_boundary_use_qv )
then 894 if ( .NOT. atmos_boundary_use_qhyd )
then 902 call atmos_boundary_alpha_fillhalo
905 end subroutine atmos_boundary_setalpha
909 subroutine atmos_boundary_setinitval( &
910 DENS, MOMZ, MOMX, MOMY, RHOT, QTRC )
913 real(RP),
intent(in) :: DENS(
ka,
ia,
ja)
914 real(RP),
intent(in) :: MOMZ(
ka,
ia,
ja)
915 real(RP),
intent(in) :: MOMX(
ka,
ia,
ja)
916 real(RP),
intent(in) :: MOMY(
ka,
ia,
ja)
917 real(RP),
intent(in) :: RHOT(
ka,
ia,
ja)
918 real(RP),
intent(in) :: QTRC(
ka,
ia,
ja,
qa)
920 integer :: i, j, k, iq
962 call atmos_boundary_var_fillhalo
965 end subroutine atmos_boundary_setinitval
969 subroutine atmos_boundary_read
985 character(len=H_LONG) :: bname
988 real(RP) :: tmp_CBFZ(
ka), tmp_CBFX(
ia), tmp_CBFY(
ja)
992 bname = atmos_boundary_in_basename
994 if ( atmos_boundary_use_dens &
995 .OR. atmos_boundary_use_velz &
996 .OR. atmos_boundary_use_velx &
997 .OR. atmos_boundary_use_vely &
998 .OR. atmos_boundary_use_pott &
1000 call fileread( reference_atmos(:,:,:), bname,
'DENS', 1,
prc_myrank )
1003 if ( atmos_boundary_use_dens )
then 1004 call fileread( reference_atmos(:,:,:), bname,
'ALPHA_DENS', 1,
prc_myrank )
1008 if ( atmos_boundary_use_velz )
then 1009 call fileread( reference_atmos(:,:,:), bname,
'VELZ', 1,
prc_myrank )
1011 call fileread( reference_atmos(:,:,:), bname,
'ALPHA_VELZ', 1,
prc_myrank )
1015 if ( atmos_boundary_use_velx )
then 1016 call fileread( reference_atmos(:,:,:), bname,
'VELX', 1,
prc_myrank )
1018 call fileread( reference_atmos(:,:,:), bname,
'ALPHA_VELX', 1,
prc_myrank )
1022 if ( atmos_boundary_use_vely )
then 1023 call fileread( reference_atmos(:,:,:), bname,
'VELY', 1,
prc_myrank )
1025 call fileread( reference_atmos(:,:,:), bname,
'ALPHA_VELY', 1,
prc_myrank )
1029 if ( atmos_boundary_use_pott )
then 1030 call fileread( reference_atmos(:,:,:), bname,
'POTT', 1,
prc_myrank )
1032 call fileread( reference_atmos(:,:,:), bname,
'ALPHA_POTT', 1,
prc_myrank )
1036 if ( atmos_boundary_use_qv )
then 1037 call fileread( reference_atmos(:,:,:), bname,
'QV', 1,
prc_myrank )
1039 call fileread( reference_atmos(:,:,:), bname,
'ALPHA_QV', 1,
prc_myrank )
1043 if ( atmos_boundary_use_qhyd )
then 1047 call fileread( reference_atmos(:,:,:), bname,
'ALPHA_'//trim(
aq_name(iq)), 1,
prc_myrank )
1052 call fileread( tmp_cbfz(:), bname,
'CBFZ', 1,
prc_myrank )
1053 call fileread( tmp_cbfx(:), bname,
'CBFX', 1,
prc_myrank )
1054 call fileread( tmp_cbfy(:), bname,
'CBFY', 1,
prc_myrank )
1057 if( abs(tmp_cbfx(i) -
grid_cbfx(i)) > eps )
then 1059 '*** Buffer layer (X) in ATMOS_BOUNDARY_IN_BASENAME is different from GRID_IN_BASENAME ***: i=', &
1065 if( abs(tmp_cbfy(j) -
grid_cbfy(j)) > eps )
then 1067 '*** Buffer layer (Y) in ATMOS_BOUNDARY_IN_BASENAME is different from GRID_IN_BASENAME ***: j=', &
1073 if( abs(tmp_cbfz(k) -
grid_cbfz(k)) > eps )
then 1075 '*** Buffer layer (Z) in ATMOS_BOUNDARY_IN_BASENAME is different from GRID_IN_BASENAME ***: k=', &
1081 call atmos_boundary_var_fillhalo
1082 call atmos_boundary_alpha_fillhalo
1085 end subroutine atmos_boundary_read
1089 subroutine atmos_boundary_write
1099 if ( atmos_boundary_use_dens &
1100 .OR. atmos_boundary_use_velz &
1101 .OR. atmos_boundary_use_velx &
1102 .OR. atmos_boundary_use_vely &
1103 .OR. atmos_boundary_use_pott &
1106 atmos_boundary_out_basename, atmos_boundary_out_title, &
1107 'DENS',
'Reference Density',
'kg/m3',
'ZXY', &
1108 atmos_boundary_out_dtype )
1110 if ( atmos_boundary_use_dens .OR. l_bnd )
then 1112 atmos_boundary_out_basename, atmos_boundary_out_title, &
1113 'ALPHA_DENS',
'Alpha for DENS',
'1',
'ZXY', &
1114 atmos_boundary_out_dtype )
1117 if ( atmos_boundary_use_velz .OR. (l_bnd .AND.
online_use_velz) )
then 1119 atmos_boundary_out_basename, atmos_boundary_out_title, &
1120 'VELZ',
'Reference Velocity w',
'm/s',
'ZXY', &
1121 atmos_boundary_out_dtype )
1123 atmos_boundary_out_basename, atmos_boundary_out_title, &
1124 'ALPHA_VELZ',
'Alpha for VELZ',
'1',
'ZXY', &
1125 atmos_boundary_out_dtype )
1128 if ( atmos_boundary_use_velx .OR. l_bnd )
then 1130 atmos_boundary_out_basename, atmos_boundary_out_title, &
1131 'VELX',
'Reference Velocity u',
'm/s',
'ZXY', &
1132 atmos_boundary_out_dtype )
1134 atmos_boundary_out_basename, atmos_boundary_out_title, &
1135 'ALPHA_VELX',
'Alpha for VELX',
'1',
'ZXY', &
1136 atmos_boundary_out_dtype )
1139 if ( atmos_boundary_use_vely .OR. l_bnd )
then 1141 atmos_boundary_out_basename, atmos_boundary_out_title, &
1142 'VELY',
'Reference Velocity y',
'm/s',
'ZXY', &
1143 atmos_boundary_out_dtype )
1145 atmos_boundary_out_basename, atmos_boundary_out_title, &
1146 'ALPHA_VELY',
'Alpha for VELY',
'1',
'ZXY', &
1147 atmos_boundary_out_dtype )
1150 if ( atmos_boundary_use_pott .OR. l_bnd )
then 1152 atmos_boundary_out_basename, atmos_boundary_out_title, &
1153 'POTT',
'Reference POTT',
'K',
'ZXY', &
1154 atmos_boundary_out_dtype )
1156 atmos_boundary_out_basename, atmos_boundary_out_title, &
1157 'ALPHA_POTT',
'Alpha for POTT',
'1',
'ZXY', &
1158 atmos_boundary_out_dtype )
1161 if ( atmos_boundary_use_qv .OR. l_bnd )
then 1163 atmos_boundary_out_basename, atmos_boundary_out_title, &
1164 'QV',
'Reference QV',
'kg/kg',
'ZXY', &
1165 atmos_boundary_out_dtype )
1167 atmos_boundary_out_basename, atmos_boundary_out_title, &
1168 'ALPHA_QV',
'Alpha for QV',
'1',
'ZXY', &
1169 atmos_boundary_out_dtype )
1172 if ( atmos_boundary_use_qhyd )
then 1175 atmos_boundary_out_basename, atmos_boundary_out_title, &
1177 atmos_boundary_out_dtype )
1179 atmos_boundary_out_basename, atmos_boundary_out_title, &
1180 'ALPHA_'//trim(
aq_name(iq)),
'Alpha for '//trim(
aq_name(iq)),
'1',
'ZXY', &
1181 atmos_boundary_out_dtype )
1186 end subroutine atmos_boundary_write
1190 subroutine atmos_boundary_generate
1195 integer :: i, j, k, iq
1213 call atmos_boundary_var_fillhalo
1216 end subroutine atmos_boundary_generate
1220 subroutine atmos_boundary_initialize_file
1229 integer :: boundary_time_startday
1230 real(DP) :: boundary_time_startsec
1231 real(DP) :: boundary_time_startms
1232 integer :: boundary_time_offset_year
1234 character(len=27) :: boundary_chardate
1236 if ( atmos_boundary_start_date(1) == -9999 )
then 1241 boundary_time_startms = 0.0_dp
1242 boundary_time_offset_year = 0
1244 atmos_boundary_start_date(:), &
1245 boundary_time_startms )
1248 boundary_time_startsec, &
1249 atmos_boundary_start_date(:), &
1250 boundary_time_startms, &
1251 boundary_time_offset_year )
1255 if(
io_l )
write(
io_fid_log,
'(1x,A,A)')
'*** BOUNDARY START Date : ', boundary_chardate
1258 end subroutine atmos_boundary_initialize_file
1275 real(RP) :: bnd_DENS(
ka,
ia,
ja)
1276 real(RP) :: bnd_VELZ(
ka,
ia,
ja)
1277 real(RP) :: bnd_VELX(
ka,
ia,
ja)
1278 real(RP) :: bnd_VELY(
ka,
ia,
ja)
1279 real(RP) :: bnd_POTT(
ka,
ia,
ja)
1282 integer :: run_time_startdate(6)
1283 integer :: run_time_startday
1284 real(DP) :: run_time_startsec
1285 real(DP) :: run_time_startms
1286 integer :: run_time_offset_year
1287 real(DP) :: run_time_nowdaysec
1289 real(DP) :: boundary_diff_daysec
1290 real(RP) :: boundary_inc_offset
1291 integer :: fillgaps_steps
1293 character(len=H_LONG) :: bname
1295 integer :: i, j, k, iq, n
1298 bname = atmos_boundary_in_basename
1300 if ( atmos_boundary_update_dt <= 0.0_dp )
then 1301 write(*,*)
'xxx You need specify ATMOS_BOUNDARY_UPDATE_DT as larger than 0.0' 1304 update_nstep = nint( atmos_boundary_update_dt /
time_dtsec )
1305 if ( abs(update_nstep *
time_dtsec - atmos_boundary_update_dt) > 1e-10_dp )
then 1306 write(*,*)
'xxx ATMOS_BOUNDARY_UPDATE_DT is not multiple of DT' 1312 run_time_startms = 0.0_dp
1313 run_time_offset_year = 0
1316 run_time_startsec, &
1317 run_time_startdate(:), &
1319 run_time_offset_year )
1323 boundary_diff_daysec = run_time_nowdaysec - boundary_time_initdaysec
1324 boundary_timestep = 1 + int( boundary_diff_daysec / atmos_boundary_update_dt )
1325 boundary_inc_offset = mod( boundary_diff_daysec, atmos_boundary_update_dt )
1326 fillgaps_steps = int( boundary_inc_offset /
time_dtsec )
1328 if(
io_l )
write(
io_fid_log,*)
'+++ BOUNDARY TIMESTEP NUMBER FOR INIT:', boundary_timestep
1329 if(
io_l )
write(
io_fid_log,*)
'+++ BOUNDARY OFFSET:', boundary_inc_offset
1330 if(
io_l )
write(
io_fid_log,*)
'+++ BOUNDARY FILLGAPS STEPS:', fillgaps_steps
1333 call atmos_boundary_update_file( ref_now )
1335 boundary_timestep = boundary_timestep + 1
1336 call atmos_boundary_update_file( ref_new )
1342 atmos_boundary_ref_dens(k,i,j,ref_old) = atmos_boundary_ref_dens(k,i,j,ref_now)
1343 atmos_boundary_ref_velx(k,i,j,ref_old) = atmos_boundary_ref_velx(k,i,j,ref_now)
1344 atmos_boundary_ref_vely(k,i,j,ref_old) = atmos_boundary_ref_vely(k,i,j,ref_now)
1345 atmos_boundary_ref_pott(k,i,j,ref_old) = atmos_boundary_ref_pott(k,i,j,ref_now)
1347 atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
1368 if ( atmos_boundary_use_velz )
then 1378 now_step = fillgaps_steps
1381 call get_boundary( bnd_dens(:,:,:), &
1386 bnd_qtrc(:,:,:,:), &
1410 subroutine atmos_boundary_initialize_online
1421 integer,
parameter :: handle = 2
1425 if ( nestqa /=
bnd_qa )
then 1426 write(*,*)
'xxx ERROR: NEST_BND_QA exceeds BND_QA [initialize/ATMOS_BOUNDARY]' 1427 write(*,*)
'xxx check consistency between' 1428 write(*,*)
' ONLINE_BOUNDARY_USE_QHYD and ATMOS_BOUNDARY_USE_QHYD.' 1435 end subroutine atmos_boundary_initialize_online
1452 integer,
parameter :: handle = 2
1455 integer :: i, j, k, iq
1459 boundary_timestep = 1
1460 if(
io_l )
write(
io_fid_log,*)
'+++ BOUNDARY TIMESTEP NUMBER FOR INIT:', boundary_timestep
1462 call atmos_boundary_update_online_daughter( ref_now )
1464 boundary_timestep = boundary_timestep + 1
1465 if(
io_l )
write(
io_fid_log,*)
'+++ BOUNDARY TIMESTEP NUMBER FOR INIT:', boundary_timestep
1467 call atmos_boundary_update_online_daughter( ref_new )
1473 atmos_boundary_ref_dens(k,i,j,ref_old) = atmos_boundary_ref_dens(k,i,j,ref_now)
1474 atmos_boundary_ref_velx(k,i,j,ref_old) = atmos_boundary_ref_velx(k,i,j,ref_now)
1475 atmos_boundary_ref_vely(k,i,j,ref_old) = atmos_boundary_ref_vely(k,i,j,ref_now)
1476 atmos_boundary_ref_pott(k,i,j,ref_old) = atmos_boundary_ref_pott(k,i,j,ref_now)
1478 atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
1507 else if ( atmos_boundary_use_velz )
then 1517 update_nstep = nint( atmos_boundary_update_dt /
time_dtsec )
1519 write(*,*)
'xxx NSTEP is not multiple of PARENT_NSTEP' 1531 DENS, MOMZ, MOMX, MOMY, RHOT, QTRC )
1535 real(RP),
intent(in) :: DENS(
ka,
ia,
ja)
1536 real(RP),
intent(in) :: MOMZ(
ka,
ia,
ja)
1537 real(RP),
intent(in) :: MOMX(
ka,
ia,
ja)
1538 real(RP),
intent(in) :: MOMY(
ka,
ia,
ja)
1539 real(RP),
intent(in) :: RHOT(
ka,
ia,
ja)
1540 real(RP),
intent(in) :: QTRC(
ka,
ia,
ja,
qa)
1544 if ( do_parent_process )
then 1546 call atmos_boundary_send( dens, momz, momx, momy, rhot, qtrc )
1565 if ( do_parent_process )
then 1570 if ( do_daughter_process )
then 1581 DENS, MOMZ, MOMX, MOMY, RHOT, QTRC )
1594 real(RP),
intent(inout) :: DENS(
ka,
ia,
ja)
1595 real(RP),
intent(inout) :: MOMZ(
ka,
ia,
ja)
1596 real(RP),
intent(inout) :: MOMX(
ka,
ia,
ja)
1597 real(RP),
intent(inout) :: MOMY(
ka,
ia,
ja)
1598 real(RP),
intent(inout) :: RHOT(
ka,
ia,
ja)
1599 real(RP),
intent(inout) :: QTRC(
ka,
ia,
ja,
qa)
1601 real(RP) :: bnd_DENS(
ka,
ia,
ja)
1602 real(RP) :: bnd_VELZ(
ka,
ia,
ja)
1603 real(RP) :: bnd_VELX(
ka,
ia,
ja)
1604 real(RP) :: bnd_VELY(
ka,
ia,
ja)
1605 real(RP) :: bnd_POTT(
ka,
ia,
ja)
1609 integer :: i, j, k, iq
1612 if ( do_parent_process )
then 1614 call atmos_boundary_update_online_parent( dens,momz,momx,momy,rhot,qtrc )
1619 if ( now_step >= update_nstep )
then 1621 boundary_timestep = boundary_timestep + 1
1625 if ( do_daughter_process )
then 1626 call atmos_boundary_update_online_daughter( ref_new )
1628 call atmos_boundary_update_file( ref_new )
1633 now_step = now_step + 1
1636 call get_boundary( bnd_dens(:,:,:), &
1641 bnd_qtrc(:,:,:,:), &
1682 qtrc(k,i,j,iq) = qtrc(k,
is,j,iq) &
1715 momz(k,i,j) = momz(k,
is,j)
1733 qtrc(k,i,j,iq) = qtrc(k,
ie,j,iq) &
1779 momz(k,i,j) = momz(k,
ie,j)
1799 qtrc(k,i,j,iq) = qtrc(k,i,
js,iq) &
1832 momz(k,i,j) = momz(k,i,
js)
1850 qtrc(k,i,j,iq) = qtrc(k,i,
je,iq) &
1896 momz(k,i,j) = momz(k,i,
je)
1903 elseif ( do_parent_process )
then 1906 write(*,*)
'xxx [BUG] invalid path' 1918 if ( do_parent_process )
then 1922 if ( do_daughter_process )
then 1932 subroutine atmos_boundary_update_file( ref )
1939 integer,
intent(in) :: ref
1942 character(len=H_LONG) :: bname
1947 if (
io_l)
write(
io_fid_log,*)
"*** Atmos Boundary: read from boundary file(timestep=", boundary_timestep,
")" 1949 bname = atmos_boundary_in_basename
1951 call fileread( reference_atmos(:,:,:), bname,
'DENS', boundary_timestep,
prc_myrank )
1952 atmos_boundary_ref_dens(
ks:
ke,
isb:
ieb,
jsb:
jeb,ref) = reference_atmos(:,:,:)
1953 call fileread( reference_atmos(:,:,:), bname,
'VELX', boundary_timestep,
prc_myrank )
1954 atmos_boundary_ref_velx(
ks:
ke,
isb:
ieb,
jsb:
jeb,ref) = reference_atmos(:,:,:)
1955 call fileread( reference_atmos(:,:,:), bname,
'VELY', boundary_timestep,
prc_myrank )
1956 atmos_boundary_ref_vely(
ks:
ke,
isb:
ieb,
jsb:
jeb,ref) = reference_atmos(:,:,:)
1957 call fileread( reference_atmos(:,:,:), bname,
'POTT', boundary_timestep,
prc_myrank )
1958 atmos_boundary_ref_pott(
ks:
ke,
isb:
ieb,
jsb:
jeb,ref) = reference_atmos(:,:,:)
1960 call fileread( reference_atmos(:,:,:), bname,
aq_name(iq), boundary_timestep,
prc_myrank )
1961 atmos_boundary_ref_qtrc(
ks:
ke,
isb:
ieb,
jsb:
jeb,iq,ref) = reference_atmos(:,:,:)
1965 call atmos_boundary_ref_fillhalo( ref )
1968 end subroutine atmos_boundary_update_file
1972 subroutine atmos_boundary_update_online_parent( &
1985 real(RP),
intent(in) :: DENS(
ka,
ia,
ja)
1986 real(RP),
intent(in) :: MOMZ(
ka,
ia,
ja)
1987 real(RP),
intent(in) :: MOMX(
ka,
ia,
ja)
1988 real(RP),
intent(in) :: MOMY(
ka,
ia,
ja)
1989 real(RP),
intent(in) :: RHOT(
ka,
ia,
ja)
1990 real(RP),
intent(in) :: QTRC(
ka,
ia,
ja,
qa)
1992 integer,
parameter :: handle = 1
1995 if (
io_l )
write(
io_fid_log,*)
"*** ATMOS BOUNDARY update online: PARENT" 2001 call atmos_boundary_send( dens, momz, momx, momy, rhot, qtrc )
2004 end subroutine atmos_boundary_update_online_parent
2008 subroutine atmos_boundary_update_online_daughter( &
2016 integer,
intent(in) :: ref
2018 integer,
parameter :: handle = 2
2021 if(
io_l )
write(
io_fid_log,
'(1X,A,I5)')
'*** ATMOS BOUNDARY update online: DAUGHTER', boundary_timestep
2024 call atmos_boundary_recv( ref )
2027 call atmos_boundary_ref_fillhalo( ref )
2033 end subroutine atmos_boundary_update_online_daughter
2037 subroutine atmos_boundary_send( &
2038 DENS, MOMZ, MOMX, MOMY, RHOT, QTRC )
2048 integer,
parameter :: handle = 1
2051 real(RP),
intent(in) :: DENS(
ka,
ia,
ja)
2052 real(RP),
intent(in) :: MOMZ(
ka,
ia,
ja)
2053 real(RP),
intent(in) :: MOMX(
ka,
ia,
ja)
2054 real(RP),
intent(in) :: MOMY(
ka,
ia,
ja)
2055 real(RP),
intent(in) :: RHOT(
ka,
ia,
ja)
2056 real(RP),
intent(in) :: QTRC(
ka,
ia,
ja,
qa)
2063 dummy_d(:,:,:,:) = 0.0_rp
2072 qtrc(:,:,:,1:nestqa), &
2078 dummy_d(:,:,:,1:nestqa) )
2081 end subroutine atmos_boundary_send
2085 subroutine atmos_boundary_recv( &
2096 integer,
parameter :: handle = 2
2099 integer,
intent(in) :: ref_idx
2106 dummy_p(:,:,:,:) = 0.0_rp
2115 dummy_p(:,:,:,1:nestqa), &
2116 atmos_boundary_ref_dens(:,:,:,ref_idx), &
2117 atmos_boundary_ref_velz(:,:,:,ref_idx), &
2118 atmos_boundary_ref_velx(:,:,:,ref_idx), &
2119 atmos_boundary_ref_vely(:,:,:,ref_idx), &
2120 atmos_boundary_ref_pott(:,:,:,ref_idx), &
2121 atmos_boundary_ref_qtrc(:,:,:,1:nestqa,ref_idx) )
2124 end subroutine atmos_boundary_recv
2128 subroutine get_boundary_same_parent( &
2140 real(RP),
intent(out) :: bnd_DENS(:,:,:)
2141 real(RP),
intent(out) :: bnd_VELZ(:,:,:)
2142 real(RP),
intent(out) :: bnd_VELX(:,:,:)
2143 real(RP),
intent(out) :: bnd_VELY(:,:,:)
2144 real(RP),
intent(out) :: bnd_POTT(:,:,:)
2145 real(RP),
intent(out) :: bnd_QTRC(:,:,:,:)
2146 integer,
intent(in) :: now_step
2147 integer,
intent(in) :: update_step
2150 integer :: i, j, k, iq
2154 if ( now_step == update_step )
then 2163 bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref)
2164 bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref)
2165 bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref)
2166 bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref)
2167 bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref)
2169 bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref)
2176 end subroutine get_boundary_same_parent
2180 subroutine get_boundary_nearest_neighbor( &
2192 real(RP) :: EPS = 1.0e-4_rp
2195 real(RP),
intent(out) :: bnd_DENS(:,:,:)
2196 real(RP),
intent(out) :: bnd_VELZ(:,:,:)
2197 real(RP),
intent(out) :: bnd_VELX(:,:,:)
2198 real(RP),
intent(out) :: bnd_VELY(:,:,:)
2199 real(RP),
intent(out) :: bnd_POTT(:,:,:)
2200 real(RP),
intent(out) :: bnd_QTRC(:,:,:,:)
2201 integer,
intent(in) :: now_step
2202 integer,
intent(in) :: update_step
2205 integer :: i, j, k, iq
2208 real(RP) :: real_nstep
2209 real(RP) :: half_nstep
2212 real_nstep =
real( now_step, kind=
rp )
2213 half_nstep =
real( UPDATE_NSTEP, kind=RP ) * 0.5_rp
2216 if( ( real_nstep - eps ) < half_nstep )
then 2220 else if( ( real_nstep - 1.0_rp + eps ) > half_nstep )
then 2232 bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_idx)
2233 bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_idx)
2234 bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_idx)
2235 bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_idx)
2236 bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_idx)
2238 bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_idx)
2245 end subroutine get_boundary_nearest_neighbor
2249 subroutine get_boundary_lerp_initpoint( &
2263 real(RP),
intent(out) :: bnd_DENS(:,:,:)
2264 real(RP),
intent(out) :: bnd_VELZ(:,:,:)
2265 real(RP),
intent(out) :: bnd_VELX(:,:,:)
2266 real(RP),
intent(out) :: bnd_VELY(:,:,:)
2267 real(RP),
intent(out) :: bnd_POTT(:,:,:)
2268 real(RP),
intent(out) :: bnd_QTRC(:,:,:,:)
2269 integer,
intent(in) :: now_step
2270 integer,
intent(in) :: update_step
2273 integer :: i, j, k, iq
2278 fact =
REAL(now_step, kind=RP) / update_step
2283 bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_now) * ( 1.0_rp-fact ) &
2284 + atmos_boundary_ref_dens(k,i,j,ref_new) * fact
2285 bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_now) * ( 1.0_rp-fact ) &
2286 + atmos_boundary_ref_velz(k,i,j,ref_new) * fact
2287 bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_now) * ( 1.0_rp-fact) &
2288 + atmos_boundary_ref_velx(k,i,j,ref_new) * fact
2289 bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_now) * ( 1.0_rp-fact) &
2290 + atmos_boundary_ref_vely(k,i,j,ref_new) * fact
2291 bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_now) * ( 1.0_rp-fact ) &
2292 + atmos_boundary_ref_pott(k,i,j,ref_new) * fact
2294 bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now) * ( 1.0_rp-fact ) &
2295 + atmos_boundary_ref_qtrc(k,i,j,iq,ref_new) * fact
2302 end subroutine get_boundary_lerp_initpoint
2306 subroutine get_boundary_lerp_midpoint( &
2320 real(RP) :: EPS = 1.0e-4_rp
2323 real(RP),
intent(out) :: bnd_DENS(:,:,:)
2324 real(RP),
intent(out) :: bnd_VELZ(:,:,:)
2325 real(RP),
intent(out) :: bnd_VELX(:,:,:)
2326 real(RP),
intent(out) :: bnd_VELY(:,:,:)
2327 real(RP),
intent(out) :: bnd_POTT(:,:,:)
2328 real(RP),
intent(out) :: bnd_QTRC(:,:,:,:)
2329 integer,
intent(in) :: now_step
2330 integer,
intent(in) :: update_step
2333 integer :: i, j, k, iq
2335 real(RP) :: real_nstep
2336 real(RP) :: half_nstep
2340 real_nstep =
real( now_step, kind=
rp )
2341 half_nstep =
real( UPDATE_NSTEP, kind=RP ) * 0.5_rp
2344 if( ( real_nstep - eps ) < half_nstep )
then 2346 t1 =
time_dtsec / atmos_boundary_update_dt * ( real_nstep + half_nstep - 0.5_rp )
2351 bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_now) * t1 &
2352 - atmos_boundary_ref_dens(k,i,j,ref_old) * ( t1 - 1.0_rp )
2353 bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_now) * t1 &
2354 - atmos_boundary_ref_velz(k,i,j,ref_old) * ( t1 - 1.0_rp )
2355 bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_now) * t1 &
2356 - atmos_boundary_ref_velx(k,i,j,ref_old) * ( t1 - 1.0_rp )
2357 bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_now) * t1 &
2358 - atmos_boundary_ref_vely(k,i,j,ref_old) * ( t1 - 1.0_rp )
2359 bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_now) * t1 &
2360 - atmos_boundary_ref_pott(k,i,j,ref_old) * ( t1 - 1.0_rp )
2362 bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now) * t1 &
2363 - atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) * ( t1 - 1.0_rp )
2370 else if( ( real_nstep - 1.0_rp + eps ) > half_nstep )
then 2372 t1 =
time_dtsec / atmos_boundary_update_dt * ( real_nstep - half_nstep - 0.5_rp )
2377 bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_new) * t1 &
2378 - atmos_boundary_ref_dens(k,i,j,ref_now) * ( t1 - 1.0_rp )
2379 bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_new) * t1 &
2380 - atmos_boundary_ref_velz(k,i,j,ref_now) * ( t1 - 1.0_rp )
2381 bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_new) * t1 &
2382 - atmos_boundary_ref_velx(k,i,j,ref_now) * ( t1 - 1.0_rp )
2383 bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_new) * t1 &
2384 - atmos_boundary_ref_vely(k,i,j,ref_now) * ( t1 - 1.0_rp )
2385 bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_new) * t1 &
2386 - atmos_boundary_ref_pott(k,i,j,ref_now) * ( t1 - 1.0_rp )
2388 bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_new) * t1 &
2389 - atmos_boundary_ref_qtrc(k,i,j,iq,ref_now) * ( t1 - 1.0_rp )
2398 t1 =
time_dtsec / atmos_boundary_update_dt * ( real_nstep + half_nstep - 1.0_rp )
2399 t2 =
time_dtsec / atmos_boundary_update_dt * ( real_nstep - half_nstep )
2404 bnd_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_new) * t2 * 0.25_rp &
2405 + atmos_boundary_ref_dens(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2406 - atmos_boundary_ref_dens(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2407 bnd_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_new) * t2 * 0.25_rp &
2408 + atmos_boundary_ref_velz(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2409 - atmos_boundary_ref_velz(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2410 bnd_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_new) * t2 * 0.25_rp &
2411 + atmos_boundary_ref_velx(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2412 - atmos_boundary_ref_velx(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2413 bnd_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_new) * t2 * 0.25_rp &
2414 + atmos_boundary_ref_vely(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2415 - atmos_boundary_ref_vely(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2416 bnd_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_new) * t2 * 0.25_rp &
2417 + atmos_boundary_ref_pott(k,i,j,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2418 - atmos_boundary_ref_pott(k,i,j,ref_old) * ( t1 - 1.0_rp ) * 0.25_rp
2420 bnd_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_new) * t2 * 0.25_rp &
2421 + atmos_boundary_ref_qtrc(k,i,j,iq,ref_now) * ( t1 - t2 + 3.0_rp ) * 0.25_rp &
2422 - atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) * ( t1 - 1.0_rp )
2431 end subroutine get_boundary_lerp_midpoint
2450 subroutine history_bnd( &
2451 ATMOS_BOUNDARY_DENS, &
2452 ATMOS_BOUNDARY_VELZ, &
2453 ATMOS_BOUNDARY_VELX, &
2454 ATMOS_BOUNDARY_VELY, &
2455 ATMOS_BOUNDARY_POTT, &
2456 ATMOS_BOUNDARY_QTRC )
2460 real(RP),
intent(in) :: ATMOS_BOUNDARY_DENS(
ka,
ia,
ja)
2461 real(RP),
intent(in) :: ATMOS_BOUNDARY_VELZ(
ka,
ia,
ja)
2462 real(RP),
intent(in) :: ATMOS_BOUNDARY_VELX(
ka,
ia,
ja)
2463 real(RP),
intent(in) :: ATMOS_BOUNDARY_VELY(
ka,
ia,
ja)
2464 real(RP),
intent(in) :: ATMOS_BOUNDARY_POTT(
ka,
ia,
ja)
2465 real(RP),
intent(in) :: ATMOS_BOUNDARY_QTRC(
ka,
ia,
ja,
bnd_qa)
2469 call hist_in( atmos_boundary_dens(:,:,:),
'DENS_BND',
'Boundary Density',
'kg/m3' )
2470 call hist_in( atmos_boundary_velz(:,:,:),
'VELZ_BND',
'Boundary velocity z-direction',
'm/s', zdim=
'half' )
2471 call hist_in( atmos_boundary_velx(:,:,:),
'VELX_BND',
'Boundary velocity x-direction',
'm/s', xdim=
'half' )
2472 call hist_in( atmos_boundary_vely(:,:,:),
'VELY_BND',
'Boundary velocity y-direction',
'm/s', ydim=
'half' )
2473 call hist_in( atmos_boundary_pott(:,:,:),
'POTT_BND',
'Boundary potential temperature',
'K' )
2475 call hist_in( atmos_boundary_qtrc(:,:,:,iq), trim(
aq_name(iq))//
'_BND',
'Boundary '//trim(
aq_name(iq)),
'kg/kg' )
2479 end subroutine history_bnd
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_velx
integer, public is
start point of inner domain: x, local
integer, dimension(2), public parent_ka
parent max number in z-direction (with halo)
integer, dimension(2), public daughter_ka
daughter max number in z-direction (with halo)
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_velz
real(dp), dimension(2), public parent_dtsec
parent DT [sec]
integer, public je
end point of inner domain: y, local
logical, public prc_has_n
subroutine, public prc_mpistop
Abort MPI.
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
subroutine atmos_boundary_resume_online
Resume boundary value for real case experiment [online daughter].
module GRID (nesting system)
subroutine, public calendar_date2char(chardate, ymdhms, subsec)
Convert from gregorian date to absolute day/second.
subroutine, public atmos_boundary_resume(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
Resume.
integer, public time_nstep
total steps [number]
logical, public io_l
output log or not? (this process)
logical, public online_iam_daughter
a flag to say "I am a daughter"
subroutine update_ref_index
Update indices of array of boundary references.
module ATMOSPHERE / Reference state
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_pott
real(rp), dimension(:), allocatable, public grid_fbfy
face buffer factor [0-1]: y
logical, public prc_has_e
integer, dimension(2), public parent_nstep
parent step [number]
integer, public ke
end point of inner domain: z, local
subroutine, public atmos_boundary_update(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
Update boundary value with a constant time boundary.
subroutine, public atmos_boundary_setup
Setup.
integer, public nest_bnd_qa
number of tracer treated in nesting system
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.
subroutine, public atmos_boundary_firstsend(DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
First send boundary value.
logical, public prc_has_s
real(rp), public const_undef
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_velz
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_vely
subroutine, public atmos_boundary_finalize
Finalize boundary value.
real(rp), dimension(:,:,:,:), allocatable, public atmos_boundary_qtrc
integer, public ia
of x whole cells (local, with HALO)
integer, dimension(2), public daughter_ia
daughter max number in x-direction (with halo)
real(rp), dimension(:), allocatable, public grid_fbfx
face buffer factor [0-1]: x
real(dp), public time_dtsec
time interval of model [sec]
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_vely
integer, public ka
of z whole cells (local, with HALO)
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_dens
refernce density [kg/m3]
integer, public kmax
of computational cells: z
real(rp), dimension(:), allocatable, public grid_fbfz
face buffer factor [0-1]: z
character(len=h_short), dimension(:), allocatable, public aq_name
integer, public js
start point of inner domain: y, local
real(rp), dimension(:), allocatable, public grid_cbfx
center buffer factor [0-1]: x
integer, dimension(2), public parent_ja
parent max number in y-direction (with halo)
logical, public comm_fill_bnd
switch whether fill boundary data
integer, dimension(2), public daughter_ja
daughter max number in y-direction (with halo)
subroutine, public nest_comm_recv_cancel(HANDLE)
Sub-command for data transfer from parent to daughter: nestdown.
character(len=h_short), dimension(:), allocatable, public aq_unit
integer, dimension(2), public parent_ia
parent max number in x-direction (with halo)
integer, public ks
start point of inner domain: z, local
real(rp), dimension(:), allocatable, public grid_cbfz
center buffer factor [0-1]: z
logical, public use_nesting
logical, public atmos_boundary_update_flag
integer, public prc_myrank
process num in local communicator
subroutine, public nest_comm_recvwait_issue(HANDLE, BND_QA)
Sub-command for data transfer from parent to daughter: nestdown.
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_dens
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_dens
integer, public ie
end point of inner domain: x, local
real(rp), public const_eps
small number
subroutine atmos_boundary_resume_file
Resume boundary value for real case experiment.
logical, public io_lnml
output log or not? (for namelist, this process)
logical, public online_iam_parent
a flag to say "I am a parent"
module ATMOSPHERE / Boundary treatment
real(rp), dimension(:), allocatable, public grid_cbfy
center buffer factor [0-1]: y
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_pott
logical, public online_use_velz
real(rp), public const_pi
pi
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
integer, public io_fid_conf
Config file ID.
integer, public io_fid_log
Log file ID.
logical, public prc_has_w
integer, parameter, public rp
real(rp), dimension(:,:,:), allocatable, public atmos_boundary_alpha_velx
subroutine, public calendar_date2daysec(absday, abssec, ymdhms, subsec, offset_year)
Convert from gregorian date to absolute day/second.
real(rp), dimension(:,:,:,:), allocatable, public atmos_boundary_alpha_qtrc
real(rp), public atmos_boundary_smoother_fact
subroutine, public nest_comm_test(HANDLE)
[check communication status] Inter-communication
integer, public ja
of y whole cells (local, with HALO)