43 private :: cnvtopo_gtopo30
44 private :: cnvtopo_gmted2010
45 private :: cnvtopo_dem50m
46 private :: cnvtopo_smooth
52 character(len=H_SHORT),
private :: cnvtopo_smooth_type =
'LAPLACIAN' 53 logical,
private :: cnvtopo_smooth_local = .false.
54 integer,
private :: cnvtopo_smooth_itelim = 10000
56 logical,
private :: cnvtopo_copy_parent = .false.
58 real(RP),
private :: cnvtopo_unittile_ddeg
59 real(RP),
private :: cnvtopo_oversampling_factor = 2.0_rp
60 real(RP),
private :: cnvtopo_smooth_maxslope_ratio = 1.0_rp
61 real(RP),
private :: cnvtopo_smooth_maxslope = -1.0_rp
63 real(RP),
private :: cnvtopo_smooth_maxslope_limit
88 character(len=H_SHORT) :: CNVTOPO_name =
'NONE' 90 namelist / param_cnvtopo / &
95 cnvtopo_unittile_ddeg, &
96 cnvtopo_oversampling_factor, &
97 cnvtopo_smooth_maxslope_ratio, &
98 cnvtopo_smooth_maxslope, &
99 cnvtopo_smooth_local, &
100 cnvtopo_smooth_itelim, &
101 cnvtopo_smooth_type, &
104 real(RP) :: minslope(
ia,
ja)
105 real(RP) :: DXL(
ia-1)
106 real(RP) :: DYL(
ja-1)
107 real(RP) :: DZDX, DZDY
109 real(RP) :: drad(
ia,
ja)
117 if(
io_l )
write(
io_fid_log,*)
'++++++ Module[convert topo] / Categ[preprocess] / Origin[SCALE-RM]' 119 if ( cnvtopo_smooth_local )
then 131 if(
io_l )
write(
io_fid_log,*)
'*** Not found namelist. Default used.' 132 elseif( ierr > 0 )
then 133 write(*,*)
'xxx Not appropriate names in namelist PARAM_CNVTOPO. Check!' 138 select case(cnvtopo_name)
158 write(*,*)
' xxx Unsupported TYPE:', trim(cnvtopo_name)
166 if(
io_l )
write(
io_fid_log,*)
'*** Use GTOPO, global 30 arcsec. data' 168 if(
io_l )
write(
io_fid_log,*)
'*** Use GMTED2010, new global 5 arcsec. data' 172 if(
io_l )
write(
io_fid_log,*)
'*** Use DEM 50m data for Japan region' 177 if(
io_l )
write(
io_fid_log,*)
'*** Use GMTED2010, new global 5 arcsec. data' 179 if(
io_l )
write(
io_fid_log,*)
'*** Use DEM 50m data for Japan region' 184 if(
io_l )
write(
io_fid_log,*)
'*** Use DEM 50m data, Japan region only' 191 call comm_horizontal_min( drad_min, drad(:,:) )
193 if ( cnvtopo_unittile_ddeg > 0.0_rp )
then 194 cnvtopo_oversampling_factor = ( drad_min / d2r ) / cnvtopo_unittile_ddeg
196 cnvtopo_oversampling_factor = max( 1.0_rp, cnvtopo_oversampling_factor )
197 cnvtopo_unittile_ddeg = ( drad_min / d2r ) / cnvtopo_oversampling_factor
199 if(
io_l )
write(
io_fid_log,*)
'*** The size of tile [deg] = ', cnvtopo_unittile_ddeg
200 if(
io_l )
write(
io_fid_log,*)
'*** oversampling factor = ', cnvtopo_oversampling_factor
203 if( cnvtopo_smooth_maxslope > 0.0_rp )
then 205 cnvtopo_smooth_maxslope_limit = cnvtopo_smooth_maxslope
213 dzdx = atan2( cnvtopo_smooth_maxslope_ratio *
grid_cdz(k), dxl(i) ) / d2r
214 dzdy = atan2( cnvtopo_smooth_maxslope_ratio *
grid_cdz(k), dyl(j) ) / d2r
215 minslope(
is,
js) = min( minslope(
is,
js), dzdx, dzdy )
221 dzdx = atan2( cnvtopo_smooth_maxslope_ratio *
grid_cdz(k), dxl(i) ) / d2r
222 dzdy = atan2( cnvtopo_smooth_maxslope_ratio *
grid_cdz(k), dyl(j) ) / d2r
223 minslope(i,
js) = min( minslope(i,
js), dzdx, dzdy )
230 dzdx = atan2( cnvtopo_smooth_maxslope_ratio *
grid_cdz(k), dxl(i) ) / d2r
231 dzdy = atan2( cnvtopo_smooth_maxslope_ratio *
grid_cdz(k), dyl(j) ) / d2r
232 minslope(
is,j) = min( minslope(
is,j), dzdx, dzdy )
239 dzdx = atan2( cnvtopo_smooth_maxslope_ratio *
grid_cdz(k), dxl(i) ) / d2r
240 dzdy = atan2( cnvtopo_smooth_maxslope_ratio *
grid_cdz(k), dyl(j) ) / d2r
241 minslope(i,j) = min( minslope(i,j), dzdx, dzdy )
246 call comm_horizontal_min( cnvtopo_smooth_maxslope_limit, minslope(:,:) )
275 if(
io_l )
write(
io_fid_log,*)
'++++++ SKIP CONVERT TOPOGRAPHY DATA ++++++' 278 if(
io_l )
write(
io_fid_log,*)
'++++++ START CONVERT TOPOGRAPHY DATA ++++++' 285 call cnvtopo_gmted2010
297 if(
io_l )
write(
io_fid_log,*)
'++++++ END CONVERT TOPOGRAPHY DATA ++++++' 308 subroutine cnvtopo_gtopo30
322 character(len=H_LONG) :: GTOPO30_IN_CATALOGUE =
'' 323 character(len=H_LONG) :: GTOPO30_IN_DIR =
'' 325 namelist / param_cnvtopo_gtopo30 / &
326 gtopo30_in_catalogue, &
330 integer,
parameter :: TILE_nlim = 100
332 real(RP) :: TILE_LATS (tile_nlim)
333 real(RP) :: TILE_LATE (tile_nlim)
334 real(RP) :: TILE_LONS (tile_nlim)
335 real(RP) :: TILE_LONE (tile_nlim)
336 character(len=H_LONG) :: TILE_fname(tile_nlim)
339 integer,
parameter :: isize_orig = 4800
340 integer,
parameter :: jsize_orig = 6000
341 integer(2) :: TILE_HEIGHT_orig(isize_orig,jsize_orig)
342 real(RP) :: TILE_DLAT_orig, TILE_DLON_orig
349 integer(2),
allocatable :: TILE_HEIGHT(:,:)
350 real(RP),
allocatable :: TILE_LATH (:)
351 real(RP),
allocatable :: TILE_LONH (:)
352 real(RP) :: TILE_DLAT, TILE_DLON
353 real(RP) :: area, area_fraction
360 real(RP) :: DOMAIN_LATS, DOMAIN_LATE
361 real(RP) :: DOMAIN_LONS, DOMAIN_LONE
362 real(RP) :: topo_sum(
ia,
ja)
363 real(RP) :: area_sum(
ia,
ja)
364 real(RP) :: topo, mask
366 character(len=H_LONG) :: fname
369 logical :: hit_lat, hit_lon
372 integer :: i, j, ii, jj, iii, jjj, t
376 if(
io_l )
write(
io_fid_log,*)
'++++++ Module[convert GTOPO30] / Categ[preprocess] / Origin[SCALE-RM]' 380 read(
io_fid_conf,nml=param_cnvtopo_gtopo30,iostat=ierr)
382 if(
io_l )
write(
io_fid_log,*)
'*** Not found namelist. Default used.' 383 elseif( ierr > 0 )
then 384 write(*,*)
'xxx Not appropriate names in namelist PARAM_CNVTOPO_GTOPO30. Check!' 391 area_sum(i,j) = 0.0_rp
392 topo_sum(i,j) = 0.0_rp
401 jos = nint( 30.0_rp / 60.0_rp / 60.0_rp / cnvtopo_unittile_ddeg - 0.5_rp ) + 1
402 ios = nint( 30.0_rp / 60.0_rp / 60.0_rp / cnvtopo_unittile_ddeg - 0.5_rp ) + 1
403 jsize = jsize_orig * jos
404 isize = isize_orig * ios
406 allocate( tile_height(isize,jsize) )
407 allocate( tile_lath(0:jsize) )
408 allocate( tile_lonh(0:isize) )
410 if(
io_l )
write(
io_fid_log,*)
'*** Oversampling (j) orig = ', jsize_orig,
', use = ', jsize
411 if(
io_l )
write(
io_fid_log,*)
'*** Oversampling (i) orig = ', isize_orig,
', use = ', isize
413 tile_dlat_orig = 30.0_rp / 60.0_rp / 60.0_rp * d2r
414 tile_dlon_orig = 30.0_rp / 60.0_rp / 60.0_rp * d2r
415 if(
io_l )
write(
io_fid_log,*)
'*** TILE_DLAT :', tile_dlat_orig/d2r
416 if(
io_l )
write(
io_fid_log,*)
'*** TILE_DLON :', tile_dlon_orig/d2r
418 tile_dlat = tile_dlat_orig / jos
419 tile_dlon = tile_dlon_orig / ios
420 if(
io_l )
write(
io_fid_log,*)
'*** TILE_DLAT (OS) :', tile_dlat/d2r
421 if(
io_l )
write(
io_fid_log,*)
'*** TILE_DLON (OS) :', tile_dlon/d2r
426 fname = trim(gtopo30_in_dir)//
'/'//trim(gtopo30_in_catalogue)
429 if(
io_l )
write(
io_fid_log,*)
'+++ Input catalogue file:', trim(fname)
433 file = trim(fname), &
434 form =
'formatted', &
438 if ( ierr /= 0 )
then 439 write(*,*)
'xxx catalogue file not found!', trim(fname)
444 read(fid,*,iostat=ierr) index, tile_lats(t), tile_late(t), &
445 tile_lons(t), tile_lone(t), &
447 if ( ierr /= 0 )
exit 458 if ( ( tile_lats(t)*d2r >= domain_lats .AND. tile_lats(t)*d2r < domain_late ) &
459 .OR. ( tile_late(t)*d2r >= domain_lats .AND. tile_late(t)*d2r < domain_late ) )
then 463 if ( ( domain_lats >= tile_lats(t)*d2r .AND. domain_lats < tile_late(t)*d2r ) &
464 .OR. ( domain_late >= tile_lats(t)*d2r .AND. domain_late < tile_late(t)*d2r ) )
then 468 if ( ( tile_lons(t)*d2r >= domain_lons .AND. tile_lons(t)*d2r < domain_lone ) &
469 .OR. ( tile_lone(t)*d2r >= domain_lons .AND. tile_lone(t)*d2r < domain_lone ) )
then 473 if ( ( domain_lons >= tile_lons(t)*d2r .AND. domain_lons < tile_lone(t)*d2r ) &
474 .OR. ( domain_lone >= tile_lons(t)*d2r .AND. domain_lone < tile_lone(t)*d2r ) )
then 478 if ( hit_lat .AND. hit_lon )
then 479 fname = trim(gtopo30_in_dir)//
'/'//trim(tile_fname(t))
482 if(
io_l )
write(
io_fid_log,*)
'+++ Input data file :', trim(fname)
483 if(
io_l )
write(
io_fid_log,*)
'*** Domain (LAT) :', domain_lats/d2r, domain_late/d2r
484 if(
io_l )
write(
io_fid_log,*)
'*** (LON) :', domain_lons/d2r, domain_lone/d2r
485 if(
io_l )
write(
io_fid_log,*)
'*** Tile (LAT) :', tile_lats(t), tile_late(t)
486 if(
io_l )
write(
io_fid_log,*)
'*** (LON) :', tile_lons(t), tile_lone(t)
490 file = trim(fname), &
491 form =
'unformatted', &
494 recl = isize_orig*jsize_orig*2, &
497 if ( ierr /= 0 )
then 498 write(*,*)
'xxx data file not found!' 502 read(fid,rec=1) tile_height_orig(:,:)
506 do jj = 1, jsize_orig
507 do ii = 1, isize_orig
510 jjj = (jj-1) * jos + j
511 iii = (ii-1) * ios + i
513 tile_height(iii,jjj) = tile_height_orig(ii,jsize_orig-jj+1)
519 tile_lath(0) = tile_lats(t) * d2r
521 tile_lath(jj) = tile_lath(jj-1) + tile_dlat
525 tile_lonh(0) = tile_lons(t) * d2r
527 tile_lonh(ii) = tile_lonh(ii-1) + tile_dlon
541 if ( tile_lonh(ii-1) < domain_lons &
542 .OR. tile_lonh(ii-1) >= domain_lone &
543 .OR. tile_lath(jj-1) < domain_lats &
544 .OR. tile_lath(jj-1) >= domain_late )
then 548 jloop:
do j =
js-1,
je+1
549 iloop:
do i =
is-1,
ie+1
550 if ( tile_lonh(ii-1) >=
real_lonx(i-1,j ) &
551 .AND. tile_lonh(ii-1) <
real_lonx(i ,j ) &
552 .AND. tile_lath(jj-1) >=
real_laty(i ,j-1) &
553 .AND. tile_lath(jj-1) <
real_laty(i ,j ) )
then 556 ifrac_l = min(
real_lonx(i,j)-tile_lonh(ii-1), tile_dlon ) / tile_dlon
559 jfrac_b = min(
real_laty(i,j)-tile_lath(jj-1), tile_dlat ) / tile_dlat
566 if( iloc == 1 .AND. jloc == 1 ) cycle
568 topo =
real( TILE_HEIGHT(ii,jj), kind=
rp )
569 mask = 0.5_rp - sign( 0.5_rp, topo )
571 area = radius * radius * tile_dlon * ( sin(tile_lath(jj))-sin(tile_lath(jj-1)) ) * ( 1.0_rp - mask )
575 area_fraction = ( ifrac_l) * ( jfrac_b) * area
576 area_sum(iloc ,jloc ) = area_sum(iloc ,jloc ) + area_fraction
577 topo_sum(iloc ,jloc ) = topo_sum(iloc ,jloc ) + area_fraction * topo
579 area_fraction = (1.0_rp-ifrac_l) * ( jfrac_b) * area
580 area_sum(iloc+1,jloc ) = area_sum(iloc+1,jloc ) + area_fraction
581 topo_sum(iloc+1,jloc ) = topo_sum(iloc+1,jloc ) + area_fraction * topo
583 area_fraction = ( ifrac_l) * (1.0_rp-jfrac_b) * area
584 area_sum(iloc ,jloc+1) = area_sum(iloc ,jloc+1) + area_fraction
585 topo_sum(iloc ,jloc+1) = topo_sum(iloc ,jloc+1) + area_fraction * topo
587 area_fraction = (1.0_rp-ifrac_l) * (1.0_rp-jfrac_b) * area
588 area_sum(iloc+1,jloc+1) = area_sum(iloc+1,jloc+1) + area_fraction
589 topo_sum(iloc+1,jloc+1) = topo_sum(iloc+1,jloc+1) + area_fraction * topo
598 zerosw = 0.5_rp - sign( 0.5_rp, area_sum(i,j)-eps )
599 topo_zsfc(i,j) = topo_sum(i,j) * ( 1.0_rp-zerosw ) / ( area_sum(i,j)-zerosw )
604 end subroutine cnvtopo_gtopo30
608 subroutine cnvtopo_gmted2010
613 end subroutine cnvtopo_gmted2010
617 subroutine cnvtopo_dem50m
631 character(len=H_LONG) :: DEM50M_IN_CATALOGUE =
'' 632 character(len=H_LONG) :: DEM50M_IN_DIR =
'' 634 namelist / param_cnvtopo_dem50m / &
635 dem50m_in_catalogue, &
639 integer,
parameter :: TILE_nlim = 1000
641 real(RP) :: TILE_LATS (tile_nlim)
642 real(RP) :: TILE_LATE (tile_nlim)
643 real(RP) :: TILE_LONS (tile_nlim)
644 real(RP) :: TILE_LONE (tile_nlim)
645 character(len=H_LONG) :: TILE_fname(tile_nlim)
648 integer,
parameter :: isize_orig = 1600
649 integer,
parameter :: jsize_orig = 1600
650 real(SP) :: TILE_HEIGHT_orig(isize_orig,jsize_orig)
651 real(RP) :: TILE_DLAT_orig, TILE_DLON_orig
658 real(SP),
allocatable :: TILE_HEIGHT(:,:)
659 real(RP),
allocatable :: TILE_LATH (:)
660 real(RP),
allocatable :: TILE_LONH (:)
661 real(RP) :: TILE_DLAT, TILE_DLON
662 real(RP) :: area, area_fraction
669 real(RP) :: DOMAIN_LATS, DOMAIN_LATE
670 real(RP) :: DOMAIN_LONS, DOMAIN_LONE
671 real(RP) :: topo_sum(
ia,
ja)
672 real(RP) :: area_sum(
ia,
ja)
673 real(RP) :: topo, mask
675 character(len=H_LONG) :: fname
678 logical :: hit_lat, hit_lon
681 integer :: i, j, ii, jj, iii, jjj, t
685 if(
io_l )
write(
io_fid_log,*)
'++++++ Module[convert DEM50M] / Categ[preprocess] / Origin[SCALE-RM]' 689 read(
io_fid_conf,nml=param_cnvtopo_dem50m,iostat=ierr)
691 if(
io_l )
write(
io_fid_log,*)
'*** Not found namelist. Default used.' 692 elseif( ierr > 0 )
then 693 write(*,*)
'xxx Not appropriate names in namelist PARAM_CNVTOPO_DEM50M. Check!' 700 area_sum(i,j) = 0.0_rp
701 topo_sum(i,j) = 0.0_rp
710 jos = nint( 5.0_rp / 60.0_rp / 200.0_rp / cnvtopo_unittile_ddeg - 0.5_rp ) + 1
711 ios = nint( 7.5_rp / 60.0_rp / 200.0_rp / cnvtopo_unittile_ddeg - 0.5_rp ) + 1
712 jsize = jsize_orig * jos
713 isize = isize_orig * ios
715 allocate( tile_height(isize,jsize) )
716 allocate( tile_lath(0:jsize) )
717 allocate( tile_lonh(0:isize) )
719 if(
io_l )
write(
io_fid_log,*)
'*** Oversampling (j) orig = ', jsize_orig,
', use = ', jsize
720 if(
io_l )
write(
io_fid_log,*)
'*** Oversampling (i) orig = ', isize_orig,
', use = ', isize
722 tile_dlat_orig = 5.0_rp / 60.0_rp / 200.0_rp * d2r
723 tile_dlon_orig = 7.5_rp / 60.0_rp / 200.0_rp * d2r
724 if(
io_l )
write(
io_fid_log,*)
'*** TILE_DLAT :', tile_dlat_orig/d2r
725 if(
io_l )
write(
io_fid_log,*)
'*** TILE_DLON :', tile_dlon_orig/d2r
727 tile_dlat = tile_dlat_orig / jos
728 tile_dlon = tile_dlon_orig / ios
729 if(
io_l )
write(
io_fid_log,*)
'*** TILE_DLAT (OS) :', tile_dlat/d2r
730 if(
io_l )
write(
io_fid_log,*)
'*** TILE_DLON (OS) :', tile_dlon/d2r
735 fname = trim(dem50m_in_dir)//
'/'//trim(dem50m_in_catalogue)
738 if(
io_l )
write(
io_fid_log,*)
'+++ Input catalogue file:', trim(fname)
742 file = trim(fname), &
743 form =
'formatted', &
747 if ( ierr /= 0 )
then 748 write(*,*)
'xxx catalogue file not found!', trim(fname)
753 read(fid,*,iostat=ierr) index, tile_lats(t), tile_late(t), &
754 tile_lons(t), tile_lone(t), &
756 if ( ierr /= 0 )
exit 767 if ( ( tile_lats(t)*d2r >= domain_lats .AND. tile_lats(t)*d2r < domain_late ) &
768 .OR. ( tile_late(t)*d2r >= domain_lats .AND. tile_late(t)*d2r < domain_late ) )
then 772 if ( ( domain_lats >= tile_lats(t)*d2r .AND. domain_lats < tile_late(t)*d2r ) &
773 .OR. ( domain_late >= tile_lats(t)*d2r .AND. domain_late < tile_late(t)*d2r ) )
then 777 if ( ( tile_lons(t)*d2r >= domain_lons .AND. tile_lons(t)*d2r < domain_lone ) &
778 .OR. ( tile_lone(t)*d2r >= domain_lons .AND. tile_lone(t)*d2r < domain_lone ) )
then 782 if ( ( domain_lons >= tile_lons(t)*d2r .AND. domain_lons < tile_lone(t)*d2r ) &
783 .OR. ( domain_lone >= tile_lons(t)*d2r .AND. domain_lone < tile_lone(t)*d2r ) )
then 787 if ( hit_lat .AND. hit_lon )
then 788 fname = trim(dem50m_in_dir)//
'/'//trim(tile_fname(t))
791 if(
io_l )
write(
io_fid_log,*)
'+++ Input data file :', trim(fname)
792 if(
io_l )
write(
io_fid_log,*)
'*** Domain (LAT) :', domain_lats/d2r, domain_late/d2r
793 if(
io_l )
write(
io_fid_log,*)
'*** (LON) :', domain_lons/d2r, domain_lone/d2r
794 if(
io_l )
write(
io_fid_log,*)
'*** Tile (LAT) :', tile_lats(t), tile_late(t)
795 if(
io_l )
write(
io_fid_log,*)
'*** (LON) :', tile_lons(t), tile_lone(t)
799 file = trim(fname), &
800 form =
'unformatted', &
803 recl = isize_orig*jsize_orig*4, &
806 if ( ierr /= 0 )
then 807 write(*,*)
'xxx data file not found!' 811 read(fid,rec=1) tile_height_orig(:,:)
815 do jj = 1, jsize_orig
816 do ii = 1, isize_orig
819 jjj = (jj-1) * jos + j
820 iii = (ii-1) * ios + i
822 tile_height(iii,jjj) = tile_height_orig(ii,jj)
828 tile_lath(0) = tile_lats(t) * d2r
830 tile_lath(jj) = tile_lath(jj-1) + tile_dlat
834 tile_lonh(0) = tile_lons(t) * d2r
836 tile_lonh(ii) = tile_lonh(ii-1) + tile_dlon
850 if ( tile_lonh(ii-1) < domain_lons &
851 .OR. tile_lonh(ii-1) >= domain_lone &
852 .OR. tile_lath(jj-1) < domain_lats &
853 .OR. tile_lath(jj-1) >= domain_late )
then 857 jloop:
do j =
js-1,
je+1
858 iloop:
do i =
is-1,
ie+1
859 if ( tile_lonh(ii-1) >=
real_lonx(i-1,j ) &
860 .AND. tile_lonh(ii-1) <
real_lonx(i ,j ) &
861 .AND. tile_lath(jj-1) >=
real_laty(i ,j-1) &
862 .AND. tile_lath(jj-1) <
real_laty(i ,j ) )
then 865 ifrac_l = min(
real_lonx(i,j)-tile_lonh(ii-1), tile_dlon ) / tile_dlon
868 jfrac_b = min(
real_laty(i,j)-tile_lath(jj-1), tile_dlat ) / tile_dlat
875 if( iloc == 1 .AND. jloc == 1 ) cycle
877 topo =
real( TILE_HEIGHT(ii,jj), kind=
rp )
878 mask = 0.5_rp - sign( 0.5_rp,topo )
880 area = radius * radius * tile_dlon * ( sin(tile_lath(jj))-sin(tile_lath(jj-1)) ) * ( 1.0_rp - mask )
884 area_fraction = ( ifrac_l) * ( jfrac_b) * area
885 area_sum(iloc ,jloc ) = area_sum(iloc ,jloc ) + area_fraction
886 topo_sum(iloc ,jloc ) = topo_sum(iloc ,jloc ) + area_fraction * topo
888 area_fraction = (1.0_rp-ifrac_l) * ( jfrac_b) * area
889 area_sum(iloc+1,jloc ) = area_sum(iloc+1,jloc ) + area_fraction
890 topo_sum(iloc+1,jloc ) = topo_sum(iloc+1,jloc ) + area_fraction * topo
892 area_fraction = ( ifrac_l) * (1.0_rp-jfrac_b) * area
893 area_sum(iloc ,jloc+1) = area_sum(iloc ,jloc+1) + area_fraction
894 topo_sum(iloc ,jloc+1) = topo_sum(iloc ,jloc+1) + area_fraction * topo
896 area_fraction = (1.0_rp-ifrac_l) * (1.0_rp-jfrac_b) * area
897 area_sum(iloc+1,jloc+1) = area_sum(iloc+1,jloc+1) + area_fraction
898 topo_sum(iloc+1,jloc+1) = topo_sum(iloc+1,jloc+1) + area_fraction * topo
907 mask = 0.5_rp + sign( 0.5_rp, area_sum(i,j)-eps )
908 zerosw = 0.5_rp - sign( 0.5_rp, area_sum(i,j)-eps )
909 topo = topo_sum(i,j) * ( 1.0_rp-zerosw ) / ( area_sum(i,j)-zerosw )
916 end subroutine cnvtopo_dem50m
920 subroutine cnvtopo_smooth( &
939 real(RP),
intent(inout) :: Zsfc(
ia,
ja)
941 real(RP) :: DZsfc_DX(1,
ia,
ja,1)
942 real(RP) :: DZsfc_DY(1,
ia,
ja,1)
944 real(RP) :: DXL(
ia-1)
945 real(RP) :: DYL(
ja-1)
947 real(RP) :: FLX_X(
ia,
ja)
948 real(RP) :: FLX_Y(
ia,
ja)
949 real(RP) :: FLX_TMP(
ia,
ja)
951 real(RP) :: slope(
ia,
ja)
955 character(len=H_SHORT) :: varname(1)
962 if(
io_l )
write(
io_fid_log,*)
'*** Apply smoothing. Slope limit = ', cnvtopo_smooth_maxslope_limit
963 if(
io_l )
write(
io_fid_log,*)
'*** Smoothing type = ', cnvtopo_smooth_type
964 if(
io_l )
write(
io_fid_log,*)
'*** Smoothing locally = ', cnvtopo_smooth_local
966 if ( cnvtopo_smooth_local )
then 975 do ite = 1, cnvtopo_smooth_itelim+1
983 dzsfc_dx(1,i,j,1) = atan2( ( zsfc(i+1,j)-zsfc(i,j) ), dxl(i) ) / d2r
986 dzsfc_dx(1,
ia,:,1) = 0.0_rp
989 dzsfc_dy(1,i,j,1) = atan2( ( zsfc(i,j+1)-zsfc(i,j) ), dyl(j) ) / d2r
992 dzsfc_dy(1,:,
ja,1) = 0.0_rp
994 slope(:,:) = max( abs(dzsfc_dx(1,:,:,1)), abs(dzsfc_dy(1,:,:,1)) )
995 call comm_horizontal_max( maxslope, slope(:,:) )
997 if(
io_l )
write(
io_fid_log,*)
'*** maximum slope [deg] : ', maxslope
999 if( maxslope < cnvtopo_smooth_maxslope_limit )
exit 1001 varname(1) =
"DZsfc_DX" 1003 varname(1) =
"DZsfc_DY" 1006 select case ( cnvtopo_smooth_type )
1012 zsfc(i,j) = ( 0.2500_rp * zsfc(i ,j ) &
1013 + 0.1250_rp * zsfc(i-1,j ) &
1014 + 0.1250_rp * zsfc(i+1,j ) &
1015 + 0.1250_rp * zsfc(i ,j-1) &
1016 + 0.1250_rp * zsfc(i ,j+1) &
1017 + 0.0625_rp * zsfc(i-1,j-1) &
1018 + 0.0625_rp * zsfc(i+1,j-1) &
1019 + 0.0625_rp * zsfc(i-1,j+1) &
1020 + 0.0625_rp * zsfc(i+1,j+1) )
1024 case (
'LAPLACIAN' )
1028 flx_x(i,j) = zsfc(i+1,j) - zsfc(i,j)
1041 flx_y(i,j) = zsfc(i,j+1) - zsfc(i,j)
1053 if ( cnvtopo_smooth_local )
then 1057 + sign(0.5_rp, max( abs(dzsfc_dx(1,i+1,j ,1)), &
1058 abs(dzsfc_dx(1,i ,j ,1)), &
1059 abs(dzsfc_dx(1,i-1,j ,1)), &
1060 abs(dzsfc_dy(1,i+1,j ,1)), &
1061 abs(dzsfc_dy(1,i+1,j-1,1)), &
1062 abs(dzsfc_dy(1,i ,j ,1)), &
1063 abs(dzsfc_dy(1,i ,j-1,1)) &
1064 ) - cnvtopo_smooth_maxslope_limit )
1065 flx_x(i,j) = flx_x(i,j) &
1073 + sign(0.5_rp, max( abs(dzsfc_dy(1,i ,j+1,1)), &
1074 abs(dzsfc_dy(1,i ,j ,1)), &
1075 abs(dzsfc_dy(1,i ,j-1,1)), &
1076 abs(dzsfc_dx(1,i ,j+1,1)), &
1077 abs(dzsfc_dx(1,i-1,j+1,1)), &
1078 abs(dzsfc_dx(1,i ,j ,1)), &
1079 abs(dzsfc_dx(1,i-1,j ,1)) &
1080 ) - cnvtopo_smooth_maxslope_limit )
1081 flx_y(i,j) = flx_y(i,j) &
1090 zsfc(i,j) = max( 0.0_rp, &
1092 + 0.1_rp * ( ( flx_x(i,j) - flx_x(i-1,j) ) &
1093 + ( flx_y(i,j) - flx_y(i,j-1) ) ) )
1098 write(*,*)
'xxx Invalid smoothing type' 1104 if ( ite > cnvtopo_smooth_itelim )
then 1105 write(*,*)
'xxx not converged' 1111 varname(1) =
"DZsfc_DX" 1113 varname(1) =
"DZsfc_DY" 1119 end subroutine cnvtopo_smooth
subroutine, public topo_write
Write topography.
integer, public is
start point of inner domain: x, local
integer, public je
end point of inner domain: y, local
subroutine, public topo_fillhalo(Zsfc)
HALO Communication.
real(rp), public dy
length in the main region [m]: y
real(rp), public const_huge
huge number
subroutine, public prc_mpistop
Abort MPI.
real(rp), dimension(:), allocatable, public grid_fdy
y-length of grid(j+1) to grid(j) [m]
real(rp), public dx
length in the main region [m]: x
logical, public io_l
output log or not? (this process)
module Convert topography
logical, public cnvtopo_usedem50m
real(rp), public const_radius
radius of the planet [m]
integer, public ke
end point of inner domain: z, local
real(rp), public const_d2r
degree to radian
logical, public cnvtopo_donothing
integer, public ia
of x whole cells (local, with HALO)
integer function, public io_get_available_fid()
search & get available file ID
real(rp), dimension(:,:), allocatable, public real_dlon
delta longitude
integer, public js
start point of inner domain: y, local
real(rp), dimension(:), allocatable, public grid_cbfx
center buffer factor [0-1]: x
real(rp), dimension(:,:), allocatable, public real_dlat
delta latitude
subroutine, public cnvtopo_setup
Setup.
subroutine, public stat_detail(var, varname, supress_globalcomm)
Search global maximum & minimum value.
integer, public ks
start point of inner domain: z, local
subroutine, public cnvtopo
Driver.
logical, public cnvtopo_usegtopo30
subroutine, public copytopo(topo_cd)
Setup and Main.
integer, public ie
end point of inner domain: x, local
real(rp), public const_eps
small number
logical, public io_lnml
output log or not? (for namelist, this process)
real(rp), dimension(:,:), allocatable, public topo_zsfc
absolute ground height [m]
real(rp), dimension(:), allocatable, public grid_cdz
z-length of control volume [m]
real(rp), dimension(:), allocatable, public grid_fdx
x-length of grid(i+1) to grid(i) [m]
real(rp), dimension(:), allocatable, public grid_cbfy
center buffer factor [0-1]: y
real(rp), public const_pi
pi
integer, public io_fid_conf
Config file ID.
integer, public io_fid_log
Log file ID.
integer, parameter, public rp
real(rp), dimension(:,:), allocatable, public real_lonx
longitude at staggered point (uy) [rad,0-2pi]
logical, public cnvtopo_usegmted2010
real(rp), dimension(:,:), allocatable, public real_laty
latitude at staggered point (xv) [rad,-pi,pi]
integer, public ja
of y whole cells (local, with HALO)