SCALE-RM
scale_file.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 ! Warning: This file was generated from file/scale_file.F90.erb.
12 ! Do not edit this file.
13 !-------------------------------------------------------------------------------
14 #include "scalelib.h"
15 module scale_file
16  !-----------------------------------------------------------------------------
17  !
18  !++ Used modules
19  !
20  use scale_precision
21  use scale_io
22  use scale_prof
23  use scale_file_h
24  use scale_prc, only: &
25  prc_abort
26  !-----------------------------------------------------------------------------
27  implicit none
28  private
29  !-----------------------------------------------------------------------------
30  !
31  !++ Public procedures
32  !
33  public :: file_setup
34  public :: file_open
35  public :: file_opened
36  public :: file_create
37  public :: file_get_dimlength
38  public :: file_set_option
39  public :: file_def_axis
40  public :: file_put_axis
41  public :: file_write_axis
42  public :: file_def_associatedcoordinate
43  public :: file_put_associatedcoordinate
44  public :: file_write_associatedcoordinate
45  public :: file_add_variable
46  public :: file_def_variable
47  public :: file_get_shape
48  public :: file_get_stepsize
49  public :: file_get_commoninfo
50  public :: file_get_datainfo
51  public :: file_get_all_datainfo
52  public :: file_read
53  public :: file_write
54  public :: file_get_attribute
55  public :: file_set_attribute
56  public :: file_add_associatedvariable
57  public :: file_enddef
58  public :: file_flush
59  public :: file_close
60  public :: file_close_all
61  public :: file_make_fname
62  public :: file_attach_buffer
63  public :: file_detach_buffer
64  public :: file_get_cftunits
65  public :: file_get_aggregate
66 
67  interface file_get_commoninfo
68  module procedure file_get_commoninfo_fid
69  module procedure file_get_commoninfo_fname
70  end interface file_get_commoninfo
71 
72  interface file_get_shape
73  module procedure file_get_shape_fid
74  module procedure file_get_shape_fname
75  end interface file_get_shape
76 
77  interface file_get_datainfo
78  module procedure file_get_datainfo_fid
79  module procedure file_get_datainfo_fname
80  end interface file_get_datainfo
81 
82  interface file_get_all_datainfo
83  module procedure file_get_all_datainfo_fid
84  module procedure file_get_all_datainfo_fname
85  end interface file_get_all_datainfo
86 
87  interface file_put_axis
88  module procedure file_put_axis_realsp
89  module procedure file_put_axis_realdp
90  end interface file_put_axis
91  interface file_write_axis
92  module procedure file_write_axis_realsp
93  module procedure file_write_axis_realdp
94  end interface file_write_axis
95  interface file_put_associatedcoordinate
96  module procedure file_put_associatedcoordinate_realsp_1d
97  module procedure file_put_associatedcoordinate_realdp_1d
98  module procedure file_put_associatedcoordinate_realsp_2d
99  module procedure file_put_associatedcoordinate_realdp_2d
100  module procedure file_put_associatedcoordinate_realsp_3d
101  module procedure file_put_associatedcoordinate_realdp_3d
102  module procedure file_put_associatedcoordinate_realsp_4d
103  module procedure file_put_associatedcoordinate_realdp_4d
104  end interface file_put_associatedcoordinate
105  interface file_write_associatedcoordinate
106  module procedure file_write_associatedcoordinate_realsp_1d
107  module procedure file_write_associatedcoordinate_realdp_1d
108  module procedure file_write_associatedcoordinate_realsp_2d
109  module procedure file_write_associatedcoordinate_realdp_2d
110  module procedure file_write_associatedcoordinate_realsp_3d
111  module procedure file_write_associatedcoordinate_realdp_3d
112  module procedure file_write_associatedcoordinate_realsp_4d
113  module procedure file_write_associatedcoordinate_realdp_4d
114  end interface file_write_associatedcoordinate
115  interface file_add_variable
116  module procedure file_add_variable_no_time
117  module procedure file_add_variable_with_time
118  end interface file_add_variable
119  interface file_read
120  module procedure file_read_realsp_1d
121  module procedure file_read_realdp_1d
122  module procedure file_read_realsp_2d
123  module procedure file_read_realdp_2d
124  module procedure file_read_realsp_3d
125  module procedure file_read_realdp_3d
126  module procedure file_read_realsp_4d
127  module procedure file_read_realdp_4d
128  module procedure file_read_var_realsp_1d
129  module procedure file_read_var_realdp_1d
130  module procedure file_read_var_realsp_2d
131  module procedure file_read_var_realdp_2d
132  module procedure file_read_var_realsp_3d
133  module procedure file_read_var_realdp_3d
134  module procedure file_read_var_realsp_4d
135  module procedure file_read_var_realdp_4d
136  end interface file_read
137  interface file_write
138  module procedure file_write_realsp_1d
139  module procedure file_write_realdp_1d
140  module procedure file_write_realsp_2d
141  module procedure file_write_realdp_2d
142  module procedure file_write_realsp_3d
143  module procedure file_write_realdp_3d
144  module procedure file_write_realsp_4d
145  module procedure file_write_realdp_4d
146  end interface file_write
147  interface file_get_attribute
148  module procedure file_get_attribute_text_fname
149  module procedure file_get_attribute_logical_fname
150  module procedure file_get_attribute_int_fname
151  module procedure file_get_attribute_float_fname
152  module procedure file_get_attribute_double_fname
153  module procedure file_get_attribute_text_fid
154  module procedure file_get_attribute_logical_fid
155  module procedure file_get_attribute_int_fid
156  module procedure file_get_attribute_float_fid
157  module procedure file_get_attribute_double_fid
158  end interface file_get_attribute
159  interface file_set_attribute
160  module procedure file_set_attribute_text
161  module procedure file_set_attribute_logical
162  module procedure file_set_attribute_int
163  module procedure file_set_attribute_float
164  module procedure file_set_attribute_double
165  end interface file_set_attribute
166 
167  !-----------------------------------------------------------------------------
168  !
169  !++ Public parameters & variables
170  !
171  logical, public :: file_aggregate = .false.
172 
173  !-----------------------------------------------------------------------------
174  !
175  !++ Private procedures
176  !
177  private :: file_get_fid
178 
179  !-----------------------------------------------------------------------------
180  !
181  !++ Private parameters & variables
182  !
183  type file
184  character(len=FILE_HLONG) :: name
185  integer :: fid
186  logical :: aggregate
187  end type file
188  type(file) :: file_files(file_file_max)
189  integer :: file_nfiles = 0
190 
191  type var
192  character(len=FILE_HLONG) :: name
193  integer :: fid
194  integer :: vid
195  end type var
196  type(var) :: file_vars(file_var_max)
197  integer :: file_nvars = 0
198 
199  integer :: mpi_myrank
200 
201  !-----------------------------------------------------------------------------
202 contains
203  !-----------------------------------------------------------------------------
205  !-----------------------------------------------------------------------------
206  subroutine file_setup( &
207  myrank )
208  use scale_prc, only: &
209  prc_set_file_closer
210  implicit none
211 
212  integer, intent(in) :: myrank
213 
214  namelist / param_file / &
215  file_aggregate
216 
217  integer :: ierr
218 
219  !--- read namelist
220  rewind(io_fid_conf)
221  read(io_fid_conf,nml=param_file,iostat=ierr)
222  if( ierr < 0 ) then !--- missing
223  log_info("FILE_setup",*) 'Not found namelist. Default used.'
224  elseif( ierr > 0 ) then !--- fatal error
225  log_error("FILE_setup",*) 'Not appropriate names in namelist PARAM_FILE. Check!'
226  call prc_abort
227  endif
228  log_nml(param_file)
229 
230  mpi_myrank = myrank
231 
232  call prc_set_file_closer( file_close_all )
233 
234  return
235  end subroutine file_setup
236 
237  !-----------------------------------------------------------------------------
241  subroutine file_create( &
242  basename, &
243  title, source, institution, &
244  fid, existed, &
245  rankid, single, aggregate, &
246  time_units, calendar, &
247  append )
248  implicit none
249 
250  character(len=*), intent(in) :: basename
251  character(len=*), intent(in) :: title
252  character(len=*), intent(in) :: source
253  character(len=*), intent(in) :: institution
254 
255  integer, intent(out) :: fid
256  logical, intent(out) :: existed
257 
258  integer, intent(in), optional :: rankid
259  logical, intent(in), optional :: single
260  logical, intent(in), optional :: aggregate
261  character(len=*), intent(in), optional :: time_units
262  character(len=*), intent(in), optional :: calendar
263  logical, intent(in), optional :: append
264 
265  character(len=FILE_HMID) :: time_units_
266  character(len=FILE_HSHORT) :: calendar_
267  integer :: rankid_
268  logical :: single_
269  integer :: mode
270 
271  integer :: error
272  !---------------------------------------------------------------------------
273 
274 
275  if ( present(rankid) ) then
276  rankid_ = rankid
277  else
278  rankid_ = mpi_myrank
279  end if
280 
281  single_ = .false.
282  if ( present(single) ) then
283  single_ = single
284  endif
285 
286  if ( present(time_units) ) then
287  time_units_ = time_units
288  else
289  time_units_ = 'seconds'
290  endif
291 
292  if ( present(calendar) ) then
293  calendar_ = calendar
294  else
295  calendar_ = ""
296  end if
297 
298  mode = file_fwrite
299  if ( present(append) ) then
300  if( append ) mode = file_fappend
301  endif
302 
303  if ( single_ .and. rankid_ /= 0 ) return
304 
305  call file_get_fid( basename, mode, & ! [IN]
306  rankid_, single_, & ! [IN]
307  fid, existed, & ! [OUT]
308  aggregate=aggregate ) ! [IN]
309 
310  if( existed ) return
311 
312  !--- append package header to the file
313  call file_set_attribute( fid, "global", "title" , title ) ! [IN]
314  call file_set_attribute( fid, "global", "source" , source ) ! [IN]
315  call file_set_attribute( fid, "global", "institution", institution ) ! [IN]
316 
317  if ( ( .not. present(aggregate) ) .or. .not. aggregate ) then
318  ! for shared-file parallel I/O, skip attributes related to MPI processes
319  call file_set_attribute( fid, "global", "rankid" , (/rankid/) ) ! [IN]
320  endif
321 
322  call file_set_tunits_c( file_files(fid)%fid, & ! [IN]
323  time_units_, calendar_, & ! [IN]
324  error ) ! [OUT]
325 
326  if ( error /= file_success_code ) then
327  log_error("FILE_create",*) 'failed to set time units'
328  call prc_abort
329  endif
330 
331  return
332  end subroutine file_create
333 
334  !-----------------------------------------------------------------------------
335  subroutine file_get_var_num( &
336  fid, nvars_limit, &
337  nvars )
338  implicit none
339 
340  integer, intent(in) :: fid
341  integer, intent(in) :: nvars_limit
342  integer, intent(out) :: nvars
343 
344  integer :: error
345  !---------------------------------------------------------------------------
346 
347  if ( .not. file_opened(fid) ) then
348  log_error("FILE_get_var_num",*) 'File is not opened. fid = ', fid
349  call prc_abort
350  end if
351 
352  call file_get_nvars_c( file_files(fid)%fid, & ! (in)
353  nvars, error ) ! (out)
354 
355  if ( error /= file_success_code ) then
356  log_error("FILE_get_var_num",*) 'failed to get varnum. fid = ', fid
357  call prc_abort
358  end if
359 
360  if ( nvars > nvars_limit ) then
361  log_error("FILE_get_var_num",*) 'number of variables exceeds the requested size.', nvars, nvars_limit
362  call prc_abort
363  endif
364 
365  return
366  end subroutine file_get_var_num
367 
368  !-----------------------------------------------------------------------------
369  subroutine file_get_var_name( &
370  fid, cvid, &
371  varname )
372  implicit none
373 
374  integer, intent(in) :: fid
375  integer, intent(in) :: cvid
376  character(len=*), intent(out) :: varname
377 
378  integer :: error
379  !---------------------------------------------------------------------------
380 
381  if ( .not. file_opened(fid) ) then
382  log_error("FILE_get_var_name",*) 'File is not opened. fid = ', fid
383  call prc_abort
384  end if
385 
386  call file_get_varname_c( file_files(fid)%fid, cvid, & ! (in)
387  varname, error ) ! (out)
388 
389  if ( error /= file_success_code ) then
390  log_error("FILE_get_var_name",*) 'failed to get varname. cvid = ', cvid
391  call prc_abort
392  end if
393 
394  return
395  end subroutine file_get_var_name
396 
397  !-----------------------------------------------------------------------------
398  subroutine file_add_associatedvariable( fid, vname, existed )
399  integer, intent(in) :: fid
400  character(len=*), intent(in) :: vname
401  logical, optional, intent(out) :: existed
402 
403  integer :: error
404 
405  if ( .not. file_opened(fid) ) then
406  log_error("FILE_add_associatedVariable",*) 'File is not opened. fid = ', fid
407  call prc_abort
408  end if
409 
410  call file_add_associatedvariable_c( file_files(fid)%fid, vname , & ! (in)
411  error ) ! (out)
412 
413  if ( present(existed) ) then
414  if ( error == file_already_existed_code ) then
415  existed = .true.
416  return
417  end if
418  existed = .false.
419  end if
420 
421  if ( error /= file_success_code ) then
422  log_error("FILE_add_associatedvariable",*) 'failed to add associated variable: '//trim(vname)
423  call prc_abort
424  end if
425 
426  return
427  end subroutine file_add_associatedvariable
428 
429  !-----------------------------------------------------------------------------
430  subroutine file_set_option( &
431  fid, &
432  filetype, key, val )
433  integer, intent(in) :: fid
434  character(len=*), intent(in) :: filetype
435  character(len=*), intent(in) :: key
436  character(len=*), intent(in) :: val
437 
438  integer :: error
439 
440  if ( .not. file_opened(fid) ) then
441  log_error("FILE_set_option",*) 'File is not opened. fid = ', fid
442  call prc_abort
443  end if
444 
445  call file_set_option_c( file_files(fid)%fid, filetype, key, val, & ! (in)
446  error ) ! (out)
447  if ( error /= file_success_code ) then
448  log_error("FILE_set_option",*) 'failed to set option'
449  call prc_abort
450  end if
451 
452  return
453  end subroutine file_set_option
454 
455  !-----------------------------------------------------------------------------
456  subroutine file_open( &
457  basename, &
458  fid, &
459  mode, &
460  single, &
461  aggregate, &
462  rankid, &
463  postfix )
464  implicit none
465 
466  character(len=*), intent( in) :: basename
467  integer, intent(out) :: fid
468  integer, intent( in), optional :: mode
469  logical, intent( in), optional :: single
470  logical, intent( in), optional :: aggregate
471  integer, intent( in), optional :: rankid
472  character(len=*), intent( in), optional :: postfix
473 
474  integer :: mode_
475  integer :: rankid_
476  logical :: existed
477  logical :: single_
478 
479  single_ = .false.
480 
481  if ( present(mode) ) then
482  mode_ = mode
483  else
484  mode_ = file_fread
485  end if
486 
487  if ( present(single) ) single_ = single
488  if ( present(rankid) ) then
489  rankid_ = rankid
490  else
491  rankid_ = mpi_myrank
492  end if
493 
494  call file_get_fid( basename, mode_, rankid_, single_, & ! (in)
495  fid, existed, & ! (out)
496  aggregate=aggregate, postfix=postfix ) ! (in)
497 
498  return
499  end subroutine file_open
500 
501  !-----------------------------------------------------------------------------
503  function file_opened( fid )
504  implicit none
505 
506  integer, intent( in) :: fid
507  logical :: FILE_opened
508 
509  if ( fid < 1 ) then
510  file_opened = .false.
511  else
512  file_opened = file_files(fid)%fid >= 0
513  end if
514 
515  return
516  end function file_opened
517 
518  !-----------------------------------------------------------------------------
520  !-----------------------------------------------------------------------------
521  subroutine file_get_dimlength( &
522  fid, dimname, &
523  len, &
524  error )
525  integer, intent(in) :: fid
526  character(len=*), intent(in) :: dimname
527 
528  integer, intent(out) :: len
529 
530  logical, intent(out), optional :: error
531 
532  integer :: ierror
533 
534 
535  if ( .not. file_opened(fid) ) then
536  log_error("FILE_get_dimLength",*) 'File is not opened. fid = ', fid
537  call prc_abort
538  end if
539 
540  call file_get_dim_length_c( file_files(fid)%fid, dimname, & ! (in)
541  len, ierror ) ! (out)
542  if ( ierror /= file_success_code .and. ierror /= file_already_existed_code ) then
543  if ( present(error) ) then
544  error = .true.
545  else
546  log_error("FILE_get_dimLength",*) 'failed to get dimension length'
547  call prc_abort
548  end if
549  else
550  if ( present(error) ) error = .false.
551  end if
552 
553  return
554  end subroutine file_get_dimlength
555 
556  !-----------------------------------------------------------------------------
557  ! interface FILE_PutAxis
558  !-----------------------------------------------------------------------------
559  subroutine file_put_axis_realsp( &
560  fid, &
561  name, desc, units, &
562  dim_name, dtype, &
563  val )
564  integer, intent(in) :: fid
565  character(len=*), intent(in) :: name
566  character(len=*), intent(in) :: desc
567  character(len=*), intent(in) :: units
568  character(len=*), intent(in) :: dim_name
569  integer, intent(in) :: dtype
570  real(SP), intent(in) :: val(:)
571 
572  integer :: error
573  intrinsic size
574 
575  if ( .not. file_opened(fid) ) then
576  log_error("FILE_put_axis_real",*) 'File is not opened. fid = ', fid
577  call prc_abort
578  end if
579 
580  call file_put_axis_c( file_files(fid)%fid, & ! (in)
581  name, desc, units, dim_name, dtype, val, size(val), sp, & ! (in)
582  error ) ! (out)
583  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
584  log_error("FILE_put_axis_realSP",*) 'failed to put axis'
585  call prc_abort
586  end if
587 
588  return
589  end subroutine file_put_axis_realsp
590  subroutine file_put_axis_realdp( &
591  fid, &
592  name, desc, units, &
593  dim_name, dtype, &
594  val )
595  integer, intent(in) :: fid
596  character(len=*), intent(in) :: name
597  character(len=*), intent(in) :: desc
598  character(len=*), intent(in) :: units
599  character(len=*), intent(in) :: dim_name
600  integer, intent(in) :: dtype
601  real(DP), intent(in) :: val(:)
602 
603  integer :: error
604  intrinsic size
605 
606  if ( .not. file_opened(fid) ) then
607  log_error("FILE_put_axis_real",*) 'File is not opened. fid = ', fid
608  call prc_abort
609  end if
610 
611  call file_put_axis_c( file_files(fid)%fid, & ! (in)
612  name, desc, units, dim_name, dtype, val, size(val), dp, & ! (in)
613  error ) ! (out)
614  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
615  log_error("FILE_put_axis_realDP",*) 'failed to put axis'
616  call prc_abort
617  end if
618 
619  return
620  end subroutine file_put_axis_realdp
621 
622  subroutine file_def_axis( &
623  fid, &
624  name, desc, units, &
625  dim_name, dtype, dim_size, &
626  bounds )
627  integer, intent(in) :: fid
628  character(len=*), intent(in) :: name
629  character(len=*), intent(in) :: desc
630  character(len=*), intent(in) :: units
631  character(len=*), intent(in) :: dim_name
632  integer, intent(in) :: dtype
633  integer, intent(in) :: dim_size
634 
635  logical, intent(in), optional :: bounds
636 
637  integer :: error
638  integer :: bounds_
639 
640  bounds_ = 0 ! .false.
641  if ( present(bounds) ) then
642  if ( bounds ) bounds_ = 1 ! .true.
643  end if
644 
645  if ( .not. file_opened(fid) ) then
646  log_error("FILE_def_axis",*) 'File is not opened. fid = ', fid
647  call prc_abort
648  end if
649 
650  call file_def_axis_c( file_files(fid)%fid, &
651  name, desc, units, dim_name, dtype, dim_size, bounds_, & ! (in)
652  error ) ! (out)
653  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
654  log_error("FILE_def_axis",*) 'failed to define axis'
655  call prc_abort
656  end if
657 
658  return
659  end subroutine file_def_axis
660 
661  !-----------------------------------------------------------------------------
662  ! interface FILE_WriteAxis
663  !-----------------------------------------------------------------------------
664  subroutine file_write_axis_realsp( &
665  fid, &
666  name, &
667  val, &
668  start )
669  integer, intent(in) :: fid
670  character(len=*), intent(in) :: name
671  real(SP), intent(in) :: val(:)
672  integer, intent(in), optional :: start(:)
673 
674  integer :: error
675  intrinsic shape
676 
677  if ( .not. file_opened(fid) ) then
678  log_error("FILE_write_axis_realSP",*) 'File is not opened. fid = ', fid
679  call prc_abort
680  end if
681 
682  if ( present(start) ) then
683  call file_write_axis_c( file_files(fid)%fid, & ! (in)
684  name, val, sp, start, shape(val), & ! (in)
685  error ) ! (out)
686  else
687  call file_write_axis_c( file_files(fid)%fid, & ! (in)
688  name, val, sp, (/1/), shape(val), & ! (in)
689  error ) ! (out)
690  end if
691  if ( error /= file_success_code ) then
692  log_error("FILE_write_axis_realSP",*) 'failed to write axis: '//trim(name)
693  call prc_abort
694  end if
695 
696  return
697  end subroutine file_write_axis_realsp
698  subroutine file_write_axis_realdp( &
699  fid, &
700  name, &
701  val, &
702  start )
703  integer, intent(in) :: fid
704  character(len=*), intent(in) :: name
705  real(DP), intent(in) :: val(:)
706  integer, intent(in), optional :: start(:)
707 
708  integer :: error
709  intrinsic shape
710 
711  if ( .not. file_opened(fid) ) then
712  log_error("FILE_write_axis_realDP",*) 'File is not opened. fid = ', fid
713  call prc_abort
714  end if
715 
716  if ( present(start) ) then
717  call file_write_axis_c( file_files(fid)%fid, & ! (in)
718  name, val, dp, start, shape(val), & ! (in)
719  error ) ! (out)
720  else
721  call file_write_axis_c( file_files(fid)%fid, & ! (in)
722  name, val, dp, (/1/), shape(val), & ! (in)
723  error ) ! (out)
724  end if
725  if ( error /= file_success_code ) then
726  log_error("FILE_write_axis_realDP",*) 'failed to write axis: '//trim(name)
727  call prc_abort
728  end if
729 
730  return
731  end subroutine file_write_axis_realdp
732 
733  !-----------------------------------------------------------------------------
734  ! interface FILE_put_associatedCoordinate
735  !-----------------------------------------------------------------------------
736  subroutine file_put_associatedcoordinate_realsp_1d( &
737  fid, &
738  name, desc, units, &
739  dim_names, dtype, &
740  val )
741  integer, intent(in) :: fid
742  character(len=*), intent(in) :: name
743  character(len=*), intent(in) :: desc
744  character(len=*), intent(in) :: units
745  character(len=*), intent(in) :: dim_names(:)
746  integer, intent(in) :: dtype
747  real(SP), intent(in) :: val(:)
748 
749  integer :: error
750  intrinsic size
751 
752  if ( .not. file_opened(fid) ) then
753  log_error("FILE_put_associatedCoordinate_realSP_1D",*) 'File is not opened. fid = ', fid
754  call prc_abort
755  end if
756 
757  call file_put_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
758  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
759  val, sp, & ! (in)
760  error ) ! (out)
761  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
762  log_error("FILE_put_associatedCoordinate_realSP_1D",*) 'failed to put associated coordinate: '//trim(name)
763  call prc_abort
764  end if
765 
766  return
767  end subroutine file_put_associatedcoordinate_realsp_1d
768  subroutine file_put_associatedcoordinate_realdp_1d( &
769  fid, &
770  name, desc, units, &
771  dim_names, dtype, &
772  val )
773  integer, intent(in) :: fid
774  character(len=*), intent(in) :: name
775  character(len=*), intent(in) :: desc
776  character(len=*), intent(in) :: units
777  character(len=*), intent(in) :: dim_names(:)
778  integer, intent(in) :: dtype
779  real(DP), intent(in) :: val(:)
780 
781  integer :: error
782  intrinsic size
783 
784  if ( .not. file_opened(fid) ) then
785  log_error("FILE_put_associatedCoordinate_realDP_1D",*) 'File is not opened. fid = ', fid
786  call prc_abort
787  end if
788 
789  call file_put_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
790  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
791  val, dp, & ! (in)
792  error ) ! (out)
793  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
794  log_error("FILE_put_associatedCoordinate_realDP_1D",*) 'failed to put associated coordinate: '//trim(name)
795  call prc_abort
796  end if
797 
798  return
799  end subroutine file_put_associatedcoordinate_realdp_1d
800  subroutine file_put_associatedcoordinate_realsp_2d( &
801  fid, &
802  name, desc, units, &
803  dim_names, dtype, &
804  val )
805  integer, intent(in) :: fid
806  character(len=*), intent(in) :: name
807  character(len=*), intent(in) :: desc
808  character(len=*), intent(in) :: units
809  character(len=*), intent(in) :: dim_names(:)
810  integer, intent(in) :: dtype
811  real(SP), intent(in) :: val(:,:)
812 
813  integer :: error
814  intrinsic size
815 
816  if ( .not. file_opened(fid) ) then
817  log_error("FILE_put_associatedCoordinate_realSP_2D",*) 'File is not opened. fid = ', fid
818  call prc_abort
819  end if
820 
821  call file_put_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
822  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
823  val, sp, & ! (in)
824  error ) ! (out)
825  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
826  log_error("FILE_put_associatedCoordinate_realSP_2D",*) 'failed to put associated coordinate: '//trim(name)
827  call prc_abort
828  end if
829 
830  return
831  end subroutine file_put_associatedcoordinate_realsp_2d
832  subroutine file_put_associatedcoordinate_realdp_2d( &
833  fid, &
834  name, desc, units, &
835  dim_names, dtype, &
836  val )
837  integer, intent(in) :: fid
838  character(len=*), intent(in) :: name
839  character(len=*), intent(in) :: desc
840  character(len=*), intent(in) :: units
841  character(len=*), intent(in) :: dim_names(:)
842  integer, intent(in) :: dtype
843  real(DP), intent(in) :: val(:,:)
844 
845  integer :: error
846  intrinsic size
847 
848  if ( .not. file_opened(fid) ) then
849  log_error("FILE_put_associatedCoordinate_realDP_2D",*) 'File is not opened. fid = ', fid
850  call prc_abort
851  end if
852 
853  call file_put_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
854  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
855  val, dp, & ! (in)
856  error ) ! (out)
857  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
858  log_error("FILE_put_associatedCoordinate_realDP_2D",*) 'failed to put associated coordinate: '//trim(name)
859  call prc_abort
860  end if
861 
862  return
863  end subroutine file_put_associatedcoordinate_realdp_2d
864  subroutine file_put_associatedcoordinate_realsp_3d( &
865  fid, &
866  name, desc, units, &
867  dim_names, dtype, &
868  val )
869  integer, intent(in) :: fid
870  character(len=*), intent(in) :: name
871  character(len=*), intent(in) :: desc
872  character(len=*), intent(in) :: units
873  character(len=*), intent(in) :: dim_names(:)
874  integer, intent(in) :: dtype
875  real(SP), intent(in) :: val(:,:,:)
876 
877  integer :: error
878  intrinsic size
879 
880  if ( .not. file_opened(fid) ) then
881  log_error("FILE_put_associatedCoordinate_realSP_3D",*) 'File is not opened. fid = ', fid
882  call prc_abort
883  end if
884 
885  call file_put_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
886  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
887  val, sp, & ! (in)
888  error ) ! (out)
889  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
890  log_error("FILE_put_associatedCoordinate_realSP_3D",*) 'failed to put associated coordinate: '//trim(name)
891  call prc_abort
892  end if
893 
894  return
895  end subroutine file_put_associatedcoordinate_realsp_3d
896  subroutine file_put_associatedcoordinate_realdp_3d( &
897  fid, &
898  name, desc, units, &
899  dim_names, dtype, &
900  val )
901  integer, intent(in) :: fid
902  character(len=*), intent(in) :: name
903  character(len=*), intent(in) :: desc
904  character(len=*), intent(in) :: units
905  character(len=*), intent(in) :: dim_names(:)
906  integer, intent(in) :: dtype
907  real(DP), intent(in) :: val(:,:,:)
908 
909  integer :: error
910  intrinsic size
911 
912  if ( .not. file_opened(fid) ) then
913  log_error("FILE_put_associatedCoordinate_realDP_3D",*) 'File is not opened. fid = ', fid
914  call prc_abort
915  end if
916 
917  call file_put_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
918  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
919  val, dp, & ! (in)
920  error ) ! (out)
921  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
922  log_error("FILE_put_associatedCoordinate_realDP_3D",*) 'failed to put associated coordinate: '//trim(name)
923  call prc_abort
924  end if
925 
926  return
927  end subroutine file_put_associatedcoordinate_realdp_3d
928  subroutine file_put_associatedcoordinate_realsp_4d( &
929  fid, &
930  name, desc, units, &
931  dim_names, dtype, &
932  val )
933  integer, intent(in) :: fid
934  character(len=*), intent(in) :: name
935  character(len=*), intent(in) :: desc
936  character(len=*), intent(in) :: units
937  character(len=*), intent(in) :: dim_names(:)
938  integer, intent(in) :: dtype
939  real(SP), intent(in) :: val(:,:,:,:)
940 
941  integer :: error
942  intrinsic size
943 
944  if ( .not. file_opened(fid) ) then
945  log_error("FILE_put_associatedCoordinate_realSP_4D",*) 'File is not opened. fid = ', fid
946  call prc_abort
947  end if
948 
949  call file_put_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
950  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
951  val, sp, & ! (in)
952  error ) ! (out)
953  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
954  log_error("FILE_put_associatedCoordinate_realSP_4D",*) 'failed to put associated coordinate: '//trim(name)
955  call prc_abort
956  end if
957 
958  return
959  end subroutine file_put_associatedcoordinate_realsp_4d
960  subroutine file_put_associatedcoordinate_realdp_4d( &
961  fid, &
962  name, desc, units, &
963  dim_names, dtype, &
964  val )
965  integer, intent(in) :: fid
966  character(len=*), intent(in) :: name
967  character(len=*), intent(in) :: desc
968  character(len=*), intent(in) :: units
969  character(len=*), intent(in) :: dim_names(:)
970  integer, intent(in) :: dtype
971  real(DP), intent(in) :: val(:,:,:,:)
972 
973  integer :: error
974  intrinsic size
975 
976  if ( .not. file_opened(fid) ) then
977  log_error("FILE_put_associatedCoordinate_realDP_4D",*) 'File is not opened. fid = ', fid
978  call prc_abort
979  end if
980 
981  call file_put_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
982  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
983  val, dp, & ! (in)
984  error ) ! (out)
985  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
986  log_error("FILE_put_associatedCoordinate_realDP_4D",*) 'failed to put associated coordinate: '//trim(name)
987  call prc_abort
988  end if
989 
990  return
991  end subroutine file_put_associatedcoordinate_realdp_4d
992 
993  subroutine file_def_associatedcoordinate( &
994  fid, &
995  name, desc, units, &
996  dim_names, dtype )
997  integer, intent(in) :: fid
998  character(len=*), intent(in) :: name
999  character(len=*), intent(in) :: desc
1000  character(len=*), intent(in) :: units
1001  character(len=*), intent(in) :: dim_names(:)
1002  integer, intent(in) :: dtype
1003 
1004  integer :: error
1005  intrinsic size
1006 
1007  if ( .not. file_opened(fid) ) then
1008  log_error("FILE_def_associatedCoordinate",*) 'File is not opened. fid = ', fid
1009  call prc_abort
1010  end if
1011 
1012  call file_def_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1013  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
1014  error ) ! (out)
1015  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
1016  log_error("FILE_def_associatedCoordinate",*) 'failed to put associated coordinate: '//trim(name)
1017  call prc_abort
1018  end if
1019 
1020  return
1021  end subroutine file_def_associatedcoordinate
1022 
1023  !-----------------------------------------------------------------------------
1024  ! interface FILE_write_associatedCoordinate
1025  !-----------------------------------------------------------------------------
1026  subroutine file_write_associatedcoordinate_realsp_1d( &
1027  fid, &
1028  name, &
1029  val, &
1030  start, count, &
1031  ndims )
1032  integer, intent(in) :: fid
1033  character(len=*), intent(in) :: name
1034  real(SP), intent(in) :: val(:)
1035  integer, intent(in), optional :: start(:)
1036  integer, intent(in), optional :: count(:) ! in case val has been reshaped
1037  integer, intent(in), optional :: ndims ! in case val has been reshaped
1038 
1039  integer :: error
1040  intrinsic shape
1041 
1042  if ( .not. file_opened(fid) ) then
1043  log_error("FILE_write_associatedCoordinate_realSP_1D",*) 'File is not opened. fid = ', fid
1044  call prc_abort
1045  end if
1046 
1047  if ( present(ndims) ) then
1048  ! Note this is called for history coordinates which have been reshaped
1049  ! from 2D/3D into 1D array. In this case, start and count must be also present
1050  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1051  name, val, sp, & ! (in)
1052  ndims, start, count, & ! (in)
1053  error ) ! (out)
1054  else if ( present(start) ) then
1055  ! Note this is called for restart coordinates
1056  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1057  name, val, sp, & ! (in)
1058  1, start, shape(val), & ! (in)
1059  error ) ! (out)
1060  else
1061  ! Note this is for the one-file-per-process I/O method
1062  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1063  name, val, sp, & ! (in)
1064  1, (/1/), shape(val), & ! (in)
1065  error ) ! (out)
1066  end if
1067  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
1068  log_error("FILE_write_associatedCoordinate_realSP_1D",*) 'failed to put associated coordinate: '//trim(name)
1069  call prc_abort
1070  end if
1071 
1072  return
1073  end subroutine file_write_associatedcoordinate_realsp_1d
1074  subroutine file_write_associatedcoordinate_realdp_1d( &
1075  fid, &
1076  name, &
1077  val, &
1078  start, count, &
1079  ndims )
1080  integer, intent(in) :: fid
1081  character(len=*), intent(in) :: name
1082  real(DP), intent(in) :: val(:)
1083  integer, intent(in), optional :: start(:)
1084  integer, intent(in), optional :: count(:) ! in case val has been reshaped
1085  integer, intent(in), optional :: ndims ! in case val has been reshaped
1086 
1087  integer :: error
1088  intrinsic shape
1089 
1090  if ( .not. file_opened(fid) ) then
1091  log_error("FILE_write_associatedCoordinate_realDP_1D",*) 'File is not opened. fid = ', fid
1092  call prc_abort
1093  end if
1094 
1095  if ( present(ndims) ) then
1096  ! Note this is called for history coordinates which have been reshaped
1097  ! from 2D/3D into 1D array. In this case, start and count must be also present
1098  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1099  name, val, dp, & ! (in)
1100  ndims, start, count, & ! (in)
1101  error ) ! (out)
1102  else if ( present(start) ) then
1103  ! Note this is called for restart coordinates
1104  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1105  name, val, dp, & ! (in)
1106  1, start, shape(val), & ! (in)
1107  error ) ! (out)
1108  else
1109  ! Note this is for the one-file-per-process I/O method
1110  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1111  name, val, dp, & ! (in)
1112  1, (/1/), shape(val), & ! (in)
1113  error ) ! (out)
1114  end if
1115  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
1116  log_error("FILE_write_associatedCoordinate_realDP_1D",*) 'failed to put associated coordinate: '//trim(name)
1117  call prc_abort
1118  end if
1119 
1120  return
1121  end subroutine file_write_associatedcoordinate_realdp_1d
1122  subroutine file_write_associatedcoordinate_realsp_2d( &
1123  fid, &
1124  name, &
1125  val, &
1126  start, count, &
1127  ndims )
1128  integer, intent(in) :: fid
1129  character(len=*), intent(in) :: name
1130  real(SP), intent(in) :: val(:,:)
1131  integer, intent(in), optional :: start(:)
1132  integer, intent(in), optional :: count(:) ! in case val has been reshaped
1133  integer, intent(in), optional :: ndims ! in case val has been reshaped
1134 
1135  integer :: error
1136  intrinsic shape
1137 
1138  if ( .not. file_opened(fid) ) then
1139  log_error("FILE_write_associatedCoordinate_realSP_2D",*) 'File is not opened. fid = ', fid
1140  call prc_abort
1141  end if
1142 
1143  if ( present(ndims) ) then
1144  ! Note this is called for history coordinates which have been reshaped
1145  ! from 2D/3D into 1D array. In this case, start and count must be also present
1146  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1147  name, val, sp, & ! (in)
1148  ndims, start, count, & ! (in)
1149  error ) ! (out)
1150  else if ( present(start) ) then
1151  ! Note this is called for restart coordinates
1152  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1153  name, val, sp, & ! (in)
1154  2, start, shape(val), & ! (in)
1155  error ) ! (out)
1156  else
1157  ! Note this is for the one-file-per-process I/O method
1158  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1159  name, val, sp, & ! (in)
1160  2, (/1,1/), shape(val), & ! (in)
1161  error ) ! (out)
1162  end if
1163  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
1164  log_error("FILE_write_associatedCoordinate_realSP_2D",*) 'failed to put associated coordinate: '//trim(name)
1165  call prc_abort
1166  end if
1167 
1168  return
1169  end subroutine file_write_associatedcoordinate_realsp_2d
1170  subroutine file_write_associatedcoordinate_realdp_2d( &
1171  fid, &
1172  name, &
1173  val, &
1174  start, count, &
1175  ndims )
1176  integer, intent(in) :: fid
1177  character(len=*), intent(in) :: name
1178  real(DP), intent(in) :: val(:,:)
1179  integer, intent(in), optional :: start(:)
1180  integer, intent(in), optional :: count(:) ! in case val has been reshaped
1181  integer, intent(in), optional :: ndims ! in case val has been reshaped
1182 
1183  integer :: error
1184  intrinsic shape
1185 
1186  if ( .not. file_opened(fid) ) then
1187  log_error("FILE_write_associatedCoordinate_realDP_2D",*) 'File is not opened. fid = ', fid
1188  call prc_abort
1189  end if
1190 
1191  if ( present(ndims) ) then
1192  ! Note this is called for history coordinates which have been reshaped
1193  ! from 2D/3D into 1D array. In this case, start and count must be also present
1194  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1195  name, val, dp, & ! (in)
1196  ndims, start, count, & ! (in)
1197  error ) ! (out)
1198  else if ( present(start) ) then
1199  ! Note this is called for restart coordinates
1200  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1201  name, val, dp, & ! (in)
1202  2, start, shape(val), & ! (in)
1203  error ) ! (out)
1204  else
1205  ! Note this is for the one-file-per-process I/O method
1206  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1207  name, val, dp, & ! (in)
1208  2, (/1,1/), shape(val), & ! (in)
1209  error ) ! (out)
1210  end if
1211  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
1212  log_error("FILE_write_associatedCoordinate_realDP_2D",*) 'failed to put associated coordinate: '//trim(name)
1213  call prc_abort
1214  end if
1215 
1216  return
1217  end subroutine file_write_associatedcoordinate_realdp_2d
1218  subroutine file_write_associatedcoordinate_realsp_3d( &
1219  fid, &
1220  name, &
1221  val, &
1222  start, count, &
1223  ndims )
1224  integer, intent(in) :: fid
1225  character(len=*), intent(in) :: name
1226  real(SP), intent(in) :: val(:,:,:)
1227  integer, intent(in), optional :: start(:)
1228  integer, intent(in), optional :: count(:) ! in case val has been reshaped
1229  integer, intent(in), optional :: ndims ! in case val has been reshaped
1230 
1231  integer :: error
1232  intrinsic shape
1233 
1234  if ( .not. file_opened(fid) ) then
1235  log_error("FILE_write_associatedCoordinate_realSP_3D",*) 'File is not opened. fid = ', fid
1236  call prc_abort
1237  end if
1238 
1239  if ( present(ndims) ) then
1240  ! Note this is called for history coordinates which have been reshaped
1241  ! from 2D/3D into 1D array. In this case, start and count must be also present
1242  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1243  name, val, sp, & ! (in)
1244  ndims, start, count, & ! (in)
1245  error ) ! (out)
1246  else if ( present(start) ) then
1247  ! Note this is called for restart coordinates
1248  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1249  name, val, sp, & ! (in)
1250  3, start, shape(val), & ! (in)
1251  error ) ! (out)
1252  else
1253  ! Note this is for the one-file-per-process I/O method
1254  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1255  name, val, sp, & ! (in)
1256  3, (/1,1,1/), shape(val), & ! (in)
1257  error ) ! (out)
1258  end if
1259  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
1260  log_error("FILE_write_associatedCoordinate_realSP_3D",*) 'failed to put associated coordinate: '//trim(name)
1261  call prc_abort
1262  end if
1263 
1264  return
1265  end subroutine file_write_associatedcoordinate_realsp_3d
1266  subroutine file_write_associatedcoordinate_realdp_3d( &
1267  fid, &
1268  name, &
1269  val, &
1270  start, count, &
1271  ndims )
1272  integer, intent(in) :: fid
1273  character(len=*), intent(in) :: name
1274  real(DP), intent(in) :: val(:,:,:)
1275  integer, intent(in), optional :: start(:)
1276  integer, intent(in), optional :: count(:) ! in case val has been reshaped
1277  integer, intent(in), optional :: ndims ! in case val has been reshaped
1278 
1279  integer :: error
1280  intrinsic shape
1281 
1282  if ( .not. file_opened(fid) ) then
1283  log_error("FILE_write_associatedCoordinate_realDP_3D",*) 'File is not opened. fid = ', fid
1284  call prc_abort
1285  end if
1286 
1287  if ( present(ndims) ) then
1288  ! Note this is called for history coordinates which have been reshaped
1289  ! from 2D/3D into 1D array. In this case, start and count must be also present
1290  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1291  name, val, dp, & ! (in)
1292  ndims, start, count, & ! (in)
1293  error ) ! (out)
1294  else if ( present(start) ) then
1295  ! Note this is called for restart coordinates
1296  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1297  name, val, dp, & ! (in)
1298  3, start, shape(val), & ! (in)
1299  error ) ! (out)
1300  else
1301  ! Note this is for the one-file-per-process I/O method
1302  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1303  name, val, dp, & ! (in)
1304  3, (/1,1,1/), shape(val), & ! (in)
1305  error ) ! (out)
1306  end if
1307  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
1308  log_error("FILE_write_associatedCoordinate_realDP_3D",*) 'failed to put associated coordinate: '//trim(name)
1309  call prc_abort
1310  end if
1311 
1312  return
1313  end subroutine file_write_associatedcoordinate_realdp_3d
1314  subroutine file_write_associatedcoordinate_realsp_4d( &
1315  fid, &
1316  name, &
1317  val, &
1318  start, count, &
1319  ndims )
1320  integer, intent(in) :: fid
1321  character(len=*), intent(in) :: name
1322  real(SP), intent(in) :: val(:,:,:,:)
1323  integer, intent(in), optional :: start(:)
1324  integer, intent(in), optional :: count(:) ! in case val has been reshaped
1325  integer, intent(in), optional :: ndims ! in case val has been reshaped
1326 
1327  integer :: error
1328  intrinsic shape
1329 
1330  if ( .not. file_opened(fid) ) then
1331  log_error("FILE_write_associatedCoordinate_realSP_4D",*) 'File is not opened. fid = ', fid
1332  call prc_abort
1333  end if
1334 
1335  if ( present(ndims) ) then
1336  ! Note this is called for history coordinates which have been reshaped
1337  ! from 2D/3D into 1D array. In this case, start and count must be also present
1338  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1339  name, val, sp, & ! (in)
1340  ndims, start, count, & ! (in)
1341  error ) ! (out)
1342  else if ( present(start) ) then
1343  ! Note this is called for restart coordinates
1344  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1345  name, val, sp, & ! (in)
1346  4, start, shape(val), & ! (in)
1347  error ) ! (out)
1348  else
1349  ! Note this is for the one-file-per-process I/O method
1350  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1351  name, val, sp, & ! (in)
1352  4, (/1,1,1,1/), shape(val), & ! (in)
1353  error ) ! (out)
1354  end if
1355  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
1356  log_error("FILE_write_associatedCoordinate_realSP_4D",*) 'failed to put associated coordinate: '//trim(name)
1357  call prc_abort
1358  end if
1359 
1360  return
1361  end subroutine file_write_associatedcoordinate_realsp_4d
1362  subroutine file_write_associatedcoordinate_realdp_4d( &
1363  fid, &
1364  name, &
1365  val, &
1366  start, count, &
1367  ndims )
1368  integer, intent(in) :: fid
1369  character(len=*), intent(in) :: name
1370  real(DP), intent(in) :: val(:,:,:,:)
1371  integer, intent(in), optional :: start(:)
1372  integer, intent(in), optional :: count(:) ! in case val has been reshaped
1373  integer, intent(in), optional :: ndims ! in case val has been reshaped
1374 
1375  integer :: error
1376  intrinsic shape
1377 
1378  if ( .not. file_opened(fid) ) then
1379  log_error("FILE_write_associatedCoordinate_realDP_4D",*) 'File is not opened. fid = ', fid
1380  call prc_abort
1381  end if
1382 
1383  if ( present(ndims) ) then
1384  ! Note this is called for history coordinates which have been reshaped
1385  ! from 2D/3D into 1D array. In this case, start and count must be also present
1386  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1387  name, val, dp, & ! (in)
1388  ndims, start, count, & ! (in)
1389  error ) ! (out)
1390  else if ( present(start) ) then
1391  ! Note this is called for restart coordinates
1392  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1393  name, val, dp, & ! (in)
1394  4, start, shape(val), & ! (in)
1395  error ) ! (out)
1396  else
1397  ! Note this is for the one-file-per-process I/O method
1398  call file_write_associatedcoordinate_c( file_files(fid)%fid, & ! (in)
1399  name, val, dp, & ! (in)
1400  4, (/1,1,1,1/), shape(val), & ! (in)
1401  error ) ! (out)
1402  end if
1403  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
1404  log_error("FILE_write_associatedCoordinate_realDP_4D",*) 'failed to put associated coordinate: '//trim(name)
1405  call prc_abort
1406  end if
1407 
1408  return
1409  end subroutine file_write_associatedcoordinate_realdp_4d
1410 
1411  !-----------------------------------------------------------------------------
1412  ! interface FILE_add_variable
1413  !-----------------------------------------------------------------------------
1414  subroutine file_add_variable_no_time( &
1415  fid, &
1416  varname, desc, units, &
1417  standard_name, &
1418  dims, dtype, &
1419  vid, &
1420  time_avg )
1421  integer, intent( in) :: fid
1422  character(len=*), intent( in) :: varname
1423  character(len=*), intent( in) :: desc
1424  character(len=*), intent( in) :: units
1425  character(len=*), intent( in) :: standard_name
1426  character(len=*), intent( in) :: dims(:)
1427  integer, intent( in) :: dtype
1428  integer, intent(out) :: vid
1429  logical, intent( in), optional :: time_avg
1430 
1431  if ( .not. file_opened(fid) ) then
1432  log_error("FILE_add_variable_no_time",*) 'File is not opened. fid = ', fid
1433  call prc_abort
1434  end if
1435 
1436  call file_add_variable_with_time( fid, & ! (in)
1437  varname, desc, units, standard_name, & ! (in)
1438  dims, dtype, -1.0_dp, & ! (in)
1439  vid, & ! (out)
1440  time_avg = time_avg ) ! (in)
1441 
1442  return
1443  end subroutine file_add_variable_no_time
1444 
1445  !-----------------------------------------------------------------------------
1446  subroutine file_add_variable_with_time( &
1447  fid, &
1448  varname, desc, units, &
1449  standard_name, &
1450  dims, dtype, &
1451  time_int, &
1452  vid, &
1453  time_avg )
1454  implicit none
1455  integer, intent(in) :: fid
1456  character(len=*), intent(in) :: varname
1457  character(len=*), intent(in) :: desc
1458  character(len=*), intent(in) :: units
1459  character(len=*), intent(in) :: standard_name
1460  character(len=*), intent(in) :: dims(:)
1461  integer, intent(in) :: dtype
1462  real(DP), intent(in) :: time_int
1463 
1464  integer, intent(out) :: vid
1465 
1466  logical, intent(in), optional :: time_avg
1467 
1468  integer :: cvid
1469  integer :: ndims
1470  integer :: itavg
1471  integer :: error
1472  integer :: n
1473 
1474  intrinsic size
1475  !---------------------------------------------------------------------------
1476 
1477  if ( .not. file_opened(fid) ) then
1478  log_error("FILE_add_variable_with_time",*) 'File is not opened. fid = ', fid
1479  call prc_abort
1480  end if
1481 
1482  vid = -1
1483  do n = 1, file_nvars
1484  if ( file_vars(n)%fid == fid .and. file_vars(n)%name == varname ) then
1485  vid = file_vars(n)%vid
1486  exit
1487  endif
1488  enddo
1489 
1490  if ( vid < 0 ) then ! variable registration
1491 
1492  ndims = size(dims)
1493  itavg = 0
1494 
1495  if ( present(time_avg) ) then
1496  if( time_avg ) itavg = 1
1497  endif
1498 
1499  call file_add_variable_c( file_files(fid)%fid, & ! [IN]
1500  varname, desc, units, standard_name, & ! [IN]
1501  dims, ndims, dtype, time_int, itavg, & ! [IN]
1502  cvid, error ) ! [OUT]
1503 
1504  if ( error /= file_success_code ) then
1505  log_error("FILE_add_variable_with_time",*) 'failed to add variable: '//trim(varname)
1506  call prc_abort
1507  endif
1508 
1509  file_nvars = file_nvars + 1
1510  vid = file_nvars
1511  file_vars(vid)%name = varname
1512  file_vars(vid)%vid = cvid
1513  file_vars(vid)%fid = fid
1514 
1515  log_info("FILE_add_variable_with_time",'(1x,A,I3.3,A,I4.4,2A)') &
1516  'Variable registration : NO.', fid, ', vid = ', vid, ', name = ', trim(varname)
1517  endif
1518 
1519  return
1520  end subroutine file_add_variable_with_time
1521 
1522  subroutine file_def_variable( &
1523  fid, &
1524  varname, desc, units, &
1525  standard_name, &
1526  ndims, dims, &
1527  dtype, &
1528  vid, &
1529  time_int, time_avg, &
1530  existed )
1531  integer, intent( in) :: fid
1532  character(len=*), intent( in) :: varname
1533  character(len=*), intent( in) :: desc
1534  character(len=*), intent( in) :: units
1535  character(len=*), intent( in) :: standard_name
1536  integer, intent( in) :: ndims
1537  character(len=*), intent( in) :: dims(:)
1538  integer, intent( in) :: dtype
1539  integer, intent(out) :: vid
1540  real(DP), intent( in), optional :: time_int
1541  logical, intent( in), optional :: time_avg
1542  logical, intent(out), optional :: existed
1543 
1544  real(DP) :: tint_
1545  integer :: itavg
1546  integer :: cvid
1547  integer :: error
1548  integer :: n
1549 
1550  !---------------------------------------------------------------------------
1551 
1552  if ( .not. file_opened(fid) ) then
1553  log_error("FILE_def_variable",*) 'File is not opened. fid = ', fid
1554  call prc_abort
1555  end if
1556 
1557  vid = -1
1558  do n = 1, file_nvars
1559  if ( file_vars(n)%fid == fid .and. file_vars(n)%name == varname ) then
1560  vid = n
1561  end if
1562  enddo
1563 
1564  if ( vid < 0 ) then ! variable registration
1565 
1566  if ( present(time_int) ) then
1567  tint_ = time_int
1568  else
1569  tint_ = -1.0_dp
1570  endif
1571 
1572  if ( present(time_avg) ) then
1573  if ( time_avg ) then
1574  itavg = 1
1575  else
1576  itavg = 0
1577  end if
1578  else
1579  itavg = 0
1580  end if
1581 
1582  call file_add_variable_c( file_files(fid)%fid, & ! (in)
1583  varname, desc, units, standard_name, & ! (in)
1584  dims, ndims, dtype, & ! (in)
1585  tint_, itavg, & ! (in)
1586  cvid, error ) ! (out)
1587  if ( error /= file_success_code ) then
1588  log_error("FILE_def_variable",*) 'failed to add variable: '//trim(varname)
1589  call prc_abort
1590  end if
1591 
1592  file_nvars = file_nvars + 1
1593  vid = file_nvars
1594  file_vars(vid)%name = varname
1595  file_vars(vid)%vid = cvid
1596  file_vars(vid)%fid = fid
1597 
1598  log_info("FILE_def_variable",'(1x,A,I3.3,A,I4.4,2A)') &
1599  'Variable registration : NO.', fid, ', vid = ', vid, ', name = ', trim(varname)
1600 
1601  if ( present(existed) ) existed = .false.
1602  else
1603  if ( present(existed) ) existed = .true.
1604  endif
1605 
1606  return
1607  end subroutine file_def_variable
1608 
1609  !-----------------------------------------------------------------------------
1610  ! FILE_Get_Attribute
1611  !-----------------------------------------------------------------------------
1612  subroutine file_get_attribute_text_fid( &
1613  fid, &
1614  vname, key, &
1615  val, &
1616  existed )
1617  integer, intent(in ) :: fid
1618  character(len=*), intent(in ) :: vname
1619  character(len=*), intent(in ) :: key
1620  character(len=*), intent(out) :: val
1621 
1622  logical, intent(out), optional :: existed
1623 
1624  integer :: suppress
1625  integer :: error
1626 
1627  if ( .not. file_opened(fid) ) then
1628  log_error("FILE_get_attribute_text_fid",*) 'File is not opened. fid = ', fid
1629  call prc_abort
1630  end if
1631 
1632  if ( present(existed) ) then
1633  suppress = 1
1634  else
1635  suppress = 0
1636  end if
1637  call file_get_attribute_text_c( &
1638  file_files(fid)%fid, vname, & ! (in)
1639  key, suppress, & ! (in)
1640  val, error ) ! (out)
1641  if ( error /= file_success_code ) then
1642  if ( present(existed) ) then
1643  existed = .false.
1644  else
1645  log_error("FILE_get_attribute_text_fid",*) 'failed to get text attribute for '//trim(vname)//': '//trim(key)
1646  call prc_abort
1647  end if
1648  else
1649  if ( present(existed) ) existed = .true.
1650  end if
1651 
1652  return
1653  end subroutine file_get_attribute_text_fid
1654  subroutine file_get_attribute_text_fname( &
1655  basename, vname, key, &
1656  val, &
1657  single, aggregate, rankid, &
1658  existed )
1659  implicit none
1660 
1661  character(len=*), intent(in) :: basename
1662  character(len=*), intent(in) :: vname
1663  character(len=*), intent(in) :: key
1664 
1665  character(len=*), intent(out) :: val
1666 
1667  logical, intent(in), optional :: single
1668  logical, intent(in), optional :: aggregate
1669  integer, intent(in), optional :: rankid
1670 
1671  logical, intent(out), optional :: existed
1672  integer :: fid
1673 
1674  call file_open( basename, & ! (in)
1675  fid, & ! (out)
1676  single=single, & ! (in)
1677  aggregate=aggregate, & ! (in)
1678  rankid=rankid ) ! (in)
1679 
1680  call file_get_attribute_text_fid( &
1681  fid, vname, key, & ! (in)
1682  val, & ! (out)
1683  existed ) ! (out)
1684 
1685  return
1686  end subroutine file_get_attribute_text_fname
1687 
1688  !-----------------------------------------------------------------------------
1689  subroutine file_get_attribute_logical_fid( &
1690  fid, &
1691  vname, key, &
1692  val, &
1693  existed )
1694  integer, intent(in ) :: fid
1695  character(len=*), intent(in ) :: vname
1696  character(len=*), intent(in ) :: key
1697  logical, intent(out) :: val
1698 
1699  logical, intent(out), optional :: existed
1700 
1701  character(len=5) :: buf
1702 
1703  if ( .not. file_opened(fid) ) then
1704  log_error("FILE_get_attribute_logical_fid",*) 'File is not opened. fid = ', fid
1705  call prc_abort
1706  end if
1707 
1708  call file_get_attribute_text_fid( fid, vname, key, & ! (in)
1709  buf, existed ) ! (out)
1710 
1711  if ( present(existed) ) then
1712  if ( .not. existed ) return
1713  end if
1714 
1715  if ( buf == "true" ) then
1716  val = .true.
1717  else if ( buf == "false" ) then
1718  val = .false.
1719  else
1720  log_error("FILE_get_attribute_logical_fid",*) 'value is not eigher true or false'
1721  call prc_abort
1722  end if
1723 
1724  return
1725  end subroutine file_get_attribute_logical_fid
1726  subroutine file_get_attribute_logical_fname( &
1727  basename, vname, key, &
1728  val, &
1729  single, aggregate, rankid, &
1730  existed )
1731  implicit none
1732 
1733  character(len=*), intent(in) :: basename
1734  character(len=*), intent(in) :: vname
1735  character(len=*), intent(in) :: key
1736 
1737  logical, intent(out) :: val
1738 
1739  logical, intent(in), optional :: single
1740  logical, intent(in), optional :: aggregate
1741  integer, intent(in), optional :: rankid
1742 
1743  logical, intent(out), optional :: existed
1744  integer :: fid
1745 
1746  call file_open( basename, & ! (in)
1747  fid, & ! (out)
1748  single=single, & ! (in)
1749  aggregate=aggregate, & ! (in)
1750  rankid=rankid ) ! (in)
1751 
1752  call file_get_attribute_logical_fid( &
1753  fid, vname, key, & ! (in)
1754  val, & ! (out)
1755  existed ) ! (out)
1756 
1757  return
1758  end subroutine file_get_attribute_logical_fname
1759 
1760  !-----------------------------------------------------------------------------
1761  subroutine file_get_attribute_int_fid( &
1762  fid, vname, key, &
1763  val, &
1764  existed )
1765  integer, intent(in ) :: fid
1766  character(len=*), intent(in ) :: vname
1767  character(len=*), intent(in ) :: key
1768  integer, intent(out) :: val(:)
1769 
1770  logical, intent(out), optional :: existed
1771 
1772  integer :: suppress
1773  integer :: error
1774 
1775  intrinsic size
1776 
1777  if ( .not. file_opened(fid) ) then
1778  log_error("FILE_get_attribute_int_fid",*) 'File is not opened. fid = ', fid
1779  call prc_abort
1780  end if
1781 
1782  if ( present(existed) ) then
1783  suppress = 1
1784  else
1785  suppress = 0
1786  end if
1787  call file_get_attribute_int_c( &
1788  file_files(fid)%fid, vname, & ! (in)
1789  key, size(val), suppress, & ! (in)
1790  val, error ) ! (out)
1791  if ( error /= file_success_code ) then
1792  if ( present(existed) ) then
1793  existed = .false.
1794  else
1795  log_error("FILE_get_attribute_int_fid",*) 'failed to get integer attribute for '//trim(vname)//': '//trim(key)
1796  call prc_abort
1797  end if
1798  else
1799  if ( present(existed) ) existed = .true.
1800  end if
1801 
1802  return
1803  end subroutine file_get_attribute_int_fid
1804  subroutine file_get_attribute_int_fname( &
1805  basename, vname, key, &
1806  val, &
1807  single, aggregate, rankid, &
1808  existed )
1809  implicit none
1810 
1811  character(len=*), intent(in) :: basename
1812  character(len=*), intent(in) :: vname
1813  character(len=*), intent(in) :: key
1814 
1815  integer, intent(out) :: val(:)
1816 
1817  logical, intent(in), optional :: single
1818  logical, intent(in), optional :: aggregate
1819  integer, intent(in), optional :: rankid
1820 
1821  logical, intent(out), optional :: existed
1822 
1823  integer :: fid
1824 
1825  call file_open( basename, & ! (in)
1826  fid, & ! (out)
1827  single=single, & ! (in)
1828  aggregate=aggregate, &
1829  rankid=rankid ) ! (in)
1830 
1831  call file_get_attribute_int_fid( &
1832  fid, vname, key, & ! (in)
1833  val, & ! (out)
1834  existed ) ! (out)
1835 
1836  return
1837  end subroutine file_get_attribute_int_fname
1838  !-----------------------------------------------------------------------------
1839 
1840  subroutine file_get_attribute_float_fid( &
1841  fid, vname, key, &
1842  val, &
1843  existed )
1844  integer, intent(in ) :: fid
1845  character(len=*), intent(in ) :: vname
1846  character(len=*), intent(in ) :: key
1847  real(SP), intent(out) :: val(:)
1848 
1849  logical, intent(out), optional :: existed
1850 
1851  integer :: suppress
1852  integer :: error
1853 
1854  intrinsic size
1855 
1856  if ( .not. file_opened(fid) ) then
1857  log_error("FILE_get_attribute_float_fid",*) 'File is not opened. fid = ', fid
1858  call prc_abort
1859  end if
1860 
1861  if ( present(existed) ) then
1862  suppress = 1
1863  else
1864  suppress = 0
1865  end if
1866  call file_get_attribute_float_c( &
1867  file_files(fid)%fid, vname, & ! (in)
1868  key, size(val), suppress, & ! (in)
1869  val, error ) ! (out)
1870  if ( error /= file_success_code ) then
1871  if ( present(existed) ) then
1872  existed = .false.
1873  else
1874  log_error("FILE_get_attribute_float_fid",*) 'failed to get float attribute for '//trim(vname)//': '//trim(key)
1875  call prc_abort
1876  end if
1877  else
1878  if ( present(existed) ) existed = .true.
1879  end if
1880 
1881  return
1882  end subroutine file_get_attribute_float_fid
1883  subroutine file_get_attribute_float_fname( &
1884  basename, vname, key, &
1885  val, &
1886  single, aggregate, rankid, &
1887  existed )
1888  implicit none
1889 
1890  character(len=*), intent(in) :: basename
1891  character(len=*), intent(in) :: vname
1892  character(len=*), intent(in) :: key
1893 
1894  real(SP), intent(out) :: val(:)
1895 
1896  logical, intent(in), optional :: single
1897  logical, intent(in), optional :: aggregate
1898  integer, intent(in), optional :: rankid
1899 
1900  logical, intent(out), optional :: existed
1901 
1902  integer :: fid
1903 
1904  call file_open( basename, & ! (in)
1905  fid, & ! (out)
1906  single=single, & ! (in)
1907  aggregate=aggregate, & ! (in)
1908  rankid=rankid ) ! (in)
1909 
1910  call file_get_attribute_float_fid( &
1911  fid, vname, key, & ! (in)
1912  val, & ! (out)
1913  existed ) ! (out)
1914 
1915  return
1916  end subroutine file_get_attribute_float_fname
1917  subroutine file_get_attribute_double_fid( &
1918  fid, vname, key, &
1919  val, &
1920  existed )
1921  integer, intent(in ) :: fid
1922  character(len=*), intent(in ) :: vname
1923  character(len=*), intent(in ) :: key
1924  real(DP), intent(out) :: val(:)
1925 
1926  logical, intent(out), optional :: existed
1927 
1928  integer :: suppress
1929  integer :: error
1930 
1931  intrinsic size
1932 
1933  if ( .not. file_opened(fid) ) then
1934  log_error("FILE_get_attribute_double_fid",*) 'File is not opened. fid = ', fid
1935  call prc_abort
1936  end if
1937 
1938  if ( present(existed) ) then
1939  suppress = 1
1940  else
1941  suppress = 0
1942  end if
1943  call file_get_attribute_double_c( &
1944  file_files(fid)%fid, vname, & ! (in)
1945  key, size(val), suppress, & ! (in)
1946  val, error ) ! (out)
1947  if ( error /= file_success_code ) then
1948  if ( present(existed) ) then
1949  existed = .false.
1950  else
1951  log_error("FILE_get_attribute_double_fid",*) 'failed to get double attribute for '//trim(vname)//': '//trim(key)
1952  call prc_abort
1953  end if
1954  else
1955  if ( present(existed) ) existed = .true.
1956  end if
1957 
1958  return
1959  end subroutine file_get_attribute_double_fid
1960  subroutine file_get_attribute_double_fname( &
1961  basename, vname, key, &
1962  val, &
1963  single, aggregate, rankid, &
1964  existed )
1965  implicit none
1966 
1967  character(len=*), intent(in) :: basename
1968  character(len=*), intent(in) :: vname
1969  character(len=*), intent(in) :: key
1970 
1971  real(DP), intent(out) :: val(:)
1972 
1973  logical, intent(in), optional :: single
1974  logical, intent(in), optional :: aggregate
1975  integer, intent(in), optional :: rankid
1976 
1977  logical, intent(out), optional :: existed
1978 
1979  integer :: fid
1980 
1981  call file_open( basename, & ! (in)
1982  fid, & ! (out)
1983  single=single, & ! (in)
1984  aggregate=aggregate, & ! (in)
1985  rankid=rankid ) ! (in)
1986 
1987  call file_get_attribute_double_fid( &
1988  fid, vname, key, & ! (in)
1989  val, & ! (out)
1990  existed ) ! (out)
1991 
1992  return
1993  end subroutine file_get_attribute_double_fname
1994 
1995  !-----------------------------------------------------------------------------
1996  ! FILE_set_attribute
1997  !-----------------------------------------------------------------------------
1998  subroutine file_set_attribute_text( &
1999  fid, vname, &
2000  key, val )
2001  integer, intent(in) :: fid
2002  character(len=*), intent(in) :: vname
2003  character(len=*), intent(in) :: key
2004  character(len=*), intent(in) :: val
2005 
2006  integer :: error
2007 
2008  if ( .not. file_opened(fid) ) then
2009  log_error("FILE_set_attribute_text",*) 'File is not opened. fid = ', fid
2010  call prc_abort
2011  end if
2012 
2013  call file_set_attribute_text_c( &
2014  file_files(fid)%fid, vname, & ! (in)
2015  key, val, & ! (in)
2016  error ) ! (out)
2017  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
2018  log_error("FILE_set_attribute_text",*) 'failed to set text attribute for '//trim(vname)//': '//trim(key)
2019  call prc_abort
2020  end if
2021 
2022  return
2023  end subroutine file_set_attribute_text
2024 
2025  subroutine file_set_attribute_logical( &
2026  fid, vname, &
2027  key, val )
2028  integer, intent(in) :: fid
2029  character(len=*), intent(in) :: vname
2030  character(len=*), intent(in) :: key
2031  logical, intent(in) :: val
2032 
2033  character(len=5) :: buf
2034 
2035  if ( .not. file_opened(fid) ) then
2036  log_error("FILE_set_attribute_logical",*) 'File is not opened. fid = ', fid
2037  call prc_abort
2038  end if
2039 
2040  if ( val ) then
2041  buf = "true"
2042  else
2043  buf = "false"
2044  end if
2045 
2046  call file_set_attribute_text( fid, vname, key, buf )
2047 
2048  return
2049  end subroutine file_set_attribute_logical
2050 
2051  !-----------------------------------------------------------------------------
2052  subroutine file_set_attribute_int( &
2053  fid, vname, &
2054  key, val )
2055  integer, intent(in) :: fid
2056  character(len=*), intent(in) :: vname
2057  character(len=*), intent(in) :: key
2058  integer, intent(in) :: val(:)
2059 
2060  integer :: error
2061 
2062  intrinsic size
2063 
2064  if ( .not. file_opened(fid) ) then
2065  log_error("FILE_set_attribute_int",*) 'File is not opened. fid = ', fid
2066  call prc_abort
2067  end if
2068 
2069  call file_set_attribute_int_c( &
2070  file_files(fid)%fid, vname, & ! (in)
2071  key, val(:), size(val(:)), & ! (in)
2072  error ) ! (out)
2073  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
2074  log_error("FILE_set_attribute_int",*) 'failed to set integer attribute for '//trim(vname)//': '//trim(key)
2075  call prc_abort
2076  end if
2077 
2078  return
2079  end subroutine file_set_attribute_int
2080 
2081  !-----------------------------------------------------------------------------
2082  subroutine file_set_attribute_float( &
2083  fid, vname, &
2084  key, val )
2085  integer, intent(in) :: fid
2086  character(len=*), intent(in) :: vname
2087  character(len=*), intent(in) :: key
2088  real(SP), intent(in) :: val(:)
2089 
2090  integer :: error
2091 
2092  intrinsic size
2093 
2094  if ( .not. file_opened(fid) ) then
2095  log_error("FILE_set_attributefloat",*) 'File is not opened. fid = ', fid
2096  call prc_abort
2097  end if
2098 
2099  call file_set_attribute_float_c( &
2100  file_files(fid)%fid, vname, & ! (in)
2101  key, val(:), size(val(:)), & ! (in)
2102  error ) ! (out)
2103  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
2104  log_error("FILE_set_attribute_float",*) 'failed to set float attribute for '//trim(vname)//': '//trim(key)
2105  call prc_abort
2106  end if
2107 
2108  return
2109  end subroutine file_set_attribute_float
2110  !-----------------------------------------------------------------------------
2111  subroutine file_set_attribute_double( &
2112  fid, vname, &
2113  key, val )
2114  integer, intent(in) :: fid
2115  character(len=*), intent(in) :: vname
2116  character(len=*), intent(in) :: key
2117  real(DP), intent(in) :: val(:)
2118 
2119  integer :: error
2120 
2121  intrinsic size
2122 
2123  if ( .not. file_opened(fid) ) then
2124  log_error("FILE_set_attributedouble",*) 'File is not opened. fid = ', fid
2125  call prc_abort
2126  end if
2127 
2128  call file_set_attribute_double_c( &
2129  file_files(fid)%fid, vname, & ! (in)
2130  key, val(:), size(val(:)), & ! (in)
2131  error ) ! (out)
2132  if ( error /= file_success_code .and. error /= file_already_existed_code ) then
2133  log_error("FILE_set_attribute_double",*) 'failed to set double attribute for '//trim(vname)//': '//trim(key)
2134  call prc_abort
2135  end if
2136 
2137  return
2138  end subroutine file_set_attribute_double
2139  !-----------------------------------------------------------------------------
2140  ! FILE_get_shape
2141  !-----------------------------------------------------------------------------
2142  subroutine file_get_shape_fname( &
2143  basename, varname, &
2144  dims, &
2145  rankid, single, &
2146  error )
2147  implicit none
2148 
2149  character(len=*), intent( in) :: basename
2150  character(len=*), intent( in) :: varname
2151  integer, intent(out) :: dims(:)
2152  integer, intent( in), optional :: rankid
2153  logical, intent( in), optional :: single
2154  logical, intent(out), optional :: error
2155 
2156  integer :: fid
2157  !---------------------------------------------------------------------------
2158 
2159  !--- search/register file
2160  call file_open( basename, & ! (in)
2161  fid, & ! (out)
2162  rankid=rankid, single=single ) ! (in)
2163 
2164  call file_get_shape_fid( fid, varname, & ! (in)
2165  dims(:), & ! (out)
2166  error = error ) ! (out)
2167 
2168  return
2169  end subroutine file_get_shape_fname
2170 
2171  subroutine file_get_shape_fid( &
2172  fid, varname, &
2173  dims, &
2174  error )
2175  implicit none
2176  integer, intent( in) :: fid
2177  character(len=*), intent( in) :: varname
2178 
2179  integer, intent(out) :: dims(:)
2180 
2181  logical, intent(out), optional :: error
2182 
2183  type(datainfo) :: dinfo
2184  integer :: ierror
2185  integer :: n
2186 
2187  logical :: suppress
2188 
2189  intrinsic size
2190  !---------------------------------------------------------------------------
2191 
2192  if ( .not. file_opened(fid) ) then
2193  log_error("FILE_get_shape_id",*) 'File is not opened. fid = ', fid
2194  call prc_abort
2195  end if
2196 
2197  if ( present(error) ) then
2198  suppress = .true.
2199  else
2200  suppress = .false.
2201  end if
2202 
2203  !--- get data information
2204  call file_get_datainfo_c( dinfo, & ! (out)
2205  file_files(fid)%fid, varname, & ! (in)
2206  1, suppress, & ! (in)
2207  ierror ) ! (out)
2208 
2209  !--- verify
2210  if ( ierror /= file_success_code ) then
2211  if ( present(error) ) then
2212  error = .true.
2213  return
2214  else
2215  log_error("FILE_get_shape_fid",*) 'failed to get data information : ', trim(varname)
2216  call prc_abort
2217  end if
2218  end if
2219 
2220  if ( dinfo%rank /= size(dims) ) then
2221  log_error("FILE_get_shape_fid",*) 'rank is different, ', trim(varname), size(dims), dinfo%rank
2222  call prc_abort
2223  end if
2224  do n = 1, size(dims)
2225  dims(n) = dinfo%dim_size(n)
2226  end do
2227 
2228  if ( present(error) ) error = .false.
2229 
2230  return
2231  end subroutine file_get_shape_fid
2232 
2233  !-----------------------------------------------------------------------------
2235  !-----------------------------------------------------------------------------
2236  subroutine file_get_stepsize( &
2237  fid, varname, &
2238  len, &
2239  error )
2240  integer, intent(in) :: fid
2241  character(len=*), intent(in) :: varname
2242 
2243  integer, intent(out) :: len
2244 
2245  logical, intent(out), optional :: error
2246 
2247  integer :: ierror
2248 
2249  if ( .not. file_opened(fid) ) then
2250  log_error("FILE_get_stepSize",*) 'File is not opened. fid = ', fid
2251  call prc_abort
2252  end if
2253 
2254  call file_get_step_size_c( file_files(fid)%fid, varname, & ! (in)
2255  len, ierror ) ! (out)
2256  if ( ierror /= file_success_code .and. ierror /= file_already_existed_code ) then
2257  if ( present(error) ) then
2258  error = .true.
2259  else
2260  log_error("FILE_get_stepSize",*) 'failed to get number of steps'
2261  call prc_abort
2262  end if
2263  else
2264  if ( present(error) ) error = .false.
2265  end if
2266 
2267  return
2268  end subroutine file_get_stepsize
2269 
2270  !-----------------------------------------------------------------------------
2271  ! FILE_get_commonInfo
2272  !-----------------------------------------------------------------------------
2273  subroutine file_get_commoninfo_fname( &
2274  basename, &
2275  rankid, &
2276  nvars_limit, &
2277  title, &
2278  source, &
2279  institution, &
2280  nvars, &
2281  varname )
2282  implicit none
2283 
2284  character(len=*), intent(in) :: basename
2285  integer, intent(in) :: rankid
2286  integer, intent(in) :: nvars_limit
2287  character(len=FILE_HMID), intent(out) :: title ! title of the file
2288  character(len=FILE_HMID), intent(out) :: source ! for file header
2289  character(len=FILE_HMID), intent(out) :: institution ! for file header
2290  integer, intent(out) :: nvars ! number of variables
2291  character(len=FILE_HSHORT), intent(out) :: varname(nvars_limit) ! name of variables
2292 
2293  integer :: fid
2294  !---------------------------------------------------------------------------
2295 
2296  call file_open( basename, & ! [IN]
2297  fid, & ! [OUT]
2298  rankid=rankid ) ! [IN]
2299 
2300  call file_get_commoninfo_fid( fid, & ! [IN]
2301  nvars_limit, & ! [IN]
2302  title, & ! [OUT]
2303  source, & ! [OUT]
2304  institution, & ! [OUT]
2305  nvars, & ! [OUT]
2306  varname(:) ) ! [OUT]
2307 
2308  return
2309  end subroutine file_get_commoninfo_fname
2310 
2311  subroutine file_get_commoninfo_fid( &
2312  fid, &
2313  nvars_limit, &
2314  title, &
2315  source, &
2316  institution, &
2317  nvars, &
2318  varname )
2319  implicit none
2320 
2321  integer, intent(in) :: fid
2322  integer, intent(in) :: nvars_limit
2323  character(len=FILE_HMID), intent(out) :: title ! title of the file
2324  character(len=FILE_HMID), intent(out) :: source ! for file header
2325  character(len=FILE_HMID), intent(out) :: institution ! for file header
2326  integer, intent(out) :: nvars ! number of variables
2327  character(len=FILE_HSHORT), intent(out) :: varname(nvars_limit) ! name of variables
2328 
2329  integer :: v
2330  !---------------------------------------------------------------------------
2331 
2332  if ( .not. file_opened(fid) ) then
2333  log_error("FILE_get_commonInfo_fid",*) 'File is not opened. fid = ', fid
2334  call prc_abort
2335  end if
2336 
2337  call file_get_attribute( fid, 'global', 'title', title )
2338  call file_get_attribute( fid, 'global', 'source', source )
2339  call file_get_attribute( fid, 'global', 'institution', institution )
2340 
2341  call file_get_var_num( fid, nvars_limit, nvars )
2342 
2343  do v = 1, nvars
2344  call file_get_var_name( fid, v, varname(v) )
2345  enddo
2346 
2347  return
2348  end subroutine file_get_commoninfo_fid
2349 
2350  !-----------------------------------------------------------------------------
2351  ! FILE_get_dataInfo
2352  !-----------------------------------------------------------------------------
2353  subroutine file_get_datainfo_fname( &
2354  basename, varname, &
2355  rankid, istep, single, &
2356  existed, &
2357  description, units, standard_name, &
2358  datatype, &
2359  dim_rank, dim_name, dim_size, &
2360  natts, att_name, att_type, att_len, &
2361  time_start, time_end, &
2362  time_units, calendar )
2363  implicit none
2364 
2365  character(len=*), intent(in) :: basename
2366  character(len=*), intent(in) :: varname
2367 
2368  integer, intent(in), optional :: rankid
2369  integer, intent(in), optional :: istep
2370  logical, intent(in), optional :: single
2371  logical, intent(out), optional :: existed
2372  character(len=FILE_HMID), intent(out), optional :: description
2373  character(len=FILE_HSHORT), intent(out), optional :: units
2374  character(len=FILE_HMID), intent(out), optional :: standard_name
2375  integer, intent(out), optional :: datatype
2376  integer, intent(out), optional :: dim_rank
2377  character(len=FILE_HSHORT), intent(out), optional :: dim_name(:)
2378  integer, intent(out), optional :: dim_size(:)
2379  integer, intent(out), optional :: natts
2380  character(len=FILE_HSHORT), intent(out), optional :: att_name(:)
2381  integer, intent(out), optional :: att_type(:)
2382  integer, intent(out), optional :: att_len (:)
2383  real(DP), intent(out), optional :: time_start
2384  real(DP), intent(out), optional :: time_end
2385  character(len=FILE_HMID), intent(out), optional :: time_units
2386  character(len=FILE_HSHORT), intent(out), optional :: calendar
2387 
2388  logical :: single_
2389  integer :: fid
2390  !---------------------------------------------------------------------------
2391 
2392  if ( present(single) ) then
2393  single_ = single
2394  else
2395  single_ = .false.
2396  endif
2397 
2398  !--- search/register file
2399  call file_open( basename, & ! [IN]
2400  fid, & ! [OUT]
2401  rankid=rankid, single=single_ ) ! [IN]
2402 
2403  call file_get_datainfo_fid( fid, varname, & ! [IN]
2404  istep, & ! [IN] , optional
2405  existed, & ! [OUT], optional
2406  description, units, standard_name, & ! [OUT], optional
2407  datatype, & ! [OUT], optional
2408  dim_rank, dim_name, dim_size, & ! [OUT], optional
2409  natts, att_name, att_type, att_len, & ! [OUT], optional
2410  time_start, time_end, time_units, calendar ) ! [OUT], optional
2411 
2412  return
2413  end subroutine file_get_datainfo_fname
2414 
2415  subroutine file_get_datainfo_fid( &
2416  fid, varname, &
2417  istep, &
2418  existed, &
2419  description, units, standard_name, &
2420  datatype, &
2421  dim_rank, dim_name, dim_size, &
2422  natts, att_name, att_type, att_len, &
2423  time_start, time_end, &
2424  time_units, calendar )
2425  implicit none
2426 
2427  integer, intent(in) :: fid
2428  character(len=*), intent(in) :: varname
2429 
2430  integer, intent(in), optional :: istep
2431  logical, intent(out), optional :: existed
2432  character(len=FILE_HMID), intent(out), optional :: description
2433  character(len=FILE_HSHORT), intent(out), optional :: units
2434  character(len=FILE_HMID), intent(out), optional :: standard_name
2435  integer, intent(out), optional :: datatype
2436  integer, intent(out), optional :: dim_rank
2437  character(len=FILE_HSHORT), intent(out), optional :: dim_name(:)
2438  integer, intent(out), optional :: dim_size(:)
2439  integer, intent(out), optional :: natts
2440  character(len=FILE_HSHORT), intent(out), optional :: att_name(:)
2441  integer, intent(out), optional :: att_type(:)
2442  integer, intent(out), optional :: att_len (:)
2443  real(DP), intent(out), optional :: time_start
2444  real(DP), intent(out), optional :: time_end
2445  character(len=FILE_HMID), intent(out), optional :: time_units
2446  character(len=FILE_HSHORT), intent(out), optional :: calendar
2447 
2448  type(datainfo) :: dinfo
2449 
2450  integer :: istep_
2451  real(DP) :: time(1)
2452  integer :: i
2453  integer :: error
2454 
2455  logical :: suppress
2456  logical :: existed2
2457 
2458  intrinsic size
2459  !---------------------------------------------------------------------------
2460 
2461  if ( present(istep) ) then
2462  istep_ = istep
2463  else
2464  istep_ = 1
2465  end if
2466 
2467  if ( present(existed) ) then
2468  suppress = .true.
2469  else
2470  suppress = .false.
2471  end if
2472 
2473  if ( .not. file_opened(fid) ) then
2474  log_error("FILE_get_dataInfo_fid",*) 'File is not opened. fid = ', fid
2475  call prc_abort
2476  end if
2477 
2478  !--- get data information
2479  call file_get_datainfo_c( dinfo, & ! [OUT]
2480  file_files(fid)%fid, & ! [IN]
2481  varname, & ! [IN]
2482  istep_, & ! [IN]
2483  suppress, & ! [IN]
2484  error ) ! [OUT]
2485 
2486  !--- verify and exit
2487  if ( error /= file_success_code ) then
2488  if ( present( existed ) ) then
2489  existed = .false.
2490  return
2491  else
2492  log_error("FILE_get_dataInfo_fid",*) 'data info not found'
2493  call prc_abort
2494  end if
2495  endif
2496 
2497  if ( present(existed) ) existed = .true.
2498 
2499  if ( present(description) ) description = dinfo%description
2500  if ( present(units) ) units = dinfo%units
2501  if ( present(standard_name) ) standard_name = dinfo%standard_name
2502  if ( present(datatype) ) datatype = dinfo%datatype
2503  if ( present(dim_rank) ) dim_rank = dinfo%rank
2504 
2505  if ( present(dim_name) ) then
2506  do i = 1, min( dinfo%rank, size(dim_name) ) ! limit dimension rank
2507  dim_name(i) = dinfo%dim_name(i)
2508  enddo
2509  endif
2510 
2511  if ( present(dim_size) ) then
2512  do i = 1, min( dinfo%rank, size(dim_size) ) ! limit dimension rank
2513  dim_size(i) = dinfo%dim_size(i)
2514  enddo
2515  endif
2516 
2517  if ( present(natts) ) natts = dinfo%natts
2518  if ( present(att_name) ) then
2519  do i = 1, min( dinfo%natts, size(att_name) )
2520  att_name(i) = dinfo%att_name(i)
2521  end do
2522  end if
2523  if ( present(att_type) ) then
2524  do i = 1, min( dinfo%natts, size(att_type) )
2525  att_type(i) = dinfo%att_type(i)
2526  end do
2527  end if
2528  if ( present(att_len) ) then
2529  do i = 1, min( dinfo%natts, size(att_len) )
2530  att_len(i) = dinfo%att_len(i)
2531  end do
2532  end if
2533 
2534  if ( present(time_units) ) then
2535  if ( dinfo%time_units == "" ) then
2536  call file_get_attribute( fid, "global", "time_units", time_units )
2537  else
2538  time_units = dinfo%time_units
2539  endif
2540  endif
2541 
2542  if ( present(calendar) ) then
2543  if ( dinfo%time_units == "" ) then
2544  call file_get_attribute( fid, "global", "calendar", calendar, existed2 )
2545  if ( .not. existed2 ) calendar = ""
2546  else
2547  calendar = dinfo%calendar
2548  end if
2549  end if
2550 
2551  if ( present(time_start) ) then
2552  if ( dinfo%time_units == "" ) then
2553  call file_get_attribute( fid, "global", "time_start", time )
2554  time_start = time(1)
2555  else
2556  time_start = dinfo%time_start
2557  endif
2558  endif
2559 
2560  if ( present(time_end) ) then
2561  if ( dinfo%time_units == "" ) then
2562  call file_get_attribute( fid, "global", "time_start", time )
2563  time_end = time(1)
2564  else
2565  time_end = dinfo%time_end
2566  end if
2567  endif
2568 
2569  return
2570  end subroutine file_get_datainfo_fid
2571 
2572  !-----------------------------------------------------------------------------
2573  ! FILE_get_data_all_dataInfo
2574  !-----------------------------------------------------------------------------
2575  subroutine file_get_all_datainfo_fname( &
2576  basename, varname, &
2577  step_nmax, &
2578  description, units, standard_name, &
2579  datatype, &
2580  dim_rank, dim_name, dim_size, &
2581  natts, att_name, att_type, att_len, &
2582  time_start, time_end, &
2583  time_units, calendar, &
2584  rankid, single )
2585  implicit none
2586  character(len=*), intent(in) :: basename
2587  character(len=*), intent(in) :: varname
2588  integer, intent(out) :: step_nmax
2589  character(len=FILE_HMID), intent(out) :: description
2590  character(len=FILE_HSHORT), intent(out) :: units
2591  character(len=FILE_HMID), intent(out) :: standard_name
2592  integer, intent(out) :: datatype
2593  integer, intent(out) :: dim_rank
2594  character(len=FILE_HSHORT), intent(out) :: dim_name (:)
2595  integer, intent(out) :: dim_size (:)
2596  integer, intent(out) :: natts
2597  character(len=FILE_HSHORT), intent(out) :: att_name (:)
2598  integer, intent(out) :: att_type (:)
2599  integer, intent(out) :: att_len (:)
2600  real(DP), intent(out) :: time_start(:)
2601  real(DP), intent(out) :: time_end (:)
2602  character(len=FILE_HMID), intent(out) :: time_units
2603  character(len=FILE_HSHORT), intent(out) :: calendar
2604 
2605  integer, intent(in), optional :: rankid
2606  logical, intent(in), optional :: single
2607 
2608  integer :: fid
2609  logical :: single_
2610  !---------------------------------------------------------------------------
2611 
2612  if ( present(single) ) then
2613  single_ = single
2614  else
2615  single_ = .false.
2616  endif
2617 
2618  !--- search/register file
2619  call file_open( basename, & ! [IN]
2620  fid, & ! [OUT]
2621  rankid=rankid, single=single_ ) ! [IN]
2622 
2623  call file_get_all_datainfo_fid( fid, varname, & ! [IN]
2624  step_nmax, & ! [OUT]
2625  description, units, standard_name, & ! [OUT]
2626  datatype, & ! [OUT]
2627  dim_rank, dim_name(:), dim_size(:), & ! [OUT]
2628  natts, att_name(:), att_type(:), att_len(:), & ! [OUT]
2629  time_start(:), time_end(:), & ! [OUT]
2630  time_units, calendar ) ! [OUT]
2631 
2632  return
2633  end subroutine file_get_all_datainfo_fname
2634 
2635  subroutine file_get_all_datainfo_fid( &
2636  fid, varname, &
2637  step_nmax, &
2638  description, units, standard_name, &
2639  datatype, &
2640  dim_rank, dim_name, dim_size, &
2641  natts, att_name, att_type, att_len, &
2642  time_start, time_end, &
2643  time_units, calendar )
2644  implicit none
2645 
2646  integer, intent(in) :: fid
2647  character(len=*), intent(in) :: varname
2648  integer, intent(out) :: step_nmax
2649  character(len=FILE_HMID), intent(out) :: description
2650  character(len=FILE_HSHORT), intent(out) :: units
2651  character(len=FILE_HMID), intent(out) :: standard_name
2652  integer, intent(out) :: datatype
2653  integer, intent(out) :: dim_rank
2654  character(len=FILE_HSHORT), intent(out) :: dim_name (:)
2655  integer, intent(out) :: dim_size (:)
2656  integer, intent(out) :: natts
2657  character(len=FILE_HSHORT), intent(out) :: att_name (:)
2658  integer, intent(out) :: att_type (:)
2659  integer, intent(out) :: att_len (:)
2660  real(DP), intent(out) :: time_start(:)
2661  real(DP), intent(out) :: time_end (:)
2662  character(len=FILE_HMID), intent(out) :: time_units
2663  character(len=FILE_HSHORT), intent(out) :: calendar
2664 
2665  type(datainfo) :: dinfo
2666 
2667  real(DP) :: time(1)
2668  integer :: i
2669  integer :: error
2670  logical :: existed
2671 
2672  integer :: istep
2673 
2674  intrinsic size
2675  !---------------------------------------------------------------------------
2676 
2677  if ( .not. file_opened(fid) ) then
2678  log_error("FILE_get_all_dataInfo_fid",*) 'File is not opened. fid = ', fid
2679  call prc_abort
2680  end if
2681 
2682  ! initialize
2683  description = ""
2684  units = ""
2685  standard_name = ""
2686  datatype = -1
2687  dim_rank = -1
2688  dim_name(:) = ""
2689  dim_size(:) = -1
2690  time_start(:) = file_rmiss
2691  time_end(:) = file_rmiss
2692 
2693  do istep = 1, min( size(time_start), size(time_end) )
2694  !--- get data information
2695  call file_get_datainfo_c( dinfo, & ! [OUT]
2696  file_files(fid)%fid, & ! [IN]
2697  varname, & ! [IN]
2698  istep, & ! [IN]
2699  .true., & ! [IN]
2700  error ) ! [OUT]
2701 
2702  !--- verify and exit
2703  if ( error /= file_success_code ) then
2704  step_nmax = istep - 1
2705  exit
2706  endif
2707 
2708  if ( istep == 1 ) then
2709  description = dinfo%description
2710  units = dinfo%units
2711  standard_name = dinfo%standard_name
2712  datatype = dinfo%datatype
2713  dim_rank = dinfo%rank
2714  natts = dinfo%natts
2715 
2716  do i = 1, min( dinfo%rank, size(dim_name) ) ! limit dimension rank
2717  dim_name(i) = dinfo%dim_name(i)
2718  dim_size(i) = dinfo%dim_size(i)
2719  enddo
2720 
2721  do i = 1, min( dinfo%natts, size(att_name) )
2722  att_name(i) = dinfo%att_name(i)
2723  att_type(i) = dinfo%att_type(i)
2724  att_len(i) = dinfo%att_len (i)
2725  end do
2726 
2727  if ( dinfo%time_units == "" ) then
2728  call file_get_attribute( fid, "global", "time_units", time_units )
2729  call file_get_attribute( fid, "global", "calendar", calendar, existed )
2730  if ( .not. existed ) calendar = ""
2731  call file_get_attribute( fid, "global", "time_start", time )
2732  time_start(1) = time(1)
2733  time_end(1) = time(1)
2734  step_nmax = 1
2735  exit
2736  else
2737  time_units = dinfo%time_units
2738  calendar = dinfo%calendar
2739  time_start(1) = dinfo%time_start
2740  time_end(1) = dinfo%time_end
2741  endif
2742  else
2743  time_start(istep) = dinfo%time_start
2744  time_end(istep) = dinfo%time_end
2745  endif
2746  enddo
2747 
2748  return
2749  end subroutine file_get_all_datainfo_fid
2750 
2751  !-----------------------------------------------------------------------------
2752  ! interface FILE_read
2753  !-----------------------------------------------------------------------------
2754  subroutine file_read_realsp_1d( &
2755  basename, varname, &
2756  var, &
2757  step, rankid, single, postfix, &
2758  allow_missing, missing_value )
2759  implicit none
2760 
2761  character(len=*), intent( in) :: basename
2762  character(len=*), intent( in) :: varname
2763  real(SP), intent(out) :: var(:)
2764  integer, intent( in), optional :: step
2765  integer, intent( in), optional :: rankid
2766  logical, intent( in), optional :: single
2767  character(len=*), intent( in), optional :: postfix
2768  logical, intent( in), optional :: allow_missing
2769  real(SP), intent( in), optional :: missing_value
2770 
2771  integer :: fid
2772 
2773  intrinsic shape
2774  !---------------------------------------------------------------------------
2775 
2776  !--- search/register file
2777  call file_open( basename, & ! (in)
2778  fid, & ! (out)
2779  rankid=rankid, single=single, & ! (in)
2780  postfix=postfix ) ! (in)
2781 
2782  call file_read_var_realsp_1d( &
2783  fid, varname, & ! (in)
2784  var(:), & ! (out)
2785  step=step, & ! (in)
2786  allow_missing=allow_missing, missing_value=missing_value ) ! (in)
2787 
2788  return
2789  end subroutine file_read_realsp_1d
2790  subroutine file_read_realdp_1d( &
2791  basename, varname, &
2792  var, &
2793  step, rankid, single, postfix, &
2794  allow_missing, missing_value )
2795  implicit none
2796 
2797  character(len=*), intent( in) :: basename
2798  character(len=*), intent( in) :: varname
2799  real(DP), intent(out) :: var(:)
2800  integer, intent( in), optional :: step
2801  integer, intent( in), optional :: rankid
2802  logical, intent( in), optional :: single
2803  character(len=*), intent( in), optional :: postfix
2804  logical, intent( in), optional :: allow_missing
2805  real(DP), intent( in), optional :: missing_value
2806 
2807  integer :: fid
2808 
2809  intrinsic shape
2810  !---------------------------------------------------------------------------
2811 
2812  !--- search/register file
2813  call file_open( basename, & ! (in)
2814  fid, & ! (out)
2815  rankid=rankid, single=single, & ! (in)
2816  postfix=postfix ) ! (in)
2817 
2818  call file_read_var_realdp_1d( &
2819  fid, varname, & ! (in)
2820  var(:), & ! (out)
2821  step=step, & ! (in)
2822  allow_missing=allow_missing, missing_value=missing_value ) ! (in)
2823 
2824  return
2825  end subroutine file_read_realdp_1d
2826  subroutine file_read_realsp_2d( &
2827  basename, varname, &
2828  var, &
2829  step, rankid, single, postfix, &
2830  allow_missing, missing_value )
2831  implicit none
2832 
2833  character(len=*), intent( in) :: basename
2834  character(len=*), intent( in) :: varname
2835  real(SP), intent(out) :: var(:,:)
2836  integer, intent( in), optional :: step
2837  integer, intent( in), optional :: rankid
2838  logical, intent( in), optional :: single
2839  character(len=*), intent( in), optional :: postfix
2840  logical, intent( in), optional :: allow_missing
2841  real(SP), intent( in), optional :: missing_value
2842 
2843  integer :: fid
2844 
2845  intrinsic shape
2846  !---------------------------------------------------------------------------
2847 
2848  !--- search/register file
2849  call file_open( basename, & ! (in)
2850  fid, & ! (out)
2851  rankid=rankid, single=single, & ! (in)
2852  postfix=postfix ) ! (in)
2853 
2854  call file_read_var_realsp_2d( &
2855  fid, varname, & ! (in)
2856  var(:,:), & ! (out)
2857  step=step, & ! (in)
2858  allow_missing=allow_missing, missing_value=missing_value ) ! (in)
2859 
2860  return
2861  end subroutine file_read_realsp_2d
2862  subroutine file_read_realdp_2d( &
2863  basename, varname, &
2864  var, &
2865  step, rankid, single, postfix, &
2866  allow_missing, missing_value )
2867  implicit none
2868 
2869  character(len=*), intent( in) :: basename
2870  character(len=*), intent( in) :: varname
2871  real(DP), intent(out) :: var(:,:)
2872  integer, intent( in), optional :: step
2873  integer, intent( in), optional :: rankid
2874  logical, intent( in), optional :: single
2875  character(len=*), intent( in), optional :: postfix
2876  logical, intent( in), optional :: allow_missing
2877  real(DP), intent( in), optional :: missing_value
2878 
2879  integer :: fid
2880 
2881  intrinsic shape
2882  !---------------------------------------------------------------------------
2883 
2884  !--- search/register file
2885  call file_open( basename, & ! (in)
2886  fid, & ! (out)
2887  rankid=rankid, single=single, & ! (in)
2888  postfix=postfix ) ! (in)
2889 
2890  call file_read_var_realdp_2d( &
2891  fid, varname, & ! (in)
2892  var(:,:), & ! (out)
2893  step=step, & ! (in)
2894  allow_missing=allow_missing, missing_value=missing_value ) ! (in)
2895 
2896  return
2897  end subroutine file_read_realdp_2d
2898  subroutine file_read_realsp_3d( &
2899  basename, varname, &
2900  var, &
2901  step, rankid, single, postfix, &
2902  allow_missing, missing_value )
2903  implicit none
2904 
2905  character(len=*), intent( in) :: basename
2906  character(len=*), intent( in) :: varname
2907  real(SP), intent(out) :: var(:,:,:)
2908  integer, intent( in), optional :: step
2909  integer, intent( in), optional :: rankid
2910  logical, intent( in), optional :: single
2911  character(len=*), intent( in), optional :: postfix
2912  logical, intent( in), optional :: allow_missing
2913  real(SP), intent( in), optional :: missing_value
2914 
2915  integer :: fid
2916 
2917  intrinsic shape
2918  !---------------------------------------------------------------------------
2919 
2920  !--- search/register file
2921  call file_open( basename, & ! (in)
2922  fid, & ! (out)
2923  rankid=rankid, single=single, & ! (in)
2924  postfix=postfix ) ! (in)
2925 
2926  call file_read_var_realsp_3d( &
2927  fid, varname, & ! (in)
2928  var(:,:,:), & ! (out)
2929  step=step, & ! (in)
2930  allow_missing=allow_missing, missing_value=missing_value ) ! (in)
2931 
2932  return
2933  end subroutine file_read_realsp_3d
2934  subroutine file_read_realdp_3d( &
2935  basename, varname, &
2936  var, &
2937  step, rankid, single, postfix, &
2938  allow_missing, missing_value )
2939  implicit none
2940 
2941  character(len=*), intent( in) :: basename
2942  character(len=*), intent( in) :: varname
2943  real(DP), intent(out) :: var(:,:,:)
2944  integer, intent( in), optional :: step
2945  integer, intent( in), optional :: rankid
2946  logical, intent( in), optional :: single
2947  character(len=*), intent( in), optional :: postfix
2948  logical, intent( in), optional :: allow_missing
2949  real(DP), intent( in), optional :: missing_value
2950 
2951  integer :: fid
2952 
2953  intrinsic shape
2954  !---------------------------------------------------------------------------
2955 
2956  !--- search/register file
2957  call file_open( basename, & ! (in)
2958  fid, & ! (out)
2959  rankid=rankid, single=single, & ! (in)
2960  postfix=postfix ) ! (in)
2961 
2962  call file_read_var_realdp_3d( &
2963  fid, varname, & ! (in)
2964  var(:,:,:), & ! (out)
2965  step=step, & ! (in)
2966  allow_missing=allow_missing, missing_value=missing_value ) ! (in)
2967 
2968  return
2969  end subroutine file_read_realdp_3d
2970  subroutine file_read_realsp_4d( &
2971  basename, varname, &
2972  var, &
2973  step, rankid, single, postfix, &
2974  allow_missing, missing_value )
2975  implicit none
2976 
2977  character(len=*), intent( in) :: basename
2978  character(len=*), intent( in) :: varname
2979  real(SP), intent(out) :: var(:,:,:,:)
2980  integer, intent( in), optional :: step
2981  integer, intent( in), optional :: rankid
2982  logical, intent( in), optional :: single
2983  character(len=*), intent( in), optional :: postfix
2984  logical, intent( in), optional :: allow_missing
2985  real(SP), intent( in), optional :: missing_value
2986 
2987  integer :: fid
2988 
2989  intrinsic shape
2990  !---------------------------------------------------------------------------
2991 
2992  !--- search/register file
2993  call file_open( basename, & ! (in)
2994  fid, & ! (out)
2995  rankid=rankid, single=single, & ! (in)
2996  postfix=postfix ) ! (in)
2997 
2998  call file_read_var_realsp_4d( &
2999  fid, varname, & ! (in)
3000  var(:,:,:,:), & ! (out)
3001  step=step, & ! (in)
3002  allow_missing=allow_missing, missing_value=missing_value ) ! (in)
3003 
3004  return
3005  end subroutine file_read_realsp_4d
3006  subroutine file_read_realdp_4d( &
3007  basename, varname, &
3008  var, &
3009  step, rankid, single, postfix, &
3010  allow_missing, missing_value )
3011  implicit none
3012 
3013  character(len=*), intent( in) :: basename
3014  character(len=*), intent( in) :: varname
3015  real(DP), intent(out) :: var(:,:,:,:)
3016  integer, intent( in), optional :: step
3017  integer, intent( in), optional :: rankid
3018  logical, intent( in), optional :: single
3019  character(len=*), intent( in), optional :: postfix
3020  logical, intent( in), optional :: allow_missing
3021  real(DP), intent( in), optional :: missing_value
3022 
3023  integer :: fid
3024 
3025  intrinsic shape
3026  !---------------------------------------------------------------------------
3027 
3028  !--- search/register file
3029  call file_open( basename, & ! (in)
3030  fid, & ! (out)
3031  rankid=rankid, single=single, & ! (in)
3032  postfix=postfix ) ! (in)
3033 
3034  call file_read_var_realdp_4d( &
3035  fid, varname, & ! (in)
3036  var(:,:,:,:), & ! (out)
3037  step=step, & ! (in)
3038  allow_missing=allow_missing, missing_value=missing_value ) ! (in)
3039 
3040  return
3041  end subroutine file_read_realdp_4d
3042 
3043  subroutine file_read_var_realsp_1d( &
3044  fid, varname, &
3045  var, &
3046  step, &
3047  allow_missing, &
3048  missing_value, &
3049  ntypes, dtype, &
3050  start, count )
3051  implicit none
3052 
3053  integer, intent( in) :: fid
3054  character(len=*), intent( in) :: varname
3055  real(SP), intent(out) :: var(:)
3056  integer, intent( in), optional :: step
3057  logical, intent( in), optional :: allow_missing
3058  real(SP), intent( in), optional :: missing_value
3059  integer, intent( in), optional :: ntypes
3060  integer, intent( in), optional :: dtype
3061  integer, intent( in), optional :: start(:)
3062  integer, intent( in), optional :: count(:)
3063 
3064  integer :: step_
3065  logical :: allow_missing_
3066  real(SP) :: missing_value_
3067 
3068  type(datainfo) :: dinfo
3069  integer :: dim_size(1)
3070  integer :: error
3071  integer :: n
3072 
3073  intrinsic size, shape
3074  !---------------------------------------------------------------------------
3075 
3076  if ( .not. file_opened(fid) ) then
3077  log_error("FILE_",*) 'File is not opened. fid = ', fid
3078  call prc_abort
3079  end if
3080 
3081  if ( present(step) ) then
3082  step_ = step
3083  else
3084  step_ = 1
3085  end if
3086 
3087  if ( present(allow_missing) ) then
3088  allow_missing_ = allow_missing
3089  else
3090  allow_missing_ = .false.
3091  end if
3092 
3093  if ( present(missing_value) ) then
3094  missing_value_ = missing_value
3095  else
3096  missing_value_ = 0.0_sp
3097  end if
3098 
3099  !--- get data information
3100  call file_get_datainfo_c( dinfo, & ! (out)
3101  file_files(fid)%fid, varname, step_, allow_missing_, & ! (in)
3102  error ) ! (out)
3103 
3104  !--- verify
3105  if ( error /= file_success_code ) then
3106  if ( allow_missing_ ) then
3107  log_info("FILE_read_var_realSP_1D",*) '[INPUT]/[FILE] data not found! : ', &
3108  'varname= ',trim(varname),', step=',step_
3109  log_info("FILE_read_var_realSP_1D",*) '[INPUT]/[FILE] Value is set to ', missing_value_
3110  var(:) = missing_value_
3111  return
3112  else
3113  log_error("FILE_read_var_realSP_1D",*) 'failed to get data information :'//trim(varname)
3114  call prc_abort
3115  end if
3116  end if
3117 
3118  if ( dinfo%rank /= 1 ) then
3119  if ( (.not. present(start)) .and. (.not. present(count)) ) then
3120  log_error("FILE_read_var_realSP_1D",*) 'rank of '//trim(varname)//' is not 1', dinfo%rank
3121  call prc_abort
3122  end if
3123  end if
3124 
3125  if ( present(ntypes) ) then
3126  call file_read_data_c( var(:), & ! (out)
3127  dinfo, sp, ntypes, dtype, start(:), count(:), & ! (in)
3128  error ) ! (out)
3129  else if ( present(start) .and. present(count) ) then
3130  call file_read_data_c( var(:), & ! (out)
3131  dinfo, sp, 0, 0, start(:), count(:), & ! (in)
3132  error ) ! (out)
3133  else
3134  dim_size(:) = shape(var)
3135  do n = 1, 1
3136  if ( dinfo%dim_size(n) /= dim_size(n) ) then
3137  log_error("FILE_read_var_realSP_1D",*) 'shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
3138  call prc_abort
3139  end if
3140  end do
3141  call file_read_data_c( var(:), & ! (out)
3142  dinfo, sp, 0, 0, -1, -1, & ! (in)
3143  error ) ! (out)
3144  end if
3145  if ( error /= file_success_code ) then
3146  log_error("FILE_read_var_realSP_1D",*) 'failed to get data value: ', trim(varname)
3147  call prc_abort
3148  end if
3149 
3150  return
3151  end subroutine file_read_var_realsp_1d
3152  subroutine file_read_var_realdp_1d( &
3153  fid, varname, &
3154  var, &
3155  step, &
3156  allow_missing, &
3157  missing_value, &
3158  ntypes, dtype, &
3159  start, count )
3160  implicit none
3161 
3162  integer, intent( in) :: fid
3163  character(len=*), intent( in) :: varname
3164  real(DP), intent(out) :: var(:)
3165  integer, intent( in), optional :: step
3166  logical, intent( in), optional :: allow_missing
3167  real(DP), intent( in), optional :: missing_value
3168  integer, intent( in), optional :: ntypes
3169  integer, intent( in), optional :: dtype
3170  integer, intent( in), optional :: start(:)
3171  integer, intent( in), optional :: count(:)
3172 
3173  integer :: step_
3174  logical :: allow_missing_
3175  real(DP) :: missing_value_
3176 
3177  type(datainfo) :: dinfo
3178  integer :: dim_size(1)
3179  integer :: error
3180  integer :: n
3181 
3182  intrinsic size, shape
3183  !---------------------------------------------------------------------------
3184 
3185  if ( .not. file_opened(fid) ) then
3186  log_error("FILE_",*) 'File is not opened. fid = ', fid
3187  call prc_abort
3188  end if
3189 
3190  if ( present(step) ) then
3191  step_ = step
3192  else
3193  step_ = 1
3194  end if
3195 
3196  if ( present(allow_missing) ) then
3197  allow_missing_ = allow_missing
3198  else
3199  allow_missing_ = .false.
3200  end if
3201 
3202  if ( present(missing_value) ) then
3203  missing_value_ = missing_value
3204  else
3205  missing_value_ = 0.0_dp
3206  end if
3207 
3208  !--- get data information
3209  call file_get_datainfo_c( dinfo, & ! (out)
3210  file_files(fid)%fid, varname, step_, allow_missing_, & ! (in)
3211  error ) ! (out)
3212 
3213  !--- verify
3214  if ( error /= file_success_code ) then
3215  if ( allow_missing_ ) then
3216  log_info("FILE_read_var_realDP_1D",*) '[INPUT]/[FILE] data not found! : ', &
3217  'varname= ',trim(varname),', step=',step_
3218  log_info("FILE_read_var_realDP_1D",*) '[INPUT]/[FILE] Value is set to ', missing_value_
3219  var(:) = missing_value_
3220  return
3221  else
3222  log_error("FILE_read_var_realDP_1D",*) 'failed to get data information :'//trim(varname)
3223  call prc_abort
3224  end if
3225  end if
3226 
3227  if ( dinfo%rank /= 1 ) then
3228  if ( (.not. present(start)) .and. (.not. present(count)) ) then
3229  log_error("FILE_read_var_realDP_1D",*) 'rank of '//trim(varname)//' is not 1', dinfo%rank
3230  call prc_abort
3231  end if
3232  end if
3233 
3234  if ( present(ntypes) ) then
3235  call file_read_data_c( var(:), & ! (out)
3236  dinfo, dp, ntypes, dtype, start(:), count(:), & ! (in)
3237  error ) ! (out)
3238  else if ( present(start) .and. present(count) ) then
3239  call file_read_data_c( var(:), & ! (out)
3240  dinfo, dp, 0, 0, start(:), count(:), & ! (in)
3241  error ) ! (out)
3242  else
3243  dim_size(:) = shape(var)
3244  do n = 1, 1
3245  if ( dinfo%dim_size(n) /= dim_size(n) ) then
3246  log_error("FILE_read_var_realDP_1D",*) 'shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
3247  call prc_abort
3248  end if
3249  end do
3250  call file_read_data_c( var(:), & ! (out)
3251  dinfo, dp, 0, 0, -1, -1, & ! (in)
3252  error ) ! (out)
3253  end if
3254  if ( error /= file_success_code ) then
3255  log_error("FILE_read_var_realDP_1D",*) 'failed to get data value: ', trim(varname)
3256  call prc_abort
3257  end if
3258 
3259  return
3260  end subroutine file_read_var_realdp_1d
3261  subroutine file_read_var_realsp_2d( &
3262  fid, varname, &
3263  var, &
3264  step, &
3265  allow_missing, &
3266  missing_value, &
3267  ntypes, dtype, &
3268  start, count )
3269  implicit none
3270 
3271  integer, intent( in) :: fid
3272  character(len=*), intent( in) :: varname
3273  real(SP), intent(out) :: var(:,:)
3274  integer, intent( in), optional :: step
3275  logical, intent( in), optional :: allow_missing
3276  real(SP), intent( in), optional :: missing_value
3277  integer, intent( in), optional :: ntypes
3278  integer, intent( in), optional :: dtype
3279  integer, intent( in), optional :: start(:)
3280  integer, intent( in), optional :: count(:)
3281 
3282  integer :: step_
3283  logical :: allow_missing_
3284  real(SP) :: missing_value_
3285 
3286  type(datainfo) :: dinfo
3287  integer :: dim_size(2)
3288  integer :: error
3289  integer :: n
3290 
3291  intrinsic size, shape
3292  !---------------------------------------------------------------------------
3293 
3294  if ( .not. file_opened(fid) ) then
3295  log_error("FILE_",*) 'File is not opened. fid = ', fid
3296  call prc_abort
3297  end if
3298 
3299  if ( present(step) ) then
3300  step_ = step
3301  else
3302  step_ = 1
3303  end if
3304 
3305  if ( present(allow_missing) ) then
3306  allow_missing_ = allow_missing
3307  else
3308  allow_missing_ = .false.
3309  end if
3310 
3311  if ( present(missing_value) ) then
3312  missing_value_ = missing_value
3313  else
3314  missing_value_ = 0.0_sp
3315  end if
3316 
3317  !--- get data information
3318  call file_get_datainfo_c( dinfo, & ! (out)
3319  file_files(fid)%fid, varname, step_, allow_missing_, & ! (in)
3320  error ) ! (out)
3321 
3322  !--- verify
3323  if ( error /= file_success_code ) then
3324  if ( allow_missing_ ) then
3325  log_info("FILE_read_var_realSP_2D",*) '[INPUT]/[FILE] data not found! : ', &
3326  'varname= ',trim(varname),', step=',step_
3327  log_info("FILE_read_var_realSP_2D",*) '[INPUT]/[FILE] Value is set to ', missing_value_
3328  var(:,:) = missing_value_
3329  return
3330  else
3331  log_error("FILE_read_var_realSP_2D",*) 'failed to get data information :'//trim(varname)
3332  call prc_abort
3333  end if
3334  end if
3335 
3336  if ( dinfo%rank /= 2 ) then
3337  if ( (.not. present(start)) .and. (.not. present(count)) ) then
3338  log_error("FILE_read_var_realSP_2D",*) 'rank of '//trim(varname)//' is not 2', dinfo%rank
3339  call prc_abort
3340  end if
3341  end if
3342 
3343  if ( present(ntypes) ) then
3344  call file_read_data_c( var(:,:), & ! (out)
3345  dinfo, sp, ntypes, dtype, start(:), count(:), & ! (in)
3346  error ) ! (out)
3347  else if ( present(start) .and. present(count) ) then
3348  call file_read_data_c( var(:,:), & ! (out)
3349  dinfo, sp, 0, 0, start(:), count(:), & ! (in)
3350  error ) ! (out)
3351  else
3352  dim_size(:) = shape(var)
3353  do n = 1, 2
3354  if ( dinfo%dim_size(n) /= dim_size(n) ) then
3355  log_error("FILE_read_var_realSP_2D",*) 'shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
3356  call prc_abort
3357  end if
3358  end do
3359  call file_read_data_c( var(:,:), & ! (out)
3360  dinfo, sp, 0, 0, -1, -1, & ! (in)
3361  error ) ! (out)
3362  end if
3363  if ( error /= file_success_code ) then
3364  log_error("FILE_read_var_realSP_2D",*) 'failed to get data value: ', trim(varname)
3365  call prc_abort
3366  end if
3367 
3368  return
3369  end subroutine file_read_var_realsp_2d
3370  subroutine file_read_var_realdp_2d( &
3371  fid, varname, &
3372  var, &
3373  step, &
3374  allow_missing, &
3375  missing_value, &
3376  ntypes, dtype, &
3377  start, count )
3378  implicit none
3379 
3380  integer, intent( in) :: fid
3381  character(len=*), intent( in) :: varname
3382  real(DP), intent(out) :: var(:,:)
3383  integer, intent( in), optional :: step
3384  logical, intent( in), optional :: allow_missing
3385  real(DP), intent( in), optional :: missing_value
3386  integer, intent( in), optional :: ntypes
3387  integer, intent( in), optional :: dtype
3388  integer, intent( in), optional :: start(:)
3389  integer, intent( in), optional :: count(:)
3390 
3391  integer :: step_
3392  logical :: allow_missing_
3393  real(DP) :: missing_value_
3394 
3395  type(datainfo) :: dinfo
3396  integer :: dim_size(2)
3397  integer :: error
3398  integer :: n
3399 
3400  intrinsic size, shape
3401  !---------------------------------------------------------------------------
3402 
3403  if ( .not. file_opened(fid) ) then
3404  log_error("FILE_",*) 'File is not opened. fid = ', fid
3405  call prc_abort
3406  end if
3407 
3408  if ( present(step) ) then
3409  step_ = step
3410  else
3411  step_ = 1
3412  end if
3413 
3414  if ( present(allow_missing) ) then
3415  allow_missing_ = allow_missing
3416  else
3417  allow_missing_ = .false.
3418  end if
3419 
3420  if ( present(missing_value) ) then
3421  missing_value_ = missing_value
3422  else
3423  missing_value_ = 0.0_dp
3424  end if
3425 
3426  !--- get data information
3427  call file_get_datainfo_c( dinfo, & ! (out)
3428  file_files(fid)%fid, varname, step_, allow_missing_, & ! (in)
3429  error ) ! (out)
3430 
3431  !--- verify
3432  if ( error /= file_success_code ) then
3433  if ( allow_missing_ ) then
3434  log_info("FILE_read_var_realDP_2D",*) '[INPUT]/[FILE] data not found! : ', &
3435  'varname= ',trim(varname),', step=',step_
3436  log_info("FILE_read_var_realDP_2D",*) '[INPUT]/[FILE] Value is set to ', missing_value_
3437  var(:,:) = missing_value_
3438  return
3439  else
3440  log_error("FILE_read_var_realDP_2D",*) 'failed to get data information :'//trim(varname)
3441  call prc_abort
3442  end if
3443  end if
3444 
3445  if ( dinfo%rank /= 2 ) then
3446  if ( (.not. present(start)) .and. (.not. present(count)) ) then
3447  log_error("FILE_read_var_realDP_2D",*) 'rank of '//trim(varname)//' is not 2', dinfo%rank
3448  call prc_abort
3449  end if
3450  end if
3451 
3452  if ( present(ntypes) ) then
3453  call file_read_data_c( var(:,:), & ! (out)
3454  dinfo, dp, ntypes, dtype, start(:), count(:), & ! (in)
3455  error ) ! (out)
3456  else if ( present(start) .and. present(count) ) then
3457  call file_read_data_c( var(:,:), & ! (out)
3458  dinfo, dp, 0, 0, start(:), count(:), & ! (in)
3459  error ) ! (out)
3460  else
3461  dim_size(:) = shape(var)
3462  do n = 1, 2
3463  if ( dinfo%dim_size(n) /= dim_size(n) ) then
3464  log_error("FILE_read_var_realDP_2D",*) 'shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
3465  call prc_abort
3466  end if
3467  end do
3468  call file_read_data_c( var(:,:), & ! (out)
3469  dinfo, dp, 0, 0, -1, -1, & ! (in)
3470  error ) ! (out)
3471  end if
3472  if ( error /= file_success_code ) then
3473  log_error("FILE_read_var_realDP_2D",*) 'failed to get data value: ', trim(varname)
3474  call prc_abort
3475  end if
3476 
3477  return
3478  end subroutine file_read_var_realdp_2d
3479  subroutine file_read_var_realsp_3d( &
3480  fid, varname, &
3481  var, &
3482  step, &
3483  allow_missing, &
3484  missing_value, &
3485  ntypes, dtype, &
3486  start, count )
3487  implicit none
3488 
3489  integer, intent( in) :: fid
3490  character(len=*), intent( in) :: varname
3491  real(SP), intent(out) :: var(:,:,:)
3492  integer, intent( in), optional :: step
3493  logical, intent( in), optional :: allow_missing
3494  real(SP), intent( in), optional :: missing_value
3495  integer, intent( in), optional :: ntypes
3496  integer, intent( in), optional :: dtype
3497  integer, intent( in), optional :: start(:)
3498  integer, intent( in), optional :: count(:)
3499 
3500  integer :: step_
3501  logical :: allow_missing_
3502  real(SP) :: missing_value_
3503 
3504  type(datainfo) :: dinfo
3505  integer :: dim_size(3)
3506  integer :: error
3507  integer :: n
3508 
3509  intrinsic size, shape
3510  !---------------------------------------------------------------------------
3511 
3512  if ( .not. file_opened(fid) ) then
3513  log_error("FILE_",*) 'File is not opened. fid = ', fid
3514  call prc_abort
3515  end if
3516 
3517  if ( present(step) ) then
3518  step_ = step
3519  else
3520  step_ = 1
3521  end if
3522 
3523  if ( present(allow_missing) ) then
3524  allow_missing_ = allow_missing
3525  else
3526  allow_missing_ = .false.
3527  end if
3528 
3529  if ( present(missing_value) ) then
3530  missing_value_ = missing_value
3531  else
3532  missing_value_ = 0.0_sp
3533  end if
3534 
3535  !--- get data information
3536  call file_get_datainfo_c( dinfo, & ! (out)
3537  file_files(fid)%fid, varname, step_, allow_missing_, & ! (in)
3538  error ) ! (out)
3539 
3540  !--- verify
3541  if ( error /= file_success_code ) then
3542  if ( allow_missing_ ) then
3543  log_info("FILE_read_var_realSP_3D",*) '[INPUT]/[FILE] data not found! : ', &
3544  'varname= ',trim(varname),', step=',step_
3545  log_info("FILE_read_var_realSP_3D",*) '[INPUT]/[FILE] Value is set to ', missing_value_
3546  var(:,:,:) = missing_value_
3547  return
3548  else
3549  log_error("FILE_read_var_realSP_3D",*) 'failed to get data information :'//trim(varname)
3550  call prc_abort
3551  end if
3552  end if
3553 
3554  if ( dinfo%rank /= 3 ) then
3555  if ( (.not. present(start)) .and. (.not. present(count)) ) then
3556  log_error("FILE_read_var_realSP_3D",*) 'rank of '//trim(varname)//' is not 3', dinfo%rank
3557  call prc_abort
3558  end if
3559  end if
3560 
3561  if ( present(ntypes) ) then
3562  call file_read_data_c( var(:,:,:), & ! (out)
3563  dinfo, sp, ntypes, dtype, start(:), count(:), & ! (in)
3564  error ) ! (out)
3565  else if ( present(start) .and. present(count) ) then
3566  call file_read_data_c( var(:,:,:), & ! (out)
3567  dinfo, sp, 0, 0, start(:), count(:), & ! (in)
3568  error ) ! (out)
3569  else
3570  dim_size(:) = shape(var)
3571  do n = 1, 3
3572  if ( dinfo%dim_size(n) /= dim_size(n) ) then
3573  log_error("FILE_read_var_realSP_3D",*) 'shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
3574  call prc_abort
3575  end if
3576  end do
3577  call file_read_data_c( var(:,:,:), & ! (out)
3578  dinfo, sp, 0, 0, -1, -1, & ! (in)
3579  error ) ! (out)
3580  end if
3581  if ( error /= file_success_code ) then
3582  log_error("FILE_read_var_realSP_3D",*) 'failed to get data value: ', trim(varname)
3583  call prc_abort
3584  end if
3585 
3586  return
3587  end subroutine file_read_var_realsp_3d
3588  subroutine file_read_var_realdp_3d( &
3589  fid, varname, &
3590  var, &
3591  step, &
3592  allow_missing, &
3593  missing_value, &
3594  ntypes, dtype, &
3595  start, count )
3596  implicit none
3597 
3598  integer, intent( in) :: fid
3599  character(len=*), intent( in) :: varname
3600  real(DP), intent(out) :: var(:,:,:)
3601  integer, intent( in), optional :: step
3602  logical, intent( in), optional :: allow_missing
3603  real(DP), intent( in), optional :: missing_value
3604  integer, intent( in), optional :: ntypes
3605  integer, intent( in), optional :: dtype
3606  integer, intent( in), optional :: start(:)
3607  integer, intent( in), optional :: count(:)
3608 
3609  integer :: step_
3610  logical :: allow_missing_
3611  real(DP) :: missing_value_
3612 
3613  type(datainfo) :: dinfo
3614  integer :: dim_size(3)
3615  integer :: error
3616  integer :: n
3617 
3618  intrinsic size, shape
3619  !---------------------------------------------------------------------------
3620 
3621  if ( .not. file_opened(fid) ) then
3622  log_error("FILE_",*) 'File is not opened. fid = ', fid
3623  call prc_abort
3624  end if
3625 
3626  if ( present(step) ) then
3627  step_ = step
3628  else
3629  step_ = 1
3630  end if
3631 
3632  if ( present(allow_missing) ) then
3633  allow_missing_ = allow_missing
3634  else
3635  allow_missing_ = .false.
3636  end if
3637 
3638  if ( present(missing_value) ) then
3639  missing_value_ = missing_value
3640  else
3641  missing_value_ = 0.0_dp
3642  end if
3643 
3644  !--- get data information
3645  call file_get_datainfo_c( dinfo, & ! (out)
3646  file_files(fid)%fid, varname, step_, allow_missing_, & ! (in)
3647  error ) ! (out)
3648 
3649  !--- verify
3650  if ( error /= file_success_code ) then
3651  if ( allow_missing_ ) then
3652  log_info("FILE_read_var_realDP_3D",*) '[INPUT]/[FILE] data not found! : ', &
3653  'varname= ',trim(varname),', step=',step_
3654  log_info("FILE_read_var_realDP_3D",*) '[INPUT]/[FILE] Value is set to ', missing_value_
3655  var(:,:,:) = missing_value_
3656  return
3657  else
3658  log_error("FILE_read_var_realDP_3D",*) 'failed to get data information :'//trim(varname)
3659  call prc_abort
3660  end if
3661  end if
3662 
3663  if ( dinfo%rank /= 3 ) then
3664  if ( (.not. present(start)) .and. (.not. present(count)) ) then
3665  log_error("FILE_read_var_realDP_3D",*) 'rank of '//trim(varname)//' is not 3', dinfo%rank
3666  call prc_abort
3667  end if
3668  end if
3669 
3670  if ( present(ntypes) ) then
3671  call file_read_data_c( var(:,:,:), & ! (out)
3672  dinfo, dp, ntypes, dtype, start(:), count(:), & ! (in)
3673  error ) ! (out)
3674  else if ( present(start) .and. present(count) ) then
3675  call file_read_data_c( var(:,:,:), & ! (out)
3676  dinfo, dp, 0, 0, start(:), count(:), & ! (in)
3677  error ) ! (out)
3678  else
3679  dim_size(:) = shape(var)
3680  do n = 1, 3
3681  if ( dinfo%dim_size(n) /= dim_size(n) ) then
3682  log_error("FILE_read_var_realDP_3D",*) 'shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
3683  call prc_abort
3684  end if
3685  end do
3686  call file_read_data_c( var(:,:,:), & ! (out)
3687  dinfo, dp, 0, 0, -1, -1, & ! (in)
3688  error ) ! (out)
3689  end if
3690  if ( error /= file_success_code ) then
3691  log_error("FILE_read_var_realDP_3D",*) 'failed to get data value: ', trim(varname)
3692  call prc_abort
3693  end if
3694 
3695  return
3696  end subroutine file_read_var_realdp_3d
3697  subroutine file_read_var_realsp_4d( &
3698  fid, varname, &
3699  var, &
3700  step, &
3701  allow_missing, &
3702  missing_value, &
3703  ntypes, dtype, &
3704  start, count )
3705  implicit none
3706 
3707  integer, intent( in) :: fid
3708  character(len=*), intent( in) :: varname
3709  real(SP), intent(out) :: var(:,:,:,:)
3710  integer, intent( in), optional :: step
3711  logical, intent( in), optional :: allow_missing
3712  real(SP), intent( in), optional :: missing_value
3713  integer, intent( in), optional :: ntypes
3714  integer, intent( in), optional :: dtype
3715  integer, intent( in), optional :: start(:)
3716  integer, intent( in), optional :: count(:)
3717 
3718  integer :: step_
3719  logical :: allow_missing_
3720  real(SP) :: missing_value_
3721 
3722  type(datainfo) :: dinfo
3723  integer :: dim_size(4)
3724  integer :: error
3725  integer :: n
3726 
3727  intrinsic size, shape
3728  !---------------------------------------------------------------------------
3729 
3730  if ( .not. file_opened(fid) ) then
3731  log_error("FILE_",*) 'File is not opened. fid = ', fid
3732  call prc_abort
3733  end if
3734 
3735  if ( present(step) ) then
3736  step_ = step
3737  else
3738  step_ = 1
3739  end if
3740 
3741  if ( present(allow_missing) ) then
3742  allow_missing_ = allow_missing
3743  else
3744  allow_missing_ = .false.
3745  end if
3746 
3747  if ( present(missing_value) ) then
3748  missing_value_ = missing_value
3749  else
3750  missing_value_ = 0.0_sp
3751  end if
3752 
3753  !--- get data information
3754  call file_get_datainfo_c( dinfo, & ! (out)
3755  file_files(fid)%fid, varname, step_, allow_missing_, & ! (in)
3756  error ) ! (out)
3757 
3758  !--- verify
3759  if ( error /= file_success_code ) then
3760  if ( allow_missing_ ) then
3761  log_info("FILE_read_var_realSP_4D",*) '[INPUT]/[FILE] data not found! : ', &
3762  'varname= ',trim(varname),', step=',step_
3763  log_info("FILE_read_var_realSP_4D",*) '[INPUT]/[FILE] Value is set to ', missing_value_
3764  var(:,:,:,:) = missing_value_
3765  return
3766  else
3767  log_error("FILE_read_var_realSP_4D",*) 'failed to get data information :'//trim(varname)
3768  call prc_abort
3769  end if
3770  end if
3771 
3772  if ( dinfo%rank /= 4 ) then
3773  if ( (.not. present(start)) .and. (.not. present(count)) ) then
3774  log_error("FILE_read_var_realSP_4D",*) 'rank of '//trim(varname)//' is not 4', dinfo%rank
3775  call prc_abort
3776  end if
3777  end if
3778 
3779  if ( present(ntypes) ) then
3780  call file_read_data_c( var(:,:,:,:), & ! (out)
3781  dinfo, sp, ntypes, dtype, start(:), count(:), & ! (in)
3782  error ) ! (out)
3783  else if ( present(start) .and. present(count) ) then
3784  call file_read_data_c( var(:,:,:,:), & ! (out)
3785  dinfo, sp, 0, 0, start(:), count(:), & ! (in)
3786  error ) ! (out)
3787  else
3788  dim_size(:) = shape(var)
3789  do n = 1, 4
3790  if ( dinfo%dim_size(n) /= dim_size(n) ) then
3791  log_error("FILE_read_var_realSP_4D",*) 'shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
3792  call prc_abort
3793  end if
3794  end do
3795  call file_read_data_c( var(:,:,:,:), & ! (out)
3796  dinfo, sp, 0, 0, -1, -1, & ! (in)
3797  error ) ! (out)
3798  end if
3799  if ( error /= file_success_code ) then
3800  log_error("FILE_read_var_realSP_4D",*) 'failed to get data value: ', trim(varname)
3801  call prc_abort
3802  end if
3803 
3804  return
3805  end subroutine file_read_var_realsp_4d
3806  subroutine file_read_var_realdp_4d( &
3807  fid, varname, &
3808  var, &
3809  step, &
3810  allow_missing, &
3811  missing_value, &
3812  ntypes, dtype, &
3813  start, count )
3814  implicit none
3815 
3816  integer, intent( in) :: fid
3817  character(len=*), intent( in) :: varname
3818  real(DP), intent(out) :: var(:,:,:,:)
3819  integer, intent( in), optional :: step
3820  logical, intent( in), optional :: allow_missing
3821  real(DP), intent( in), optional :: missing_value
3822  integer, intent( in), optional :: ntypes
3823  integer, intent( in), optional :: dtype
3824  integer, intent( in), optional :: start(:)
3825  integer, intent( in), optional :: count(:)
3826 
3827  integer :: step_
3828  logical :: allow_missing_
3829  real(DP) :: missing_value_
3830 
3831  type(datainfo) :: dinfo
3832  integer :: dim_size(4)
3833  integer :: error
3834  integer :: n
3835 
3836  intrinsic size, shape
3837  !---------------------------------------------------------------------------
3838 
3839  if ( .not. file_opened(fid) ) then
3840  log_error("FILE_",*) 'File is not opened. fid = ', fid
3841  call prc_abort
3842  end if
3843 
3844  if ( present(step) ) then
3845  step_ = step
3846  else
3847  step_ = 1
3848  end if
3849 
3850  if ( present(allow_missing) ) then
3851  allow_missing_ = allow_missing
3852  else
3853  allow_missing_ = .false.
3854  end if
3855 
3856  if ( present(missing_value) ) then
3857  missing_value_ = missing_value
3858  else
3859  missing_value_ = 0.0_dp
3860  end if
3861 
3862  !--- get data information
3863  call file_get_datainfo_c( dinfo, & ! (out)
3864  file_files(fid)%fid, varname, step_, allow_missing_, & ! (in)
3865  error ) ! (out)
3866 
3867  !--- verify
3868  if ( error /= file_success_code ) then
3869  if ( allow_missing_ ) then
3870  log_info("FILE_read_var_realDP_4D",*) '[INPUT]/[FILE] data not found! : ', &
3871  'varname= ',trim(varname),', step=',step_
3872  log_info("FILE_read_var_realDP_4D",*) '[INPUT]/[FILE] Value is set to ', missing_value_
3873  var(:,:,:,:) = missing_value_
3874  return
3875  else
3876  log_error("FILE_read_var_realDP_4D",*) 'failed to get data information :'//trim(varname)
3877  call prc_abort
3878  end if
3879  end if
3880 
3881  if ( dinfo%rank /= 4 ) then
3882  if ( (.not. present(start)) .and. (.not. present(count)) ) then
3883  log_error("FILE_read_var_realDP_4D",*) 'rank of '//trim(varname)//' is not 4', dinfo%rank
3884  call prc_abort
3885  end if
3886  end if
3887 
3888  if ( present(ntypes) ) then
3889  call file_read_data_c( var(:,:,:,:), & ! (out)
3890  dinfo, dp, ntypes, dtype, start(:), count(:), & ! (in)
3891  error ) ! (out)
3892  else if ( present(start) .and. present(count) ) then
3893  call file_read_data_c( var(:,:,:,:), & ! (out)
3894  dinfo, dp, 0, 0, start(:), count(:), & ! (in)
3895  error ) ! (out)
3896  else
3897  dim_size(:) = shape(var)
3898  do n = 1, 4
3899  if ( dinfo%dim_size(n) /= dim_size(n) ) then
3900  log_error("FILE_read_var_realDP_4D",*) 'shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
3901  call prc_abort
3902  end if
3903  end do
3904  call file_read_data_c( var(:,:,:,:), & ! (out)
3905  dinfo, dp, 0, 0, -1, -1, & ! (in)
3906  error ) ! (out)
3907  end if
3908  if ( error /= file_success_code ) then
3909  log_error("FILE_read_var_realDP_4D",*) 'failed to get data value: ', trim(varname)
3910  call prc_abort
3911  end if
3912 
3913  return
3914  end subroutine file_read_var_realdp_4d
3915 
3916  !-----------------------------------------------------------------------------
3917  ! interface FILE_write
3918  !-----------------------------------------------------------------------------
3919  subroutine file_write_realsp_1d( &
3920  vid, var, &
3921  t_start, t_end, &
3922  ndims, &
3923  count, &
3924  start )
3925  implicit none
3926 
3927  integer, intent(in) :: vid
3928  real(SP), intent(in) :: var(:)
3929  real(DP), intent(in) :: t_start
3930  real(DP), intent(in) :: t_end
3931  integer, intent(in), optional :: ndims ! when var has been reshaped to 1D
3932  integer, intent(in), optional :: count(:)
3933  integer, intent(in), optional :: start(:)
3934  real(DP) :: ts, te
3935 
3936  integer :: start_(1)
3937 
3938  integer :: fid
3939  integer :: error, n
3940 
3941  intrinsic shape
3942  !---------------------------------------------------------------------------
3943 
3944  ts = t_start
3945  te = t_end
3946 
3947  fid = file_vars(vid)%fid
3948 
3949  if ( .not. file_opened(fid) ) then
3950  log_error("FILE_write_realSP_1D",*) 'File is not opened. fid = ', fid
3951  call prc_abort
3952  end if
3953 
3954  if ( present(ndims) ) then
3955  ! history variable has been reshaped to 1D
3956  ! In this case, start and count must be present
3957 
3958  if ( .not. present(start) ) then
3959  log_error("FILE_write_realSP_1D",*) 'start argument is neccessary when ndims is specified'
3960  call prc_abort
3961  end if
3962  if ( .not. present(count) ) then
3963  log_error("FILE_write_realSP_1D",*) 'count argument is neccessary when ndims is specified'
3964  call prc_abort
3965  end if
3966 
3967  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
3968  var(:), ts, te, sp, & ! (in)
3969  ndims, start, count, & ! (in)
3970  error ) ! (out)
3971  else
3972  ! this is for restart variable which keeps its original shape
3973  if ( present(start) ) then
3974  start_(:) = start(:)
3975  else
3976  start_(:) = 1
3977  end if
3978  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
3979  var(:), ts, te, sp, & ! (in)
3980  1, start_, shape(var), & ! (in)
3981  error ) ! (out)
3982  end if
3983  if ( error /= file_success_code ) then
3984  do n = 1, file_nvars
3985  if ( file_vars(n)%vid == vid ) then
3986  log_error("FILE_write_realSP_1D",*) 'failed to write data: ', trim(file_vars(n)%name)
3987  exit
3988  end if
3989  enddo
3990  call prc_abort
3991  end if
3992 
3993  return
3994  end subroutine file_write_realsp_1d
3995  subroutine file_write_realdp_1d( &
3996  vid, var, &
3997  t_start, t_end, &
3998  ndims, &
3999  count, &
4000  start )
4001  implicit none
4002 
4003  integer, intent(in) :: vid
4004  real(DP), intent(in) :: var(:)
4005  real(DP), intent(in) :: t_start
4006  real(DP), intent(in) :: t_end
4007  integer, intent(in), optional :: ndims ! when var has been reshaped to 1D
4008  integer, intent(in), optional :: count(:)
4009  integer, intent(in), optional :: start(:)
4010  real(DP) :: ts, te
4011 
4012  integer :: start_(1)
4013 
4014  integer :: fid
4015  integer :: error, n
4016 
4017  intrinsic shape
4018  !---------------------------------------------------------------------------
4019 
4020  ts = t_start
4021  te = t_end
4022 
4023  fid = file_vars(vid)%fid
4024 
4025  if ( .not. file_opened(fid) ) then
4026  log_error("FILE_write_realDP_1D",*) 'File is not opened. fid = ', fid
4027  call prc_abort
4028  end if
4029 
4030  if ( present(ndims) ) then
4031  ! history variable has been reshaped to 1D
4032  ! In this case, start and count must be present
4033 
4034  if ( .not. present(start) ) then
4035  log_error("FILE_write_realDP_1D",*) 'start argument is neccessary when ndims is specified'
4036  call prc_abort
4037  end if
4038  if ( .not. present(count) ) then
4039  log_error("FILE_write_realDP_1D",*) 'count argument is neccessary when ndims is specified'
4040  call prc_abort
4041  end if
4042 
4043  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
4044  var(:), ts, te, dp, & ! (in)
4045  ndims, start, count, & ! (in)
4046  error ) ! (out)
4047  else
4048  ! this is for restart variable which keeps its original shape
4049  if ( present(start) ) then
4050  start_(:) = start(:)
4051  else
4052  start_(:) = 1
4053  end if
4054  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
4055  var(:), ts, te, dp, & ! (in)
4056  1, start_, shape(var), & ! (in)
4057  error ) ! (out)
4058  end if
4059  if ( error /= file_success_code ) then
4060  do n = 1, file_nvars
4061  if ( file_vars(n)%vid == vid ) then
4062  log_error("FILE_write_realDP_1D",*) 'failed to write data: ', trim(file_vars(n)%name)
4063  exit
4064  end if
4065  enddo
4066  call prc_abort
4067  end if
4068 
4069  return
4070  end subroutine file_write_realdp_1d
4071  subroutine file_write_realsp_2d( &
4072  vid, var, &
4073  t_start, t_end, &
4074  start )
4075  implicit none
4076 
4077  integer, intent(in) :: vid
4078  real(SP), intent(in) :: var(:,:)
4079  real(DP), intent(in) :: t_start
4080  real(DP), intent(in) :: t_end
4081  integer, intent(in), optional :: start(:)
4082  real(DP) :: ts, te
4083 
4084  integer :: start_(2)
4085 
4086  integer :: fid
4087  integer :: error, n
4088 
4089  intrinsic shape
4090  !---------------------------------------------------------------------------
4091 
4092  ts = t_start
4093  te = t_end
4094 
4095  fid = file_vars(vid)%fid
4096 
4097  if ( .not. file_opened(fid) ) then
4098  log_error("FILE_write_realSP_2D",*) 'File is not opened. fid = ', fid
4099  call prc_abort
4100  end if
4101 
4102  ! this is for restart variable which keeps its original shape
4103  if ( present(start) ) then
4104  start_(:) = start(:)
4105  else
4106  start_(:) = 1
4107  end if
4108  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
4109  var(:,:), ts, te, sp, & ! (in)
4110  2, start_, shape(var), & ! (in)
4111  error ) ! (out)
4112  if ( error /= file_success_code ) then
4113  do n = 1, file_nvars
4114  if ( file_vars(n)%vid == vid ) then
4115  log_error("FILE_write_realSP_2D",*) 'failed to write data: ', trim(file_vars(n)%name)
4116  exit
4117  end if
4118  enddo
4119  call prc_abort
4120  end if
4121 
4122  return
4123  end subroutine file_write_realsp_2d
4124  subroutine file_write_realdp_2d( &
4125  vid, var, &
4126  t_start, t_end, &
4127  start )
4128  implicit none
4129 
4130  integer, intent(in) :: vid
4131  real(DP), intent(in) :: var(:,:)
4132  real(DP), intent(in) :: t_start
4133  real(DP), intent(in) :: t_end
4134  integer, intent(in), optional :: start(:)
4135  real(DP) :: ts, te
4136 
4137  integer :: start_(2)
4138 
4139  integer :: fid
4140  integer :: error, n
4141 
4142  intrinsic shape
4143  !---------------------------------------------------------------------------
4144 
4145  ts = t_start
4146  te = t_end
4147 
4148  fid = file_vars(vid)%fid
4149 
4150  if ( .not. file_opened(fid) ) then
4151  log_error("FILE_write_realDP_2D",*) 'File is not opened. fid = ', fid
4152  call prc_abort
4153  end if
4154 
4155  ! this is for restart variable which keeps its original shape
4156  if ( present(start) ) then
4157  start_(:) = start(:)
4158  else
4159  start_(:) = 1
4160  end if
4161  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
4162  var(:,:), ts, te, dp, & ! (in)
4163  2, start_, shape(var), & ! (in)
4164  error ) ! (out)
4165  if ( error /= file_success_code ) then
4166  do n = 1, file_nvars
4167  if ( file_vars(n)%vid == vid ) then
4168  log_error("FILE_write_realDP_2D",*) 'failed to write data: ', trim(file_vars(n)%name)
4169  exit
4170  end if
4171  enddo
4172  call prc_abort
4173  end if
4174 
4175  return
4176  end subroutine file_write_realdp_2d
4177  subroutine file_write_realsp_3d( &
4178  vid, var, &
4179  t_start, t_end, &
4180  start )
4181  implicit none
4182 
4183  integer, intent(in) :: vid
4184  real(SP), intent(in) :: var(:,:,:)
4185  real(DP), intent(in) :: t_start
4186  real(DP), intent(in) :: t_end
4187  integer, intent(in), optional :: start(:)
4188  real(DP) :: ts, te
4189 
4190  integer :: start_(3)
4191 
4192  integer :: fid
4193  integer :: error, n
4194 
4195  intrinsic shape
4196  !---------------------------------------------------------------------------
4197 
4198  ts = t_start
4199  te = t_end
4200 
4201  fid = file_vars(vid)%fid
4202 
4203  if ( .not. file_opened(fid) ) then
4204  log_error("FILE_write_realSP_3D",*) 'File is not opened. fid = ', fid
4205  call prc_abort
4206  end if
4207 
4208  ! this is for restart variable which keeps its original shape
4209  if ( present(start) ) then
4210  start_(:) = start(:)
4211  else
4212  start_(:) = 1
4213  end if
4214  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
4215  var(:,:,:), ts, te, sp, & ! (in)
4216  3, start_, shape(var), & ! (in)
4217  error ) ! (out)
4218  if ( error /= file_success_code ) then
4219  do n = 1, file_nvars
4220  if ( file_vars(n)%vid == vid ) then
4221  log_error("FILE_write_realSP_3D",*) 'failed to write data: ', trim(file_vars(n)%name)
4222  exit
4223  end if
4224  enddo
4225  call prc_abort
4226  end if
4227 
4228  return
4229  end subroutine file_write_realsp_3d
4230  subroutine file_write_realdp_3d( &
4231  vid, var, &
4232  t_start, t_end, &
4233  start )
4234  implicit none
4235 
4236  integer, intent(in) :: vid
4237  real(DP), intent(in) :: var(:,:,:)
4238  real(DP), intent(in) :: t_start
4239  real(DP), intent(in) :: t_end
4240  integer, intent(in), optional :: start(:)
4241  real(DP) :: ts, te
4242 
4243  integer :: start_(3)
4244 
4245  integer :: fid
4246  integer :: error, n
4247 
4248  intrinsic shape
4249  !---------------------------------------------------------------------------
4250 
4251  ts = t_start
4252  te = t_end
4253 
4254  fid = file_vars(vid)%fid
4255 
4256  if ( .not. file_opened(fid) ) then
4257  log_error("FILE_write_realDP_3D",*) 'File is not opened. fid = ', fid
4258  call prc_abort
4259  end if
4260 
4261  ! this is for restart variable which keeps its original shape
4262  if ( present(start) ) then
4263  start_(:) = start(:)
4264  else
4265  start_(:) = 1
4266  end if
4267  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
4268  var(:,:,:), ts, te, dp, & ! (in)
4269  3, start_, shape(var), & ! (in)
4270  error ) ! (out)
4271  if ( error /= file_success_code ) then
4272  do n = 1, file_nvars
4273  if ( file_vars(n)%vid == vid ) then
4274  log_error("FILE_write_realDP_3D",*) 'failed to write data: ', trim(file_vars(n)%name)
4275  exit
4276  end if
4277  enddo
4278  call prc_abort
4279  end if
4280 
4281  return
4282  end subroutine file_write_realdp_3d
4283  subroutine file_write_realsp_4d( &
4284  vid, var, &
4285  t_start, t_end, &
4286  start )
4287  implicit none
4288 
4289  integer, intent(in) :: vid
4290  real(SP), intent(in) :: var(:,:,:,:)
4291  real(DP), intent(in) :: t_start
4292  real(DP), intent(in) :: t_end
4293  integer, intent(in), optional :: start(:)
4294  real(DP) :: ts, te
4295 
4296  integer :: start_(4)
4297 
4298  integer :: fid
4299  integer :: error, n
4300 
4301  intrinsic shape
4302  !---------------------------------------------------------------------------
4303 
4304  ts = t_start
4305  te = t_end
4306 
4307  fid = file_vars(vid)%fid
4308 
4309  if ( .not. file_opened(fid) ) then
4310  log_error("FILE_write_realSP_4D",*) 'File is not opened. fid = ', fid
4311  call prc_abort
4312  end if
4313 
4314  ! this is for restart variable which keeps its original shape
4315  if ( present(start) ) then
4316  start_(:) = start(:)
4317  else
4318  start_(:) = 1
4319  end if
4320  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
4321  var(:,:,:,:), ts, te, sp, & ! (in)
4322  4, start_, shape(var), & ! (in)
4323  error ) ! (out)
4324  if ( error /= file_success_code ) then
4325  do n = 1, file_nvars
4326  if ( file_vars(n)%vid == vid ) then
4327  log_error("FILE_write_realSP_4D",*) 'failed to write data: ', trim(file_vars(n)%name)
4328  exit
4329  end if
4330  enddo
4331  call prc_abort
4332  end if
4333 
4334  return
4335  end subroutine file_write_realsp_4d
4336  subroutine file_write_realdp_4d( &
4337  vid, var, &
4338  t_start, t_end, &
4339  start )
4340  implicit none
4341 
4342  integer, intent(in) :: vid
4343  real(DP), intent(in) :: var(:,:,:,:)
4344  real(DP), intent(in) :: t_start
4345  real(DP), intent(in) :: t_end
4346  integer, intent(in), optional :: start(:)
4347  real(DP) :: ts, te
4348 
4349  integer :: start_(4)
4350 
4351  integer :: fid
4352  integer :: error, n
4353 
4354  intrinsic shape
4355  !---------------------------------------------------------------------------
4356 
4357  ts = t_start
4358  te = t_end
4359 
4360  fid = file_vars(vid)%fid
4361 
4362  if ( .not. file_opened(fid) ) then
4363  log_error("FILE_write_realDP_4D",*) 'File is not opened. fid = ', fid
4364  call prc_abort
4365  end if
4366 
4367  ! this is for restart variable which keeps its original shape
4368  if ( present(start) ) then
4369  start_(:) = start(:)
4370  else
4371  start_(:) = 1
4372  end if
4373  call file_write_data_c( file_files(fid)%fid, file_vars(vid)%vid, & ! (in)
4374  var(:,:,:,:), ts, te, dp, & ! (in)
4375  4, start_, shape(var), & ! (in)
4376  error ) ! (out)
4377  if ( error /= file_success_code ) then
4378  do n = 1, file_nvars
4379  if ( file_vars(n)%vid == vid ) then
4380  log_error("FILE_write_realDP_4D",*) 'failed to write data: ', trim(file_vars(n)%name)
4381  exit
4382  end if
4383  enddo
4384  call prc_abort
4385  end if
4386 
4387  return
4388  end subroutine file_write_realdp_4d
4389 
4390  !-----------------------------------------------------------------------------
4391  ! exit netCDF define mode and enter data mode
4392  subroutine file_enddef( fid )
4393  implicit none
4394 
4395  integer, intent(in) :: fid
4396 
4397  integer :: error
4398  !---------------------------------------------------------------------------
4399 
4400  if ( .not. file_opened(fid) ) return
4401 
4402  call file_enddef_c( file_files(fid)%fid, error )
4403 
4404  if ( error == file_success_code ) then
4405 
4406  log_newline
4407  log_info("FILE_enddef",'(1x,A,I3.3,2A)') &
4408  'End define mode : No.', fid, ', name = ', trim(file_files(fid)%name)
4409 
4410  else
4411  log_error("FILE_enddef",*) 'failed to exit define mode'
4412  call prc_abort
4413  end if
4414 
4415  return
4416  end subroutine file_enddef
4417 
4418  !-----------------------------------------------------------------------------
4419  ! This subroutine is used when PnetCDF I/O method is enabled
4420  subroutine file_attach_buffer( &
4421  fid, &
4422  buf_amount )
4423  implicit none
4424 
4425  integer, intent(in) :: fid
4426  integer(8), intent(in) :: buf_amount
4427 
4428  integer :: error
4429  !---------------------------------------------------------------------------
4430 
4431  if ( .not. file_opened(fid) ) return
4432 
4433  call file_attach_buffer_c( file_files(fid)%fid, buf_amount, error )
4434 
4435  if ( error == file_success_code ) then
4436 
4437  log_newline
4438  log_info("FILE_attach_buffer",'(1x,A,I3.3,3A,I10)') &
4439  'Attach buffer : No.', fid, ', name = ', trim(file_files(fid)%name), &
4440  ', size = ', buf_amount
4441  else
4442  log_error("FILE_attach_buffer",*) 'failed to attach buffer in PnetCDF'
4443  call prc_abort
4444  end if
4445 
4446  return
4447  end subroutine file_attach_buffer
4448 
4449  !-----------------------------------------------------------------------------
4450  ! This subroutine is used when PnetCDF I/O method is enabled
4451  subroutine file_detach_buffer( fid )
4452  implicit none
4453 
4454  integer, intent(in) :: fid
4455 
4456  integer :: error
4457  !---------------------------------------------------------------------------
4458 
4459  if ( .not. file_opened(fid) ) return
4460 
4461  if ( file_files(fid)%fid < 0 ) return ! already closed
4462 
4463  call file_detach_buffer_c( file_files(fid)%fid, error )
4464 
4465  if ( error == file_success_code ) then
4466 
4467  log_newline
4468  log_info("FILE_detach_buffer",'(1x,A,I3.3,2A)') &
4469  'Detach buffer : No.', fid, ', name = ', trim(file_files(fid)%name)
4470 
4471  else
4472  log_error("FILE_detach_buffer",*) 'failed to detach buffer in PnetCDF'
4473  call prc_abort
4474  end if
4475 
4476  return
4477  end subroutine file_detach_buffer
4478 
4479  !-----------------------------------------------------------------------------
4480  ! This subroutine is used when PnetCDF I/O method is enabled
4481  subroutine file_flush( fid )
4482  implicit none
4483 
4484  integer, intent(in) :: fid
4485 
4486  integer :: error
4487  !---------------------------------------------------------------------------
4488 
4489  if ( .not. file_opened(fid) ) return
4490 
4491  if ( file_files(fid)%fid < 0 ) return ! already closed
4492 
4493  call file_flush_c( file_files(fid)%fid, error )
4494 
4495  if ( error == file_success_code ) then
4496 
4497 !!$ LOG_NEWLINE
4498 !!$ LOG_INFO("FILE_flush",'(1xA,I3.3,2A)') &
4499 !!$ 'Flush : No.', fid, ', name = ', trim(FILE_files(fid)%name)
4500 
4501  else
4502  log_error("FILE_flush",*) 'failed to flush PnetCDF pending requests'
4503  call prc_abort
4504  end if
4505 
4506  return
4507  end subroutine file_flush
4508 
4509  !-----------------------------------------------------------------------------
4510  subroutine file_close( fid, skip_abort )
4511  implicit none
4512  integer, intent(in) :: fid
4513  logical, intent(in), optional :: skip_abort
4514 
4515  logical :: skip_abort_
4516  integer :: error
4517  integer :: n
4518  !---------------------------------------------------------------------------
4519 
4520  if ( .not. file_opened(fid) ) return
4521 
4522  if ( file_files(fid)%fid < 0 ) return ! already closed
4523 
4524  if ( present(skip_abort) ) then
4525  skip_abort_ = skip_abort
4526  else
4527  skip_abort_ = .false.
4528  end if
4529 
4530  call file_close_c( file_files(fid)%fid, error )
4531 
4532  if ( error == file_success_code ) then
4533 
4534  log_newline
4535  log_info("FILE_close",'(1x,A,I3.3,2A)') &
4536  'Close : No.', fid, ', name = ', trim(file_files(fid)%name)
4537 
4538  elseif( error /= file_already_closed_code ) then
4539  log_error("FILE_close",*) 'failed to close file'
4540  if ( .not. skip_abort_ ) call prc_abort
4541  end if
4542 
4543  file_files(fid)%fid = -1
4544  file_files(fid)%name = ''
4545  file_files(fid)%aggregate = .false.
4546 
4547  do n = 1, file_nvars
4548  if ( file_vars(n)%fid == fid ) then
4549  file_vars(n)%vid = -1
4550  file_vars(n)%name = ''
4551  end if
4552  end do
4553 
4554  return
4555  end subroutine file_close
4556  !-----------------------------------------------------------------------------
4557  subroutine file_close_all( &
4558  skip_abort )
4559  implicit none
4560  logical, intent(in), optional :: skip_abort
4561 
4562  integer :: fid
4563  !---------------------------------------------------------------------------
4564 
4565  do fid = 1, file_nfiles
4566  call file_close( fid, skip_abort )
4567  enddo
4568 
4569  return
4570  end subroutine file_close_all
4571 
4572  subroutine file_make_fname( &
4573  basename, &
4574  prefix, &
4575  rankid, &
4576  len, &
4577  fname )
4578  character(len=*), intent( in) :: basename
4579  character(len=*), intent( in) :: prefix
4580  integer, intent( in) :: rankid
4581  integer, intent( in) :: len
4582  character(len=*), intent(out) :: fname
4583 
4584  ! 12345678901234567
4585  character(len=17) :: fmt = "(A, '.', A, I*.*)"
4586  !---------------------------------------------------------------------------
4587 
4588  if ( len < 1 .or. len > 9 ) then
4589  log_error("FILE_make_fname",*) 'len is invalid'
4590  call prc_abort
4591  end if
4592 
4593  write(fmt(14:14),'(I1)') len
4594  write(fmt(16:16),'(I1)') len
4595  write(fname, fmt) trim(basename), trim(prefix), rankid
4596 
4597  return
4598  end subroutine file_make_fname
4599 
4600  !-----------------------------------------------------------------------------
4602  !-----------------------------------------------------------------------------
4603  subroutine file_get_cftunits(date, tunits)
4604  implicit none
4605 
4606  integer, intent(in) :: date(6)
4607  character(len=*), intent(out) :: tunits
4608  !---------------------------------------------------------------------------
4609 
4610  write(tunits,'(a,i4.4,"-",i2.2,"-",i2.2," ",i2.2,":",i2.2,":",i2.2)') 'seconds since ', date
4611 
4612  return
4613  end subroutine file_get_cftunits
4614 
4615  function file_get_aggregate( fid )
4616  integer, intent(in) :: fid
4617  logical :: FILE_get_aggregate
4618 
4619  if ( .not. file_opened(fid) ) then
4620  file_get_aggregate = .false.
4621  else
4622  file_get_aggregate = file_files(fid)%aggregate
4623  end if
4624 
4625  return
4626  end function file_get_aggregate
4627 
4628  !-----------------------------------------------------------------------------
4629  ! private
4630  !-----------------------------------------------------------------------------
4631 
4632  !-----------------------------------------------------------------------------
4633  subroutine file_get_fid( &
4634  basename, &
4635  mode, &
4636  rankid, &
4637  single, &
4638  fid, &
4639  existed, &
4640  aggregate, &
4641  postfix )
4642  use scale_prc, only: &
4643  prc_local_comm_world, &
4644  prc_comm_null
4645  implicit none
4646 
4647  character(len=*), intent( in) :: basename
4648  integer, intent( in) :: mode
4649  integer, intent( in) :: rankid
4650  logical, intent( in) :: single
4651 
4652  integer, intent(out) :: fid
4653  logical, intent(out) :: existed
4654 
4655  logical, intent( in), optional :: aggregate
4656  character(len=*), intent( in), optional :: postfix
4657 
4658  character(len=FILE_HSHORT) :: rwname(0:2)
4659  data rwname / 'READ','WRITE','APPEND' /
4660 
4661  character(len=FILE_HLONG) :: fname
4662  integer :: n
4663 
4664  logical :: aggregate_
4665  integer :: cfid
4666  integer :: error
4667  integer :: mpi_comm
4668  !---------------------------------------------------------------------------
4669 
4670  !--- check aggregate (parallel I/O on a single shared netCDF file)
4671 
4672  ! check to do PnetCDF I/O
4673  if ( present(aggregate) ) then
4674  aggregate_ = aggregate
4675  else
4676  aggregate_ = file_aggregate
4677  end if
4678 
4679  if ( aggregate_ ) then
4680  mpi_comm = prc_local_comm_world
4681  else
4682  mpi_comm = prc_comm_null
4683  end if
4684 
4685  if ( present(postfix) ) then
4686  fname = trim(basename)//trim(postfix)
4687  elseif ( aggregate_ ) then
4688  fname = basename
4689  elseif ( single ) then
4690  fname = trim(basename)//'.peall'
4691  else
4692  call file_make_fname( basename, 'pe', rankid, 6, fname )
4693  endif
4694 
4695  !--- search existing file
4696  fid = -1
4697  do n = 1, file_nfiles
4698  if ( fname == file_files(n)%name ) then
4699  fid = n
4700  exit
4701  end if
4702  enddo
4703 
4704  if ( file_opened(fid) ) then
4705  existed = .true.
4706  return
4707  end if
4708 
4709  call file_open_c( cfid, & ! (out)
4710  fname, mode, mpi_comm, & ! (in)
4711  error ) ! (out)
4712 
4713  if ( error /= file_success_code ) then
4714  log_error("FILE_get_fid",*) 'failed to open file :'//trim(fname)//'.nc'
4715  call prc_abort
4716  end if
4717 
4718  file_nfiles = file_nfiles + 1
4719  fid = file_nfiles
4720 
4721  file_files(fid)%name = fname
4722  file_files(fid)%fid = cfid
4723  file_files(fid)%aggregate = aggregate_
4724 
4725  log_newline
4726  log_info("FILE_get_fid",'(1x,A,A6,A,I3.3,2A)') &
4727  'Registration (', trim(rwname(mode)), ') : No.', fid, ', name = ', trim(fname)
4728 
4729  existed = .false.
4730 
4731  return
4732  end subroutine file_get_fid
4733 
4734 
4735 end module scale_file
4736 !-------------------------------------------------------------------------------
4737 
4738 
4739 !--
4740 ! vi:set readonly sw=4 ts=8
4741 !
4742 !Local Variables:
4743 !mode: f90
4744 !buffer-read-only: t
4745 !End:
4746 !
4747 !++
scale_file::file_close_all
subroutine, public file_close_all(skip_abort)
Definition: scale_file.F90:4559
scale_file::file_get_stepsize
subroutine, public file_get_stepsize(fid, varname, len, error)
get number of steps
Definition: scale_file.F90:2240
file_get_attribute_int_c
int32_t file_get_attribute_int_c(const int32_t fid, const char *vname, const char *key, const int32_t suppress, int32_t *value, const size_t len)
scale_file::file_close
subroutine, public file_close(fid, skip_abort)
Definition: scale_file.F90:4511
file_get_attribute_double_c
int32_t file_get_attribute_double_c(const int32_t fid, const char *vname, const char *key, const int32_t suppress, double *value, const size_t len)
Definition: scale_file_netcdf.c:967
scale_file_h::file_success_code
integer, parameter, public file_success_code
Definition: scale_file_h.F90:38
scale_prc::prc_set_file_closer
subroutine, public prc_set_file_closer(routine)
Definition: scale_prc.F90:972
file_set_attribute_int_c
int32_t file_set_attribute_int_c(const int32_t fid, const char *vname, const char *key, const int32_t *value, const size_t len)
Definition: scale_file_netcdf.c:1051
scale_file_h::file_fappend
integer, parameter, public file_fappend
Definition: scale_file_h.F90:34
file_write_axis_c
int32_t file_write_axis_c(const int32_t fid, const char *name, const void *val, const int32_t precision, const MPI_Offset *start, const MPI_Offset *count)
Definition: scale_file_netcdf.c:1321
scale_file::file_aggregate
logical, public file_aggregate
Definition: scale_file.F90:171
file_detach_buffer_c
int32_t file_detach_buffer_c(const int32_t fid)
Definition: scale_file_netcdf.c:1801
scale_file::file_def_axis
subroutine, public file_def_axis(fid, name, desc, units, dim_name, dtype, dim_size, bounds)
Definition: scale_file.F90:627
scale_prc::prc_comm_null
integer, parameter, public prc_comm_null
Definition: scale_prc.F90:67
file_set_attribute_double_c
int32_t file_set_attribute_double_c(const int32_t fid, const char *vname, const char *key, const double *value, const size_t len)
Definition: scale_file_netcdf.c:1136
scale_file::file_set_option
subroutine, public file_set_option(fid, filetype, key, val)
Definition: scale_file.F90:433
file_put_axis_c
int32_t file_put_axis_c(const int32_t fid, const char *name, const char *desc, const char *units, const char *dim_name, const int32_t dtype, const void *val, const int32_t size, const int32_t precision)
Definition: scale_file_netcdf.c:1207
file_get_nvars_c
int32_t file_get_nvars_c(const int32_t fid, int32_t *nvars)
Definition: scale_file_netcdf.c:296
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:55
file_get_step_size_c
int32_t file_get_step_size_c(const int32_t fid, const char *varname, int32_t *len)
Definition: scale_file_netcdf.c:633
scale_file::file_detach_buffer
subroutine, public file_detach_buffer(fid)
Definition: scale_file.F90:4452
file_get_attribute_text_c
int32_t file_get_attribute_text_c(const int32_t fid, const char *vname, const char *key, const int32_t suppress, char *value, const int32_t len)
Definition: scale_file_netcdf.c:834
scale_file::file_open
subroutine, public file_open(basename, fid, mode, single, aggregate, rankid, postfix)
Definition: scale_file.F90:464
scale_file::file_attach_buffer
subroutine, public file_attach_buffer(fid, buf_amount)
Definition: scale_file.F90:4423
scale_file::file_flush
subroutine, public file_flush(fid)
Definition: scale_file.F90:4482
file_write_associatedcoordinate_c
int32_t file_write_associatedcoordinate_c(const int32_t fid, const char *name, const void *val, const int32_t precision, const MPI_Offset *start, const MPI_Offset *count)
Definition: scale_file_netcdf.c:1466
file_put_associatedcoordinate_c
int32_t file_put_associatedcoordinate_c(const int32_t fid, const char *name, const char *desc, const char *units, const char **dim_names, const int32_t ndims, const int32_t dtype, const void *val, const int32_t precision)
Definition: scale_file_netcdf.c:1363
scale_file
module file
Definition: scale_file.F90:15
file_open_c
int32_t file_open_c(int32_t *fid, const char *fname, const int32_t mode, const MPI_Comm comm)
Definition: scale_file_netcdf.c:170
scale_file_h::file_file_max
integer, parameter, public file_file_max
Definition: scale_file_h.F90:43
scale_file_h::file_fread
integer, parameter, public file_fread
Definition: scale_file_h.F90:32
file_set_tunits_c
int32_t file_set_tunits_c(const int32_t fid, const char *time_units, const char *calendar)
Definition: scale_file_netcdf.c:1197
file_set_option_c
int32_t file_set_option_c(const int32_t fid, const char *filetype, const char *key, const char *val)
Definition: scale_file_netcdf.c:280
file_get_datainfo_c
int32_t file_get_datainfo_c(datainfo_t *dinfo, const int32_t fid, const char *varname, const int32_t step, const int32_t suppress)
Definition: scale_file_netcdf.c:338
scale_prc
module PROCESS
Definition: scale_prc.F90:11
file_get_varname_c
int32_t file_get_varname_c(const int32_t fid, const int32_t vid, char *name, const int32_t len)
Definition: scale_file_netcdf.c:313
file_close_c
int32_t file_close_c(const int32_t fid)
Definition: scale_file_netcdf.c:1953
file_add_variable_c
int32_t file_add_variable_c(const int32_t fid, const char *varname, const char *desc, const char *units, const char *stdname, const char **dims, const int32_t ndims, const int32_t dtype, const real64_t tint, const int32_t tavg, int32_t *vid)
Definition: scale_file_netcdf.c:1508
scale_file::file_def_variable
subroutine, public file_def_variable(fid, varname, desc, units, standard_name, ndims, dims, dtype, vid, time_int, time_avg, existed)
Definition: scale_file.F90:1531
scale_file_h::file_already_closed_code
integer, parameter, public file_already_closed_code
Definition: scale_file_h.F90:39
scale_file::file_opened
logical function, public file_opened(fid)
check if the file is opened?
Definition: scale_file.F90:504
scale_file::file_setup
subroutine, public file_setup(myrank)
setup
Definition: scale_file.F90:208
file_write_data_c
int32_t file_write_data_c(const int32_t fid, const int32_t vid, const void *var, const real64_t t_start, const real64_t t_end, const int32_t precision, const int32_t ndims, const int32_t *start, const int32_t *count)
Definition: scale_file_netcdf.c:1829
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
file_flush_c
int32_t file_flush_c(const int32_t fid)
Definition: scale_file_netcdf.c:1814
scale_file_h::datainfo
Definition: scale_file_h.F90:51
file_set_attribute_text_c
int32_t file_set_attribute_text_c(const int32_t fid, const char *vname, const char *key, const char *value)
Definition: scale_file_netcdf.c:1010
scale_file_h::file_var_max
integer, parameter, public file_var_max
Definition: scale_file_h.F90:44
scale_file_h::file_rmiss
real(dp), parameter, public file_rmiss
Definition: scale_file_h.F90:48
scale_file::file_create
subroutine, public file_create(basename, title, source, institution, fid, existed, rankid, single, aggregate, time_units, calendar, append)
create file fid is >= 1
Definition: scale_file.F90:248
scale_file_h::file_already_existed_code
integer, parameter, public file_already_existed_code
Definition: scale_file_h.F90:40
scale_file::file_get_aggregate
logical function, public file_get_aggregate(fid)
Definition: scale_file.F90:4616
file_def_associatedcoordinate_c
int32_t file_def_associatedcoordinate_c(const int32_t fid, const char *name, const char *desc, const char *units, const char **dim_names, const int32_t ndims, const int32_t dtype)
Definition: scale_file_netcdf.c:1416
file_read_data_c
int32_t file_read_data_c(void *var, const datainfo_t *dinfo, const int32_t precision, const MPI_Offset ntypes, const MPI_Datatype dtype, const int32_t *start, const int32_t *count)
Definition: scale_file_netcdf.c:687
scale_file::file_def_associatedcoordinate
subroutine, public file_def_associatedcoordinate(fid, name, desc, units, dim_names, dtype)
Definition: scale_file.F90:997
scale_file::file_make_fname
subroutine, public file_make_fname(basename, prefix, rankid, len, fname)
Definition: scale_file.F90:4578
scale_prof
module profiler
Definition: scale_prof.F90:11
file_enddef_c
int32_t file_enddef_c(const int32_t fid)
Definition: scale_file_netcdf.c:1776
file_def_axis_c
int32_t file_def_axis_c(const int32_t fid, const char *name, const char *desc, const char *units, const char *dim_name, const int32_t dtype, const int32_t dim_size, const int32_t bounds)
Definition: scale_file_netcdf.c:1256
scale_precision
module PRECISION
Definition: scale_precision.F90:14
file_set_attribute_float_c
int32_t file_set_attribute_float_c(const int32_t fid, const char *vname, const char *key, const float *value, const size_t len)
Definition: scale_file_netcdf.c:1094
scale_prc::prc_local_comm_world
integer, public prc_local_comm_world
local communicator
Definition: scale_prc.F90:87
file_get_attribute_float_c
int32_t file_get_attribute_float_c(const int32_t fid, const char *vname, const char *key, const int32_t suppress, float *value, const size_t len)
Definition: scale_file_netcdf.c:924
scale_precision::sp
integer, parameter, public sp
Definition: scale_precision.F90:31
scale_io
module STDIO
Definition: scale_io.F90:10
scale_file::file_add_associatedvariable
subroutine, public file_add_associatedvariable(fid, vname, existed)
Definition: scale_file.F90:399
scale_file_h::file_fwrite
integer, parameter, public file_fwrite
Definition: scale_file_h.F90:33
file_attach_buffer_c
int32_t file_attach_buffer_c(const int32_t fid, const int64_t buf_amount)
Definition: scale_file_netcdf.c:1787
scale_precision::dp
integer, parameter, public dp
Definition: scale_precision.F90:32
file_get_dim_length_c
int32_t file_get_dim_length_c(const int32_t fid, const char *dimname, int32_t *len)
Definition: scale_file_netcdf.c:256
scale_file::file_enddef
subroutine, public file_enddef(fid)
Definition: scale_file.F90:4393
scale_file_h
module file_h
Definition: scale_file_h.F90:11
file_add_associatedvariable_c
int32_t file_add_associatedvariable_c(const int32_t fid, const char *vname)
Definition: scale_file_netcdf.c:1174
scale_file::file_get_dimlength
subroutine, public file_get_dimlength(fid, dimname, len, error)
get length of dimension
Definition: scale_file.F90:525
scale_file::file_get_cftunits
subroutine, public file_get_cftunits(date, tunits)
get unit of time
Definition: scale_file.F90:4604
Generated by   doxygen 1.8.13