SCALE-RM
mod_cnvtopo.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
9 !-------------------------------------------------------------------------------
11  !-----------------------------------------------------------------------------
12  !
13  !++ used modules
14  !
15  use scale_precision
16  use scale_stdio
17  use scale_prof
19  use scale_tracer
20  !-----------------------------------------------------------------------------
21  implicit none
22  private
23  !-----------------------------------------------------------------------------
24  !
25  !++ Public procedure
26  !
27  public :: cnvtopo_setup
28  public :: cnvtopo
29 
30  !-----------------------------------------------------------------------------
31  !
32  !++ Public parameters & variables
33  !
34  logical, public :: cnvtopo_donothing
35  logical, public :: cnvtopo_usegtopo30 = .false.
36  logical, public :: cnvtopo_usegmted2010 = .false.
37  logical, public :: cnvtopo_usedem50m = .false.
38 
39  !-----------------------------------------------------------------------------
40  !
41  !++ Private procedure
42  !
43  private :: cnvtopo_gtopo30
44  private :: cnvtopo_gmted2010
45  private :: cnvtopo_dem50m
46  private :: cnvtopo_smooth
47 
48  !-----------------------------------------------------------------------------
49  !
50  !++ Private parameters & variables
51  !
52  character(len=H_SHORT), private :: cnvtopo_smooth_type = 'LAPLACIAN'
53  real(RP), private :: cnvtopo_smooth_maxslope
54  real(RP), private :: cnvtopo_smooth_maxslope_bnd
55  logical, private :: cnvtopo_smooth_local = .false.
56  integer, private :: cnvtopo_smooth_itelim = 1000
57 
58  logical, private :: cnvtopo_copy_parent = .false.
59 
60  real(RP), private :: cnvtopo_unittile_ddeg ! dx for unit tile [deg]
61  real(RP), private :: cnvtopo_oversampling_factor = 2.0_rp ! factor of min. dx against the unit tile
62 
63  !-----------------------------------------------------------------------------
64 contains
65  !-----------------------------------------------------------------------------
67  subroutine cnvtopo_setup
68  use scale_process, only: &
70  use scale_const, only: &
71  d2r => const_d2r, &
72  huge => const_huge
73  use scale_comm, only: &
74  comm_horizontal_min
75  use scale_grid, only: &
76  dx, &
77  dy, &
78  grid_cdz, &
79  grid_fdx, &
80  grid_fdy
81  use scale_grid_real, only: &
82  real_dlat, &
83  real_dlon
84  implicit none
85 
86  character(len=H_SHORT) :: CNVTOPO_name = 'NONE' ! keep backward compatibility
87 
88  namelist / param_cnvtopo / &
89  cnvtopo_name, &
93  cnvtopo_unittile_ddeg, &
94  cnvtopo_oversampling_factor, &
95  cnvtopo_smooth_maxslope, &
96  cnvtopo_smooth_maxslope_bnd, &
97  cnvtopo_smooth_local, &
98  cnvtopo_smooth_itelim, &
99  cnvtopo_smooth_type, &
100  cnvtopo_copy_parent
101 
102  real(RP) :: minslope(ia,ja)
103  real(RP) :: DXL(ia-1)
104  real(RP) :: DYL(ja-1)
105  real(RP) :: DZDX, DZDY
106 
107  real(RP) :: drad(ia,ja)
108  real(RP) :: drad_min
109 
110  integer :: ierr
111  integer :: k, i, j
112  !---------------------------------------------------------------------------
113 
114  if( io_l ) write(io_fid_log,*)
115  if( io_l ) write(io_fid_log,*) '++++++ Module[convert topo] / Categ[preprocess] / Origin[SCALE-RM]'
116 
117  if ( cnvtopo_smooth_local ) then
118  dxl(:) = dx
119  dyl(:) = dy
120  else
121  dxl(:) = grid_fdx(:)
122  dyl(:) = grid_fdy(:)
123  endif
124 
125  minslope(:,:) = huge
126 
127  j = js-1
128  i = is-1
129  do k = ks, ke
130  dzdx = atan2( 2.5_rp * grid_cdz(k), dxl(i) ) / d2r
131  dzdy = atan2( 2.5_rp * grid_cdz(k), dyl(j) ) / d2r
132  minslope(is,js) = min( minslope(is,js), dzdx, dzdy )
133  enddo
134 
135  j = js-1
136  do i = is, ie
137  do k = ks, ke
138  dzdx = atan2( 2.5_rp * grid_cdz(k), dxl(i) ) / d2r
139  dzdy = atan2( 2.5_rp * grid_cdz(k), dyl(j) ) / d2r
140  minslope(i,js) = min( minslope(i,js), dzdx, dzdy )
141  enddo
142  enddo
143 
144  i = is-1
145  do j = js, je
146  do k = ks, ke
147  dzdx = atan2( 2.5_rp * grid_cdz(k), dxl(i) ) / d2r
148  dzdy = atan2( 2.5_rp * grid_cdz(k), dyl(j) ) / d2r
149  minslope(is,j) = min( minslope(is,j), dzdx, dzdy )
150  enddo
151  enddo
152 
153  do j = js, je
154  do i = is, ie
155  do k = ks, ke
156  dzdx = atan2( 2.5_rp * grid_cdz(k), dxl(i) ) / d2r
157  dzdy = atan2( 2.5_rp * grid_cdz(k), dyl(j) ) / d2r
158  minslope(i,j) = min( minslope(i,j), dzdx, dzdy )
159  enddo
160  enddo
161  enddo
162 
163  call comm_horizontal_min( cnvtopo_smooth_maxslope, minslope(:,:) )
164 
165  cnvtopo_smooth_maxslope_bnd = -1.0_rp
166 
167  !--- read namelist
168  rewind(io_fid_conf)
169  read(io_fid_conf,nml=param_cnvtopo,iostat=ierr)
170  if( ierr < 0 ) then !--- missing
171  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
172  elseif( ierr > 0 ) then !--- fatal error
173  write(*,*) 'xxx Not appropriate names in namelist PARAM_CNVTOPO. Check!'
174  call prc_mpistop
175  endif
176  if( io_lnml ) write(io_fid_log,nml=param_cnvtopo)
177 
178  select case(cnvtopo_name)
179  case('NONE')
180  ! do nothing
181  case('GTOPO30')
182  cnvtopo_usegtopo30 = .true.
183  cnvtopo_usegmted2010 = .false.
184  cnvtopo_usedem50m = .false.
185  case('GMTED2010')
186  cnvtopo_usegtopo30 = .false.
187  cnvtopo_usegmted2010 = .true.
188  cnvtopo_usedem50m = .false.
189  case('DEM50M')
190  cnvtopo_usegtopo30 = .false.
191  cnvtopo_usegmted2010 = .false.
192  cnvtopo_usedem50m = .true.
193  case('COMBINE')
194  cnvtopo_usegtopo30 = .true.
195  cnvtopo_usegmted2010 = .true.
196  cnvtopo_usedem50m = .true.
197  case default
198  write(*,*) ' xxx Unsupported TYPE:', trim(cnvtopo_name)
199  call prc_mpistop
200  endselect
201 
202  cnvtopo_donothing = .true.
203 
204  if ( cnvtopo_usegtopo30 ) then
205  cnvtopo_donothing = .false.
206  if( io_l ) write(io_fid_log,*) '*** Use GTOPO, global 30 arcsec. data'
207  if ( cnvtopo_usegmted2010 ) then
208  if( io_l ) write(io_fid_log,*) '*** Use GMTED2010, new global 5 arcsec. data'
209  if( io_l ) write(io_fid_log,*) '*** Overwrite Existing region'
210  endif
211  if ( cnvtopo_usedem50m ) then
212  if( io_l ) write(io_fid_log,*) '*** Use DEM 50m data for Japan region'
213  if( io_l ) write(io_fid_log,*) '*** Overwrite Japan region'
214  endif
215  elseif ( cnvtopo_usegmted2010 ) then
216  cnvtopo_donothing = .false.
217  if( io_l ) write(io_fid_log,*) '*** Use GMTED2010, new global 5 arcsec. data'
218  if ( cnvtopo_usedem50m ) then
219  if( io_l ) write(io_fid_log,*) '*** Use DEM 50m data for Japan region'
220  if( io_l ) write(io_fid_log,*) '*** Overwrite Japan region'
221  endif
222  elseif ( cnvtopo_usedem50m ) then
223  cnvtopo_donothing = .false.
224  if( io_l ) write(io_fid_log,*) '*** Use DEM 50m data, Japan region only'
225  endif
226 
227  if ( cnvtopo_smooth_maxslope_bnd < 0.0_rp ) then
228  cnvtopo_smooth_maxslope_bnd = cnvtopo_smooth_maxslope
229  endif
230 
231  if ( cnvtopo_donothing ) then
232  if( io_l ) write(io_fid_log,*) '*** Do nothing for landuse index'
233  else
234  drad(:,:) = min( real_dlat(:,:), real_dlon(:,:) )
235  call comm_horizontal_min( drad_min, drad(:,:) )
236 
237  if ( cnvtopo_unittile_ddeg > 0.0_rp ) then
238  cnvtopo_oversampling_factor = ( drad_min / d2r ) / cnvtopo_unittile_ddeg
239  endif
240  cnvtopo_oversampling_factor = max( 1.0_rp, cnvtopo_oversampling_factor )
241  cnvtopo_unittile_ddeg = ( drad_min / d2r ) / cnvtopo_oversampling_factor
242 
243  if( io_l ) write(io_fid_log,*) '*** The size of tile [deg] = ', cnvtopo_unittile_ddeg
244  if( io_l ) write(io_fid_log,*) '*** oversampling factor = ', cnvtopo_oversampling_factor
245  endif
246 
247  return
248  end subroutine cnvtopo_setup
249 
250  !-----------------------------------------------------------------------------
252  subroutine cnvtopo
253  use scale_process, only: &
255  use scale_const, only: &
256  pi => const_pi
257  use scale_grid, only: &
258  cbfx => grid_cbfx, &
259  cbfy => grid_cbfy
260  use scale_topography, only: &
261  topo_fillhalo, &
262  topo_zsfc, &
263  topo_write
264  use mod_copytopo, only: &
265  copytopo
266  implicit none
267 
268  real(RP) :: Zsfc(ia,ja,2)
269  real(RP) :: frac
270  integer :: i, j
271  !---------------------------------------------------------------------------
272 
273  if ( cnvtopo_donothing ) then
274  if( io_l ) write(io_fid_log,*)
275  if( io_l ) write(io_fid_log,*) '++++++ SKIP CONVERT TOPOGRAPHY DATA ++++++'
276  else
277  if( io_l ) write(io_fid_log,*)
278  if( io_l ) write(io_fid_log,*) '++++++ START CONVERT TOPOGRAPHY DATA ++++++'
279 
280  if ( cnvtopo_usegtopo30 ) then
281  call cnvtopo_gtopo30
282  endif
283 
284  if ( cnvtopo_usegmted2010 ) then
285  call cnvtopo_gmted2010
286  endif
287 
288  if ( cnvtopo_usedem50m ) then
289  call cnvtopo_dem50m
290  endif
291 
292  zsfc(:,:,1) = topo_zsfc(:,:)
293  call cnvtopo_smooth( zsfc(:,:,1), & ! (inout)
294  cnvtopo_smooth_maxslope ) ! (in)
295 
296  zsfc(:,:,2) = zsfc(:,:,1)
297  call cnvtopo_smooth( zsfc(:,:,2), & ! (inout)
298  cnvtopo_smooth_maxslope_bnd ) ! (in)
299 
300  do j = 1, ja
301  do i = 1, ia
302  frac = sin( 0.5_rp * pi * max( cbfx(i), cbfy(j) ) )
303 
304  topo_zsfc(i,j) = ( 1.0_rp-frac ) * zsfc(i,j,1) &
305  + ( frac ) * zsfc(i,j,2)
306  enddo
307  enddo
308 
309  call topo_fillhalo
310 
311  if( cnvtopo_copy_parent ) call copytopo( topo_zsfc )
312 
313  if( io_l ) write(io_fid_log,*) '++++++ END CONVERT TOPOGRAPHY DATA ++++++'
314 
315  ! output topography file
316  call topo_write
317  endif
318 
319  return
320  end subroutine cnvtopo
321 
322  !-----------------------------------------------------------------------------
324  subroutine cnvtopo_gtopo30
325  use scale_process, only: &
327  use scale_const, only: &
328  radius => const_radius, &
329  eps => const_eps, &
330  d2r => const_d2r
331  use scale_topography, only: &
332  topo_zsfc
333  use scale_grid_real, only: &
334  real_laty, &
335  real_lonx
336  implicit none
337 
338  character(len=H_LONG) :: GTOPO30_IN_CATALOGUE = ''
339  character(len=H_LONG) :: GTOPO30_IN_DIR = ''
340 
341  namelist / param_cnvtopo_gtopo30 / &
342  gtopo30_in_catalogue, &
343  gtopo30_in_dir
344 
345  ! data catalogue list
346  integer, parameter :: TILE_nlim = 100
347  integer :: TILE_nmax
348  real(RP) :: TILE_LATS (tile_nlim)
349  real(RP) :: TILE_LATE (tile_nlim)
350  real(RP) :: TILE_LONS (tile_nlim)
351  real(RP) :: TILE_LONE (tile_nlim)
352  character(len=H_LONG) :: TILE_fname(tile_nlim)
353 
354  ! GTOPO30 data
355  integer, parameter :: isize_orig = 4800
356  integer, parameter :: jsize_orig = 6000
357  integer(2) :: TILE_HEIGHT_orig(isize_orig,jsize_orig)
358  real(RP) :: TILE_DLAT_orig, TILE_DLON_orig
359 
360  ! GTOPO30 data (oversampling)
361  integer :: ios
362  integer :: jos
363  integer :: isize
364  integer :: jsize
365  integer(2), allocatable :: TILE_HEIGHT(:,:)
366  real(RP), allocatable :: TILE_LATH (:)
367  real(RP), allocatable :: TILE_LONH (:)
368  real(RP) :: TILE_DLAT, TILE_DLON
369  real(RP) :: area, area_fraction
370 
371  integer :: iloc
372  integer :: jloc
373  real(RP) :: ifrac_l ! fraction for iloc
374  real(RP) :: jfrac_b ! fraction for jloc
375 
376  real(RP) :: DOMAIN_LATS, DOMAIN_LATE
377  real(RP) :: DOMAIN_LONS, DOMAIN_LONE
378  real(RP) :: topo_sum(ia,ja)
379  real(RP) :: area_sum(ia,ja)
380  real(RP) :: topo, mask
381 
382  character(len=H_LONG) :: fname
383 
384  real(RP) :: zerosw
385  logical :: hit_lat, hit_lon
386  integer :: index
387  integer :: fid, ierr
388  integer :: i, j, ii, jj, iii, jjj, t
389  !---------------------------------------------------------------------------
390 
391  if( io_l ) write(io_fid_log,*)
392  if( io_l ) write(io_fid_log,*) '++++++ Module[convert GTOPO30] / Categ[preprocess] / Origin[SCALE-RM]'
393 
394  !--- read namelist
395  rewind(io_fid_conf)
396  read(io_fid_conf,nml=param_cnvtopo_gtopo30,iostat=ierr)
397  if( ierr < 0 ) then !--- missing
398  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
399  elseif( ierr > 0 ) then !--- fatal error
400  write(*,*) 'xxx Not appropriate names in namelist PARAM_CNVTOPO_GTOPO30. Check!'
401  call prc_mpistop
402  endif
403  if( io_lnml ) write(io_fid_log,nml=param_cnvtopo_gtopo30)
404 
405  do j = 1, ja
406  do i = 1, ia
407  area_sum(i,j) = 0.0_rp
408  topo_sum(i,j) = 0.0_rp
409  enddo
410  enddo
411 
412  domain_lats = minval(real_laty(:,:))
413  domain_late = maxval(real_laty(:,:))
414  domain_lons = minval(real_lonx(:,:))
415  domain_lone = maxval(real_lonx(:,:))
416 
417  jos = nint( 30.0_rp / 60.0_rp / 60.0_rp / cnvtopo_unittile_ddeg - 0.5_rp ) + 1
418  ios = nint( 30.0_rp / 60.0_rp / 60.0_rp / cnvtopo_unittile_ddeg - 0.5_rp ) + 1
419  jsize = jsize_orig * jos
420  isize = isize_orig * ios
421 
422  allocate( tile_height(isize,jsize) )
423  allocate( tile_lath(0:jsize) )
424  allocate( tile_lonh(0:isize) )
425 
426  if( io_l ) write(io_fid_log,*) '*** Oversampling (j) orig = ', jsize_orig, ', use = ', jsize
427  if( io_l ) write(io_fid_log,*) '*** Oversampling (i) orig = ', isize_orig, ', use = ', isize
428 
429  tile_dlat_orig = 30.0_rp / 60.0_rp / 60.0_rp * d2r
430  tile_dlon_orig = 30.0_rp / 60.0_rp / 60.0_rp * d2r
431  if( io_l ) write(io_fid_log,*) '*** TILE_DLAT :', tile_dlat_orig/d2r
432  if( io_l ) write(io_fid_log,*) '*** TILE_DLON :', tile_dlon_orig/d2r
433 
434  tile_dlat = tile_dlat_orig / jos
435  tile_dlon = tile_dlon_orig / ios
436  if( io_l ) write(io_fid_log,*) '*** TILE_DLAT (OS) :', tile_dlat/d2r
437  if( io_l ) write(io_fid_log,*) '*** TILE_DLON (OS) :', tile_dlon/d2r
438 
439  !---< READ from external files >---
440 
441  ! catalogue file
442  fname = trim(gtopo30_in_dir)//'/'//trim(gtopo30_in_catalogue)
443 
444  if( io_l ) write(io_fid_log,*)
445  if( io_l ) write(io_fid_log,*) '+++ Input catalogue file:', trim(fname)
446 
447  fid = io_get_available_fid()
448  open( fid, &
449  file = trim(fname), &
450  form = 'formatted', &
451  status = 'old', &
452  iostat = ierr )
453 
454  if ( ierr /= 0 ) then
455  write(*,*) 'xxx catalogue file not found!', trim(fname)
456  call prc_mpistop
457  endif
458 
459  do t = 1, tile_nlim
460  read(fid,*,iostat=ierr) index, tile_lats(t), tile_late(t), & ! South->North
461  tile_lons(t), tile_lone(t), & ! WEST->EAST
462  tile_fname(t)
463  if ( ierr /= 0 ) exit
464  enddo
465 
466  tile_nmax = t - 1
467  close(fid)
468 
469  ! data file
470  do t = 1, tile_nmax
471  hit_lat = .false.
472  hit_lon = .false.
473 
474  if ( ( tile_lats(t)*d2r >= domain_lats .AND. tile_lats(t)*d2r < domain_late ) &
475  .OR. ( tile_late(t)*d2r >= domain_lats .AND. tile_late(t)*d2r < domain_late ) ) then
476  hit_lat = .true.
477  endif
478 
479  if ( ( domain_lats >= tile_lats(t)*d2r .AND. domain_lats < tile_late(t)*d2r ) &
480  .OR. ( domain_late >= tile_lats(t)*d2r .AND. domain_late < tile_late(t)*d2r ) ) then
481  hit_lat = .true.
482  endif
483 
484  if ( ( tile_lons(t)*d2r >= domain_lons .AND. tile_lons(t)*d2r < domain_lone ) &
485  .OR. ( tile_lone(t)*d2r >= domain_lons .AND. tile_lone(t)*d2r < domain_lone ) ) then
486  hit_lon = .true.
487  endif
488 
489  if ( ( domain_lons >= tile_lons(t)*d2r .AND. domain_lons < tile_lone(t)*d2r ) &
490  .OR. ( domain_lone >= tile_lons(t)*d2r .AND. domain_lone < tile_lone(t)*d2r ) ) then
491  hit_lon = .true.
492  endif
493 
494  if ( hit_lat .AND. hit_lon ) then
495  fname = trim(gtopo30_in_dir)//'/'//trim(tile_fname(t))
496 
497  if( io_l ) write(io_fid_log,*)
498  if( io_l ) write(io_fid_log,*) '+++ Input data file :', trim(fname)
499  if( io_l ) write(io_fid_log,*) '*** Domain (LAT) :', domain_lats/d2r, domain_late/d2r
500  if( io_l ) write(io_fid_log,*) '*** (LON) :', domain_lons/d2r, domain_lone/d2r
501  if( io_l ) write(io_fid_log,*) '*** Tile (LAT) :', tile_lats(t), tile_late(t)
502  if( io_l ) write(io_fid_log,*) '*** (LON) :', tile_lons(t), tile_lone(t)
503 
504  fid = io_get_available_fid()
505  open( fid, &
506  file = trim(fname), &
507  form = 'unformatted', &
508  access = 'direct', &
509  status = 'old', &
510  recl = isize_orig*jsize_orig*2, &
511  iostat = ierr )
512 
513  if ( ierr /= 0 ) then
514  write(*,*) 'xxx data file not found!'
515  call prc_mpistop
516  endif
517 
518  read(fid,rec=1) tile_height_orig(:,:)
519  close(fid)
520 
521  ! oversampling
522  do jj = 1, jsize_orig
523  do ii = 1, isize_orig
524  do j = 1, jos
525  do i = 1, ios
526  jjj = (jj-1) * jos + j
527  iii = (ii-1) * ios + i
528 
529  tile_height(iii,jjj) = tile_height_orig(ii,jsize_orig-jj+1) ! reverse y-axis
530  enddo
531  enddo
532  enddo
533  enddo
534 
535  tile_lath(0) = tile_lats(t) * d2r
536  do jj = 1, jsize
537  tile_lath(jj) = tile_lath(jj-1) + tile_dlat
538 ! if( IO_L ) write(IO_FID_LOG,*) jj, TILE_LATH(jj)
539  enddo
540 
541  tile_lonh(0) = tile_lons(t) * d2r
542  do ii = 1, isize
543  tile_lonh(ii) = tile_lonh(ii-1) + tile_dlon
544 ! if( IO_L ) write(IO_FID_LOG,*) ii, TILE_LONH(ii)
545  enddo
546 
547  ! match and calc fraction
548  do jj = 1, jsize
549  do ii = 1, isize
550 
551  iloc = 1 ! Z_sfc(1,1) is used for dummy grid
552  ifrac_l = 1.0_rp
553 
554  jloc = 1 ! Z_sfc(1,1) is used for dummy grid
555  jfrac_b = 1.0_rp
556 
557  if ( tile_lonh(ii-1) < domain_lons &
558  .OR. tile_lonh(ii-1) >= domain_lone &
559  .OR. tile_lath(jj-1) < domain_lats &
560  .OR. tile_lath(jj-1) >= domain_late ) then
561  cycle
562  endif
563 
564  jloop: do j = js-1, je+1
565  iloop: do i = is-1, ie+1
566  if ( tile_lonh(ii-1) >= real_lonx(i-1,j ) &
567  .AND. tile_lonh(ii-1) < real_lonx(i ,j ) &
568  .AND. tile_lath(jj-1) >= real_laty(i ,j-1) &
569  .AND. tile_lath(jj-1) < real_laty(i ,j ) ) then
570 
571  iloc = i
572  ifrac_l = min( real_lonx(i,j)-tile_lonh(ii-1), tile_dlon ) / tile_dlon
573 
574  jloc = j
575  jfrac_b = min( real_laty(i,j)-tile_lath(jj-1), tile_dlat ) / tile_dlat
576  exit jloop
577 
578  endif
579  enddo iloop
580  enddo jloop
581 
582  if( iloc == 1 .AND. jloc == 1 ) cycle
583 
584  topo = real( TILE_HEIGHT(ii,jj), kind=rp )
585  mask = 0.5_rp - sign( 0.5_rp, topo ) ! if Height is negative, mask = 1
586 
587  area = radius * radius * tile_dlon * ( sin(tile_lath(jj))-sin(tile_lath(jj-1)) ) * ( 1.0_rp - mask )
588 
589 ! if( IO_L ) write(IO_FID_LOG,*) ii, jj, area, iloc, jloc, ifrac_l, jfrac_b, TILE_HEIGHT(ii,jj)
590 
591  area_fraction = ( ifrac_l) * ( jfrac_b) * area
592  area_sum(iloc ,jloc ) = area_sum(iloc ,jloc ) + area_fraction
593  topo_sum(iloc ,jloc ) = topo_sum(iloc ,jloc ) + area_fraction * topo
594 
595  area_fraction = (1.0_rp-ifrac_l) * ( jfrac_b) * area
596  area_sum(iloc+1,jloc ) = area_sum(iloc+1,jloc ) + area_fraction
597  topo_sum(iloc+1,jloc ) = topo_sum(iloc+1,jloc ) + area_fraction * topo
598 
599  area_fraction = ( ifrac_l) * (1.0_rp-jfrac_b) * area
600  area_sum(iloc ,jloc+1) = area_sum(iloc ,jloc+1) + area_fraction
601  topo_sum(iloc ,jloc+1) = topo_sum(iloc ,jloc+1) + area_fraction * topo
602 
603  area_fraction = (1.0_rp-ifrac_l) * (1.0_rp-jfrac_b) * area
604  area_sum(iloc+1,jloc+1) = area_sum(iloc+1,jloc+1) + area_fraction
605  topo_sum(iloc+1,jloc+1) = topo_sum(iloc+1,jloc+1) + area_fraction * topo
606  enddo
607  enddo
608 
609  endif
610  enddo ! tile loop
611 
612  do j = js, je
613  do i = is, ie
614  zerosw = 0.5_rp - sign( 0.5_rp, area_sum(i,j)-eps )
615  topo_zsfc(i,j) = topo_sum(i,j) * ( 1.0_rp-zerosw ) / ( area_sum(i,j)-zerosw )
616  enddo
617  enddo
618 
619  return
620  end subroutine cnvtopo_gtopo30
621 
622  !-----------------------------------------------------------------------------
624  subroutine cnvtopo_gmted2010
625  implicit none
626  !---------------------------------------------------------------------------
627 
628  return
629  end subroutine cnvtopo_gmted2010
630 
631  !-----------------------------------------------------------------------------
633  subroutine cnvtopo_dem50m
634  use scale_process, only: &
636  use scale_const, only: &
637  radius => const_radius, &
638  eps => const_eps, &
639  d2r => const_d2r
640  use scale_topography, only: &
641  topo_zsfc
642  use scale_grid_real, only: &
643  real_laty, &
644  real_lonx
645  implicit none
646 
647  character(len=H_LONG) :: DEM50M_IN_CATALOGUE = ''
648  character(len=H_LONG) :: DEM50M_IN_DIR = ''
649 
650  namelist / param_cnvtopo_dem50m / &
651  dem50m_in_catalogue, &
652  dem50m_in_dir
653 
654  ! data catalogue list
655  integer, parameter :: TILE_nlim = 1000
656  integer :: TILE_nmax
657  real(RP) :: TILE_LATS (tile_nlim)
658  real(RP) :: TILE_LATE (tile_nlim)
659  real(RP) :: TILE_LONS (tile_nlim)
660  real(RP) :: TILE_LONE (tile_nlim)
661  character(len=H_LONG) :: TILE_fname(tile_nlim)
662 
663  ! DEM50M data
664  integer, parameter :: isize_orig = 1600
665  integer, parameter :: jsize_orig = 1600
666  real(SP) :: TILE_HEIGHT_orig(isize_orig,jsize_orig)
667  real(RP) :: TILE_DLAT_orig, TILE_DLON_orig
668 
669  ! DEM50M data (oversampling)
670  integer :: ios
671  integer :: jos
672  integer :: isize
673  integer :: jsize
674  real(SP), allocatable :: TILE_HEIGHT(:,:)
675  real(RP), allocatable :: TILE_LATH (:)
676  real(RP), allocatable :: TILE_LONH (:)
677  real(RP) :: TILE_DLAT, TILE_DLON
678  real(RP) :: area, area_fraction
679 
680  integer :: iloc
681  integer :: jloc
682  real(RP) :: ifrac_l ! fraction for iloc
683  real(RP) :: jfrac_b ! fraction for jloc
684 
685  real(RP) :: DOMAIN_LATS, DOMAIN_LATE
686  real(RP) :: DOMAIN_LONS, DOMAIN_LONE
687  real(RP) :: topo_sum(ia,ja)
688  real(RP) :: area_sum(ia,ja)
689  real(RP) :: topo, mask
690 
691  character(len=H_LONG) :: fname
692 
693  real(RP) :: zerosw
694  logical :: hit_lat, hit_lon
695  integer :: index
696  integer :: fid, ierr
697  integer :: i, j, ii, jj, iii, jjj, t
698  !---------------------------------------------------------------------------
699 
700  if( io_l ) write(io_fid_log,*)
701  if( io_l ) write(io_fid_log,*) '++++++ Module[convert DEM50M] / Categ[preprocess] / Origin[SCALE-RM]'
702 
703  !--- read namelist
704  rewind(io_fid_conf)
705  read(io_fid_conf,nml=param_cnvtopo_dem50m,iostat=ierr)
706  if( ierr < 0 ) then !--- missing
707  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
708  elseif( ierr > 0 ) then !--- fatal error
709  write(*,*) 'xxx Not appropriate names in namelist PARAM_CNVTOPO_DEM50M. Check!'
710  call prc_mpistop
711  endif
712  if( io_lnml ) write(io_fid_log,nml=param_cnvtopo_dem50m)
713 
714  do j = 1, ja
715  do i = 1, ia
716  area_sum(i,j) = 0.0_rp
717  topo_sum(i,j) = 0.0_rp
718  enddo
719  enddo
720 
721  domain_lats = minval(real_laty(:,:))
722  domain_late = maxval(real_laty(:,:))
723  domain_lons = minval(real_lonx(:,:))
724  domain_lone = maxval(real_lonx(:,:))
725 
726  jos = nint( 5.0_rp / 60.0_rp / 200.0_rp / cnvtopo_unittile_ddeg - 0.5_rp ) + 1
727  ios = nint( 7.5_rp / 60.0_rp / 200.0_rp / cnvtopo_unittile_ddeg - 0.5_rp ) + 1
728  jsize = jsize_orig * jos
729  isize = isize_orig * ios
730 
731  allocate( tile_height(isize,jsize) )
732  allocate( tile_lath(0:jsize) )
733  allocate( tile_lonh(0:isize) )
734 
735  if( io_l ) write(io_fid_log,*) '*** Oversampling (j) orig = ', jsize_orig, ', use = ', jsize
736  if( io_l ) write(io_fid_log,*) '*** Oversampling (i) orig = ', isize_orig, ', use = ', isize
737 
738  tile_dlat_orig = 5.0_rp / 60.0_rp / 200.0_rp * d2r
739  tile_dlon_orig = 7.5_rp / 60.0_rp / 200.0_rp * d2r
740  if( io_l ) write(io_fid_log,*) '*** TILE_DLAT :', tile_dlat_orig/d2r
741  if( io_l ) write(io_fid_log,*) '*** TILE_DLON :', tile_dlon_orig/d2r
742 
743  tile_dlat = tile_dlat_orig / jos
744  tile_dlon = tile_dlon_orig / ios
745  if( io_l ) write(io_fid_log,*) '*** TILE_DLAT (OS) :', tile_dlat/d2r
746  if( io_l ) write(io_fid_log,*) '*** TILE_DLON (OS) :', tile_dlon/d2r
747 
748  !---< READ from external files >---
749 
750  ! catalogue file
751  fname = trim(dem50m_in_dir)//'/'//trim(dem50m_in_catalogue)
752 
753  if( io_l ) write(io_fid_log,*)
754  if( io_l ) write(io_fid_log,*) '+++ Input catalogue file:', trim(fname)
755 
756  fid = io_get_available_fid()
757  open( fid, &
758  file = trim(fname), &
759  form = 'formatted', &
760  status = 'old', &
761  iostat = ierr )
762 
763  if ( ierr /= 0 ) then
764  write(*,*) 'xxx catalogue file not found!', trim(fname)
765  call prc_mpistop
766  endif
767 
768  do t = 1, tile_nlim
769  read(fid,*,iostat=ierr) index, tile_lats(t), tile_late(t), & ! South->North
770  tile_lons(t), tile_lone(t), & ! WEST->EAST
771  tile_fname(t)
772  if ( ierr /= 0 ) exit
773  enddo
774 
775  tile_nmax = t - 1
776  close(fid)
777 
778  ! data file
779  do t = 1, tile_nmax
780  hit_lat = .false.
781  hit_lon = .false.
782 
783  if ( ( tile_lats(t)*d2r >= domain_lats .AND. tile_lats(t)*d2r < domain_late ) &
784  .OR. ( tile_late(t)*d2r >= domain_lats .AND. tile_late(t)*d2r < domain_late ) ) then
785  hit_lat = .true.
786  endif
787 
788  if ( ( domain_lats >= tile_lats(t)*d2r .AND. domain_lats < tile_late(t)*d2r ) &
789  .OR. ( domain_late >= tile_lats(t)*d2r .AND. domain_late < tile_late(t)*d2r ) ) then
790  hit_lat = .true.
791  endif
792 
793  if ( ( tile_lons(t)*d2r >= domain_lons .AND. tile_lons(t)*d2r < domain_lone ) &
794  .OR. ( tile_lone(t)*d2r >= domain_lons .AND. tile_lone(t)*d2r < domain_lone ) ) then
795  hit_lon = .true.
796  endif
797 
798  if ( ( domain_lons >= tile_lons(t)*d2r .AND. domain_lons < tile_lone(t)*d2r ) &
799  .OR. ( domain_lone >= tile_lons(t)*d2r .AND. domain_lone < tile_lone(t)*d2r ) ) then
800  hit_lon = .true.
801  endif
802 
803  if ( hit_lat .AND. hit_lon ) then
804  fname = trim(dem50m_in_dir)//'/'//trim(tile_fname(t))
805 
806  if( io_l ) write(io_fid_log,*)
807  if( io_l ) write(io_fid_log,*) '+++ Input data file :', trim(fname)
808  if( io_l ) write(io_fid_log,*) '*** Domain (LAT) :', domain_lats/d2r, domain_late/d2r
809  if( io_l ) write(io_fid_log,*) '*** (LON) :', domain_lons/d2r, domain_lone/d2r
810  if( io_l ) write(io_fid_log,*) '*** Tile (LAT) :', tile_lats(t), tile_late(t)
811  if( io_l ) write(io_fid_log,*) '*** (LON) :', tile_lons(t), tile_lone(t)
812 
813  fid = io_get_available_fid()
814  open( fid, &
815  file = trim(fname), &
816  form = 'unformatted', &
817  access = 'direct', &
818  status = 'old', &
819  recl = isize_orig*jsize_orig*4, &
820  iostat = ierr )
821 
822  if ( ierr /= 0 ) then
823  write(*,*) 'xxx data file not found!'
824  call prc_mpistop
825  endif
826 
827  read(fid,rec=1) tile_height_orig(:,:)
828  close(fid)
829 
830  ! oversampling
831  do jj = 1, jsize_orig
832  do ii = 1, isize_orig
833  do j = 1, jos
834  do i = 1, ios
835  jjj = (jj-1) * jos + j
836  iii = (ii-1) * ios + i
837 
838  tile_height(iii,jjj) = tile_height_orig(ii,jj)
839  enddo
840  enddo
841  enddo
842  enddo
843 
844  tile_lath(0) = tile_lats(t) * d2r
845  do jj = 1, jsize
846  tile_lath(jj) = tile_lath(jj-1) + tile_dlat
847 ! if( IO_L ) write(IO_FID_LOG,*) jj, TILE_LATH(jj)
848  enddo
849 
850  tile_lonh(0) = tile_lons(t) * d2r
851  do ii = 1, isize
852  tile_lonh(ii) = tile_lonh(ii-1) + tile_dlon
853 ! if( IO_L ) write(IO_FID_LOG,*) ii, TILE_LONH(ii)
854  enddo
855 
856  ! match and calc fraction
857  do jj = 1, jsize
858  do ii = 1, isize
859 
860  iloc = 1 ! Z_sfc(1,1) is used for dummy grid
861  ifrac_l = 1.0_rp
862 
863  jloc = 1 ! Z_sfc(1,1) is used for dummy grid
864  jfrac_b = 1.0_rp
865 
866  if ( tile_lonh(ii-1) < domain_lons &
867  .OR. tile_lonh(ii-1) >= domain_lone &
868  .OR. tile_lath(jj-1) < domain_lats &
869  .OR. tile_lath(jj-1) >= domain_late ) then
870  cycle
871  endif
872 
873  jloop: do j = js-1, je+1
874  iloop: do i = is-1, ie+1
875  if ( tile_lonh(ii-1) >= real_lonx(i-1,j ) &
876  .AND. tile_lonh(ii-1) < real_lonx(i ,j ) &
877  .AND. tile_lath(jj-1) >= real_laty(i ,j-1) &
878  .AND. tile_lath(jj-1) < real_laty(i ,j ) ) then
879 
880  iloc = i
881  ifrac_l = min( real_lonx(i,j)-tile_lonh(ii-1), tile_dlon ) / tile_dlon
882 
883  jloc = j
884  jfrac_b = min( real_laty(i,j)-tile_lath(jj-1), tile_dlat ) / tile_dlat
885  exit jloop
886 
887  endif
888  enddo iloop
889  enddo jloop
890 
891  if( iloc == 1 .AND. jloc == 1 ) cycle
892 
893  topo = real( TILE_HEIGHT(ii,jj), kind=rp )
894  mask = 0.5_rp - sign( 0.5_rp,topo ) ! if Height is negative, mask = 1
895 
896  area = radius * radius * tile_dlon * ( sin(tile_lath(jj))-sin(tile_lath(jj-1)) ) * ( 1.0_rp - mask )
897 
898 ! if( IO_L ) write(IO_FID_LOG,*) ii, jj, area, iloc, jloc, ifrac_l, jfrac_b, TILE_HEIGHT(ii,jj)
899 
900  area_fraction = ( ifrac_l) * ( jfrac_b) * area
901  area_sum(iloc ,jloc ) = area_sum(iloc ,jloc ) + area_fraction
902  topo_sum(iloc ,jloc ) = topo_sum(iloc ,jloc ) + area_fraction * topo
903 
904  area_fraction = (1.0_rp-ifrac_l) * ( jfrac_b) * area
905  area_sum(iloc+1,jloc ) = area_sum(iloc+1,jloc ) + area_fraction
906  topo_sum(iloc+1,jloc ) = topo_sum(iloc+1,jloc ) + area_fraction * topo
907 
908  area_fraction = ( ifrac_l) * (1.0_rp-jfrac_b) * area
909  area_sum(iloc ,jloc+1) = area_sum(iloc ,jloc+1) + area_fraction
910  topo_sum(iloc ,jloc+1) = topo_sum(iloc ,jloc+1) + area_fraction * topo
911 
912  area_fraction = (1.0_rp-ifrac_l) * (1.0_rp-jfrac_b) * area
913  area_sum(iloc+1,jloc+1) = area_sum(iloc+1,jloc+1) + area_fraction
914  topo_sum(iloc+1,jloc+1) = topo_sum(iloc+1,jloc+1) + area_fraction * topo
915  enddo
916  enddo
917 
918  endif
919  enddo ! tile loop
920 
921  do j = js, je
922  do i = is, ie
923  mask = 0.5_rp + sign( 0.5_rp, area_sum(i,j)-eps ) ! if any data is found, overwrite
924  zerosw = 0.5_rp - sign( 0.5_rp, area_sum(i,j)-eps )
925  topo = topo_sum(i,j) * ( 1.0_rp-zerosw ) / ( area_sum(i,j)-zerosw )
926  topo_zsfc(i,j) = ( mask ) * topo & ! overwrite
927  + ( 1.0_rp-mask ) * topo_zsfc(i,j) ! keep existing value
928  enddo
929  enddo
930 
931  return
932  end subroutine cnvtopo_dem50m
933 
934  !-----------------------------------------------------------------------------
936  subroutine cnvtopo_smooth( &
937  Zsfc, &
938  smooth_maxslope )
939  use scale_const, only: &
940  d2r => const_d2r
941  use scale_process, only: &
943  use scale_grid, only: &
944  dx, &
945  dy, &
946  grid_fdx, &
947  grid_fdy
948  use scale_comm, only: &
949  comm_horizontal_max
950  use scale_rm_statistics, only: &
952  use scale_topography, only: &
954  implicit none
955 
956  real(RP), intent(inout) :: Zsfc(ia,ja)
957  real(RP), intent(in) :: smooth_maxslope
958 
959  real(RP) :: DZsfc_DX(1,ia,ja,1) ! d(Zsfc)/dx at u-position
960  real(RP) :: DZsfc_DY(1,ia,ja,1) ! d(Zsfc)/dy at v-position
961 
962  real(RP) :: DXL(ia-1)
963  real(RP) :: DYL(ja-1)
964 
965  real(RP) :: FLX_X(ia,ja)
966  real(RP) :: FLX_Y(ia,ja)
967  real(RP) :: FLX_TMP(ia,ja)
968 
969  real(RP) :: slope(ia,ja)
970  real(RP) :: maxslope
971  real(RP) :: flag
972 
973  character(len=H_SHORT) :: varname(1)
974 
975  integer :: ite
976  integer :: i, j
977  !---------------------------------------------------------------------------
978 
979  if( io_l ) write(io_fid_log,*)
980  if( io_l ) write(io_fid_log,*) '*** Apply smoothing. Slope limit = ', cnvtopo_smooth_maxslope
981  if( io_l ) write(io_fid_log,*) '*** Smoothing type = ', cnvtopo_smooth_type
982  if( io_l ) write(io_fid_log,*) '*** Smoothing locally = ', cnvtopo_smooth_local
983 
984  if ( cnvtopo_smooth_local ) then
985  dxl(:) = dx
986  dyl(:) = dy
987  else
988  dxl(:) = grid_fdx(:)
989  dyl(:) = grid_fdy(:)
990  endif
991 
992  ! digital filter
993  do ite = 1, cnvtopo_smooth_itelim+1
994  if( io_l ) write(io_fid_log,*)
995  if( io_l ) write(io_fid_log,*) '*** Smoothing itelation : ', ite
996 
997  call topo_fillhalo( zsfc )
998 
999  do j = 1, ja
1000  do i = 1, ia-1
1001  dzsfc_dx(1,i,j,1) = atan2( ( zsfc(i+1,j)-zsfc(i,j) ), dxl(i) ) / d2r
1002  enddo
1003  enddo
1004  dzsfc_dx(1,ia,:,1) = 0.0_rp
1005  do j = 1, ja-1
1006  do i = 1, ia
1007  dzsfc_dy(1,i,j,1) = atan2( ( zsfc(i,j+1)-zsfc(i,j) ), dyl(j) ) / d2r
1008  enddo
1009  enddo
1010  dzsfc_dy(1,:,ja,1) = 0.0_rp
1011 
1012  slope(:,:) = max( abs(dzsfc_dx(1,:,:,1)), abs(dzsfc_dy(1,:,:,1)) )
1013  call comm_horizontal_max( maxslope, slope(:,:) )
1014 
1015  if( io_l ) write(io_fid_log,*) '*** maximum slope [deg] : ', maxslope
1016 
1017  if( maxslope < smooth_maxslope ) exit
1018 
1019  varname(1) = "DZsfc_DX"
1020  call stat_detail( dzsfc_dx(:,:,:,:), varname(:) )
1021  varname(1) = "DZsfc_DY"
1022  call stat_detail( dzsfc_dy(:,:,:,:), varname(:) )
1023 
1024  select case ( cnvtopo_smooth_type )
1025  case ( 'GAUSSIAN' )
1026 
1027  ! 3 by 3 gaussian filter
1028  do j = js, je
1029  do i = is, ie
1030  zsfc(i,j) = ( 0.2500_rp * zsfc(i ,j ) &
1031  + 0.1250_rp * zsfc(i-1,j ) &
1032  + 0.1250_rp * zsfc(i+1,j ) &
1033  + 0.1250_rp * zsfc(i ,j-1) &
1034  + 0.1250_rp * zsfc(i ,j+1) &
1035  + 0.0625_rp * zsfc(i-1,j-1) &
1036  + 0.0625_rp * zsfc(i+1,j-1) &
1037  + 0.0625_rp * zsfc(i-1,j+1) &
1038  + 0.0625_rp * zsfc(i+1,j+1) )
1039  enddo
1040  enddo
1041 
1042  case ( 'LAPLACIAN' )
1043 
1044  do j = js , je
1045  do i = is-1, ie
1046  flx_x(i,j) = zsfc(i+1,j) - zsfc(i,j)
1047 ! FLX_TMP(i,j) = Zsfc(i+1,j) - Zsfc(i,j)
1048  enddo
1049  enddo
1050 !!$ call TOPO_fillhalo( FLX_TMP )
1051 !!$ do j = JS , JE
1052 !!$ do i = IS-1, IE
1053 !!$ FLX_X(i,j) = - ( FLX_TMP(i+1,j) - FLX_TMP(i,j) )
1054 !!$ enddo
1055 !!$ enddo
1056 
1057  do j = js-1, je
1058  do i = is , ie
1059  flx_y(i,j) = zsfc(i,j+1) - zsfc(i,j)
1060 ! FLX_TMP(i,j) = Zsfc(i,j+1) - Zsfc(i,j)
1061  enddo
1062  enddo
1063 !!$ call TOPO_fillhalo( FLX_TMP )
1064 !!$ do j = JS-1, JE
1065 !!$ do i = IS , IE
1066 !!$ FLX_Y(i,j) = - ( FLX_TMP(i,j+1) - FLX_TMP(i,j) )
1067 !!$ enddo
1068 !!$ enddo
1069 
1070 
1071  if ( cnvtopo_smooth_local ) then
1072  do j = js , je
1073  do i = is-1, ie
1074  flag = 0.5_rp &
1075  + sign(0.5_rp, max( abs(dzsfc_dx(1,i+1,j ,1)), &
1076  abs(dzsfc_dx(1,i ,j ,1)), &
1077  abs(dzsfc_dx(1,i-1,j ,1)), &
1078  abs(dzsfc_dy(1,i+1,j ,1)), &
1079  abs(dzsfc_dy(1,i+1,j-1,1)), &
1080  abs(dzsfc_dy(1,i ,j ,1)), &
1081  abs(dzsfc_dy(1,i ,j-1,1)) &
1082  ) - smooth_maxslope )
1083  flx_x(i,j) = flx_x(i,j) &
1084  * dxl(i) / grid_fdx(i) &
1085  * flag
1086  enddo
1087  enddo
1088  do j = js-1, je
1089  do i = is , ie
1090  flag = 0.5_rp &
1091  + sign(0.5_rp, max( abs(dzsfc_dy(1,i ,j+1,1)), &
1092  abs(dzsfc_dy(1,i ,j ,1)), &
1093  abs(dzsfc_dy(1,i ,j-1,1)), &
1094  abs(dzsfc_dx(1,i ,j+1,1)), &
1095  abs(dzsfc_dx(1,i-1,j+1,1)), &
1096  abs(dzsfc_dx(1,i ,j ,1)), &
1097  abs(dzsfc_dx(1,i-1,j ,1)) &
1098  ) - smooth_maxslope )
1099  flx_y(i,j) = flx_y(i,j) &
1100  * dyl(j) / grid_fdy(j) &
1101  * flag
1102  enddo
1103  enddo
1104  endif
1105 
1106  do j = js, je
1107  do i = is, ie
1108  zsfc(i,j) = max( 0.0_rp, &
1109  zsfc(i,j) &
1110  + 0.1_rp * ( ( flx_x(i,j) - flx_x(i-1,j) ) &
1111  + ( flx_y(i,j) - flx_y(i,j-1) ) ) )
1112  enddo
1113  enddo
1114 
1115  case default
1116  write(*,*) 'xxx Invalid smoothing type'
1117  call prc_mpistop
1118  end select
1119 
1120  enddo
1121 
1122  if ( ite > cnvtopo_smooth_itelim ) then
1123  write(*,*) 'xxx not converged'
1124  call prc_mpistop
1125  else
1126  if( io_l ) write(io_fid_log,*) '*** smoothing complete.'
1127  endif
1128 
1129  varname(1) = "DZsfc_DX"
1130  call stat_detail( dzsfc_dx(:,:,:,:), varname(:) )
1131  varname(1) = "DZsfc_DY"
1132  call stat_detail( dzsfc_dy(:,:,:,:), varname(:) )
1133 
1134  if( io_l ) write(io_fid_log,*)
1135 
1136  return
1137  end subroutine cnvtopo_smooth
1138 
1139 end module mod_cnvtopo
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
Definition: scale_const.F90:38
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)
Definition: scale_stdio.F90:59
module Convert topography
Definition: mod_cnvtopo.f90:10
logical, public cnvtopo_usedem50m
Definition: mod_cnvtopo.f90:37
real(rp), public const_radius
radius of the planet [m]
Definition: scale_const.F90:46
module STDIO
Definition: scale_stdio.F90:12
integer, public ke
end point of inner domain: z, local
real(rp), public const_d2r
degree to radian
Definition: scale_const.F90:35
module Copy topography
module Statistics
module grid index
logical, public cnvtopo_donothing
Definition: mod_cnvtopo.f90:34
module TRACER
integer, public ia
of x whole cells (local, with HALO)
integer function, public io_get_available_fid()
search & get available file ID
module GRID (real space)
real(rp), dimension(:,:), allocatable, public real_dlon
delta longitude
module COMMUNICATION
Definition: scale_comm.F90:23
integer, public js
start point of inner domain: y, local
real(rp), dimension(:), allocatable, public grid_cbfx
center buffer factor [0-1]: x
module PROCESS
real(rp), dimension(:,:), allocatable, public real_dlat
delta latitude
subroutine, public cnvtopo_setup
Setup.
Definition: mod_cnvtopo.f90:68
subroutine, public stat_detail(var, varname, supress_globalcomm)
Search global maximum & minimum value.
module CONSTANT
Definition: scale_const.F90:14
integer, public ks
start point of inner domain: z, local
module GRID (cartesian)
subroutine, public cnvtopo
Driver.
logical, public cnvtopo_usegtopo30
Definition: mod_cnvtopo.f90:35
subroutine, public copytopo(topo_cd)
Setup and Main.
module profiler
Definition: scale_prof.F90:10
integer, public ie
end point of inner domain: x, local
real(rp), public const_eps
small number
Definition: scale_const.F90:36
logical, public io_lnml
output log or not? (for namelist, this process)
Definition: scale_stdio.F90:60
module PRECISION
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
module TOPOGRAPHY
real(rp), public const_pi
pi
Definition: scale_const.F90:34
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
integer, parameter, public rp
real(rp), dimension(:,:), allocatable, public real_lonx
longitude at staggered point (uy) [rad,0-2pi]
logical, public cnvtopo_usegmted2010
Definition: mod_cnvtopo.f90:36
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)