SCALE-RM
scale_landuse.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
17 !-------------------------------------------------------------------------------
18 #include "scalelib.h"
19 module scale_landuse
20  !-----------------------------------------------------------------------------
21  !
22  !++ used modules
23  !
24  use scale_precision
25  use scale_io
26  use scale_prof
27  use scale_atmos_grid_cartesc_index
28  !-----------------------------------------------------------------------------
29  implicit none
30  private
31  !-----------------------------------------------------------------------------
32  !
33  !++ Public procedure
34  !
35  public :: landuse_setup
36  public :: landuse_calc_fact
37  public :: landuse_fillhalo
38  public :: landuse_write
39  public :: landuse_finalize
40 
41  !-----------------------------------------------------------------------------
42  !
43  !++ Public parameters & variables
44  !
45  real(rp), public, allocatable :: landuse_fact_ocean(:,:)
46  real(rp), public, allocatable :: landuse_fact_land (:,:)
47  real(rp), public, allocatable :: landuse_fact_urban(:,:)
48  real(rp), public, allocatable :: landuse_fact_lake (:,:)
49 
50  logical, public, allocatable :: landuse_exists_ocean(:,:)
51  logical, public, allocatable :: landuse_exists_land (:,:)
52  logical, public, allocatable :: landuse_exists_urban(:,:)
53  logical, public, allocatable :: landuse_exists_lake (:,:)
54 
55  real(rp), public, allocatable :: landuse_frac_land (:,:)
56  real(rp), public, allocatable :: landuse_frac_urban(:,:)
57  real(rp), public, allocatable :: landuse_frac_lake (:,:)
58 
59  integer, public, parameter :: landuse_index_ocean = 0
60  integer, public, parameter :: landuse_index_urban = -1
61  integer, public, parameter :: landuse_index_lake = -2
62 
63  integer, public, parameter :: landuse_pft_nmin = -2
64  integer, public :: landuse_pft_nmax = 17
65  integer, public :: landuse_pft_mosaic = 2
66 
67  real(rp), public, allocatable :: landuse_frac_pft (:,:,:)
68  integer, public, allocatable :: landuse_index_pft(:,:,:)
69 
70  !-----------------------------------------------------------------------------
71  !
72  !++ Private procedure
73  !
74  private :: landuse_read
75 
76  !-----------------------------------------------------------------------------
77  !
78  !++ Private parameters & variables
79  !
80  character(len=H_LONG), private :: landuse_in_basename = ''
81  logical, private :: landuse_in_aggregate
82  logical, private :: landuse_in_check_coordinates = .true.
83  character(len=H_LONG), private :: landuse_out_basename = ''
84  logical, private :: landuse_out_aggregate
85  character(len=H_MID), private :: landuse_out_title = 'SCALE-RM LANDUSE'
86  character(len=H_SHORT), private :: landuse_out_dtype = 'DEFAULT'
87  logical, private :: landuse_allocean = .false.
88  logical, private :: landuse_allland = .false.
89  logical, private :: landuse_allurban = .false.
90  logical, private :: landuse_alllake = .false.
91  logical, private :: landuse_ignore_lake = .false.
92  logical, private :: landuse_mosaicworld = .false.
93 
94  !-----------------------------------------------------------------------------
95 contains
96  !-----------------------------------------------------------------------------
98  subroutine landuse_setup( &
99  OCEAN_do, &
100  URBAN_do, &
101  LAKE_do )
102  use scale_prc, only: &
103  prc_abort
104  use scale_file, only: &
105  file_aggregate
106  implicit none
107 
108  logical, intent(in) :: ocean_do
109  logical, intent(in) :: urban_do
110  logical, intent(in) :: lake_do
111 
112  namelist / param_landuse / &
113  landuse_in_basename, &
114  landuse_in_aggregate, &
115  landuse_in_check_coordinates, &
116  landuse_out_basename, &
117  landuse_out_aggregate, &
118  landuse_out_dtype, &
119  landuse_pft_mosaic, &
120  landuse_pft_nmax, &
121  landuse_allocean, &
122  landuse_allland, &
123  landuse_allurban, &
124  landuse_alllake, &
125  landuse_ignore_lake, &
126  landuse_mosaicworld
127 
128  integer :: ierr
129  !---------------------------------------------------------------------------
130 
131  log_newline
132  log_info("LANDUSE_setup",*) 'Setup'
133 
134  landuse_in_aggregate = file_aggregate
135  landuse_out_aggregate = file_aggregate
136 
137  !--- read namelist
138  rewind(io_fid_conf)
139  read(io_fid_conf,nml=param_landuse,iostat=ierr)
140  if( ierr < 0 ) then !--- missing
141  log_info("LANDUSE_setup",*) 'Not found namelist. Default used.'
142  elseif( ierr > 0 ) then !--- fatal error
143  log_error("LANDUSE_setup",*) 'Not appropriate names in namelist PARAM_LANDUSE. Check!'
144  call prc_abort
145  endif
146  log_nml(param_landuse)
147 
148  allocate( landuse_frac_land(ia,ja) )
149  allocate( landuse_frac_urban(ia,ja) )
150  allocate( landuse_frac_lake(ia,ja) )
151  landuse_frac_land(:,:) = 0.0_rp
152  landuse_frac_urban(:,:) = 0.0_rp
153  landuse_frac_lake(:,:) = 0.0_rp
154  !$acc enter data copyin(LANDUSE_frac_land, LANDUSE_frac_urban, LANDUSE_frac_lake)
155 
156  allocate( landuse_index_pft(ia,ja,landuse_pft_mosaic) )
157  allocate( landuse_frac_pft(ia,ja,landuse_pft_mosaic) )
158  landuse_frac_pft(:,:,:) = 0.0_rp
159  landuse_frac_pft(:,:,1) = 1.0_rp ! tentative, mosaic is off
160  landuse_index_pft(:,:,:) = 1 ! default
161  !$acc enter data copyin(LANDUSE_index_PFT, LANDUSE_frac_PFT)
162 
163  allocate( landuse_fact_ocean(ia,ja) )
164  allocate( landuse_fact_land(ia,ja) )
165  allocate( landuse_fact_urban(ia,ja) )
166  allocate( landuse_fact_lake(ia,ja) )
167  landuse_fact_ocean(:,:) = 0.0_rp
168  landuse_fact_land(:,:) = 0.0_rp
169  landuse_fact_urban(:,:) = 0.0_rp
170  landuse_fact_lake(:,:) = 0.0_rp
171  !$acc enter data copyin(LANDUSE_fact_ocean, LANDUSE_fact_land, LANDUSE_fact_urban, LANDUSE_fact_lake)
172 
173  allocate( landuse_exists_ocean(ia,ja) )
174  allocate( landuse_exists_land(ia,ja) )
175  allocate( landuse_exists_urban(ia,ja) )
176  allocate( landuse_exists_lake(ia,ja) )
177  landuse_exists_ocean(:,:) = .false.
178  landuse_exists_land(:,:) = .false.
179  landuse_exists_urban(:,:) = .false.
180  landuse_exists_lake(:,:) = .false.
181  !$acc enter data copyin(LANDUSE_exists_ocean, LANDUSE_exists_land, LANDUSE_exists_urban, LANDUSE_exists_lake)
182 
183 
184 
185  if ( landuse_allocean ) then
186 
187  log_info("LANDUSE_setup",*) 'Assume all grids are ocean'
188 
189  elseif( landuse_allland ) then
190 
191  log_info("LANDUSE_setup",*) 'Assume all grids are land'
192  log_info("LANDUSE_setup",*) 'Assume land PFT is 1 (bare ground)'
193  landuse_frac_land(:,:) = 1.0_rp
194 
195  elseif( landuse_allurban ) then
196 
197  log_info("LANDUSE_setup",*) 'Assume all grids are land'
198  log_info("LANDUSE_setup",*) 'Assume all lands are urban'
199  log_info("LANDUSE_setup",*) 'Assume land PFT is urban: ', landuse_index_urban
200  landuse_frac_land(:,:) = 1.0_rp
201  landuse_frac_urban(:,:) = 1.0_rp
202  landuse_index_pft(:,:,:) = landuse_index_urban
203 
204  elseif( landuse_alllake ) then
205 
206  log_info("LANDUSE_setup",*) 'Assume all grids are land'
207  log_info("LANDUSE_setup",*) 'Assume all lands are lake'
208  log_info("LANDUSE_setup",*) 'Assume land PFT is lake: ', landuse_index_lake
209  landuse_frac_land(:,:) = 1.0_rp
210  landuse_frac_lake(:,:) = 1.0_rp
211  landuse_index_pft(:,:,:) = landuse_index_lake
212 
213  elseif( landuse_mosaicworld ) then
214 
215  log_info("LANDUSE_setup",*) 'Assume all grids have ocean, land, and urban'
216 ! LOG_INFO("LANDUSE_setup",*) 'Assume all grids have ocean, land, urban, and lake'
217  log_info("LANDUSE_setup",*) 'Assume land PFT is 1 (bare ground)'
218  landuse_frac_land(:,:) = 0.5_rp
219  landuse_frac_urban(:,:) = 0.5_rp
220 ! LANDUSE_frac_lake (:,:) = 0.25_RP
221 
222  else ! default: read from file
223 
224  call landuse_read( ocean_do, urban_do, lake_do )
225 
226  endif
227 
228  !$acc update device(LANDUSE_frac_land, LANDUSE_frac_urban, LANDUSE_frac_lake)
229  !$acc update device(LANDUSE_index_PFT, LANDUSE_frac_PFT)
230 
231  call landuse_calc_fact
232 
233  return
234  end subroutine landuse_setup
235 
236  !-----------------------------------------------------------------------------
237  subroutine landuse_calc_fact
238  implicit none
239 
240  real(rp) :: fact_soil
241  integer :: i, j
242  !---------------------------------------------------------------------------
243 
244  log_newline
245  log_info("LANDUSE_calc_fact",*) 'calculate landuse factor'
246 
247  ! make factors
248  !$omp parallel do private(fact_soil)
249  !$acc kernels
250  do j = 1, ja
251  do i = 1, ia
252  landuse_fact_ocean(i,j) = max( 1.0_rp - landuse_frac_land(i,j), 0.0_rp )
253  landuse_fact_lake(i,j) = landuse_frac_land(i,j) * landuse_frac_lake(i,j)
254  fact_soil = max( landuse_frac_land(i,j) - landuse_fact_lake(i,j), 0.0_rp )
255  landuse_fact_urban(i,j) = fact_soil * landuse_frac_urban(i,j)
256  landuse_fact_land(i,j) = max( fact_soil - landuse_fact_urban(i,j), 0.0_rp )
257 
258  if( landuse_fact_ocean(i,j) > 0.0_rp ) landuse_exists_ocean(i,j) = .true.
259  if( landuse_fact_land(i,j) > 0.0_rp ) landuse_exists_land(i,j) = .true.
260  if( landuse_fact_urban(i,j) > 0.0_rp ) landuse_exists_urban(i,j) = .true.
261  if( landuse_fact_lake(i,j) > 0.0_rp ) landuse_exists_lake(i,j) = .true.
262  enddo
263  enddo
264  !$acc end kernels
265 
266  !$acc update host(LANDUSE_fact_ocean, LANDUSE_fact_land, LANDUSE_fact_urban, LANDUSE_fact_lake)
267  !$acc update host(LANDUSE_exists_ocean, LANDUSE_exists_land, LANDUSE_exists_urban, LANDUSE_exists_lake)
268 
269  return
270  end subroutine landuse_calc_fact
271 
272  !-----------------------------------------------------------------------------
274  subroutine landuse_fillhalo( FILL_BND )
275  use scale_comm_cartesc, only: &
276  comm_vars8, &
277  comm_wait
278  implicit none
279 
280  logical, intent(in), optional :: fill_bnd
281 
282  real(rp) :: temp(ia,ja)
283 
284  logical :: fill_bnd_
285  integer :: p
286  !---------------------------------------------------------------------------
287 
288  ! tentative (calculated in mod_cnvlanduse.F90)
289  !$acc update device(LANDUSE_frac_land, LANDUSE_frac_lake, LANDUSE_frac_urban)
290  !$acc update device(LANDUSE_frac_PFT, LANDUSE_index_PFT)
291 
292  fill_bnd_ = .true.
293  if ( present(fill_bnd) ) fill_bnd_ = fill_bnd
294 
295  call comm_vars8( landuse_frac_land(:,:), 1 )
296  call comm_vars8( landuse_frac_lake(:,:), 2 )
297  call comm_vars8( landuse_frac_urban(:,:), 3 )
298  call comm_vars8( landuse_fact_ocean(:,:), 4 )
299  call comm_vars8( landuse_fact_land(:,:), 5 )
300  call comm_vars8( landuse_fact_urban(:,:), 6 )
301  call comm_vars8( landuse_fact_lake(:,:), 7 )
302 
303  call comm_wait ( landuse_frac_land(:,:), 1, fill_bnd_ )
304  call comm_wait ( landuse_frac_lake(:,:), 2, fill_bnd_ )
305  call comm_wait ( landuse_frac_urban(:,:), 3, fill_bnd_ )
306  call comm_wait ( landuse_fact_ocean(:,:), 4, fill_bnd_ )
307  call comm_wait ( landuse_fact_land(:,:), 5, fill_bnd_ )
308  call comm_wait ( landuse_fact_urban(:,:), 6, fill_bnd_ )
309  call comm_wait ( landuse_fact_lake(:,:), 7, fill_bnd_ )
310 
311  !$acc data create(temp)
312 
313  do p = 1, landuse_pft_mosaic
314  !$acc kernels
315  temp(:,:) = real(landuse_index_pft(:,:,p),kind=rp)
316  !$acc end kernels
317 
318  call comm_vars8( landuse_frac_pft(:,:,p), 8+2*(p-1) )
319  call comm_vars8( temp(:,:) , 9+2*(p-1) )
320 
321  call comm_wait ( landuse_frac_pft(:,:,p), 8+2*(p-1), fill_bnd_ )
322  call comm_wait ( temp(:,:) , 9+2*(p-1), fill_bnd_ )
323 
324  !$acc kernels
325  landuse_index_pft(:,:,p) = aint(temp(:,:),kind=4)
326  !$acc end kernels
327  enddo
328 
329  !$acc end data
330 
331  !$acc update host( LANDUSE_frac_land, LANDUSE_frac_lake, LANDUSE_frac_urban )
332  !$acc update host( LANDUSE_fact_ocean, LANDUSE_fact_land, LANDUSE_fact_urban, LANDUSE_fact_lake )
333  !$acc update host( LANDUSE_frac_PFT, LANDUSE_index_PFT )
334 
335  return
336  end subroutine landuse_fillhalo
337 
338  !-----------------------------------------------------------------------------
340  subroutine landuse_read( &
341  OCEAN_do, &
342  URBAN_do, &
343  LAKE_do )
344  use scale_file_cartesc, only: &
345  file_cartesc_open, &
346  file_cartesc_read, &
347  file_cartesc_flush, &
348  file_cartesc_check_coordinates, &
349  file_cartesc_close
350  use scale_prc, only: &
351  prc_abort
352  implicit none
353 
354  logical, intent(in) :: ocean_do
355  logical, intent(in) :: urban_do
356  logical, intent(in) :: lake_do
357 
358  real(rp) :: temp(ia,ja)
359 
360  character(len=H_SHORT) :: varname
361 
362  integer :: fid
363  integer :: p, i, j
364  !---------------------------------------------------------------------------
365 
366  log_newline
367  log_info("LANDUSE_read",*) 'Input landuse file '
368 
369  if ( landuse_in_basename /= '' ) then
370 
371  call file_cartesc_open( landuse_in_basename, fid, aggregate=landuse_in_aggregate )
372 
373  call file_cartesc_read( fid, 'FRAC_LAND', 'XY', landuse_frac_land(:,:) )
374  call file_cartesc_read( fid, 'FRAC_LAKE', 'XY', landuse_frac_lake(:,:) )
375  call file_cartesc_read( fid, 'FRAC_URBAN', 'XY', landuse_frac_urban(:,:) )
376 
377  call file_cartesc_flush( fid )
378 
379  do p = 1, landuse_pft_mosaic
380  write(varname,'(A8,I1.1)') 'FRAC_PFT', p
381 
382  call file_cartesc_read( fid, varname, 'XY', landuse_frac_pft(:,:,p) )
383 
384  write(varname,'(A9,I1.1)') 'INDEX_PFT', p
385 
386  call file_cartesc_read( fid, varname, 'XY', temp(:,:) )
387  call file_cartesc_flush( fid ) ! for non-blocking I/O
388 
389  do j = js, je
390  do i = is, ie
391  landuse_index_pft(i,j,p) = int(temp(i,j)+1.e-3_rp,kind=4)
392  enddo
393  enddo
394  enddo
395 
396  if ( landuse_in_check_coordinates ) then
397  call file_cartesc_check_coordinates( fid )
398  end if
399 
400  call file_cartesc_close( fid )
401 
402  call landuse_fillhalo( fill_bnd=.false. )
403 
404  ! validity check
405  !$omp parallel do
406  do j = 1, ja
407  do i = 1, ia
408  if ( landuse_frac_land(i,j) < 0.0_rp .or. landuse_frac_land(i,j) > 1.0_rp ) then
409  log_error("LANDUSE_read",*) 'LANDUSE_frac_land is invalid: ', i,j, landuse_frac_land(i,j)
410  call prc_abort
411  end if
412  if ( landuse_frac_lake(i,j) < 0.0_rp .or. landuse_frac_lake(i,j) > 1.0_rp ) then
413  log_error("LANDUSE_read",*) 'LANDUSE_frac_lake is invalid: ', i,j, landuse_frac_lake(i,j)
414  call prc_abort
415  end if
416  if ( landuse_frac_urban(i,j) < 0.0_rp .or. landuse_frac_urban(i,j) > 1.0_rp ) then
417  log_error("LANDUSE_read",*) 'LANDUSE_frac_urban is invalid: ', i,j, landuse_frac_urban(i,j)
418  call prc_abort
419  end if
420  end do
421  end do
422 
423 !!$ if ( .not. OCEAN_do ) then
424 !!$ !$omp parallel do private(frac_ocean)
425 !!$ do j = 1, JA
426 !!$ do i = 1, IA
427 !!$ do p = LANDUSE_PFT_mosaic, 1, -1
428 !!$ frac_ocean = 1.0_RP - LANDUSE_frac_land(i,j)
429 !!$ if ( frac_ocean > LANDUSE_frac_PFT(i,j,p) ) then
430 !!$ if ( p < LANDUSE_PFT_mosaic ) then
431 !!$ LANDUSE_index_PFT(i,j,p+1) = LANDUSE_index_PFT(i,j,p)
432 !!$ LANDUSE_frac_PFT (i,j,p+1) = LANDUSE_frac_PFT (i,j,p)
433 !!$ end if
434 !!$ LANDUSE_index_PFT(i,j,p) = LANDUSE_index_OCEAN
435 !!$ LANDUSE_frac_PFT (i,j,p) = frac_ocean
436 !!$ else
437 !!$ exit
438 !!$ end if
439 !!$ end do
440 !!$ LANDUSE_frac_PFT(i,j,:) = LANDUSE_frac_PFT(i,j,:) / sum( LANDUSE_frac_PFT(i,j,:) )
441 !!$ end do
442 !!$ end do
443 !!$ LANDUSE_frac_land(:,:) = 1.0_RP
444 !!$ end if
445 
446  if ( .not. urban_do ) then
447  !$omp parallel do
448  do j = 1, ja
449  do i = 1, ia
450  do p = landuse_pft_mosaic, 1, -1
451  if ( landuse_frac_urban(i,j) > landuse_frac_pft(i,j,p) ) then
452  if ( p < landuse_pft_mosaic ) then
453  landuse_index_pft(i,j,p+1) = landuse_index_pft(i,j,p)
454  landuse_frac_pft(i,j,p+1) = landuse_frac_pft(i,j,p)
455  end if
456  landuse_index_pft(i,j,p) = landuse_index_urban
457  landuse_frac_pft(i,j,p) = landuse_frac_urban(i,j)
458  end if
459  end do
460  landuse_frac_pft(i,j,:) = landuse_frac_pft(i,j,:) / sum( landuse_frac_pft(i,j,:) )
461  end do
462  end do
463  landuse_frac_urban(:,:) = 0.0_rp
464  end if
465 
466  if ( .not. lake_do ) then
467  if ( landuse_ignore_lake .or. (.not. ocean_do) ) then
468  !$omp parallel do
469  do j = 1, ja
470  do i = 1, ia
471  do p = landuse_pft_mosaic, 1, -1
472  if ( landuse_frac_lake(i,j) > landuse_frac_pft(i,j,p) ) then
473  if ( p < landuse_pft_mosaic ) then
474  landuse_index_pft(i,j,p+1) = landuse_index_pft(i,j,p)
475  landuse_frac_pft(i,j,p+1) = landuse_frac_pft(i,j,p)
476  end if
477  landuse_index_pft(i,j,p) = landuse_index_lake
478  landuse_frac_pft(i,j,p) = landuse_frac_lake(i,j)
479  else
480  exit
481  end if
482  end do
483  landuse_frac_pft(i,j,:) = landuse_frac_pft(i,j,:) / sum( landuse_frac_pft(i,j,:) )
484  landuse_frac_urban(i,j) = max( landuse_frac_urban(i,j) * ( 1.0_rp - landuse_frac_lake(i,j) ), 0.0_rp )
485  end do
486  end do
487  else
488  ! lake is assumed to be ocean
489  !$omp parallel do
490  do j = 1, ja
491  do i = 1, ia
492  if( landuse_frac_land(i,j) == 0.0_rp .and. landuse_frac_urban(i,j) > 0.0_rp)then
493  log_error("LANDUSE_read",*) 'Not appropriate original landuse (w/ Lake). Bug!',i,j
494  call prc_abort
495  endif
496 
497  landuse_frac_land(i,j) = min( max( landuse_frac_land(i,j) * (1.0_rp-landuse_frac_lake(i,j)), 0.0_rp), 1.0_rp)
498 
499  if( landuse_frac_land(i,j) == 0.0_rp .and. landuse_frac_urban(i,j) > 0.0_rp)then
500  log_error("LANDUSE_read",*) 'Not appropriate replaced landuse (w/o Lake). Bug!',i,j
501  call prc_abort
502  endif
503 
504  end do
505  end do
506  end if
507 
508  landuse_frac_lake(:,:) = 0.0_rp
509  end if
510 
511  else
512  log_info_cont(*) 'landuse file is not specified.'
513  log_info_cont(*) 'Assume all grids are ocean'
514  endif
515 
516  return
517  end subroutine landuse_read
518 
519  !-----------------------------------------------------------------------------
521  subroutine landuse_write
522  use scale_file_cartesc, only: &
523  file_cartesc_create, &
524  file_cartesc_def_var, &
525  file_cartesc_enddef, &
526  file_cartesc_write_var, &
527  file_cartesc_close
528  implicit none
529 
530  real(rp) :: temp(ia,ja)
531 
532  integer :: vid(7+landuse_pft_mosaic*2)
533  character(len=H_SHORT) :: varname
534 
535  integer :: fid
536  integer :: p
537  !---------------------------------------------------------------------------
538 
539  if ( landuse_out_basename /= '' .and. landuse_out_basename /= landuse_in_basename ) then
540 
541  log_newline
542  log_info("LANDUSE_write",*) 'Output landuse file '
543 
544  call landuse_fillhalo( fill_bnd=.false. )
545 
546  call file_cartesc_create( landuse_out_basename, landuse_out_title, landuse_out_dtype, & ! [IN]
547  fid, & ! [OUT]
548  haszcoord=.false., aggregate=landuse_out_aggregate ) ! [IN]
549 
550  call file_cartesc_def_var( fid, 'FRAC_LAND' , 'LAND fraction' , '1', 'XY', landuse_out_dtype, vid(1), standard_name="land_area_fraction" )
551  call file_cartesc_def_var( fid, 'FRAC_LAKE' , 'LAKE fraction' , '1', 'XY', landuse_out_dtype, vid(2) )
552  call file_cartesc_def_var( fid, 'FRAC_URBAN' , 'URBAN fraction' , '1', 'XY', landuse_out_dtype, vid(3) )
553  call file_cartesc_def_var( fid, 'FRAC_OCEAN_abs', 'absolute OCEAN fraction', '1', 'XY', landuse_out_dtype, vid(4) )
554  call file_cartesc_def_var( fid, 'FRAC_LAND_abs' , 'absolute LAND fraction' , '1', 'XY', landuse_out_dtype, vid(5) )
555  call file_cartesc_def_var( fid, 'FRAC_URBAN_abs', 'absolute URBAN fraction', '1', 'XY', landuse_out_dtype, vid(6) )
556  call file_cartesc_def_var( fid, 'FRAC_LAKE_abs' , 'absolute LAKE fraction' , '1', 'XY', landuse_out_dtype, vid(7) )
557 
558  do p = 1, landuse_pft_mosaic
559  write(varname,'(A8,I1.1)') 'FRAC_PFT', p
560  call file_cartesc_def_var( fid, varname, 'PFT fraction', '1', 'XY', landuse_out_dtype, vid(8+2*(p-1)) )
561  write(varname,'(A9,I1.1)') 'INDEX_PFT', p
562  call file_cartesc_def_var( fid, varname, 'PFT index', '1', 'XY', landuse_out_dtype, vid(9+2*(p-1)) )
563  end do
564 
565  call file_cartesc_enddef( fid )
566 
567  call file_cartesc_write_var( fid, vid(1), landuse_frac_land(:,:), 'FRAC_LAND' , 'XY' )
568  call file_cartesc_write_var( fid, vid(2), landuse_frac_lake(:,:), 'FRAC_LAKE' , 'XY' )
569  call file_cartesc_write_var( fid, vid(3), landuse_frac_urban(:,:), 'FRAC_URBAN' , 'XY' )
570  call file_cartesc_write_var( fid, vid(4), landuse_fact_ocean(:,:), 'FRAC_OCEAN_abs', 'XY' )
571  call file_cartesc_write_var( fid, vid(5), landuse_fact_land(:,:), 'FRAC_LAND_abs' , 'XY' )
572  call file_cartesc_write_var( fid, vid(6), landuse_fact_urban(:,:), 'FRAC_URBAN_abs', 'XY' )
573  call file_cartesc_write_var( fid, vid(7), landuse_fact_lake(:,:), 'FRAC_LAKE_abs' , 'XY' )
574 
575  do p = 1, landuse_pft_mosaic
576  write(varname,'(A8,I1.1)') 'FRAC_PFT', p
577  call file_cartesc_write_var( fid, vid(8+2*(p-1)), landuse_frac_pft(:,:,p), varname, 'XY' )
578  write(varname,'(A9,I1.1)') 'INDEX_PFT', p
579  temp(:,:) = real(landuse_index_pft(:,:,p),kind=rp)
580  call file_cartesc_write_var( fid, vid(9+2*(p-1)), temp(:,:), varname, 'XY' )
581  end do
582 
583  call file_cartesc_close( fid )
584 
585  end if
586 
587  return
588  end subroutine landuse_write
589 
590  !-----------------------------------------------------------------------------
592  subroutine landuse_finalize
593  implicit none
594  !---------------------------------------------------------------------------
595 
596  log_newline
597  log_info("LANDUSE_finalize",*) 'Finalize'
598 
599  !$acc exit data delete(LANDUSE_frac_land, LANDUSE_frac_urban, LANDUSE_frac_lake)
600  deallocate( landuse_frac_land )
601  deallocate( landuse_frac_urban )
602  deallocate( landuse_frac_lake )
603 
604  !$acc exit data delete(LANDUSE_index_PFT, LANDUSE_frac_PFT)
605  deallocate( landuse_index_pft )
606  deallocate( landuse_frac_pft )
607 
608  !$acc exit data delete(LANDUSE_fact_ocean, LANDUSE_fact_land, LANDUSE_fact_urban, LANDUSE_fact_lake)
609  deallocate( landuse_fact_ocean )
610  deallocate( landuse_fact_land )
611  deallocate( landuse_fact_urban )
612  deallocate( landuse_fact_lake )
613 
614  !$acc exit data delete(LANDUSE_exists_ocean, LANDUSE_exists_land, LANDUSE_exists_urban, LANDUSE_exists_lake)
615  deallocate( landuse_exists_ocean )
616  deallocate( landuse_exists_land )
617  deallocate( landuse_exists_urban )
618  deallocate( landuse_exists_lake )
619 
620  return
621  end subroutine landuse_finalize
622 
623 end module scale_landuse
scale_landuse::landuse_fact_lake
real(rp), dimension(:,:), allocatable, public landuse_fact_lake
lake factor
Definition: scale_landuse.F90:48
scale_landuse::landuse_fact_ocean
real(rp), dimension(:,:), allocatable, public landuse_fact_ocean
ocean factor
Definition: scale_landuse.F90:45
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:350
scale_file_cartesc::file_cartesc_enddef
subroutine, public file_cartesc_enddef(fid)
Exit netCDF file define mode.
Definition: scale_file_cartesC.F90:964
scale_landuse::landuse_calc_fact
subroutine, public landuse_calc_fact
Definition: scale_landuse.F90:238
scale_file_cartesc::file_cartesc_def_var
subroutine, public file_cartesc_def_var(fid, varname, desc, unit, dim_type, datatype, vid, standard_name, timeintv, nsteps, cell_measures)
Define a variable to file.
Definition: scale_file_cartesC.F90:3360
scale_landuse::landuse_exists_lake
logical, dimension(:,:), allocatable, public landuse_exists_lake
lake calculation flag
Definition: scale_landuse.F90:53
scale_landuse::landuse_setup
subroutine, public landuse_setup(OCEAN_do, URBAN_do, LAKE_do)
Setup.
Definition: scale_landuse.F90:102
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_landuse::landuse_index_ocean
integer, parameter, public landuse_index_ocean
ocean index
Definition: scale_landuse.F90:59
scale_landuse::landuse_pft_mosaic
integer, public landuse_pft_mosaic
number of PFT mosaic
Definition: scale_landuse.F90:65
scale_landuse::landuse_exists_land
logical, dimension(:,:), allocatable, public landuse_exists_land
land calculation flag
Definition: scale_landuse.F90:51
scale_file
module file
Definition: scale_file.F90:15
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
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
scale_io
module STDIO
Definition: scale_io.F90:10
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
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_file_cartesc::file_cartesc_close
subroutine, public file_cartesc_close(fid)
Close a netCDF file.
Definition: scale_file_cartesC.F90:1044
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
scale_landuse::landuse_index_urban
integer, parameter, public landuse_index_urban
urban index
Definition: scale_landuse.F90:60
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_landuse::landuse_fact_land
real(rp), dimension(:,:), allocatable, public landuse_fact_land
land factor
Definition: scale_landuse.F90:46
scale_landuse::landuse_exists_ocean
logical, dimension(:,:), allocatable, public landuse_exists_ocean
ocean calculation flag
Definition: scale_landuse.F90:50
scale_file::file_aggregate
logical, public file_aggregate
Definition: scale_file.F90:196
scale_file_cartesc::file_cartesc_create
subroutine, public file_cartesc_create(basename, title, datatype, fid, date, subsec, haszcoord, append, aggregate, single)
Create/open a netCDF file.
Definition: scale_file_cartesC.F90:796
scale_landuse::landuse_finalize
subroutine, public landuse_finalize
Finalize.
Definition: scale_landuse.F90:593
scale_file_cartesc::file_cartesc_flush
subroutine, public file_cartesc_flush(fid)
Flush all pending requests to a netCDF file (PnetCDF only)
Definition: scale_file_cartesC.F90:1018
scale_landuse::landuse_exists_urban
logical, dimension(:,:), allocatable, public landuse_exists_urban
urban calculation flag
Definition: scale_landuse.F90:52
scale_comm_cartesc
module COMMUNICATION
Definition: scale_comm_cartesC.F90:11
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_landuse::landuse_index_lake
integer, parameter, public landuse_index_lake
lake index
Definition: scale_landuse.F90:61
scale_landuse::landuse_write
subroutine, public landuse_write
Write landuse data.
Definition: scale_landuse.F90:522
scale_file_cartesc::file_cartesc_open
subroutine, public file_cartesc_open(basename, fid, single, aggregate)
open a netCDF file for read
Definition: scale_file_cartesC.F90:760
scale_landuse::landuse_fact_urban
real(rp), dimension(:,:), allocatable, public landuse_fact_urban
urban factor
Definition: scale_landuse.F90:47
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_file_cartesc
module file / cartesianC
Definition: scale_file_cartesC.F90:11
scale_landuse::landuse_fillhalo
subroutine, public landuse_fillhalo(FILL_BND)
HALO Communication.
Definition: scale_landuse.F90:275
scale_landuse::landuse_pft_nmin
integer, parameter, public landuse_pft_nmin
minimum number of PFT type
Definition: scale_landuse.F90:63
Generated by   doxygen 1.8.17