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  logical, private :: cnvtopo_smooth_local = .false.
54  integer, private :: cnvtopo_smooth_itelim = 10000
55 
56  logical, private :: cnvtopo_copy_parent = .false.
57 
58  real(RP), private :: cnvtopo_unittile_ddeg ! dx for unit tile [deg]
59  real(RP), private :: cnvtopo_oversampling_factor = 2.0_rp ! factor of min. dx against the unit tile
60  real(RP), private :: cnvtopo_smooth_maxslope_ratio = 1.0_rp ! ratio of DZDX, DZDY
61  real(RP), private :: cnvtopo_smooth_maxslope = -1.0_rp ! [deg]
62 
63  real(RP), private :: cnvtopo_smooth_maxslope_limit
64 
65  !-----------------------------------------------------------------------------
66 contains
67  !-----------------------------------------------------------------------------
69  subroutine cnvtopo_setup
70  use scale_process, only: &
72  use scale_const, only: &
73  d2r => const_d2r, &
74  huge => const_huge
75  use scale_comm, only: &
76  comm_horizontal_min
77  use scale_grid, only: &
78  dx, &
79  dy, &
80  grid_cdz, &
81  grid_fdx, &
82  grid_fdy
83  use scale_grid_real, only: &
84  real_dlat, &
85  real_dlon
86  implicit none
87 
88  character(len=H_SHORT) :: CNVTOPO_name = 'NONE' ! keep backward compatibility
89 
90  namelist / param_cnvtopo / &
91  cnvtopo_name, &
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, &
102  cnvtopo_copy_parent
103 
104  real(RP) :: minslope(ia,ja)
105  real(RP) :: DXL(ia-1)
106  real(RP) :: DYL(ja-1)
107  real(RP) :: DZDX, DZDY
108 
109  real(RP) :: drad(ia,ja)
110  real(RP) :: drad_min
111 
112  integer :: ierr
113  integer :: k, i, j
114  !---------------------------------------------------------------------------
115 
116  if( io_l ) write(io_fid_log,*)
117  if( io_l ) write(io_fid_log,*) '++++++ Module[convert topo] / Categ[preprocess] / Origin[SCALE-RM]'
118 
119  if ( cnvtopo_smooth_local ) then
120  dxl(:) = dx
121  dyl(:) = dy
122  else
123  dxl(:) = grid_fdx(:)
124  dyl(:) = grid_fdy(:)
125  endif
126 
127  !--- read namelist
128  rewind(io_fid_conf)
129  read(io_fid_conf,nml=param_cnvtopo,iostat=ierr)
130  if( ierr < 0 ) then !--- missing
131  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
132  elseif( ierr > 0 ) then !--- fatal error
133  write(*,*) 'xxx Not appropriate names in namelist PARAM_CNVTOPO. Check!'
134  call prc_mpistop
135  endif
136  if( io_lnml ) write(io_fid_log,nml=param_cnvtopo)
137 
138  select case(cnvtopo_name)
139  case('NONE')
140  ! do nothing
141  case('GTOPO30')
142  cnvtopo_usegtopo30 = .true.
143  cnvtopo_usegmted2010 = .false.
144  cnvtopo_usedem50m = .false.
145  case('GMTED2010')
146  cnvtopo_usegtopo30 = .false.
147  cnvtopo_usegmted2010 = .true.
148  cnvtopo_usedem50m = .false.
149  case('DEM50M')
150  cnvtopo_usegtopo30 = .false.
151  cnvtopo_usegmted2010 = .false.
152  cnvtopo_usedem50m = .true.
153  case('COMBINE')
154  cnvtopo_usegtopo30 = .true.
155  cnvtopo_usegmted2010 = .true.
156  cnvtopo_usedem50m = .true.
157  case default
158  write(*,*) ' xxx Unsupported TYPE:', trim(cnvtopo_name)
159  call prc_mpistop
160  endselect
161 
162  cnvtopo_donothing = .true.
163 
164  if ( cnvtopo_usegtopo30 ) then
165  cnvtopo_donothing = .false.
166  if( io_l ) write(io_fid_log,*) '*** Use GTOPO, global 30 arcsec. data'
167  if ( cnvtopo_usegmted2010 ) then
168  if( io_l ) write(io_fid_log,*) '*** Use GMTED2010, new global 5 arcsec. data'
169  if( io_l ) write(io_fid_log,*) '*** Overwrite Existing region'
170  endif
171  if ( cnvtopo_usedem50m ) then
172  if( io_l ) write(io_fid_log,*) '*** Use DEM 50m data for Japan region'
173  if( io_l ) write(io_fid_log,*) '*** Overwrite Japan region'
174  endif
175  elseif ( cnvtopo_usegmted2010 ) then
176  cnvtopo_donothing = .false.
177  if( io_l ) write(io_fid_log,*) '*** Use GMTED2010, new global 5 arcsec. data'
178  if ( cnvtopo_usedem50m ) then
179  if( io_l ) write(io_fid_log,*) '*** Use DEM 50m data for Japan region'
180  if( io_l ) write(io_fid_log,*) '*** Overwrite Japan region'
181  endif
182  elseif ( cnvtopo_usedem50m ) then
183  cnvtopo_donothing = .false.
184  if( io_l ) write(io_fid_log,*) '*** Use DEM 50m data, Japan region only'
185  endif
186 
187  if ( cnvtopo_donothing ) then
188  if( io_l ) write(io_fid_log,*) '*** Do nothing for landuse index'
189  else
190  drad(:,:) = min( real_dlat(:,:), real_dlon(:,:) )
191  call comm_horizontal_min( drad_min, drad(:,:) )
192 
193  if ( cnvtopo_unittile_ddeg > 0.0_rp ) then
194  cnvtopo_oversampling_factor = ( drad_min / d2r ) / cnvtopo_unittile_ddeg
195  endif
196  cnvtopo_oversampling_factor = max( 1.0_rp, cnvtopo_oversampling_factor )
197  cnvtopo_unittile_ddeg = ( drad_min / d2r ) / cnvtopo_oversampling_factor
198 
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
201  endif
202 
203  if( cnvtopo_smooth_maxslope > 0.0_rp ) then
204 
205  cnvtopo_smooth_maxslope_limit = cnvtopo_smooth_maxslope
206 
207  else
208  minslope(:,:) = huge
209 
210  j = js-1
211  i = is-1
212  do k = ks, ke
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 )
216  enddo
217 
218  j = js-1
219  do i = is, ie
220  do k = ks, ke
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 )
224  enddo
225  enddo
226 
227  i = is-1
228  do j = js, je
229  do k = ks, ke
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 )
233  enddo
234  enddo
235 
236  do j = js, je
237  do i = is, ie
238  do k = ks, ke
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 )
242  enddo
243  enddo
244  enddo
245 
246  call comm_horizontal_min( cnvtopo_smooth_maxslope_limit, minslope(:,:) )
247  end if
248 
249  return
250  end subroutine cnvtopo_setup
251 
252  !-----------------------------------------------------------------------------
254  subroutine cnvtopo
255  use scale_process, only: &
257  use scale_const, only: &
258  pi => const_pi
259  use scale_grid, only: &
260  cbfx => grid_cbfx, &
261  cbfy => grid_cbfy
262  use scale_topography, only: &
263  topo_fillhalo, &
264  topo_zsfc, &
265  topo_write
266  use mod_copytopo, only: &
267  copytopo
268  implicit none
269 
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  call cnvtopo_smooth( topo_zsfc(:,:) ) ! (inout)
293  call topo_fillhalo
294 
295  if( cnvtopo_copy_parent ) call copytopo( topo_zsfc )
296 
297  if( io_l ) write(io_fid_log,*) '++++++ END CONVERT TOPOGRAPHY DATA ++++++'
298 
299  ! output topography file
300  call topo_write
301  endif
302 
303  return
304  end subroutine cnvtopo
305 
306  !-----------------------------------------------------------------------------
308  subroutine cnvtopo_gtopo30
309  use scale_process, only: &
311  use scale_const, only: &
312  radius => const_radius, &
313  eps => const_eps, &
314  d2r => const_d2r
315  use scale_topography, only: &
316  topo_zsfc
317  use scale_grid_real, only: &
318  real_laty, &
319  real_lonx
320  implicit none
321 
322  character(len=H_LONG) :: GTOPO30_IN_CATALOGUE = ''
323  character(len=H_LONG) :: GTOPO30_IN_DIR = ''
324 
325  namelist / param_cnvtopo_gtopo30 / &
326  gtopo30_in_catalogue, &
327  gtopo30_in_dir
328 
329  ! data catalogue list
330  integer, parameter :: TILE_nlim = 100
331  integer :: TILE_nmax
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)
337 
338  ! GTOPO30 data
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
343 
344  ! GTOPO30 data (oversampling)
345  integer :: ios
346  integer :: jos
347  integer :: isize
348  integer :: jsize
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
354 
355  integer :: iloc
356  integer :: jloc
357  real(RP) :: ifrac_l ! fraction for iloc
358  real(RP) :: jfrac_b ! fraction for jloc
359 
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
365 
366  character(len=H_LONG) :: fname
367 
368  real(RP) :: zerosw
369  logical :: hit_lat, hit_lon
370  integer :: index
371  integer :: fid, ierr
372  integer :: i, j, ii, jj, iii, jjj, t
373  !---------------------------------------------------------------------------
374 
375  if( io_l ) write(io_fid_log,*)
376  if( io_l ) write(io_fid_log,*) '++++++ Module[convert GTOPO30] / Categ[preprocess] / Origin[SCALE-RM]'
377 
378  !--- read namelist
379  rewind(io_fid_conf)
380  read(io_fid_conf,nml=param_cnvtopo_gtopo30,iostat=ierr)
381  if( ierr < 0 ) then !--- missing
382  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
383  elseif( ierr > 0 ) then !--- fatal error
384  write(*,*) 'xxx Not appropriate names in namelist PARAM_CNVTOPO_GTOPO30. Check!'
385  call prc_mpistop
386  endif
387  if( io_lnml ) write(io_fid_log,nml=param_cnvtopo_gtopo30)
388 
389  do j = 1, ja
390  do i = 1, ia
391  area_sum(i,j) = 0.0_rp
392  topo_sum(i,j) = 0.0_rp
393  enddo
394  enddo
395 
396  domain_lats = minval(real_laty(:,:))
397  domain_late = maxval(real_laty(:,:))
398  domain_lons = minval(real_lonx(:,:))
399  domain_lone = maxval(real_lonx(:,:))
400 
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
405 
406  allocate( tile_height(isize,jsize) )
407  allocate( tile_lath(0:jsize) )
408  allocate( tile_lonh(0:isize) )
409 
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
412 
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
417 
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
422 
423  !---< READ from external files >---
424 
425  ! catalogue file
426  fname = trim(gtopo30_in_dir)//'/'//trim(gtopo30_in_catalogue)
427 
428  if( io_l ) write(io_fid_log,*)
429  if( io_l ) write(io_fid_log,*) '+++ Input catalogue file:', trim(fname)
430 
431  fid = io_get_available_fid()
432  open( fid, &
433  file = trim(fname), &
434  form = 'formatted', &
435  status = 'old', &
436  iostat = ierr )
437 
438  if ( ierr /= 0 ) then
439  write(*,*) 'xxx catalogue file not found!', trim(fname)
440  call prc_mpistop
441  endif
442 
443  do t = 1, tile_nlim
444  read(fid,*,iostat=ierr) index, tile_lats(t), tile_late(t), & ! South->North
445  tile_lons(t), tile_lone(t), & ! WEST->EAST
446  tile_fname(t)
447  if ( ierr /= 0 ) exit
448  enddo
449 
450  tile_nmax = t - 1
451  close(fid)
452 
453  ! data file
454  do t = 1, tile_nmax
455  hit_lat = .false.
456  hit_lon = .false.
457 
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
460  hit_lat = .true.
461  endif
462 
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
465  hit_lat = .true.
466  endif
467 
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
470  hit_lon = .true.
471  endif
472 
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
475  hit_lon = .true.
476  endif
477 
478  if ( hit_lat .AND. hit_lon ) then
479  fname = trim(gtopo30_in_dir)//'/'//trim(tile_fname(t))
480 
481  if( io_l ) write(io_fid_log,*)
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)
487 
488  fid = io_get_available_fid()
489  open( fid, &
490  file = trim(fname), &
491  form = 'unformatted', &
492  access = 'direct', &
493  status = 'old', &
494  recl = isize_orig*jsize_orig*2, &
495  iostat = ierr )
496 
497  if ( ierr /= 0 ) then
498  write(*,*) 'xxx data file not found!'
499  call prc_mpistop
500  endif
501 
502  read(fid,rec=1) tile_height_orig(:,:)
503  close(fid)
504 
505  ! oversampling
506  do jj = 1, jsize_orig
507  do ii = 1, isize_orig
508  do j = 1, jos
509  do i = 1, ios
510  jjj = (jj-1) * jos + j
511  iii = (ii-1) * ios + i
512 
513  tile_height(iii,jjj) = tile_height_orig(ii,jsize_orig-jj+1) ! reverse y-axis
514  enddo
515  enddo
516  enddo
517  enddo
518 
519  tile_lath(0) = tile_lats(t) * d2r
520  do jj = 1, jsize
521  tile_lath(jj) = tile_lath(jj-1) + tile_dlat
522 ! if( IO_L ) write(IO_FID_LOG,*) jj, TILE_LATH(jj)
523  enddo
524 
525  tile_lonh(0) = tile_lons(t) * d2r
526  do ii = 1, isize
527  tile_lonh(ii) = tile_lonh(ii-1) + tile_dlon
528 ! if( IO_L ) write(IO_FID_LOG,*) ii, TILE_LONH(ii)
529  enddo
530 
531  ! match and calc fraction
532  do jj = 1, jsize
533  do ii = 1, isize
534 
535  iloc = 1 ! Z_sfc(1,1) is used for dummy grid
536  ifrac_l = 1.0_rp
537 
538  jloc = 1 ! Z_sfc(1,1) is used for dummy grid
539  jfrac_b = 1.0_rp
540 
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
545  cycle
546  endif
547 
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
554 
555  iloc = i
556  ifrac_l = min( real_lonx(i,j)-tile_lonh(ii-1), tile_dlon ) / tile_dlon
557 
558  jloc = j
559  jfrac_b = min( real_laty(i,j)-tile_lath(jj-1), tile_dlat ) / tile_dlat
560  exit jloop
561 
562  endif
563  enddo iloop
564  enddo jloop
565 
566  if( iloc == 1 .AND. jloc == 1 ) cycle
567 
568  topo = real( TILE_HEIGHT(ii,jj), kind=rp )
569  mask = 0.5_rp - sign( 0.5_rp, topo ) ! if Height is negative, mask = 1
570 
571  area = radius * radius * tile_dlon * ( sin(tile_lath(jj))-sin(tile_lath(jj-1)) ) * ( 1.0_rp - mask )
572 
573 ! if( IO_L ) write(IO_FID_LOG,*) ii, jj, area, iloc, jloc, ifrac_l, jfrac_b, TILE_HEIGHT(ii,jj)
574 
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
578 
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
582 
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
586 
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
590  enddo
591  enddo
592 
593  endif
594  enddo ! tile loop
595 
596  do j = js, je
597  do i = is, ie
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 )
600  enddo
601  enddo
602 
603  return
604  end subroutine cnvtopo_gtopo30
605 
606  !-----------------------------------------------------------------------------
608  subroutine cnvtopo_gmted2010
609  implicit none
610  !---------------------------------------------------------------------------
611 
612  return
613  end subroutine cnvtopo_gmted2010
614 
615  !-----------------------------------------------------------------------------
617  subroutine cnvtopo_dem50m
618  use scale_process, only: &
620  use scale_const, only: &
621  radius => const_radius, &
622  eps => const_eps, &
623  d2r => const_d2r
624  use scale_topography, only: &
625  topo_zsfc
626  use scale_grid_real, only: &
627  real_laty, &
628  real_lonx
629  implicit none
630 
631  character(len=H_LONG) :: DEM50M_IN_CATALOGUE = ''
632  character(len=H_LONG) :: DEM50M_IN_DIR = ''
633 
634  namelist / param_cnvtopo_dem50m / &
635  dem50m_in_catalogue, &
636  dem50m_in_dir
637 
638  ! data catalogue list
639  integer, parameter :: TILE_nlim = 1000
640  integer :: TILE_nmax
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)
646 
647  ! DEM50M data
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
652 
653  ! DEM50M data (oversampling)
654  integer :: ios
655  integer :: jos
656  integer :: isize
657  integer :: jsize
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
663 
664  integer :: iloc
665  integer :: jloc
666  real(RP) :: ifrac_l ! fraction for iloc
667  real(RP) :: jfrac_b ! fraction for jloc
668 
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
674 
675  character(len=H_LONG) :: fname
676 
677  real(RP) :: zerosw
678  logical :: hit_lat, hit_lon
679  integer :: index
680  integer :: fid, ierr
681  integer :: i, j, ii, jj, iii, jjj, t
682  !---------------------------------------------------------------------------
683 
684  if( io_l ) write(io_fid_log,*)
685  if( io_l ) write(io_fid_log,*) '++++++ Module[convert DEM50M] / Categ[preprocess] / Origin[SCALE-RM]'
686 
687  !--- read namelist
688  rewind(io_fid_conf)
689  read(io_fid_conf,nml=param_cnvtopo_dem50m,iostat=ierr)
690  if( ierr < 0 ) then !--- missing
691  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
692  elseif( ierr > 0 ) then !--- fatal error
693  write(*,*) 'xxx Not appropriate names in namelist PARAM_CNVTOPO_DEM50M. Check!'
694  call prc_mpistop
695  endif
696  if( io_lnml ) write(io_fid_log,nml=param_cnvtopo_dem50m)
697 
698  do j = 1, ja
699  do i = 1, ia
700  area_sum(i,j) = 0.0_rp
701  topo_sum(i,j) = 0.0_rp
702  enddo
703  enddo
704 
705  domain_lats = minval(real_laty(:,:))
706  domain_late = maxval(real_laty(:,:))
707  domain_lons = minval(real_lonx(:,:))
708  domain_lone = maxval(real_lonx(:,:))
709 
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
714 
715  allocate( tile_height(isize,jsize) )
716  allocate( tile_lath(0:jsize) )
717  allocate( tile_lonh(0:isize) )
718 
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
721 
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
726 
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
731 
732  !---< READ from external files >---
733 
734  ! catalogue file
735  fname = trim(dem50m_in_dir)//'/'//trim(dem50m_in_catalogue)
736 
737  if( io_l ) write(io_fid_log,*)
738  if( io_l ) write(io_fid_log,*) '+++ Input catalogue file:', trim(fname)
739 
740  fid = io_get_available_fid()
741  open( fid, &
742  file = trim(fname), &
743  form = 'formatted', &
744  status = 'old', &
745  iostat = ierr )
746 
747  if ( ierr /= 0 ) then
748  write(*,*) 'xxx catalogue file not found!', trim(fname)
749  call prc_mpistop
750  endif
751 
752  do t = 1, tile_nlim
753  read(fid,*,iostat=ierr) index, tile_lats(t), tile_late(t), & ! South->North
754  tile_lons(t), tile_lone(t), & ! WEST->EAST
755  tile_fname(t)
756  if ( ierr /= 0 ) exit
757  enddo
758 
759  tile_nmax = t - 1
760  close(fid)
761 
762  ! data file
763  do t = 1, tile_nmax
764  hit_lat = .false.
765  hit_lon = .false.
766 
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
769  hit_lat = .true.
770  endif
771 
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
774  hit_lat = .true.
775  endif
776 
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
779  hit_lon = .true.
780  endif
781 
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
784  hit_lon = .true.
785  endif
786 
787  if ( hit_lat .AND. hit_lon ) then
788  fname = trim(dem50m_in_dir)//'/'//trim(tile_fname(t))
789 
790  if( io_l ) write(io_fid_log,*)
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)
796 
797  fid = io_get_available_fid()
798  open( fid, &
799  file = trim(fname), &
800  form = 'unformatted', &
801  access = 'direct', &
802  status = 'old', &
803  recl = isize_orig*jsize_orig*4, &
804  iostat = ierr )
805 
806  if ( ierr /= 0 ) then
807  write(*,*) 'xxx data file not found!'
808  call prc_mpistop
809  endif
810 
811  read(fid,rec=1) tile_height_orig(:,:)
812  close(fid)
813 
814  ! oversampling
815  do jj = 1, jsize_orig
816  do ii = 1, isize_orig
817  do j = 1, jos
818  do i = 1, ios
819  jjj = (jj-1) * jos + j
820  iii = (ii-1) * ios + i
821 
822  tile_height(iii,jjj) = tile_height_orig(ii,jj)
823  enddo
824  enddo
825  enddo
826  enddo
827 
828  tile_lath(0) = tile_lats(t) * d2r
829  do jj = 1, jsize
830  tile_lath(jj) = tile_lath(jj-1) + tile_dlat
831 ! if( IO_L ) write(IO_FID_LOG,*) jj, TILE_LATH(jj)
832  enddo
833 
834  tile_lonh(0) = tile_lons(t) * d2r
835  do ii = 1, isize
836  tile_lonh(ii) = tile_lonh(ii-1) + tile_dlon
837 ! if( IO_L ) write(IO_FID_LOG,*) ii, TILE_LONH(ii)
838  enddo
839 
840  ! match and calc fraction
841  do jj = 1, jsize
842  do ii = 1, isize
843 
844  iloc = 1 ! Z_sfc(1,1) is used for dummy grid
845  ifrac_l = 1.0_rp
846 
847  jloc = 1 ! Z_sfc(1,1) is used for dummy grid
848  jfrac_b = 1.0_rp
849 
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
854  cycle
855  endif
856 
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
863 
864  iloc = i
865  ifrac_l = min( real_lonx(i,j)-tile_lonh(ii-1), tile_dlon ) / tile_dlon
866 
867  jloc = j
868  jfrac_b = min( real_laty(i,j)-tile_lath(jj-1), tile_dlat ) / tile_dlat
869  exit jloop
870 
871  endif
872  enddo iloop
873  enddo jloop
874 
875  if( iloc == 1 .AND. jloc == 1 ) cycle
876 
877  topo = real( TILE_HEIGHT(ii,jj), kind=rp )
878  mask = 0.5_rp - sign( 0.5_rp,topo ) ! if Height is negative, mask = 1
879 
880  area = radius * radius * tile_dlon * ( sin(tile_lath(jj))-sin(tile_lath(jj-1)) ) * ( 1.0_rp - mask )
881 
882 ! if( IO_L ) write(IO_FID_LOG,*) ii, jj, area, iloc, jloc, ifrac_l, jfrac_b, TILE_HEIGHT(ii,jj)
883 
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
887 
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
891 
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
895 
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
899  enddo
900  enddo
901 
902  endif
903  enddo ! tile loop
904 
905  do j = js, je
906  do i = is, ie
907  mask = 0.5_rp + sign( 0.5_rp, area_sum(i,j)-eps ) ! if any data is found, overwrite
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 )
910  topo_zsfc(i,j) = ( mask ) * topo & ! overwrite
911  + ( 1.0_rp-mask ) * topo_zsfc(i,j) ! keep existing value
912  enddo
913  enddo
914 
915  return
916  end subroutine cnvtopo_dem50m
917 
918  !-----------------------------------------------------------------------------
920  subroutine cnvtopo_smooth( &
921  Zsfc )
922  use scale_const, only: &
923  d2r => const_d2r
924  use scale_process, only: &
926  use scale_grid, only: &
927  dx, &
928  dy, &
929  grid_fdx, &
930  grid_fdy
931  use scale_comm, only: &
932  comm_horizontal_max
933  use scale_rm_statistics, only: &
935  use scale_topography, only: &
937  implicit none
938 
939  real(RP), intent(inout) :: Zsfc(ia,ja)
940 
941  real(RP) :: DZsfc_DX(1,ia,ja,1) ! d(Zsfc)/dx at u-position
942  real(RP) :: DZsfc_DY(1,ia,ja,1) ! d(Zsfc)/dy at v-position
943 
944  real(RP) :: DXL(ia-1)
945  real(RP) :: DYL(ja-1)
946 
947  real(RP) :: FLX_X(ia,ja)
948  real(RP) :: FLX_Y(ia,ja)
949  real(RP) :: FLX_TMP(ia,ja)
950 
951  real(RP) :: slope(ia,ja)
952  real(RP) :: maxslope
953  real(RP) :: flag
954 
955  character(len=H_SHORT) :: varname(1)
956 
957  integer :: ite
958  integer :: i, j
959  !---------------------------------------------------------------------------
960 
961  if( io_l ) write(io_fid_log,*)
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
965 
966  if ( cnvtopo_smooth_local ) then
967  dxl(:) = dx
968  dyl(:) = dy
969  else
970  dxl(:) = grid_fdx(:)
971  dyl(:) = grid_fdy(:)
972  endif
973 
974  ! digital filter
975  do ite = 1, cnvtopo_smooth_itelim+1
976  if( io_l ) write(io_fid_log,*)
977  if( io_l ) write(io_fid_log,*) '*** Smoothing itelation : ', ite
978 
979  call topo_fillhalo( zsfc )
980 
981  do j = 1, ja
982  do i = 1, ia-1
983  dzsfc_dx(1,i,j,1) = atan2( ( zsfc(i+1,j)-zsfc(i,j) ), dxl(i) ) / d2r
984  enddo
985  enddo
986  dzsfc_dx(1,ia,:,1) = 0.0_rp
987  do j = 1, ja-1
988  do i = 1, ia
989  dzsfc_dy(1,i,j,1) = atan2( ( zsfc(i,j+1)-zsfc(i,j) ), dyl(j) ) / d2r
990  enddo
991  enddo
992  dzsfc_dy(1,:,ja,1) = 0.0_rp
993 
994  slope(:,:) = max( abs(dzsfc_dx(1,:,:,1)), abs(dzsfc_dy(1,:,:,1)) )
995  call comm_horizontal_max( maxslope, slope(:,:) )
996 
997  if( io_l ) write(io_fid_log,*) '*** maximum slope [deg] : ', maxslope
998 
999  if( maxslope < cnvtopo_smooth_maxslope_limit ) exit
1000 
1001  varname(1) = "DZsfc_DX"
1002  call stat_detail( dzsfc_dx(:,:,:,:), varname(:) )
1003  varname(1) = "DZsfc_DY"
1004  call stat_detail( dzsfc_dy(:,:,:,:), varname(:) )
1005 
1006  select case ( cnvtopo_smooth_type )
1007  case ( 'GAUSSIAN' )
1008 
1009  ! 3 by 3 gaussian filter
1010  do j = js, je
1011  do i = is, ie
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) )
1021  enddo
1022  enddo
1023 
1024  case ( 'LAPLACIAN' )
1025 
1026  do j = js , je
1027  do i = is-1, ie
1028  flx_x(i,j) = zsfc(i+1,j) - zsfc(i,j)
1029 ! FLX_TMP(i,j) = Zsfc(i+1,j) - Zsfc(i,j)
1030  enddo
1031  enddo
1032 !!$ call TOPO_fillhalo( FLX_TMP )
1033 !!$ do j = JS , JE
1034 !!$ do i = IS-1, IE
1035 !!$ FLX_X(i,j) = - ( FLX_TMP(i+1,j) - FLX_TMP(i,j) )
1036 !!$ enddo
1037 !!$ enddo
1038 
1039  do j = js-1, je
1040  do i = is , ie
1041  flx_y(i,j) = zsfc(i,j+1) - zsfc(i,j)
1042 ! FLX_TMP(i,j) = Zsfc(i,j+1) - Zsfc(i,j)
1043  enddo
1044  enddo
1045 !!$ call TOPO_fillhalo( FLX_TMP )
1046 !!$ do j = JS-1, JE
1047 !!$ do i = IS , IE
1048 !!$ FLX_Y(i,j) = - ( FLX_TMP(i,j+1) - FLX_TMP(i,j) )
1049 !!$ enddo
1050 !!$ enddo
1051 
1052 
1053  if ( cnvtopo_smooth_local ) then
1054  do j = js , je
1055  do i = is-1, ie
1056  flag = 0.5_rp &
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) &
1066  * dxl(i) / grid_fdx(i) &
1067  * flag
1068  enddo
1069  enddo
1070  do j = js-1, je
1071  do i = is , ie
1072  flag = 0.5_rp &
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) &
1082  * dyl(j) / grid_fdy(j) &
1083  * flag
1084  enddo
1085  enddo
1086  endif
1087 
1088  do j = js, je
1089  do i = is, ie
1090  zsfc(i,j) = max( 0.0_rp, &
1091  zsfc(i,j) &
1092  + 0.1_rp * ( ( flx_x(i,j) - flx_x(i-1,j) ) &
1093  + ( flx_y(i,j) - flx_y(i,j-1) ) ) )
1094  enddo
1095  enddo
1096 
1097  case default
1098  write(*,*) 'xxx Invalid smoothing type'
1099  call prc_mpistop
1100  end select
1101 
1102  enddo
1103 
1104  if ( ite > cnvtopo_smooth_itelim ) then
1105  write(*,*) 'xxx not converged'
1106  call prc_mpistop
1107  else
1108  if( io_l ) write(io_fid_log,*) '*** smoothing complete.'
1109  endif
1110 
1111  varname(1) = "DZsfc_DX"
1112  call stat_detail( dzsfc_dx(:,:,:,:), varname(:) )
1113  varname(1) = "DZsfc_DY"
1114  call stat_detail( dzsfc_dy(:,:,:,:), varname(:) )
1115 
1116  if( io_l ) write(io_fid_log,*)
1117 
1118  return
1119  end subroutine cnvtopo_smooth
1120 
1121 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:70
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)