SCALE-RM
gtool_file.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
13 !-------------------------------------------------------------------------------
14 ! Warning: This file was generated from gtool_file.f90.erb.
15 ! Do not edit this file.
16 !-------------------------------------------------------------------------------
17 module gtool_file
18  !-----------------------------------------------------------------------------
19  !
20  !++ Used modules
21  !
22  use gtool_file_h
23  use dc_log, only: &
24  log, &
25  log_lmsg
26  use dc_types, only: &
27  dp, &
28  sp
29  !-----------------------------------------------------------------------------
30  implicit none
31  private
32  !-----------------------------------------------------------------------------
33  !
34  !++ Public procedures
35  !
36  public :: fileopen
37  public :: filecreate
38  public :: filesetoption
39  public :: fileputaxis
40  public :: fileputassociatedcoordinates
41  public :: fileaddvariable
42  public :: filesettattr
43  public :: filegetshape
44  public :: filegetdatainfo
45  public :: filegetalldatainfo
46  public :: fileread
47  public :: filewrite
48  public :: filegetglobalattribute
49  public :: filesetglobalattribute
50  public :: fileclose
51  public :: filecloseall
52  public :: filemakefname
53 
54  interface fileputaxis
55  module procedure fileputaxisrealsp
56  module procedure fileputaxisrealdp
57  end interface fileputaxis
58  interface fileputassociatedcoordinates
59  module procedure fileput1dassociatedcoordinatesrealsp
60  module procedure fileput1dassociatedcoordinatesrealdp
61  module procedure fileput2dassociatedcoordinatesrealsp
62  module procedure fileput2dassociatedcoordinatesrealdp
63  module procedure fileput3dassociatedcoordinatesrealsp
64  module procedure fileput3dassociatedcoordinatesrealdp
65  module procedure fileput4dassociatedcoordinatesrealsp
66  module procedure fileput4dassociatedcoordinatesrealdp
67  end interface fileputassociatedcoordinates
68  interface fileaddvariable
69  module procedure fileaddvariablenot
70  module procedure fileaddvariablerealsp
71  module procedure fileaddvariablerealdp
72  end interface fileaddvariable
73  interface fileread
74  module procedure fileread1drealsp
75  module procedure fileread1drealdp
76  module procedure fileread2drealsp
77  module procedure fileread2drealdp
78  module procedure fileread3drealsp
79  module procedure fileread3drealdp
80  module procedure fileread4drealsp
81  module procedure fileread4drealdp
82  end interface fileread
83  interface filewrite
84  module procedure filewrite1drealsp
85  module procedure filewrite1drealdp
86  module procedure filewrite2drealsp
87  module procedure filewrite2drealdp
88  module procedure filewrite3drealsp
89  module procedure filewrite3drealdp
90  module procedure filewrite4drealsp
91  module procedure filewrite4drealdp
92  end interface filewrite
93  interface filegetglobalattribute
94  module procedure filegetglobalattributetext
95  module procedure filegetglobalattributeint
96  module procedure filegetglobalattributefloat
97  module procedure filegetglobalattributedouble
98  end interface filegetglobalattribute
99  interface filesetglobalattribute
100  module procedure filesetglobalattributetext
101  module procedure filesetglobalattributeint
102  module procedure filesetglobalattributefloat
103  module procedure filesetglobalattributedouble
104  end interface filesetglobalattribute
105 
106  !-----------------------------------------------------------------------------
107  !
108  !++ Public parameters & variables
109  !
110  real(DP), parameter, public :: rmiss = -9.9999e+30
111  !-----------------------------------------------------------------------------
112  !
113  !++ Private procedures
114  !
115  !-----------------------------------------------------------------------------
116  !
117  !++ Private parameters & variables
118  !
119  integer, private, parameter :: file_nfile_max = 512 ! number limit of file
120  ! Keep consistency with "FILE_MAX" in gtool_netcdf.c
121  integer, private, parameter :: file_nvar_max = 40960 ! number limit of variables
122  ! Keep consistency with "VAR_MAX" in gtool_netcdf.c
123 
124  character(LEN=File_HLONG), private, save :: file_fname_list(file_nfile_max)
125  integer, private, save :: file_fid_list (file_nfile_max)
126  integer, private, save :: file_fid_count = 1
127  character(LEN=File_HLONG), private, save :: file_vname_list (file_nvar_max)
128  integer, private, save :: file_vid_fid_list(file_nvar_max)
129  integer, private, save :: file_vid_list (file_nvar_max)
130  integer, private, save :: file_vid_count = 1
131  integer, private, save :: mpi_myrank
132 
133  character(LEN=LOG_LMSG), private :: message
134 
135 contains
136  !-----------------------------------------------------------------------------
137  subroutine filecreate( &
138  fid, & ! (out)
139  existed, & ! (out)
140  basename, & ! (in)
141  title, & ! (in)
142  source, & ! (in)
143  institution, & ! (in)
144  master, & ! (in)
145  myrank, & ! (in)
146  rankidx, & ! (in)
147  single, & ! (in) optional
148  time_units, & ! (in) optional
149  append ) ! (in) optional
150  implicit none
151 
152  integer, intent(out) :: fid
153  logical, intent(out) :: existed
154  character(LEN=*), intent( in) :: basename
155  character(LEN=*), intent( in) :: title
156  character(LEN=*), intent( in) :: source
157  character(LEN=*), intent( in) :: institution
158  integer, intent( in) :: master
159  integer, intent( in) :: myrank
160  integer, intent( in) :: rankidx(:)
161  character(LEN=*), intent( in), optional :: time_units
162  logical, intent( in), optional :: single
163  logical, intent( in), optional :: append
164 
165  character(len=File_HMID) :: time_units_
166  logical :: single_
167  integer :: mode
168  integer :: error
169 
170  intrinsic size
171 
172  if ( present(time_units) ) then
173  time_units_ = time_units
174  else
175  time_units_ = 'seconds'
176  end if
177 
178  mpi_myrank = myrank
179 
180  if ( present(single) ) then
181  if ( single .and. (myrank .ne. master) ) return
182  single_ = single
183  else
184  single_ = .false.
185  endif
186 
187  mode = file_fwrite
188  if ( present(append) ) then
189  if ( append ) mode = file_fappend
190  end if
191 
192  call filegetfid( &
193  fid, & ! (out)
194  existed, & ! (out)
195  basename, & ! (in)
196  mode, & ! (in)
197  single_ & ! (in)
198  )
199 
200  if ( existed ) return
201 
202  !--- append package header to the file
203  call filesetglobalattribute( fid, & ! (in)
204  "title", title ) ! (in)
205  call filesetglobalattribute( fid, & ! (in)
206  "source", source ) ! (in)
207  call filesetglobalattribute( fid, & ! (in)
208  "institution", institution ) ! (in)
209  call filesetglobalattribute( fid, & ! (in)
210  "myrank", (/myrank/) ) ! (in)
211  call filesetglobalattribute( fid, & ! (in)
212  "rankidx", rankidx ) ! (in)
213 
214  call file_set_tunits( fid, & ! (in)
215  time_units_, & ! (in)
216  error ) ! (out)
217  if ( error /= success_code ) then
218  call log('E', 'xxx failed to set time units')
219  end if
220 
221  return
222  end subroutine filecreate
223 
224  !-----------------------------------------------------------------------------
225  subroutine filegetglobalattributetext( &
226  fid, & ! (in)
227  key, & ! (in)
228  val & ! (out)
229  )
230  integer, intent(in) :: fid
231  character(LEN=*), intent(in) :: key
232  character(LEN=*), intent(out) :: val
233 
234  integer error
235 
236  intrinsic size
237 
238  call file_get_global_attribute_text( & ! (in)
239  fid, key, & ! (in)
240  val, error ) ! (out)
241  if ( error /= success_code ) then
242  call log('E', 'xxx failed to get text global attribute: '//trim(key))
243  end if
244 
245  return
246  end subroutine filegetglobalattributetext
247 
248  !-----------------------------------------------------------------------------
249  subroutine filegetglobalattributeint( &
250  fid, & ! (in)
251  key, & ! (in)
252  val & ! (out)
253  )
254  integer, intent(in) :: fid
255  character(LEN=*), intent(in) :: key
256  integer, intent(out) :: val(:)
257 
258  integer error
259 
260  intrinsic size
261 
262  call file_get_global_attribute_int( & ! (in)
263  fid, key, size(val), & ! (in)
264  val, error ) ! (out)
265  if ( error /= success_code ) then
266  call log('E', 'xxx failed to get integer global attribute: '//trim(key))
267  end if
268 
269  return
270  end subroutine filegetglobalattributeint
271 
272  !-----------------------------------------------------------------------------
273  subroutine filegetglobalattributefloat( &
274  fid, & ! (in)
275  key, & ! (in)
276  val & ! (out)
277  )
278  integer, intent(in) :: fid
279  character(LEN=*), intent(in) :: key
280  real(SP), intent(out) :: val(:)
281 
282  integer error
283 
284  intrinsic size
285 
286  call file_get_global_attribute_float( & ! (in)
287  fid, key, size(val), & ! (in)
288  val, error ) ! (out)
289  if ( error /= success_code ) then
290  call log('E', 'xxx failed to get float global attribute: '//trim(key))
291  end if
292 
293  return
294  end subroutine filegetglobalattributefloat
295 
296  !-----------------------------------------------------------------------------
297  subroutine filegetglobalattributedouble( &
298  fid, & ! (in)
299  key, & ! (in)
300  val & ! (out)
301  )
302  integer, intent(in) :: fid
303  character(LEN=*), intent(in) :: key
304  real(DP), intent(out) :: val(:)
305 
306  integer error
307 
308  intrinsic size
309 
310  call file_get_global_attribute_double( & ! (in)
311  fid, key, size(val), & ! (in)
312  val, error ) ! (out)
313  if ( error /= success_code ) then
314  call log('E', 'xxx failed to get double global attribute: '//trim(key))
315  end if
316 
317  return
318  end subroutine filegetglobalattributedouble
319 
320 
321  !-----------------------------------------------------------------------------
322  subroutine filesetglobalattributetext( &
323  fid, & ! (in)
324  key, & ! (in)
325  val & ! (in)
326  )
327  integer, intent(in) :: fid
328  character(LEN=*), intent(in) :: key
329  character(LEN=*), intent(in) :: val
330 
331  integer error
332 
333  call file_set_global_attribute_text( fid, & ! (in)
334  key, val, & ! (in)
335  error ) ! (out)
336  if ( error /= success_code ) then
337  call log('E', 'xxx failed to set text global attribute: '//trim(key))
338  end if
339 
340  return
341  end subroutine filesetglobalattributetext
342 
343  !-----------------------------------------------------------------------------
344  subroutine filesetglobalattributeint( &
345  fid, & ! (in)
346  key, & ! (in)
347  val & ! (in)
348  )
349  integer, intent(in) :: fid
350  character(LEN=*), intent(in) :: key
351  integer, intent(in) :: val(:)
352 
353  integer error
354 
355  intrinsic size
356 
357  call file_set_global_attribute_int( fid, & ! (in)
358  key, val, size(val), & ! (in)
359  error ) ! (out)
360  if ( error /= success_code ) then
361  call log('E', 'xxx failed to set integer global attribute: '//trim(key))
362  end if
363 
364  return
365  end subroutine filesetglobalattributeint
366 
367  !-----------------------------------------------------------------------------
368  subroutine filesetglobalattributefloat( &
369  fid, & ! (in)
370  key, & ! (in)
371  val & ! (in)
372  )
373  integer, intent(in) :: fid
374  character(LEN=*), intent(in) :: key
375  real(SP), intent(in) :: val(:)
376 
377  integer error
378 
379  intrinsic size
380 
381  call file_set_global_attribute_float( fid, & ! (in)
382  key, val, size(val), & ! (in)
383  error ) ! (out)
384  if ( error /= success_code ) then
385  call log('E', 'xxx failed to set float global attribute: '//trim(key))
386  end if
387 
388  return
389  end subroutine filesetglobalattributefloat
390 
391  !-----------------------------------------------------------------------------
392  subroutine filesetglobalattributedouble( &
393  fid, & ! (in)
394  key, & ! (in)
395  val & ! (in)
396  )
397  integer, intent(in) :: fid
398  character(LEN=*), intent(in) :: key
399  real(DP), intent(in) :: val(:)
400 
401  integer error
402 
403  intrinsic size
404 
405  call file_set_global_attribute_double( fid, & ! (in)
406  key, val, size(val), & ! (in)
407  error ) ! (out)
408  if ( error /= success_code ) then
409  call log('E', 'xxx failed to set double global attribute: '//trim(key))
410  end if
411 
412  return
413  end subroutine filesetglobalattributedouble
414 
415  !-----------------------------------------------------------------------------
416  subroutine filesetoption( &
417  fid, & ! (in)
418  filetype, & ! (in)
419  key, & ! (in)
420  val & ! (in)
421  )
422  integer, intent(in) :: fid
423  character(LEN=*), intent(in) :: filetype
424  character(LEN=*), intent(in) :: key
425  character(LEN=*), intent(in) :: val
426 
427  integer error
428 
429  call file_set_option( fid, & ! (in)
430  filetype, key, val, & ! (in)
431  error ) ! (out)
432  if ( error /= success_code ) then
433  call log('E', 'xxx failed to set option')
434  end if
435 
436  return
437  end subroutine filesetoption
438 
439  !-----------------------------------------------------------------------------
440  subroutine fileopen( &
441  fid, & ! (out)
442  basename, & ! (in)
443  mode, & ! (in)
444  single & ! (in) optional
445  )
446  implicit none
447 
448  integer, intent(out) :: fid
449  character(LEN=*), intent( in) :: basename
450  integer, intent( in) :: mode
451  logical, intent( in), optional :: single
452 
453  logical :: existed
454  logical :: single_ = .false.
455 
456  if ( present(single) ) single_ = single
457 
458  call filegetfid( fid, & ! (out)
459  existed, & ! (out)
460  basename, mode, single_ ) ! (in)
461 
462  return
463  end subroutine fileopen
464 
465  !-----------------------------------------------------------------------------
466  ! interface FilePutAxis
467  !-----------------------------------------------------------------------------
468  subroutine fileputaxisrealsp( &
469  fid, & ! (in)
470  name, & ! (in)
471  desc, & ! (in)
472  units, & ! (in)
473  dim_name, & ! (in)
474  dtype, & ! (in)
475  val ) ! (in)
476  integer, intent(in) :: fid
477  character(len=*), intent(in) :: name
478  character(len=*), intent(in) :: desc
479  character(len=*), intent(in) :: units
480  character(len=*), intent(in) :: dim_name
481  integer, intent(in) :: dtype
482  real(SP), intent(in) :: val(:)
483 
484  integer error
485  intrinsic size
486 
487  call file_put_axis( fid, & ! (in)
488  name, desc, units, dim_name, dtype, val, size(val), sp, & ! (in)
489  error ) ! (out)
490  if ( error /= success_code .and. error /= already_existed_code ) then
491  call log('E', 'xxx failed to put axis')
492  end if
493 
494  return
495  end subroutine fileputaxisrealsp
496  subroutine fileputaxisrealdp( &
497  fid, & ! (in)
498  name, & ! (in)
499  desc, & ! (in)
500  units, & ! (in)
501  dim_name, & ! (in)
502  dtype, & ! (in)
503  val ) ! (in)
504  integer, intent(in) :: fid
505  character(len=*), intent(in) :: name
506  character(len=*), intent(in) :: desc
507  character(len=*), intent(in) :: units
508  character(len=*), intent(in) :: dim_name
509  integer, intent(in) :: dtype
510  real(DP), intent(in) :: val(:)
511 
512  integer error
513  intrinsic size
514 
515  call file_put_axis( fid, & ! (in)
516  name, desc, units, dim_name, dtype, val, size(val), dp, & ! (in)
517  error ) ! (out)
518  if ( error /= success_code .and. error /= already_existed_code ) then
519  call log('E', 'xxx failed to put axis')
520  end if
521 
522  return
523  end subroutine fileputaxisrealdp
524 
525  !-----------------------------------------------------------------------------
526  ! interface FilePutAssociatedCoordinates
527  !-----------------------------------------------------------------------------
528  subroutine fileput1dassociatedcoordinatesrealsp( &
529  fid, & ! (in)
530  name, & ! (in)
531  desc, & ! (in)
532  units, & ! (in)
533  dim_names, & ! (in)
534  dtype, & ! (in)
535  val ) ! (in)
536  integer, intent(in) :: fid
537  character(len=*), intent(in) :: name
538  character(len=*), intent(in) :: desc
539  character(len=*), intent(in) :: units
540  character(len=*), intent(in) :: dim_names(:)
541  integer, intent(in) :: dtype
542  real(SP), intent(in) :: val(:)
543 
544  integer error
545  intrinsic size
546 
547  call file_put_associated_coordinates( fid, & ! (in)
548  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
549  val, sp, & ! (in)
550  error ) ! (out)
551  if ( error /= success_code .and. error /= already_existed_code ) then
552  call log('E', 'xxx failed to put associated coordinates')
553  end if
554 
555  return
556  end subroutine fileput1dassociatedcoordinatesrealsp
557  subroutine fileput1dassociatedcoordinatesrealdp( &
558  fid, & ! (in)
559  name, & ! (in)
560  desc, & ! (in)
561  units, & ! (in)
562  dim_names, & ! (in)
563  dtype, & ! (in)
564  val ) ! (in)
565  integer, intent(in) :: fid
566  character(len=*), intent(in) :: name
567  character(len=*), intent(in) :: desc
568  character(len=*), intent(in) :: units
569  character(len=*), intent(in) :: dim_names(:)
570  integer, intent(in) :: dtype
571  real(DP), intent(in) :: val(:)
572 
573  integer error
574  intrinsic size
575 
576  call file_put_associated_coordinates( fid, & ! (in)
577  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
578  val, dp, & ! (in)
579  error ) ! (out)
580  if ( error /= success_code .and. error /= already_existed_code ) then
581  call log('E', 'xxx failed to put associated coordinates')
582  end if
583 
584  return
585  end subroutine fileput1dassociatedcoordinatesrealdp
586  subroutine fileput2dassociatedcoordinatesrealsp( &
587  fid, & ! (in)
588  name, & ! (in)
589  desc, & ! (in)
590  units, & ! (in)
591  dim_names, & ! (in)
592  dtype, & ! (in)
593  val ) ! (in)
594  integer, intent(in) :: fid
595  character(len=*), intent(in) :: name
596  character(len=*), intent(in) :: desc
597  character(len=*), intent(in) :: units
598  character(len=*), intent(in) :: dim_names(:)
599  integer, intent(in) :: dtype
600  real(SP), intent(in) :: val(:,:)
601 
602  integer error
603  intrinsic size
604 
605  call file_put_associated_coordinates( fid, & ! (in)
606  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
607  val, sp, & ! (in)
608  error ) ! (out)
609  if ( error /= success_code .and. error /= already_existed_code ) then
610  call log('E', 'xxx failed to put associated coordinates')
611  end if
612 
613  return
614  end subroutine fileput2dassociatedcoordinatesrealsp
615  subroutine fileput2dassociatedcoordinatesrealdp( &
616  fid, & ! (in)
617  name, & ! (in)
618  desc, & ! (in)
619  units, & ! (in)
620  dim_names, & ! (in)
621  dtype, & ! (in)
622  val ) ! (in)
623  integer, intent(in) :: fid
624  character(len=*), intent(in) :: name
625  character(len=*), intent(in) :: desc
626  character(len=*), intent(in) :: units
627  character(len=*), intent(in) :: dim_names(:)
628  integer, intent(in) :: dtype
629  real(DP), intent(in) :: val(:,:)
630 
631  integer error
632  intrinsic size
633 
634  call file_put_associated_coordinates( fid, & ! (in)
635  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
636  val, dp, & ! (in)
637  error ) ! (out)
638  if ( error /= success_code .and. error /= already_existed_code ) then
639  call log('E', 'xxx failed to put associated coordinates')
640  end if
641 
642  return
643  end subroutine fileput2dassociatedcoordinatesrealdp
644  subroutine fileput3dassociatedcoordinatesrealsp( &
645  fid, & ! (in)
646  name, & ! (in)
647  desc, & ! (in)
648  units, & ! (in)
649  dim_names, & ! (in)
650  dtype, & ! (in)
651  val ) ! (in)
652  integer, intent(in) :: fid
653  character(len=*), intent(in) :: name
654  character(len=*), intent(in) :: desc
655  character(len=*), intent(in) :: units
656  character(len=*), intent(in) :: dim_names(:)
657  integer, intent(in) :: dtype
658  real(SP), intent(in) :: val(:,:,:)
659 
660  integer error
661  intrinsic size
662 
663  call file_put_associated_coordinates( fid, & ! (in)
664  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
665  val, sp, & ! (in)
666  error ) ! (out)
667  if ( error /= success_code .and. error /= already_existed_code ) then
668  call log('E', 'xxx failed to put associated coordinates')
669  end if
670 
671  return
672  end subroutine fileput3dassociatedcoordinatesrealsp
673  subroutine fileput3dassociatedcoordinatesrealdp( &
674  fid, & ! (in)
675  name, & ! (in)
676  desc, & ! (in)
677  units, & ! (in)
678  dim_names, & ! (in)
679  dtype, & ! (in)
680  val ) ! (in)
681  integer, intent(in) :: fid
682  character(len=*), intent(in) :: name
683  character(len=*), intent(in) :: desc
684  character(len=*), intent(in) :: units
685  character(len=*), intent(in) :: dim_names(:)
686  integer, intent(in) :: dtype
687  real(DP), intent(in) :: val(:,:,:)
688 
689  integer error
690  intrinsic size
691 
692  call file_put_associated_coordinates( fid, & ! (in)
693  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
694  val, dp, & ! (in)
695  error ) ! (out)
696  if ( error /= success_code .and. error /= already_existed_code ) then
697  call log('E', 'xxx failed to put associated coordinates')
698  end if
699 
700  return
701  end subroutine fileput3dassociatedcoordinatesrealdp
702  subroutine fileput4dassociatedcoordinatesrealsp( &
703  fid, & ! (in)
704  name, & ! (in)
705  desc, & ! (in)
706  units, & ! (in)
707  dim_names, & ! (in)
708  dtype, & ! (in)
709  val ) ! (in)
710  integer, intent(in) :: fid
711  character(len=*), intent(in) :: name
712  character(len=*), intent(in) :: desc
713  character(len=*), intent(in) :: units
714  character(len=*), intent(in) :: dim_names(:)
715  integer, intent(in) :: dtype
716  real(SP), intent(in) :: val(:,:,:,:)
717 
718  integer error
719  intrinsic size
720 
721  call file_put_associated_coordinates( fid, & ! (in)
722  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
723  val, sp, & ! (in)
724  error ) ! (out)
725  if ( error /= success_code .and. error /= already_existed_code ) then
726  call log('E', 'xxx failed to put associated coordinates')
727  end if
728 
729  return
730  end subroutine fileput4dassociatedcoordinatesrealsp
731  subroutine fileput4dassociatedcoordinatesrealdp( &
732  fid, & ! (in)
733  name, & ! (in)
734  desc, & ! (in)
735  units, & ! (in)
736  dim_names, & ! (in)
737  dtype, & ! (in)
738  val ) ! (in)
739  integer, intent(in) :: fid
740  character(len=*), intent(in) :: name
741  character(len=*), intent(in) :: desc
742  character(len=*), intent(in) :: units
743  character(len=*), intent(in) :: dim_names(:)
744  integer, intent(in) :: dtype
745  real(DP), intent(in) :: val(:,:,:,:)
746 
747  integer error
748  intrinsic size
749 
750  call file_put_associated_coordinates( fid, & ! (in)
751  name, desc, units, dim_names, size(dim_names), dtype, & ! (in)
752  val, dp, & ! (in)
753  error ) ! (out)
754  if ( error /= success_code .and. error /= already_existed_code ) then
755  call log('E', 'xxx failed to put associated coordinates')
756  end if
757 
758  return
759  end subroutine fileput4dassociatedcoordinatesrealdp
760 
761  !-----------------------------------------------------------------------------
762  ! interface FileAddVariable
763  !-----------------------------------------------------------------------------
764  subroutine fileaddvariablenot( &
765  vid, & ! (out)
766  fid, & ! (in)
767  varname, & ! (in)
768  desc, & ! (in)
769  units, & ! (in)
770  dims, & ! (in)
771  dtype, & ! (in)
772  tavg & ! (in) optional
773  )
774  integer, intent(out) :: vid
775  integer, intent( in) :: fid
776  character(len=*), intent( in) :: varname
777  character(len=*), intent( in) :: desc
778  character(len=*), intent( in) :: units
779  character(len=*), intent( in) :: dims(:)
780  integer, intent( in) :: dtype
781  logical, intent( in), optional :: tavg
782 
783  call fileaddvariablerealdp(vid, fid, varname, desc, units, dims, dtype, &
784  -1.0_dp, tavg )
785 
786  return
787  end subroutine fileaddvariablenot
788  subroutine fileaddvariablerealsp( &
789  vid, & ! (out)
790  fid, & ! (in)
791  varname, & ! (in)
792  desc, & ! (in)
793  units, & ! (in)
794  dims, & ! (in)
795  dtype, & ! (in)
796  tint, & ! (in)
797  tavg & ! (in) optional
798  )
799  integer, intent(out) :: vid
800  integer, intent( in) :: fid
801  character(len=*), intent( in) :: varname
802  character(len=*), intent( in) :: desc
803  character(len=*), intent( in) :: units
804  character(len=*), intent( in) :: dims(:)
805  integer, intent( in) :: dtype
806  real(SP), intent( in) :: tint
807  logical, intent( in), optional :: tavg
808 
809  real(DP) :: tint8
810  integer :: itavg
811  integer :: error
812  integer :: n
813 
814  intrinsic size
815  !---------------------------------------------------------------------------
816 
817  vid = -1
818  do n = 1, file_vid_count
819  if ( file_vid_fid_list(n) == fid .and. &
820  varname == file_vname_list(n) ) then
821  vid = file_vid_list(n)
822  end if
823  enddo
824 
825  if ( vid < 0 ) then ! variable registration
826  !--- register new variable
827  write(message,*) '*** [File] Var registration'
828  call log("I", message)
829  write(message,*) '*** variable name: ', trim(varname)
830  call log("I", message)
831 
832  tint8 = real(tint,dp)
833 
834  if ( present(tavg) ) then
835  if ( tavg ) then
836  itavg = 1
837  else
838  itavg = 0
839  end if
840  else
841  itavg = 0
842  end if
843 
844  call file_add_variable( vid, & ! (out)
845  fid, varname, desc, units, dims, size(dims), dtype, & ! (in)
846  tint8, itavg, & ! (in)
847  error ) ! (out)
848  if ( error /= success_code ) then
849  call log('E', 'xxx failed to add variable: '//trim(varname))
850  end if
851 
852  file_vname_list(file_vid_count) = trim(varname)
853  file_vid_list(file_vid_count) = vid
854  file_vid_fid_list(file_vid_count) = fid
855  file_vid_count = file_vid_count + 1
856  endif
857 
858  return
859  end subroutine fileaddvariablerealsp
860  subroutine fileaddvariablerealdp( &
861  vid, & ! (out)
862  fid, & ! (in)
863  varname, & ! (in)
864  desc, & ! (in)
865  units, & ! (in)
866  dims, & ! (in)
867  dtype, & ! (in)
868  tint, & ! (in)
869  tavg & ! (in) optional
870  )
871  integer, intent(out) :: vid
872  integer, intent( in) :: fid
873  character(len=*), intent( in) :: varname
874  character(len=*), intent( in) :: desc
875  character(len=*), intent( in) :: units
876  character(len=*), intent( in) :: dims(:)
877  integer, intent( in) :: dtype
878  real(DP), intent( in) :: tint
879  logical, intent( in), optional :: tavg
880 
881  real(DP) :: tint8
882  integer :: itavg
883  integer :: error
884  integer :: n
885 
886  intrinsic size
887  !---------------------------------------------------------------------------
888 
889  vid = -1
890  do n = 1, file_vid_count
891  if ( file_vid_fid_list(n) == fid .and. &
892  varname == file_vname_list(n) ) then
893  vid = file_vid_list(n)
894  end if
895  enddo
896 
897  if ( vid < 0 ) then ! variable registration
898  !--- register new variable
899  write(message,*) '*** [File] Var registration'
900  call log("I", message)
901  write(message,*) '*** variable name: ', trim(varname)
902  call log("I", message)
903 
904  tint8 = real(tint,dp)
905 
906  if ( present(tavg) ) then
907  if ( tavg ) then
908  itavg = 1
909  else
910  itavg = 0
911  end if
912  else
913  itavg = 0
914  end if
915 
916  call file_add_variable( vid, & ! (out)
917  fid, varname, desc, units, dims, size(dims), dtype, & ! (in)
918  tint8, itavg, & ! (in)
919  error ) ! (out)
920  if ( error /= success_code ) then
921  call log('E', 'xxx failed to add variable: '//trim(varname))
922  end if
923 
924  file_vname_list(file_vid_count) = trim(varname)
925  file_vid_list(file_vid_count) = vid
926  file_vid_fid_list(file_vid_count) = fid
927  file_vid_count = file_vid_count + 1
928  endif
929 
930  return
931  end subroutine fileaddvariablerealdp
932 
933  !-----------------------------------------------------------------------------
934  ! FileSetTAttr
935  !-----------------------------------------------------------------------------
936  subroutine filesettattr( &
937  fid, & ! (in)
938  vname, & ! (in)
939  key, & ! (in)
940  val & ! (in)
941  )
942  integer, intent(in) :: fid
943  character(len=*), intent(in) :: vname
944  character(len=*), intent(in) :: key
945  character(len=*), intent(in) :: val
946 
947  integer :: error
948 
949  call file_set_tattr( &
950  fid, vname, & ! (in)
951  key, val, & ! (in)
952  error ) ! (out)
953  if ( error /= success_code .and. error /= already_existed_code ) then
954  call log('E', 'xxx failed to put axis')
955  end if
956 
957  return
958  end subroutine filesettattr
959 
960  !-----------------------------------------------------------------------------
961  ! FileGetShape
962  !-----------------------------------------------------------------------------
963  subroutine filegetshape( &
964  dims, & ! (out)
965  basename, & ! (in)
966  varname, & ! (in)
967  myrank, & ! (in)
968  single & ! (in) optional
969  )
970  implicit none
971 
972  integer, intent(out) :: dims(:)
973  character(LEN=*), intent( in) :: basename
974  character(LEN=*), intent( in) :: varname
975  integer, intent( in) :: myrank
976  logical, intent( in), optional :: single
977 
978  integer :: fid
979  type(datainfo) :: dinfo
980  integer :: error
981  integer :: n
982 
983  logical :: single_ = .false.
984 
985  intrinsic size
986  intrinsic shape
987  !---------------------------------------------------------------------------
988 
989  mpi_myrank = myrank
990 
991  if ( present(single) ) single_ = single
992 
993  !--- search/register file
994  call fileopen( fid, & ! (out)
995  basename, file_fread, single_ ) ! (in)
996 
997  !--- get data information
998  call file_get_datainfo( dinfo, & ! (out)
999  fid, varname, 1, .false., & ! (in)
1000  error ) ! (out)
1001 
1002  !--- verify
1003  if ( error /= success_code ) then
1004  call log('E', 'xxx failed to get data information :'//trim(varname))
1005  end if
1006 
1007  if ( dinfo%rank /= size(dims) ) then
1008  write(message,*) 'xxx rank is different, ', size(dims), dinfo%rank
1009  call log('E', message)
1010  end if
1011  do n = 1, size(dims)
1012  dims(n) = dinfo%dim_size(n)
1013  end do
1014 
1015  return
1016  end subroutine filegetshape
1017 
1018  !-----------------------------------------------------------------------------
1019  ! FileGetData
1020  !-----------------------------------------------------------------------------
1021  subroutine filegetdatainfo( &
1022  basename, &
1023  varname, &
1024  myrank, &
1025  istep, &
1026  single, &
1027  description, &
1028  units, &
1029  datatype, &
1030  dim_rank, &
1031  dim_name, &
1032  dim_size, &
1033  time_start, &
1034  time_end, &
1035  time_units )
1036  implicit none
1037  character(len=*), intent(in) :: basename
1038  character(len=*), intent(in) :: varname
1039  integer, intent(in) :: myrank
1040  integer, intent(in) :: istep
1041  logical, intent(in), optional :: single
1042 
1043  character(len=File_HMID), intent(out), optional :: description
1044  character(len=File_HSHORT), intent(out), optional :: units
1045  integer, intent(out), optional :: datatype
1046  integer, intent(out), optional :: dim_rank
1047  character(len=File_HSHORT), intent(out), optional :: dim_name(:)
1048  integer, intent(out), optional :: dim_size(:)
1049  real(DP), intent(out), optional :: time_start
1050  real(DP), intent(out), optional :: time_end
1051  character(len=File_HMID), intent(out), optional :: time_units
1052 
1053  integer :: fid
1054  type(datainfo) :: dinfo
1055 
1056  integer :: ndim, idim
1057  real(DP):: time(1)
1058 
1059  integer :: error
1060  logical :: single_ = .false.
1061 
1062  intrinsic size
1063  !---------------------------------------------------------------------------
1064 
1065  mpi_myrank = myrank
1066 
1067  if ( present(single) ) single_ = single
1068 
1069  !--- search/register file
1070  call fileopen( fid, & ! [OUT]
1071  basename, & ! [IN]
1072  file_fread, & ! [IN]
1073  single_ ) ! [IN]
1074 
1075  !--- get data information
1076  call file_get_datainfo( dinfo, & ! [OUT]
1077  fid, & ! [IN]
1078  varname, & ! [IN]
1079  istep, & ! [IN]
1080  .false., & ! [IN]
1081  error ) ! [OUT]
1082 
1083  !--- verify and exit
1084  if ( error /= success_code ) then
1085  call log('E', 'xxx data info not found in '//trim(basename))
1086  endif
1087 
1088  if ( present(description) ) description = dinfo%description
1089  if ( present(units) ) units = dinfo%units
1090  if ( present(datatype) ) datatype = dinfo%datatype
1091  if ( present(dim_rank) ) dim_rank = dinfo%rank
1092 
1093  if ( present(dim_name) ) then
1094  ndim = min( dinfo%rank, size(dim_name) ) ! limit dimension rank
1095  do idim = 1, ndim
1096  dim_name(idim) = dinfo%dim_name(idim)
1097  enddo
1098  end if
1099  if ( present(dim_size) ) then
1100  ndim = min( dinfo%rank, size(dim_size) ) ! limit dimension rank
1101  do idim = 1, ndim
1102  dim_size(idim) = dinfo%dim_size(idim)
1103  enddo
1104  end if
1105 
1106  if ( present(time_units) ) then
1107  if ( dinfo%time_units == "" ) then
1108  call filegetglobalattribute( fid, "time_units", time_units )
1109  else
1110  time_units = dinfo%time_units
1111  end if
1112  end if
1113  if ( present(time_start) ) then
1114  if ( dinfo%time_units == "" ) then
1115  call filegetglobalattribute( fid, "time", time )
1116  time_start = time(1)
1117  else
1118  time_start = dinfo%time_start
1119  end if
1120  end if
1121  if ( present(time_end) ) then
1122  if ( dinfo%time_units == "" ) then
1123  call filegetglobalattribute( fid, "time", time )
1124  time_end = time(1)
1125  else
1126  time_end = dinfo%time_end
1127  end if
1128  end if
1129 
1130  return
1131  end subroutine filegetdatainfo
1132 
1133  !-----------------------------------------------------------------------------
1134  ! FileGetData
1135  !-----------------------------------------------------------------------------
1136  subroutine filegetalldatainfo( &
1137  step_limit, &
1138  dim_limit, &
1139  basename, &
1140  varname, &
1141  myrank, &
1142  step_nmax, &
1143  description, &
1144  units, &
1145  datatype, &
1146  dim_rank, &
1147  dim_name, &
1148  dim_size, &
1149  time_start, &
1150  time_end, &
1151  time_units, &
1152  single )
1153  implicit none
1154 
1155  integer, intent(in) :: step_limit
1156  integer, intent(in) :: dim_limit
1157  character(len=*), intent(in) :: basename
1158  character(len=*), intent(in) :: varname
1159  integer, intent(in) :: myrank
1160  integer, intent(out) :: step_nmax
1161  character(len=File_HMID), intent(out) :: description
1162  character(len=File_HSHORT), intent(out) :: units
1163  integer, intent(out) :: datatype
1164  integer, intent(out) :: dim_rank
1165  character(len=File_HSHORT), intent(out) :: dim_name (dim_limit)
1166  integer, intent(out) :: dim_size (dim_limit)
1167  real(DP), intent(out) :: time_start(step_limit)
1168  real(DP), intent(out) :: time_end (step_limit)
1169  character(len=File_HMID), intent(out) :: time_units
1170 
1171  logical, intent(in), optional :: single
1172 
1173  integer :: fid
1174  type(datainfo) :: dinfo
1175 
1176  integer :: ndim
1177  integer :: istep, idim
1178  logical :: flag_first = .true.
1179 
1180  integer :: error
1181  logical :: single_ = .false.
1182  !---------------------------------------------------------------------------
1183 
1184  mpi_myrank = myrank
1185 
1186  if ( present(single) ) single_ = single
1187 
1188  !--- search/register file
1189  call fileopen( fid, & ! [OUT]
1190  basename, & ! [IN]
1191  file_fread, & ! [IN]
1192  single_ ) ! [IN]
1193 
1194  ! initialize
1195  description = ""
1196  units = ""
1197  datatype = -1
1198  dim_rank = -1
1199  dim_name(:) = ""
1200  dim_size(:) = -1
1201  time_start(:) = rmiss
1202  time_end(:) = rmiss
1203 
1204  do istep = 1, step_limit
1205  !--- get data information
1206  call file_get_datainfo( dinfo, & ! [OUT]
1207  fid, & ! [IN]
1208  varname, & ! [IN]
1209  istep, & ! [IN]
1210  .true., & ! [IN]
1211  error ) ! [OUT]
1212 
1213  !--- verify and exit
1214  if ( error /= success_code ) then
1215  step_nmax = istep - 1
1216  exit
1217  endif
1218 
1219  if ( flag_first ) then
1220  flag_first = .false.
1221 
1222  description = dinfo%description
1223  units = dinfo%units
1224  datatype = dinfo%datatype
1225  dim_rank = dinfo%rank
1226 
1227  ndim = min( dinfo%rank, dim_limit ) ! limit dimension rank
1228  do idim = 1, ndim
1229  dim_name(idim) = dinfo%dim_name(idim)
1230  dim_size(idim) = dinfo%dim_size(idim)
1231  enddo
1232 
1233  time_units = dinfo%time_units
1234  endif
1235 
1236  time_start(istep) = dinfo%time_start
1237  time_end(istep) = dinfo%time_end
1238  enddo
1239 
1240  return
1241  end subroutine filegetalldatainfo
1242 
1243  !-----------------------------------------------------------------------------
1244  ! interface File_read
1245  !-----------------------------------------------------------------------------
1246  subroutine fileread1drealsp( &
1247  var, & ! (out)
1248  basename, & ! (in)
1249  varname, & ! (in)
1250  step, & ! (in)
1251  myrank, & ! (in)
1252  allow_missing, & ! (in) optional
1253  single & ! (in) optional
1254  )
1255  implicit none
1256 
1257  real(SP), intent(out) :: var(:)
1258  character(LEN=*), intent( in) :: basename
1259  character(LEN=*), intent( in) :: varname
1260  integer, intent( in) :: step
1261  integer, intent( in) :: myrank
1262  logical, intent( in), optional :: allow_missing !--- if data is missing, set value to zero
1263  logical, intent( in), optional :: single
1264 
1265  integer :: fid
1266  type(datainfo) :: dinfo
1267  integer :: dim_size(1)
1268  integer :: error
1269  integer :: n
1270 
1271  logical :: single_ = .false.
1272 
1273  intrinsic shape
1274  !---------------------------------------------------------------------------
1275 
1276  mpi_myrank = myrank
1277 
1278  if ( present(single) ) single_ = single
1279 
1280  !--- search/register file
1281  call fileopen( fid, & ! (out)
1282  basename, file_fread, single_ ) ! (in)
1283 
1284  !--- get data information
1285  call file_get_datainfo( dinfo, & ! (out)
1286  fid, varname, step, .false., & ! (in)
1287  error ) ! (out)
1288 
1289  !--- verify
1290  if ( error /= success_code ) then
1291  if ( present(allow_missing) ) then
1292  if ( allow_missing ) then
1293  write(message,*) 'xxx [INPUT]/[File] data not found! : ', &
1294  'varname= ',trim(varname),', step=',step
1295  call log('I', message)
1296  call log('I', 'xxx [INPUT]/[File] Value is set to 0.')
1297  var(:) = 0.0_sp
1298  else
1299  call log('E', 'xxx failed to get data information :'//trim(varname))
1300  end if
1301  else
1302  call log('E', 'xxx failed to get data information :'//trim(varname))
1303  end if
1304  end if
1305 
1306  if ( dinfo%rank /= 1 ) then
1307  write(message,*) 'xxx rank is not 1', dinfo%rank
1308  call log('E', message)
1309  end if
1310  dim_size(:) = shape(var)
1311  do n = 1, 1
1312  if ( dinfo%dim_size(n) /= dim_size(n) ) then
1313  write(message,*) 'xxx shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
1314  call log('E', message)
1315  end if
1316  end do
1317 
1318  call file_read_data( var(:), & ! (out)
1319  dinfo, sp, & ! (in)
1320  error ) ! (out)
1321  if ( error /= success_code ) then
1322  call log('E', 'xxx failed to get data value')
1323  end if
1324 
1325  return
1326  end subroutine fileread1drealsp
1327  subroutine fileread1drealdp( &
1328  var, & ! (out)
1329  basename, & ! (in)
1330  varname, & ! (in)
1331  step, & ! (in)
1332  myrank, & ! (in)
1333  allow_missing, & ! (in) optional
1334  single & ! (in) optional
1335  )
1336  implicit none
1337 
1338  real(DP), intent(out) :: var(:)
1339  character(LEN=*), intent( in) :: basename
1340  character(LEN=*), intent( in) :: varname
1341  integer, intent( in) :: step
1342  integer, intent( in) :: myrank
1343  logical, intent( in), optional :: allow_missing !--- if data is missing, set value to zero
1344  logical, intent( in), optional :: single
1345 
1346  integer :: fid
1347  type(datainfo) :: dinfo
1348  integer :: dim_size(1)
1349  integer :: error
1350  integer :: n
1351 
1352  logical :: single_ = .false.
1353 
1354  intrinsic shape
1355  !---------------------------------------------------------------------------
1356 
1357  mpi_myrank = myrank
1358 
1359  if ( present(single) ) single_ = single
1360 
1361  !--- search/register file
1362  call fileopen( fid, & ! (out)
1363  basename, file_fread, single_ ) ! (in)
1364 
1365  !--- get data information
1366  call file_get_datainfo( dinfo, & ! (out)
1367  fid, varname, step, .false., & ! (in)
1368  error ) ! (out)
1369 
1370  !--- verify
1371  if ( error /= success_code ) then
1372  if ( present(allow_missing) ) then
1373  if ( allow_missing ) then
1374  write(message,*) 'xxx [INPUT]/[File] data not found! : ', &
1375  'varname= ',trim(varname),', step=',step
1376  call log('I', message)
1377  call log('I', 'xxx [INPUT]/[File] Value is set to 0.')
1378  var(:) = 0.0_dp
1379  else
1380  call log('E', 'xxx failed to get data information :'//trim(varname))
1381  end if
1382  else
1383  call log('E', 'xxx failed to get data information :'//trim(varname))
1384  end if
1385  end if
1386 
1387  if ( dinfo%rank /= 1 ) then
1388  write(message,*) 'xxx rank is not 1', dinfo%rank
1389  call log('E', message)
1390  end if
1391  dim_size(:) = shape(var)
1392  do n = 1, 1
1393  if ( dinfo%dim_size(n) /= dim_size(n) ) then
1394  write(message,*) 'xxx shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
1395  call log('E', message)
1396  end if
1397  end do
1398 
1399  call file_read_data( var(:), & ! (out)
1400  dinfo, dp, & ! (in)
1401  error ) ! (out)
1402  if ( error /= success_code ) then
1403  call log('E', 'xxx failed to get data value')
1404  end if
1405 
1406  return
1407  end subroutine fileread1drealdp
1408  subroutine fileread2drealsp( &
1409  var, & ! (out)
1410  basename, & ! (in)
1411  varname, & ! (in)
1412  step, & ! (in)
1413  myrank, & ! (in)
1414  allow_missing, & ! (in) optional
1415  single & ! (in) optional
1416  )
1417  implicit none
1418 
1419  real(SP), intent(out) :: var(:,:)
1420  character(LEN=*), intent( in) :: basename
1421  character(LEN=*), intent( in) :: varname
1422  integer, intent( in) :: step
1423  integer, intent( in) :: myrank
1424  logical, intent( in), optional :: allow_missing !--- if data is missing, set value to zero
1425  logical, intent( in), optional :: single
1426 
1427  integer :: fid
1428  type(datainfo) :: dinfo
1429  integer :: dim_size(2)
1430  integer :: error
1431  integer :: n
1432 
1433  logical :: single_ = .false.
1434 
1435  intrinsic shape
1436  !---------------------------------------------------------------------------
1437 
1438  mpi_myrank = myrank
1439 
1440  if ( present(single) ) single_ = single
1441 
1442  !--- search/register file
1443  call fileopen( fid, & ! (out)
1444  basename, file_fread, single_ ) ! (in)
1445 
1446  !--- get data information
1447  call file_get_datainfo( dinfo, & ! (out)
1448  fid, varname, step, .false., & ! (in)
1449  error ) ! (out)
1450 
1451  !--- verify
1452  if ( error /= success_code ) then
1453  if ( present(allow_missing) ) then
1454  if ( allow_missing ) then
1455  write(message,*) 'xxx [INPUT]/[File] data not found! : ', &
1456  'varname= ',trim(varname),', step=',step
1457  call log('I', message)
1458  call log('I', 'xxx [INPUT]/[File] Value is set to 0.')
1459  var(:,:) = 0.0_sp
1460  else
1461  call log('E', 'xxx failed to get data information :'//trim(varname))
1462  end if
1463  else
1464  call log('E', 'xxx failed to get data information :'//trim(varname))
1465  end if
1466  end if
1467 
1468  if ( dinfo%rank /= 2 ) then
1469  write(message,*) 'xxx rank is not 2', dinfo%rank
1470  call log('E', message)
1471  end if
1472  dim_size(:) = shape(var)
1473  do n = 1, 2
1474  if ( dinfo%dim_size(n) /= dim_size(n) ) then
1475  write(message,*) 'xxx shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
1476  call log('E', message)
1477  end if
1478  end do
1479 
1480  call file_read_data( var(:,:), & ! (out)
1481  dinfo, sp, & ! (in)
1482  error ) ! (out)
1483  if ( error /= success_code ) then
1484  call log('E', 'xxx failed to get data value')
1485  end if
1486 
1487  return
1488  end subroutine fileread2drealsp
1489  subroutine fileread2drealdp( &
1490  var, & ! (out)
1491  basename, & ! (in)
1492  varname, & ! (in)
1493  step, & ! (in)
1494  myrank, & ! (in)
1495  allow_missing, & ! (in) optional
1496  single & ! (in) optional
1497  )
1498  implicit none
1499 
1500  real(DP), intent(out) :: var(:,:)
1501  character(LEN=*), intent( in) :: basename
1502  character(LEN=*), intent( in) :: varname
1503  integer, intent( in) :: step
1504  integer, intent( in) :: myrank
1505  logical, intent( in), optional :: allow_missing !--- if data is missing, set value to zero
1506  logical, intent( in), optional :: single
1507 
1508  integer :: fid
1509  type(datainfo) :: dinfo
1510  integer :: dim_size(2)
1511  integer :: error
1512  integer :: n
1513 
1514  logical :: single_ = .false.
1515 
1516  intrinsic shape
1517  !---------------------------------------------------------------------------
1518 
1519  mpi_myrank = myrank
1520 
1521  if ( present(single) ) single_ = single
1522 
1523  !--- search/register file
1524  call fileopen( fid, & ! (out)
1525  basename, file_fread, single_ ) ! (in)
1526 
1527  !--- get data information
1528  call file_get_datainfo( dinfo, & ! (out)
1529  fid, varname, step, .false., & ! (in)
1530  error ) ! (out)
1531 
1532  !--- verify
1533  if ( error /= success_code ) then
1534  if ( present(allow_missing) ) then
1535  if ( allow_missing ) then
1536  write(message,*) 'xxx [INPUT]/[File] data not found! : ', &
1537  'varname= ',trim(varname),', step=',step
1538  call log('I', message)
1539  call log('I', 'xxx [INPUT]/[File] Value is set to 0.')
1540  var(:,:) = 0.0_dp
1541  else
1542  call log('E', 'xxx failed to get data information :'//trim(varname))
1543  end if
1544  else
1545  call log('E', 'xxx failed to get data information :'//trim(varname))
1546  end if
1547  end if
1548 
1549  if ( dinfo%rank /= 2 ) then
1550  write(message,*) 'xxx rank is not 2', dinfo%rank
1551  call log('E', message)
1552  end if
1553  dim_size(:) = shape(var)
1554  do n = 1, 2
1555  if ( dinfo%dim_size(n) /= dim_size(n) ) then
1556  write(message,*) 'xxx shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
1557  call log('E', message)
1558  end if
1559  end do
1560 
1561  call file_read_data( var(:,:), & ! (out)
1562  dinfo, dp, & ! (in)
1563  error ) ! (out)
1564  if ( error /= success_code ) then
1565  call log('E', 'xxx failed to get data value')
1566  end if
1567 
1568  return
1569  end subroutine fileread2drealdp
1570  subroutine fileread3drealsp( &
1571  var, & ! (out)
1572  basename, & ! (in)
1573  varname, & ! (in)
1574  step, & ! (in)
1575  myrank, & ! (in)
1576  allow_missing, & ! (in) optional
1577  single & ! (in) optional
1578  )
1579  implicit none
1580 
1581  real(SP), intent(out) :: var(:,:,:)
1582  character(LEN=*), intent( in) :: basename
1583  character(LEN=*), intent( in) :: varname
1584  integer, intent( in) :: step
1585  integer, intent( in) :: myrank
1586  logical, intent( in), optional :: allow_missing !--- if data is missing, set value to zero
1587  logical, intent( in), optional :: single
1588 
1589  integer :: fid
1590  type(datainfo) :: dinfo
1591  integer :: dim_size(3)
1592  integer :: error
1593  integer :: n
1594 
1595  logical :: single_ = .false.
1596 
1597  intrinsic shape
1598  !---------------------------------------------------------------------------
1599 
1600  mpi_myrank = myrank
1601 
1602  if ( present(single) ) single_ = single
1603 
1604  !--- search/register file
1605  call fileopen( fid, & ! (out)
1606  basename, file_fread, single_ ) ! (in)
1607 
1608  !--- get data information
1609  call file_get_datainfo( dinfo, & ! (out)
1610  fid, varname, step, .false., & ! (in)
1611  error ) ! (out)
1612 
1613  !--- verify
1614  if ( error /= success_code ) then
1615  if ( present(allow_missing) ) then
1616  if ( allow_missing ) then
1617  write(message,*) 'xxx [INPUT]/[File] data not found! : ', &
1618  'varname= ',trim(varname),', step=',step
1619  call log('I', message)
1620  call log('I', 'xxx [INPUT]/[File] Value is set to 0.')
1621  var(:,:,:) = 0.0_sp
1622  else
1623  call log('E', 'xxx failed to get data information :'//trim(varname))
1624  end if
1625  else
1626  call log('E', 'xxx failed to get data information :'//trim(varname))
1627  end if
1628  end if
1629 
1630  if ( dinfo%rank /= 3 ) then
1631  write(message,*) 'xxx rank is not 3', dinfo%rank
1632  call log('E', message)
1633  end if
1634  dim_size(:) = shape(var)
1635  do n = 1, 3
1636  if ( dinfo%dim_size(n) /= dim_size(n) ) then
1637  write(message,*) 'xxx shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
1638  call log('E', message)
1639  end if
1640  end do
1641 
1642  call file_read_data( var(:,:,:), & ! (out)
1643  dinfo, sp, & ! (in)
1644  error ) ! (out)
1645  if ( error /= success_code ) then
1646  call log('E', 'xxx failed to get data value')
1647  end if
1648 
1649  return
1650  end subroutine fileread3drealsp
1651  subroutine fileread3drealdp( &
1652  var, & ! (out)
1653  basename, & ! (in)
1654  varname, & ! (in)
1655  step, & ! (in)
1656  myrank, & ! (in)
1657  allow_missing, & ! (in) optional
1658  single & ! (in) optional
1659  )
1660  implicit none
1661 
1662  real(DP), intent(out) :: var(:,:,:)
1663  character(LEN=*), intent( in) :: basename
1664  character(LEN=*), intent( in) :: varname
1665  integer, intent( in) :: step
1666  integer, intent( in) :: myrank
1667  logical, intent( in), optional :: allow_missing !--- if data is missing, set value to zero
1668  logical, intent( in), optional :: single
1669 
1670  integer :: fid
1671  type(datainfo) :: dinfo
1672  integer :: dim_size(3)
1673  integer :: error
1674  integer :: n
1675 
1676  logical :: single_ = .false.
1677 
1678  intrinsic shape
1679  !---------------------------------------------------------------------------
1680 
1681  mpi_myrank = myrank
1682 
1683  if ( present(single) ) single_ = single
1684 
1685  !--- search/register file
1686  call fileopen( fid, & ! (out)
1687  basename, file_fread, single_ ) ! (in)
1688 
1689  !--- get data information
1690  call file_get_datainfo( dinfo, & ! (out)
1691  fid, varname, step, .false., & ! (in)
1692  error ) ! (out)
1693 
1694  !--- verify
1695  if ( error /= success_code ) then
1696  if ( present(allow_missing) ) then
1697  if ( allow_missing ) then
1698  write(message,*) 'xxx [INPUT]/[File] data not found! : ', &
1699  'varname= ',trim(varname),', step=',step
1700  call log('I', message)
1701  call log('I', 'xxx [INPUT]/[File] Value is set to 0.')
1702  var(:,:,:) = 0.0_dp
1703  else
1704  call log('E', 'xxx failed to get data information :'//trim(varname))
1705  end if
1706  else
1707  call log('E', 'xxx failed to get data information :'//trim(varname))
1708  end if
1709  end if
1710 
1711  if ( dinfo%rank /= 3 ) then
1712  write(message,*) 'xxx rank is not 3', dinfo%rank
1713  call log('E', message)
1714  end if
1715  dim_size(:) = shape(var)
1716  do n = 1, 3
1717  if ( dinfo%dim_size(n) /= dim_size(n) ) then
1718  write(message,*) 'xxx shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
1719  call log('E', message)
1720  end if
1721  end do
1722 
1723  call file_read_data( var(:,:,:), & ! (out)
1724  dinfo, dp, & ! (in)
1725  error ) ! (out)
1726  if ( error /= success_code ) then
1727  call log('E', 'xxx failed to get data value')
1728  end if
1729 
1730  return
1731  end subroutine fileread3drealdp
1732  subroutine fileread4drealsp( &
1733  var, & ! (out)
1734  basename, & ! (in)
1735  varname, & ! (in)
1736  step, & ! (in)
1737  myrank, & ! (in)
1738  allow_missing, & ! (in) optional
1739  single & ! (in) optional
1740  )
1741  implicit none
1742 
1743  real(SP), intent(out) :: var(:,:,:,:)
1744  character(LEN=*), intent( in) :: basename
1745  character(LEN=*), intent( in) :: varname
1746  integer, intent( in) :: step
1747  integer, intent( in) :: myrank
1748  logical, intent( in), optional :: allow_missing !--- if data is missing, set value to zero
1749  logical, intent( in), optional :: single
1750 
1751  integer :: fid
1752  type(datainfo) :: dinfo
1753  integer :: dim_size(4)
1754  integer :: error
1755  integer :: n
1756 
1757  logical :: single_ = .false.
1758 
1759  intrinsic shape
1760  !---------------------------------------------------------------------------
1761 
1762  mpi_myrank = myrank
1763 
1764  if ( present(single) ) single_ = single
1765 
1766  !--- search/register file
1767  call fileopen( fid, & ! (out)
1768  basename, file_fread, single_ ) ! (in)
1769 
1770  !--- get data information
1771  call file_get_datainfo( dinfo, & ! (out)
1772  fid, varname, step, .false., & ! (in)
1773  error ) ! (out)
1774 
1775  !--- verify
1776  if ( error /= success_code ) then
1777  if ( present(allow_missing) ) then
1778  if ( allow_missing ) then
1779  write(message,*) 'xxx [INPUT]/[File] data not found! : ', &
1780  'varname= ',trim(varname),', step=',step
1781  call log('I', message)
1782  call log('I', 'xxx [INPUT]/[File] Value is set to 0.')
1783  var(:,:,:,:) = 0.0_sp
1784  else
1785  call log('E', 'xxx failed to get data information :'//trim(varname))
1786  end if
1787  else
1788  call log('E', 'xxx failed to get data information :'//trim(varname))
1789  end if
1790  end if
1791 
1792  if ( dinfo%rank /= 4 ) then
1793  write(message,*) 'xxx rank is not 4', dinfo%rank
1794  call log('E', message)
1795  end if
1796  dim_size(:) = shape(var)
1797  do n = 1, 4
1798  if ( dinfo%dim_size(n) /= dim_size(n) ) then
1799  write(message,*) 'xxx shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
1800  call log('E', message)
1801  end if
1802  end do
1803 
1804  call file_read_data( var(:,:,:,:), & ! (out)
1805  dinfo, sp, & ! (in)
1806  error ) ! (out)
1807  if ( error /= success_code ) then
1808  call log('E', 'xxx failed to get data value')
1809  end if
1810 
1811  return
1812  end subroutine fileread4drealsp
1813  subroutine fileread4drealdp( &
1814  var, & ! (out)
1815  basename, & ! (in)
1816  varname, & ! (in)
1817  step, & ! (in)
1818  myrank, & ! (in)
1819  allow_missing, & ! (in) optional
1820  single & ! (in) optional
1821  )
1822  implicit none
1823 
1824  real(DP), intent(out) :: var(:,:,:,:)
1825  character(LEN=*), intent( in) :: basename
1826  character(LEN=*), intent( in) :: varname
1827  integer, intent( in) :: step
1828  integer, intent( in) :: myrank
1829  logical, intent( in), optional :: allow_missing !--- if data is missing, set value to zero
1830  logical, intent( in), optional :: single
1831 
1832  integer :: fid
1833  type(datainfo) :: dinfo
1834  integer :: dim_size(4)
1835  integer :: error
1836  integer :: n
1837 
1838  logical :: single_ = .false.
1839 
1840  intrinsic shape
1841  !---------------------------------------------------------------------------
1842 
1843  mpi_myrank = myrank
1844 
1845  if ( present(single) ) single_ = single
1846 
1847  !--- search/register file
1848  call fileopen( fid, & ! (out)
1849  basename, file_fread, single_ ) ! (in)
1850 
1851  !--- get data information
1852  call file_get_datainfo( dinfo, & ! (out)
1853  fid, varname, step, .false., & ! (in)
1854  error ) ! (out)
1855 
1856  !--- verify
1857  if ( error /= success_code ) then
1858  if ( present(allow_missing) ) then
1859  if ( allow_missing ) then
1860  write(message,*) 'xxx [INPUT]/[File] data not found! : ', &
1861  'varname= ',trim(varname),', step=',step
1862  call log('I', message)
1863  call log('I', 'xxx [INPUT]/[File] Value is set to 0.')
1864  var(:,:,:,:) = 0.0_dp
1865  else
1866  call log('E', 'xxx failed to get data information :'//trim(varname))
1867  end if
1868  else
1869  call log('E', 'xxx failed to get data information :'//trim(varname))
1870  end if
1871  end if
1872 
1873  if ( dinfo%rank /= 4 ) then
1874  write(message,*) 'xxx rank is not 4', dinfo%rank
1875  call log('E', message)
1876  end if
1877  dim_size(:) = shape(var)
1878  do n = 1, 4
1879  if ( dinfo%dim_size(n) /= dim_size(n) ) then
1880  write(message,*) 'xxx shape is different: ', varname, n, dinfo%dim_size(n), dim_size(n)
1881  call log('E', message)
1882  end if
1883  end do
1884 
1885  call file_read_data( var(:,:,:,:), & ! (out)
1886  dinfo, dp, & ! (in)
1887  error ) ! (out)
1888  if ( error /= success_code ) then
1889  call log('E', 'xxx failed to get data value')
1890  end if
1891 
1892  return
1893  end subroutine fileread4drealdp
1894 
1895  !-----------------------------------------------------------------------------
1896  ! interface FileWrite
1897  !-----------------------------------------------------------------------------
1898  subroutine filewrite1drealsp( &
1899  fid, & ! (in)
1900  vid, & ! (in)
1901  var, & ! (in)
1902  t_start, & ! (in)
1903  t_end & ! (in)
1904  )
1905  implicit none
1906 
1907  real(SP), intent(in) :: var(:)
1908  integer, intent(in) :: fid
1909  integer, intent(in) :: vid
1910  real(DP), intent(in) :: t_start
1911  real(DP), intent(in) :: t_end
1912 
1913  real(DP) :: ts, te
1914 
1915  integer :: error, n
1916  character(len=100) :: str
1917  !---------------------------------------------------------------------------
1918 
1919  ts = t_start
1920  te = t_end
1921  call file_write_data( fid, vid, var(:), ts, te, sp, & ! (in)
1922  error ) ! (out)
1923  if ( error /= success_code ) then
1924  do n = 1, file_vid_count
1925  if ( file_vid_list(n) == vid ) then
1926  write(str,*) 'xxx failed to write data: ', trim(file_vname_list(n)), mpi_myrank
1927  exit
1928  end if
1929  enddo
1930  call log('E', trim(str))
1931  end if
1932 
1933  return
1934  end subroutine filewrite1drealsp
1935  subroutine filewrite1drealdp( &
1936  fid, & ! (in)
1937  vid, & ! (in)
1938  var, & ! (in)
1939  t_start, & ! (in)
1940  t_end & ! (in)
1941  )
1942  implicit none
1943 
1944  real(DP), intent(in) :: var(:)
1945  integer, intent(in) :: fid
1946  integer, intent(in) :: vid
1947  real(DP), intent(in) :: t_start
1948  real(DP), intent(in) :: t_end
1949 
1950  real(DP) :: ts, te
1951 
1952  integer :: error, n
1953  character(len=100) :: str
1954  !---------------------------------------------------------------------------
1955 
1956  ts = t_start
1957  te = t_end
1958  call file_write_data( fid, vid, var(:), ts, te, dp, & ! (in)
1959  error ) ! (out)
1960  if ( error /= success_code ) then
1961  do n = 1, file_vid_count
1962  if ( file_vid_list(n) == vid ) then
1963  write(str,*) 'xxx failed to write data: ', trim(file_vname_list(n)), mpi_myrank
1964  exit
1965  end if
1966  enddo
1967  call log('E', trim(str))
1968  end if
1969 
1970  return
1971  end subroutine filewrite1drealdp
1972  subroutine filewrite2drealsp( &
1973  fid, & ! (in)
1974  vid, & ! (in)
1975  var, & ! (in)
1976  t_start, & ! (in)
1977  t_end & ! (in)
1978  )
1979  implicit none
1980 
1981  real(SP), intent(in) :: var(:,:)
1982  integer, intent(in) :: fid
1983  integer, intent(in) :: vid
1984  real(DP), intent(in) :: t_start
1985  real(DP), intent(in) :: t_end
1986 
1987  real(DP) :: ts, te
1988 
1989  integer :: error, n
1990  character(len=100) :: str
1991  !---------------------------------------------------------------------------
1992 
1993  ts = t_start
1994  te = t_end
1995  call file_write_data( fid, vid, var(:,:), ts, te, sp, & ! (in)
1996  error ) ! (out)
1997  if ( error /= success_code ) then
1998  do n = 1, file_vid_count
1999  if ( file_vid_list(n) == vid ) then
2000  write(str,*) 'xxx failed to write data: ', trim(file_vname_list(n)), mpi_myrank
2001  exit
2002  end if
2003  enddo
2004  call log('E', trim(str))
2005  end if
2006 
2007  return
2008  end subroutine filewrite2drealsp
2009  subroutine filewrite2drealdp( &
2010  fid, & ! (in)
2011  vid, & ! (in)
2012  var, & ! (in)
2013  t_start, & ! (in)
2014  t_end & ! (in)
2015  )
2016  implicit none
2017 
2018  real(DP), intent(in) :: var(:,:)
2019  integer, intent(in) :: fid
2020  integer, intent(in) :: vid
2021  real(DP), intent(in) :: t_start
2022  real(DP), intent(in) :: t_end
2023 
2024  real(DP) :: ts, te
2025 
2026  integer :: error, n
2027  character(len=100) :: str
2028  !---------------------------------------------------------------------------
2029 
2030  ts = t_start
2031  te = t_end
2032  call file_write_data( fid, vid, var(:,:), ts, te, dp, & ! (in)
2033  error ) ! (out)
2034  if ( error /= success_code ) then
2035  do n = 1, file_vid_count
2036  if ( file_vid_list(n) == vid ) then
2037  write(str,*) 'xxx failed to write data: ', trim(file_vname_list(n)), mpi_myrank
2038  exit
2039  end if
2040  enddo
2041  call log('E', trim(str))
2042  end if
2043 
2044  return
2045  end subroutine filewrite2drealdp
2046  subroutine filewrite3drealsp( &
2047  fid, & ! (in)
2048  vid, & ! (in)
2049  var, & ! (in)
2050  t_start, & ! (in)
2051  t_end & ! (in)
2052  )
2053  implicit none
2054 
2055  real(SP), intent(in) :: var(:,:,:)
2056  integer, intent(in) :: fid
2057  integer, intent(in) :: vid
2058  real(DP), intent(in) :: t_start
2059  real(DP), intent(in) :: t_end
2060 
2061  real(DP) :: ts, te
2062 
2063  integer :: error, n
2064  character(len=100) :: str
2065  !---------------------------------------------------------------------------
2066 
2067  ts = t_start
2068  te = t_end
2069  call file_write_data( fid, vid, var(:,:,:), ts, te, sp, & ! (in)
2070  error ) ! (out)
2071  if ( error /= success_code ) then
2072  do n = 1, file_vid_count
2073  if ( file_vid_list(n) == vid ) then
2074  write(str,*) 'xxx failed to write data: ', trim(file_vname_list(n)), mpi_myrank
2075  exit
2076  end if
2077  enddo
2078  call log('E', trim(str))
2079  end if
2080 
2081  return
2082  end subroutine filewrite3drealsp
2083  subroutine filewrite3drealdp( &
2084  fid, & ! (in)
2085  vid, & ! (in)
2086  var, & ! (in)
2087  t_start, & ! (in)
2088  t_end & ! (in)
2089  )
2090  implicit none
2091 
2092  real(DP), intent(in) :: var(:,:,:)
2093  integer, intent(in) :: fid
2094  integer, intent(in) :: vid
2095  real(DP), intent(in) :: t_start
2096  real(DP), intent(in) :: t_end
2097 
2098  real(DP) :: ts, te
2099 
2100  integer :: error, n
2101  character(len=100) :: str
2102  !---------------------------------------------------------------------------
2103 
2104  ts = t_start
2105  te = t_end
2106  call file_write_data( fid, vid, var(:,:,:), ts, te, dp, & ! (in)
2107  error ) ! (out)
2108  if ( error /= success_code ) then
2109  do n = 1, file_vid_count
2110  if ( file_vid_list(n) == vid ) then
2111  write(str,*) 'xxx failed to write data: ', trim(file_vname_list(n)), mpi_myrank
2112  exit
2113  end if
2114  enddo
2115  call log('E', trim(str))
2116  end if
2117 
2118  return
2119  end subroutine filewrite3drealdp
2120  subroutine filewrite4drealsp( &
2121  fid, & ! (in)
2122  vid, & ! (in)
2123  var, & ! (in)
2124  t_start, & ! (in)
2125  t_end & ! (in)
2126  )
2127  implicit none
2128 
2129  real(SP), intent(in) :: var(:,:,:,:)
2130  integer, intent(in) :: fid
2131  integer, intent(in) :: vid
2132  real(DP), intent(in) :: t_start
2133  real(DP), intent(in) :: t_end
2134 
2135  real(DP) :: ts, te
2136 
2137  integer :: error, n
2138  character(len=100) :: str
2139  !---------------------------------------------------------------------------
2140 
2141  ts = t_start
2142  te = t_end
2143  call file_write_data( fid, vid, var(:,:,:,:), ts, te, sp, & ! (in)
2144  error ) ! (out)
2145  if ( error /= success_code ) then
2146  do n = 1, file_vid_count
2147  if ( file_vid_list(n) == vid ) then
2148  write(str,*) 'xxx failed to write data: ', trim(file_vname_list(n)), mpi_myrank
2149  exit
2150  end if
2151  enddo
2152  call log('E', trim(str))
2153  end if
2154 
2155  return
2156  end subroutine filewrite4drealsp
2157  subroutine filewrite4drealdp( &
2158  fid, & ! (in)
2159  vid, & ! (in)
2160  var, & ! (in)
2161  t_start, & ! (in)
2162  t_end & ! (in)
2163  )
2164  implicit none
2165 
2166  real(DP), intent(in) :: var(:,:,:,:)
2167  integer, intent(in) :: fid
2168  integer, intent(in) :: vid
2169  real(DP), intent(in) :: t_start
2170  real(DP), intent(in) :: t_end
2171 
2172  real(DP) :: ts, te
2173 
2174  integer :: error, n
2175  character(len=100) :: str
2176  !---------------------------------------------------------------------------
2177 
2178  ts = t_start
2179  te = t_end
2180  call file_write_data( fid, vid, var(:,:,:,:), ts, te, dp, & ! (in)
2181  error ) ! (out)
2182  if ( error /= success_code ) then
2183  do n = 1, file_vid_count
2184  if ( file_vid_list(n) == vid ) then
2185  write(str,*) 'xxx failed to write data: ', trim(file_vname_list(n)), mpi_myrank
2186  exit
2187  end if
2188  enddo
2189  call log('E', trim(str))
2190  end if
2191 
2192  return
2193  end subroutine filewrite4drealdp
2194 
2195  !-----------------------------------------------------------------------------
2196  subroutine fileclose( &
2197  fid & ! (in)
2198  )
2199  implicit none
2200 
2201  integer, intent(in) :: fid
2202 
2203  character(LEN=File_HLONG) :: fname
2204  integer :: error
2205  integer :: n
2206  !---------------------------------------------------------------------------
2207 
2208  if ( fid < 0 ) return
2209 
2210  do n = 1, file_fid_count-1
2211  if ( file_fid_list(n) == fid ) exit
2212  end do
2213  if ( fid /= file_fid_list(n) ) then
2214  write(message,*) 'xxx invalid fid' , fid
2215  call log('E', message)
2216  end if
2217  call file_close( fid , & ! (in)
2218  error ) ! (out)
2219  if ( error == success_code ) then
2220  write(message, '(1x,A,i3)') '*** [File] File Close : NO.', n
2221  call log('I', message)
2222  call log('I', '*** closed filename: ' // trim(file_fname_list(n)))
2223  else if ( error /= already_closed_code ) then
2224  call log('E', 'xxx failed to close file')
2225  end if
2226 
2227  do n = 1, file_fid_count-1
2228  if ( file_fid_list(n) == fid ) then
2229  file_fid_list(n) = -1
2230  file_fname_list(n) = ''
2231  end if
2232  end do
2233 
2234  return
2235  end subroutine fileclose
2236  !-----------------------------------------------------------------------------
2237  subroutine filecloseall
2238  implicit none
2239 
2240  integer n
2241  !---------------------------------------------------------------------------
2242 
2243  do n = 1, file_fid_count-1
2244  call fileclose( file_fid_list(n) )
2245  enddo
2246 
2247  return
2248  end subroutine filecloseall
2249 
2250  !-----------------------------------------------------------------------------
2251  ! private
2252  !-----------------------------------------------------------------------------
2253  subroutine filemakefname( &
2254  fname, & ! (out)
2255  basename, & ! (in)
2256  prefix, & ! (in)
2257  myrank, & ! (in)
2258  len ) ! (in)
2259  character(len=*), intent(out) :: fname
2260  character(len=*), intent( in) :: basename
2261  character(len=*), intent( in) :: prefix
2262  integer, intent( in) :: myrank
2263  integer, intent( in) :: len
2264 
2265  ! 12345678901234567
2266  character(len=17) :: fmt = "(A, '.', A, I*.*)"
2267  !---------------------------------------------------------------------------
2268 
2269  if ( len < 1 .or. len > 9 ) then
2270  call log('E', 'xxx len is invalid')
2271  end if
2272 
2273  write(fmt(14:14),'(I1)') len
2274  write(fmt(16:16),'(I1)') len
2275  write(fname, fmt) trim(basename), trim(prefix), myrank
2276 
2277  return
2278  end subroutine filemakefname
2279  !-----------------------------------------------------------------------------
2280  subroutine filegetfid( &
2281  fid, &
2282  existed, &
2283  basename, &
2284  mode, &
2285  single )
2286  implicit none
2287 
2288  integer, intent(out) :: fid
2289  logical, intent(out) :: existed
2290  character(LEN=*), intent( in) :: basename
2291  integer, intent( in) :: mode
2292  logical, intent( in) :: single
2293 
2294 
2295  character(LEN=File_HSHORT) :: rwname(0:2)
2296  data rwname / 'READ','WRITE','APPEND' /
2297 
2298  character(LEN=File_HLONG) :: fname
2299  integer :: n
2300 
2301  integer :: error
2302  !---------------------------------------------------------------------------
2303 
2304  !--- register new file and open
2305  if ( single ) then
2306  fname = trim(basename)//'.peall'
2307  else
2308  call filemakefname(fname,trim(basename),'pe',mpi_myrank,6)
2309  endif
2310 
2311  !--- search existing file
2312  fid = -1
2313  do n = 1, file_fid_count-1
2314  if ( fname==file_fname_list(n) ) fid = file_fid_list(n)
2315  enddo
2316 
2317  if ( fid >= 0 ) then
2318  existed = .true.
2319  return
2320  end if
2321 
2322  call file_open( fid, & ! (out)
2323  fname, mode, & ! (in)
2324  error ) ! (out)
2325  if ( error /= success_code ) then
2326  call log('E', 'xxx failed to open file :'//trim(fname)//'.nc')
2327  end if
2328 
2329  write(message,*) '*** [File] File registration : ',trim(rwname(mode)),' -', fid
2330  call log("I", message)
2331  write(message,*) '*** filename: ', trim(fname)
2332  call log("I", message)
2333 
2334  file_fname_list(file_fid_count) = trim(fname)
2335  file_fid_list(file_fid_count) = fid
2336  file_fid_count = file_fid_count + 1
2337 
2338  existed = .false.
2339 
2340  return
2341  end subroutine filegetfid
2342 
2343 end module gtool_file
2344 !-------------------------------------------------------------------------------
2345 
2346 
2347 !--
2348 ! vi:set readonly sw=4 ts=8
2349 !
2350 !Local Variables:
2351 !mode: f90
2352 !buffer-read-only: t
2353 !End:
2354 !
2355 !++
file_set_tunits
int32_t file_set_tunits(int32_t fid, char *time_units)
Definition: gtool_netcdf.c:439
gtool_file::filecreate
subroutine, public filecreate(fid, existed, basename, title, source, institution, master, myrank, rankidx, single, time_units, append)
Definition: gtool_file.f90:150
gtool_file
module GTOOL_FILE
Definition: gtool_file.f90:17
gtool_file_h::file_fwrite
integer, parameter, public file_fwrite
Definition: gtool_file_h.f90:51
dc_log
module DC_Log
Definition: dc_log.f90:14
gtool_file_h::datainfo
Definition: gtool_file_h.f90:63
gtool_file::rmiss
real(dp), parameter, public rmiss
Definition: gtool_file.f90:110
file_set_tattr
int32_t file_set_tattr(int32_t fid, char *vname, char *key, char *val)
Definition: gtool_netcdf.c:447
file_set_global_attribute_text
int32_t file_set_global_attribute_text(int32_t fid, char *key, char *value)
Definition: gtool_netcdf.c:368
gtool_file::filegetalldatainfo
subroutine, public filegetalldatainfo(step_limit, dim_limit, basename, varname, myrank, step_nmax, description, units, datatype, dim_rank, dim_name, dim_size, time_start, time_end, time_units, single)
Definition: gtool_file.f90:1153
file_set_global_attribute_double
int32_t file_set_global_attribute_double(int32_t fid, char *key, double *value, size_t len)
Definition: gtool_netcdf.c:421
dc_log::log_lmsg
integer, parameter, public log_lmsg
Definition: dc_log.f90:47
gtool_file_h::file_fappend
integer, parameter, public file_fappend
Definition: gtool_file_h.f90:52
gtool_file_h::already_existed_code
integer, parameter, public already_existed_code
Definition: gtool_file_h.f90:58
gtool_file::filegetshape
subroutine, public filegetshape(dims, basename, varname, myrank, single)
Definition: gtool_file.f90:970
file_set_global_attribute_float
int32_t file_set_global_attribute_float(int32_t fid, char *key, float *value, size_t len)
Definition: gtool_netcdf.c:403
file_get_global_attribute_int
int32_t file_get_global_attribute_int(int32_t fid, char *key, int32_t *value, size_t len)
file_get_global_attribute_float
int32_t file_get_global_attribute_float(int32_t fid, char *key, float *value, size_t len)
Definition: gtool_netcdf.c:332
gtool_file::filecloseall
subroutine, public filecloseall
Definition: gtool_file.f90:2238
file_get_datainfo
int32_t file_get_datainfo(datainfo_t *dinfo, int32_t fid, char *varname, int32_t step, int32_t suppress)
Definition: gtool_netcdf.c:162
file_set_global_attribute_int
int32_t file_set_global_attribute_int(int32_t fid, char *key, int32_t *value, size_t len)
file_get_global_attribute_double
int32_t file_get_global_attribute_double(int32_t fid, char *key, double *value, size_t len)
Definition: gtool_netcdf.c:350
file_open
int32_t file_open(int32_t *fid, char *fname, int32_t mode)
Definition: gtool_netcdf.c:97
gtool_file_h::success_code
integer, parameter, public success_code
Definition: gtool_file_h.f90:56
gtool_file::fileclose
subroutine, public fileclose(fid)
Definition: gtool_file.f90:2199
file_put_axis
int32_t file_put_axis(int32_t fid, char *name, char *desc, char *units, char *dim_name, int32_t dtype, void *val, int32_t size, int32_t precision)
Definition: gtool_netcdf.c:473
dc_types::dp
integer, parameter, public dp
Definition: dc_types.f90:27
gtool_file::filesettattr
subroutine, public filesettattr(fid, vname, key, val)
Definition: gtool_file.f90:942
gtool_file::filesetoption
subroutine, public filesetoption(fid, filetype, key, val)
Definition: gtool_file.f90:422
gtool_file::filemakefname
subroutine, public filemakefname(fname, basename, prefix, myrank, len)
Definition: gtool_file.f90:2259
file_write_data
int32_t file_write_data(int32_t fid, int32_t vid, void *var, real64_t t_start, real64_t t_end, int32_t precision)
Definition: gtool_netcdf.c:778
gtool_file_h::already_closed_code
integer, parameter, public already_closed_code
Definition: gtool_file_h.f90:57
gtool_file_h::file_fread
integer, parameter, public file_fread
Definition: gtool_file_h.f90:50
gtool_file::fileopen
subroutine, public fileopen(fid, basename, mode, single)
Definition: gtool_file.f90:446
dc_log::log
subroutine, public log(type, message)
Definition: dc_log.f90:133
gtool_file::filegetdatainfo
subroutine, public filegetdatainfo(basename, varname, myrank, istep, single, description, units, datatype, dim_rank, dim_name, dim_size, time_start, time_end, time_units)
Definition: gtool_file.f90:1036
dc_types
Definition: dc_types.f90:12
file_get_global_attribute_text
int32_t file_get_global_attribute_text(int32_t fid, char *key, char *value, int32_t len)
Definition: gtool_netcdf.c:294
dc_types::sp
integer, parameter, public sp
Definition: dc_types.f90:30
file_put_associated_coordinates
int32_t file_put_associated_coordinates(int32_t fid, char *name, char *desc, char *units, char **dim_names, int32_t ndims, int32_t dtype, void *val, int32_t precision)
Definition: gtool_netcdf.c:524
gtool_file_h
module FILE I/O HEADER
Definition: gtool_file_h.f90:14
file_read_data
int32_t file_read_data(void *var, datainfo_t *dinfo, int32_t precision)
Definition: gtool_netcdf.c:245
file_add_variable
int32_t file_add_variable(int32_t *vid, int32_t fid, char *varname, char *desc, char *units, char **dims, int32_t ndims, int32_t dtype, real64_t tint, int32_t tavg)
Definition: gtool_netcdf.c:579
file_close
int32_t file_close(int32_t fid)
Definition: gtool_netcdf.c:852
file_set_option
int32_t file_set_option(int32_t fid, char *filetype, char *key, char *val)
Definition: gtool_netcdf.c:146
Generated by   doxygen 1.8.13