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  ! calculate landuse factors
285  call landuse_fillhalo( fill_bnd=.true. )
286  call landuse_calc_fact
287 
288  log_progress(*) 'end convert landuse data'
289 
290  endif
291 
292  return
293  end subroutine cnvlanduse
294 
295  !-----------------------------------------------------------------------------
297  subroutine cnvlanduse_glccv2( PFT_weight )
298  use scale_prc, only: &
299  prc_abort
300  use scale_const, only: &
301  radius => const_radius, &
302  d2r => const_d2r
303  use scale_atmos_grid_cartesc, only: &
304  fx => atmos_grid_cartesc_fx, &
305  fy => atmos_grid_cartesc_fy, &
306  cx => atmos_grid_cartesc_cx, &
307  cy => atmos_grid_cartesc_cy
308  use scale_file_tiledata, only: &
309  file_tiledata_get_info, &
310  file_tiledata_get_latlon, &
311  file_tiledata_get_data
312  use scale_mapprojection, only: &
313  mapprojection_lonlat2xy
314  use scale_landuse, only: &
315  landuse_pft_nmax
316  implicit none
317 
318  real(rp), intent(inout) :: pft_weight(-2:landuse_pft_nmax,ia,ja)
319 
320  character(len=H_LONG) :: glccv2_in_dir = '.'
321  character(len=H_LONG) :: glccv2_in_catalogue = ''
322 
323  namelist / param_cnvlanduse_glccv2 / &
324  glccv2_in_dir, &
325  glccv2_in_catalogue
326 
327  ! GLCCv2 data
328  integer, parameter :: categ_nmax = 25
329  real(rp), parameter :: glccv2_dlat = 30.0_rp / 60.0_rp / 60.0_rp ! 30 arc sec.
330  real(rp), parameter :: glccv2_dlon = 30.0_rp / 60.0_rp / 60.0_rp ! 30 arc sec.
331 
332  integer :: lookuptable(1:categ_nmax)
333  data lookuptable / 0, & ! 1 Urban and Built-Up Land -> 0 urban
334  7, & ! 2 Dryland Cropland and Pasture -> 7 Dryland Cropland and Pasture
335  8, & ! 3 Irrigated Cropland and Pasture -> 8 Irrigated Cropland and Pasture
336  9, & ! 4 Mixed Cropland and Pasture -> 9 Mixed Cropland and Pasture
337  5, & ! 5 Cropland/Grassland Mosaic -> 5 Cropland/Grassland Mosaic
338  6, & ! 6 Cropland/Woodland Mosaic -> 6 Cropland/Woodland Mosaic
339  2, & ! 7 Grassland -> 2 Grassland
340  3, & ! 8 Shrubland -> 3 Shrubland
341  4, & ! 9 Mixed Shrubland/Grassland -> 4 Mixed Shrubland/Grassland
342  4, & ! 10 Savanna -> 4 Mixed Shrubland/Grassland
343  11, & ! 11 Deciduous Broadleaf Forest -> 11 Deciduous Broadleaf Forest
344  12, & ! 12 Deciduous Needleleaf Forest -> 12 Deciduous Needleleaf Forest
345  13, & ! 13 Evergreen Broadleaf Forest -> 13 Deciduous Broadleaf Forest
346  14, & ! 14 Evergreen Needleleaf Forest -> 14 Deciduous Needleleaf Forest
347  15, & ! 15 Mixed Forest -> 15 Mixed Forest
348  -2, & ! 16 Water Bodies -> -2 Lake/River
349  10, & ! 17 Herbaceous Wetland -> 10 Paddy
350  10, & ! 18 Wooded Wetland -> 10 Paddy
351  1, & ! 19 Barren or Sparsely Vegetated -> 1 Dessert
352  16, & ! 20 Herbaceous Tundra -> 16 Tundra
353  16, & ! 21 Wooded Tundra -> 16 Tundra
354  16, & ! 22 Mixed Tundra -> 16 Tundra
355  16, & ! 23 Bare Ground Tundra -> 16 Tundra
356  17, & ! 24 Snow or Ice -> 17 Gracier
357  -1 / ! 25+ Sea Surface -> -1 Sea Surface
358 
359  !---------------------------------------------------------------------------
360 
361  ! data catalogue list
362  integer, parameter :: tile_nlim = 100
363  integer :: tile_nmax
364  character(len=H_LONG) :: tile_fname(tile_nlim)
365  logical :: tile_hit (tile_nlim)
366  integer :: tile_js (tile_nlim)
367  integer :: tile_je (tile_nlim)
368  integer :: tile_is (tile_nlim)
369  integer :: tile_ie (tile_nlim)
370  real(rp) :: tile_dlat, tile_dlon
371 
372  integer, allocatable :: landuse(:,:)
373  real(rp), allocatable :: lath(:,:), lonh(:,:)
374  real(rp), allocatable :: lath_1d(:), lonh_1d(:)
375  real(rp), allocatable :: xh(:,:), yh(:,:)
376  integer :: nlonh, nlath
377 
378  integer :: global_ia
379 
380  character(len=H_LONG) :: fname
381 
382  logical :: hit, no_hit_x
383  real(rp) :: dmin, d
384  integer :: min_i, min_j
385  real(rp) :: limit
386 
387  integer :: ish, ieh, jsh, jeh
388  logical :: zonal, pole
389  integer :: lu
390  integer :: ierr
391  integer :: i, j, ii, jj, p
392  !---------------------------------------------------------------------------
393 
394  !--- read namelist
395  rewind(io_fid_conf)
396  read(io_fid_conf,nml=param_cnvlanduse_glccv2,iostat=ierr)
397  if( ierr < 0 ) then !--- missing
398  log_info("CNVLANDUSE_GLCCv2",*) 'Not found namelist. Default used.'
399  elseif( ierr > 0 ) then !--- fatal error
400  log_error("CNVLANDUSE_GLCCv2",*) 'Not appropriate names in namelist PARAM_CNVLANDUSE_GLCCv2. Check!'
401  call prc_abort
402  endif
403  log_nml(param_cnvlanduse_glccv2)
404 
405 
406  tile_dlat = glccv2_dlat * d2r
407  tile_dlon = glccv2_dlon * d2r
408 
409  ! catalogue file
410  fname = trim(glccv2_in_dir)//'/'//trim(glccv2_in_catalogue)
411 
412  call file_tiledata_get_info( tile_nlim, & ! [IN]
413  tile_dlat, tile_dlon, & ! [IN]
414  domain_lats, domain_late, domain_lons, domain_lone, & ! [IN]
415  fname, & ! [IN]
416  global_ia, & ! [OUT]
417  tile_nmax, & ! [OUT]
418  tile_fname(:), tile_hit(:), & ! [OUT]
419  tile_js(:), tile_je(:), tile_is(:), tile_ie(:), & ! [OUT]
420  nlath, nlonh, jsh, jeh, ish, ieh, zonal, pole ) ! [OUT]
421 
422  allocate( landuse(nlonh,nlath) )
423  allocate( lath(nlonh,nlath) )
424  allocate( lonh(nlonh,nlath) )
425  allocate( lath_1d(nlath) )
426  allocate( lonh_1d(nlonh) )
427  allocate( yh(nlonh,nlath) )
428  allocate( xh(nlonh,nlath) )
429 
430  call file_tiledata_get_latlon( nlath, nlonh, & ! [IN]
431  jsh, ish, & ! [IN]
432  tile_dlat, tile_dlon, & ! [IN]
433  lath_1d(:), lonh_1d(:) ) ! [OUT]
434 
435  call file_tiledata_get_data( nlath, nlonh, & ! [IN]
436  glccv2_in_dir, & ! [IN]
437  global_ia, & ! [IN]
438  tile_nmax, & ! [IN]
439  tile_dlat, tile_dlon, & ! [IN]
440  tile_fname(:), tile_hit(:), & ! [IN]
441  tile_js(:), tile_je(:), tile_is(:), tile_ie(:), & ! [IN]
442  jsh, jeh, ish, ieh, & ! [IN]
443  "INT1", & ! [IN]
444  landuse(:,:) ) ! [OUT]
445 
446  !$omp parallel do collapse(2)
447  do j = 1, nlath
448  do i = 1, nlonh
449  lath(i,j) = lath_1d(j)
450  lonh(i,j) = lonh_1d(i)
451  end do
452  end do
453 
454  call mapprojection_lonlat2xy( nlonh, 1, nlonh, nlath, 1, nlath, &
455  lonh(:,:), lath(:,:), & ! [IN]
456  xh(:,:), yh(:,:) ) ! [OUT]
457 
458  limit = ( tile_dlat * radius * 1.5_rp )**2
459  !$omp parallel do collapse(2) &
460  !$omp private(hit,no_hit_x,lu,p,dmin,min_i,min_j,d)
461  do j = 1, ja
462  do i = 1, ia
463  hit = .false.
464  dmin = d_large
465  min_i = -1
466  min_j = -1
467  do jj = 1, nlath
468  no_hit_x = .true.
469  do ii = 1, nlonh
470  if ( fx(i-1) <= xh(ii,jj) .and. xh(ii,jj) < fx(i) &
471  .and. fy(j-1) <= yh(ii,jj) .and. yh(ii,jj) < fy(j) ) then
472  no_hit_x = .false.
473  lu = min( landuse(ii,jj), categ_nmax )
474  if ( 1 <= lu ) then
475  p = lookuptable(lu)
476  pft_weight(p,i,j) = pft_weight(p,i,j) + cos(lath(ii,jj)) ! area weight
477  hit = .true.
478  cycle
479  end if
480  end if
481  d = ( xh(ii,jj)-cx(i) )**2 + ( yh(ii,jj)-cy(j) )**2
482  lu = min( landuse(ii,jj), categ_nmax )
483  if ( d < dmin .and. 1 <= lu ) then
484  dmin = d
485  min_i = ii
486  min_j = jj
487  end if
488  end do
489  if ( hit .and. no_hit_x ) exit
490  end do
491  if ( ( .not. hit ) .and. dmin < limit ) then
492  lu = min( landuse(min_i,min_j), categ_nmax )
493  p = lookuptable(lu)
494  pft_weight(p,i,j) = 1.0_rp
495  end if
496  end do
497  end do
498 
499  deallocate( landuse, lath, lonh, yh, xh )
500 
501  return
502  end subroutine cnvlanduse_glccv2
503 
504  !-----------------------------------------------------------------------------
506  subroutine cnvlanduse_lu100m( PFT_weight )
507  use scale_prc, only: &
508  prc_abort
509  use scale_const, only: &
510  undef2 => const_undef2, &
511  radius => const_radius, &
512  d2r => const_d2r
513  use scale_atmos_grid_cartesc, only: &
514  fx => atmos_grid_cartesc_fx, &
515  fy => atmos_grid_cartesc_fy, &
516  cx => atmos_grid_cartesc_cx, &
517  cy => atmos_grid_cartesc_cy
518  use scale_file_tiledata, only: &
519  file_tiledata_get_info, &
520  file_tiledata_get_latlon, &
521  file_tiledata_get_data
522  use scale_mapprojection, only: &
523  mapprojection_lonlat2xy
524  use scale_landuse, only: &
525  landuse_pft_nmax
526  implicit none
527 
528  real(rp), intent(inout) :: pft_weight(-2:landuse_pft_nmax,ia,ja)
529 
530  character(len=H_LONG) :: lu100m_in_dir = '.'
531  character(len=H_LONG) :: lu100m_in_catalogue = ''
532 
533  namelist / param_cnvlanduse_lu100m / &
534  lu100m_in_dir, &
535  lu100m_in_catalogue
536 
537  ! LU100M data
538  integer, parameter :: categ_nmax = 16
539  real(rp), parameter :: lu100m_dlat = 5.0_rp / 60.0_rp / 100.0_rp
540  real(rp), parameter :: lu100m_dlon = 7.5_rp / 60.0_rp / 100.0_rp
541 
542  integer :: lookuptable(1:16)
543  data lookuptable / 10, & ! 1 paddy -> 10 Paddy
544  9, & ! 2 cropland -> 9 Mixed Cropland and Pasture
545  1, & ! 3 UNDEF -> 1 Dessert
546  1, & ! 4 UNDEF -> 1 Dessert
547  11, & ! 5 forest -> 11 Deciduous Broadleaf Forest
548  1, & ! 6 bareground -> 1 Dessert
549  0, & ! 7 urban building -> 0 Urban and Built-up Land
550  1, & ! 8 UNDEF -> 1 Dessert
551  0, & ! 9 motorway -> 0 Urban and Built-up Land
552  0, & ! 10 urban ground -> 0 Urban and Built-up Land
553  -2, & ! 11 lake,river -> -2 Lake/River
554  1, & ! 12 UNDEF -> 1 Dessert
555  1, & ! 13 UNDEF -> 1 Dessert
556  1, & ! 14 seashore -> 1 Dessert
557  -1, & ! 15 ocean -> -1 Sea Surface
558  2 / ! 16 golf course -> 2 Grassland
559 
560  !---------------------------------------------------------------------------
561 
562  ! data catalogue list
563  integer, parameter :: tile_nlim = 1000
564  integer :: tile_nmax
565  character(len=H_LONG) :: tile_fname(tile_nlim)
566  logical :: tile_hit (tile_nlim)
567  integer :: tile_js (tile_nlim)
568  integer :: tile_je (tile_nlim)
569  integer :: tile_is (tile_nlim)
570  integer :: tile_ie (tile_nlim)
571  real(rp) :: tile_dlat, tile_dlon
572 
573  integer, allocatable :: landuse(:,:)
574  real(rp), allocatable :: lath (:,:)
575  real(rp), allocatable :: lonh (:,:)
576  real(rp), allocatable :: lath_1d(:)
577  real(rp), allocatable :: lonh_1d(:)
578  real(rp), allocatable :: xh(:,:), yh(:,:)
579  integer :: nlonh, nlath
580 
581  integer :: global_ia
582 
583  character(len=H_LONG) :: fname
584 
585  logical :: hit, no_hit_x
586  real(rp) :: dmin, d
587  integer :: min_i, min_j
588  real(rp) :: limit
589 
590  integer :: ish, ieh, jsh, jeh
591  logical :: zonal, pole
592  integer :: lu
593  integer :: ierr
594  integer :: i, j, ii, jj, p
595  !---------------------------------------------------------------------------
596 
597  !--- read namelist
598  rewind(io_fid_conf)
599  read(io_fid_conf,nml=param_cnvlanduse_lu100m,iostat=ierr)
600  if( ierr < 0 ) then !--- missing
601  log_info("CNVLANDUSE_LU100M",*) 'Not found namelist. Default used.'
602  elseif( ierr > 0 ) then !--- fatal error
603  log_error("CNVLANDUSE_LU100M",*) 'Not appropriate names in namelist PARAM_CNVLANDUSE_LU100M. Check!'
604  call prc_abort
605  endif
606  log_nml(param_cnvlanduse_lu100m)
607 
608 
609  tile_dlat = lu100m_dlat * d2r
610  tile_dlon = lu100m_dlon * d2r
611 
612  ! catalogue file
613  fname = trim(lu100m_in_dir)//'/'//trim(lu100m_in_catalogue)
614 
615  call file_tiledata_get_info( tile_nlim, & ! [IN]
616  tile_dlat, tile_dlon, & ! [IN]
617  domain_lats, domain_late, domain_lons, domain_lone, & ! [IN]
618  fname, & ! [IN]
619  global_ia, & ! [OUT]
620  tile_nmax, & ! [OUT]
621  tile_fname(:), tile_hit(:), & ! [OUT]
622  tile_js(:), tile_je(:), tile_is(:), tile_ie(:), & ! [OUT]
623  nlath, nlonh, jsh, jeh, ish, ieh, zonal, pole ) ! [OUT]
624 
625  if ( .not. any(tile_hit(1:tile_nmax) ) ) return
626 
627  allocate( landuse(nlonh,nlath) )
628  allocate( lath(nlonh,nlath) )
629  allocate( lonh(nlonh,nlath) )
630  allocate( lath_1d(nlath) )
631  allocate( lonh_1d(nlonh) )
632  allocate( yh(nlonh,nlath) )
633  allocate( xh(nlonh,nlath) )
634 
635  call file_tiledata_get_latlon( nlath, nlonh, & ! [IN]
636  jsh, ish, & ! [IN]
637  tile_dlat, tile_dlon, & ! [IN]
638  lath_1d(:), lonh_1d(:) ) ! [OUT]
639 
640  call file_tiledata_get_data( nlath, nlonh, & ! [IN]
641  lu100m_in_dir, & ! [IN]
642  global_ia, & ! [IN]
643  tile_nmax, & ! [IN]
644  tile_dlat, tile_dlon, & ! [IN]
645  tile_fname(:), tile_hit(:), & ! [IN]
646  tile_js(:), tile_je(:), tile_is(:), tile_ie(:), & ! [IN]
647  jsh, jeh, ish, ieh, & ! [IN]
648  "REAL4", & ! [IN]
649  landuse(:,:), & ! [OUT]
650  min_value = 1 ) ! [IN]
651 
652  !$omp parallel do collapse(2)
653  do j = 1, nlath
654  do i = 1, nlonh
655  lath(i,j) = lath_1d(j)
656  lonh(i,j) = lonh_1d(i)
657  end do
658  end do
659 
660  call mapprojection_lonlat2xy( nlonh, 1, nlonh, nlath, 1, nlath, &
661  lonh(:,:), lath(:,:), & ! [IN]
662  xh(:,:), yh(:,:) ) ! [OUT]
663 
664  limit = ( tile_dlat * radius * 1.5_rp )**2
665  !$omp parallel do collapse(2) &
666  !$omp private(hit,no_hit_x,lu,p,dmin,min_i,min_j,d)
667  do j = 1, ja
668  do i = 1, ia
669  hit = .false.
670  dmin = d_large
671  min_i = -1
672  min_j = -1
673  do jj = 1, nlath
674  no_hit_x = .true.
675  do ii = 1, nlonh
676  if ( fx(i-1) <= xh(ii,jj) .and. xh(ii,jj) < fx(i) &
677  .and. fy(j-1) <= yh(ii,jj) .and. yh(ii,jj) < fy(j) ) then
678  no_hit_x = .false.
679  lu = landuse(ii,jj)
680  if ( lu /= undef2 ) then
681  if ( .not. hit ) pft_weight(:,i,j) = 0.0_rp
682  p = lookuptable(lu)
683  pft_weight(p,i,j) = pft_weight(p,i,j) + 1.0_rp
684  hit = .true.
685  cycle
686  end if
687  end if
688  d = ( xh(ii,jj)-cx(i) )**2 + ( yh(ii,jj)-cy(j) )**2
689  if ( d < dmin ) then
690  dmin = d
691  min_i = ii
692  min_j = jj
693  end if
694  end do
695  if ( hit .and. no_hit_x ) exit
696  end do
697  if ( ( .not. hit ) .and. dmin < limit ) then
698  lu = landuse(min_i,min_j)
699  if ( lu /= undef2 ) then
700  pft_weight(:,i,j) = 0.0_rp
701  p = lookuptable(lu)
702  pft_weight(p,i,j) = 1.0_rp
703  end if
704  end if
705  end do
706  end do
707 
708  deallocate( landuse, lath, lonh, yh, xh )
709 
710  return
711  end subroutine cnvlanduse_lu100m
712 
713  !-----------------------------------------------------------------------------
715  subroutine cnvlanduse_jibis( PFT_weight )
716  use scale_landuse, only: &
717  landuse_pft_nmax
718  implicit none
719 
720  real(rp), intent(inout) :: pft_weight(-2:landuse_pft_nmax,ia,ja)
721  !---------------------------------------------------------------------------
722 
723  return
724  end subroutine cnvlanduse_jibis
725 
726 end module mod_cnvlanduse
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_const::const_undef2
integer, parameter, public const_undef2
undefined value (INT2)
Definition: scale_const.F90:38
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:239
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:33
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:57
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:68
scale_landuse::landuse_pft_mosaic
integer, public landuse_pft_mosaic
number of PFT mosaic
Definition: scale_landuse.F90:64
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:55
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:54
scale_landuse::landuse_index_pft
integer, dimension(:,:,:), allocatable, public landuse_index_pft
index of PFT for each mosaic
Definition: scale_landuse.F90:67
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:58
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:67
scale_landuse::landuse_pft_nmax
integer, public landuse_pft_nmax
number of plant functional type(PFT)
Definition: scale_landuse.F90:63
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:66
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:56
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:175
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:57
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:54
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:44
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:56
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:32
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:56
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:271
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:55
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:49
Generated by   doxygen 1.8.17