47 private :: copytopo_transgrid
48 private :: copytopo_setalpha
49 private :: copytopo_input_data
50 private :: copytopo_mix_data
56 integer,
private,
parameter :: handle = 1
57 integer,
private :: itp_nh = 4
59 character(len=H_LONG),
private :: copytopo_in_basename =
'' 61 real(RP),
private :: copytopo_transition_dx = -1.0_rp
62 real(RP),
private :: copytopo_transition_dy = -1.0_rp
63 real(RP),
private :: copytopo_transfact = -1.0_rp
64 real(RP),
private :: copytopo_fracx = 1.0_rp
65 real(RP),
private :: copytopo_fracy = 1.0_rp
66 real(RP),
private :: copytopo_taux = 1.0_rp
67 real(RP),
private :: copytopo_tauy = 1.0_rp
69 logical,
private :: copytopo_entire_region = .false.
70 logical,
private :: copytopo_linear_h = .true.
71 real(RP),
private :: copytopo_exp_h = 2.0_rp
73 real(RP),
private,
allocatable :: ctrx(:)
74 real(RP),
private,
allocatable :: ctry(:)
75 real(RP),
private,
allocatable :: copytopo_alpha(:,:)
76 real(RP),
private,
allocatable :: topo_pd(:,:)
96 real(RP),
intent(inout) :: topo_cd(:,:)
98 namelist / param_copytopo / &
99 copytopo_in_basename, &
100 copytopo_transition_dx, &
101 copytopo_transition_dy, &
102 copytopo_transfact, &
107 copytopo_entire_region, &
115 if(
io_l )
write(
io_fid_log,*)
'+++ Module[COPYTOPO]/Categ[COPYTOPO]' 121 if(
io_l )
write(
io_fid_log,*)
'*** Not found namelist. Default used.' 122 elseif( ierr > 0 )
then 123 write(*,*)
'xxx Not appropriate names in namelist PARAM_COPYTOPO. Check!' 128 if ( copytopo_transition_dx < 0.0_rp )
then 131 if ( copytopo_transition_dy < 0.0_rp )
then 134 if ( copytopo_transfact < 0.0_rp )
then 140 allocate( copytopo_alpha(
ia,
ja) )
141 allocate( topo_pd(
ia,
ja) )
142 copytopo_alpha(:,:) = 0.0_rp
147 call copytopo_transgrid
149 call copytopo_setalpha
151 call copytopo_input_data( topo_pd )
153 call copytopo_mix_data( topo_cd, &
165 subroutine copytopo_transgrid
188 real(RP),
allocatable :: ctrxg(:)
189 real(RP),
allocatable :: ctryg(:)
191 real(RP),
allocatable :: buffx(:), buffy(:)
192 real(RP) :: bufftotx, bufftoty
193 real(RP),
allocatable :: transx(:), transy(:)
194 real(RP) :: transtotx, transtoty
196 integer :: imain, ibuff, itrans
197 integer :: jmain, jbuff, jtrans
198 integer :: copy_is, copy_ie, copy_js, copy_je
200 integer :: i, j, ii, jj
203 allocate( buffx(0:
iag) )
204 allocate( buffy(0:
jag) )
205 allocate( transx(0:
iag) )
206 allocate( transy(0:
jag) )
207 allocate( ctrxg(
iag) )
208 allocate( ctryg(
jag) )
218 if( abs(cbfxg(i) - 0.0_rp) < eps )
exit 220 bufftotx = bufftotx + buffx(i)
222 ibuff = i - (
ihalo+1)
225 if( transtotx >= copytopo_transition_dx )
exit 226 transx(i) = transx(i-1) * copytopo_transfact
227 transtotx = transtotx + transx(i)
230 imain =
iag - 2*ibuff - 2*itrans - 2*
ihalo 232 if ( imain < 1 )
then 233 write(*,*)
'xxx Not appropriate transition width for global domain(X).', copytopo_transition_dx
234 write(*,*)
' # of buffer region (one side)', ibuff
235 write(*,*)
' # of transion region (one side)', itrans
241 do i = 1,
ihalo+ibuff
245 if ( itrans > 0 )
then 246 copy_is =
ihalo+ibuff+1
247 copy_ie =
ihalo+ibuff+itrans
248 do i = copy_is, copy_ie
249 ctrxg(i) = (transtotx+bufftotx+fxg(
ihalo )-cxg(i)) / transtotx
251 copy_is =
ihalo+ibuff+itrans+imain+1
252 copy_ie =
ihalo+ibuff+itrans+imain+itrans+ibuff
253 do i = copy_is, copy_ie
254 ctrxg(i) = (transtotx+bufftotx-fxg(
iag-
ihalo)+cxg(i)) / transtotx
258 copy_is =
ihalo+ibuff+itrans+imain+itrans+ibuff+1
259 copy_ie =
ihalo+ibuff+itrans+imain+itrans+ibuff+
ihalo 260 do i = copy_is, copy_ie
263 ctrxg(:) = max( min( ctrxg(:), 1.0_rp ), 0.0_rp )
273 if( abs(cbfyg(j) - 0.0_rp) < eps )
exit 275 bufftoty = bufftoty + buffy(j)
277 jbuff = j - (
jhalo+1)
280 if( transtoty >= copytopo_transition_dy )
exit 281 transy(j) = transy(j-1) * copytopo_transfact
282 transtoty = transtoty + transy(j)
285 jmain =
jag - 2*jbuff - 2*jtrans - 2*
jhalo 287 if ( jmain < 1 )
then 288 write(*,*)
'xxx Not appropriate transition width for global domain(Y).', copytopo_transition_dy
289 write(*,*)
' # of buffer region (one side)', jbuff
290 write(*,*)
' # of transion region (one side)', jtrans
296 do j = 1,
jhalo+jbuff
300 if ( jtrans > 0 )
then 301 copy_js =
jhalo+jbuff+1
302 copy_je =
jhalo+jbuff+jtrans
303 do j = copy_js, copy_je
304 ctryg(j) = (transtoty+bufftoty+fyg(
jhalo )-cyg(j)) / transtoty
306 copy_js =
jhalo+jbuff+jtrans+jmain+1
307 copy_je =
jhalo+jbuff+jtrans+jmain+jtrans+jbuff
308 do j = copy_js, copy_je
309 ctryg(j) = (transtoty+bufftoty-fyg(
jag-
jhalo)+cyg(j)) / transtoty
313 copy_js =
jhalo+jbuff+jtrans+jmain+jtrans+jbuff+1
314 copy_je =
jhalo+jbuff+jtrans+jmain+jtrans+jbuff+
jhalo 315 do j = copy_js, copy_je
318 ctryg(:) = max( min( ctryg(:), 1.0_rp ), 0.0_rp )
334 end subroutine copytopo_transgrid
339 subroutine copytopo_setalpha
346 real(RP) :: coef_x, alpha_x1
347 real(RP) :: coef_y, alpha_y1
354 copytopo_fracx = max( min( copytopo_fracx, 1.0_rp ), eps )
355 copytopo_fracy = max( min( copytopo_fracy, 1.0_rp ), eps )
357 if ( copytopo_taux <= 0.0_rp )
then 360 coef_x = 1.0_rp / copytopo_taux
363 if ( copytopo_tauy <= 0.0_rp )
then 366 coef_y = 1.0_rp / copytopo_tauy
372 if ( ee1 <= 1.0_rp - copytopo_fracx )
then 375 ee1 = ( ee1 - 1.0_rp + copytopo_fracx ) / copytopo_fracx
378 if ( copytopo_linear_h )
then 379 alpha_x1 = coef_x * ee1
381 alpha_x1 = coef_x * ee1 * exp( -(1.0_rp-ee1) * copytopo_exp_h )
385 if ( ee1 <= 1.0_rp - copytopo_fracy )
then 388 ee1 = ( ee1 - 1.0_rp + copytopo_fracy ) / copytopo_fracy
391 if ( copytopo_linear_h )
then 392 alpha_y1 = coef_y * ee1
394 alpha_y1 = coef_y * ee1 * exp( -(1.0_rp-ee1) * copytopo_exp_h )
397 copytopo_alpha(i,j) = max( alpha_x1, alpha_y1 )
401 call comm_vars8( copytopo_alpha(:,:), 1 )
402 call comm_wait ( copytopo_alpha(:,:), 1 )
405 end subroutine copytopo_setalpha
410 subroutine copytopo_input_data( &
433 real(RP),
intent(out) :: topo_pd(:,:)
435 real(RP) :: dummy (1,1,1)
436 real(RP),
allocatable :: read2d(:,:)
437 real(RP),
allocatable :: lon_org (:,:)
438 real(RP),
allocatable :: lat_org (:,:)
439 real(RP),
allocatable :: topo_org(:,:)
440 real(RP),
allocatable :: hfact(:,:,:)
441 integer,
allocatable :: igrd (:,:,:)
442 integer,
allocatable :: jgrd (:,:,:)
444 integer :: iall, jall
446 integer :: tilei, tilej
449 integer :: cxs, cxe, cys, cye
450 integer :: pxs, pxe, pys, pye
458 allocate( hfact(
ia,
ja, itp_nh ) )
459 allocate( igrd(
ia,
ja, itp_nh ) )
460 allocate( jgrd(
ia,
ja, itp_nh ) )
461 allocate( lon_org( iall, jall ) )
462 allocate( lat_org( iall, jall ) )
463 allocate( topo_org( iall, jall ) )
475 allocate( read2d( tilei,tilej ) )
477 call fileread( read2d(:,:), copytopo_in_basename,
"lon", 1, rank )
478 lon_org(cxs:cxe,cys:cye) = read2d(pxs:pxe,pys:pye) * d2r
479 call fileread( read2d(:,:), copytopo_in_basename,
"lat", 1, rank )
480 lat_org(cxs:cxe,cys:cye) = read2d(pxs:pxe,pys:pye) * d2r
481 call fileread( read2d(:,:), copytopo_in_basename,
"TOPO", 1, rank )
482 topo_org(cxs:cxe,cys:cye) = read2d(pxs:pxe,pys:pye)
488 lon(:,:), lat(:,:), dummy(:,:,:), &
511 call comm_vars8( topo_pd(:,:), 1 )
512 call comm_wait ( topo_pd(:,:), 1 )
515 end subroutine copytopo_input_data
519 subroutine copytopo_mix_data( &
523 real(RP),
intent(inout) :: topo_cd(:,:)
524 real(RP),
intent(in) :: topo_pd(:,:)
530 if ( copytopo_entire_region )
then 531 topo_cd(:,:) = topo_pd(:,:)
535 frac = copytopo_alpha(i,j)
536 topo_cd(i,j) = topo_cd(i,j) * ( 1.0_rp - frac ) &
537 + topo_pd(i,j) * frac
543 end subroutine copytopo_mix_data
integer, public imax
of computational cells: x, local
integer, public prc_num_x
x length of 2D processor topology
real(rp), public buffer_dx
thickness of buffer region [m]: x
subroutine, public intrpnest_domain_compatibility(lon_org, lat_org, lev_org, lon_loc, lat_loc, lev_loc, skip_x, skip_y, skip_z)
real(rp), public dy
length in the main region [m]: y
real(rp), dimension(:), allocatable, public grid_cyg
center coordinate [m]: y, global
subroutine, public prc_mpistop
Abort MPI.
real(rp), dimension(:), allocatable, public grid_cbfyg
center buffer factor (0-1): y, global
integer, parameter, public i_dem50m
integer, dimension(2), public parent_jmax
parent max number in y-direction
module GRID (nesting system)
real(rp), dimension(:), allocatable, public grid_cxg
center coordinate [m]: x, global
real(rp), public dx
length in the main region [m]: x
logical, public io_l
output log or not? (this process)
real(rp), dimension(:), allocatable, public grid_fxg
face coordinate [m]: x, global
real(rp), public const_radius
radius of the planet [m]
real(rp), public const_d2r
degree to radian
procedure(intrpnest_intfc_interp_2d), pointer, public intrpnest_interp_2d
integer, dimension(:), allocatable, public nest_tile_id
parent tile real id
integer, public nest_interp_level
horizontal interpolation level
subroutine, public intrpnest_interp_fact_latlon(hfact, igrd, jgrd, mylat, mylon, myIA, myJA, inlat, inlon, inIA, inJA)
integer, parameter, public i_gtopo30
integer, public prc_num_y
y length of 2D processor topology
logical, public io_nml
output log or not? (for namelist, this process)
subroutine, public nest_domain_shape(tilei, tilej, cxs, cxe, cys, cye, pxs, pxe, pys, pye, iloc)
Return shape of ParentDomain at the specified rank (for offline)
integer, public ia
of whole cells: x, local, with HALO
integer, public jag
of computational grids
integer, parameter, public i_gmted2010
integer, parameter, public i_ignore
integer, public jhalo
of halo cells: y
integer, public iag
of computational grids
integer, public nest_tile_num_y
parent tile number in y-direction
integer, public prc_myrank
process num in local communicator
module INTERPOLATION (nesting system)
subroutine, public copytopo(topo_cd)
Setup and Main.
real(rp), public buffer_dy
thickness of buffer region [m]: y
integer, dimension(2), public parent_imax
parent max number in x-direction
real(rp), public const_eps
small number
real(rp), dimension(:,:), allocatable, public real_lon
longitude [rad,0-2pi]
integer, public nest_tile_num_x
parent tile number in x-direction
integer, public cnvtopo_type
integer, dimension(:,:), allocatable, public prc_2drank
node index in 2D topology
integer, public io_fid_conf
Config file ID.
real(rp), dimension(:,:), allocatable, public real_lat
latitude [rad,-pi,pi]
integer, public io_fid_log
Log file ID.
real(rp), public bufffact
default strech factor for dx/dy/dz of buffer region
integer, public jmax
of computational cells: y, local
integer, public io_fid_nml
Log file ID (only for output namelist)
real(rp), dimension(:), allocatable, public grid_fyg
face coordinate [m]: y, global
real(rp), dimension(:), allocatable, public grid_cbfxg
center buffer factor (0-1): x, global
integer, public ihalo
of halo cells: x
integer, public ja
of whole cells: y, local, with HALO