SCALE-RM
mod_cnvlanduse.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
9 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
11 module mod_cnvlanduse
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use scale_precision
17  use scale_io
18  use scale_prof
19  use scale_atmos_grid_cartesc_index
20  use scale_tracer
21  !-----------------------------------------------------------------------------
22  implicit none
23  private
24  !-----------------------------------------------------------------------------
25  !
26  !++ Public procedure
27  !
28  public :: cnvlanduse_setup
29  public :: cnvlanduse
30 
31  !-----------------------------------------------------------------------------
32  !
33  !++ Public parameters & variables
34  !
35  logical, public :: cnvlanduse_donothing
36  logical, public :: cnvlanduse_useglccv2 = .false.
37  logical, public :: cnvlanduse_uselu100m = .false.
38  logical, public :: cnvlanduse_usejibis = .false.
39 
40  !-----------------------------------------------------------------------------
41  !
42  !++ Private procedure
43  !
44  private :: cnvlanduse_glccv2
45  private :: cnvlanduse_lu100m
46  private :: cnvlanduse_jibis
47 
48  !-----------------------------------------------------------------------------
49  !
50  !++ Private parameters & variables
51  !
52  real(rp), private :: cnvlanduse_limit_urban_fraction = 1.0_rp
53 
54  real(rp), private :: domain_lats, domain_late
55  real(rp), private :: domain_lons, domain_lone
56  real(rp), private :: domain_dlat
57 
58  real(rp), private, parameter :: d_large = 1e20_rp
59  !-----------------------------------------------------------------------------
60 contains
61  !-----------------------------------------------------------------------------
63  subroutine cnvlanduse_setup
64  use scale_prc, only: &
65  prc_abort
66  implicit none
67 
68  character(len=H_SHORT) :: cnvlanduse_name = 'NONE' ! keep backward compatibility
69 
70  namelist / param_cnvlanduse / &
71  cnvlanduse_name, &
72  cnvlanduse_useglccv2, &
73  cnvlanduse_uselu100m, &
74 ! CNVLANDUSE_UseJIBIS
75  cnvlanduse_limit_urban_fraction
76 
77  integer :: ierr
78  !---------------------------------------------------------------------------
79 
80  log_newline
81  log_info("CNVLANDUSE_setup",*) 'Setup'
82  !--- read namelist
83  rewind(io_fid_conf)
84  read(io_fid_conf,nml=param_cnvlanduse,iostat=ierr)
85  if( ierr < 0 ) then !--- missing
86  log_info("CNVLANDUSE_setup",*) 'Not found namelist. Default used.'
87  elseif( ierr > 0 ) then !--- fatal error
88  log_error("CNVLANDUSE_setup",*) 'Not appropriate names in namelist PARAM_CNVLANDUSE. Check!'
89  call prc_abort
90  endif
91  log_nml(param_cnvlanduse)
92 
93  select case(cnvlanduse_name)
94  case('NONE')
95  ! do nothing
96  case('GLCCv2')
97  cnvlanduse_useglccv2 = .true.
98  cnvlanduse_uselu100m = .false.
99  cnvlanduse_usejibis = .false.
100  case('LU100M')
101  cnvlanduse_useglccv2 = .false.
102  cnvlanduse_uselu100m = .true.
103  cnvlanduse_usejibis = .false.
104  case('COMBINE')
105  cnvlanduse_useglccv2 = .true.
106  cnvlanduse_uselu100m = .true.
107  cnvlanduse_usejibis = .true.
108  case default
109  log_error("CNVLANDUSE_setup",*) 'Unsupported TYPE: ', trim(cnvlanduse_name)
110  call prc_abort
111  endselect
112 
113  cnvlanduse_donothing = .true.
114 
115  if ( cnvlanduse_useglccv2 ) then
116  cnvlanduse_donothing = .false.
117  log_info("CNVLANDUSE_setup",*) 'Use GLCC ver.2, global 30 arcsec. data'
118  if ( cnvlanduse_uselu100m ) then
119  log_info("CNVLANDUSE_setup",*) 'Use KSJ landuse 100m data for Japan region'
120  log_info("CNVLANDUSE_setup",*) 'Overwrite Japan region'
121  if ( cnvlanduse_usejibis ) then
122  log_info("CNVLANDUSE_setup",*) 'Use J-IBIS map 100m data for Japan region'
123  log_info("CNVLANDUSE_setup",*) 'Overwrite Japan region (PFT only)'
124  endif
125  endif
126  elseif ( cnvlanduse_uselu100m ) then
127  cnvlanduse_donothing = .false.
128  log_info("CNVLANDUSE_setup",*) 'Use KSJ landuse 100m data, Japan region only'
129  if ( cnvlanduse_usejibis ) then
130  log_info("CNVLANDUSE_setup",*) 'Use J-IBIS map 100m data for Japan region'
131  log_info("CNVLANDUSE_setup",*) 'Overwrite Japan region (PFT only)'
132  endif
133  endif
134 
135  if ( cnvlanduse_donothing ) then
136  log_info("CNVLANDUSE_setup",*) 'Do nothing for landuse index'
137  endif
138 
139  return
140  end subroutine cnvlanduse_setup
141 
142  !-----------------------------------------------------------------------------
144  subroutine cnvlanduse
145  use scale_const, only: &
146  eps => const_eps, &
147  d2r => const_d2r
148  use scale_prc, only: &
149  prc_abort
150  use scale_sort, only: &
151  sort_exec
152  use scale_landuse, only: &
153  landuse_frac_land, &
154  landuse_frac_lake, &
155  landuse_frac_urban, &
156  landuse_pft_mosaic, &
157  landuse_pft_nmax, &
158  landuse_frac_pft, &
159  landuse_index_pft, &
160  landuse_calc_fact, &
161  landuse_fillhalo
162  use scale_atmos_grid_cartesc_real, only: &
163  latxv => atmos_grid_cartesc_real_latxv, &
164  lonuy => atmos_grid_cartesc_real_lonuy, &
165  dlat => atmos_grid_cartesc_real_dlat
166  implicit none
167 
168  real(rp) :: pft_weight(-2:landuse_pft_nmax,ia,ja)
169  integer :: pft_idx(landuse_pft_nmax)
170  real(rp) :: lake_wgt, ocean_wgt, urban_wgt, land_wgt
171  real(rp) :: allsum
172  real(rp) :: zerosw
173 
174  integer :: i, j, p
175  !---------------------------------------------------------------------------
176 
177  if ( cnvlanduse_donothing ) then
178  log_newline
179  log_progress(*) 'skip convert landuse data'
180  else
181  log_newline
182  log_progress(*) 'start convert landuse data'
183 
184  domain_lats = minval( latxv(:,:) )
185  domain_late = maxval( latxv(:,:) )
186  domain_lons = minval( lonuy(:,:) )
187  domain_lone = maxval( lonuy(:,:) )
188  domain_dlat = maxval( dlat(:,:) )
189 
190  log_info("CNVLANDUSE",*) 'Domain Information'
191  log_info_cont(*) 'Domain (LAT) :', domain_lats/d2r, domain_late/d2r
192  log_info_cont(*) ' (LON) :', domain_lons/d2r, domain_lone/d2r
193 
194 
195  !$omp parallel do
196 !OCL XFILL
197  do j = 1, ja
198  do i = 1, ia
199  pft_weight(:,i,j) = 0.0_rp
200  end do
201  end do
202 
203  if ( cnvlanduse_useglccv2 ) then
204  call cnvlanduse_glccv2( pft_weight(:,:,:) ) ! [INOUT]
205  endif
206 
207  if ( cnvlanduse_uselu100m ) then
208  call cnvlanduse_lu100m( pft_weight(:,:,:) ) ! [INOUT]
209  endif
210 
211  if ( cnvlanduse_usejibis ) then
212  call cnvlanduse_jibis( pft_weight(:,:,:) ) ! [INOUT]
213  endif
214 
215  !$omp parallel do &
216  !$omp private(lake_wgt,ocean_wgt,urban_wgt,land_wgt,allsum,zerosw,PFT_idx)
217  do j = js, je
218  do i = is, ie
219 
220  lake_wgt = pft_weight(-2,i,j)
221  ocean_wgt = pft_weight(-1,i,j)
222  urban_wgt = pft_weight( 0,i,j)
223  land_wgt = sum( pft_weight(1:,i,j) )
224 
225  do p = 1, landuse_pft_nmax
226  pft_idx(p) = p
227  end do
228  call sort_exec( landuse_pft_nmax, pft_weight(1:,i,j), pft_idx(:) )
229 
230 
231  ! total = ocean + lake + urban + land
232 
233  ! land fraction : total - ocean / total
234  allsum = lake_wgt + ocean_wgt + urban_wgt + land_wgt
235  zerosw = 0.5_rp - sign( 0.5_rp, allsum-eps )
236  landuse_frac_land(i,j) = min( ( allsum-ocean_wgt ) * ( 1.0_rp-zerosw ) / ( allsum-zerosw ), 1.0_rp )
237 
238  ! lake fraction : lake / ( lake + urban + land )
239  allsum = lake_wgt + urban_wgt + land_wgt
240  zerosw = 0.5_rp - sign( 0.5_rp, allsum-eps )
241  landuse_frac_lake(i,j) = min( lake_wgt * ( 1.0_rp-zerosw ) / ( allsum-zerosw ), 1.0_rp )
242 
243  ! urban fraction : urban / ( urban + land )
244  allsum = urban_wgt + land_wgt
245  zerosw = 0.5_rp - sign( 0.5_rp, allsum-eps )
246  landuse_frac_urban(i,j) = min( urban_wgt * ( 1.0_rp-zerosw ) / ( allsum-zerosw ), 1.0_rp )
247 
248  ! PFT fraction : PFT / sum( PFT(1:mosaic) )
249  allsum = sum( pft_weight(landuse_pft_nmax-landuse_pft_mosaic+1:,i,j) )
250  if ( allsum > eps ) then
251  do p = 1, landuse_pft_mosaic
252  landuse_frac_pft(i,j,p) = min( pft_weight(landuse_pft_nmax-p+1,i,j) / allsum, 1.0_rp )
253  landuse_index_pft(i,j,p) = pft_idx(landuse_pft_nmax-p+1)
254  enddo
255  ! if no second PFT, set to same as PFT1
256  if ( abs(landuse_frac_pft(i,j,1)-1.0_rp) <= eps ) then
257  landuse_frac_pft(i,j,:) = 0.0_rp
258  landuse_frac_pft(i,j,1) = 1.0_rp
259  landuse_index_pft(i,j,:) = pft_idx(landuse_pft_nmax)
260  endif
261  else ! if no PFT, set to bare ground
262  landuse_frac_pft(i,j,:) = 0.0_rp
263  landuse_frac_pft(i,j,1) = 1.0_rp
264  landuse_index_pft(i,j,:) = 1
265  endif
266 
267  enddo
268  enddo
269 
270  if ( cnvlanduse_limit_urban_fraction < 1.0_rp ) then
271  !$omp parallel do
272  do j = js, je
273  do i = is, ie
274  if ( landuse_frac_urban(i,j) == 1.0_rp ) then ! if no PFT, set to grassland
275  landuse_frac_pft(i,j,:) = 0.0_rp
276  landuse_frac_pft(i,j,1) = 1.0_rp
277  landuse_index_pft(i,j,:) = 2 ! Grassland
278  endif
279  landuse_frac_urban(i,j) = min( landuse_frac_urban(i,j), cnvlanduse_limit_urban_fraction )
280  enddo
281  enddo
282  endif
283 
284  !$acc update device(LANDUSE_frac_land, LANDUSE_frac_lake, LANDUSE_frac_urban)
285  !$acc update device(LANDUSE_frac_PFT, LANDUSE_index_PFT)
286 
287  ! calculate landuse factors
288  call landuse_fillhalo( fill_bnd=.true. )
289  call landuse_calc_fact
290 
291  log_progress(*) 'end convert landuse data'
292 
293  endif
294 
295  return
296  end subroutine cnvlanduse
297 
298  !-----------------------------------------------------------------------------
300  subroutine cnvlanduse_glccv2( PFT_weight )
301  use scale_prc, only: &
302  prc_abort
303  use scale_const, only: &
304  radius => const_radius, &
305  d2r => const_d2r
306  use scale_atmos_grid_cartesc, only: &
307  fx => atmos_grid_cartesc_fx, &
308  fy => atmos_grid_cartesc_fy, &
309  cx => atmos_grid_cartesc_cx, &
310  cy => atmos_grid_cartesc_cy
311  use scale_file_tiledata, only: &
312  file_tiledata_get_info, &
313  file_tiledata_get_latlon, &
314  file_tiledata_get_data
315  use scale_mapprojection, only: &
316  mapprojection_lonlat2xy
317  use scale_landuse, only: &
318  landuse_pft_nmax
319  implicit none
320 
321  real(rp), intent(inout) :: pft_weight(-2:landuse_pft_nmax,ia,ja)
322 
323  character(len=H_LONG) :: glccv2_in_dir = '.'
324  character(len=H_LONG) :: glccv2_in_catalogue = ''
325 
326  namelist / param_cnvlanduse_glccv2 / &
327  glccv2_in_dir, &
328  glccv2_in_catalogue
329 
330  ! GLCCv2 data
331  integer, parameter :: categ_nmax = 25
332  real(rp), parameter :: glccv2_dlat = 30.0_rp / 60.0_rp / 60.0_rp ! 30 arc sec.
333  real(rp), parameter :: glccv2_dlon = 30.0_rp / 60.0_rp / 60.0_rp ! 30 arc sec.
334 
335  integer :: lookuptable(1:categ_nmax)
336  data lookuptable / 0, & ! 1 Urban and Built-Up Land -> 0 urban
337  7, & ! 2 Dryland Cropland and Pasture -> 7 Dryland Cropland and Pasture
338  8, & ! 3 Irrigated Cropland and Pasture -> 8 Irrigated Cropland and Pasture
339  9, & ! 4 Mixed Cropland and Pasture -> 9 Mixed Cropland and Pasture
340  5, & ! 5 Cropland/Grassland Mosaic -> 5 Cropland/Grassland Mosaic
341  6, & ! 6 Cropland/Woodland Mosaic -> 6 Cropland/Woodland Mosaic
342  2, & ! 7 Grassland -> 2 Grassland
343  3, & ! 8 Shrubland -> 3 Shrubland
344  4, & ! 9 Mixed Shrubland/Grassland -> 4 Mixed Shrubland/Grassland
345  4, & ! 10 Savanna -> 4 Mixed Shrubland/Grassland
346  11, & ! 11 Deciduous Broadleaf Forest -> 11 Deciduous Broadleaf Forest
347  12, & ! 12 Deciduous Needleleaf Forest -> 12 Deciduous Needleleaf Forest
348  13, & ! 13 Evergreen Broadleaf Forest -> 13 Deciduous Broadleaf Forest
349  14, & ! 14 Evergreen Needleleaf Forest -> 14 Deciduous Needleleaf Forest
350  15, & ! 15 Mixed Forest -> 15 Mixed Forest
351  -2, & ! 16 Water Bodies -> -2 Lake/River
352  10, & ! 17 Herbaceous Wetland -> 10 Paddy
353  10, & ! 18 Wooded Wetland -> 10 Paddy
354  1, & ! 19 Barren or Sparsely Vegetated -> 1 Dessert
355  16, & ! 20 Herbaceous Tundra -> 16 Tundra
356  16, & ! 21 Wooded Tundra -> 16 Tundra
357  16, & ! 22 Mixed Tundra -> 16 Tundra
358  16, & ! 23 Bare Ground Tundra -> 16 Tundra
359  17, & ! 24 Snow or Ice -> 17 Gracier
360  -1 / ! 25+ Sea Surface -> -1 Sea Surface
361 
362  !---------------------------------------------------------------------------
363 
364  ! data catalogue list
365  integer, parameter :: tile_nlim = 100
366  integer :: tile_nmax
367  character(len=H_LONG) :: tile_fname(tile_nlim)
368  logical :: tile_hit (tile_nlim)
369  integer :: tile_js (tile_nlim)
370  integer :: tile_je (tile_nlim)
371  integer :: tile_is (tile_nlim)
372  integer :: tile_ie (tile_nlim)
373  real(rp) :: tile_dlat, tile_dlon
374 
375  integer, allocatable :: landuse(:,:)
376  real(rp), allocatable :: lath(:,:), lonh(:,:)
377  real(rp), allocatable :: lath_1d(:), lonh_1d(:)
378  real(rp), allocatable :: xh(:,:), yh(:,:)
379  integer :: nlonh, nlath
380 
381  integer :: global_ia
382 
383  character(len=H_LONG) :: fname
384 
385  logical :: hit, no_hit_x
386  real(rp) :: dmin, d
387  integer :: min_i, min_j
388  real(rp) :: limit
389 
390  integer :: ish, ieh, jsh, jeh
391  logical :: zonal, pole
392  integer :: lu
393  integer :: ierr
394  integer :: i, j, ii, jj, p
395  !---------------------------------------------------------------------------
396 
397  !--- read namelist
398  rewind(io_fid_conf)
399  read(io_fid_conf,nml=param_cnvlanduse_glccv2,iostat=ierr)
400  if( ierr < 0 ) then !--- missing
401  log_info("CNVLANDUSE_GLCCv2",*) 'Not found namelist. Default used.'
402  elseif( ierr > 0 ) then !--- fatal error
403  log_error("CNVLANDUSE_GLCCv2",*) 'Not appropriate names in namelist PARAM_CNVLANDUSE_GLCCv2. Check!'
404  call prc_abort
405  endif
406  log_nml(param_cnvlanduse_glccv2)
407 
408 
409  tile_dlat = glccv2_dlat * d2r
410  tile_dlon = glccv2_dlon * d2r
411 
412  ! catalogue file
413  fname = trim(glccv2_in_dir)//'/'//trim(glccv2_in_catalogue)
414 
415  call file_tiledata_get_info( tile_nlim, & ! [IN]
416  tile_dlat, tile_dlon, & ! [IN]
417  domain_lats, domain_late, domain_lons, domain_lone, & ! [IN]
418  fname, & ! [IN]
419  global_ia, & ! [OUT]
420  tile_nmax, & ! [OUT]
421  tile_fname(:), tile_hit(:), & ! [OUT]
422  tile_js(:), tile_je(:), tile_is(:), tile_ie(:), & ! [OUT]
423  nlath, nlonh, jsh, jeh, ish, ieh, zonal, pole ) ! [OUT]
424 
425  allocate( landuse(nlonh,nlath) )
426  allocate( lath(nlonh,nlath) )
427  allocate( lonh(nlonh,nlath) )
428  allocate( lath_1d(nlath) )
429  allocate( lonh_1d(nlonh) )
430  allocate( yh(nlonh,nlath) )
431  allocate( xh(nlonh,nlath) )
432 
433  call file_tiledata_get_latlon( nlath, nlonh, & ! [IN]
434  jsh, ish, & ! [IN]
435  tile_dlat, tile_dlon, & ! [IN]
436  lath_1d(:), lonh_1d(:) ) ! [OUT]
437 
438  call file_tiledata_get_data( nlath, nlonh, & ! [IN]
439  glccv2_in_dir, & ! [IN]
440  global_ia, & ! [IN]
441  tile_nmax, & ! [IN]
442  tile_dlat, tile_dlon, & ! [IN]
443  tile_fname(:), tile_hit(:), & ! [IN]
444  tile_js(:), tile_je(:), tile_is(:), tile_ie(:), & ! [IN]
445  jsh, jeh, ish, ieh, & ! [IN]
446  "INT1", & ! [IN]
447  landuse(:,:) ) ! [OUT]
448 
449  !$omp parallel do collapse(2)
450  do j = 1, nlath
451  do i = 1, nlonh
452  lath(i,j) = lath_1d(j)
453  lonh(i,j) = lonh_1d(i)
454  end do
455  end do
456 
457  call mapprojection_lonlat2xy( nlonh, 1, nlonh, nlath, 1, nlath, &
458  lonh(:,:), lath(:,:), & ! [IN]
459  xh(:,:), yh(:,:) ) ! [OUT]
460 
461  limit = ( tile_dlat * radius * 1.5_rp )**2
462  !$omp parallel do collapse(2) &
463  !$omp private(hit,no_hit_x,lu,p,dmin,min_i,min_j,d)
464  do j = 1, ja
465  do i = 1, ia
466  hit = .false.
467  dmin = d_large
468  min_i = -1
469  min_j = -1
470  do jj = 1, nlath
471  no_hit_x = .true.
472  do ii = 1, nlonh
473  if ( fx(i-1) <= xh(ii,jj) .and. xh(ii,jj) < fx(i) &
474  .and. fy(j-1) <= yh(ii,jj) .and. yh(ii,jj) < fy(j) ) then
475  no_hit_x = .false.
476  lu = min( landuse(ii,jj), categ_nmax )
477  if ( 1 <= lu ) then
478  p = lookuptable(lu)
479  pft_weight(p,i,j) = pft_weight(p,i,j) + cos(lath(ii,jj)) ! area weight
480  hit = .true.
481  cycle
482  end if
483  end if
484  d = ( xh(ii,jj)-cx(i) )**2 + ( yh(ii,jj)-cy(j) )**2
485  lu = min( landuse(ii,jj), categ_nmax )
486  if ( d < dmin .and. 1 <= lu ) then
487  dmin = d
488  min_i = ii
489  min_j = jj
490  end if
491  end do
492  if ( hit .and. no_hit_x ) exit
493  end do
494  if ( ( .not. hit ) .and. dmin < limit ) then
495  lu = min( landuse(min_i,min_j), categ_nmax )
496  p = lookuptable(lu)
497  pft_weight(p,i,j) = 1.0_rp
498  end if
499  end do
500  end do
501 
502  deallocate( landuse, lath, lonh, yh, xh )
503 
504  return
505  end subroutine cnvlanduse_glccv2
506 
507  !-----------------------------------------------------------------------------
509  subroutine cnvlanduse_lu100m( PFT_weight )
510  use scale_prc, only: &
511  prc_abort
512  use scale_const, only: &
513  undef2 => const_undef2, &
514  radius => const_radius, &
515  d2r => const_d2r
516  use scale_atmos_grid_cartesc, only: &
517  fx => atmos_grid_cartesc_fx, &
518  fy => atmos_grid_cartesc_fy, &
519  cx => atmos_grid_cartesc_cx, &
520  cy => atmos_grid_cartesc_cy
521  use scale_file_tiledata, only: &
522  file_tiledata_get_info, &
523  file_tiledata_get_latlon, &
524  file_tiledata_get_data
525  use scale_mapprojection, only: &
526  mapprojection_lonlat2xy
527  use scale_landuse, only: &
528  landuse_pft_nmax
529  implicit none
530 
531  real(rp), intent(inout) :: pft_weight(-2:landuse_pft_nmax,ia,ja)
532 
533  character(len=H_LONG) :: lu100m_in_dir = '.'
534  character(len=H_LONG) :: lu100m_in_catalogue = ''
535 
536  namelist / param_cnvlanduse_lu100m / &
537  lu100m_in_dir, &
538  lu100m_in_catalogue
539 
540  ! LU100M data
541  integer, parameter :: categ_nmax = 16
542  real(rp), parameter :: lu100m_dlat = 5.0_rp / 60.0_rp / 100.0_rp
543  real(rp), parameter :: lu100m_dlon = 7.5_rp / 60.0_rp / 100.0_rp
544 
545  integer :: lookuptable(1:16)
546  data lookuptable / 10, & ! 1 paddy -> 10 Paddy
547  9, & ! 2 cropland -> 9 Mixed Cropland and Pasture
548  1, & ! 3 UNDEF -> 1 Dessert
549  1, & ! 4 UNDEF -> 1 Dessert
550  11, & ! 5 forest -> 11 Deciduous Broadleaf Forest
551  1, & ! 6 bareground -> 1 Dessert
552  0, & ! 7 urban building -> 0 Urban and Built-up Land
553  1, & ! 8 UNDEF -> 1 Dessert
554  0, & ! 9 motorway -> 0 Urban and Built-up Land
555  0, & ! 10 urban ground -> 0 Urban and Built-up Land
556  -2, & ! 11 lake,river -> -2 Lake/River
557  1, & ! 12 UNDEF -> 1 Dessert
558  1, & ! 13 UNDEF -> 1 Dessert
559  1, & ! 14 seashore -> 1 Dessert
560  -1, & ! 15 ocean -> -1 Sea Surface
561  2 / ! 16 golf course -> 2 Grassland
562 
563  !---------------------------------------------------------------------------
564 
565  ! data catalogue list
566  integer, parameter :: tile_nlim = 1000
567  integer :: tile_nmax
568  character(len=H_LONG) :: tile_fname(tile_nlim)
569  logical :: tile_hit (tile_nlim)
570  integer :: tile_js (tile_nlim)
571  integer :: tile_je (tile_nlim)
572  integer :: tile_is (tile_nlim)
573  integer :: tile_ie (tile_nlim)
574  real(rp) :: tile_dlat, tile_dlon
575 
576  integer, allocatable :: landuse(:,:)
577  real(rp), allocatable :: lath (:,:)
578  real(rp), allocatable :: lonh (:,:)
579  real(rp), allocatable :: lath_1d(:)
580  real(rp), allocatable :: lonh_1d(:)
581  real(rp), allocatable :: xh(:,:), yh(:,:)
582  integer :: nlonh, nlath
583 
584  integer :: global_ia
585 
586  character(len=H_LONG) :: fname
587 
588  logical :: hit, no_hit_x
589  real(rp) :: dmin, d
590  integer :: min_i, min_j
591  real(rp) :: limit
592 
593  integer :: ish, ieh, jsh, jeh
594  logical :: zonal, pole
595  integer :: lu
596  integer :: ierr
597  integer :: i, j, ii, jj, p
598  !---------------------------------------------------------------------------
599 
600  !--- read namelist
601  rewind(io_fid_conf)
602  read(io_fid_conf,nml=param_cnvlanduse_lu100m,iostat=ierr)
603  if( ierr < 0 ) then !--- missing
604  log_info("CNVLANDUSE_LU100M",*) 'Not found namelist. Default used.'
605  elseif( ierr > 0 ) then !--- fatal error
606  log_error("CNVLANDUSE_LU100M",*) 'Not appropriate names in namelist PARAM_CNVLANDUSE_LU100M. Check!'
607  call prc_abort
608  endif
609  log_nml(param_cnvlanduse_lu100m)
610 
611 
612  tile_dlat = lu100m_dlat * d2r
613  tile_dlon = lu100m_dlon * d2r
614 
615  ! catalogue file
616  fname = trim(lu100m_in_dir)//'/'//trim(lu100m_in_catalogue)
617 
618  call file_tiledata_get_info( tile_nlim, & ! [IN]
619  tile_dlat, tile_dlon, & ! [IN]
620  domain_lats, domain_late, domain_lons, domain_lone, & ! [IN]
621  fname, & ! [IN]
622  global_ia, & ! [OUT]
623  tile_nmax, & ! [OUT]
624  tile_fname(:), tile_hit(:), & ! [OUT]
625  tile_js(:), tile_je(:), tile_is(:), tile_ie(:), & ! [OUT]
626  nlath, nlonh, jsh, jeh, ish, ieh, zonal, pole ) ! [OUT]
627 
628  if ( .not. any(tile_hit(1:tile_nmax) ) ) return
629 
630  allocate( landuse(nlonh,nlath) )
631  allocate( lath(nlonh,nlath) )
632  allocate( lonh(nlonh,nlath) )
633  allocate( lath_1d(nlath) )
634  allocate( lonh_1d(nlonh) )
635  allocate( yh(nlonh,nlath) )
636  allocate( xh(nlonh,nlath) )
637 
638  call file_tiledata_get_latlon( nlath, nlonh, & ! [IN]
639  jsh, ish, & ! [IN]
640  tile_dlat, tile_dlon, & ! [IN]
641  lath_1d(:), lonh_1d(:) ) ! [OUT]
642 
643  call file_tiledata_get_data( nlath, nlonh, & ! [IN]
644  lu100m_in_dir, & ! [IN]
645  global_ia, & ! [IN]
646  tile_nmax, & ! [IN]
647  tile_dlat, tile_dlon, & ! [IN]
648  tile_fname(:), tile_hit(:), & ! [IN]
649  tile_js(:), tile_je(:), tile_is(:), tile_ie(:), & ! [IN]
650  jsh, jeh, ish, ieh, & ! [IN]
651  "REAL4", & ! [IN]
652  landuse(:,:), & ! [OUT]
653  min_value = 1 ) ! [IN]
654 
655  !$omp parallel do collapse(2)
656  do j = 1, nlath
657  do i = 1, nlonh
658  lath(i,j) = lath_1d(j)
659  lonh(i,j) = lonh_1d(i)
660  end do
661  end do
662 
663  call mapprojection_lonlat2xy( nlonh, 1, nlonh, nlath, 1, nlath, &
664  lonh(:,:), lath(:,:), & ! [IN]
665  xh(:,:), yh(:,:) ) ! [OUT]
666 
667  limit = ( tile_dlat * radius * 1.5_rp )**2
668  !$omp parallel do collapse(2) &
669  !$omp private(hit,no_hit_x,lu,p,dmin,min_i,min_j,d)
670  do j = 1, ja
671  do i = 1, ia
672  hit = .false.
673  dmin = d_large
674  min_i = -1
675  min_j = -1
676  do jj = 1, nlath
677  no_hit_x = .true.
678  do ii = 1, nlonh
679  if ( fx(i-1) <= xh(ii,jj) .and. xh(ii,jj) < fx(i) &
680  .and. fy(j-1) <= yh(ii,jj) .and. yh(ii,jj) < fy(j) ) then
681  no_hit_x = .false.
682  lu = landuse(ii,jj)
683  if ( lu /= undef2 ) then
684  if ( .not. hit ) pft_weight(:,i,j) = 0.0_rp
685  p = lookuptable(lu)
686  pft_weight(p,i,j) = pft_weight(p,i,j) + 1.0_rp
687  hit = .true.
688  cycle
689  end if
690  end if
691  d = ( xh(ii,jj)-cx(i) )**2 + ( yh(ii,jj)-cy(j) )**2
692  if ( d < dmin ) then
693  dmin = d
694  min_i = ii
695  min_j = jj
696  end if
697  end do
698  if ( hit .and. no_hit_x ) exit
699  end do
700  if ( ( .not. hit ) .and. dmin < limit ) then
701  lu = landuse(min_i,min_j)
702  if ( lu /= undef2 ) then
703  pft_weight(:,i,j) = 0.0_rp
704  p = lookuptable(lu)
705  pft_weight(p,i,j) = 1.0_rp
706  end if
707  end if
708  end do
709  end do
710 
711  deallocate( landuse, lath, lonh, yh, xh )
712 
713  return
714  end subroutine cnvlanduse_lu100m
715 
716  !-----------------------------------------------------------------------------
718  subroutine cnvlanduse_jibis( PFT_weight )
719  use scale_landuse, only: &
720  landuse_pft_nmax
721  implicit none
722 
723  real(rp), intent(inout) :: pft_weight(-2:landuse_pft_nmax,ia,ja)
724  !---------------------------------------------------------------------------
725 
726  return
727  end subroutine cnvlanduse_jibis
728 
729 end module mod_cnvlanduse
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:350
scale_const::const_undef2
integer, parameter, public const_undef2
undefined value (INT2)
Definition: scale_const.F90:40
mod_cnvlanduse::cnvlanduse_uselu100m
logical, public cnvlanduse_uselu100m
Definition: mod_cnvlanduse.F90:37
scale_landuse::landuse_calc_fact
subroutine, public landuse_calc_fact
Definition: scale_landuse.F90:238
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_sort
module SORT
Definition: scale_sort.F90:11
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:35
scale_atmos_grid_cartesc::atmos_grid_cartesc_fx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fx
face coordinate [m]: x, local
Definition: scale_atmos_grid_cartesC.F90:58
scale_file_tiledata::file_tiledata_get_info
subroutine, public file_tiledata_get_info(TILE_nlim, TILE_DLAT, TILE_DLON, DOMAIN_LATS, DOMAIN_LATE, DOMAIN_LONS, DOMAIN_LONE, catalog_fname, GLOBAL_IA, TILE_nmax, TILE_fname, TILE_hit, TILE_JS, TILE_JE, TILE_IS, TILE_IE, nLATH, nLONH, jsh, jeh, ish, ieh, zonal, pole, single_fname, LATS, LATE, LONS, LONE)
get tile information
Definition: scale_file_tiledata.F90:62
scale_atmos_grid_cartesc_index::jeh
integer, public jeh
end point of inner domain: y, local (half level)
Definition: scale_atmos_grid_cartesC_index.F90:69
scale_landuse::landuse_pft_mosaic
integer, public landuse_pft_mosaic
number of PFT mosaic
Definition: scale_landuse.F90:65
scale_atmos_grid_cartesc_real
module Atmosphere GRID CartesC Real(real space)
Definition: scale_atmos_grid_cartesC_real.F90:11
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
scale_mapprojection
module Map projection
Definition: scale_mapprojection.F90:12
scale_landuse::landuse_frac_urban
real(rp), dimension(:,:), allocatable, public landuse_frac_urban
urban fraction
Definition: scale_landuse.F90:56
scale_atmos_grid_cartesc_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:54
mod_cnvlanduse::cnvlanduse
subroutine, public cnvlanduse
Driver.
Definition: mod_cnvlanduse.F90:145
scale_io
module STDIO
Definition: scale_io.F90:10
mod_cnvlanduse::cnvlanduse_useglccv2
logical, public cnvlanduse_useglccv2
Definition: mod_cnvlanduse.F90:36
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
scale_landuse::landuse_frac_land
real(rp), dimension(:,:), allocatable, public landuse_frac_land
land fraction
Definition: scale_landuse.F90:55
scale_landuse::landuse_index_pft
integer, dimension(:,:,:), allocatable, public landuse_index_pft
index of PFT for each mosaic
Definition: scale_landuse.F90:68
scale_atmos_grid_cartesc::atmos_grid_cartesc_fy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fy
face coordinate [m]: y, local
Definition: scale_atmos_grid_cartesC.F90:59
scale_atmos_grid_cartesc_index::ieh
integer, public ieh
end point of inner domain: x, local (half level)
Definition: scale_atmos_grid_cartesC_index.F90:68
scale_landuse::landuse_pft_nmax
integer, public landuse_pft_nmax
number of plant functional type(PFT)
Definition: scale_landuse.F90:64
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_atmos_grid_cartesc_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:53
mod_cnvlanduse::cnvlanduse_donothing
logical, public cnvlanduse_donothing
Definition: mod_cnvlanduse.F90:35
scale_landuse::landuse_frac_pft
real(rp), dimension(:,:,:), allocatable, public landuse_frac_pft
fraction of PFT for each mosaic
Definition: scale_landuse.F90:67
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
scale_landuse::landuse_frac_lake
real(rp), dimension(:,:), allocatable, public landuse_frac_lake
lake fraction
Definition: scale_landuse.F90:57
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
scale_file_tiledata::file_tiledata_get_latlon
subroutine, public file_tiledata_get_latlon(nLAT, nLON, jsh, ish, TILE_DLAT, TILE_DLON, LAT, LON)
get tile data
Definition: scale_file_tiledata.F90:177
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_dlat
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_dlat
delta latitude
Definition: scale_atmos_grid_cartesC_real.F90:58
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_latxv
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_latxv
latitude at staggered point (xv) [rad,-pi,pi]
Definition: scale_atmos_grid_cartesC_real.F90:55
mod_cnvlanduse::cnvlanduse_usejibis
logical, public cnvlanduse_usejibis
Definition: mod_cnvlanduse.F90:38
scale_const::const_radius
real(rp), public const_radius
radius of the planet [m]
Definition: scale_const.F90:47
scale_atmos_grid_cartesc_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:55
scale_atmos_grid_cartesc::atmos_grid_cartesc_cy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cy
center coordinate [m]: y, local
Definition: scale_atmos_grid_cartesC.F90:57
mod_cnvlanduse::cnvlanduse_setup
subroutine, public cnvlanduse_setup
Setup.
Definition: mod_cnvlanduse.F90:64
scale_const::const_d2r
real(rp), public const_d2r
degree to radian
Definition: scale_const.F90:33
scale_file_tiledata
module file_tiledata
Definition: scale_file_tiledata.F90:12
mod_cnvlanduse
module Convert LandUseIndex
Definition: mod_cnvlanduse.F90:11
scale_atmos_grid_cartesc
module atmosphere / grid / cartesC
Definition: scale_atmos_grid_cartesC.F90:12
scale_landuse
module LANDUSE
Definition: scale_landuse.F90:19
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_atmos_grid_cartesc_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:56
scale_landuse::landuse_fillhalo
subroutine, public landuse_fillhalo(FILL_BND)
HALO Communication.
Definition: scale_landuse.F90:275
scale_atmos_grid_cartesc::atmos_grid_cartesc_cx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cx
center coordinate [m]: x, local
Definition: scale_atmos_grid_cartesC.F90:56
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lonuy
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lonuy
longitude at staggered point (uy) [rad,0-2pi]
Definition: scale_atmos_grid_cartesC_real.F90:50
Generated by   doxygen 1.8.17