SCALE-RM
scale_file_cartesC.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use scale_precision
17  use scale_io
18  use scale_prof
23  use scale_file_h, only: &
25 #ifdef _OPENACC
26  use openacc
27 #endif
28  !-----------------------------------------------------------------------------
29  implicit none
30  private
31  !-----------------------------------------------------------------------------
32  !
33  !++ Public procedure
34  !
35  public :: file_cartesc_setup
36  public :: file_cartesc_finalize
42  public :: file_cartesc_check_coordinates
43 
44  public :: file_cartesc_get_size
45  public :: file_cartesc_create
46  public :: file_cartesc_open
48  public :: file_cartesc_def_var
49  public :: file_cartesc_enddef
50  public :: file_cartesc_write_var
51  public :: file_cartesc_read
52  public :: file_cartesc_write
53  public :: file_cartesc_flush
54  public :: file_cartesc_close
55 
56  interface file_cartesc_check_coordinates
57  module procedure file_cartesc_check_coordinates_name
58  module procedure file_cartesc_check_coordinates_id
59  end interface file_cartesc_check_coordinates
60 
61  interface file_cartesc_get_size
62  module procedure file_cartesc_get_size_id
63  module procedure file_cartesc_get_size_name
64  end interface file_cartesc_get_size
65 
66  interface file_cartesc_read
67  module procedure file_cartesc_read_1d
68  module procedure file_cartesc_read_2d
69  module procedure file_cartesc_read_3d
70  module procedure file_cartesc_read_4d
71  module procedure file_cartesc_read_var_1d
72  module procedure file_cartesc_read_var_2d
73  module procedure file_cartesc_read_var_3d
74  module procedure file_cartesc_read_var_4d
75  module procedure file_cartesc_read_auto_2d
76  module procedure file_cartesc_read_auto_3d
77  end interface file_cartesc_read
78 
79  interface file_cartesc_write
80  module procedure file_cartesc_write_1d
81  module procedure file_cartesc_write_2d
82  module procedure file_cartesc_write_3d
83  module procedure file_cartesc_write_3d_t
84  module procedure file_cartesc_write_4d
85  end interface file_cartesc_write
86 
87  interface file_cartesc_write_var
88  module procedure file_cartesc_write_var_1d
89  module procedure file_cartesc_write_var_2d
90  module procedure file_cartesc_write_var_3d
91  module procedure file_cartesc_write_var_3d_t
92  module procedure file_cartesc_write_var_4d
93  end interface file_cartesc_write_var
94 
95  !-----------------------------------------------------------------------------
96  !
97  !++ Public parameters & variables
98  !
99  type, public :: axisattinfo
100  integer :: size_global (1)
101  integer :: start_global(1)
102  integer :: halo_global (2)
103  integer :: halo_local (2)
104  logical :: periodic
105  end type axisattinfo
106 
107  !-----------------------------------------------------------------------------
108  !
109  !++ Private procedure
110  !
111  private :: check_1d
112  private :: check_2d
113  private :: check_3d
114 
115  !-----------------------------------------------------------------------------
116  !
117  !++ Private parameters & variables
118  !
119  real(rp), private :: file_cartesc_datacheck_criteria
120 
121  type dims
122  character(len=H_SHORT) :: name
123  integer :: ndims
124  character(len=H_SHORT) :: dims(3)
125  integer :: size
126  logical :: mapping
127  character(len=H_SHORT) :: area
128  character(len=H_SHORT) :: area_x
129  character(len=H_SHORT) :: area_y
130  character(len=H_SHORT) :: volume
131  character(len=H_SHORT) :: location
132  character(len=H_SHORT) :: grid
133  end type dims
134  integer, parameter :: file_cartesc_ndims = 44
135  type(dims) :: file_cartesc_dims(file_cartesc_ndims)
136 
137  type(axisattinfo) :: file_cartesc_axis_info(4) ! x, xh, y, yh
138 
139 
140  real(rp), private, allocatable :: axis_hgt (:,:,:)
141  real(rp), private, allocatable :: axis_hgtwxy(:,:,:)
142 
143  real(rp), private, allocatable :: axis_lon (:,:) ! [deg]
144  real(rp), private, allocatable :: axis_lonuy(:,:) ! [deg]
145  real(rp), private, allocatable :: axis_lonxv(:,:) ! [deg]
146  real(rp), private, allocatable :: axis_lonuv(:,:) ! [deg]
147  real(rp), private, allocatable :: axis_lat (:,:) ! [deg]
148  real(rp), private, allocatable :: axis_latuy(:,:) ! [deg]
149  real(rp), private, allocatable :: axis_latxv(:,:) ! [deg]
150  real(rp), private, allocatable :: axis_latuv(:,:) ! [deg]
151 
152  real(rp), private, allocatable :: axis_topo (:,:)
153  real(rp), private, allocatable :: axis_lsmask(:,:)
154 
155  real(rp), private, allocatable :: axis_area (:,:)
156  real(rp), private, allocatable :: axis_areazuy_x(:,:,:)
157  real(rp), private, allocatable :: axis_areazxv_y(:,:,:)
158  real(rp), private, allocatable :: axis_areawuy_x(:,:,:)
159  real(rp), private, allocatable :: axis_areawxv_y(:,:,:)
160  real(rp), private, allocatable :: axis_areauy (:,:)
161  real(rp), private, allocatable :: axis_areazxy_x(:,:,:)
162  real(rp), private, allocatable :: axis_areazuv_y(:,:,:)
163  real(rp), private, allocatable :: axis_areaxv (:,:)
164  real(rp), private, allocatable :: axis_areazuv_x(:,:,:)
165  real(rp), private, allocatable :: axis_areazxy_y(:,:,:)
166 
167  real(rp), private, allocatable :: axis_vol (:,:,:)
168  real(rp), private, allocatable :: axis_volwxy(:,:,:)
169  real(rp), private, allocatable :: axis_volzuy(:,:,:)
170  real(rp), private, allocatable :: axis_volzxv(:,:,:)
171 
172  real(rp), private, allocatable :: axis_volo(:,:,:)
173  real(rp), private, allocatable :: axis_voll(:,:,:)
174  real(rp), private, allocatable :: axis_volu(:,:,:)
175 
176  logical, private :: file_axes_written(0:file_file_max-1) ! whether axes have been written
177  ! ! fid starts from zero so index should start from zero
178  logical, private :: file_haszcoord (0:file_file_max-1) ! z-coordinates exist?
179  integer(8), private :: write_buf_amount (0:file_file_max-1) ! sum of write buffer amounts
180 
181  integer, private :: nfiles = 0
182  integer, private :: fids(file_file_max)
183 
184  ! global star and count
185  integer, private, target :: startxy (3), countxy (3)
186  integer, private, target :: startzx (2), countzx (2)
187  integer, private, target :: startzxy (4), countzxy (4)
188  integer, private, target :: startzhxy (4), countzhxy (4)
189  integer, private, target :: startocean(4), countocean(4)
190  integer, private, target :: startland (4), countland (4)
191  integer, private, target :: starturban(4), counturban(4)
192  ! local start and end
193  integer, private :: isb2, ieb2, jsb2, jeb2
194 
195  ! MPI element datatype for restart variables
196  integer, private :: etype
197 
198  ! MPI derived datatypes
199  integer, private :: centertypexy
200  integer, private :: centertypezx
201  integer, private :: centertypezxy
202  integer, private :: centertypezhxy
203  integer, private :: centertypeocean
204  integer, private :: centertypeland
205  integer, private :: centertypeurban
206 
207  logical, private :: set_coordinates = .false.
208 
209  logical, private :: prof = .false.
210  !-----------------------------------------------------------------------------
211 contains
212  !-----------------------------------------------------------------------------
214  subroutine file_cartesc_setup
215  use scale_prc, only: &
216  prc_myrank, &
217  prc_abort
218  use scale_prc_cartesc, only: &
219  prc_2drank, &
220  prc_num_x, &
221  prc_num_y
222  use scale_file, only: &
223  file_setup
224  implicit none
225 
226  namelist / param_file_cartesc / &
227  file_cartesc_datacheck_criteria
228 
229  integer :: im, jm
230  integer :: ierr
231  !---------------------------------------------------------------------------
232 
233  call file_setup( prc_myrank )
234 
235 
236  log_newline
237  log_info("FILE_CARTESC_setup",*) 'Setup'
238 
239  file_cartesc_datacheck_criteria = 0.1_rp**(rp)
240 
241  !--- read namelist
242  rewind(io_fid_conf)
243  read(io_fid_conf,nml=param_file_cartesc,iostat=ierr)
244  if( ierr < 0 ) then !--- missing
245  log_info("FILE_CARTESC_setup",*) 'Not found namelist. Default used.'
246  elseif( ierr > 0 ) then !--- fatal error
247  log_error("FILE_CARTESC_setup",*) 'Not appropriate names in namelist PARAM_FILE_CARTESC. Check!'
248  call prc_abort
249  endif
250  log_nml(param_file_cartesc)
251 
252  log_newline
253  log_info("FILE_CARTESC_setup",*) 'NetCDF header information '
254  log_info_cont(*) 'Data source : ', trim(h_source)
255  log_info_cont(*) 'Institute : ', trim(h_institute)
256 
257  log_newline
258  log_info("FILE_CARTESC_setup",*) 'Data consistency criteria : ', &
259  '(file-internal)/internal = ', file_cartesc_datacheck_criteria
260 
261  ! construct indices independent from PRC_PERIODIC_X/Y
262  isb2 = is
263  if( prc_2drank(prc_myrank,1) == 0 ) isb2 = 1
264  ieb2 = ie
265  if( prc_2drank(prc_myrank,1) == prc_num_x-1 ) ieb2 = ia
266 
267  jsb2 = js
268  if( prc_2drank(prc_myrank,2) == 0 ) jsb2 = 1
269  jeb2 = je
270  if( prc_2drank(prc_myrank,2) == prc_num_y-1 ) jeb2 = ja
271 
272  im = ieb2 - isb2 + 1
273  jm = jeb2 - jsb2 + 1
274  allocate( axis_hgt(kmax ,im,jm) )
275  allocate( axis_hgtwxy(kmax+1,im,jm) )
276 
277  allocate( axis_lon(im,jm) )
278  allocate( axis_lonuy(im,jm) )
279  allocate( axis_lonxv(im,jm) )
280  allocate( axis_lonuv(im,jm) )
281  allocate( axis_lat(im,jm) )
282  allocate( axis_latuy(im,jm) )
283  allocate( axis_latxv(im,jm) )
284  allocate( axis_latuv(im,jm) )
285 
286  allocate( axis_topo(im,jm) )
287  allocate( axis_lsmask(im,jm) )
288 
289  allocate( axis_area( im,jm) )
290  allocate( axis_areazuy_x(kmax, im,jm) )
291  allocate( axis_areazxv_y(kmax, im,jm) )
292  allocate( axis_areawuy_x(kmax+1,im,jm) )
293  allocate( axis_areawxv_y(kmax+1,im,jm) )
294  allocate( axis_areauy( im,jm) )
295  allocate( axis_areazxy_x(kmax, im,jm) )
296  allocate( axis_areazuv_y(kmax, im,jm) )
297  allocate( axis_areaxv( im,jm) )
298  allocate( axis_areazuv_x(kmax, im,jm) )
299  allocate( axis_areazxy_y(kmax, im,jm) )
300 
301  allocate( axis_vol(kmax ,im,jm) )
302  allocate( axis_volwxy(kmax+1,im,jm) )
303  allocate( axis_volzuy(kmax ,im,jm) )
304  allocate( axis_volzxv(kmax ,im,jm) )
305 
306  allocate( axis_volo(okmax,im,jm) )
307  allocate( axis_voll(lkmax,im,jm) )
308  allocate( axis_volu(ukmax,im,jm) )
309 
311 
312  write_buf_amount(:) = 0
313 
314  return
315  end subroutine file_cartesc_setup
316 
317  !-----------------------------------------------------------------------------
319  subroutine file_cartesc_finalize
320  implicit none
321 
322  integer :: n
323  !---------------------------------------------------------------------------
324 
325  do n = 1, nfiles
326  call file_cartesc_close( fids(nfiles) )
327  end do
328  nfiles = 0
329 
330  deallocate( axis_hgt )
331  deallocate( axis_hgtwxy )
332 
333  deallocate( axis_lon )
334  deallocate( axis_lonuy )
335  deallocate( axis_lonxv )
336  deallocate( axis_lonuv )
337  deallocate( axis_lat )
338  deallocate( axis_latuy )
339  deallocate( axis_latxv )
340  deallocate( axis_latuv )
341 
342  deallocate( axis_topo )
343  deallocate( axis_lsmask )
344 
345  deallocate( axis_area )
346  deallocate( axis_areazuy_x )
347  deallocate( axis_areazxv_y )
348  deallocate( axis_areawuy_x )
349  deallocate( axis_areawxv_y )
350  deallocate( axis_areauy )
351  deallocate( axis_areazxy_x )
352  deallocate( axis_areazuv_y )
353  deallocate( axis_areaxv )
354  deallocate( axis_areazuv_x )
355  deallocate( axis_areazxy_y )
356 
357  deallocate( axis_vol )
358  deallocate( axis_volwxy )
359  deallocate( axis_volzuy )
360  deallocate( axis_volzxv )
361 
362  deallocate( axis_volo )
363  deallocate( axis_voll )
364  deallocate( axis_volu )
365 
367 
368  set_coordinates = .false.
369 
370  return
371  end subroutine file_cartesc_finalize
372 
373  !-----------------------------------------------------------------------------
377  !-----------------------------------------------------------------------------
378  subroutine file_cartesc_get_size_name( &
379  basename, &
380  KMAX, OKMAX, LKMAX, UKMAX, &
381  IMAXG, JMAXG, &
382  KHALO, IHALO, JHALO, &
383  aggregate )
384  use scale_file, only: &
385  file_open
386  character(len=*), intent(in) :: basename
387 
388  integer, intent(out) :: kmax, okmax, lkmax, ukmax
389  integer, intent(out) :: imaxg, jmaxg
390  integer, intent(out) :: khalo, ihalo, jhalo
391 
392  logical, intent(in), optional :: aggregate
393 
394  integer :: fid
395 
396  call file_open( basename, & ! (in)
397  fid, & ! (out)
398  aggregate=aggregate ) ! (in)
399 
400  call file_cartesc_get_size_id( fid, & ! (in)
401  kmax, okmax, lkmax, ukmax, & ! (out)
402  imaxg, jmaxg, & ! (out)
403  khalo, ihalo, jhalo ) ! (out)
404 
405  return
406  end subroutine file_cartesc_get_size_name
407  subroutine file_cartesc_get_size_id( &
408  fid, &
409  KMAX, OKMAX, LKMAX, UKMAX, &
410  IMAXG, JMAXG, &
411  KHALO, IHALO, JHALO )
412  use scale_file, only: &
413  file_get_attribute
414 
415  integer, intent(in) :: fid
416 
417  integer, intent(out) :: KMAX, OKMAX, LKMAX, UKMAX
418  integer, intent(out) :: IMAXG, JMAXG
419  integer, intent(out) :: KHALO, IHALO, JHALO
420 
421  integer :: buf(1)
422  logical :: existed
423 
424  call file_get_attribute( fid, "global", "scale_atmos_grid_cartesC_index_kmax", buf(:) )
425  kmax = buf(1)
426  call file_get_attribute( fid, "global", "scale_ocean_grid_cartesC_index_kmax", buf(:), existed=existed )
427  if ( existed ) then
428  okmax = buf(1)
429  else
430  okmax = -1
431  end if
432  call file_get_attribute( fid, "global", "scale_land_grid_cartesC_index_kmax", buf(:), existed=existed )
433  if ( existed ) then
434  lkmax = buf(1)
435  else
436  lkmax = -1
437  end if
438  call file_get_attribute( fid, "global", "scale_urban_grid_cartesC_index_kmax", buf(:), existed=existed )
439  if ( existed ) then
440  ukmax = buf(1)
441  else
442  ukmax = -1
443  end if
444 
445  call file_get_attribute( fid, "global", "scale_atmos_grid_cartesC_index_imaxg", buf(:) )
446  imaxg = buf(1)
447  call file_get_attribute( fid, "global", "scale_atmos_grid_cartesC_index_jmaxg", buf(:) )
448  jmaxg = buf(1)
449 
450  call file_get_attribute( fid, "global", "scale_atmos_grid_cartesC_index_khalo", buf(:) )
451  khalo = buf(1)
452  call file_get_attribute( fid, "global", "scale_atmos_grid_cartesC_index_ihalo", buf(:) )
453  ihalo = buf(1)
454  call file_get_attribute( fid, "global", "scale_atmos_grid_cartesC_index_jhalo", buf(:) )
455  jhalo = buf(1)
456 
457  return
458  end subroutine file_cartesc_get_size_id
459 
460  !-----------------------------------------------------------------------------
463  CZ, FZ, &
464  LON, LONUY, LONXV, LONUV, &
465  LAT, LATUY, LATXV, LATUV, &
466  TOPO, LSMASK )
467  use scale_const, only: &
468  d2r => const_d2r
469  implicit none
470 
471  real(rp), intent(in) :: cz( ka,ia,ja)
472  real(rp), intent(in) :: fz(0:ka,ia,ja)
473  real(rp), intent(in) :: lon ( ia, ja)
474  real(rp), intent(in) :: lonuy(0:ia, ja)
475  real(rp), intent(in) :: lonxv( ia,0:ja)
476  real(rp), intent(in) :: lonuv(0:ia,0:ja)
477  real(rp), intent(in) :: lat ( ia, ja)
478  real(rp), intent(in) :: latuy(0:ia, ja)
479  real(rp), intent(in) :: latxv( ia,0:ja)
480  real(rp), intent(in) :: latuv(0:ia,0:ja)
481  real(rp), intent(in) :: topo ( ia, ja)
482  real(rp), intent(in) :: lsmask( ia, ja)
483  !---------------------------------------------------------------------------
484 
485  axis_hgt(:,:,:) = cz(ks :ke,isb2:ieb2,jsb2:jeb2)
486  axis_hgtwxy(:,:,:) = fz(ks-1:ke,isb2:ieb2,jsb2:jeb2)
487 
488  axis_lon(:,:) = lon(isb2:ieb2,jsb2:jeb2) / d2r
489  axis_lonuy(:,:) = lonuy(isb2:ieb2,jsb2:jeb2) / d2r
490  axis_lonxv(:,:) = lonxv(isb2:ieb2,jsb2:jeb2) / d2r
491  axis_lonuv(:,:) = lonuv(isb2:ieb2,jsb2:jeb2) / d2r
492  axis_lat(:,:) = lat(isb2:ieb2,jsb2:jeb2) / d2r
493  axis_latuy(:,:) = latuy(isb2:ieb2,jsb2:jeb2) / d2r
494  axis_latxv(:,:) = latxv(isb2:ieb2,jsb2:jeb2) / d2r
495  axis_latuv(:,:) = latuv(isb2:ieb2,jsb2:jeb2) / d2r
496 
497  axis_topo(:,:) = topo(isb2:ieb2,jsb2:jeb2)
498  axis_lsmask(:,:) = lsmask(isb2:ieb2,jsb2:jeb2)
499 
500  set_coordinates = .true.
501 
502  return
504 
505  !-----------------------------------------------------------------------------
507  subroutine file_cartesc_set_areavol_atmos( &
508  AREA, AREAZUY_X, AREAZXV_Y, &
509  AREAWUY_X, AREAWXV_Y, &
510  AREAUY, AREAZXY_X, AREAZUV_Y, &
511  AREAXV, AREAZUV_X, AREAZXY_Y, &
512  VOL, VOLWXY, VOLZUY, VOLZXV )
513  use scale_const, only: &
514  d2r => const_d2r
515  implicit none
516  real(rp), intent(in) :: area ( ia,ja)
517  real(rp), intent(in) :: areazuy_x( ka,ia,ja)
518  real(rp), intent(in) :: areazxv_y( ka,ia,ja)
519  real(rp), intent(in) :: areawuy_x(0:ka,ia,ja)
520  real(rp), intent(in) :: areawxv_y(0:ka,ia,ja)
521  real(rp), intent(in) :: areauy ( ia,ja)
522  real(rp), intent(in) :: areazxy_x( ka,ia,ja)
523  real(rp), intent(in) :: areazuv_y( ka,ia,ja)
524  real(rp), intent(in) :: areaxv ( ia,ja)
525  real(rp), intent(in) :: areazuv_x( ka,ia,ja)
526  real(rp), intent(in) :: areazxy_y( ka,ia,ja)
527  real(rp), intent(in) :: vol ( ka,ia,ja)
528  real(rp), intent(in) :: volwxy(0:ka,ia,ja)
529  real(rp), intent(in) :: volzuy( ka,ia,ja)
530  real(rp), intent(in) :: volzxv( ka,ia,ja)
531 
532  axis_area(:,:) = area( isb2:ieb2,jsb2:jeb2)
533  axis_areazuy_x(:,:,:) = areazuy_x(ks :ke,isb2:ieb2,jsb2:jeb2)
534  axis_areazxv_y(:,:,:) = areazxv_y(ks :ke,isb2:ieb2,jsb2:jeb2)
535  axis_areawuy_x(:,:,:) = areawuy_x(ks-1:ke,isb2:ieb2,jsb2:jeb2)
536  axis_areawxv_y(:,:,:) = areawxv_y(ks-1:ke,isb2:ieb2,jsb2:jeb2)
537  axis_areauy(:,:) = areauy( isb2:ieb2,jsb2:jeb2)
538  axis_areazxy_x(:,:,:) = areazxy_x(ks :ke,isb2:ieb2,jsb2:jeb2)
539  axis_areazuv_y(:,:,:) = areazuv_y(ks :ke,isb2:ieb2,jsb2:jeb2)
540  axis_areaxv(:,:) = areaxv( isb2:ieb2,jsb2:jeb2)
541  axis_areazuv_x(:,:,:) = areazuv_x(ks :ke,isb2:ieb2,jsb2:jeb2)
542  axis_areazxy_y(:,:,:) = areazxy_y(ks :ke,isb2:ieb2,jsb2:jeb2)
543 
544  axis_vol(:,:,:) = vol(ks :ke,isb2:ieb2,jsb2:jeb2)
545  axis_volwxy(:,:,:) = volwxy(ks-1:ke,isb2:ieb2,jsb2:jeb2)
546  axis_volzuy(:,:,:) = volzuy(ks :ke,isb2:ieb2,jsb2:jeb2)
547  axis_volzxv(:,:,:) = volzxv(ks :ke,isb2:ieb2,jsb2:jeb2)
548 
549  return
550  end subroutine file_cartesc_set_areavol_atmos
551 
552  !-----------------------------------------------------------------------------
555  VOL )
556  implicit none
557 
558  real(rp), intent(in) :: vol(oka,oia,oja)
559  !---------------------------------------------------------------------------
560 
561  axis_volo(:,:,:) = vol(oks:oke,isb2:ieb2,jsb2:jeb2)
562 
563  return
565 
566  !-----------------------------------------------------------------------------
569  VOL )
570  implicit none
571 
572  real(rp), intent(in) :: vol(lka,lia,lja)
573  !---------------------------------------------------------------------------
574 
575  axis_voll(:,:,:) = vol(lks:lke,isb2:ieb2,jsb2:jeb2)
576 
577  return
578  end subroutine file_cartesc_set_coordinates_land
579 
580  !-----------------------------------------------------------------------------
583  VOL )
584  implicit none
585 
586  real(rp), intent(in) :: vol(uka,uia,uja)
587  !---------------------------------------------------------------------------
588 
589  axis_volu(:,:,:) = vol(uks:uke,isb2:ieb2,jsb2:jeb2)
590 
591  return
593 
594  !-----------------------------------------------------------------------------
596  subroutine file_cartesc_check_coordinates_name( &
597  basename, &
598  atmos, ocean, land, urban, &
599  transpose )
600  implicit none
601 
602  character(len=*), intent(in) :: basename
603  logical, intent(in), optional :: atmos
604  logical, intent(in), optional :: ocean
605  logical, intent(in), optional :: land
606  logical, intent(in), optional :: urban
607  logical, intent(in), optional :: transpose
608 
609  logical :: atmos_
610  logical :: ocean_
611  logical :: land_
612  logical :: urban_
613  logical :: transpose_
614 
615  integer :: fid
616  !---------------------------------------------------------------------------
617 
618  atmos_ = .false.
619  ocean_ = .false.
620  land_ = .false.
621  urban_ = .false.
622  transpose_ = .false.
623 
624  if( present(atmos) ) atmos_ = atmos
625  if( present(ocean) ) ocean_ = ocean
626  if( present(land ) ) land_ = land
627  if( present(urban) ) urban_ = urban
628  if( present(transpose) ) transpose_ = transpose
629 
630  call file_cartesc_open( basename, fid )
631 
632 
633  call file_cartesc_check_coordinates_id( fid, & ! [IN]
634  atmos_, ocean_, land_, urban_, & ! [IN]
635  transpose_ ) ! [IN]
636 
637  return
638  end subroutine file_cartesc_check_coordinates_name
639 
640  !-----------------------------------------------------------------------------
642  subroutine file_cartesc_check_coordinates_id( &
643  fid, &
644  atmos, ocean, land, urban, &
645  transpose )
646  use scale_atmos_grid_cartesc, only: &
650  use scale_ocean_grid_cartesc, only: &
652  use scale_land_grid_cartesc, only: &
654  use scale_urban_grid_cartesc, only: &
656  implicit none
657 
658  integer, intent(in) :: fid
659  logical, intent(in), optional :: atmos
660  logical, intent(in), optional :: ocean
661  logical, intent(in), optional :: land
662  logical, intent(in), optional :: urban
663  logical, intent(in), optional :: transpose
664 
665  logical :: atmos_
666  logical :: ocean_
667  logical :: land_
668  logical :: urban_
669  logical :: transpose_
670 
671  real(rp) :: buffer_z (ka)
672  real(rp) :: buffer_x (ia)
673  real(rp) :: buffer_y (ja)
674  real(rp) :: buffer_xy (ia,ja)
675  real(rp) :: buffer_zxy(ka,ia,ja)
676  real(rp) :: buffer_o (okmax)
677  real(rp) :: buffer_l (lkmax)
678  real(rp) :: buffer_u (ukmax)
679 
680  integer :: xsb, xeb, ysb, yeb
681  !---------------------------------------------------------------------------
682 
683  log_newline
684  log_info("FILE_CARTESC_check_coordinates_id",*) 'Check consistency of axis '
685 
686  atmos_ = .false.
687  ocean_ = .false.
688  land_ = .false.
689  urban_ = .false.
690  transpose_ = .false.
691 
692  if( present(atmos) ) atmos_ = atmos
693  if( present(ocean) ) ocean_ = ocean
694  if( present(land ) ) land_ = land
695  if( present(urban) ) urban_ = urban
696  if( present(transpose) ) transpose_ = transpose
697 
698 
699  xsb = isb - isb2 + 1
700  xeb = ieb - isb + xsb
701  ysb = jsb - jsb2 + 1
702  yeb = jeb - jsb + ysb
703 
704  call file_cartesc_read_var_1d( fid, 'x', 'X', buffer_x(:) )
705  call file_cartesc_read_var_1d( fid, 'y', 'Y', buffer_y(:) )
706  call file_cartesc_flush( fid ) ! for non-blocking I/O
707  call check_1d( atmos_grid_cartesc_cx(isb:ieb), buffer_x(isb:ieb), 'x' )
708  call check_1d( atmos_grid_cartesc_cy(jsb:jeb), buffer_y(jsb:jeb), 'y' )
709 
710  if ( set_coordinates ) then
711  call file_cartesc_read_var_2d( fid, 'lon', 'XY', buffer_xy(:,:) )
712  call file_cartesc_flush( fid ) ! for non-blocking I/O
713  call check_2d( axis_lon(xsb:xeb,ysb:yeb), buffer_xy(isb:ieb,jsb:jeb), 'lon' )
714 
715  call file_cartesc_read_var_2d( fid, 'lat', 'XY', buffer_xy(:,:) )
716  call file_cartesc_flush( fid ) ! for non-blocking I/O
717  call check_2d( axis_lat(xsb:xeb,ysb:yeb), buffer_xy(isb:ieb,jsb:jeb), 'lat' )
718  endif
719 
720  if ( atmos_ ) then
721  call file_cartesc_read_var_1d( fid, 'z', 'Z', buffer_z(:) )
722  if ( .not. transpose_ ) then
723  call file_cartesc_read_var_3d( fid, 'height', 'ZXY', buffer_zxy(:,:,:) )
724  endif
725  call file_cartesc_flush( fid ) ! for non-blocking I/O
726  call check_1d( atmos_grid_cartesc_cz(ks:ke), buffer_z(ks:ke), 'z' )
727  if ( .not. transpose_ ) then
728  call check_3d( axis_hgt(:,xsb:xeb,ysb:yeb), buffer_zxy(ks:ke,isb:ieb,jsb:jeb), 'height', transpose_ )
729  endif
730  endif
731 
732  if ( ocean_ ) then
733  call file_cartesc_read_var_1d( fid, 'oz', 'OZ', buffer_o(:) )
734  call file_cartesc_flush( fid ) ! for non-blocking I/O
735  call check_1d( ocean_grid_cartesc_cz(oks:oke), buffer_o(oks:oke), 'oz' )
736  endif
737 
738  if ( land_ ) then
739  call file_cartesc_read_var_1d( fid, 'lz', 'LZ', buffer_l(:) )
740  call file_cartesc_flush( fid ) ! for non-blocking I/O
741  call check_1d( land_grid_cartesc_cz(lks:lke), buffer_l(lks:lke), 'lz' )
742  endif
743 
744  if ( urban_ ) then
745  call file_cartesc_read_var_1d( fid, 'uz', 'UZ', buffer_u(:) )
746  call file_cartesc_flush( fid ) ! for non-blocking I/O
747  call check_1d( urban_grid_cartesc_cz(uks:uke), buffer_u(uks:uke), 'uz' )
748  endif
749 
750  return
751  end subroutine file_cartesc_check_coordinates_id
752 
753  !-----------------------------------------------------------------------------
755  subroutine file_cartesc_open( &
756  basename, &
757  fid, &
758  single, &
759  aggregate )
760  use scale_file_h, only: &
761  file_fread
762  use scale_file, only: &
763  file_aggregate, &
764  file_open
765  use scale_prc, only: &
766  prc_myrank
767  implicit none
768 
769  character(len=*), intent(in) :: basename
770  integer, intent(out) :: fid
771  logical, intent(in), optional :: single
772  logical, intent(in), optional :: aggregate
773  !---------------------------------------------------------------------------
774 
775  call prof_rapstart('FILE_Write', 2)
776 
777  call file_open( basename, & ! [IN]
778  fid, & ! [OUT]
779  single=single, & ! [IN]
780  aggregate=aggregate, & ! [IN]
781  rankid=prc_myrank ) ! [IN]
782 
783  call prof_rapend ('FILE_Write', 2)
784 
785  return
786  end subroutine file_cartesc_open
787 
788  !-----------------------------------------------------------------------------
790  subroutine file_cartesc_create( &
791  basename, title, datatype, &
792  fid, &
793  date, subsec, &
794  haszcoord, &
795  append, aggregate, single )
796  use scale_file_h, only: &
797  file_real8, &
798  file_real4
799  use scale_file, only: &
800  file_aggregate, &
801  file_create, &
803  use scale_calendar, only: &
805  use scale_prc, only: &
806  prc_myrank, &
807  prc_abort
808  use scale_time, only: &
809  nowdate => time_nowdate, &
810  nowsubsec => time_nowsubsec
811  use scale_prc_cartesc, only: &
812  prc_2drank, &
813  prc_num_x, &
814  prc_num_y, &
815  prc_periodic_x, &
817  implicit none
818 
819  character(len=*), intent(in) :: basename
820  character(len=*), intent(in) :: title
821  character(len=*), intent(in) :: datatype
822  integer, intent(out) :: fid
823  integer, intent(in), optional :: date(6)
824  real(dp), intent(in), optional :: subsec
825  logical, intent(in), optional :: append
826  logical, intent(in), optional :: haszcoord
827  logical, intent(in), optional :: aggregate
828  logical, intent(in), optional :: single
829 
830  integer :: dtype
831  logical :: append_sw
832  character(len=34) :: tunits
833  character(len=H_SHORT) :: calendar
834  real(dp) :: subsec_
835  integer :: rank_x, rank_y
836  integer :: num_x, num_y
837  logical :: fileexisted
838  logical :: aggregate_
839  logical :: single_
840  integer :: date_(6)
841  !---------------------------------------------------------------------------
842 
843  prof = .true.
844  call prof_rapstart('FILE_Write', 2)
845 
846  if ( present(single) ) then
847  single_ = single
848  else
849  single_ = .false.
850  end if
851 
852  ! dtype is used to define the data type of axis variables in file
853  if ( datatype == 'REAL8' ) then
854  dtype = file_real8
855  elseif( datatype == 'REAL4' ) then
856  dtype = file_real4
857  else
858  if ( rp == 8 ) then
859  dtype = file_real8
860  elseif( rp == 4 ) then
861  dtype = file_real4
862  else
863  log_error("FILE_CARTESC_create",*) 'unsupported data type. Check!', trim(datatype)
864  call prc_abort
865  endif
866  endif
867 
868  append_sw = .false.
869  if ( present(append) ) then
870  append_sw = append
871  endif
872 
873  ! create a netCDF file if not already existed. Otherwise, open it.
874  if ( present(date) ) then
875  date_(:) = date(:)
876  else
877  date_(:) = nowdate(:)
878  end if
879  if ( date_(1) > 0 ) then
880  call file_get_cftunits( date_(:), tunits )
881  call calendar_get_name( calendar )
882  else
883  tunits = 'seconds'
884  calendar = ''
885  endif
886 
887 
888  ! check to use PnetCDF I/O
889  if ( present(aggregate) ) then
890  aggregate_ = aggregate
891  else
892  aggregate_ = file_aggregate
893  endif
894 
895  call file_create( basename, & ! [IN]
896  title, & ! [IN]
897  h_source, & ! [IN]
898  h_institute, & ! [IN]
899  fid, & ! [OUT]
900  fileexisted, & ! [OUT]
901  rankid = prc_myrank, & ! [IN]
902  single = single_, & ! [IN]
903  aggregate = aggregate_, & ! [IN]
904  time_units = tunits, & ! [IN]
905  calendar = calendar, & ! [IN]
906  append = append_sw ) ! [IN]
907 
908 
909  if ( fid > 0 .and. (.not. fileexisted) ) then ! do below only once when file is created
910 
911  nfiles = nfiles + 1
912  fids(nfiles) = fid
913 
914  file_axes_written(fid) = .false. ! indicating axes have not been written yet
915 
916  if ( present( haszcoord ) ) then
917  file_haszcoord(fid) = haszcoord
918  else
919  file_haszcoord(fid) = .true.
920  endif
921 
922  if ( aggregate_ ) then
923  rank_x = 0
924  rank_y = 0
925  num_x = 1
926  num_y = 1
927  else
928  rank_x = prc_2drank(prc_myrank,1)
929  rank_y = prc_2drank(prc_myrank,2)
930  num_x = prc_num_x
931  num_y = prc_num_y
932  end if
933 
934  if ( present( subsec ) ) then
935  subsec_ = subsec
936  else
937  subsec_= nowsubsec
938  end if
939 
940  call file_cartesc_put_globalattributes( fid, & ! [IN]
941  rank_x, rank_y, & ! [IN]
942  num_x, num_y, & ! [IN]
943  prc_periodic_x, prc_periodic_y, & ! [IN]
944  kmax, okmax, lkmax, ukmax, & ! [IN]
945  imaxg, jmaxg, & ! [IN]
946  khalo, ihalo, jhalo, & ! [IN]
947  subsec_, tunits, calendar ) ! [IN]
948 
949  call file_cartesc_def_axes( fid, & ! [IN]
950  dtype, & ! [IN]
951  file_haszcoord(fid) ) ! [IN]
952 
953  end if
954 
955  call prof_rapend ('FILE_Write', 2)
956  prof = .false.
957 
958  return
959  end subroutine file_cartesc_create
960 
961  !-----------------------------------------------------------------------------
963  subroutine file_cartesc_enddef( fid )
964  use scale_file, only: &
966  file_opened, &
967  file_allnodes, &
968  file_enddef, &
969  file_flush, &
971  implicit none
972 
973  integer, intent(in) :: fid
974 
975  integer :: start(3)
976  !---------------------------------------------------------------------------
977 
978  if ( .not. file_opened(fid) ) return
979 
980  call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
981 
982  call file_enddef( fid ) ! [IN]
983 
984  ! If this enddef is called the first time, write axis variables
985  if ( .NOT. file_axes_written(fid) ) then
986 
987  if ( file_get_aggregate(fid) ) then
988  start(1) = 1
989  start(2) = isga
990  start(3) = jsga
991  else
992  start(1) = 1
993  start(2) = 1
994  start(3) = 1
995  endif
996 
997  call file_cartesc_write_axes( fid, & ! [IN]
998  file_haszcoord(fid), & ! [IN]
999  start(:) ) ! [IN]
1000 
1001  file_axes_written(fid) = .true.
1002  endif
1003 
1004  ! Tell PnetCDF library to use a buffer of size write_buf_amount to aggregate write requests to be post in FILE_CARTESC_write_var
1005  if ( file_get_aggregate(fid) ) then
1006  call file_flush( fid )
1007  call file_attach_buffer( fid, write_buf_amount(fid) )
1008  endif
1009 
1010  call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
1011 
1012  return
1013  end subroutine file_cartesc_enddef
1014 
1015  !-----------------------------------------------------------------------------
1017  subroutine file_cartesc_flush( fid )
1018  use scale_file, only: &
1020  file_opened, &
1021  file_allnodes, &
1022  file_flush
1023  implicit none
1024 
1025  integer, intent(in) :: fid
1026  !---------------------------------------------------------------------------
1027 
1028  if ( .not. file_opened(fid) ) return
1029 
1030  call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
1031 
1032  if ( file_get_aggregate(fid) ) then
1033  call file_flush( fid ) ! flush all pending read/write requests
1034  end if
1035 
1036  call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
1037 
1038  return
1039  end subroutine file_cartesc_flush
1040 
1041  !-----------------------------------------------------------------------------
1043  subroutine file_cartesc_close( fid )
1044  use scale_file, only: &
1046  file_opened, &
1047  file_allnodes, &
1048  file_close, &
1049  file_flush, &
1051  implicit none
1052 
1053  integer, intent(in) :: fid
1054  !---------------------------------------------------------------------------
1055 
1056  if ( .not. file_opened(fid) ) return
1057 
1058  call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
1059 
1060  if ( file_get_aggregate(fid) ) then
1061  call file_flush( fid ) ! flush all pending read/write requests
1062  if ( write_buf_amount(fid) > 0 ) then
1063  call file_detach_buffer( fid ) ! detach PnetCDF aggregation buffer
1064  write_buf_amount(fid) = 0 ! reset write request amount
1065  endif
1066  endif
1067 
1068  call file_close( fid ) ! [IN]
1069 
1070  call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
1071 
1072  return
1073  end subroutine file_cartesc_close
1074 
1075  !-----------------------------------------------------------------------------
1080  !-----------------------------------------------------------------------------
1081  subroutine file_cartesc_read_1d( &
1082  basename, varname, &
1083  dim_type, &
1084  var, &
1085  step, &
1086  aggregate, &
1087  allow_missing )
1088  implicit none
1089  character(len=*), intent(in) :: basename
1090  character(len=*), intent(in) :: varname
1091  character(len=*), intent(in) :: dim_type
1092 
1093  real(RP), intent(out) :: var(:)
1094 
1095  integer, intent(in), optional :: step
1096  logical, intent(in), optional :: aggregate
1097  logical, intent(in), optional :: allow_missing
1098 
1099  integer :: fid
1100  !---------------------------------------------------------------------------
1101 
1102  call file_cartesc_open( basename, & ! [IN]
1103  fid, & ! [OUT]
1104  aggregate=aggregate ) ! [IN]
1105 
1106  call file_cartesc_read_var_1d( fid, varname, dim_type, & ! [IN]
1107  var(:), & ! [OUT]
1108  step=step, & ! [IN]
1109  allow_missing=allow_missing ) ! [IN]
1110 
1111  call file_cartesc_close( fid )
1112 
1113  return
1114  end subroutine file_cartesc_read_1d
1115 
1116  !-----------------------------------------------------------------------------
1118  subroutine file_cartesc_read_2d( &
1119  basename, varname, &
1120  dim_type, &
1121  var, &
1122  step, &
1123  aggregate, &
1124  allow_missing )
1125  implicit none
1126  character(len=*), intent(in) :: basename
1127  character(len=*), intent(in) :: varname
1128  character(len=*), intent(in) :: dim_type
1129 
1130  real(RP), intent(out) :: var(:,:)
1131 
1132  integer, intent(in), optional :: step
1133  logical, intent(in), optional :: aggregate
1134  logical, intent(in), optional :: allow_missing
1135 
1136  integer :: fid
1137  !---------------------------------------------------------------------------
1138 
1139  call file_cartesc_open( basename, & ! [IN]
1140  fid, & ! [OUT]
1141  aggregate=aggregate ) ! [IN]
1142 
1143  call file_cartesc_read_var_2d( fid, varname, dim_type, & ! [IN]
1144  var(:,:), & ! [OUT]
1145  step=step, & ! [IN]
1146  allow_missing=allow_missing ) ! [IN]
1147 
1148  call file_cartesc_close( fid )
1149 
1150  return
1151  end subroutine file_cartesc_read_2d
1152 
1153  !-----------------------------------------------------------------------------
1155  subroutine file_cartesc_read_3d( &
1156  basename, varname, &
1157  dim_type, &
1158  var, &
1159  step, &
1160  aggregate, &
1161  allow_missing )
1162  implicit none
1163  character(len=*), intent(in) :: basename
1164  character(len=*), intent(in) :: varname
1165  character(len=*), intent(in) :: dim_type
1166 
1167  real(RP), intent(out) :: var(:,:,:)
1168 
1169  integer, intent(in), optional :: step
1170  logical, intent(in), optional :: aggregate
1171  logical, intent(in), optional :: allow_missing
1172 
1173  integer :: fid
1174  !---------------------------------------------------------------------------
1175 
1176  call file_cartesc_open( basename, & ! [IN]
1177  fid, & ! [OUT]
1178  aggregate=aggregate ) ! [IN]
1179 
1180  call file_cartesc_read_var_3d( fid, varname, dim_type, & ! [IN]
1181  var(:,:,:), & ! [OUT]
1182  step=step, & ! [IN]
1183  allow_missing=allow_missing ) ! [IN]
1184 
1185  call file_cartesc_close( fid )
1186 
1187  return
1188  end subroutine file_cartesc_read_3d
1189 
1190  !-----------------------------------------------------------------------------
1192  subroutine file_cartesc_read_4d( &
1193  basename, varname, &
1194  dim_type, step, &
1195  var, &
1196  aggregate, &
1197  allow_missing )
1198  implicit none
1199  character(len=*), intent(in) :: basename
1200  character(len=*), intent(in) :: varname
1201  character(len=*), intent(in) :: dim_type
1202  integer, intent(in) :: step
1203 
1204  real(RP), intent(out) :: var(:,:,:,:)
1205 
1206  logical, intent(in), optional :: aggregate
1207  logical, intent(in), optional :: allow_missing
1208 
1209  integer :: fid
1210  !---------------------------------------------------------------------------
1211 
1212  call file_cartesc_open( basename, & ! [IN]
1213  fid, & ! [OUT]
1214  aggregate=aggregate ) ! [IN]
1215 
1216  call file_cartesc_read_var_4d( fid, varname, dim_type, step, & ! [IN]
1217  var(:,:,:,:), & ! [OUT]
1218  allow_missing=allow_missing ) ! [IN]
1219 
1220  call file_cartesc_close( fid )
1221 
1222  return
1223  end subroutine file_cartesc_read_4d
1224 
1225  !-----------------------------------------------------------------------------
1227  subroutine file_cartesc_read_var_1d( &
1228  fid, varname, &
1229  dim_type, &
1230  var, &
1231  step, &
1232  allow_missing )
1233  use scale_file, only: &
1235  file_opened, &
1236  file_allnodes, &
1237  file_read
1238  use scale_prc, only: &
1239  prc_abort
1240  use scale_prc_cartesc, only: &
1241  prc_num_x, &
1242  prc_num_y
1243  use mpi
1244  implicit none
1245  integer, intent(in) :: fid
1246  character(len=*), intent(in) :: varname
1247  character(len=*), intent(in) :: dim_type
1248 
1249  real(RP), intent(out) :: var(:)
1250 
1251  integer, intent(in), optional :: step
1252  logical, intent(in), optional :: allow_missing
1253 
1254  integer :: vsize
1255  integer :: dim1_S, dim1_E
1256  integer :: start(1) ! start offset of globale variable
1257  integer :: count(1) ! request length to the global variable
1258  !---------------------------------------------------------------------------
1259 
1260  if ( .not. file_opened(fid) ) return
1261 
1262  call prof_rapstart('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1263 
1264  log_info("FILE_CARTESC_read_var_1D",'(1x,2A)') 'Read from file (1D), name : ', trim(varname)
1265 
1266  if ( file_get_aggregate(fid) ) then
1267  ! read data and halos into the local buffer
1268  if ( dim_type == 'Z' ) then
1269  vsize = ka
1270  dim1_s = ks
1271  dim1_e = ke
1272  start(1) = 1
1273  elseif( dim_type == 'OZ' ) then
1274  vsize = oka
1275  dim1_s = oks
1276  dim1_e = oke
1277  start(1) = 1
1278  elseif( dim_type == 'LZ' ) then
1279  vsize = lka
1280  dim1_s = lks
1281  dim1_e = lke
1282  start(1) = 1
1283  elseif( dim_type == 'UZ' ) then
1284  vsize = uka
1285  dim1_s = uks
1286  dim1_e = uke
1287  start(1) = 1
1288  elseif( dim_type == 'X' .OR. dim_type == 'CX' ) then
1289  vsize = ia
1290  dim1_s = 1
1291  dim1_e = ia
1292  start(1) = is_ing - ihalo
1293  elseif( dim_type == 'Y' .OR. dim_type == 'CY' ) then
1294  vsize = ja
1295  dim1_s = 1
1296  dim1_e = ja
1297  start(1) = js_ing - jhalo
1298  else
1299  log_error("FILE_CARTESC_read_var_1D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
1300  call prc_abort
1301  endif
1302 
1303  if ( size(var) .ne. vsize ) then
1304  log_error("FILE_CARTESC_read_var_1D",*) 'size of var is invalid: ', trim(varname), size(var), vsize
1305  call prc_abort
1306  end if
1307  count(1) = dim1_e - dim1_s + 1
1308  call file_read( fid, varname, & ! (in)
1309  var(dim1_s:dim1_e), & ! (out)
1310  step=step, allow_missing=allow_missing, & ! (in)
1311  ntypes=count(1), dtype=etype, start=start, count=count ) ! (in)
1312 
1313  else
1314  if ( dim_type == 'Z' ) then
1315  vsize = ka
1316  dim1_s = ks
1317  dim1_e = ke
1318  elseif( dim_type == 'OZ' ) then
1319  vsize = oka
1320  dim1_s = oks
1321  dim1_e = oke
1322  elseif( dim_type == 'LZ' ) then
1323  vsize = lka
1324  dim1_s = lks
1325  dim1_e = lke
1326  elseif( dim_type == 'UZ' ) then
1327  vsize = uka
1328  dim1_s = uks
1329  dim1_e = uke
1330  elseif( dim_type == 'X' ) then
1331  vsize = ia
1332  dim1_s = isb
1333  dim1_e = ieb
1334  elseif( dim_type == 'CX' ) then
1335  vsize = ia
1336  dim1_s = 1
1337  dim1_e = ia
1338  elseif( dim_type == 'Y' ) then
1339  vsize = ja
1340  dim1_s = jsb
1341  dim1_e = jeb
1342  elseif( dim_type == 'CY' ) then
1343  vsize = ja
1344  dim1_s = 1
1345  dim1_e = ja
1346  else
1347  log_error("FILE_CARTESC_read_var_1D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
1348  call prc_abort
1349  endif
1350 
1351  if ( size(var) .ne. vsize ) then
1352  log_error("FILE_CARTESC_read_var_1D",*) 'size of var is invalid: ', trim(varname), size(var), vsize
1353  call prc_abort
1354  end if
1355  call file_read( fid, varname, var(dim1_s:dim1_e), step=step )
1356  endif
1357 
1358  call prof_rapend('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1359 
1360  return
1361  end subroutine file_cartesc_read_var_1d
1362 
1363  !-----------------------------------------------------------------------------
1365  subroutine file_cartesc_read_var_2d( &
1366  fid, varname, &
1367  dim_type, &
1368  var, &
1369  step, &
1370  allow_missing )
1371  use scale_file, only: &
1373  file_opened, &
1374  file_allnodes, &
1375  file_read
1376  use scale_prc, only: &
1377  prc_abort
1378  implicit none
1379  integer, intent(in) :: fid
1380  character(len=*), intent(in) :: varname
1381  character(len=*), intent(in) :: dim_type
1382 
1383  real(RP), intent(out) :: var(:,:)
1384 
1385  integer, intent(in), optional :: step
1386  logical, intent(in), optional :: allow_missing
1387 
1388  integer :: vsize
1389  integer :: ntypes, dtype
1390  integer, pointer :: start(:), count(:)
1391  integer :: dim1_S, dim1_E
1392  integer :: dim2_S, dim2_E
1393 
1394  real(RP), allocatable :: buf(:,:)
1395  !---------------------------------------------------------------------------
1396 
1397  if ( .not. file_opened(fid) ) return
1398 
1399  call prof_rapstart('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1400 
1401  log_info("FILE_CARTESC_read_var_2D",'(1x,2A)') 'Read from file (2D), name : ', trim(varname)
1402 
1403  if ( file_get_aggregate(fid) ) then
1404 
1405  ! read data and halos into the local buffer
1406  if ( dim_type == 'XY' ) then
1407  vsize = ia * ja
1408  ntypes = ia * ja
1409  dtype = etype
1410  start => startxy
1411  count => countxy
1412  elseif( dim_type == 'ZX' ) then
1413  ! Because KHALO is not saved in files, we use centerTypeZX, an MPI
1414  ! derived datatype to describe the layout of local read buffer
1415  vsize = ka * ia
1416  ntypes = 1
1417  dtype = centertypezx
1418  start => startzx
1419  count => countzx
1420  else
1421  log_error("FILE_CARTESC_read_var_2D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
1422  call prc_abort
1423  endif
1424 
1425  if ( size(var) .ne. vsize ) then
1426  log_error("FILE_CARTESC_read_var_2D",*) 'size of var is invalid: ', trim(varname), size(var), vsize
1427  call prc_abort
1428  end if
1429  call file_read( fid, varname, & ! (in)
1430  var(:,:), & ! (out)
1431  step=step, allow_missing=allow_missing, & ! (in)
1432  ntypes=ntypes, dtype=dtype, start=start, count=count ) ! (in)
1433 
1434  else
1435 
1436  if ( dim_type == 'XY' ) then
1437  vsize = ia * ja
1438  dim1_s = isb
1439  dim1_e = ieb
1440  dim2_s = jsb
1441  dim2_e = jeb
1442  elseif( dim_type == 'ZX' ) then
1443  vsize = ka * ia
1444  dim1_s = ks
1445  dim1_e = ke
1446  dim2_s = isb
1447  dim2_e = ieb
1448  else
1449  log_error("FILE_CARTESC_read_var_2D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
1450  call prc_abort
1451  endif
1452 
1453  if ( size(var) .ne. vsize ) then
1454  log_error("FILE_CARTESC_read_var_2D",*) 'size of var is invalid: ', trim(varname), size(var), vsize
1455  call prc_abort
1456  end if
1457  allocate( buf(dim1_s:dim1_e,dim2_s:dim2_e) )
1458  call file_read( fid, varname, buf(:,:), step=step )
1459  !$omp workshare
1460  var(dim1_s:dim1_e,dim2_s:dim2_e) = buf(:,:)
1461  !$omp endworkshare
1462  deallocate( buf )
1463 
1464  !$acc update device(var) if(acc_is_present(var))
1465  endif
1466 
1467  call prof_rapend('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1468 
1469  return
1470  end subroutine file_cartesc_read_var_2d
1471 
1472  !-----------------------------------------------------------------------------
1474  subroutine file_cartesc_read_var_3d( &
1475  fid, varname, &
1476  dim_type, &
1477  var, &
1478  step, &
1479  allow_missing )
1480  use scale_file, only: &
1482  file_opened, &
1483  file_allnodes, &
1484  file_read
1485  use scale_prc, only: &
1486  prc_abort
1487  use scale_prc_cartesc, only: &
1488  prc_num_x, &
1489  prc_num_y
1490  implicit none
1491  integer, intent(in) :: fid
1492  character(len=*), intent(in) :: varname
1493  character(len=*), intent(in) :: dim_type
1494 
1495  real(RP), intent(out) :: var(:,:,:)
1496 
1497  integer, intent(in), optional :: step
1498  logical, intent(in), optional :: allow_missing
1499 
1500  integer :: vsize
1501  integer :: ntypes, dtype
1502  integer, pointer :: start(:), count(:)
1503  integer :: dim1_S, dim1_E
1504  integer :: dim2_S, dim2_E
1505  integer :: dim3_S, dim3_E
1506  real(RP), allocatable :: buf(:,:,:)
1507  !---------------------------------------------------------------------------
1508 
1509  if ( .not. file_opened(fid) ) return
1510 
1511  call prof_rapstart('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1512 
1513  log_info("FILE_CARTESC_read_var_3D",'(1x,2A)') 'Read from file (3D), name : ', trim(varname)
1514 
1515  if ( file_get_aggregate(fid) ) then
1516 
1517  ! read data and halos into the local buffer
1518  ! Because KHALO is not saved in files, we use mpi derived datatypes to
1519  ! describe the layout of local read buffer
1520  if( dim_type == 'ZXY' &
1521  .or. dim_type == 'ZXHY' &
1522  .or. dim_type == 'ZXYH' ) then
1523  vsize = ka * ia * ja
1524  ntypes = 1
1525  dtype = centertypezxy
1526  start => startzxy
1527  count => countzxy
1528  elseif( dim_type == 'ZHXY' ) then
1529  vsize = ka * ia * ja
1530  ntypes = 1
1531  dtype = centertypezhxy
1532  start => startzhxy
1533  count => countzhxy
1534  elseif( dim_type == 'XYT' ) then
1535  if ( .not. present(step) ) then
1536  log_error("FILE_CARTESC_read_var_3D",*) 'step is necessary for "XYT"'
1537  call prc_abort
1538  end if
1539  vsize = ia * ja * step
1540  ntypes = ia * ja * step
1541  dtype = etype
1542  startxy(3) = 1
1543  countxy(3) = step
1544  start => startxy
1545  count => countxy
1546  elseif( dim_type == 'OXY' ) then
1547  vsize = oka * oia * oja
1548  ntypes = 1
1549  dtype = centertypeocean
1550  start => startocean
1551  count => countocean
1552  elseif( dim_type == 'LXY' ) then
1553  vsize = lka * lia * lja
1554  ntypes = 1
1555  dtype = centertypeland
1556  start => startland
1557  count => countland
1558  elseif( dim_type == 'UXY' ) then
1559  vsize = uka * uia * uja
1560  ntypes = 1
1561  dtype = centertypeurban
1562  start => starturban
1563  count => counturban
1564  else
1565  log_error("FILE_CARTESC_read_var_3D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
1566  call prc_abort
1567  endif
1568 
1569  if ( size(var) .ne. vsize ) then
1570  log_error("FILE_CARTESC_read_var_3D",*) 'size of var is invalid: ', trim(varname), size(var), vsize
1571  call prc_abort
1572  end if
1573  call file_read( fid, varname, & ! (in)
1574  var(:,:,:), & ! (out)
1575  step=step, allow_missing=allow_missing, & ! (in)
1576  ntypes=ntypes, dtype=dtype, start=start, count=count ) ! (in)
1577 
1578  else
1579  if( dim_type == 'ZXY' &
1580  .or. dim_type == 'ZXHY' &
1581  .or. dim_type == 'ZXYH' ) then
1582  vsize = ka * ia * ja
1583  dim1_s = ks
1584  dim1_e = ke
1585  dim2_s = isb
1586  dim2_e = ieb
1587  dim3_s = jsb
1588  dim3_e = jeb
1589  elseif( dim_type == 'ZHXY' ) then
1590  vsize = ka * ia * ja
1591  dim1_s = ks-1
1592  dim1_e = ke
1593  dim2_s = isb
1594  dim2_e = ieb
1595  dim3_s = jsb
1596  dim3_e = jeb
1597  elseif( dim_type == 'XYT' ) then
1598  if ( .not. present(step) ) then
1599  log_error("FILE_CARTESC_read_var_3D",*) 'step is necessary for "XYT"'
1600  call prc_abort
1601  end if
1602  vsize = ia * ja * step
1603  dim1_s = isb
1604  dim1_e = ieb
1605  dim2_s = jsb
1606  dim2_e = jeb
1607  dim3_s = 1
1608  dim3_e = step
1609  elseif( dim_type == 'OXY' ) then
1610  vsize = oka * oia * oja
1611  dim1_s = oks
1612  dim1_e = oke
1613  dim2_s = isb
1614  dim2_e = ieb
1615  dim3_s = jsb
1616  dim3_e = jeb
1617  elseif( dim_type == 'LXY' ) then
1618  vsize = lka * lia * lja
1619  dim1_s = lks
1620  dim1_e = lke
1621  dim2_s = isb
1622  dim2_e = ieb
1623  dim3_s = jsb
1624  dim3_e = jeb
1625  elseif( dim_type == 'UXY' ) then
1626  vsize = uka * uia * uja
1627  dim1_s = uks
1628  dim1_e = uke
1629  dim2_s = isb
1630  dim2_e = ieb
1631  dim3_s = jsb
1632  dim3_e = jeb
1633  else
1634  log_error("FILE_CARTESC_read_var_3D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
1635  call prc_abort
1636  endif
1637 
1638  if ( size(var) .ne. vsize ) then
1639  log_error("FILE_CARTESC_read_var_3D",*) 'size of var is invalid: ', trim(varname), size(var), vsize
1640  call prc_abort
1641  end if
1642 
1643  allocate( buf(dim1_s:dim1_e,dim2_s:dim2_e,dim3_s:dim3_e) )
1644  call file_read( fid, varname, buf(:,:,:), &
1645  step=step, allow_missing=allow_missing )
1646  !$omp workshare
1647  var(dim1_s:dim1_e,dim2_s:dim2_e,dim3_s:dim3_e) = buf(:,:,:)
1648  !$omp end workshare
1649  deallocate( buf )
1650 
1651  !$acc update device(var) if(acc_is_present(var))
1652  endif
1653 
1654  call prof_rapend('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1655 
1656  return
1657  end subroutine file_cartesc_read_var_3d
1658 
1659  !-----------------------------------------------------------------------------
1661  subroutine file_cartesc_read_var_4d( &
1662  fid, varname, &
1663  dim_type, &
1664  step, &
1665  var, &
1666  allow_missing )
1667  use scale_file, only: &
1669  file_opened, &
1670  file_allnodes, &
1671  file_read
1672  use scale_prc, only: &
1673  prc_abort
1674  use scale_prc_cartesc, only: &
1675  prc_num_x, &
1676  prc_num_y
1677  implicit none
1678  integer, intent(in) :: fid
1679  character(len=*), intent(in) :: varname
1680  character(len=*), intent(in) :: dim_type
1681  integer, intent(in) :: step
1682 
1683  real(RP), intent(out) :: var(:,:,:,:)
1684 
1685  logical, intent(in), optional :: allow_missing
1686 
1687  integer :: vsize
1688  integer :: dtype
1689  integer, pointer :: start(:), count(:)
1690  integer :: dim1_S, dim1_E
1691  integer :: dim2_S, dim2_E
1692  integer :: dim3_S, dim3_E
1693  integer :: dim4_S, dim4_E
1694 
1695  real(RP), allocatable :: buf(:,:,:,:)
1696  !---------------------------------------------------------------------------
1697 
1698  if ( .not. file_opened(fid) ) return
1699 
1700  call prof_rapstart('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1701 
1702  log_info("FILE_CARTESC_read_var_4D",'(1x,2A)') 'Read from file (4D), name : ', trim(varname)
1703 
1704  if ( file_get_aggregate(fid) ) then
1705  ! read data and halos into the local buffer
1706  if ( dim_type == 'ZXYT' &
1707  .or. dim_type == 'ZXHYT' &
1708  .or. dim_type == 'ZXYHT' ) then
1709  vsize = ka * ia * ja * step
1710  dtype = centertypezxy
1711  start => startzxy
1712  count => countzxy
1713  elseif ( dim_type == 'ZHXYT' ) then
1714  vsize = ka * ia * ja * step
1715  dtype = centertypezhxy
1716  start => startzhxy
1717  count => countzhxy
1718  elseif ( dim_type == 'OXYT' ) then
1719  vsize = oka * oia * oja * step
1720  dtype = centertypeocean
1721  start => startocean
1722  count => countocean
1723  elseif ( dim_type == 'LXYT' ) then
1724  vsize = lka * lia * lja * step
1725  dtype = centertypeland
1726  start => startland
1727  count => countland
1728  elseif ( dim_type == 'UXYT' ) then
1729  vsize = uka * uia * uja * step
1730  dtype = centertypeurban
1731  start => starturban
1732  count => counturban
1733  else
1734  log_error("FILE_CARTESC_read_var_4D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
1735  call prc_abort
1736  endif
1737 
1738  if ( size(var) .ne. vsize ) then
1739  log_error("FILE_CARTESC_read_var_4D",*) 'size of var is invalid: ', trim(varname), size(var), vsize
1740  call prc_abort
1741  end if
1742  start(4) = 1
1743  count(4) = step
1744  call file_read( fid, varname, & ! (in)
1745  var(:,:,:,:), & ! (out)
1746  allow_missing=allow_missing, & ! (in)
1747  ntypes=step, dtype=dtype, start=start, count=count ) ! (in)
1748 
1749  else
1750  if ( dim_type == 'ZXYT' &
1751  .or. dim_type == 'ZXHYT' &
1752  .or. dim_type == 'ZXYHT' ) then
1753  vsize = ka * ia * ja * step
1754  dim1_s = ks
1755  dim1_e = ke
1756  dim2_s = isb
1757  dim2_e = ieb
1758  dim3_s = jsb
1759  dim3_e = jeb
1760  elseif ( dim_type == 'ZHXYT' ) then
1761  vsize = ka * ia * ja * step
1762  dim1_s = ks-1
1763  dim1_e = ke
1764  dim2_s = isb
1765  dim2_e = ieb
1766  dim3_s = jsb
1767  dim3_e = jeb
1768  elseif ( dim_type == 'OXYT' ) then
1769  vsize = oka * oia * oja * step
1770  dim1_s = oks
1771  dim1_e = oke
1772  dim2_s = isb
1773  dim2_e = ieb
1774  dim3_s = jsb
1775  dim3_e = jeb
1776  elseif ( dim_type == 'LXYT' ) then
1777  vsize = lka * lia * lja * step
1778  dim1_s = lks
1779  dim1_e = lke
1780  dim2_s = isb
1781  dim2_e = ieb
1782  dim3_s = jsb
1783  dim3_e = jeb
1784  elseif ( dim_type == 'UXYT' ) then
1785  vsize = uka * uia * uja * step
1786  dim1_s = uks
1787  dim1_e = uke
1788  dim2_s = isb
1789  dim2_e = ieb
1790  dim3_s = jsb
1791  dim3_e = jeb
1792  else
1793  log_error("FILE_CARTESC_read_var_4D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
1794  call prc_abort
1795  endif
1796 
1797  if ( size(var) .ne. vsize ) then
1798  log_error("FILE_CARTESC_read_var_4D",*) 'size of var is invalid: ', trim(varname), size(var), vsize
1799  call prc_abort
1800  end if
1801  dim4_s = 1
1802  dim4_e = step
1803 
1804  allocate( buf(dim1_s:dim1_e,dim2_s:dim2_e,dim3_s:dim3_e,dim4_s:dim4_e) )
1805  call file_read( fid, varname, & ! (in)
1806  buf(:,:,:,:) ) ! (out)
1807  !$omp workshare
1808  var(dim1_s:dim1_e,dim2_s:dim2_e,dim3_s:dim3_e,dim4_s:dim4_e) = buf(:,:,:,:)
1809  !$omp end workshare
1810  deallocate( buf )
1811 
1812  !$acc update device(var) if(acc_is_present(var))
1813  endif
1814 
1815  call prof_rapend('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1816 
1817  return
1818  end subroutine file_cartesc_read_var_4d
1819 
1820  !-----------------------------------------------------------------------------
1822  subroutine file_cartesc_read_auto_2d( &
1823  fid, varname, &
1824  var, &
1825  step, existed )
1826  use scale_file, only: &
1827  file_opened, &
1828  file_allnodes, &
1829  file_get_shape, &
1830  file_get_datainfo, &
1831  file_get_attribute, &
1832  file_read
1833  use scale_prc, only: &
1834  prc_abort
1835  implicit none
1836  integer, intent(in) :: fid
1837  character(len=*), intent(in) :: varname
1838 
1839  real(RP), intent(out) :: var(:,:)
1840 
1841  integer, intent(in), optional :: step
1842 
1843  logical, intent(out), optional :: existed
1844 
1845  integer :: dims(2)
1846  integer :: halos(2)
1847  integer :: start(2)
1848  integer :: count(2)
1849  character(len=H_SHORT) :: dnames(2)
1850 
1851  integer :: nx, ny
1852  integer :: n
1853 
1854  logical :: existed2
1855 
1856  intrinsic size
1857  !---------------------------------------------------------------------------
1858 
1859  if ( .not. file_opened(fid) ) return
1860 
1861  call prof_rapstart('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1862 
1863  log_info("FILE_CARTESC_read_auto_2D",'(1x,2A)') 'Read from file (2D), name : ', trim(varname)
1864 
1865  call file_get_datainfo( fid, varname, dim_name=dnames(:), existed=existed2 )
1866 
1867  if ( present( existed ) ) then
1868  existed = existed2
1869  if ( .not. existed2 ) then
1870  call prof_rapend ('FILE_Read', 2)
1871  return
1872  end if
1873  end if
1874 
1875  if ( .not. existed2 ) then
1876  log_error("FILE_CARTESC_read_auto_2D",*) 'variable not found: ', trim(varname)
1877  call prc_abort
1878  end if
1879 
1880  call file_get_shape( fid, varname, dims(:) )
1881  nx = size(var,1)
1882  ny = size(var,2)
1883 
1884  if ( nx==dims(1) .and. ny==dims(2) ) then
1885  start(:) = (/1,1/)
1886  else
1887  do n = 1, 2
1888  call file_get_attribute( fid, dnames(n), "halo_local", halos(:), existed=existed2 )
1889  if ( existed2 ) then
1890  start(n) = halos(1) + 1
1891  else
1892  start(n) = 1
1893  end if
1894  end do
1895  end if
1896  count(:) = (/nx,ny/)
1897 
1898  call file_read( fid, varname, var(:,:), step=step, start=start(:), count=count(:) )
1899  call file_cartesc_flush( fid )
1900  !$acc update device(var) if(acc_is_present(var))
1901 
1902  call prof_rapend('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1903 
1904  return
1905  end subroutine file_cartesc_read_auto_2d
1906 
1907  !-----------------------------------------------------------------------------
1909  subroutine file_cartesc_read_auto_3d( &
1910  fid, varname, &
1911  var, &
1912  step, existed )
1913  use scale_file, only: &
1914  file_opened, &
1915  file_allnodes, &
1916  file_get_shape, &
1917  file_get_datainfo, &
1918  file_get_attribute, &
1919  file_read
1920  use scale_prc, only: &
1921  prc_abort
1922  implicit none
1923  integer, intent(in) :: fid
1924  character(len=*), intent(in) :: varname
1925 
1926  real(RP), intent(out) :: var(:,:,:)
1927 
1928  integer, intent(in), optional :: step
1929 
1930  logical, intent(out), optional :: existed
1931 
1932  integer :: dims(3)
1933  integer :: halos(3)
1934  integer :: start(3)
1935  integer :: count(3)
1936  character(len=H_SHORT) :: dnames(3)
1937 
1938  logical :: existed2
1939 
1940  real(RP), allocatable :: buf(:,:,:)
1941  integer :: nx, ny, nz
1942  integer :: n
1943  integer :: k, i, j
1944 
1945  intrinsic size
1946  !---------------------------------------------------------------------------
1947 
1948  if ( .not. file_opened(fid) ) return
1949 
1950  call prof_rapstart('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
1951 
1952  log_info("FILE_CARTESC_read_auto_3D",'(1x,2A)') 'Read from file (3D), name : ', trim(varname)
1953 
1954  call file_get_datainfo( fid, varname, dim_name=dnames(:), existed=existed2 )
1955 
1956  if ( present(existed) ) then
1957  existed = existed2
1958  if ( .not. existed2 ) then
1959  call prof_rapend ('FILE_Read', 2)
1960  return
1961  end if
1962  end if
1963 
1964  if ( .not. existed2 ) then
1965  log_error("FILE_CARTESC_read_auto_3D",*) 'variable not found: ', trim(varname)
1966  call prc_abort
1967  end if
1968 
1969  call file_get_shape( fid, varname, dims(:) )
1970  nz = size(var,1)
1971  nx = size(var,2)
1972  ny = size(var,3)
1973 
1974  if ( ( dnames(1)(1:1)=="z" .or. dnames(1)(2:2)=="z" ) .and. dnames(2)(1:1)=="x" .and. dnames(3)(1:1)=="y" ) then
1975  if ( nz==dims(1) .and. nx==dims(2) .and. ny==dims(3) ) then
1976  start(:) = (/1,1,1/)
1977  else if ( dnames(1)=="zh" .and. nz+1==dims(1) .and. nx==dims(2) .and. ny==dims(3) ) then
1978  start(:) = (/2,1,1/)
1979  else
1980  do n = 1, 3
1981  call file_get_attribute( fid, dnames(n), "halo_local", halos(:), existed=existed2 )
1982  if ( existed2 ) then
1983  start(n) = halos(1) + 1
1984  else if ( dnames(n)=="zh" ) then
1985  start(n) = 2
1986  else
1987  start(n) = 1
1988  end if
1989  end do
1990  end if
1991  count(:) = (/nz,nx,ny/)
1992  call file_read( fid, varname, var(:,:,:), step=step, start=start(:), count=count(:) )
1993  call file_cartesc_flush( fid )
1994  !$acc update device(var) if(acc_is_present(var))
1995  else if ( dnames(1)(1:1)=="x" .and. dnames(2)(1:1)=="y" .and. ( dnames(3)(1:1)=="z" .or. dnames(3)(2:2)=="z" ) ) then
1996  allocate( buf(nx,ny,nz) )
1997  if ( nx==dims(1) .and. ny==dims(2) .and. nz==dims(3) ) then
1998  start(:) = (/1,1,1/)
1999  else if ( nx==dims(1) .and. ny==dims(2) .and. nz+1==dims(3) .and. dnames(3)=="zh" ) then
2000  start(:) = (/1,1,2/)
2001  else
2002  do n = 1, 3
2003  call file_get_attribute( fid, dnames(n), "halo_local", halos(:), existed=existed2 )
2004  if ( existed2 ) then
2005  start(n) = halos(1) + 1
2006  else if ( dnames(n)=="zh" ) then
2007  start(n) = 2
2008  else
2009  start(n) = 1
2010  end if
2011  end do
2012  end if
2013  count(:) = (/nx,ny,nz/)
2014  call file_read( fid, varname, buf(:,:,:), step=step, start=start(:), count=count(:) )
2015  call file_cartesc_flush( fid )
2016 
2017  !$omp parallel do
2018  !$acc kernels if(acc_is_present(var))
2019  do j = 1, ny
2020  do i = 1, nx
2021  do k = 1, nz
2022  var(k,i,j) = buf(i,j,k)
2023  end do
2024  end do
2025  end do
2026  !$acc end kernels
2027  deallocate(buf)
2028  else
2029  log_error("FILE_CARTESC_read_auto_3D",*) 'invalid dimension'
2030  call prc_abort
2031  end if
2032 
2033  call prof_rapend('FILE_Read', 2, disable_barrier = .not. file_allnodes(fid) )
2034 
2035  return
2036  end subroutine file_cartesc_read_auto_3d
2037 
2038  !-----------------------------------------------------------------------------
2043  !-----------------------------------------------------------------------------
2044  subroutine file_cartesc_write_1d( &
2045  var, &
2046  basename, title, &
2047  varname, desc, unit, &
2048  dim_type, datatype, &
2049  date, subsec, &
2050  append, aggregate, &
2051  standard_name, &
2052  cell_measures )
2053  implicit none
2054 
2055  real(RP), intent(in) :: var(:)
2056  character(len=*), intent(in) :: basename
2057  character(len=*), intent(in) :: title
2058  character(len=*), intent(in) :: varname
2059  character(len=*), intent(in) :: desc
2060  character(len=*), intent(in) :: unit
2061  character(len=*), intent(in) :: dim_type
2062  character(len=*), intent(in) :: datatype
2063 
2064  integer, intent(in), optional :: date(6)
2065  real(DP), intent(in), optional :: subsec
2066  logical, intent(in), optional :: append
2067  logical, intent(in), optional :: aggregate
2068  character(len=*), intent(in), optional :: standard_name
2069  character(len=*), intent(in), optional :: cell_measures
2070 
2071  integer :: fid, vid
2072  !---------------------------------------------------------------------------
2073 
2074  log_info("FILE_CARTESC_write_1D",'(1x,2A)') 'Write to file (1D), name : ', trim(varname)
2075 
2076  call file_cartesc_create( basename, title, datatype, & ! [IN]
2077  fid, & ! [OUT]
2078  date=date, subsec=subsec, & ! [IN]
2079  append=append, aggregate=aggregate, single=.true. ) ! [IN]
2080 
2081  call file_cartesc_def_var( fid, varname, desc, unit, dim_type, datatype, & ! [IN]
2082  vid, & ! [OUT]
2083  standard_name=standard_name, & ! [IN]
2084  cell_measures=cell_measures ) ! [IN]
2085 
2086  call file_cartesc_enddef( fid )
2087 
2088  call file_cartesc_write_var_1d( fid, vid, var, varname, dim_type )
2089 
2090  return
2091  end subroutine file_cartesc_write_1d
2092 
2093  !-----------------------------------------------------------------------------
2095  subroutine file_cartesc_write_2d( &
2096  var, &
2097  basename, title, &
2098  varname, desc, unit, &
2099  dim_type, datatype, &
2100  date, subsec, &
2101  fill_halo, haszcoord, &
2102  append, aggregate, &
2103  standard_name, &
2104  cell_measures )
2105  implicit none
2106 
2107  real(RP), intent(in) :: var(:,:)
2108  character(len=*), intent(in) :: basename
2109  character(len=*), intent(in) :: title
2110  character(len=*), intent(in) :: varname
2111  character(len=*), intent(in) :: desc
2112  character(len=*), intent(in) :: unit
2113  character(len=*), intent(in) :: dim_type
2114  character(len=*), intent(in) :: datatype
2115 
2116  integer, intent(in), optional :: date(6)
2117  real(DP), intent(in), optional :: subsec
2118  logical, intent(in), optional :: fill_halo
2119  logical, intent(in), optional :: haszcoord
2120  logical, intent(in), optional :: append
2121  logical, intent(in), optional :: aggregate
2122  character(len=*), intent(in), optional :: standard_name
2123  character(len=*), intent(in), optional :: cell_measures
2124 
2125  integer :: fid, vid
2126  !---------------------------------------------------------------------------
2127 
2128  log_info("FILE_CARTESC_write_2D",'(1x,2A)') 'Write to file (2D), name : ', trim(varname)
2129 
2130  call file_cartesc_create( basename, title, datatype, & ! [IN]
2131  fid, & ! [OUT]
2132  date=date, subsec=subsec, & ! [IN]
2133  haszcoord=haszcoord, & ! [IN]
2134  append=append, aggregate=aggregate ) ! [IN]
2135 
2136  call file_cartesc_def_var( fid, varname, desc, unit, dim_type, datatype, & ! [IN]
2137  vid, & ! [OUT]
2138  standard_name=standard_name, & ! [IN]
2139  cell_measures=cell_measures ) ! [IN]
2140 
2141  call file_cartesc_enddef( fid )
2142 
2143  call file_cartesc_write_var_2d( fid, vid, var, varname, dim_type, fill_halo )
2144 
2145  return
2146  end subroutine file_cartesc_write_2d
2147 
2148  !-----------------------------------------------------------------------------
2150  subroutine file_cartesc_write_3d( &
2151  var, &
2152  basename, title, &
2153  varname, desc, unit, &
2154  dim_type, datatype, &
2155  date, subsec, &
2156  fill_halo, &
2157  append, aggregate, &
2158  standard_name, &
2159  cell_measures )
2160  implicit none
2161 
2162  real(RP), intent(in) :: var(:,:,:)
2163  character(len=*), intent(in) :: basename
2164  character(len=*), intent(in) :: title
2165  character(len=*), intent(in) :: varname
2166  character(len=*), intent(in) :: desc
2167  character(len=*), intent(in) :: unit
2168  character(len=*), intent(in) :: dim_type
2169  character(len=*), intent(in) :: datatype
2170 
2171  integer, intent(in), optional :: date(6)
2172  real(DP), intent(in), optional :: subsec
2173  logical, intent(in), optional :: fill_halo
2174  logical, intent(in), optional :: append
2175  logical, intent(in), optional :: aggregate
2176  character(len=*), intent(in), optional :: standard_name
2177  character(len=*), intent(in), optional :: cell_measures
2178 
2179  integer :: fid, vid
2180  !---------------------------------------------------------------------------
2181 
2182  log_info("FILE_CARTESC_write_3D",'(1x,2A)') 'Write to file (3D), name : ', trim(varname)
2183 
2184  call file_cartesc_create( basename, title, datatype, & ! [IN]
2185  fid, & ! [OUT]
2186  date=date, subsec=subsec, & ! [IN]
2187  append=append, aggregate=aggregate ) ! [IN]
2188 
2189  call file_cartesc_def_var( fid, varname, desc, unit, dim_type, datatype, & ! [IN]
2190  vid, & ! [OUT]
2191  standard_name=standard_name, & ! [IN]
2192  cell_measures=cell_measures ) ! [IN]
2193 
2194  call file_cartesc_enddef( fid )
2195 
2196  call file_cartesc_write_var_3d( fid, vid, var, varname, dim_type, fill_halo )
2197 
2198 
2199  return
2200  end subroutine file_cartesc_write_3d
2201 
2202  !-----------------------------------------------------------------------------
2204  subroutine file_cartesc_write_3d_t( &
2205  var, &
2206  basename, title, &
2207  varname, desc, unit, &
2208  dim_type, datatype, &
2209  timeintv, tsince, &
2210  timetarg, timeofs, &
2211  fill_halo, &
2212  append, aggregate, &
2213  standard_name, &
2214  cell_measures )
2215  implicit none
2216 
2217  real(RP), intent(in) :: var(:,:,:)
2218  character(len=*), intent(in) :: basename
2219  character(len=*), intent(in) :: title
2220  character(len=*), intent(in) :: varname
2221  character(len=*), intent(in) :: desc
2222  character(len=*), intent(in) :: unit
2223  character(len=*), intent(in) :: dim_type
2224  character(len=*), intent(in) :: datatype
2225  real(DP), intent(in) :: timeintv
2226  integer , intent(in) :: tsince(6)
2227 
2228  integer, intent(in), optional :: timetarg
2229  real(DP), intent(in), optional :: timeofs
2230  logical, intent(in), optional :: fill_halo
2231  logical, intent(in), optional :: append
2232  logical, intent(in), optional :: aggregate
2233  character(len=*), intent(in), optional :: standard_name
2234  character(len=*), intent(in), optional :: cell_measures
2235 
2236  integer :: fid, vid
2237  integer :: nsteps
2238 
2239  intrinsic :: size
2240  !---------------------------------------------------------------------------
2241 
2242  log_info("FILE_CARTESC_write_3D_t",'(1x,3A)') 'Write to file (3D), name : ', trim(varname), 'with time dimension'
2243 
2244  call file_cartesc_create( basename, title, datatype, & ! [IN]
2245  fid, & ! [OUT]
2246  date=tsince, & ! [IN]
2247  append=append, aggregate=aggregate ) ! [IN]
2248 
2249  if ( present(timetarg) ) then
2250  nsteps = 1
2251  else
2252  nsteps = size(var,3)
2253  endif
2254  call file_cartesc_def_var( fid, varname, desc, unit, dim_type, datatype, & ! [IN]
2255  vid, & ! [OUT]
2256  standard_name=standard_name, & ! [IN]
2257  cell_measures=cell_measures, & ! [IN]
2258  timeintv=timeintv, nsteps=nsteps ) ! [IN]
2259 
2260  call file_cartesc_enddef( fid )
2261 
2262  call file_cartesc_write_var_3d_t( fid, vid, var, varname, dim_type, timeintv, &
2263  timetarg, timeofs, fill_halo )
2264 
2265  return
2266  end subroutine file_cartesc_write_3d_t
2267 
2268  !-----------------------------------------------------------------------------
2270  subroutine file_cartesc_write_4d( &
2271  var, &
2272  basename, title, &
2273  varname, desc, unit, &
2274  dim_type, datatype, &
2275  timeintv, tsince, &
2276  timetarg, timeofs, &
2277  fill_halo, &
2278  append, aggregate, &
2279  standard_name, &
2280  cell_measures )
2281  implicit none
2282 
2283  real(RP), intent(in) :: var(:,:,:,:)
2284  character(len=*), intent(in) :: basename
2285  character(len=*), intent(in) :: title
2286  character(len=*), intent(in) :: varname
2287  character(len=*), intent(in) :: desc
2288  character(len=*), intent(in) :: unit
2289  character(len=*), intent(in) :: dim_type
2290  character(len=*), intent(in) :: datatype
2291  real(DP), intent(in) :: timeintv
2292  integer, intent(in) :: tsince(6)
2293 
2294  integer, intent(in), optional :: timetarg
2295  real(DP), intent(in), optional :: timeofs
2296  logical, intent(in), optional :: fill_halo
2297  logical, intent(in), optional :: append
2298  logical, intent(in), optional :: aggregate
2299  character(len=*), intent(in), optional :: standard_name
2300  character(len=*), intent(in), optional :: cell_measures
2301 
2302  integer :: fid, vid
2303  integer :: nsteps
2304 
2305  intrinsic :: size
2306  !---------------------------------------------------------------------------
2307 
2308  log_info("FILE_CARTESC_write_4D",'(1x,2A)') 'Write to file (4D), name : ', trim(varname)
2309 
2310  call file_cartesc_create( basename, title, datatype, & ! [IN]
2311  fid, & ! [OUT]
2312  date=tsince, & ! [IN]
2313  append=append, aggregate=aggregate ) ! [IN]
2314 
2315  if ( present(timetarg) ) then
2316  nsteps = 1
2317  else
2318  nsteps = size(var,3)
2319  endif
2320  call file_cartesc_def_var( fid, varname, desc, unit, dim_type, datatype, & ! [IN]
2321  vid, & ! [OUT]
2322  standard_name=standard_name, & ! [IN]
2323  cell_measures=cell_measures, & ! [IN]
2324  timeintv=timeintv, nsteps=nsteps ) ! [IN]
2325 
2326  call file_cartesc_enddef( fid )
2327 
2328  call file_cartesc_write_var_4d( fid, vid, var, varname, dim_type, timeintv, &
2329  timetarg, timeofs, fill_halo )
2330 
2331  return
2332  end subroutine file_cartesc_write_4d
2333 
2334  !-----------------------------------------------------------------------------
2336  subroutine file_cartesc_put_globalattributes( &
2337  fid, &
2338  prc_rank_x, prc_rank_y, &
2339  prc_num_x, prc_num_y, &
2340  prc_periodic_x, prc_periodic_y, &
2341  kmax, okmax, lkmax, ukmax, &
2342  imaxg, jmaxg, &
2343  khalo, ihalo, jhalo, &
2344  time, tunits, calendar )
2347  use scale_file, only: &
2348  file_opened, &
2349  file_allnodes, &
2350  file_set_attribute
2351 
2352  integer, intent(in) :: fid
2353  integer, intent(in) :: prc_rank_x, prc_rank_y
2354  integer, intent(in) :: prc_num_x, prc_num_y
2355  logical, intent(in) :: prc_periodic_x, prc_periodic_y
2356  integer, intent(in) :: kmax, okmax, lkmax, ukmax
2357  integer, intent(in) :: imaxg, jmaxg
2358  integer, intent(in) :: khalo, ihalo, jhalo
2359  real(dp), intent(in) :: time
2360  character(len=*), intent(in) :: tunits
2361  character(len=*), intent(in) :: calendar
2362  !---------------------------------------------------------------------------
2363 
2364  if ( .not. file_opened(fid) ) return
2365 
2366  if ( .not. prof ) call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
2367 
2368  call file_set_attribute( fid, "global", "Conventions", "CF-1.6" ) ! [IN]
2369 
2370  call file_set_attribute( fid, "global", "grid_name", atmos_grid_cartesc_name ) ! [IN]
2371 
2372  call file_set_attribute( fid, "global", "scale_cartesC_prc_rank_x", (/prc_rank_x/) ) ! [IN]
2373  call file_set_attribute( fid, "global", "scale_cartesC_prc_rank_y", (/prc_rank_y/) ) ! [IN]
2374 
2375  call file_set_attribute( fid, "global", "scale_cartesC_prc_num_x", (/prc_num_x/) ) ! [IN]
2376  call file_set_attribute( fid, "global", "scale_cartesC_prc_num_y", (/prc_num_y/) ) ! [IN]
2377 
2378  call file_set_attribute( fid, "global", "scale_cartesC_prc_periodic_z", .false. ) ! [IN]
2379  call file_set_attribute( fid, "global", "scale_cartesC_prc_periodic_x", prc_periodic_x ) ! [IN]
2380  call file_set_attribute( fid, "global", "scale_cartesC_prc_periodic_y", prc_periodic_y ) ! [IN]
2381 
2382  call file_set_attribute( fid, "global", "scale_atmos_grid_cartesC_index_imaxg", (/imaxg/) ) ! [IN]
2383  call file_set_attribute( fid, "global", "scale_atmos_grid_cartesC_index_jmaxg", (/jmaxg/) ) ! [IN]
2384 
2385  call file_set_attribute( fid, "global", "scale_atmos_grid_cartesC_index_kmax", (/kmax/) ) ! [IN]
2386  if ( okmax > 0 ) call file_set_attribute( fid, "global", "scale_ocean_grid_cartesC_index_kmax", (/okmax/) ) ! [IN]
2387  if ( lkmax > 0 ) call file_set_attribute( fid, "global", "scale_land_grid_cartesC_index_kmax", (/lkmax/) ) ! [IN]
2388  if ( ukmax > 0 ) call file_set_attribute( fid, "global", "scale_urban_grid_cartesC_index_kmax", (/ukmax/) ) ! [IN]
2389 
2390  call file_set_attribute( fid, "global", "scale_atmos_grid_cartesC_index_khalo", (/khalo/) ) ! [IN]
2391  call file_set_attribute( fid, "global", "scale_atmos_grid_cartesC_index_ihalo", (/ihalo/) ) ! [IN]
2392  call file_set_attribute( fid, "global", "scale_atmos_grid_cartesC_index_jhalo", (/jhalo/) ) ! [IN]
2393 
2394  if ( calendar /= "" ) call file_set_attribute( fid, "global", "calendar", calendar )
2395  call file_set_attribute( fid, "global", "time_units", tunits )
2396  call file_set_attribute( fid, "global", "time_start", (/time/) )
2397 
2398  if ( .not. prof ) call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
2399 
2400  return
2401  end subroutine file_cartesc_put_globalattributes
2402 
2403  !-----------------------------------------------------------------------------
2405  subroutine file_cartesc_def_axes( &
2406  fid, &
2407  dtype, &
2408  hasZ )
2409  use scale_file, only: &
2410  file_opened, &
2412  file_def_axis, &
2413  file_set_attribute, &
2416  use scale_const, only: &
2417  undef => const_undef
2418  use scale_mapprojection, only: &
2420  implicit none
2421 
2422  integer, intent(in) :: fid
2423  integer, intent(in) :: dtype
2424  logical, intent(in) :: hasZ
2425 
2426  integer :: iall ! grid size, x-axis, (whole domain or local tile), including halo
2427  integer :: jall ! grid size, y-axis, (whole domain or local tile), including halo
2428  integer :: isize ! grid size, x-axis, (whole domain or local tile), without halo except domain edge
2429  integer :: jsize ! grid size, y-axis, (whole domain or local tile), without halo except domain edge
2430 
2431  character(len=2) :: axisname(3)
2432 
2433  logical, save :: set_dim = .false.
2434  !---------------------------------------------------------------------------
2435 
2436  if ( .not. file_opened(fid) ) return
2437 
2438  if ( .not. set_dim ) then
2440  set_dim = .true.
2441  end if
2442 
2443  if ( file_get_aggregate(fid) ) then
2444  iall = iag
2445  jall = jag
2446  isize = iag
2447  jsize = jag
2448  else
2449  iall = ia
2450  jall = ja
2451  isize = imaxb
2452  jsize = jmaxb
2453  endif
2454 
2455  if ( hasz ) then
2456  call file_def_axis( fid, 'z' , 'Z' , 'm', 'z' , dtype, kmax, bounds=.true. )
2457  call file_def_axis( fid, 'zh' , 'Z (half level)' , 'm', 'zh' , dtype, kmax+1, bounds=.true. )
2458 
2459  if ( okmax > 0 ) then
2460  call file_def_axis( fid, 'oz' , 'OZ' , 'm', 'oz' , dtype, okmax, bounds=.true. )
2461  call file_def_axis( fid, 'ozh', 'OZ (half level)', 'm', 'ozh', dtype, okmax+1, bounds=.true. )
2462  end if
2463 
2464  if ( lkmax > 0 ) then
2465  call file_def_axis( fid, 'lz' , 'LZ' , 'm', 'lz' , dtype, lkmax, bounds=.true. )
2466  call file_def_axis( fid, 'lzh', 'LZ (half level)', 'm', 'lzh', dtype, lkmax+1, bounds=.true. )
2467  end if
2468 
2469  if ( ukmax > 0 ) then
2470  call file_def_axis( fid, 'uz' , 'UZ' , 'm', 'uz' , dtype, ukmax, bounds=.true. )
2471  call file_def_axis( fid, 'uzh', 'UZ (half level)', 'm', 'uzh', dtype, ukmax+1, bounds=.true. )
2472  end if
2473  end if
2474 
2475  call file_def_axis( fid, 'x' , 'X' , 'm', 'x' , dtype, isize, bounds=.true. )
2476  call file_def_axis( fid, 'xh' , 'X (half level)' , 'm', 'xh' , dtype, isize, bounds=.true. )
2477  call file_def_axis( fid, 'y' , 'Y' , 'm', 'y' , dtype, jsize, bounds=.true. )
2478  call file_def_axis( fid, 'yh' , 'Y (half level)' , 'm', 'yh' , dtype, jsize, bounds=.true. )
2479 
2480  if ( hasz ) then
2481  call file_def_axis( fid, 'CZ' , 'Atmos Grid Center Position Z', 'm', 'CZ', dtype, ka )
2482  call file_def_axis( fid, 'FZ' , 'Atmos Grid Face Position Z', 'm', 'FZ', dtype, ka+1 )
2483  call file_def_axis( fid, 'CDZ' , 'Grid Cell length Z', 'm', 'CZ', dtype, ka )
2484  call file_def_axis( fid, 'FDZ' , 'Grid distance Z', 'm', 'FDZ', dtype, ka-1 )
2485  call file_def_axis( fid, 'CBFZ' , 'Boundary factor Center Z', '1', 'CZ', dtype, ka )
2486  call file_def_axis( fid, 'FBFZ' , 'Boundary factor Face Z', '1', 'FZ', dtype, ka+1 )
2487 
2488  if ( okmax > 0 ) then
2489  call file_def_axis( fid, 'OCZ' , 'Ocean Grid Center Position Z', 'm', 'OCZ', dtype, okmax )
2490  call file_def_axis( fid, 'OFZ' , 'Ocean Grid Face Position Z', 'm', 'OFZ', dtype, okmax+1 )
2491  call file_def_axis( fid, 'OCDZ' , 'Ocean Grid Cell length Z', 'm', 'OCZ', dtype, okmax )
2492  end if
2493 
2494  if ( lkmax > 0 ) then
2495  call file_def_axis( fid, 'LCZ' , 'Land Grid Center Position Z', 'm', 'LCZ', dtype, lkmax )
2496  call file_def_axis( fid, 'LFZ' , 'Land Grid Face Position Z', 'm', 'LFZ', dtype, lkmax+1 )
2497  call file_def_axis( fid, 'LCDZ' , 'Land Grid Cell length Z', 'm', 'LCZ', dtype, lkmax )
2498  end if
2499 
2500  if ( ukmax > 0 ) then
2501  call file_def_axis( fid, 'UCZ' , 'Urban Grid Center Position Z', 'm', 'UCZ', dtype, ukmax )
2502  call file_def_axis( fid, 'UFZ' , 'Urban Grid Face Position Z', 'm', 'UFZ', dtype, ukmax+1 )
2503  call file_def_axis( fid, 'UCDZ' , 'Urban Grid Cell length Z', 'm', 'UCZ', dtype, ukmax )
2504  end if
2505  end if
2506 
2507  call file_def_axis( fid, 'CX' , 'Atmos Grid Center Position X', 'm', 'CX', dtype, iall )
2508  call file_def_axis( fid, 'CY' , 'Atmos Grid Center Position Y', 'm', 'CY', dtype, jall )
2509  call file_def_axis( fid, 'FX' , 'Atmos Grid Face Position X', 'm', 'FX', dtype, iall+1 )
2510  call file_def_axis( fid, 'FY' , 'Atmos Grid Face Position Y', 'm', 'FY', dtype, jall+1 )
2511  call file_def_axis( fid, 'CDX' , 'Grid Cell length X', 'm', 'CX', dtype, iall )
2512  call file_def_axis( fid, 'CDY' , 'Grid Cell length Y', 'm', 'CY', dtype, jall )
2513  call file_def_axis( fid, 'FDX' , 'Grid distance X', 'm', 'FX', dtype, iall+1 )
2514  call file_def_axis( fid, 'FDY' , 'Grid distance Y', 'm', 'FY', dtype, jall+1 )
2515  call file_def_axis( fid, 'CBFX' , 'Boundary factor Center X', '1', 'CX', dtype, iall )
2516  call file_def_axis( fid, 'CBFY' , 'Boundary factor Center Y', '1', 'CY', dtype, jall )
2517  call file_def_axis( fid, 'FBFX' , 'Boundary factor Face X', '1', 'FX', dtype, iall+1 )
2518  call file_def_axis( fid, 'FBFY' , 'Boundary factor Face Y', '1', 'FY', dtype, jall+1 )
2519 
2520  call file_def_axis( fid, 'CXG' , 'Grid Center Position X (global)', 'm', 'CXG', dtype, iag )
2521  call file_def_axis( fid, 'CYG' , 'Grid Center Position Y (global)', 'm', 'CYG', dtype, jag )
2522  call file_def_axis( fid, 'FXG' , 'Grid Face Position X (global)', 'm', 'FXG', dtype, iag+1 )
2523  call file_def_axis( fid, 'FYG' , 'Grid Face Position Y (global)', 'm', 'FYG', dtype, jag+1 )
2524  call file_def_axis( fid, 'CDXG' , 'Grid Cell length X (global)', 'm', 'CXG', dtype, iag )
2525  call file_def_axis( fid, 'CDYG' , 'Grid Cell length Y (global)', 'm', 'CYG', dtype, jag )
2526  call file_def_axis( fid, 'FDXG' , 'Grid distance X (global)', 'm', 'FXG', dtype, iag+1 )
2527  call file_def_axis( fid, 'FDYG' , 'Grid distance Y (global)', 'm', 'FYG', dtype, jag+1 )
2528  call file_def_axis( fid, 'CBFXG', 'Boundary factor Center X (global)', '1', 'CXG', dtype, iag )
2529  call file_def_axis( fid, 'CBFYG', 'Boundary factor Center Y (global)', '1', 'CYG', dtype, jag )
2530  call file_def_axis( fid, 'FBFXG', 'Boundary factor Face X (global)', '1', 'FXG', dtype, iag+1 )
2531  call file_def_axis( fid, 'FBFYG', 'Boundary factor Face Y (global)', '1', 'FYG', dtype, jag+1 )
2532 
2533  ! associate coordinates
2534  axisname(1:2) = (/'x ','y '/)
2535  call file_def_associatedcoordinate( fid, 'lon' , 'longitude', 'degrees_east' , axisname(1:2), dtype )
2536  axisname(1:2) = (/'xh','y '/)
2537  call file_def_associatedcoordinate( fid, 'lon_uy', 'longitude (half level uy)', 'degrees_east' , axisname(1:2), dtype )
2538  axisname(1:2) = (/'x ','yh'/)
2539  call file_def_associatedcoordinate( fid, 'lon_xv', 'longitude (half level xv)', 'degrees_east' , axisname(1:2), dtype )
2540  axisname(1:2) = (/'xh','yh'/)
2541  call file_def_associatedcoordinate( fid, 'lon_uv', 'longitude (half level uv)', 'degrees_east' , axisname(1:2), dtype )
2542  axisname(1:2) = (/'x ','y '/)
2543  call file_def_associatedcoordinate( fid, 'lat' , 'latitude', 'degrees_north', axisname(1:2), dtype )
2544  axisname(1:2) = (/'xh','y '/)
2545  call file_def_associatedcoordinate( fid, 'lat_uy', 'latitude (half level uy)', 'degrees_north', axisname(1:2), dtype )
2546  axisname(1:2) = (/'x ','yh'/)
2547  call file_def_associatedcoordinate( fid, 'lat_xv', 'latitude (half level xv)', 'degrees_north', axisname(1:2), dtype )
2548  axisname(1:2) = (/'xh','yh'/)
2549  call file_def_associatedcoordinate( fid, 'lat_uv', 'latitude (half level uv)', 'degrees_north', axisname(1:2), dtype )
2550 
2551  if ( hasz ) then
2552  axisname(1:2) = (/'x ','y '/)
2553  call file_def_associatedcoordinate( fid, 'topo' , 'topography', 'm', axisname(1:2), dtype )
2554  end if
2555  axisname(1:2) = (/'x ','y '/)
2556  call file_def_associatedcoordinate( fid, 'lsmask', 'fraction for land-sea mask', '1', axisname(1:2), dtype )
2557 
2558  axisname(1:2) = (/'x ','y '/)
2559  call file_def_associatedcoordinate( fid, 'cell_area', 'area of grid cell', 'm2', axisname(1:2), dtype )
2560  axisname(1:2) = (/'xh','y '/)
2561  call file_def_associatedcoordinate( fid, 'cell_area_uy', 'area of grid cell (half level uy)', 'm2', axisname(1:2), dtype )
2562  axisname(1:2) = (/'x ','yh'/)
2563  call file_def_associatedcoordinate( fid, 'cell_area_xv', 'area of grid cell (half level xv)', 'm2', axisname(1:2), dtype )
2564  axisname(1:2) = (/'xh','yh'/)
2565 
2566  if ( hasz ) then
2567  axisname = (/'z ', 'x ', 'y '/)
2568  call file_def_associatedcoordinate( fid, 'height', 'height above sea level', &
2569  'm', axisname(1:3), dtype )
2570  axisname = (/'zh', 'x ', 'y '/)
2571  call file_def_associatedcoordinate( fid, 'height_wxy', 'height above sea level (half level wxy)', &
2572  'm', axisname(1:3), dtype )
2573 
2574  axisname = (/'z ', 'xh', 'y '/)
2575  call file_def_associatedcoordinate( fid, 'cell_area_zuy_x', 'area of grid cell face (half level zuy, normal x)', &
2576  'm2', axisname(1:3), dtype )
2577  axisname = (/'z ', 'x ', 'yh'/)
2578  call file_def_associatedcoordinate( fid, 'cell_area_zxv_y', 'area of grid cell face (half level zxv, normal y)', &
2579  'm2', axisname(1:3), dtype )
2580  axisname = (/'zh', 'xh', 'y '/)
2581  call file_def_associatedcoordinate( fid, 'cell_area_wuy_x', 'area of grid cell face (half level wuy, normal x)', &
2582  'm2', axisname(1:3), dtype )
2583  axisname = (/'zh', 'x ', 'yh'/)
2584  call file_def_associatedcoordinate( fid, 'cell_area_wxv_y', 'area of grid cell face (half level wxv, normal y)', &
2585  'm2', axisname(1:3), dtype )
2586  axisname = (/'z ', 'x ', 'y '/)
2587  call file_def_associatedcoordinate( fid, 'cell_area_zxy_x', 'area of grid cell face (half level zxy, normal x)', &
2588  'm2', axisname(1:3), dtype )
2589  axisname = (/'z ', 'xh', 'yh'/)
2590  call file_def_associatedcoordinate( fid, 'cell_area_zuv_y', 'area of grid cell face (half level zuv, normal y)', &
2591  'm2', axisname(1:3), dtype )
2592  axisname = (/'z ', 'xh', 'yh'/)
2593  call file_def_associatedcoordinate( fid, 'cell_area_zuv_x', 'area of grid cell face (half level zuv, normal x)', &
2594  'm2', axisname(1:3), dtype )
2595  axisname = (/'z ', 'x ', 'y '/)
2596  call file_def_associatedcoordinate( fid, 'cell_area_zxy_y', 'area of grid cell face (half level zxy, normal y)', &
2597  'm2', axisname(1:3), dtype )
2598 
2599  axisname = (/'z ', 'x ', 'y '/)
2600  call file_def_associatedcoordinate( fid, 'cell_volume', 'volume of grid cell', &
2601  'm3', axisname(1:3), dtype )
2602  axisname = (/'zh', 'x ', 'y '/)
2603  call file_def_associatedcoordinate( fid, 'cell_volume_wxy', 'volume of grid cell (half level wxy)', &
2604  'm3', axisname(1:3), dtype )
2605  axisname = (/'z ', 'xh', 'y '/)
2606  call file_def_associatedcoordinate( fid, 'cell_volume_zuy', 'volume of grid cell (half level zuy)', &
2607  'm3', axisname(1:3), dtype )
2608  axisname = (/'z ', 'x ', 'yh'/)
2609  call file_def_associatedcoordinate( fid, 'cell_volume_zxv', 'volume of grid cell (half level zxv)', &
2610  'm3', axisname(1:3), dtype )
2611 
2612  if ( okmax > 0 ) then
2613  axisname = (/'oz', 'x ', 'y '/)
2614  call file_def_associatedcoordinate( fid, 'cell_volume_oxy', 'volume of grid cell', &
2615  'm3', axisname(1:3), dtype )
2616  end if
2617  if ( lkmax > 0 ) then
2618  axisname = (/'lz', 'x ', 'y '/)
2619  call file_def_associatedcoordinate( fid, 'cell_volume_lxy', 'volume of grid cell', &
2620  'm3', axisname(1:3), dtype )
2621  end if
2622  if ( ukmax > 0 ) then
2623  axisname = (/'uz', 'x ', 'y '/)
2624  call file_def_associatedcoordinate( fid, 'cell_volume_uxy', 'volume of grid cell', &
2625  'm3', axisname(1:3), dtype )
2626  end if
2627  endif
2628 
2629  ! attributes
2630 
2631  if ( hasz ) then
2632  if ( okmax > 0 ) then
2633  call file_set_attribute( fid, 'oz' , 'positive', 'down' )
2634  call file_set_attribute( fid, 'ozh', 'positive', 'down' )
2635  end if
2636  if ( lkmax > 0 ) then
2637  call file_set_attribute( fid, 'lz' , 'positive', 'down' )
2638  call file_set_attribute( fid, 'lzh', 'positive', 'down' )
2639  end if
2640  if ( ukmax > 0 ) then
2641  call file_set_attribute( fid, 'uz' , 'positive', 'down' )
2642  call file_set_attribute( fid, 'uzh', 'positive', 'down' )
2643  end if
2644  if ( okmax > 0 ) then
2645  call file_set_attribute( fid, 'OCZ', 'positive', 'down' )
2646  call file_set_attribute( fid, 'OFZ', 'positive', 'down' )
2647  end if
2648  if ( lkmax > 0 ) then
2649  call file_set_attribute( fid, 'LCZ', 'positive', 'down' )
2650  call file_set_attribute( fid, 'LFZ', 'positive', 'down' )
2651  end if
2652  if ( ukmax > 0 ) then
2653  call file_set_attribute( fid, 'UCZ', 'positive', 'down' )
2654  call file_set_attribute( fid, 'UFZ', 'positive', 'down' )
2655  end if
2656  endif
2657 
2658  if ( file_get_aggregate(fid) ) then
2659  call file_set_attribute( fid, "x" , "size_global" , (/ iag /) )
2660  call file_set_attribute( fid, "x" , "start_global", (/ 1 /) )
2661  call file_set_attribute( fid, "x" , "halo_global" , (/ ihalo, ihalo /) )
2662  call file_set_attribute( fid, "x" , "halo_local" , (/ ihalo, ihalo /) )
2663 
2664  call file_set_attribute( fid, "xh", "size_global" , (/ iag+1 /) )
2665  call file_set_attribute( fid, "xh", "start_global", (/ 1 /) )
2666  call file_set_attribute( fid, "xh", "halo_global" , (/ ihalo, ihalo /) )
2667  call file_set_attribute( fid, "xh", "halo_local" , (/ ihalo, ihalo /) )
2668 
2669  call file_set_attribute( fid, "y" , "size_global" , (/ jag /) )
2670  call file_set_attribute( fid, "y" , "start_global", (/ 1 /) )
2671  call file_set_attribute( fid, "y" , "halo_global" , (/ jhalo, jhalo /) )
2672  call file_set_attribute( fid, "y" , "halo_local" , (/ jhalo, jhalo /) )
2673 
2674  call file_set_attribute( fid, "yh", "size_global" , (/ jag+1 /) )
2675  call file_set_attribute( fid, "yh", "start_global", (/ 1 /) )
2676  call file_set_attribute( fid, "yh", "halo_global" , (/ jhalo, jhalo /) )
2677  call file_set_attribute( fid, "yh", "halo_local" , (/ jhalo, jhalo /) )
2678  else
2679  call file_set_attribute( fid, "x" , "size_global" , file_cartesc_axis_info(1)%size_global (:) )
2680  call file_set_attribute( fid, "x" , "start_global", file_cartesc_axis_info(1)%start_global(:) )
2681  call file_set_attribute( fid, "x" , "halo_global" , file_cartesc_axis_info(1)%halo_global (:) )
2682  call file_set_attribute( fid, "x" , "halo_local" , file_cartesc_axis_info(1)%halo_local (:) )
2683 
2684  call file_set_attribute( fid, "xh", "size_global" , file_cartesc_axis_info(2)%size_global (:) )
2685  call file_set_attribute( fid, "xh", "start_global", file_cartesc_axis_info(2)%start_global(:) )
2686  call file_set_attribute( fid, "xh", "halo_global" , file_cartesc_axis_info(2)%halo_global (:) )
2687  call file_set_attribute( fid, "xh", "halo_local" , file_cartesc_axis_info(2)%halo_local (:) )
2688 
2689  call file_set_attribute( fid, "y" , "size_global" , file_cartesc_axis_info(3)%size_global (:) )
2690  call file_set_attribute( fid, "y" , "start_global", file_cartesc_axis_info(3)%start_global(:) )
2691  call file_set_attribute( fid, "y" , "halo_global" , file_cartesc_axis_info(3)%halo_global (:) )
2692  call file_set_attribute( fid, "y" , "halo_local" , file_cartesc_axis_info(3)%halo_local (:) )
2693 
2694  call file_set_attribute( fid, "yh", "size_global" , file_cartesc_axis_info(4)%size_global (:) )
2695  call file_set_attribute( fid, "yh", "start_global", file_cartesc_axis_info(4)%start_global(:) )
2696  call file_set_attribute( fid, "yh", "halo_global" , file_cartesc_axis_info(4)%halo_global (:) )
2697  call file_set_attribute( fid, "yh", "halo_local" , file_cartesc_axis_info(4)%halo_local (:) )
2698  end if
2699 
2700  call file_set_attribute( fid, "x" , "periodic" , file_cartesc_axis_info(1)%periodic )
2701  call file_set_attribute( fid, "xh", "periodic" , file_cartesc_axis_info(2)%periodic )
2702  call file_set_attribute( fid, "y" , "periodic" , file_cartesc_axis_info(3)%periodic )
2703  call file_set_attribute( fid, "yh", "periodic" , file_cartesc_axis_info(4)%periodic )
2704 
2705  ! map projection info
2706 
2707  if ( mapprojection_mappinginfo%mapping_name /= "" ) then
2708  call file_set_attribute( fid, "x" , "standard_name", "projection_x_coordinate" )
2709  call file_set_attribute( fid, "xh", "standard_name", "projection_x_coordinate" )
2710  call file_set_attribute( fid, "y" , "standard_name", "projection_y_coordinate" )
2711  call file_set_attribute( fid, "yh", "standard_name", "projection_y_coordinate" )
2712 
2713  call file_add_associatedvariable( fid, mapprojection_mappinginfo%mapping_name )
2714  call file_set_attribute( fid, mapprojection_mappinginfo%mapping_name, "grid_mapping_name", mapprojection_mappinginfo%mapping_name )
2715 
2716  if ( mapprojection_mappinginfo%false_easting /= undef ) then
2717  call file_set_attribute( fid, & ! [IN]
2718  mapprojection_mappinginfo%mapping_name, & ! [IN]
2719  "false_easting", & ! [IN]
2720  mapprojection_mappinginfo%false_easting ) ! [IN]
2721  endif
2722 
2723  if ( mapprojection_mappinginfo%false_northing /= undef ) then
2724  call file_set_attribute( fid, & ! [IN]
2725  mapprojection_mappinginfo%mapping_name, & ! [IN]
2726  "false_northing", & ! [IN]
2727  mapprojection_mappinginfo%false_northing ) ! [IN]
2728  endif
2729 
2730  if ( mapprojection_mappinginfo%longitude_of_central_meridian /= undef ) then
2731  call file_set_attribute( fid, & ! [IN]
2732  mapprojection_mappinginfo%mapping_name, & ! [IN]
2733  "longitude_of_central_meridian", & ! [IN]
2734  mapprojection_mappinginfo%longitude_of_central_meridian ) ! [IN]
2735  endif
2736 
2737  if ( mapprojection_mappinginfo%longitude_of_projection_origin /= undef ) then
2738  call file_set_attribute( fid, & ! [IN]
2739  mapprojection_mappinginfo%mapping_name, & ! [IN]
2740  "longitude_of_projection_origin", & ! [IN]
2741  mapprojection_mappinginfo%longitude_of_projection_origin ) ! [IN]
2742  endif
2743 
2744  if ( mapprojection_mappinginfo%latitude_of_projection_origin /= undef ) then
2745  call file_set_attribute( fid, & ! [IN]
2746  mapprojection_mappinginfo%mapping_name, & ! [IN]
2747  "latitude_of_projection_origin", & ! [IN]
2748  mapprojection_mappinginfo%latitude_of_projection_origin ) ! [IN]
2749  endif
2750 
2751  if ( mapprojection_mappinginfo%straight_vertical_longitude_from_pole /= undef ) then
2752  call file_set_attribute( fid, & ! [IN]
2753  mapprojection_mappinginfo%mapping_name, & ! [IN]
2754  "straight_vertical_longitude_from_pole", & ! [IN]
2755  mapprojection_mappinginfo%straight_vertical_longitude_from_pole ) ! [IN]
2756  endif
2757 
2758  if ( mapprojection_mappinginfo%standard_parallel(1) /= undef ) then
2759  if ( mapprojection_mappinginfo%standard_parallel(2) /= undef ) then
2760  call file_set_attribute( fid, & ! [IN]
2761  mapprojection_mappinginfo%mapping_name, & ! [IN]
2762  "standard_parallel", & ! [IN]
2763  mapprojection_mappinginfo%standard_parallel(:) ) ! [IN]
2764  else
2765  call file_set_attribute( fid, & ! [IN]
2766  mapprojection_mappinginfo%mapping_name, & ! [IN]
2767  "standard_parallel", & ! [IN]
2768  mapprojection_mappinginfo%standard_parallel(1) ) ! [IN]
2769  endif
2770  endif
2771 
2772  if ( mapprojection_mappinginfo%rotation /= undef ) then
2773  call file_set_attribute( fid, & ! [IN]
2774  mapprojection_mappinginfo%mapping_name, & ! [IN]
2775  "rotation", & ! [IN]
2776  mapprojection_mappinginfo%rotation ) ! [IN]
2777  endif
2778 
2779  endif
2780 
2781  ! cell measures
2782 
2783  call file_set_attribute( fid, "cell_area", "standard_name", "area" ) ! [IN]
2784  call file_set_attribute( fid, "cell_area_uy", "standard_name", "area" ) ! [IN]
2785  call file_set_attribute( fid, "cell_area_xv", "standard_name", "area" ) ! [IN]
2786 
2787  if ( hasz ) then
2788  call file_set_attribute( fid, "cell_area_zuy_x", "standard_name", "area" ) ! [IN]
2789  call file_set_attribute( fid, "cell_area_zxv_y", "standard_name", "area" ) ! [IN]
2790  call file_set_attribute( fid, "cell_area_wuy_x", "standard_name", "area" ) ! [IN]
2791  call file_set_attribute( fid, "cell_area_wxv_y", "standard_name", "area" ) ! [IN]
2792  call file_set_attribute( fid, "cell_area_zxy_x", "standard_name", "area" ) ! [IN]
2793  call file_set_attribute( fid, "cell_area_zuv_y", "standard_name", "area" ) ! [IN]
2794  call file_set_attribute( fid, "cell_area_zuv_x", "standard_name", "area" ) ! [IN]
2795  call file_set_attribute( fid, "cell_area_zxy_y", "standard_name", "area" ) ! [IN]
2796 
2797  call file_set_attribute( fid, "cell_volume", "standard_name", "volume" ) ! [IN]
2798  call file_set_attribute( fid, "cell_volume_wxy", "standard_name", "volume" ) ! [IN]
2799  call file_set_attribute( fid, "cell_volume_zuy", "standard_name", "volume" ) ! [IN]
2800  call file_set_attribute( fid, "cell_volume_zxv", "standard_name", "volume" ) ! [IN]
2801 
2802  if ( okmax > 0 ) then
2803  call file_set_attribute( fid, "cell_volume_oxy", "standard_name", "volume" ) ! [IN]
2804  end if
2805  if ( lkmax > 0 ) then
2806  call file_set_attribute( fid, "cell_volume_lxy", "standard_name", "volume" ) ! [IN]
2807  end if
2808  if ( ukmax > 0 ) then
2809  call file_set_attribute( fid, "cell_volume_uxy", "standard_name", "volume" ) ! [IN]
2810  end if
2811  end if
2812 
2813  ! SGRID
2814  call file_add_associatedvariable( fid, "grid" )
2815  call file_set_attribute( fid, "grid", "cf_role", "grid_topology" )
2816  call file_set_attribute( fid, "grid", "topology_dimension", (/ 2 /) )
2817  call file_set_attribute( fid, "grid", "node_dimensions", "xh yh" )
2818  call file_set_attribute( fid, "grid", "face_dimensions", "x: xh (padding: none) y: yh (padding: none)" )
2819  call file_set_attribute( fid, "grid", "node_coordinates", "lon_uv lat_uv" )
2820  call file_set_attribute( fid, "grid", "face_coordinates", "lon lat" )
2821  call file_set_attribute( fid, "grid", "edge1_coordinates", "lon_uy lat_uy" )
2822  call file_set_attribute( fid, "grid", "edge2_coordinates", "lon_xv lat_xv" )
2823  call file_set_attribute( fid, "grid", "vertical_dimensions", "z: zh (padding: none)" )
2824 
2825  if ( okmax > 0 ) then
2826  call file_add_associatedvariable( fid, "grid_ocean" )
2827  call file_set_attribute( fid, "grid_ocean", "cf_role", "grid_topology" )
2828  call file_set_attribute( fid, "grid_ocean", "topology_dimension", (/ 2 /) )
2829  call file_set_attribute( fid, "grid_ocean", "node_dimensions", "xh yh" )
2830  call file_set_attribute( fid, "grid_ocean", "face_dimensions", "x: xh (padding: none) y: yh (padding: none)" )
2831  call file_set_attribute( fid, "grid_ocean", "node_coordinates", "lon_uv lat_uv" )
2832  call file_set_attribute( fid, "grid_ocean", "face_coordinates", "lon lat" )
2833  call file_set_attribute( fid, "grid_ocean", "edge1_coordinates", "lon_uy lat_uy" )
2834  call file_set_attribute( fid, "grid_ocean", "edge2_coordinates", "lon_xv lat_xv" )
2835  call file_set_attribute( fid, "grid_ocean", "vertical_dimensions", "oz: ozh (padding: none)" )
2836  end if
2837 
2838  if ( lkmax > 0 ) then
2839  call file_add_associatedvariable( fid, "grid_land" )
2840  call file_set_attribute( fid, "grid_land", "cf_role", "grid_topology" )
2841  call file_set_attribute( fid, "grid_land", "topology_dimension", (/ 2 /) )
2842  call file_set_attribute( fid, "grid_land", "node_dimensions", "xh yh" )
2843  call file_set_attribute( fid, "grid_land", "face_dimensions", "x: xh (padding: none) y: yh (padding: none)" )
2844  call file_set_attribute( fid, "grid_land", "node_coordinates", "lon_uv lat_uv" )
2845  call file_set_attribute( fid, "grid_land", "face_coordinates", "lon lat" )
2846  call file_set_attribute( fid, "grid_land", "edge1_coordinates", "lon_uy lat_uy" )
2847  call file_set_attribute( fid, "grid_land", "edge2_coordinates", "lon_xv lat_xv" )
2848  call file_set_attribute( fid, "grid_land", "vertical_dimensions", "lz: lzh (padding: none)" )
2849  end if
2850 
2851  if ( ukmax > 0 ) then
2852  call file_add_associatedvariable( fid, "grid_urban" )
2853  call file_set_attribute( fid, "grid_urban", "cf_role", "grid_topology" )
2854  call file_set_attribute( fid, "grid_urban", "topology_dimension", (/ 2 /) )
2855  call file_set_attribute( fid, "grid_urban", "node_dimensions", "xh yh" )
2856  call file_set_attribute( fid, "grid_urban", "face_dimensions", "x: xh (padding: none) y: yh (padding: none)" )
2857  call file_set_attribute( fid, "grid_urban", "node_coordinates", "lon_uv lat_uv" )
2858  call file_set_attribute( fid, "grid_urban", "face_coordinates", "lon lat" )
2859  call file_set_attribute( fid, "grid_urban", "edge1_coordinates", "lon_uy lat_uy" )
2860  call file_set_attribute( fid, "grid_urban", "edge2_coordinates", "lon_xv lat_xv" )
2861  call file_set_attribute( fid, "grid_urban", "vertical_dimensions", "uz: uzh (padding: none)" )
2862  end if
2863 
2864  call file_add_associatedvariable( fid, "grid_model" )
2865  call file_set_attribute( fid, "grid_model", "cf_role", "grid_topology" )
2866  call file_set_attribute( fid, "grid_model", "topology_dimension", (/ 2 /) )
2867  call file_set_attribute( fid, "grid_model", "node_dimensions", "FX FY" )
2868  call file_set_attribute( fid, "grid_model", "face_dimensions", "CX: FY (padding: none) CY: FY (padding: none)" )
2869  call file_set_attribute( fid, "grid_model", "vertical_dimensions", "CZ: FZ (padding: none)" )
2870 
2871  call file_add_associatedvariable( fid, "grid_model_global" )
2872  call file_set_attribute( fid, "grid_model_global", "cf_role", "grid_topology" )
2873  call file_set_attribute( fid, "grid_model_global", "topology_dimension", (/ 2 /) )
2874  call file_set_attribute( fid, "grid_model_global", "node_dimensions", "FXG FYG" )
2875  call file_set_attribute( fid, "grid_model_global", "face_dimensions", "CXG: FYG (padding: none) CYG: FYG (padding: none)" )
2876  call file_set_attribute( fid, "grid_model_global", "vertical_dimensions", "CZ: FZ (padding: none)" )
2877 
2878  return
2879  end subroutine file_cartesc_def_axes
2880 
2881  !-----------------------------------------------------------------------------
2883  subroutine file_cartesc_write_axes( &
2884  fid, &
2885  haszcoord, &
2886  start )
2887  use scale_const, only: &
2888  undef => const_undef
2889  use scale_file, only: &
2890  file_opened, &
2892  file_write_axis, &
2893  file_write_associatedcoordinate
2894  use scale_prc, only: &
2895  prc_myrank, &
2896  prc_ismaster
2897  use scale_prc_cartesc, only: &
2898  prc_2drank
2899  use scale_atmos_grid_cartesc, only: &
2930  use scale_ocean_grid_cartesc, only: &
2934  use scale_land_grid_cartesc, only: &
2938  use scale_urban_grid_cartesc, only: &
2942  implicit none
2943 
2944  integer, intent(in) :: fid
2945  logical, intent(in) :: haszcoord
2946  integer, intent(in) :: start(3)
2947 
2948  logical :: put_z, put_x, put_y
2949  integer :: XSB, XEB, YSB, YEB
2950 
2951  real(RP) :: z_bnds(2,KA), zh_bnds(2,0:KA)
2952  real(RP) :: oz_bnds(2,OKA), ozh_bnds(2,0:OKA)
2953  real(RP) :: lz_bnds(2,LKA), lzh_bnds(2,0:LKA)
2954  real(RP) :: uz_bnds(2,UKA), uzh_bnds(2,0:UKA)
2955  real(RP) :: x_bnds(2,IA), xh_bnds(2,0:IA)
2956  real(RP) :: y_bnds(2,JA), yh_bnds(2,0:JA)
2957  integer :: start_(2)
2958 
2959  real(RP) :: FDXG(0:IAG), FDYG(0:JAG)
2960  real(RP) :: FDX(0:IA), FDY(0:JA)
2961 
2962  integer :: k, i, j
2963  !---------------------------------------------------------------------------
2964 
2965  if ( .not. file_opened(fid) ) return
2966 
2967  if ( file_get_aggregate(fid) ) then
2968  ! For parallel I/O, not all variables are written by all processes.
2969  ! 1. Let PRC_myrank 0 writes all z axes
2970  ! 2. Let processes (rankidx(2) == 0) write x axes (south-most processes)
2971  ! rankidx(1) == 0 writes west HALO
2972  ! rankidx(1) == PRC_NUM_X-1 writes east HALO
2973  ! others writes without HALO
2974  ! 3. Let processes (rankidx(1) == 0) write y axes (west-most processes)
2975  ! rankidx(1) == 0 writes south HALO
2976  ! rankidx(1) == PRC_NUM_Y-1 writes north HALO
2977  ! others writes without HALO
2978 
2979  put_z = ( prc_ismaster ) ! only master process output the vertical coordinates
2980  put_x = ( prc_2drank(prc_myrank,2) == 0 ) ! only south-most row processes write x coordinates
2981  put_y = ( prc_2drank(prc_myrank,1) == 0 ) ! only west-most column processes write y coordinates
2982  else
2983  put_z = .true.
2984  put_x = .true.
2985  put_y = .true.
2986  end if
2987 
2988  if ( haszcoord .and. put_z ) then
2989  start_(1) = 1
2990  start_(2) = start(1)
2991 
2992  ! atmos
2993  call file_write_axis( fid, 'z', atmos_grid_cartesc_cz(ks:ke), start(1:1) )
2994  do k = ks, ke
2995  z_bnds(1,k) = atmos_grid_cartesc_fz(k-1)
2996  z_bnds(2,k) = atmos_grid_cartesc_fz(k )
2997  end do
2998  call file_write_associatedcoordinate( fid, 'z_bnds', z_bnds(:,ks:ke), start_(:) )
2999 
3000  call file_write_axis( fid, 'zh', atmos_grid_cartesc_fz(ks-1:ke) , start(1:1) )
3001  do k = ks-1, ke
3002  zh_bnds(1,k) = atmos_grid_cartesc_cz(k )
3003  zh_bnds(2,k) = atmos_grid_cartesc_cz(k+1)
3004  end do
3005  call file_write_associatedcoordinate( fid, 'zh_bnds', zh_bnds(:,ks-1:ke), start_(:) )
3006 
3007  ! ocean
3008  if ( okmax > 0 ) then
3009  call file_write_axis( fid, 'oz', ocean_grid_cartesc_cz(oks:oke), start(1:1) )
3010  do k = oks, oke
3011  oz_bnds(1,k) = ocean_grid_cartesc_fz(k-1)
3012  oz_bnds(2,k) = ocean_grid_cartesc_fz(k )
3013  end do
3014  call file_write_associatedcoordinate( fid, 'oz_bnds', oz_bnds(:,oks:oke), start_(:) )
3015 
3016  call file_write_axis( fid, 'ozh', ocean_grid_cartesc_fz(oks-1:oke), start(1:1) )
3017  ozh_bnds(1,oks-1) = ocean_grid_cartesc_fz(oks-1)
3018  do k = oks-1, oke-1
3019  ozh_bnds(2,k ) = ocean_grid_cartesc_cz(k+1)
3020  ozh_bnds(1,k+1) = ocean_grid_cartesc_cz(k+1)
3021  end do
3022  ozh_bnds(2,oke) = ocean_grid_cartesc_fz(oke)
3023  call file_write_associatedcoordinate( fid, 'ozh_bnds', ozh_bnds(:,oks-1:oke), start_(:) )
3024  end if
3025 
3026  ! land
3027  if ( lkmax > 0 ) then
3028  call file_write_axis( fid, 'lz', land_grid_cartesc_cz(lks:lke), start(1:1) )
3029  do k = lks, lke
3030  lz_bnds(1,k) = land_grid_cartesc_fz(k-1)
3031  lz_bnds(2,k) = land_grid_cartesc_fz(k )
3032  end do
3033  call file_write_associatedcoordinate( fid, 'lz_bnds', lz_bnds(:,lks:lke), start_(:) )
3034 
3035  call file_write_axis( fid, 'lzh', land_grid_cartesc_fz(lks-1:lke), start(1:1) )
3036  lzh_bnds(1,lks-1) = land_grid_cartesc_fz(lks-1)
3037  do k = lks-1, lke-1
3038  lzh_bnds(2,k ) = land_grid_cartesc_cz(k+1)
3039  lzh_bnds(1,k+1) = land_grid_cartesc_cz(k+1)
3040  end do
3041  lzh_bnds(2,lke) = land_grid_cartesc_fz(lke)
3042  call file_write_associatedcoordinate( fid, 'lzh_bnds', lzh_bnds(:,lks-1:lke), start_(:) )
3043  end if
3044 
3045  ! urban
3046  if ( ukmax > 0 ) then
3047  call file_write_axis( fid, 'uz', urban_grid_cartesc_cz(uks:uke), start(1:1) )
3048  do k = uks, uke
3049  uz_bnds(1,k) = urban_grid_cartesc_fz(k-1)
3050  uz_bnds(2,k) = urban_grid_cartesc_fz(k )
3051  end do
3052  call file_write_associatedcoordinate( fid, 'uz_bnds', uz_bnds(:,uks:uke), start_(:) )
3053 
3054  call file_write_axis( fid, 'uzh', urban_grid_cartesc_fz(uks-1:uke), start(1:1) )
3055  uzh_bnds(1,uks-1) = urban_grid_cartesc_fz(uks-1)
3056  do k = uks-1, uke-1
3057  uzh_bnds(2,k ) = urban_grid_cartesc_cz(k+1)
3058  uzh_bnds(1,k+1) = urban_grid_cartesc_cz(k+1)
3059  end do
3060  uzh_bnds(2,uke) = urban_grid_cartesc_fz(uke)
3061  call file_write_associatedcoordinate( fid, 'uzh_bnds', uzh_bnds(:,uks-1:uke), start_(:) )
3062  end if
3063  end if
3064 
3065  if ( put_x ) then
3066  start_(1) = 1
3067  start_(2) = start(2)
3068 
3069  if ( file_get_aggregate(fid) ) then
3070  call file_write_axis( fid, 'x' , atmos_grid_cartesc_cx(isb2:ieb2), start(2:2) )
3071  do i = isb2, ieb2
3072  x_bnds(1,i) = atmos_grid_cartesc_fx(i-1)
3073  x_bnds(2,i) = atmos_grid_cartesc_fx(i )
3074  end do
3075  call file_write_associatedcoordinate( fid, 'x_bnds', x_bnds(:,isb2:ieb2), start_(:) )
3076 
3077  call file_write_axis( fid, 'xh', atmos_grid_cartesc_fx(isb2:ieb2), start(2:2) )
3078  do i = isb2, ieb2-1
3079  xh_bnds(1,i) = atmos_grid_cartesc_cx(i )
3080  xh_bnds(2,i) = atmos_grid_cartesc_cx(i+1)
3081  end do
3082  xh_bnds(1,ieb2) = atmos_grid_cartesc_cx(ieb2)
3083  if ( ieb2 == ia ) then
3084  xh_bnds(2,ieb2) = atmos_grid_cartesc_fx(ieb2)
3085  else
3086  xh_bnds(2,ieb2) = atmos_grid_cartesc_cx(ieb2+1)
3087  end if
3088  call file_write_associatedcoordinate( fid, 'xh_bnds', xh_bnds(:,isb2:ieb2), start_(:) )
3089  else
3090  call file_write_axis( fid, 'x' , atmos_grid_cartesc_cx(isb:ieb), start(2:2) )
3091  do i = isb2, ieb
3092  x_bnds(1,i) = atmos_grid_cartesc_fx(i-1)
3093  x_bnds(2,i) = atmos_grid_cartesc_fx(i )
3094  end do
3095  call file_write_associatedcoordinate( fid, 'x_bnds', x_bnds(:,isb:ieb), start_(:) )
3096 
3097  call file_write_axis( fid, 'xh', atmos_grid_cartesc_fx(isb:ieb), start(2:2) )
3098  do i = isb, ieb-1
3099  xh_bnds(1,i) = atmos_grid_cartesc_cx(i )
3100  xh_bnds(2,i) = atmos_grid_cartesc_cx(i+1)
3101  end do
3102  xh_bnds(1,ieb) = atmos_grid_cartesc_cx(ieb)
3103  if ( ieb == ia ) then
3104  xh_bnds(2,ieb) = atmos_grid_cartesc_fx(ieb)
3105  else
3106  xh_bnds(2,ieb) = atmos_grid_cartesc_cx(ieb+1)
3107  end if
3108  call file_write_associatedcoordinate( fid, 'xh_bnds', xh_bnds(:,isb:ieb), start_(:) )
3109  end if
3110  end if
3111 
3112  if ( put_y ) then
3113  start_(1) = 1
3114  start_(2) = start(3)
3115 
3116  if ( file_get_aggregate(fid) ) then
3117  call file_write_axis( fid, 'y' , atmos_grid_cartesc_cy(jsb2:jeb2), start(3:3) )
3118  do j = jsb2, jeb2
3119  y_bnds(1,j) = atmos_grid_cartesc_fy(j-1)
3120  y_bnds(2,j) = atmos_grid_cartesc_fy(j )
3121  end do
3122  call file_write_associatedcoordinate( fid, 'y_bnds', y_bnds(:,jsb2:jeb2), start_(:) )
3123 
3124  call file_write_axis( fid, 'yh', atmos_grid_cartesc_fy(jsb2:jeb2), start(3:3) )
3125  do j = jsb2, jeb2-1
3126  yh_bnds(1,j) = atmos_grid_cartesc_cy(j )
3127  yh_bnds(2,j) = atmos_grid_cartesc_cy(j+1)
3128  end do
3129  yh_bnds(1,jeb2) = atmos_grid_cartesc_cy(jeb2)
3130  if ( jeb2 == ja ) then
3131  yh_bnds(2,jeb2) = atmos_grid_cartesc_fy(jeb2)
3132  else
3133  yh_bnds(2,jeb2) = atmos_grid_cartesc_cy(jeb2+1)
3134  end if
3135  call file_write_associatedcoordinate( fid, 'yh_bnds', yh_bnds(:,jsb2:jeb2), start_(:) )
3136  else
3137  call file_write_axis( fid, 'y' , atmos_grid_cartesc_cy(jsb:jeb), start(3:3) )
3138  do j = jsb, jeb
3139  y_bnds(1,j) = atmos_grid_cartesc_fy(j-1)
3140  y_bnds(2,j) = atmos_grid_cartesc_fy(j )
3141  end do
3142  call file_write_associatedcoordinate( fid, 'y_bnds', y_bnds(:,jsb:jeb), start_(:) )
3143 
3144  call file_write_axis( fid, 'yh', atmos_grid_cartesc_fy(jsb:jeb), start(3:3) )
3145  do j = jsb, jeb-1
3146  yh_bnds(1,j) = atmos_grid_cartesc_cy(j )
3147  yh_bnds(2,j) = atmos_grid_cartesc_cy(j+1)
3148  end do
3149  yh_bnds(1,jeb) = atmos_grid_cartesc_cy(jeb2)
3150  if ( jeb == ja ) then
3151  yh_bnds(2,jeb) = atmos_grid_cartesc_fy(jeb)
3152  else
3153  yh_bnds(2,jeb) = atmos_grid_cartesc_cy(jeb+1)
3154  end if
3155  call file_write_associatedcoordinate( fid, 'yh_bnds', yh_bnds(:,jsb:jeb), start_(:) )
3156  end if
3157  end if
3158 
3159  fdxg(1:iag-1) = atmos_grid_cartesc_fdxg(:)
3160  fdxg(0 ) = undef
3161  fdxg(iag) = undef
3162  fdyg(1:jag-1) = atmos_grid_cartesc_fdyg(:)
3163  fdyg(0 ) = undef
3164  fdyg(jag) = undef
3165 
3166  fdx(1:ia-1) = atmos_grid_cartesc_fdx(:)
3167  fdx(0 ) = fdxg(is_ing-ihalo-1)
3168  fdx(ia) = fdxg(ie_ing+ihalo )
3169  fdy(1:ja-1) = atmos_grid_cartesc_fdy(:)
3170  fdy(0 ) = fdyg(js_ing-jhalo-1)
3171  fdy(ja) = fdyg(je_ing+jhalo )
3172 
3173  ! global coordinates (always including halo)
3174  if ( haszcoord .and. put_z ) then
3175  call file_write_axis( fid, 'CZ' , atmos_grid_cartesc_cz(:), start(1:1) )
3176  call file_write_axis( fid, 'FZ' , atmos_grid_cartesc_fz(:), start(1:1) )
3177  call file_write_axis( fid, 'CDZ' , atmos_grid_cartesc_cdz(:), start(1:1) )
3178  call file_write_axis( fid, 'FDZ' , atmos_grid_cartesc_fdz(:), start(1:1) )
3179  call file_write_axis( fid, 'CBFZ', atmos_grid_cartesc_cbfz(:), start(1:1) )
3180  call file_write_axis( fid, 'FBFZ', atmos_grid_cartesc_fbfz(:), start(1:1) )
3181 
3182  if ( okmax > 0 ) then
3183  call file_write_axis( fid, 'OCZ' , ocean_grid_cartesc_cz(:), start(1:1) )
3184  call file_write_axis( fid, 'OFZ' , ocean_grid_cartesc_fz(:), start(1:1) )
3185  call file_write_axis( fid, 'OCDZ', ocean_grid_cartesc_cdz(:), start(1:1) )
3186  end if
3187 
3188  if ( lkmax > 0 ) then
3189  call file_write_axis( fid, 'LCZ' , land_grid_cartesc_cz(:), start(1:1) )
3190  call file_write_axis( fid, 'LFZ' , land_grid_cartesc_fz(:), start(1:1) )
3191  call file_write_axis( fid, 'LCDZ', land_grid_cartesc_cdz(:), start(1:1) )
3192  end if
3193 
3194  if ( ukmax > 0 ) then
3195  call file_write_axis( fid, 'UCZ' , urban_grid_cartesc_cz(:), start(1:1) )
3196  call file_write_axis( fid, 'UFZ' , urban_grid_cartesc_fz(:), start(1:1) )
3197  call file_write_axis( fid, 'UCDZ', urban_grid_cartesc_cdz(:), start(1:1) )
3198  end if
3199  end if
3200 
3201  if ( file_get_aggregate(fid) ) then
3202  if ( prc_ismaster ) then
3203  call file_write_axis( fid, 'CX', atmos_grid_cartesc_cxg(:) )
3204  call file_write_axis( fid, 'CY', atmos_grid_cartesc_cyg(:) )
3205  call file_write_axis( fid, 'FX', atmos_grid_cartesc_fxg(:) )
3206  call file_write_axis( fid, 'FY', atmos_grid_cartesc_fyg(:) )
3207  call file_write_axis( fid, 'CDX', atmos_grid_cartesc_cdxg(:) )
3208  call file_write_axis( fid, 'CDY', atmos_grid_cartesc_cdyg(:) )
3209 
3210  call file_write_axis( fid, 'FDX', fdxg(:) )
3211  call file_write_axis( fid, 'FDY', fdyg(:) )
3212  call file_write_axis( fid, 'CBFX', atmos_grid_cartesc_cbfxg(:) )
3213  call file_write_axis( fid, 'CBFY', atmos_grid_cartesc_cbfyg(:) )
3214  call file_write_axis( fid, 'FBFX', atmos_grid_cartesc_fbfxg(:) )
3215  call file_write_axis( fid, 'FBFY', atmos_grid_cartesc_fbfyg(:) )
3216  endif
3217  else
3218  call file_write_axis( fid, 'CX', atmos_grid_cartesc_cx(:) )
3219  call file_write_axis( fid, 'CY', atmos_grid_cartesc_cy(:) )
3220  call file_write_axis( fid, 'FX', atmos_grid_cartesc_fx(:) )
3221  call file_write_axis( fid, 'FY', atmos_grid_cartesc_fy(:) )
3222  call file_write_axis( fid, 'CDX', atmos_grid_cartesc_cdx(:) )
3223  call file_write_axis( fid, 'CDY', atmos_grid_cartesc_cdy(:) )
3224  call file_write_axis( fid, 'FDX', fdx(:) )
3225  call file_write_axis( fid, 'FDY', fdy(:) )
3226  call file_write_axis( fid, 'CBFX', atmos_grid_cartesc_cbfx(:) )
3227  call file_write_axis( fid, 'CBFY', atmos_grid_cartesc_cbfy(:) )
3228  call file_write_axis( fid, 'FBFX', atmos_grid_cartesc_fbfx(:) )
3229  call file_write_axis( fid, 'FBFY', atmos_grid_cartesc_fbfy(:) )
3230  endif
3231 
3232  call file_write_axis( fid, 'CXG', atmos_grid_cartesc_cxg(:) )
3233  call file_write_axis( fid, 'CYG', atmos_grid_cartesc_cyg(:) )
3234  call file_write_axis( fid, 'FXG', atmos_grid_cartesc_fxg(:) )
3235  call file_write_axis( fid, 'FYG', atmos_grid_cartesc_fyg(:) )
3236  call file_write_axis( fid, 'CDXG', atmos_grid_cartesc_cdxg(:) )
3237  call file_write_axis( fid, 'CDYG', atmos_grid_cartesc_cdyg(:) )
3238  call file_write_axis( fid, 'FDXG', fdxg(:) )
3239  call file_write_axis( fid, 'FDYG', fdyg(:) )
3240  call file_write_axis( fid, 'CBFXG', atmos_grid_cartesc_cbfxg(:) )
3241  call file_write_axis( fid, 'CBFYG', atmos_grid_cartesc_cbfyg(:) )
3242  call file_write_axis( fid, 'FBFXG', atmos_grid_cartesc_fbfxg(:) )
3243  call file_write_axis( fid, 'FBFYG', atmos_grid_cartesc_fbfyg(:) )
3244 
3245  ! associate coordinates
3246  if ( file_get_aggregate(fid) ) then
3247  call file_write_associatedcoordinate( fid, 'lon' , axis_lon(:,:), start(2:3) )
3248  call file_write_associatedcoordinate( fid, 'lon_uy', axis_lonuy(:,:), start(2:3) )
3249  call file_write_associatedcoordinate( fid, 'lon_xv', axis_lonxv(:,:), start(2:3) )
3250  call file_write_associatedcoordinate( fid, 'lon_uv', axis_lonuv(:,:), start(2:3) )
3251  call file_write_associatedcoordinate( fid, 'lat' , axis_lat(:,:), start(2:3) )
3252  call file_write_associatedcoordinate( fid, 'lat_uy', axis_latuy(:,:), start(2:3) )
3253  call file_write_associatedcoordinate( fid, 'lat_xv', axis_latxv(:,:), start(2:3) )
3254  call file_write_associatedcoordinate( fid, 'lat_uv', axis_latuv(:,:), start(2:3) )
3255 
3256  if ( haszcoord ) then
3257  call file_write_associatedcoordinate( fid, 'topo', axis_topo(:,:), start(2:3) )
3258  end if
3259  call file_write_associatedcoordinate( fid, 'lsmask', axis_lsmask(:,:), start(2:3) )
3260 
3261  call file_write_associatedcoordinate( fid, 'cell_area', axis_area(:,:), start(2:3) )
3262  call file_write_associatedcoordinate( fid, 'cell_area_uy', axis_areauy(:,:), start(2:3) )
3263  call file_write_associatedcoordinate( fid, 'cell_area_xv', axis_areaxv(:,:), start(2:3) )
3264 
3265  if ( haszcoord ) then
3266  call file_write_associatedcoordinate( fid, 'height' , axis_hgt(:,:,:), start(1:3) )
3267  call file_write_associatedcoordinate( fid, 'height_wxy', axis_hgtwxy(:,:,:), start(1:3) )
3268 
3269  call file_write_associatedcoordinate( fid, 'cell_area_zuy_x', axis_areazuy_x(:,:,:), start(1:3) )
3270  call file_write_associatedcoordinate( fid, 'cell_area_zxv_y', axis_areazxv_y(:,:,:), start(1:3) )
3271  call file_write_associatedcoordinate( fid, 'cell_area_wuy_x', axis_areawuy_x(:,:,:), start(1:3) )
3272  call file_write_associatedcoordinate( fid, 'cell_area_wxv_y', axis_areawxv_y(:,:,:), start(1:3) )
3273  call file_write_associatedcoordinate( fid, 'cell_area_zxy_x', axis_areazxy_x(:,:,:), start(1:3) )
3274  call file_write_associatedcoordinate( fid, 'cell_area_zuv_y', axis_areazuv_y(:,:,:), start(1:3) )
3275  call file_write_associatedcoordinate( fid, 'cell_area_zuv_x', axis_areazuv_x(:,:,:), start(1:3) )
3276  call file_write_associatedcoordinate( fid, 'cell_area_zxy_y', axis_areazxy_y(:,:,:), start(1:3) )
3277 
3278  call file_write_associatedcoordinate( fid, 'cell_volume', axis_vol(:,:,:), start(1:3) )
3279  call file_write_associatedcoordinate( fid, 'cell_volume_wxy', axis_volwxy(:,:,:), start(1:3) )
3280  call file_write_associatedcoordinate( fid, 'cell_volume_zuy', axis_volzuy(:,:,:), start(1:3) )
3281  call file_write_associatedcoordinate( fid, 'cell_volume_zxv', axis_volzxv(:,:,:), start(1:3) )
3282 
3283  if ( okmax > 0 ) then
3284  call file_write_associatedcoordinate( fid, 'cell_volume_oxy', axis_volo(:,:,:), start(1:3) )
3285  end if
3286  if ( lkmax > 0 ) then
3287  call file_write_associatedcoordinate( fid, 'cell_volume_lxy', axis_voll(:,:,:), start(1:3) )
3288  end if
3289  if ( ukmax > 0 ) then
3290  call file_write_associatedcoordinate( fid, 'cell_volume_uxy', axis_volu(:,:,:), start(1:3) )
3291  end if
3292  end if
3293  else
3294  xsb = isb - isb2 + 1
3295  xeb = ieb - isb + xsb
3296  ysb = jsb - jsb2 + 1
3297  yeb = jeb - jsb + ysb
3298 
3299  call file_write_associatedcoordinate( fid, 'lon' , axis_lon(xsb:xeb,ysb:yeb), start(2:3) )
3300  call file_write_associatedcoordinate( fid, 'lon_uy', axis_lonuy(xsb:xeb,ysb:yeb), start(2:3) )
3301  call file_write_associatedcoordinate( fid, 'lon_xv', axis_lonxv(xsb:xeb,ysb:yeb), start(2:3) )
3302  call file_write_associatedcoordinate( fid, 'lon_uv', axis_lonuv(xsb:xeb,ysb:yeb), start(2:3) )
3303  call file_write_associatedcoordinate( fid, 'lat' , axis_lat(xsb:xeb,ysb:yeb), start(2:3) )
3304  call file_write_associatedcoordinate( fid, 'lat_uy', axis_latuy(xsb:xeb,ysb:yeb), start(2:3) )
3305  call file_write_associatedcoordinate( fid, 'lat_xv', axis_latxv(xsb:xeb,ysb:yeb), start(2:3) )
3306  call file_write_associatedcoordinate( fid, 'lat_uv', axis_latuv(xsb:xeb,ysb:yeb), start(2:3) )
3307 
3308  if ( haszcoord ) then
3309  call file_write_associatedcoordinate( fid, 'topo', axis_topo(xsb:xeb,ysb:yeb), start(2:3) )
3310  end if
3311  call file_write_associatedcoordinate( fid, 'lsmask', axis_lsmask(xsb:xeb,ysb:yeb), start(2:3) )
3312 
3313  call file_write_associatedcoordinate( fid, 'cell_area', axis_area(xsb:xeb,ysb:yeb), start(2:3) )
3314  call file_write_associatedcoordinate( fid, 'cell_area_uy', axis_areauy(xsb:xeb,ysb:yeb), start(2:3) )
3315  call file_write_associatedcoordinate( fid, 'cell_area_xv', axis_areaxv(xsb:xeb,ysb:yeb), start(2:3) )
3316 
3317  if ( haszcoord ) then
3318  call file_write_associatedcoordinate( fid, 'height' , axis_hgt(:,xsb:xeb,ysb:yeb), start(1:3) )
3319  call file_write_associatedcoordinate( fid, 'height_wxy', axis_hgtwxy(:,xsb:xeb,ysb:yeb), start(1:3) )
3320 
3321  call file_write_associatedcoordinate( fid, 'cell_area_zuy_x', axis_areazuy_x(:,xsb:xeb,ysb:yeb), start(1:3) )
3322  call file_write_associatedcoordinate( fid, 'cell_area_zxv_y', axis_areazxv_y(:,xsb:xeb,ysb:yeb), start(1:3) )
3323  call file_write_associatedcoordinate( fid, 'cell_area_wuy_x', axis_areawuy_x(:,xsb:xeb,ysb:yeb), start(1:3) )
3324  call file_write_associatedcoordinate( fid, 'cell_area_wxv_y', axis_areawxv_y(:,xsb:xeb,ysb:yeb), start(1:3) )
3325  call file_write_associatedcoordinate( fid, 'cell_area_zxy_x', axis_areazxy_x(:,xsb:xeb,ysb:yeb), start(1:3) )
3326  call file_write_associatedcoordinate( fid, 'cell_area_zuv_y', axis_areazuv_y(:,xsb:xeb,ysb:yeb), start(1:3) )
3327  call file_write_associatedcoordinate( fid, 'cell_area_zuv_x', axis_areazuv_x(:,xsb:xeb,ysb:yeb), start(1:3) )
3328  call file_write_associatedcoordinate( fid, 'cell_area_zxy_y', axis_areazxy_y(:,xsb:xeb,ysb:yeb), start(1:3) )
3329 
3330  call file_write_associatedcoordinate( fid, 'cell_volume', axis_vol(:,xsb:xeb,ysb:yeb), start(1:3) )
3331  call file_write_associatedcoordinate( fid, 'cell_volume_wxy', axis_volwxy(:,xsb:xeb,ysb:yeb), start(1:3) )
3332  call file_write_associatedcoordinate( fid, 'cell_volume_zuy', axis_volzuy(:,xsb:xeb,ysb:yeb), start(1:3) )
3333  call file_write_associatedcoordinate( fid, 'cell_volume_zxv', axis_volzxv(:,xsb:xeb,ysb:yeb), start(1:3) )
3334 
3335  if ( okmax > 0 ) then
3336  call file_write_associatedcoordinate( fid, 'cell_volume_oxy', axis_volo(:,xsb:xeb,ysb:yeb), start(1:3) )
3337  end if
3338  if ( lkmax > 0 ) then
3339  call file_write_associatedcoordinate( fid, 'cell_volume_lxy', axis_voll(:,xsb:xeb,ysb:yeb), start(1:3) )
3340  end if
3341  if ( ukmax > 0 ) then
3342  call file_write_associatedcoordinate( fid, 'cell_volume_uxy', axis_volu(:,xsb:xeb,ysb:yeb), start(1:3) )
3343  end if
3344  end if
3345  end if
3346 
3347  return
3348  end subroutine file_cartesc_write_axes
3349 
3350  !-----------------------------------------------------------------------------
3352  subroutine file_cartesc_def_var( &
3353  fid, &
3354  varname, desc, unit, &
3355  dim_type, datatype, &
3356  vid, &
3357  standard_name, &
3358  timeintv, nsteps, &
3359  cell_measures )
3360  use scale_file_h, only: &
3361  file_real8, &
3362  file_real4
3363  use scale_file, only: &
3364  file_opened, &
3365  file_allnodes, &
3367  file_set_attribute
3368  use scale_prc, only: &
3369  prc_abort
3370  use scale_prc_cartesc, only: &
3371  prc_twod
3372  use scale_mapprojection, only: &
3374  implicit none
3375 
3376  integer, intent(in) :: fid
3377  character(len=*), intent(in) :: varname
3378  character(len=*), intent(in) :: desc
3379  character(len=*), intent(in) :: unit
3380  character(len=*), intent(in) :: dim_type
3381  character(len=*), intent(in) :: datatype
3382 
3383  integer, intent(out) :: vid
3384 
3385  character(len=*), intent(in), optional :: standard_name
3386  real(dp), intent(in), optional :: timeintv
3387  integer, intent(in), optional :: nsteps
3388  character(len=*), intent(in), optional :: cell_measures
3389 
3390  character(len=H_MID) :: standard_name_
3391  character(len=H_SHORT) :: cell_measures_
3392 
3393  character(len=H_SHORT) :: dimtype
3394 
3395  integer :: dtype, elm_size, ndims
3396  integer :: dimid, n
3397  !---------------------------------------------------------------------------
3398 
3399  if ( .not. file_opened(fid) ) return
3400 
3401  call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
3402 
3403  if ( datatype == 'REAL8' ) then
3404  dtype = file_real8
3405  elm_size = 4
3406  elseif( datatype == 'REAL4' ) then
3407  dtype = file_real4
3408  elm_size = 8
3409  else
3410  if ( rp == 8 ) then
3411  dtype = file_real8
3412  elm_size = 8
3413  elseif( rp == 4 ) then
3414  dtype = file_real4
3415  elm_size = 4
3416  else
3417  log_error("FILE_CARTESC_def_var",*) 'unsupported data type. Check!', trim(datatype), ' item:',trim(varname)
3418  call prc_abort
3419  endif
3420  endif
3421 
3422  if ( prc_twod ) then
3423  select case( dim_type )
3424  case ( "UY" )
3425  dimtype = "XY"
3426  case ( "UV" )
3427  dimtype = "XV"
3428  case ( "ZXHY" )
3429  dimtype = "ZXY"
3430  case ( "ZXHYH")
3431  dimtype = "ZXYH"
3432  case ( "ZHXHY" )
3433  dimtype = "ZHXY"
3434  case default
3435  dimtype = dim_type
3436  end select
3437  else
3438  dimtype = dim_type
3439  end if
3440 
3441  dimid = -1
3442  do n = 1, file_cartesc_ndims
3443  if ( file_cartesc_dims(n)%name == dimtype ) then
3444  dimid = n
3445  exit
3446  end if
3447  end do
3448  if ( dimid <= -1 ) then
3449  log_error("FILE_CARTESC_def_var",*) 'dim_type is not supported: ', trim(dimtype)
3450  call prc_abort
3451  end if
3452 
3453  if ( present(nsteps) ) then
3454  write_buf_amount(fid) = write_buf_amount(fid) + file_cartesc_dims(dimid)%size * elm_size * nsteps
3455  else
3456  write_buf_amount(fid) = write_buf_amount(fid) + file_cartesc_dims(dimid)%size * elm_size
3457  end if
3458 
3459  ndims = file_cartesc_dims(dimid)%ndims
3460 
3461  if ( present(standard_name) ) then
3462  standard_name_ = standard_name
3463  else
3464  standard_name_ = ""
3465  end if
3466 
3467  if ( present(timeintv) ) then ! 3D/4D variable with time dimension
3468  call file_def_variable( fid, varname, desc, unit, standard_name_, & ! [IN]
3469  ndims, file_cartesc_dims(dimid)%dims(1:ndims), dtype, & ! [IN]
3470  vid, & ! [OUT]
3471  time_int=timeintv ) ! [IN]
3472  else
3473  call file_def_variable( fid, varname, desc, unit, standard_name_, & ! [IN]
3474  ndims, file_cartesc_dims(dimid)%dims(1:ndims), dtype, & ! [IN]
3475  vid ) ! [OUT]
3476  endif
3477 
3478  if ( present(cell_measures) ) then
3479  cell_measures_ = cell_measures
3480  select case ( cell_measures )
3481  case ( "area" )
3482  if ( file_cartesc_dims(dimid)%area == "" ) then
3483  log_error("FILE_CARTESC_def_var",*) 'area is not supported for ', trim(dimtype), ' as cell_measures'
3484  call prc_abort
3485  end if
3486  case ( "area_z" )
3487  if ( file_cartesc_dims(dimid)%area == "" ) then
3488  log_error("FILE_CARTESC_def_var",*) 'area_z is not supported for ', trim(dimtype), ' as cell_measures'
3489  call prc_abort
3490  end if
3491  case ( "area_x" )
3492  if ( file_cartesc_dims(dimid)%area_x == "" ) then
3493  log_error("FILE_CARTESC_def_var",*) 'area_x is not supported for ', trim(dimtype), ' as cell_measures'
3494  call prc_abort
3495  end if
3496  case ( "area_y" )
3497  if ( file_cartesc_dims(dimid)%area_y == "" ) then
3498  log_error("FILE_CARTESC_def_var",*) 'area_y is not supported for ', trim(dimtype), ' as cell_measures'
3499  call prc_abort
3500  end if
3501  case ( "volume" )
3502  if ( file_cartesc_dims(dimid)%volume == "" ) then
3503  log_error("FILE_CARTESC_def_var",*) 'volume is not supported for ', trim(dimtype), ' as cell_measures'
3504  call prc_abort
3505  end if
3506  case default
3507  log_error("FILE_CARTESC_def_var",*) 'cell_measures must be "area" or "volume"'
3508  call prc_abort
3509  end select
3510  else if ( ndims == 2 ) then
3511  cell_measures_ = "area"
3512  else if ( ndims == 3 ) then
3513  cell_measures_ = "volume"
3514  else
3515  cell_measures_ = ""
3516  end if
3517 
3518  select case( cell_measures_ )
3519  case ( "area", "area_z" )
3520  call file_set_attribute( fid, varname, "cell_measures", "area: "//trim(file_cartesc_dims(dimid)%area) )
3521  case ( "area_x" )
3522  call file_set_attribute( fid, varname, "cell_measures", "area: "//trim(file_cartesc_dims(dimid)%area_x) )
3523  case ( "area_y" )
3524  call file_set_attribute( fid, varname, "cell_measures", "area: "//trim(file_cartesc_dims(dimid)%area_y) )
3525  case ( "volume" )
3526  call file_set_attribute( fid, varname, "cell_measures", "volume: "//trim(file_cartesc_dims(dimid)%volume) )
3527  end select
3528 
3529  ! mapping
3530  if ( file_cartesc_dims(dimid)%mapping .and. mapprojection_mappinginfo%mapping_name /= "" ) then
3531  call file_set_attribute( fid, varname, "grid_mapping", mapprojection_mappinginfo%mapping_name )
3532  end if
3533 
3534  ! SGRID
3535  if ( file_cartesc_dims(dimid)%location /= "" ) then
3536  call file_set_attribute( fid, varname, "grid", file_cartesc_dims(dimid)%grid )
3537  call file_set_attribute( fid, varname, "location", file_cartesc_dims(dimid)%location )
3538  end if
3539 
3540  call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
3541 
3542  return
3543  end subroutine file_cartesc_def_var
3544 
3545  !-----------------------------------------------------------------------------
3547  subroutine file_cartesc_write_var_1d( &
3548  fid, &
3549  vid, &
3550  var, &
3551  varname, &
3552  dim_type )
3553  use scale_file, only: &
3555  file_opened, &
3556  file_allnodes, &
3557  file_write
3558  use scale_prc, only: &
3559  prc_myrank, &
3560  prc_abort
3561  use scale_prc_cartesc, only: &
3562  prc_2drank
3563  use scale_time, only: &
3564  nowdaysec => time_nowdaysec
3565  implicit none
3566 
3567  integer, intent(in) :: fid
3568  integer, intent(in) :: vid
3569  real(RP), intent(in) :: var(:)
3570  character(len=*), intent(in) :: varname
3571  character(len=*), intent(in) :: dim_type
3572 
3573  integer :: dim1_S, dim1_E
3574  integer :: rankidx(2)
3575  integer :: start(1) ! used only when AGGREGATE is .true.
3576  logical :: exec
3577  !---------------------------------------------------------------------------
3578 
3579  if ( .not. file_opened(fid) ) return
3580 
3581  call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
3582 
3583  rankidx(1) = prc_2drank(prc_myrank,1)
3584  rankidx(2) = prc_2drank(prc_myrank,2)
3585 
3586  if ( dim_type == 'Z' ) then
3587  dim1_s = ks
3588  dim1_e = ke
3589  start(1) = 1
3590  if( file_get_aggregate(fid) .AND. prc_myrank > 0 ) then
3591  exec = .false. ! only rank 0 writes
3592  else
3593  exec = .true.
3594  end if
3595  elseif( dim_type == 'X' ) then
3596  if ( file_get_aggregate(fid) ) then
3597  exec = ( rankidx(2) == 0 ) ! only south most row processes write
3598  dim1_s = isb2
3599  dim1_e = ieb2
3600  else
3601  exec = .true.
3602  dim1_s = isb
3603  dim1_e = ieb
3604  end if
3605  start(1) = isga
3606  elseif( dim_type == 'Y' ) then
3607  if ( file_get_aggregate(fid) ) then
3608  exec = ( rankidx(1) == 0 ) ! only west most column processes write
3609  dim1_s = jsb2
3610  dim1_e = jeb2
3611  else
3612  exec = .true.
3613  dim1_s = jsb
3614  dim1_e = jeb
3615  end if
3616  start(1) = jsga
3617  else
3618  log_error("FILE_CARTESC_write_var_1D",*) 'unsupported dimenstion type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
3619  call prc_abort
3620  endif
3621 
3622  if( exec ) call file_write( vid, var(dim1_s:dim1_e), & ! [IN]
3623  nowdaysec, nowdaysec, start=start ) ! [IN]
3624 
3625  call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
3626 
3627  return
3628  end subroutine file_cartesc_write_var_1d
3629 
3630  !-----------------------------------------------------------------------------
3632  subroutine file_cartesc_write_var_2d( &
3633  fid, &
3634  vid, &
3635  var, &
3636  varname, &
3637  dim_type, &
3638  fill_halo )
3639  use scale_file_h, only: &
3640  rmiss => file_rmiss
3641  use scale_file, only: &
3643  file_opened, &
3644  file_allnodes, &
3645  file_write
3646  use scale_prc, only: &
3647  prc_myrank, &
3648  prc_abort
3649  use scale_prc_cartesc, only: &
3650  prc_2drank, &
3651  prc_num_x, &
3652  prc_num_y
3653  use scale_time, only: &
3654  nowdaysec => time_nowdaysec
3655  implicit none
3656 
3657  integer, intent(in) :: fid
3658  integer, intent(in) :: vid
3659  real(RP), intent(in) :: var(:,:)
3660  character(len=*), intent(in) :: varname
3661  character(len=*), intent(in) :: dim_type
3662  logical, intent(in), optional :: fill_halo
3663 
3664  real(RP), allocatable :: buf(:,:)
3665 
3666  integer :: dim1_S, dim1_E
3667  integer :: dim2_S, dim2_E
3668 
3669  integer :: i, j
3670  logical :: fill_halo_
3671  integer :: rankidx(2)
3672  integer :: start(2) ! used only when AGGREGATE is .true.
3673  logical :: exec
3674  !---------------------------------------------------------------------------
3675 
3676  if ( .not. file_opened(fid) ) return
3677 
3678  call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
3679 
3680  rankidx(1) = prc_2drank(prc_myrank,1)
3681  rankidx(2) = prc_2drank(prc_myrank,2)
3682 
3683  start(1) = isga
3684  start(2) = jsga
3685 
3686  fill_halo_ = .false.
3687  if( present(fill_halo) ) fill_halo_ = fill_halo
3688 
3689  if ( dim_type == 'XY' &
3690  .OR. dim_type == 'UY' &
3691  .OR. dim_type == 'XV' &
3692  .OR. dim_type == 'UV' ) then
3693  if ( file_get_aggregate(fid) ) then
3694  dim1_s = isb2
3695  dim1_e = ieb2
3696  dim2_s = jsb2
3697  dim2_e = jeb2
3698  else
3699  dim1_s = isb
3700  dim1_e = ieb
3701  dim2_s = jsb
3702  dim2_e = jeb
3703  endif
3704  exec = .true.
3705  elseif( dim_type == 'ZX' ) then
3706  dim1_s = ks
3707  dim1_e = ke
3708  start(2) = start(1)
3709  start(1) = 1
3710  if ( file_get_aggregate(fid) ) then
3711  exec = ( rankidx(2) == 0 ) ! only south most row processes write
3712  dim2_s = isb2
3713  dim2_e = ieb2
3714  else
3715  exec = .true.
3716  dim2_s = isb
3717  dim2_e = ieb
3718  endif
3719  else
3720  log_error("FILE_CARTESC_write_var_2D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
3721  call prc_abort
3722  endif
3723 
3724  if ( exec ) then
3725 
3726  !$acc update host(var) if(acc_is_present(var))
3727 
3728  allocate( buf(dim1_s:dim1_e,dim2_s:dim2_e) )
3729 
3730  if ( fill_halo_ ) then ! fill halo cells with RMISS
3731  do j = js, je
3732  do i = is, ie
3733  buf(i,j) = var(i,j)
3734  end do
3735  end do
3736 
3737  ! W halo
3738  do j = dim2_s, dim2_e
3739  do i = dim1_s, is-1
3740  buf(i,j) = rmiss
3741  enddo
3742  enddo
3743  ! E halo
3744  do j = dim2_s, dim2_e
3745  do i = ie+1, dim1_e
3746  buf(i,j) = rmiss
3747  enddo
3748  enddo
3749  ! S halo
3750  do j = dim2_s, js-1
3751  do i = dim1_s, dim1_e
3752  buf(i,j) = rmiss
3753  enddo
3754  enddo
3755  ! N halo
3756  do j = je+1, dim2_e
3757  do i = dim1_s, dim1_e
3758  buf(i,j) = rmiss
3759  enddo
3760  enddo
3761  else
3762  do j = dim2_s, dim2_e
3763  do i = dim1_s, dim1_e
3764  buf(i,j) = var(i,j)
3765  end do
3766  end do
3767  end if
3768 
3769  call file_write( vid, buf(:,:), nowdaysec, nowdaysec, start ) ! [IN]
3770  call file_cartesc_flush( fid )
3771 
3772  deallocate( buf )
3773 
3774  endif
3775 
3776  call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
3777 
3778  return
3779  end subroutine file_cartesc_write_var_2d
3780 
3781  !-----------------------------------------------------------------------------
3783  subroutine file_cartesc_write_var_3d( &
3784  fid, &
3785  vid, &
3786  var, &
3787  varname, &
3788  dim_type, &
3789  fill_halo )
3790  use scale_file_h, only: &
3791  rmiss => file_rmiss
3792  use scale_file, only: &
3794  file_opened, &
3795  file_allnodes, &
3796  file_write
3797  use scale_prc, only: &
3798  prc_myrank, &
3799  prc_abort
3800  use scale_prc_cartesc, only: &
3801  prc_2drank, &
3802  prc_num_x, &
3803  prc_num_y
3804  use scale_time, only: &
3805  nowdaysec => time_nowdaysec
3806  implicit none
3807 
3808  integer, intent(in) :: fid
3809  integer, intent(in) :: vid
3810  real(RP), intent(in) :: var(:,:,:)
3811  character(len=*), intent(in) :: varname
3812  character(len=*), intent(in) :: dim_type
3813 
3814  logical, intent(in), optional :: fill_halo
3815 
3816  real(RP), allocatable :: buf(:,:,:)
3817 
3818  integer :: dim1_S, dim1_E
3819  integer :: dim2_S, dim2_E
3820  integer :: dim3_S, dim3_E
3821 
3822  integer :: i, j, k
3823  logical :: fill_halo_
3824  integer :: rankidx(2)
3825  integer :: start(3) ! used only when AGGREGATE is .true.
3826  !---------------------------------------------------------------------------
3827 
3828  if ( .not. file_opened(fid) ) return
3829 
3830  call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
3831 
3832  fill_halo_ = .false.
3833  if( present(fill_halo) ) fill_halo_ = fill_halo
3834 
3835  rankidx(1) = prc_2drank(prc_myrank,1)
3836  rankidx(2) = prc_2drank(prc_myrank,2)
3837 
3838  start(1) = 1
3839  start(2) = isga
3840  start(3) = jsga
3841 
3842  if ( dim_type == 'ZXY' &
3843  .OR. dim_type == 'ZXHY' &
3844  .OR. dim_type == 'ZXYH' &
3845  .OR. dim_type == 'ZXHYH' ) then
3846  dim1_s = ks
3847  dim1_e = ke
3848  elseif ( dim_type == 'ZHXY' &
3849  .OR. dim_type == 'ZHXHY' &
3850  .OR. dim_type == 'ZHXYH' ) then
3851  dim1_s = ks-1
3852  dim1_e = ke
3853  elseif( dim_type == 'OXY' ) then
3854  dim1_s = oks
3855  dim1_e = oke
3856  elseif( dim_type == 'LXY' ) then
3857  dim1_s = lks
3858  dim1_e = lke
3859  elseif( dim_type == 'UXY' ) then
3860  dim1_s = uks
3861  dim1_e = uke
3862  else
3863  log_error("FILE_CARTESC_write_var_3D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
3864  call prc_abort
3865  endif
3866 
3867  if ( file_get_aggregate(fid) ) then
3868  dim2_s = isb2
3869  dim2_e = ieb2
3870  dim3_s = jsb2
3871  dim3_e = jeb2
3872  else
3873  dim2_s = isb
3874  dim2_e = ieb
3875  dim3_s = jsb
3876  dim3_e = jeb
3877  endif
3878 
3879  !$acc update host(var) if(acc_is_present(var))
3880 
3881  allocate( buf(dim1_s:dim1_e,dim2_s:dim2_e,dim3_s:dim3_e) )
3882 
3883  if ( fill_halo_ ) then
3884 
3885  !$omp parallel do
3886  do j = js, je
3887  do i = is, ie
3888  do k = dim1_s, dim1_e
3889  buf(k,i,j) = var(k,i,j)
3890  enddo
3891  enddo
3892  enddo
3893 
3894  ! W halo
3895  do j = dim3_s, dim3_e
3896  do i = dim2_s, is-1
3897  do k = dim1_s, dim1_e
3898  buf(k,i,j) = rmiss
3899  enddo
3900  enddo
3901  enddo
3902  ! E halo
3903  do j = dim3_s, dim3_e
3904  do i = ie+1, dim2_e
3905  do k = dim1_s, dim1_e
3906  buf(k,i,j) = rmiss
3907  enddo
3908  enddo
3909  enddo
3910  ! S halo
3911  do j = dim3_s, js-1
3912  do i = dim2_s, dim2_e
3913  do k = dim1_s, dim1_e
3914  buf(k,i,j) = rmiss
3915  enddo
3916  enddo
3917  enddo
3918  ! N halo
3919  do j = je+1, dim3_e
3920  do i = dim2_s, dim2_e
3921  do k = dim1_s, dim1_e
3922  buf(k,i,j) = rmiss
3923  enddo
3924  enddo
3925  enddo
3926 
3927  else
3928 
3929  do j = dim3_s, dim3_e
3930  do i = dim2_s, dim2_e
3931  do k = dim1_s, dim1_e
3932  buf(k,i,j) = var(k,i,j)
3933  enddo
3934  enddo
3935  enddo
3936 
3937  end if
3938 
3939  call file_write( vid, buf(:,:,:), nowdaysec, nowdaysec, start ) ! [IN]
3940  call file_cartesc_flush( fid )
3941 
3942  deallocate( buf )
3943 
3944  call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
3945 
3946  return
3947  end subroutine file_cartesc_write_var_3d
3948 
3949  !-----------------------------------------------------------------------------
3951  subroutine file_cartesc_write_var_3d_t( &
3952  fid, &
3953  vid, &
3954  var, &
3955  varname, &
3956  dim_type, &
3957  timeintv, &
3958  timetarg, &
3959  timeofs, &
3960  fill_halo )
3961  use scale_file_h, only: &
3962  rmiss => file_rmiss
3963  use scale_file, only: &
3965  file_opened, &
3966  file_allnodes, &
3967  file_write
3968  use scale_prc, only: &
3969  prc_myrank, &
3970  prc_abort
3971  use scale_prc_cartesc, only: &
3972  prc_2drank, &
3973  prc_num_x, &
3974  prc_num_y
3975  implicit none
3976 
3977  integer, intent(in) :: fid
3978  integer, intent(in) :: vid
3979  real(RP), intent(in) :: var(:,:,:)
3980  character(len=*), intent(in) :: varname
3981  character(len=*), intent(in) :: dim_type
3982  real(DP), intent(in) :: timeintv
3983 
3984  integer, intent(in), optional :: timetarg
3985  real(DP), intent(in), optional :: timeofs
3986  logical, intent(in), optional :: fill_halo
3987 
3988  real(RP), allocatable :: buf(:,:)
3989 
3990  integer :: dim1_S, dim1_E
3991  integer :: dim2_S, dim2_E
3992 
3993  real(DP) :: time_interval, nowtime
3994 
3995  integer :: step
3996  integer :: i, j, n
3997  logical :: fill_halo_
3998  real(DP) :: timeofs_
3999  integer :: rankidx(2)
4000  integer :: start(2) ! used only when AGGREGATE is .true.
4001  !---------------------------------------------------------------------------
4002 
4003  if ( .not. file_opened(fid) ) return
4004 
4005  call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
4006 
4007  fill_halo_ = .false.
4008  if( present(fill_halo) ) fill_halo_ = fill_halo
4009 
4010  timeofs_ = 0.0_dp
4011  if( present(timeofs) ) timeofs_ = timeofs
4012 
4013  time_interval = timeintv
4014  step = size(var(isb,jsb,:))
4015 
4016  rankidx(1) = prc_2drank(prc_myrank,1)
4017  rankidx(2) = prc_2drank(prc_myrank,2)
4018 
4019  if ( dim_type == 'XYT' ) then
4020  if ( file_get_aggregate(fid) ) then
4021  dim1_s = isb2
4022  dim1_e = ieb2
4023  dim2_s = jsb2
4024  dim2_e = jeb2
4025  else
4026  dim1_s = isb
4027  dim1_e = ieb
4028  dim2_s = jsb
4029  dim2_e = jeb
4030  end if
4031  else
4032  log_error("FILE_CARTESC_write_var_3D_t",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
4033  call prc_abort
4034  endif
4035 
4036  start(1) = isga
4037  start(2) = jsga
4038  ! start(3) time dimension will be set in file_write_data()
4039 
4040  allocate( buf(dim1_s:dim1_e,dim2_s:dim2_e) )
4041 
4042  if ( present(timetarg) ) then
4043  nowtime = timeofs_ + (timetarg-1) * time_interval
4044 
4045  !$acc update host(var) if(acc_is_present(var))
4046 
4047  if ( fill_halo_ ) then
4048 
4049  do j = js, je
4050  do i = is, ie
4051  buf(i,j) = var(i,j,timetarg)
4052  end do
4053  end do
4054 
4055  ! W halo
4056  do j = dim2_s, dim2_e
4057  do i = dim1_s, is-1
4058  buf(i,j) = rmiss
4059  enddo
4060  enddo
4061  ! E halo
4062  do j = dim2_s, dim2_e
4063  do i = ie+1, dim1_e
4064  buf(i,j) = rmiss
4065  enddo
4066  enddo
4067  ! S halo
4068  do j = dim2_s, js-1
4069  do i = dim1_s, dim1_e
4070  buf(i,j) = rmiss
4071  enddo
4072  enddo
4073  ! N halo
4074  do j = je+1, dim2_e
4075  do i = dim1_s, dim1_e
4076  buf(i,j) = rmiss
4077  enddo
4078  enddo
4079 
4080  else
4081 
4082  do j = dim2_s, dim2_e
4083  do i = dim1_s, dim1_e
4084  buf(i,j) = var(i,j,timetarg)
4085  enddo
4086  enddo
4087 
4088  end if
4089 
4090  call file_write( vid, buf(:,:), nowtime, nowtime, start ) ! [IN]
4091  call file_cartesc_flush( fid )
4092 
4093  else
4094  nowtime = timeofs_
4095 
4096  !$acc update host(var) if(acc_is_present(var))
4097 
4098  do n = 1, step
4099  if ( fill_halo_ ) then
4100 
4101  do j = js, je
4102  do i = is, ie
4103  buf(i,j) = var(i,j,n)
4104  end do
4105  end do
4106 
4107  ! W halo
4108  do j = dim2_s, dim2_e
4109  do i = dim1_s, is-1
4110  buf(i,j) = rmiss
4111  enddo
4112  enddo
4113  ! E halo
4114  do j = dim2_s, dim2_e
4115  do i = ie+1, dim1_e
4116  buf(i,j) = rmiss
4117  enddo
4118  enddo
4119  ! S halo
4120  do j = dim2_s, js-1
4121  do i = dim1_s, dim1_e
4122  buf(i,j) = rmiss
4123  enddo
4124  enddo
4125  ! N halo
4126  do j = je+1, dim2_e
4127  do i = dim1_s, dim1_e
4128  buf(i,j) = rmiss
4129  enddo
4130  enddo
4131 
4132  else
4133 
4134  do j = dim2_s, dim2_e
4135  do i = dim1_s, dim1_e
4136  buf(i,j) = var(i,j,n)
4137  enddo
4138  enddo
4139 
4140  end if
4141 
4142  call file_write( vid, buf(:,:), nowtime, nowtime, start ) ! [IN]
4143  call file_cartesc_flush( fid )
4144 
4145  nowtime = nowtime + time_interval
4146  enddo
4147  endif
4148 
4149  deallocate( buf )
4150 
4151  call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
4152 
4153  return
4154  end subroutine file_cartesc_write_var_3d_t
4155 
4156  !-----------------------------------------------------------------------------
4158  subroutine file_cartesc_write_var_4d( &
4159  fid, &
4160  vid, &
4161  var, &
4162  varname, &
4163  dim_type, &
4164  timeintv, &
4165  timetarg, &
4166  timeofs, &
4167  fill_halo )
4168  use scale_file_h, only: &
4169  rmiss => file_rmiss
4170  use scale_file, only: &
4172  file_opened, &
4173  file_allnodes, &
4174  file_write
4175  use scale_prc, only: &
4176  prc_myrank, &
4177  prc_abort
4178  use scale_prc_cartesc, only: &
4179  prc_2drank, &
4180  prc_num_x, &
4181  prc_num_y
4182  implicit none
4183 
4184  integer, intent(in) :: fid
4185  integer, intent(in) :: vid
4186  real(RP), intent(in) :: var(:,:,:,:)
4187  character(len=*), intent(in) :: varname
4188  character(len=*), intent(in) :: dim_type
4189  real(DP), intent(in) :: timeintv
4190 
4191  integer, intent(in), optional :: timetarg
4192  real(DP), intent(in), optional :: timeofs
4193  logical, intent(in), optional :: fill_halo
4194 
4195  real(RP), allocatable :: buf(:,:,:)
4196 
4197  integer :: dim1_S, dim1_E
4198  integer :: dim2_S, dim2_E
4199  integer :: dim3_S, dim3_E
4200 
4201  real(DP) :: time_interval, nowtime
4202 
4203  integer :: step
4204  integer :: i, j, k, n
4205  logical :: fill_halo_
4206  real(DP) :: timeofs_
4207  integer :: rankidx(2)
4208  integer :: start(3) ! used only when AGGREGATE is .true.
4209  !---------------------------------------------------------------------------
4210 
4211  if ( .not. file_opened(fid) ) return
4212 
4213  call prof_rapstart('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
4214 
4215  fill_halo_ = .false.
4216  if( present(fill_halo) ) fill_halo_ = fill_halo
4217 
4218  timeofs_ = 0.0_dp
4219  if( present(timeofs) ) timeofs_ = timeofs
4220 
4221  rankidx(1) = prc_2drank(prc_myrank,1)
4222  rankidx(2) = prc_2drank(prc_myrank,2)
4223 
4224  start(1) = 1
4225  start(2) = isga
4226  start(3) = jsga
4227  ! start(4) time dimension will be set in file_write_data()
4228 
4229  time_interval = timeintv
4230  step = size(var,4)
4231 
4232  if ( file_get_aggregate(fid) ) then
4233  dim2_s = isb2
4234  dim2_e = ieb2
4235  dim3_s = jsb2
4236  dim3_e = jeb2
4237  else
4238  dim2_s = isb
4239  dim2_e = ieb
4240  dim3_s = jsb
4241  dim3_e = jeb
4242  endif
4243 
4244  if ( dim_type == 'ZXYT' &
4245  .OR. dim_type == 'ZXHYT' &
4246  .OR. dim_type == 'ZXYHT' ) then
4247  dim1_s = ks
4248  dim1_e = ke
4249  elseif ( dim_type == 'ZHXYT' ) then
4250  dim1_s = ks-1
4251  dim1_e = ke
4252  elseif( dim_type == 'OXYT' ) then
4253  dim1_s = oks
4254  dim1_e = oke
4255  elseif( dim_type == 'OHXYT' ) then
4256  dim1_s = oks-1
4257  dim1_e = oke
4258  elseif( dim_type == 'LXYT' ) then
4259  dim1_s = lks
4260  dim1_e = lke
4261  elseif( dim_type == 'LHXYT' ) then
4262  dim1_s = lks-1
4263  dim1_e = lke
4264  elseif( dim_type == 'UXYT' ) then
4265  dim1_s = uks
4266  dim1_e = uke
4267  elseif( dim_type == 'UHXYT' ) then
4268  dim1_s = uks-1
4269  dim1_e = uke
4270  else
4271  log_error("FILE_CARTESC_write_var_4D",*) 'unsupported dimension type. Check! dim_type:', trim(dim_type), ', item:',trim(varname)
4272  call prc_abort
4273  endif
4274 
4275  allocate( buf(dim1_s:dim1_e,dim2_s:dim2_e,dim3_s:dim3_e) )
4276 
4277  !$acc update host(var) if(acc_is_present(var))
4278 
4279  if ( present(timetarg) ) then
4280  nowtime = timeofs_ + (timetarg-1) * time_interval
4281 
4282  if ( fill_halo_ ) then
4283 
4284  do j = js, je
4285  do i = is, ie
4286  do k = dim1_s, dim1_e
4287  buf(k,i,j) = var(k,i,j,timetarg)
4288  end do
4289  end do
4290  end do
4291 
4292  ! W halo
4293  do j = dim3_s, dim3_e
4294  do i = dim2_s, is-1
4295  do k = dim1_s, dim1_e
4296  buf(k,i,j) = rmiss
4297  enddo
4298  enddo
4299  enddo
4300  ! E halo
4301  do j = dim3_s, dim3_e
4302  do i = ie+1, dim2_e
4303  do k = dim1_s, dim1_e
4304  buf(k,i,j) = rmiss
4305  enddo
4306  enddo
4307  enddo
4308  ! S halo
4309  do j = dim3_s, js-1
4310  do i = dim2_s, dim2_e
4311  do k = dim1_s, dim1_e
4312  buf(k,i,j) = rmiss
4313  enddo
4314  enddo
4315  enddo
4316  ! N halo
4317  do j = je+1, dim3_e
4318  do i = dim2_s, dim2_e
4319  do k = dim1_s, dim1_e
4320  buf(k,i,j) = rmiss
4321  enddo
4322  enddo
4323  enddo
4324 
4325  else
4326 
4327  do j = dim3_s, dim3_e
4328  do i = dim2_s, dim2_e
4329  do k = dim1_s, dim1_e
4330  buf(k,i,j) = var(k,i,j,timetarg)
4331  enddo
4332  enddo
4333  enddo
4334 
4335  end if
4336 
4337  call file_write( vid, buf(:,:,:), nowtime, nowtime, start ) ! [IN]
4338  call file_cartesc_flush( fid )
4339 
4340  else
4341  nowtime = timeofs_
4342  do n = 1, step
4343  if ( fill_halo_ ) then
4344 
4345  do j = js, je
4346  do i = is, ie
4347  do k = dim1_s, dim1_e
4348  buf(k,i,j) = var(k,i,j,n)
4349  end do
4350  end do
4351  end do
4352 
4353  ! W halo
4354  do j = dim3_s, dim3_e
4355  do i = dim2_s, is-1
4356  do k = dim1_s, dim1_e
4357  buf(k,i,j) = rmiss
4358  enddo
4359  enddo
4360  enddo
4361  ! E halo
4362  do j = dim3_s, dim3_e
4363  do i = ie+1, dim2_e
4364  do k = dim1_s, dim1_e
4365  buf(k,i,j) = rmiss
4366  enddo
4367  enddo
4368  enddo
4369  ! S halo
4370  do j = dim3_s, js-1
4371  do i = dim2_s, dim2_e
4372  do k = dim1_s, dim1_e
4373  buf(k,i,j) = rmiss
4374  enddo
4375  enddo
4376  enddo
4377  ! N halo
4378  do j = je+1, dim3_e
4379  do i = dim2_s, dim2_e
4380  do k = dim1_s, dim1_e
4381  buf(k,i,j) = rmiss
4382  enddo
4383  enddo
4384  enddo
4385 
4386  else
4387 
4388  do j = dim3_s, dim3_e
4389  do i = dim2_s, dim2_e
4390  do k = dim1_s, dim1_e
4391  buf(k,i,j) = var(k,i,j,n)
4392  enddo
4393  enddo
4394  enddo
4395 
4396  end if
4397 
4398  call file_write( vid, buf(:,:,:), nowtime, nowtime, start ) ! [IN]
4399  call file_cartesc_flush( fid )
4400 
4401  nowtime = nowtime + time_interval
4402 
4403  enddo
4404  endif
4405 
4406  deallocate( buf )
4407 
4408  call prof_rapend('FILE_Write', 2, disable_barrier = .not. file_allnodes(fid) )
4409 
4410  return
4411  end subroutine file_cartesc_write_var_4d
4412 
4413 
4414  !-----------------------------------------------------------------------------
4415 
4416  ! private procedures
4417 
4418  !-----------------------------------------------------------------------------
4419  subroutine check_1d( &
4420  expected, buffer, &
4421  name )
4422  use scale_prc, only: &
4423  prc_abort
4424  use scale_const, only: &
4425  eps => const_eps
4426  implicit none
4427 
4428  real(RP), intent(in) :: expected(:)
4429  real(RP), intent(in) :: buffer(:)
4430  character(len=*), intent(in) :: name
4431 
4432  real(RP) :: check
4433  integer :: nmax, n
4434 
4435  intrinsic :: size
4436  !---------------------------------------------------------------------------
4437 
4438  nmax = size(expected)
4439  if ( size(buffer) /= nmax ) then
4440  log_error("check_1d",*) 'size of coordinate ('//trim(name)//') is different:', nmax, size(buffer)
4441  call prc_abort
4442  endif
4443 
4444  do n=1, nmax
4445  if ( abs(expected(n)) > eps ) then
4446  check = abs(buffer(n)-expected(n)) / abs(buffer(n)+expected(n)) * 2.0_rp
4447  else
4448  check = abs(buffer(n)-expected(n))
4449  endif
4450 
4451  if ( check > file_cartesc_datacheck_criteria ) then
4452  log_error("check_1d",*) 'value of coordinate ('//trim(name)//') at ', n, ' is different:', &
4453  expected(n), buffer(n), check
4454  call prc_abort
4455  endif
4456  enddo
4457 
4458  return
4459  end subroutine check_1d
4460 
4461  !-----------------------------------------------------------------------------
4462  subroutine check_2d( &
4463  expected, buffer, &
4464  name )
4465  use scale_prc, only: &
4466  prc_abort
4467  use scale_const, only: &
4468  eps => const_eps
4469  implicit none
4470 
4471  real(RP), intent(in) :: expected(:,:)
4472  real(RP), intent(in) :: buffer(:,:)
4473  character(len=*), intent(in) :: name
4474 
4475  real(RP) :: check
4476  integer :: imax, jmax
4477  integer :: i, j
4478 
4479  intrinsic :: size
4480  !---------------------------------------------------------------------------
4481 
4482  imax = size(expected,1)
4483  jmax = size(expected,2)
4484  if ( size(buffer,1) /= imax ) then
4485  log_error("check_2d",*) 'the first size of coordinate ('//trim(name)//') is different:', imax, size(buffer,1)
4486  call prc_abort
4487  endif
4488  if ( size(buffer,2) /= jmax ) then
4489  log_error("check_2d",*) 'the second size of coordinate ('//trim(name)//') is different:', jmax, size(buffer,2)
4490  call prc_abort
4491  endif
4492 
4493  do j=1, jmax
4494  do i=1, imax
4495  if ( abs(expected(i,j)) > eps ) then
4496  check = abs(buffer(i,j)-expected(i,j)) / abs(buffer(i,j)+expected(i,j)) * 2.0_rp
4497  else
4498  check = abs(buffer(i,j)-expected(i,j))
4499  endif
4500 
4501  if ( check > file_cartesc_datacheck_criteria ) then
4502  log_error("check_2d",*) 'value of coordinate ('//trim(name)//') at (', i, ',', j, ') is different:', &
4503  expected(i,j), buffer(i,j), check
4504  call prc_abort
4505  endif
4506  enddo
4507  enddo
4508 
4509  return
4510  end subroutine check_2d
4511 
4512  !-----------------------------------------------------------------------------
4513  subroutine check_3d( &
4514  expected, buffer, &
4515  name, &
4516  transpose )
4517  use scale_prc, only: &
4518  prc_abort
4519  use scale_const, only: &
4520  eps => const_eps
4521  implicit none
4522 
4523  real(RP), intent(in) :: expected(:,:,:)
4524  real(RP), intent(in) :: buffer(:,:,:)
4525  character(len=*), intent(in) :: name
4526  logical, intent(in) :: transpose
4527 
4528  real(RP) :: check
4529  integer :: imax, jmax, kmax
4530  integer :: i, j, k
4531 
4532  intrinsic :: size
4533  !---------------------------------------------------------------------------
4534 
4535  if ( transpose ) then
4536  kmax = size(expected,3)
4537  imax = size(expected,1)
4538  jmax = size(expected,2)
4539  else
4540  kmax = size(expected,1)
4541  imax = size(expected,2)
4542  jmax = size(expected,3)
4543  endif
4544  if ( size(buffer,1) /= kmax ) then
4545  log_error("check_3d",*) 'the first size of coordinate ('//trim(name)//') is different:', kmax, size(buffer,1)
4546  call prc_abort
4547  endif
4548  if ( size(buffer,2) /= imax ) then
4549  log_error("check_3d",*) 'the second size of coordinate ('//trim(name)//') is different:', imax, size(buffer,2)
4550  call prc_abort
4551  endif
4552  if ( size(buffer,3) /= jmax ) then
4553  log_error("check_3d",*) 'the third size of coordinate ('//trim(name)//') is different:', jmax, size(buffer,3)
4554  call prc_abort
4555  endif
4556 
4557  if ( transpose ) then
4558  ! buffer(i,j,k), expected(k,i,j)
4559  do k=1, kmax
4560  do j=1, jmax
4561  do i=1, imax
4562  if ( abs(expected(k,i,j)) > eps ) then
4563  check = abs(buffer(i,j,k)-expected(k,i,j)) / abs(buffer(i,j,k)+expected(k,i,j)) * 2.0_rp
4564  else
4565  check = abs(buffer(i,j,k)-expected(k,i,j))
4566  endif
4567 
4568  if ( check > file_cartesc_datacheck_criteria ) then
4569  log_error("check_3d",*) 'value of coordinate ('//trim(name)//') at ', i, ',', j, ',', k, ' is different:', &
4570  expected(k,i,j), buffer(i,j,k), check
4571  call prc_abort
4572  endif
4573  enddo
4574  enddo
4575  enddo
4576  else
4577  do j=1, jmax
4578  do i=1, imax
4579  do k=1, kmax
4580  if ( abs(expected(k,i,j)) > eps ) then
4581  check = abs(buffer(k,i,j)-expected(k,i,j)) / abs(buffer(k,i,j)+expected(k,i,j)) * 2.0_rp
4582  else
4583  check = abs(buffer(k,i,j)-expected(k,i,j))
4584  endif
4585 
4586  if ( check > file_cartesc_datacheck_criteria ) then
4587  log_error("check_3d",*) 'value of coordinate ('//trim(name)//') at ', k, ',', i, ',', j, ' is different:', &
4588  expected(k,i,j), buffer(k,i,j), check
4589  call prc_abort
4590  endif
4591  enddo
4592  enddo
4593  enddo
4594  endif
4595 
4596  return
4597  end subroutine check_3d
4598 
4599  subroutine set_dimension_informations
4600  use scale_prc_cartesc, only: &
4601  prc_periodic_x, &
4602  prc_periodic_y, &
4603  prc_num_x, &
4604  prc_num_y, &
4605  prc_has_w, &
4606  prc_has_e, &
4607  prc_has_s, &
4608  prc_has_n
4609  implicit none
4610  !---------------------------------------------------------------------------
4611 
4612  ! Dimension Information
4613 
4614  ! 1D variable
4615  call set_dimension( 'Z', 1, 'z', ka )
4616  call set_dimension( 'X', 1, 'x', ia )
4617  call set_dimension( 'Y', 1, 'y', ja )
4618 
4619  ! 2D variable
4620  call set_dimension( 'XY', 2, (/ 'x' , 'y' /), ia*ja, .true., area='cell_area', location='face' )
4621  call set_dimension( 'UY', 2, (/ 'xh', 'y ' /), ia*ja, .true., area='cell_area_uy', location='edge1' )
4622  call set_dimension( 'XV', 2, (/ 'x ', 'yh' /), ia*ja, .true., area='cell_area_xv', location='edge2' )
4623  call set_dimension( 'UV', 2, (/ 'xh', 'yh' /), ia*ja, .true., location='node' )
4624 
4625  call set_dimension( 'ZX', 2, (/ 'z', 'x' /), ka*ia )
4626  call set_dimension( 'ZY', 2, (/ 'z', 'y' /), ka*ja )
4627 
4628  ! 3D variable
4629  call set_dimension( 'ZXY', 3, (/ 'z', 'x', 'y' /), ka*ia*ja, .true., &
4630  area='cell_area', area_x='cell_area_zxy_x', area_y='cell_area_zxy_y', &
4631  volume='cell_volume', location='face' )
4632  call set_dimension( 'ZHXY', 3, (/ 'zh', 'x ', 'y ' /), (ka+1)*ia*ja, .true., &
4633  area='cell_area', area_x='cell_area_wxy_x', area_y='cell_area_wxy_y', &
4634  volume='cell_volume_wxy', location='face' )
4635  call set_dimension( 'ZXHY', 3, (/ 'z ', 'xh', 'y ' /), ka*ia*ja, .true., &
4636  area='cell_area_uy', area_x='cell_area_zuy_x', &
4637  volume='cell_volume_zuy', location='edge1' )
4638  call set_dimension( 'ZXYH', 3, (/ 'z ', 'x ', 'yh' /), ka*ia*ja, .true., &
4639  area='cell_area_xv', area_y='cell_area_zxv_y', &
4640  volume='cell_volume_zxv', location='edge2' )
4641  call set_dimension( 'ZXHYH', 3, (/ 'z ', 'xh', 'yh' /), ka*ia*ja, .true., &
4642  area_x='cell_area_zuv_x', area_y='cell_area_zuv_y', &
4643  location='node' )
4644  call set_dimension( 'ZHXHY', 3, (/ 'zh', 'xh', 'y ' /), (ka+1)*ia*ja, .true., &
4645  area_x='cell_area_wuy_x', &
4646  location='edge1' )
4647  call set_dimension( 'ZHXYH', 3, (/ 'zh', 'x ', 'yh' /), (ka+1)*ia*ja, .true., &
4648  area_y='cell_area_wxv_y', &
4649  location='edge2' )
4650 
4651  if ( okmax > 0 ) then
4652  call set_dimension( 'OXY', 3, (/ 'oz', 'x ', 'y ' /), okmax*ia*ja, .true., area='cell_area', volume='cell_volume_oxy', location='face', grid='ocean' )
4653  call set_dimension( 'OHXY', 3, (/ 'ozh', 'x ', 'y ' /), (okmax+1)*ia*ja, .true., area='cell_area', volume='cell_volume_oxy', location='face', grid='ocean' )
4654  end if
4655  if ( lkmax > 0 ) then
4656  call set_dimension( 'LXY', 3, (/ 'lz', 'x ', 'y ' /), lkmax*ia*ja, .true., area='cell_area', volume='cell_volume_lxy', location='face', grid='land' )
4657  call set_dimension( 'LHXY', 3, (/ 'lzh', 'x ', 'y ' /), (lkmax+1)*ia*ja, .true., area='cell_area', volume='cell_volume_lxy', location='face', grid='land' )
4658  end if
4659  if ( ukmax > 0 ) then
4660  call set_dimension( 'UXY', 3, (/ 'uz', 'x ', 'y ' /), ukmax*ia*ja, .true., area='cell_area', volume='cell_volume_uxy', location='face', grid='urban' )
4661  call set_dimension( 'UHXY', 3, (/ 'uzh', 'x ', 'y ' /), (ukmax+1)*ia*ja, .true., area='cell_area', volume='cell_volume_uxy', location='face', grid='urban' )
4662  end if
4663 
4664 
4665  ! Axis information
4666 
4667  if ( prc_periodic_x ) then
4668  file_cartesc_axis_info(1)%periodic = .true.
4669  file_cartesc_axis_info(2)%periodic = .true.
4670  else
4671  file_cartesc_axis_info(1)%periodic = .false.
4672  file_cartesc_axis_info(2)%periodic = .false.
4673  endif
4674 
4675  if ( prc_periodic_y ) then
4676  file_cartesc_axis_info(3)%periodic = .true.
4677  file_cartesc_axis_info(4)%periodic = .true.
4678  else
4679  file_cartesc_axis_info(3)%periodic = .false.
4680  file_cartesc_axis_info(4)%periodic = .false.
4681  endif
4682 
4683 
4684  ! for x
4685  if ( prc_periodic_x ) then
4686  file_cartesc_axis_info(1)%size_global (1) = imax * prc_num_x
4687  file_cartesc_axis_info(1)%start_global(1) = is_ing - ihalo
4688  file_cartesc_axis_info(1)%halo_global (1) = 0 ! west side
4689  file_cartesc_axis_info(1)%halo_global (2) = 0 ! east side
4690  file_cartesc_axis_info(1)%halo_local (1) = 0 ! west side
4691  file_cartesc_axis_info(1)%halo_local (2) = 0 ! east side
4692  else
4693  file_cartesc_axis_info(1)%size_global (1) = iag
4694  file_cartesc_axis_info(1)%start_global(1) = isga
4695  file_cartesc_axis_info(1)%halo_global (1) = ihalo ! west side
4696  file_cartesc_axis_info(1)%halo_global (2) = ihalo ! east side
4697  file_cartesc_axis_info(1)%halo_local (1) = ihalo ! west side
4698  file_cartesc_axis_info(1)%halo_local (2) = ihalo ! east side
4699  if( prc_has_w ) file_cartesc_axis_info(1)%halo_local(1) = 0
4700  if( prc_has_e ) file_cartesc_axis_info(1)%halo_local(2) = 0
4701  endif
4702  ! for xh
4703  file_cartesc_axis_info(2) = file_cartesc_axis_info(1)
4704 
4705  ! for y
4706  if ( prc_periodic_y ) then
4707  file_cartesc_axis_info(3)%size_global (1) = jmax * prc_num_y
4708  file_cartesc_axis_info(3)%start_global(1) = js_ing - jhalo
4709  file_cartesc_axis_info(3)%halo_global (1) = 0 ! south side
4710  file_cartesc_axis_info(3)%halo_global (2) = 0 ! north side
4711  file_cartesc_axis_info(3)%halo_local (1) = 0 ! south side
4712  file_cartesc_axis_info(3)%halo_local (2) = 0 ! north side
4713  else
4714  file_cartesc_axis_info(3)%size_global (1) = jag
4715  file_cartesc_axis_info(3)%start_global(1) = jsga
4716  file_cartesc_axis_info(3)%halo_global (1) = jhalo ! south side
4717  file_cartesc_axis_info(3)%halo_global (2) = jhalo ! north side
4718  file_cartesc_axis_info(3)%halo_local (1) = jhalo ! south side
4719  file_cartesc_axis_info(3)%halo_local (2) = jhalo ! north side
4720  if( prc_has_s ) file_cartesc_axis_info(3)%halo_local(1) = 0
4721  if( prc_has_n ) file_cartesc_axis_info(3)%halo_local(2) = 0
4722  endif
4723  ! for yh
4724  file_cartesc_axis_info(4) = file_cartesc_axis_info(3)
4725 
4726 
4727  return
4728  end subroutine set_dimension_informations
4729 
4730  subroutine set_dimension( name, ndims, dims, size, mapping, area, area_x, area_y, volume, location, grid )
4731  use scale_prc, only: &
4732  prc_abort
4733  character(len=*), intent(in) :: name
4734  integer, intent(in) :: ndims
4735  character(len=*), intent(in) :: dims(ndims)
4736  integer, intent(in) :: size
4737  logical, intent(in), optional :: mapping
4738  character(len=*), intent(in), optional :: area
4739  character(len=*), intent(in), optional :: area_x
4740  character(len=*), intent(in), optional :: area_y
4741  character(len=*), intent(in), optional :: volume
4742  character(len=*), intent(in), optional :: location
4743  character(len=*), intent(in), optional :: grid
4744 
4745  integer, save :: dimid = 0
4746 
4747  integer :: n
4748 
4749  do n = 1, 2
4750  dimid = dimid + 1
4751  if ( dimid > file_cartesc_ndims ) then
4752  log_error("set_dimension",*) 'number of dimensions exceeds the limit', dimid, file_cartesc_ndims
4753  call prc_abort
4754  end if
4755 
4756  if ( n==1 ) then
4757  file_cartesc_dims(dimid)%name = name
4758  else
4759  file_cartesc_dims(dimid)%name = trim(name)//"T"
4760  end if
4761  file_cartesc_dims(dimid)%ndims = ndims
4762  file_cartesc_dims(dimid)%dims(1:ndims) = dims(:)
4763  file_cartesc_dims(dimid)%size = size
4764 
4765  if ( present(mapping) ) then
4766  file_cartesc_dims(dimid)%mapping = mapping
4767  else
4768  file_cartesc_dims(dimid)%mapping = .false.
4769  end if
4770 
4771  if ( present(area) ) then
4772  file_cartesc_dims(dimid)%area = area
4773  else
4774  file_cartesc_dims(dimid)%area = ''
4775  end if
4776  if ( present(area_x) ) then
4777  file_cartesc_dims(dimid)%area = area_x
4778  else
4779  file_cartesc_dims(dimid)%area = ''
4780  end if
4781  if ( present(area_y) ) then
4782  file_cartesc_dims(dimid)%area = area_y
4783  else
4784  file_cartesc_dims(dimid)%area = ''
4785  end if
4786 
4787  if ( present(volume) ) then
4788  file_cartesc_dims(dimid)%volume = volume
4789  else
4790  file_cartesc_dims(dimid)%volume = ''
4791  end if
4792 
4793  if ( present(location) ) then
4794  file_cartesc_dims(dimid)%location = location
4795  if ( present(grid) ) then
4796  file_cartesc_dims(dimid)%grid = 'grid_'//trim(grid)
4797  else
4798  file_cartesc_dims(dimid)%grid = 'grid'
4799  end if
4800  else
4801  file_cartesc_dims(dimid)%location = ''
4802  file_cartesc_dims(dimid)%grid = ''
4803  end if
4804 
4805  end do
4806 
4807  return
4808  end subroutine set_dimension
4809 
4810  !-----------------------------------------------------------------------------
4812  subroutine construct_derived_datatype
4813  use mpi
4814  use scale_prc_cartesc, only: &
4815  prc_num_x, &
4816  prc_num_y
4817  implicit none
4818 
4819  integer :: err, order
4820  integer :: sizes(3), subsizes(3), sub_off(3)
4821  !---------------------------------------------------------------------------
4822 
4823  order = mpi_order_fortran
4824 
4825  centertypexy = mpi_datatype_null
4826  centertypezx = mpi_datatype_null
4827  centertypezxy = mpi_datatype_null
4828  centertypezhxy = mpi_datatype_null
4829  centertypeocean = mpi_datatype_null
4830  centertypeland = mpi_datatype_null
4831  centertypeurban = mpi_datatype_null
4832 
4833  etype = mpi_float
4834 
4835  if( rp == 8 ) etype = mpi_double
4836 
4837  ! for dim_type == 'XY'
4838  startxy(1) = is_ing - ihalo
4839  startxy(2) = js_ing - jhalo
4840  countxy(1) = ia
4841  countxy(2) = ja
4842  ! for dim_type == 'ZXY'
4843  startzxy(1) = 1
4844  startzxy(2:3) = startxy(1:2)
4845  countzxy(1) = kmax
4846  countzxy(2:3) = countxy(1:2)
4847  ! construct MPI subarray data type
4848  sizes(1) = ka
4849  sizes(2) = ia
4850  sizes(3) = ja
4851  subsizes(1) = kmax
4852  subsizes(2) = ia
4853  subsizes(3) = ja
4854  sub_off(1) = ks - 1 ! MPI start index starts with 0
4855  sub_off(2) = 0
4856  sub_off(3) = 0
4857  call mpi_type_create_subarray(3, sizes, subsizes, sub_off, order, etype, centertypezxy, err)
4858  call mpi_type_commit(centertypezxy, err)
4859 
4860  ! for dim_type == 'ZHXY'
4861  startzhxy(1) = 1
4862  startzhxy(2:3) = startxy(1:2)
4863  countzhxy(1) = kmax+1
4864  countzhxy(2:3) = countxy(1:2)
4865  ! construct MPI subarray data type
4866  sizes(1) = ka
4867  sizes(2) = ia
4868  sizes(3) = ja
4869  subsizes(1) = kmax+1
4870  subsizes(2) = ia
4871  subsizes(3) = ja
4872  sub_off(1) = ks - 2 ! MPI start index starts with 0
4873  sub_off(2) = 0
4874  sub_off(3) = 0
4875  call mpi_type_create_subarray(3, sizes, subsizes, sub_off, order, etype, centertypezhxy, err)
4876  call mpi_type_commit(centertypezhxy, err)
4877 
4878  if ( okmax > 0 ) then
4879  ! for dim_type == 'OXY'
4880  startocean(1) = 1
4881  startocean(2:3) = startxy(1:2)
4882  countocean(1) = okmax
4883  countocean(2:3) = countxy(1:2)
4884  ! construct MPI subarray data type
4885  sizes(1) = okmax
4886  subsizes(1) = okmax
4887  sub_off(1) = oks - 1 ! MPI start index starts with 0
4888  call mpi_type_create_subarray(3, sizes, subsizes, sub_off, order, etype, centertypeocean, err)
4889  call mpi_type_commit(centertypeocean, err)
4890  end if
4891 
4892  if ( lkmax > 0 ) then
4893  ! for dim_type == 'LXY'
4894  startland(1) = 1
4895  startland(2:3) = startxy(1:2)
4896  countland(1) = lkmax
4897  countland(2:3) = countxy(1:2)
4898  ! construct MPI subarray data type
4899  sizes(1) = lkmax
4900  subsizes(1) = lkmax
4901  sub_off(1) = lks - 1 ! MPI start index starts with 0
4902  call mpi_type_create_subarray(3, sizes, subsizes, sub_off, order, etype, centertypeland, err)
4903  call mpi_type_commit(centertypeland, err)
4904  end if
4905 
4906  if ( ukmax > 0 ) then
4907  ! for dim_type == 'UXY'
4908  starturban(1) = 1
4909  starturban(2:3) = startxy(1:2)
4910  counturban(1) = ukmax
4911  counturban(2:3) = countxy(1:2)
4912  ! construct MPI subarray data type
4913  sizes(1) = ukmax
4914  subsizes(1) = ukmax
4915  sub_off(1) = uks - 1 ! MPI start index starts with 0
4916  call mpi_type_create_subarray(3, sizes, subsizes, sub_off, order, etype, centertypeurban, err)
4917  call mpi_type_commit(centertypeurban, err)
4918  end if
4919 
4920  ! for dim_type == 'ZX'
4921  startzx(1) = khalo+1
4922  startzx(2) = is_ing - ihalo
4923  countzx(1) = kmax
4924  countzx(2) = ia
4925  ! construct MPI subarray data type
4926  sizes(1) = ka
4927  sizes(2) = ia
4928  subsizes(1) = kmax
4929  subsizes(2) = imaxb
4930  sub_off(1) = khalo ! MPI start index starts with 0
4931  sub_off(2) = isb - 1 ! MPI start index starts with 0
4932  call mpi_type_create_subarray(2, sizes, subsizes, sub_off, order, etype, centertypezx, err)
4933  call mpi_type_commit(centertypezx, err)
4934 
4935  return
4936  end subroutine construct_derived_datatype
4937 
4938  !-----------------------------------------------------------------------------
4940  subroutine free_derived_datatype
4941  use mpi
4942  implicit none
4943 
4944  integer :: err
4945  !---------------------------------------------------------------------------
4946 
4947  if( centertypexy /= mpi_datatype_null ) call mpi_type_free(centertypexy, err)
4948  if( centertypezx /= mpi_datatype_null ) call mpi_type_free(centertypezx, err)
4949  if( centertypezxy /= mpi_datatype_null ) call mpi_type_free(centertypezxy, err)
4950  if( centertypezhxy /= mpi_datatype_null ) call mpi_type_free(centertypezhxy, err)
4951  if( centertypeocean /= mpi_datatype_null ) call mpi_type_free(centertypeocean, err)
4952  if( centertypeland /= mpi_datatype_null ) call mpi_type_free(centertypeland, err)
4953  if( centertypeurban /= mpi_datatype_null ) call mpi_type_free(centertypeurban, err)
4954 
4955  return
4956  end subroutine free_derived_datatype
4957 
4958 end module scale_file_cartesc
scale_atmos_grid_cartesc_index::isb
integer, public isb
Definition: scale_atmos_grid_cartesC_index.F90:64
scale_file_cartesc::file_cartesc_set_coordinates_land
subroutine, public file_cartesc_set_coordinates_land(VOL)
set volume for land
Definition: scale_file_cartesC.F90:570
scale_urban_grid_cartesc_index::uja
integer, public uja
Definition: scale_urban_grid_cartesC_index.F90:45
scale_atmos_grid_cartesc_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:52
scale_file_cartesc::file_cartesc_read_1d
subroutine file_cartesc_read_1d(basename, varname, dim_type, var, step, aggregate, allow_missing)
interface FILE_CARTESC_read Read data from file This routine is a wrapper of the lower primitive rout...
Definition: scale_file_cartesC.F90:1088
scale_time::time_nowdaysec
real(dp), public time_nowdaysec
second of current time [sec]
Definition: scale_time.F90:72
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:350
scale_ocean_grid_cartesc::ocean_grid_cartesc_cz
real(rp), dimension(:), allocatable, public ocean_grid_cartesc_cz
center coordinate [m]: z, local=global
Definition: scale_ocean_grid_cartesC.F90:36
scale_urban_grid_cartesc::urban_grid_cartesc_cdz
real(rp), dimension(:), allocatable, public urban_grid_cartesc_cdz
z-length of control volume [m]
Definition: scale_urban_grid_cartesC.F90:38
scale_land_grid_cartesc_index::lia
integer, public lia
Definition: scale_land_grid_cartesC_index.F90:41
scale_atmos_grid_cartesc::atmos_grid_cartesc_cdz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cdz
z-length of control volume [m]
Definition: scale_atmos_grid_cartesC.F90:43
scale_urban_grid_cartesc_index::uia
integer, public uia
Definition: scale_urban_grid_cartesC_index.F90:41
scale_ocean_grid_cartesc_index::oke
integer, public oke
Definition: scale_ocean_grid_cartesC_index.F90:39
scale_atmos_grid_cartesc_index::ihalo
integer, public ihalo
Definition: scale_atmos_grid_cartesC_index.F90:44
scale_atmos_grid_cartesc_index::jmaxb
integer, public jmaxb
Definition: scale_atmos_grid_cartesC_index.F90:63
scale_file::file_open
subroutine, public file_open(basename, fid, mode, single, allnodes, aggregate, rankid, postfix)
Definition: scale_file.F90:536
scale_prc_cartesc::prc_has_s
logical, public prc_has_s
Definition: scale_prc_cartesC.F90:51
scale_land_grid_cartesc_index::lja
integer, public lja
Definition: scale_land_grid_cartesC_index.F90:45
scale_file_cartesc::file_cartesc_enddef
subroutine, public file_cartesc_enddef(fid)
Exit netCDF file define mode.
Definition: scale_file_cartesC.F90:964
scale_file_h::file_real4
integer, parameter, public file_real4
Definition: scale_file_h.F90:26
scale_land_grid_cartesc::land_grid_cartesc_cdz
real(rp), dimension(:), allocatable, public land_grid_cartesc_cdz
z-length of control volume [m]
Definition: scale_land_grid_cartesC.F90:37
scale_file::file_enddef
subroutine, public file_enddef(fid)
Definition: scale_file.F90:6061
scale_calendar::calendar_get_name
subroutine, public calendar_get_name(name)
Definition: scale_calendar.F90:806
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_file_cartesc::set_dimension
subroutine set_dimension(name, ndims, dims, size, mapping, area, area_x, area_y, volume, location, grid)
Definition: scale_file_cartesC.F90:4731
scale_file_cartesc::file_cartesc_write_1d
subroutine file_cartesc_write_1d(var, basename, title, varname, desc, unit, dim_type, datatype, date, subsec, append, aggregate, standard_name, cell_measures)
interface FILE_CARTESC_write Write data to file This routine is a wrapper of the lowere primitive rou...
Definition: scale_file_cartesC.F90:2053
scale_prc_cartesc::prc_periodic_y
logical, public prc_periodic_y
periodic condition or not (Y)?
Definition: scale_prc_cartesC.F90:54
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
scale_atmos_grid_cartesc_index::isga
integer, public isga
start point of the full domain: cx, global
Definition: scale_atmos_grid_cartesC_index.F90:82
scale_file_cartesc::file_cartesc_put_globalattributes
subroutine, public file_cartesc_put_globalattributes(fid, prc_rank_x, prc_rank_y, prc_num_x, prc_num_y, prc_periodic_x, prc_periodic_y, kmax, okmax, lkmax, ukmax, imaxg, jmaxg, khalo, ihalo, jhalo, time, tunits, calendar)
put global attributes
Definition: scale_file_cartesC.F90:2345
scale_file::file_attach_buffer
subroutine, public file_attach_buffer(fid, buf_amount)
Definition: scale_file.F90:6127
scale_file_cartesc::file_cartesc_write_var_3d
subroutine file_cartesc_write_var_3d(fid, vid, var, varname, dim_type, fill_halo)
Write 3D data to file.
Definition: scale_file_cartesC.F90:3790
scale_file::file_flush
subroutine, public file_flush(fid)
Definition: scale_file.F90:6201
scale_land_grid_cartesc_index::lkmax
integer, public lkmax
Definition: scale_land_grid_cartesC_index.F90:32
scale_atmos_grid_cartesc::atmos_grid_cartesc_cdyg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cdyg
center coordinate [m]: y, global
Definition: scale_atmos_grid_cartesC.F90:82
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:35
scale_time::time_nowsubsec
real(dp), public time_nowsubsec
subsecond part of current time [sec]
Definition: scale_time.F90:71
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level, disable_barrier)
Start raptime.
Definition: scale_prof.F90:174
scale_file_cartesc::file_cartesc_set_coordinates_urban
subroutine, public file_cartesc_set_coordinates_urban(VOL)
set volume for urban
Definition: scale_file_cartesC.F90:584
scale_file::file_allnodes
logical function, public file_allnodes(fid)
check if the file is allnodes
Definition: scale_file.F90:612
scale_atmos_grid_cartesc::atmos_grid_cartesc_fyg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fyg
face coordinate [m]: y, global
Definition: scale_atmos_grid_cartesC.F90:79
scale_atmos_grid_cartesc::atmos_grid_cartesc_cdy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cdy
y-length of control volume [m]
Definition: scale_atmos_grid_cartesC.F90:62
scale_ocean_grid_cartesc_index::oka
integer, public oka
Definition: scale_ocean_grid_cartesC_index.F90:37
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_atmos_grid_cartesc::atmos_grid_cartesc_fdyg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdyg
center coordinate [m]: y, global
Definition: scale_atmos_grid_cartesC.F90:84
scale_file_h::file_rmiss
real(dp), parameter, public file_rmiss
Definition: scale_file_h.F90:51
scale_prc::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:91
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdy
y-length of grid(j+1) to grid(j) [m]
Definition: scale_atmos_grid_cartesC.F90:64
scale_ocean_grid_cartesc_index::okmax
integer, public okmax
Definition: scale_ocean_grid_cartesC_index.F90:32
scale_atmos_grid_cartesc_index::khalo
integer, parameter, public khalo
Definition: scale_atmos_grid_cartesC_index.F90:43
scale_atmos_grid_cartesc::atmos_grid_cartesc_fbfx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fbfx
face buffer factor (0-1): x
Definition: scale_atmos_grid_cartesC.F90:73
scale_file::file_opened
logical function, public file_opened(fid)
check if the file is opened?
Definition: scale_file.F90:578
scale_calendar
module CALENDAR
Definition: scale_calendar.F90:13
scale_urban_grid_cartesc_index
module urban / grid / icosahedralA / index
Definition: scale_urban_grid_cartesC_index.F90:11
scale_atmos_grid_cartesc_index::imaxg
integer, public imaxg
Definition: scale_atmos_grid_cartesC_index.F90:72
scale_atmos_grid_cartesc_index::je_ing
integer, public je_ing
end point of the inner domain: cy, global
Definition: scale_atmos_grid_cartesC_index.F90:81
scale_ocean_grid_cartesc
module ocean / grid / cartesianC
Definition: scale_ocean_grid_cartesC.F90:12
scale_io::h_institute
character(len=h_mid), public h_institute
for file header
Definition: scale_io.F90:52
scale_atmos_grid_cartesc::atmos_grid_cartesc_cdxg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cdxg
center coordinate [m]: x, global
Definition: scale_atmos_grid_cartesC.F90:81
scale_urban_grid_cartesc::urban_grid_cartesc_cz
real(rp), dimension(:), allocatable, public urban_grid_cartesc_cz
center coordinate [m]: z, local=global
Definition: scale_urban_grid_cartesC.F90:36
scale_file
module file
Definition: scale_file.F90:15
scale_atmos_grid_cartesc_index::imax
integer, public imax
Definition: scale_atmos_grid_cartesC_index.F90:37
scale_io::h_source
character(len=h_mid), public h_source
for file header
Definition: scale_io.F90:51
scale_file_cartesc::file_cartesc_def_axes
subroutine file_cartesc_def_axes(fid, dtype, hasZ)
define axis variables in the file
Definition: scale_file_cartesC.F90:2409
scale_atmos_grid_cartesc_index::jmaxg
integer, public jmaxg
Definition: scale_atmos_grid_cartesC_index.F90:73
scale_prc_cartesc::prc_has_n
logical, public prc_has_n
Definition: scale_prc_cartesC.F90:49
scale_land_grid_cartesc_index
module land / grid / cartesianC / index
Definition: scale_land_grid_cartesC_index.F90:11
scale_atmos_grid_cartesc_index::jeb
integer, public jeb
Definition: scale_atmos_grid_cartesC_index.F90:67
scale_file_cartesc::axisattinfo
Definition: scale_file_cartesC.F90:99
scale_file::file_def_axis
subroutine, public file_def_axis(fid, name, desc, units, dim_name, dtype, dim_size, bounds)
Definition: scale_file.F90:770
scale_prc_cartesc::prc_has_e
logical, public prc_has_e
Definition: scale_prc_cartesC.F90:50
scale_urban_grid_cartesc_index::ukmax
integer, public ukmax
Definition: scale_urban_grid_cartesC_index.F90:32
scale_atmos_grid_cartesc::atmos_grid_cartesc_cbfx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cbfx
center buffer factor (0-1): x
Definition: scale_atmos_grid_cartesC.F90:71
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_file_cartesc::file_cartesc_read_auto_3d
subroutine file_cartesc_read_auto_3d(fid, varname, var, step, existed)
Read 3D data from file.
Definition: scale_file_cartesC.F90:1913
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_atmos_grid_cartesc::atmos_grid_cartesc_fbfxg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fbfxg
face buffer factor (0-1): x, global
Definition: scale_atmos_grid_cartesC.F90:88
scale_io
module STDIO
Definition: scale_io.F90:10
scale_atmos_grid_cartesc_index::jag
integer, public jag
Definition: scale_atmos_grid_cartesC_index.F90:75
scale_file_cartesc::file_cartesc_get_size_id
subroutine file_cartesc_get_size_id(fid, KMAX, OKMAX, LKMAX, UKMAX, IMAXG, JMAXG, KHALO, IHALO, JHALO)
Definition: scale_file_cartesC.F90:412
scale_atmos_grid_cartesc_index::iag
integer, public iag
Definition: scale_atmos_grid_cartesC_index.F90:74
scale_prc_cartesc::prc_periodic_x
logical, public prc_periodic_x
periodic condition or not (X)?
Definition: scale_prc_cartesC.F90:53
scale_atmos_grid_cartesc_index::js_ing
integer, public js_ing
start point of the inner domain: cy, global
Definition: scale_atmos_grid_cartesC_index.F90:80
scale_atmos_grid_cartesc::atmos_grid_cartesc_cbfz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cbfz
center buffer factor (0-1): z
Definition: scale_atmos_grid_cartesC.F90:47
scale_file::file_close
subroutine, public file_close(fid, abort)
Definition: scale_file.F90:6234
scale_ocean_grid_cartesc::ocean_grid_cartesc_fz
real(rp), dimension(:), allocatable, public ocean_grid_cartesc_fz
face coordinate [m]: z, local=global
Definition: scale_ocean_grid_cartesC.F90:37
scale_atmos_grid_cartesc::atmos_grid_cartesc_cxg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cxg
center coordinate [m]: x, global
Definition: scale_atmos_grid_cartesC.F90:76
scale_file_cartesc::file_cartesc_read_var_2d
subroutine file_cartesc_read_var_2d(fid, varname, dim_type, var, step, allow_missing)
Read 2D data from file.
Definition: scale_file_cartesC.F90:1371
scale_ocean_grid_cartesc_index::oja
integer, public oja
Definition: scale_ocean_grid_cartesC_index.F90:47
scale_file::file_def_associatedcoordinate
subroutine, public file_def_associatedcoordinate(fid, name, desc, units, dim_names, dtype)
Definition: scale_file.F90:1472
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_file_cartesc::file_cartesc_read_var_3d
subroutine file_cartesc_read_var_3d(fid, varname, dim_type, var, step, allow_missing)
Read 3D data from file.
Definition: scale_file_cartesC.F90:1480
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
scale_file_cartesc::file_cartesc_set_coordinates_ocean
subroutine, public file_cartesc_set_coordinates_ocean(VOL)
set volume for ocean
Definition: scale_file_cartesC.F90:556
scale_atmos_grid_cartesc::atmos_grid_cartesc_fbfy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fbfy
face buffer factor (0-1): y
Definition: scale_atmos_grid_cartesC.F90:74
scale_atmos_grid_cartesc_index::ie_ing
integer, public ie_ing
end point of the inner domain: cx, global
Definition: scale_atmos_grid_cartesC_index.F90:79
scale_prc_cartesc::prc_2drank
integer, dimension(:,:), allocatable, public prc_2drank
node index in 2D topology
Definition: scale_prc_cartesC.F90:45
scale_atmos_grid_cartesc_index::kmax
integer, public kmax
Definition: scale_atmos_grid_cartesC_index.F90:36
scale_file_cartesc::construct_derived_datatype
subroutine construct_derived_datatype
construct MPI derived datatypes for read buffers
Definition: scale_file_cartesC.F90:4813
scale_urban_grid_cartesc
module urban / grid / cartesianC
Definition: scale_urban_grid_cartesC.F90:12
scale_atmos_grid_cartesc_index::is_ing
integer, public is_ing
start point of the inner domain: cx, global
Definition: scale_atmos_grid_cartesC_index.F90:78
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_file_cartesc::file_cartesc_close
subroutine, public file_cartesc_close(fid)
Close a netCDF file.
Definition: scale_file_cartesC.F90:1044
scale_prc_cartesc
module process / cartesC
Definition: scale_prc_cartesC.F90:11
scale_atmos_grid_cartesc::atmos_grid_cartesc_fbfz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fbfz
face buffer factor (0-1): z
Definition: scale_atmos_grid_cartesC.F90:48
scale_file_cartesc::file_cartesc_write_axes
subroutine file_cartesc_write_axes(fid, haszcoord, start)
write axis to the file
Definition: scale_file_cartesC.F90:2887
scale_ocean_grid_cartesc::ocean_grid_cartesc_cdz
real(rp), dimension(:), allocatable, public ocean_grid_cartesc_cdz
z-length of control volume [m]
Definition: scale_ocean_grid_cartesC.F90:38
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_file_cartesc::file_cartesc_finalize
subroutine, public file_cartesc_finalize
deallocate buffers
Definition: scale_file_cartesC.F90:320
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_atmos_grid_cartesc_index::jhalo
integer, public jhalo
Definition: scale_atmos_grid_cartesC_index.F90:45
scale_file_cartesc::file_cartesc_read_var_4d
subroutine file_cartesc_read_var_4d(fid, varname, dim_type, step, var, allow_missing)
Read 4D data from file.
Definition: scale_file_cartesC.F90:1667
scale_ocean_grid_cartesc_index
module ocean / grid / cartesianC / index
Definition: scale_ocean_grid_cartesC_index.F90:11
scale_precision::dp
integer, parameter, public dp
Definition: scale_precision.F90:32
scale_atmos_grid_cartesc::atmos_grid_cartesc_cbfxg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cbfxg
center buffer factor (0-1): x, global
Definition: scale_atmos_grid_cartesC.F90:86
scale_file_cartesc::file_cartesc_write_var_4d
subroutine file_cartesc_write_var_4d(fid, vid, var, varname, dim_type, timeintv, timetarg, timeofs, fill_halo)
Write 4D data to file.
Definition: scale_file_cartesC.F90:4168
scale_file_h
module file_h
Definition: scale_file_h.F90:11
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
scale_time
module TIME
Definition: scale_time.F90:11
scale_file::file_add_associatedvariable
subroutine, public file_add_associatedvariable(fid, vname, existed)
Definition: scale_file.F90:464
scale_file_cartesc::set_dimension_informations
subroutine set_dimension_informations
Definition: scale_file_cartesC.F90:4600
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdx
x-length of grid(i+1) to grid(i) [m]
Definition: scale_atmos_grid_cartesC.F90:63
scale_land_grid_cartesc::land_grid_cartesc_cz
real(rp), dimension(:), allocatable, public land_grid_cartesc_cz
center coordinate [m]: z, local=global
Definition: scale_land_grid_cartesC.F90:35
scale_file_cartesc::file_cartesc_set_coordinates_atmos
subroutine, public file_cartesc_set_coordinates_atmos(CZ, FZ, LON, LONUY, LONXV, LONUV, LAT, LATUY, LATXV, LATUV, TOPO, LSMASK)
set latlon and z for atmosphere
Definition: scale_file_cartesC.F90:467
scale_file_cartesc::file_cartesc_set_areavol_atmos
subroutine, public file_cartesc_set_areavol_atmos(AREA, AREAZUY_X, AREAZXV_Y, AREAWUY_X, AREAWXV_Y, AREAUY, AREAZXY_X, AREAZUV_Y, AREAXV, AREAZUV_X, AREAZXY_Y, VOL, VOLWXY, VOLZUY, VOLZXV)
set area and volume
Definition: scale_file_cartesC.F90:513
scale_atmos_grid_cartesc::atmos_grid_cartesc_fbfyg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fbfyg
face buffer factor (0-1): y, global
Definition: scale_atmos_grid_cartesC.F90:89
scale_urban_grid_cartesc_index::uks
integer, public uks
Definition: scale_urban_grid_cartesC_index.F90:38
scale_atmos_grid_cartesc::atmos_grid_cartesc_fxg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fxg
face coordinate [m]: x, global
Definition: scale_atmos_grid_cartesC.F90:78
scale_atmos_grid_cartesc_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:51
scale_atmos_grid_cartesc_index::imaxb
integer, public imaxb
Definition: scale_atmos_grid_cartesC_index.F90:62
scale_file_cartesc::free_derived_datatype
subroutine free_derived_datatype
free MPI derived datatypes
Definition: scale_file_cartesC.F90:4941
scale_land_grid_cartesc::land_grid_cartesc_fz
real(rp), dimension(:), allocatable, public land_grid_cartesc_fz
face coordinate [m]: z, local=global
Definition: scale_land_grid_cartesC.F90:36
scale_file::file_get_cftunits
subroutine, public file_get_cftunits(date, tunits)
get unit of time
Definition: scale_file.F90:6304
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_atmos_grid_cartesc::atmos_grid_cartesc_fz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fz
face coordinate [m]: z, local
Definition: scale_atmos_grid_cartesC.F90:42
scale_atmos_grid_cartesc::atmos_grid_cartesc_name
character(len=7), parameter, public atmos_grid_cartesc_name
Definition: scale_atmos_grid_cartesC.F90:37
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_file_h::file_fread
integer, parameter, public file_fread
Definition: scale_file_h.F90:34
scale_file::file_def_variable
subroutine, public file_def_variable(fid, varname, desc, units, standard_name, ndims, dims, dtype, vid, time_int, time_stats, existed)
Definition: scale_file.F90:2381
scale_atmos_grid_cartesc::atmos_grid_cartesc_cyg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cyg
center coordinate [m]: y, global
Definition: scale_atmos_grid_cartesC.F90:77
scale_mapprojection::mapprojection_mappinginfo
type(mappinginfo), save, public mapprojection_mappinginfo
Definition: scale_mapprojection.F90:104
scale_atmos_grid_cartesc_index::jmax
integer, public jmax
Definition: scale_atmos_grid_cartesC_index.F90:38
scale_time::time_nowdate
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
Definition: scale_time.F90:68
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_file::file_create
subroutine, public file_create(basename, title, source, institution, fid, existed, rankid, single, aggregate, time_units, calendar, allnodes, append)
create file fid is >= 1
Definition: scale_file.F90:295
scale_prc_cartesc::prc_num_y
integer, public prc_num_y
y length of 2D processor topology
Definition: scale_prc_cartesC.F90:43
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
scale_atmos_grid_cartesc_index::ieb
integer, public ieb
Definition: scale_atmos_grid_cartesC_index.F90:65
scale_file::file_get_aggregate
logical function, public file_get_aggregate(fid)
Definition: scale_file.F90:6316
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_urban_grid_cartesc_index::uka
integer, public uka
Definition: scale_urban_grid_cartesC_index.F90:37
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level, disable_barrier)
Save raptime.
Definition: scale_prof.F90:246
scale_const::const_d2r
real(rp), public const_d2r
degree to radian
Definition: scale_const.F90:33
scale_atmos_grid_cartesc::atmos_grid_cartesc_cbfy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cbfy
center buffer factor (0-1): y
Definition: scale_atmos_grid_cartesC.F90:72
scale_ocean_grid_cartesc_index::oia
integer, public oia
Definition: scale_ocean_grid_cartesC_index.F90:42
scale_land_grid_cartesc
module land / grid / cartesianC
Definition: scale_land_grid_cartesC.F90:11
scale_prc_cartesc::prc_num_x
integer, public prc_num_x
x length of 2D processor topology
Definition: scale_prc_cartesC.F90:42
scale_land_grid_cartesc_index::lke
integer, public lke
Definition: scale_land_grid_cartesC_index.F90:39
scale_file::file_detach_buffer
subroutine, public file_detach_buffer(fid)
Definition: scale_file.F90:6165
scale_atmos_grid_cartesc::atmos_grid_cartesc_cdx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cdx
x-length of control volume [m]
Definition: scale_atmos_grid_cartesC.F90:61
scale_file_cartesc::file_cartesc_write_var_1d
subroutine file_cartesc_write_var_1d(fid, vid, var, varname, dim_type)
Write 1D data to file.
Definition: scale_file_cartesC.F90:3553
scale_atmos_grid_cartesc
module atmosphere / grid / cartesC
Definition: scale_atmos_grid_cartesC.F90:12
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdz
z-length of grid(i+1) to grid(i) [m]
Definition: scale_atmos_grid_cartesC.F90:44
scale_atmos_grid_cartesc::atmos_grid_cartesc_cz
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cz
center coordinate [m]: z, local
Definition: scale_atmos_grid_cartesC.F90:41
scale_file_cartesc::file_cartesc_read_auto_2d
subroutine file_cartesc_read_auto_2d(fid, varname, var, step, existed)
Read 2D data from file.
Definition: scale_file_cartesC.F90:1826
scale_file::file_setup
subroutine, public file_setup(myrank)
setup
Definition: scale_file.F90:236
scale_atmos_grid_cartesc::atmos_grid_cartesc_cbfyg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cbfyg
center buffer factor (0-1): y, global
Definition: scale_atmos_grid_cartesC.F90:87
scale_file_cartesc::file_cartesc_setup
subroutine, public file_cartesc_setup
Setup.
Definition: scale_file_cartesC.F90:215
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_file_cartesc::file_cartesc_write_var_3d_t
subroutine file_cartesc_write_var_3d_t(fid, vid, var, varname, dim_type, timeintv, timetarg, timeofs, fill_halo)
Write 3D data with time dimension to file.
Definition: scale_file_cartesC.F90:3961
scale_atmos_grid_cartesc_index::jsb
integer, public jsb
Definition: scale_atmos_grid_cartesC_index.F90:66
scale_file_h::file_file_max
integer, parameter, public file_file_max
Definition: scale_file_h.F90:45
scale_prc_cartesc::prc_has_w
logical, public prc_has_w
Definition: scale_prc_cartesC.F90:48
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_land_grid_cartesc_index::lks
integer, public lks
Definition: scale_land_grid_cartesC_index.F90:38
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_prc_cartesc::prc_twod
logical, public prc_twod
2D experiment
Definition: scale_prc_cartesC.F90:56
scale_file_cartesc
module file / cartesianC
Definition: scale_file_cartesC.F90:11
scale_file_h::file_real8
integer, parameter, public file_real8
Definition: scale_file_h.F90:27
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_prc::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_prc.F90:92
scale_atmos_grid_cartesc_index::jsga
integer, public jsga
start point of the full domain: cy, global
Definition: scale_atmos_grid_cartesC_index.F90:84
scale_urban_grid_cartesc_index::uke
integer, public uke
Definition: scale_urban_grid_cartesC_index.F90:39
scale_land_grid_cartesc_index::lka
integer, public lka
Definition: scale_land_grid_cartesC_index.F90:37
scale_urban_grid_cartesc::urban_grid_cartesc_fz
real(rp), dimension(:), allocatable, public urban_grid_cartesc_fz
face coordinate [m]: z, local=global
Definition: scale_urban_grid_cartesC.F90:37
scale_atmos_grid_cartesc::atmos_grid_cartesc_fdxg
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fdxg
center coordinate [m]: x, global
Definition: scale_atmos_grid_cartesC.F90:83
scale_file_cartesc::file_cartesc_write_var_2d
subroutine file_cartesc_write_var_2d(fid, vid, var, varname, dim_type, fill_halo)
Write 2D data to file.
Definition: scale_file_cartesC.F90:3639
scale_ocean_grid_cartesc_index::oks
integer, public oks
Definition: scale_ocean_grid_cartesC_index.F90:38