SCALE-RM
gtool_history.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
13 !-------------------------------------------------------------------------------
14 ! Warning: This file was generated from gtool_history.f90.erb.
15 ! Do not edit this file.
16 !-------------------------------------------------------------------------------
17 module gtool_history
18  !-----------------------------------------------------------------------------
19  !
20  !++ Used modules
21  !
22  use dc_log, only: &
23  log, &
24  log_nml, &
25  log_fid, &
26  log_fid_nml, &
27  log_lmsg
28  use dc_types, only: &
29  sp, &
30  dp
31  use gtool_file_h, only: &
32  file_hlong, &
33  file_hshort, &
34  file_hmid
35  !-----------------------------------------------------------------------------
36  implicit none
37  private
38  !-----------------------------------------------------------------------------
39  !
40  !++ Public procedures
41  !
42  public :: historyinit
43  public :: historycheck
44  public :: historyaddvariable
45  public :: historyputaxis
46  public :: historyputassociatedcoordinates
47  public :: historysettattr
48  public :: historyquery
49  public :: historyput
50  public :: historywriteall
51  public :: historywriteaxes
52  public :: historywrite
53  public :: historyget
54  public :: historyoutputlist
55  public :: historyfinalize
56 
57  interface historyputaxis
58  module procedure historyputaxissp
59  module procedure historyputaxisdp
60  end interface historyputaxis
61 
62  interface historyputassociatedcoordinates
63  module procedure historyput1dassociatedcoordinatessp
64  module procedure historyput1dassociatedcoordinatesdp
65  module procedure historyput2dassociatedcoordinatessp
66  module procedure historyput2dassociatedcoordinatesdp
67  module procedure historyput3dassociatedcoordinatessp
68  module procedure historyput3dassociatedcoordinatesdp
69  module procedure historyput4dassociatedcoordinatessp
70  module procedure historyput4dassociatedcoordinatesdp
71  end interface historyputassociatedcoordinates
72 
73  interface historyput
74  module procedure historyput0didsp
75  module procedure historyput0diddp
76  module procedure historyput1didsp
77  module procedure historyput1diddp
78  module procedure historyput2didsp
79  module procedure historyput2diddp
80  module procedure historyput3didsp
81  module procedure historyput3diddp
82  end interface historyput
83 
84  interface historyget
85  module procedure historyget1dsp
86  module procedure historyget1ddp
87  module procedure historyget2dsp
88  module procedure historyget2ddp
89  module procedure historyget3dsp
90  module procedure historyget3ddp
91  end interface historyget
92 
93  type request
94  character(len=File_HSHORT) :: item
95  character(len=File_HMID) :: zcoord
96  character(len=File_HSHORT) :: outname
97  character(len=File_HLONG) :: basename
98  integer :: dstep
99  logical :: taverage
100  integer :: dtype
101  end type request
102 
103  type vars
104  character(len=File_HSHORT) :: item
105  character(len=File_HMID) :: zcoord
106  character(len=File_HSHORT) :: outname
107  integer :: fid
108  integer :: dstep
109  logical :: taverage
110  integer :: vid
111 
112  real(DP) :: waitsec
113  integer :: laststep_write
114  integer :: laststep_put
115  integer :: size
116  real(DP) :: timesum
117  real(DP), pointer :: varsum(:)
118  integer :: ndims
119  integer :: start(4)
120  integer :: count(4)
121  end type vars
122 
123  type axis
124  character(len=File_HSHORT) :: name
125  character(len=File_HLONG) :: desc
126  character(len=File_HSHORT) :: units
127  character(len=File_HSHORT) :: dim
128  integer :: dtype
129  integer :: dim_size
130  real(DP), pointer :: var(:)
131  logical :: down
132  integer :: gdim_size ! global dimension size
133  integer :: start(1) ! global array start index
134  end type axis
135 
136  type assoc
137  character(len=File_HSHORT) :: name
138  character(len=File_HLONG) :: desc
139  character(len=File_HSHORT) :: units
140  integer :: ndims
141  character(len=File_HSHORT) :: dims(4)
142  integer :: dtype
143  real(DP), pointer :: var(:)
144  integer :: start(4) ! global array start indices
145  integer :: count(4) ! global array request lengths
146  end type assoc
147 
148  !-----------------------------------------------------------------------------
149  !
150  !++ included parameters
151  !
152  !-----------------------------------------------------------------------------
153  !
154  !++ Public parameters & variables
155  !
156  !-----------------------------------------------------------------------------
157  !
158  !++ Private procedures
159  !
160  !-----------------------------------------------------------------------------
161  !
162  !++ Private parameters & variables
163  !
164 
165  ! From upstream side of the library
166  integer, private :: History_master
167  integer, private :: History_myrank
168  integer, private, allocatable :: History_rankidx(:)
169 
170  real(DP), private :: History_STARTDAYSEC
171  real(DP), private :: History_DTSEC
172  character(len=File_HMID), private :: History_TIME_SINCE
173 
174  ! From NAMELIST or upstream side of the library
175  character(len=File_HMID), private :: History_TITLE
176  character(len=File_HMID), private :: History_SOURCE
177  character(len=File_HMID), private :: History_INSTITUTION
178  character(len=File_HMID), private :: History_TIME_UNITS
179 
180  logical, private :: History_OUTPUT_STEP0 = .false.
181  real(DP), private :: History_OUTPUT_WAIT = 0.0_dp
182 
183  logical, private :: History_ERROR_PUTMISS = .true.
184 
185  ! working
186  integer, private, parameter :: History_req_limit = 1000
187  integer, private :: History_req_count = 0
188  type(request), private, allocatable :: History_req(:)
189 
190  integer, private :: History_id_count = 0
191  type(vars), private, allocatable :: History_vars(:)
192  logical, private, allocatable :: History_axis_written(:)
193 
194  integer, private, parameter :: History_axis_limit = 100
195  integer, private :: History_axis_count = 0
196  type(axis), private :: History_axis(History_axis_limit)
197 
198  integer, private, parameter :: History_assoc_limit = 20
199  integer, private :: History_assoc_count = 0
200  type(assoc), private :: History_assoc(History_assoc_limit)
201 
202  real(DP), private, parameter :: eps = 1.d-10
203 
204  integer, private :: laststep_write = -1
205  logical, private :: firsttime = .true.
206  character(len=LOG_LMSG), private :: message = ''
207  logical, private :: debug = .false.
208 
209  integer, private :: io_buffer_size
210 
211 contains
212  !-----------------------------------------------------------------------------
213  subroutine historyinit( &
214  item_count, &
215  variant_count, &
216  isize, &
217  jsize, &
218  ksize, &
219  master, &
220  myrank, &
221  rankidx, &
222  title, &
223  source, &
224  institution, &
225  time_start, &
226  time_interval, &
227  time_units, &
228  time_since, &
229  default_basename, &
230  default_zcoord, &
231  default_tinterval, &
232  default_tunit, &
233  default_taverage, &
234  default_datatype, &
235  namelist_filename, &
236  namelist_fid )
237 #if defined(PGI) || defined(SX)
238  use dc_log, only: &
239  log_master_nml
240 #endif
241  use dc_calendar, only: &
242  calendarymdhms2sec
243  use gtool_file_h, only: &
244  file_real4, &
245  file_real8, &
246  file_preclist
247  implicit none
248 
249  integer, intent(out) :: item_count
250  integer, intent(out) :: variant_count
251  integer, intent(in) :: isize
252  integer, intent(in) :: jsize
253  integer, intent(in) :: ksize
254  integer, intent(in) :: master
255  integer, intent(in) :: myrank
256  integer, intent(in) :: rankidx(:)
257  character(len=*), intent(in) :: title
258  character(len=*), intent(in) :: source
259  character(len=*), intent(in) :: institution
260  real(DP), intent(in) :: time_start
261  real(DP), intent(in) :: time_interval
262  character(len=*), intent(in), optional :: time_units
263  character(len=*), intent(in), optional :: time_since
264  character(len=*), intent(in), optional :: default_basename
265  character(len=*), intent(in), optional :: default_zcoord
266  real(DP), intent(in), optional :: default_tinterval
267  character(len=*), intent(in), optional :: default_tunit
268  logical, intent(in), optional :: default_taverage
269  character(len=*), intent(in), optional :: default_datatype
270  character(len=*), intent(in), optional :: namelist_filename
271  integer , intent(in), optional :: namelist_fid
272 
273  character(len=File_HLONG) :: history_default_basename
274  real(DP) :: history_default_tinterval
275  character(len=File_HSHORT) :: history_default_tunit
276  logical :: history_default_taverage
277  character(len=File_HSHORT) :: history_default_zcoord
278  character(len=File_HSHORT) :: history_default_datatype
281 
282  namelist / param_history / &
283  history_title, &
284  history_source, &
285  history_institution, &
286  history_time_units, &
287  history_default_basename, &
288  history_default_tinterval, &
289  history_default_tunit, &
290  history_default_taverage, &
291  history_default_zcoord, &
292  history_default_datatype, &
293  history_output_step0, &
294  history_output_wait, &
295  history_error_putmiss, &
296  debug
297 
298  character(len=File_HSHORT) :: item
299  character(len=File_HSHORT) :: outname
300 
301  character(len=File_HLONG) :: basename
302  real(DP) :: tinterval
303  character(len=File_HSHORT) :: tunit
304  logical :: taverage
305  character(len=File_HSHORT) :: zcoord
306  character(len=File_HSHORT) :: datatype
307 
308  namelist / histitem / &
309  item, &
310  outname, &
311  basename, &
312  tinterval, &
313  tunit, &
314  taverage, &
315  zcoord, &
316  datatype
317 
318  integer :: array_size
319  integer :: memsize
320  integer :: reqid
321  real(DP) :: item_dtsec
322  integer :: item_dstep
323 
324  integer :: id1, id2, count
325  character(len=File_HSHORT) :: item1, item2
326 
327  integer :: fid, ierr
328  integer :: n, id
329 
330  intrinsic size
331  !---------------------------------------------------------------------------
332 
333  call log('I','')
334  call log('I','###### Module[HISTORY] / Origin[gtoollib]')
335 
336  ! setup
337  allocate( history_rankidx(size(rankidx)) )
338  history_master = master
339  history_myrank = myrank
340  history_rankidx(:) = rankidx(:)
341 
342  history_startdaysec = time_start
343  history_dtsec = time_interval
344  if( present(time_since) ) then
345  history_time_since = time_since
346  else
347  history_time_since = ''
348  end if
349 
350  history_time_units = 'seconds'
351  history_default_basename = ''
352  history_default_tinterval = -1.0_dp
353  history_default_tunit = 'sec'
354  history_default_taverage = .false.
355  history_default_zcoord = ''
356  history_default_datatype = 'REAL4'
357 
358  !--- read namelist
359  history_title = title
360  history_source = source
361  history_institution = institution
362  if( present(time_units) ) history_time_units = time_units
363  if( present(default_basename) ) history_default_basename = default_basename
364  if( present(default_tinterval) ) history_default_tinterval = default_tinterval
365  if( present(default_tunit) ) history_default_tunit = default_tunit
366  if( present(default_taverage) ) history_default_taverage = default_taverage
367  if( present(default_zcoord) ) history_default_zcoord = default_zcoord
368  if( present(default_datatype) ) history_default_datatype = default_datatype
369 
370  fid = -1
371  if ( present(namelist_fid) ) then
372  fid = namelist_fid
373  elseif( present(namelist_filename) ) then
374  if ( namelist_filename /= '' ) then
375  open( unit = fid, &
376  file = trim(namelist_filename), &
377  form = 'formatted', &
378  status = 'old' )
379  endif
380  endif
381 
382  if ( fid <= 0 ) then
383  call log('E','xxx No namelist file is specified. Check!')
384  endif
385 
386  rewind(fid)
387  read(fid,nml=param_history,iostat=ierr)
388  if ( ierr < 0 ) then !--- missing
389  call log('I','*** Not found namelist. Default used.')
390  elseif( ierr > 0 ) then !--- fatal error
391  call log('E','xxx Not appropriate names in namelist PARAM_HISTORY. Check!')
392  endif
393 
394 #if defined(PGI) || defined(SX)
395  if ( log_master_nml ) write(log_fid_nml,nml=param_history)
396 #else
397  write(message,nml=param_history)
398  call log_nml('I',message)
399 #endif
400 
401  if ( history_output_wait < 0.0_dp ) then
402  write(message,*) 'xxx History_OUTPUT_WAIT must be positive. STOP'
403  call log('E',message)
404  endif
405 
406  array_size = isize * jsize * ksize
407 
408  ! count history request
409  history_req_count = 0
410  rewind(fid)
411  do n = 1, history_req_limit
412  item = ''
413  outname = 'undefined'
414  basename = history_default_basename
415 
416  read(fid,nml=histitem,iostat=ierr)
417  if( ierr /= 0 ) exit
418  if( basename == '' .OR. item == '' .OR. outname == '' ) cycle ! invalid HISTITEM
419 
420  history_req_count = history_req_count + 1
421  enddo
422 
423  item_count = history_req_count
424  variant_count = 1
425 
426  if ( history_req_count > history_req_limit ) then
427  write(message,*) 'xxx request of history file is exceed! n >', history_req_limit
428  call log('E',message)
429  elseif( history_req_count == 0 ) then
430  call log('I','*** No history file specified.')
431  return
432  endif
433 
434 
435  allocate( history_req(history_req_count) )
436 
437  ! allows PnetCDF to use an internal buffer to aggregate write requests
438  io_buffer_size = array_size * history_req_count * 8
439 
440  ! read history request
441 
442 
443  memsize = 0
444  reqid = 0
445  if ( fid > 0 ) rewind(fid)
446  do n = 1, history_req_limit
447  ! set default
448  item = ''
449  outname = 'undefined'
450  basename = history_default_basename
451  tinterval = history_default_tinterval
452  tunit = history_default_tunit
453  taverage = history_default_taverage
454  zcoord = history_default_zcoord
455  datatype = history_default_datatype
456 
457  read(fid,nml=histitem,iostat=ierr)
458  if( ierr /= 0 ) exit
459  if( basename == '' .OR. item == '' .OR. outname == '' ) cycle ! invalid HISTITEM
460 
461  if ( log_fid_nml /= log_fid ) then
462 #if defined(PGI) || defined(SX)
463  if ( log_master_nml ) write(log_fid_nml,nml=histitem)
464 #else
465  write(message,nml=histitem)
466  call log_nml('I',message)
467 #endif
468  endif
469 
470  ! check duplicated request
471  if ( outname == 'undefined' ) outname = item ! set default name
472  do id = 1, reqid
473  if ( history_req(id)%outname == outname ) then
474  write(message,*) &
475  'xxx Same name of history output is already registered. Check!', trim(outname)
476  call log('E',message)
477  endif
478  enddo
479 
480  reqid = reqid + 1
481 
482  history_req(reqid)%item = item
483  history_req(reqid)%outname = outname
484  history_req(reqid)%basename = basename
485  history_req(reqid)%taverage = taverage
486 
487  call calendarymdhms2sec( item_dtsec, tinterval, tunit )
488  item_dstep = int( item_dtsec / history_dtsec )
489 
490  if ( item_dtsec <= 0.d0 ) then
491  write(message,*) &
492  'xxx Not appropriate time interval. Check!', trim(item), tinterval, trim(tunit)
493  call log('E',message)
494  endif
495 
496  if ( abs(item_dtsec-real(item_dstep,kind=dp)*history_dtsec ) > eps ) then
497  write(message,*) &
498  'xxx time interval must be a multiple of delta t. (interval,dt)=', item_dtsec, history_dtsec
499  call log('E',message)
500  endif
501 
502  history_req(reqid)%dstep = item_dstep
503  history_req(reqid)%zcoord = zcoord
504 
505  if ( datatype == 'REAL4' ) then
506  history_req(reqid)%dtype = file_real4
507  memsize = memsize + array_size * file_preclist(file_real4)
508  elseif( datatype == 'REAL8' ) then
509  history_req(reqid)%dtype = file_real8
510  memsize = memsize + array_size * file_preclist(file_real8)
511  else
512  write(message,*) 'xxx Not appropriate DATATYPE. Check!', datatype
513  call log('E',message)
514  endif
515  enddo
516 
517  call log('I','')
518  write(message,'(A,I4)') '*** Number of requested history item : ', history_req_count
519  call log('I',message)
520  write(message,'(A,A)') '*** Output default data type : ', history_default_datatype
521  call log('I',message)
522  write(message,'(A,I8)') '*** Memory usage for history data buffer [Mbyte] : ', memsize / 1024 / 1024
523  call log('I',message)
524  write(message,'(A,L4)') '*** Output value at the initial step? : ', history_output_step0
525  call log('I',message)
526  write(message,'(A,L4)') '*** Check if requested item is not registered? : ', history_error_putmiss
527  call log('I',message)
528  if ( history_output_wait > 0.0_dp ) then
529  write(message,'(A,F10.3)') '*** Time to suppress output [sec] : ', history_output_wait
530  call log('I',message)
531  endif
532 
533  if ( .NOT. present(namelist_fid) ) then
534  if( fid > 0 ) close(fid)
535  endif
536 
537  history_id_count = 0
538  allocate( history_vars( history_req_count) )
539  allocate( history_axis_written(0:history_req_count) )
540 
541  do n = 1, history_req_count
542  allocate( history_vars(n)%varsum(array_size) )
543  enddo
544 
545  ! count number of items and variants
546  do id1 = 1, item_count
547  item1 = history_req(id1)%item
548  count = 1
549  do id2 = id1, item_count
550  item2 = history_req(id2)%item
551  if( item1 == item2 ) count = count + 1
552  enddo
553  variant_count = max( variant_count, count)
554  enddo
555 
556  return
557  end subroutine historyinit
558 
559  !-----------------------------------------------------------------------------
560  subroutine historycheck( &
561  existed, &
562  item, &
563  zcoord )
564  implicit none
565 
566  logical, intent(out) :: existed
567  character(len=*), intent(in) :: item
568  character(len=*), intent(in), optional :: zcoord
569 
570  integer :: max_count
571  integer :: n
572 
573  intrinsic size
574  !---------------------------------------------------------------------------
575 
576  existed = .false.
577 
578  max_count = min( history_id_count, history_req_count )
579 
580  do n = 1, max_count
581 
582  !--- search existing item
583  if ( item == history_vars(n)%item ) then ! match (at least one) existing item
584  !--- check z-coordinate
585  if ( present(zcoord) ) then
586  if ( history_vars(n)%zcoord == zcoord ) then
587  existed = .true.
588  return
589  endif
590  else
591  existed = .true.
592  return
593  endif
594 
595  end if
596 
597  enddo
598 
599  return
600  end subroutine historycheck
601 
602  !-----------------------------------------------------------------------------
603  subroutine historyaddvariable( &
604  nregist, &
605  item, &
606  dims, &
607  desc, &
608  units, &
609  now_step, &
610  zcoord, &
611  options, &
612  start, &
613  count, &
614  comm )
615  use gtool_file, only: &
616  filecreate, &
617  filesetoption, &
618  fileaddvariable, &
619  filesettattr, &
620  filedefaxis, &
621  filedefassociatedcoordinates, &
622  fileattachbuffer
623  use mpi, only: &
624  mpi_comm_null
625  implicit none
626 
627  integer, intent(out) :: nregist
628  character(len=*), intent(in) :: item
629  character(len=*), intent(in) :: dims(:)
630  character(len=*), intent(in) :: desc
631  character(len=*), intent(in) :: units
632  integer, intent(in) :: now_step
633  character(len=*), intent(in), optional :: zcoord
634  character(len=*), intent(in), optional :: options ! 'filetype1:key1=val1&filetype2:key2=val2&...'
635  integer, intent(in), optional :: start(:) ! global subarray starting indices of this process's write request
636  integer, intent(in), optional :: count(:) ! lengths of this process's write request along each dimension
637  integer, intent(in), optional :: comm ! MPI communicator
638 
639  character(len=File_HMID) :: tunits
640  logical :: fileexisted
641  integer :: ic, ie, is, lo
642  real(DP) :: dtsec
643  logical :: existed
644  integer :: ndim
645 
646  logical :: shared_file_io
647  integer :: reqid
648  integer :: id, fid
649  integer :: m, dim_size
650 
651  intrinsic size
652  !---------------------------------------------------------------------------
653 
654  nregist = 0
655 
656  ! check whether shared-file I/O method is enabled
657  shared_file_io = .false.
658  if ( present(comm) .AND. comm .NE. mpi_comm_null ) shared_file_io = .true.
659 
660  call historycheck( existed, & ! [OUT]
661  item, & ! [IN]
662  zcoord ) ! [IN]
663 
664  if ( .NOT. existed ) then ! request-register matching check
665 
666  ! new file registration
667  if ( history_time_since == '' ) then
668  tunits = trim(history_time_units)
669  else
670  tunits = trim(history_time_units)//' since '//trim(history_time_since)
671  endif
672 
673  ndim = size(dims)
674 
675  do reqid = 1, history_req_count
676 
677  ! note: plural requests are allowed for each item
678  if ( item == history_req(reqid)%item ) then
679 
680  if ( present(zcoord) ) then
681  if ( history_req(reqid)%zcoord /= zcoord ) cycle
682  end if
683 
684  existed = .true.
685  nregist = nregist + 1
686 
687  history_id_count = history_id_count + 1
688  id = history_id_count
689 
690  history_vars(id)%item = history_req(reqid)%item
691  history_vars(id)%outname = history_req(reqid)%outname
692 
693  call filecreate( fid, & ! [OUT]
694  fileexisted, & ! [OUT]
695  history_req(reqid)%basename, & ! [IN]
696  history_title, & ! [IN]
697  history_source, & ! [IN]
698  history_institution, & ! [IN]
699  history_master, & ! [IN]
700  history_myrank, & ! [IN]
701  history_rankidx(:), & ! [IN]
702  time_units = tunits, & ! [IN]
703  comm = comm ) ! [IN]
704 
705  history_vars(id)%fid = fid
706  history_vars(id)%dstep = history_req(reqid)%dstep
707  history_vars(id)%taverage = history_req(reqid)%taverage
708  history_vars(id)%zcoord = history_req(reqid)%zcoord
709 
710  if ( .NOT. fileexisted ) then ! new file
711 
712  ! write options
713  if ( present(options) ) then
714  ic = -1 ! index of ':'
715  ie = -1 ! index of '='
716  is = 1 ! start index
717  lo = len_trim(options)
718  do m = 1, lo+1
719  if ( m == lo+1 .OR. options(m:m) == '&' ) then
720  if ( ic == -1 .OR. ie == -1 ) then
721  call log('E','xxx option is invalid: '//trim(options))
722  endif
723 
724  call filesetoption( fid, & ! [IN]
725  options(is :ic-1), & ! [IN]
726  options(ic+1:ie-1), & ! [IN]
727  options(ie+1:m -1) ) ! [IN]
728 
729  ic = -1
730  ie = -1
731  is = m+1
732  elseif( options(m:m) == ':' ) then
733  ic = m
734  elseif( options(m:m) == '=' ) then
735  ie = m
736  endif
737  enddo
738  endif
739 
740  ! define registered history axis variables in the newly created file
741  ! actual writing axis variables are deferred to HistoryWriteAxes
742  do m = 1, history_axis_count
743  if ( shared_file_io ) then ! for shared-file I/O, define axis in its global size
744  dim_size = history_axis(m)%gdim_size ! axis global size
745  else
746  dim_size = history_axis(m)%dim_size
747  end if
748 
749  call filedefaxis( fid, & ! [IN]
750  history_axis(m)%name, & ! [IN]
751  history_axis(m)%desc, & ! [IN]
752  history_axis(m)%units, & ! [IN]
753  history_axis(m)%dim, & ! [IN]
754  history_axis(m)%dtype, & ! [IN]
755  dim_size ) ! [IN]
756  enddo
757 
758  ! define registered history associated coordinate variables in the newly created file
759  ! actual writing coordinate variables are deferred to HistoryWriteAxes
760  do m = 1, history_assoc_count
761 
762  if ( shared_file_io ) then
763  dim_size = history_axis(m)%gdim_size
764  else
765  dim_size = history_axis(m)%dim_size
766  end if
767 
768  call filedefassociatedcoordinates( fid, & ! [IN]
769  history_assoc(m)%name, & ! [IN]
770  history_assoc(m)%desc, & ! [IN]
771  history_assoc(m)%units, & ! [IN]
772  history_assoc(m)%dims(1:history_assoc(m)%ndims), & ! [IN]
773  history_assoc(m)%dtype ) ! [IN]
774  enddo
775 
776  ! allows PnetCDF to allocate an internal buffer of size io_buffer_size
777  ! to aggregate write requests for history variables
778  call fileattachbuffer( fid, io_buffer_size )
779 
780  history_axis_written(fid) = .false.
781 
782  endif ! new file?
783 
784  ! Add new variable
785  dtsec = real(History_vars(id)%dstep,kind=DP) * history_dtsec
786 
787  ! history variable has been reshaped to 1D, we preserve the
788  ! original shape in count(:) and History_count(:,id)
789  ! History_ndims(id) stores number of dimensions of original shape
790  history_vars(id)%ndims = size(dims)
791 
792  history_vars(id)%start(:) = 1
793  history_vars(id)%count(:) = 1
794  if ( present(start) ) history_vars(id)%start(:) = start(:)
795  if ( present(count) ) history_vars(id)%count(:) = count(:)
796 
797  call fileaddvariable( history_vars(id)%vid, & ! [OUT]
798  fid, & ! [IN]
799  history_vars(id)%outname, & ! [IN]
800  desc, & ! [IN]
801  units, & ! [IN]
802  dims(1:ndim), & ! [IN]
803  history_req(reqid)%dtype, & ! [IN]
804  dtsec, & ! [IN]
805  history_vars(id)%taverage ) ! [IN]
806 
807  if ( .not. fileexisted ) then
808  do m = 1, history_axis_count
809  if ( history_axis(m)%down ) then
810  call filesettattr( fid, history_axis(m)%name, 'positive', 'down' )
811  endif
812  enddo
813  endif
814 
815  ! initialize
816  history_vars(id)%size = 0
817  history_vars(id)%waitsec = history_output_wait
818  if ( history_output_step0 .AND. now_step == 1 ) then
819  history_vars(id)%laststep_write = 1 - history_vars(id)%dstep
820  else
821  history_vars(id)%laststep_write = 1
822  endif
823  history_vars(id)%laststep_put = history_vars(id)%laststep_write
824  history_vars(id)%timesum = 0.0_dp
825  history_vars(id)%varsum(:) = 0.0_dp
826 
827  if ( debug ) then
828  write(message,*) '*** [HIST] Item registration No.= ', id
829  call log('I',message)
830  write(message,*) '] Item name : ', trim(history_vars(id)%item)
831  call log('I',message)
832  write(message,*) '] Output name : ', trim(history_vars(id)%outname)
833  call log('I',message)
834  write(message,*) '] Description : ', trim(desc)
835  call log('I',message)
836  write(message,*) '] Unit : ', trim(units)
837  call log('I',message)
838  write(message,*) '] Z-coordinate : ', trim(history_vars(id)%zcoord)
839  call log('I',message)
840  write(message,*) '] Interval [sec,step] : ', dtsec, history_vars(id)%dstep
841  call log('I',message)
842  write(message,*) '] Time Average? : ', history_vars(id)%taverage
843  call log('I',message)
844  write(message,*) '] axis name : ', dims(1:ndim)
845  call log('I',message)
846  call log('I','')
847  endif
848 
849  endif ! match item?
850  enddo
851 
852  endif ! new items?
853 
854  return
855  end subroutine historyaddvariable
856 
857  !-----------------------------------------------------------------------------
858  ! interface HistoryPutAxis
859  !-----------------------------------------------------------------------------
860  !-----------------------------------------------------------------------------
861  subroutine historyputaxissp( &
862  name, &
863  desc, &
864  units, &
865  dim, &
866  var, &
867  datatype, &
868  down, &
869  gsize, &
870  start )
871  use gtool_file_h, only: &
872  file_real4, &
873  file_real8
874  implicit none
875 
876  character(len=*), intent(in) :: name
877  character(len=*), intent(in) :: desc
878  character(len=*), intent(in) :: units
879  character(len=*), intent(in) :: dim
880  real(SP), intent(in) :: var(:)
881  character(len=*), intent(in), optional :: datatype
882  logical, intent(in), optional :: down
883  integer, intent(in), optional :: gsize ! global dim size
884  integer, intent(in), optional :: start ! global subarray start indices
885 
886  integer :: dtype
887  integer :: dim_size
888  integer :: id
889 
890  intrinsic size
891  !---------------------------------------------------------------------------
892 
893  if ( present(datatype) ) then
894  if ( datatype == 'REAL4' ) then
895  dtype = file_real4
896  elseif( datatype == 'REAL8' ) then
897  dtype = file_real8
898  else
899  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
900  call log('E',message)
901  endif
902  else
903  dtype = file_real4
904  endif
905 
906  dim_size = size(var)
907 
908  if ( history_axis_count < history_axis_limit ) then
909  history_axis_count = history_axis_count + 1
910  id = history_axis_count
911 
912  allocate( history_axis(id)%var(dim_size) )
913 
914  history_axis(id)%name = name
915  history_axis(id)%desc = desc
916  history_axis(id)%units = units
917  history_axis(id)%dim = dim
918  history_axis(id)%dtype = dtype
919  history_axis(id)%dim_size = dim_size
920  history_axis(id)%var(:) = var(:)
921 
922  if ( present(down) ) then
923  history_axis(history_axis_count)%down = down
924  else
925  history_axis(history_axis_count)%down = .false.
926  endif
927  if ( present(gsize) ) & ! global dimension size
928  history_axis(history_axis_count)%gdim_size = gsize
929  if ( present(start) ) then ! global subarray starting indices
930  history_axis(history_axis_count)%start(1) = start
931  else
932  history_axis(history_axis_count)%start(1) = 1
933  end if
934  else
935  write(message,*) 'xxx Number of axis exceeds the limit.'
936  call log('E',message)
937  endif
938 
939  return
940  end subroutine historyputaxissp
941 
942  !-----------------------------------------------------------------------------
943  subroutine historyputaxisdp( &
944  name, &
945  desc, &
946  units, &
947  dim, &
948  var, &
949  datatype, &
950  down, &
951  gsize, &
952  start )
953  use gtool_file_h, only: &
954  file_real4, &
955  file_real8
956  implicit none
957 
958  character(len=*), intent(in) :: name
959  character(len=*), intent(in) :: desc
960  character(len=*), intent(in) :: units
961  character(len=*), intent(in) :: dim
962  real(DP), intent(in) :: var(:)
963  character(len=*), intent(in), optional :: datatype
964  logical, intent(in), optional :: down
965  integer, intent(in), optional :: gsize ! global dim size
966  integer, intent(in), optional :: start ! global subarray start indices
967 
968  integer :: dtype
969  integer :: dim_size
970  integer :: id
971 
972  intrinsic size
973  !---------------------------------------------------------------------------
974 
975  if ( present(datatype) ) then
976  if ( datatype == 'REAL4' ) then
977  dtype = file_real4
978  elseif( datatype == 'REAL8' ) then
979  dtype = file_real8
980  else
981  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
982  call log('E',message)
983  endif
984  else
985  dtype = file_real8
986  endif
987 
988  dim_size = size(var)
989 
990  if ( history_axis_count < history_axis_limit ) then
991  history_axis_count = history_axis_count + 1
992  id = history_axis_count
993 
994  allocate( history_axis(id)%var(dim_size) )
995 
996  history_axis(id)%name = name
997  history_axis(id)%desc = desc
998  history_axis(id)%units = units
999  history_axis(id)%dim = dim
1000  history_axis(id)%dtype = dtype
1001  history_axis(id)%dim_size = dim_size
1002  history_axis(id)%var(:) = var(:)
1003 
1004  if ( present(down) ) then
1005  history_axis(history_axis_count)%down = down
1006  else
1007  history_axis(history_axis_count)%down = .false.
1008  endif
1009  if ( present(gsize) ) & ! global dimension size
1010  history_axis(history_axis_count)%gdim_size = gsize
1011  if ( present(start) ) then ! global subarray starting indices
1012  history_axis(history_axis_count)%start(1) = start
1013  else
1014  history_axis(history_axis_count)%start(1) = 1
1015  end if
1016  else
1017  write(message,*) 'xxx Number of axis exceeds the limit.'
1018  call log('E',message)
1019  endif
1020 
1021  return
1022  end subroutine historyputaxisdp
1023 
1024  !-----------------------------------------------------------------------------
1025  subroutine historyput1dassociatedcoordinatessp( &
1026  name, &
1027  desc, &
1028  units, &
1029  dims, &
1030  var, &
1031  datatype, &
1032  start )
1033  use gtool_file_h, only: &
1034  file_real4, &
1035  file_real8
1036  implicit none
1037 
1038  character(len=*), intent(in) :: name
1039  character(len=*), intent(in) :: desc
1040  character(len=*), intent(in) :: units
1041  character(len=*), intent(in) :: dims(:)
1042  real(SP), intent(in) :: var(:)
1043  character(len=*), intent(in), optional :: datatype
1044  integer, intent(in), optional :: start(:)
1045 
1046  integer :: dtype
1047  integer :: dim_size
1048  integer :: id
1049 
1050  intrinsic size, shape, reshape
1051  !---------------------------------------------------------------------------
1052 
1053  if ( present(datatype) ) then
1054  if ( datatype == 'REAL4' ) then
1055  dtype = file_real4
1056  elseif( datatype == 'REAL8' ) then
1057  dtype = file_real8
1058  else
1059  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
1060  call log('E',message)
1061  endif
1062  else
1063  dtype = file_real4
1064  endif
1065 
1066  dim_size = size(var)
1067 
1068  if ( history_assoc_count < history_assoc_limit ) then
1069  history_assoc_count = history_assoc_count + 1
1070  id = history_assoc_count
1071 
1072  allocate( history_assoc(id)%var(dim_size) )
1073 
1074  history_assoc(id)%name = name
1075  history_assoc(id)%desc = desc
1076  history_assoc(id)%units = units
1077  history_assoc(id)%ndims = 1
1078  history_assoc(id)%dims(:) = ''
1079  history_assoc(id)%dims(1:1) = dims(1:1)
1080  history_assoc(id)%dtype = dtype
1081  history_assoc(id)%var(:) = reshape( var, (/ dim_size /) )
1082 
1083  ! start and count are used for parallel I/O to a single shared file
1084  ! since var is reshaped into 1D array, we need to preserve its original shape in count
1085  history_assoc(id)%count(1:1) = shape(var)
1086  if ( present(start) ) then
1087  history_assoc(id)%start(1:1) = start(1:1)
1088  else
1089  history_assoc(id)%start = (/ 1, 1, 1, 1 /)
1090  end if
1091  else
1092  write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
1093  call log('E',message)
1094  endif
1095 
1096  return
1097  end subroutine historyput1dassociatedcoordinatessp
1098 
1099  !-----------------------------------------------------------------------------
1100  subroutine historyput1dassociatedcoordinatesdp( &
1101  name, &
1102  desc, &
1103  units, &
1104  dims, &
1105  var, &
1106  datatype, &
1107  start )
1108  use gtool_file_h, only: &
1109  file_real4, &
1110  file_real8
1111  implicit none
1112 
1113  character(len=*), intent(in) :: name
1114  character(len=*), intent(in) :: desc
1115  character(len=*), intent(in) :: units
1116  character(len=*), intent(in) :: dims(:)
1117  real(DP), intent(in) :: var(:)
1118  character(len=*), intent(in), optional :: datatype
1119  integer, intent(in), optional :: start(:)
1120 
1121  integer :: dtype
1122  integer :: dim_size
1123  integer :: id
1124 
1125  intrinsic size, shape, reshape
1126  !---------------------------------------------------------------------------
1127 
1128  if ( present(datatype) ) then
1129  if ( datatype == 'REAL4' ) then
1130  dtype = file_real4
1131  elseif( datatype == 'REAL8' ) then
1132  dtype = file_real8
1133  else
1134  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
1135  call log('E',message)
1136  endif
1137  else
1138  dtype = file_real8
1139  endif
1140 
1141  dim_size = size(var)
1142 
1143  if ( history_assoc_count < history_assoc_limit ) then
1144  history_assoc_count = history_assoc_count + 1
1145  id = history_assoc_count
1146 
1147  allocate( history_assoc(id)%var(dim_size) )
1148 
1149  history_assoc(id)%name = name
1150  history_assoc(id)%desc = desc
1151  history_assoc(id)%units = units
1152  history_assoc(id)%ndims = 1
1153  history_assoc(id)%dims(:) = ''
1154  history_assoc(id)%dims(1:1) = dims(1:1)
1155  history_assoc(id)%dtype = dtype
1156  history_assoc(id)%var(:) = reshape( var, (/ dim_size /) )
1157 
1158  ! start and count are used for parallel I/O to a single shared file
1159  ! since var is reshaped into 1D array, we need to preserve its original shape in count
1160  history_assoc(id)%count(1:1) = shape(var)
1161  if ( present(start) ) then
1162  history_assoc(id)%start(1:1) = start(1:1)
1163  else
1164  history_assoc(id)%start = (/ 1, 1, 1, 1 /)
1165  end if
1166  else
1167  write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
1168  call log('E',message)
1169  endif
1170 
1171  return
1172  end subroutine historyput1dassociatedcoordinatesdp
1173 
1174  !-----------------------------------------------------------------------------
1175  subroutine historyput2dassociatedcoordinatessp( &
1176  name, &
1177  desc, &
1178  units, &
1179  dims, &
1180  var, &
1181  datatype, &
1182  start )
1183  use gtool_file_h, only: &
1184  file_real4, &
1185  file_real8
1186  implicit none
1187 
1188  character(len=*), intent(in) :: name
1189  character(len=*), intent(in) :: desc
1190  character(len=*), intent(in) :: units
1191  character(len=*), intent(in) :: dims(:)
1192  real(SP), intent(in) :: var(:,:)
1193  character(len=*), intent(in), optional :: datatype
1194  integer, intent(in), optional :: start(:)
1195 
1196  integer :: dtype
1197  integer :: dim_size
1198  integer :: id
1199 
1200  intrinsic size, shape, reshape
1201  !---------------------------------------------------------------------------
1202 
1203  if ( present(datatype) ) then
1204  if ( datatype == 'REAL4' ) then
1205  dtype = file_real4
1206  elseif( datatype == 'REAL8' ) then
1207  dtype = file_real8
1208  else
1209  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
1210  call log('E',message)
1211  endif
1212  else
1213  dtype = file_real4
1214  endif
1215 
1216  dim_size = size(var)
1217 
1218  if ( history_assoc_count < history_assoc_limit ) then
1219  history_assoc_count = history_assoc_count + 1
1220  id = history_assoc_count
1221 
1222  allocate( history_assoc(id)%var(dim_size) )
1223 
1224  history_assoc(id)%name = name
1225  history_assoc(id)%desc = desc
1226  history_assoc(id)%units = units
1227  history_assoc(id)%ndims = 2
1228  history_assoc(id)%dims(:) = ''
1229  history_assoc(id)%dims(1:2) = dims(1:2)
1230  history_assoc(id)%dtype = dtype
1231  history_assoc(id)%var(:) = reshape( var, (/ dim_size /) )
1232 
1233  ! start and count are used for parallel I/O to a single shared file
1234  ! since var is reshaped into 1D array, we need to preserve its original shape in count
1235  history_assoc(id)%count(1:2) = shape(var)
1236  if ( present(start) ) then
1237  history_assoc(id)%start(1:2) = start(1:2)
1238  else
1239  history_assoc(id)%start = (/ 1, 1, 1, 1 /)
1240  end if
1241  else
1242  write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
1243  call log('E',message)
1244  endif
1245 
1246  return
1247  end subroutine historyput2dassociatedcoordinatessp
1248 
1249  !-----------------------------------------------------------------------------
1250  subroutine historyput2dassociatedcoordinatesdp( &
1251  name, &
1252  desc, &
1253  units, &
1254  dims, &
1255  var, &
1256  datatype, &
1257  start )
1258  use gtool_file_h, only: &
1259  file_real4, &
1260  file_real8
1261  implicit none
1262 
1263  character(len=*), intent(in) :: name
1264  character(len=*), intent(in) :: desc
1265  character(len=*), intent(in) :: units
1266  character(len=*), intent(in) :: dims(:)
1267  real(DP), intent(in) :: var(:,:)
1268  character(len=*), intent(in), optional :: datatype
1269  integer, intent(in), optional :: start(:)
1270 
1271  integer :: dtype
1272  integer :: dim_size
1273  integer :: id
1274 
1275  intrinsic size, shape, reshape
1276  !---------------------------------------------------------------------------
1277 
1278  if ( present(datatype) ) then
1279  if ( datatype == 'REAL4' ) then
1280  dtype = file_real4
1281  elseif( datatype == 'REAL8' ) then
1282  dtype = file_real8
1283  else
1284  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
1285  call log('E',message)
1286  endif
1287  else
1288  dtype = file_real8
1289  endif
1290 
1291  dim_size = size(var)
1292 
1293  if ( history_assoc_count < history_assoc_limit ) then
1294  history_assoc_count = history_assoc_count + 1
1295  id = history_assoc_count
1296 
1297  allocate( history_assoc(id)%var(dim_size) )
1298 
1299  history_assoc(id)%name = name
1300  history_assoc(id)%desc = desc
1301  history_assoc(id)%units = units
1302  history_assoc(id)%ndims = 2
1303  history_assoc(id)%dims(:) = ''
1304  history_assoc(id)%dims(1:2) = dims(1:2)
1305  history_assoc(id)%dtype = dtype
1306  history_assoc(id)%var(:) = reshape( var, (/ dim_size /) )
1307 
1308  ! start and count are used for parallel I/O to a single shared file
1309  ! since var is reshaped into 1D array, we need to preserve its original shape in count
1310  history_assoc(id)%count(1:2) = shape(var)
1311  if ( present(start) ) then
1312  history_assoc(id)%start(1:2) = start(1:2)
1313  else
1314  history_assoc(id)%start = (/ 1, 1, 1, 1 /)
1315  end if
1316  else
1317  write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
1318  call log('E',message)
1319  endif
1320 
1321  return
1322  end subroutine historyput2dassociatedcoordinatesdp
1323 
1324  !-----------------------------------------------------------------------------
1325  subroutine historyput3dassociatedcoordinatessp( &
1326  name, &
1327  desc, &
1328  units, &
1329  dims, &
1330  var, &
1331  datatype, &
1332  start )
1333  use gtool_file_h, only: &
1334  file_real4, &
1335  file_real8
1336  implicit none
1337 
1338  character(len=*), intent(in) :: name
1339  character(len=*), intent(in) :: desc
1340  character(len=*), intent(in) :: units
1341  character(len=*), intent(in) :: dims(:)
1342  real(SP), intent(in) :: var(:,:,:)
1343  character(len=*), intent(in), optional :: datatype
1344  integer, intent(in), optional :: start(:)
1345 
1346  integer :: dtype
1347  integer :: dim_size
1348  integer :: id
1349 
1350  intrinsic size, shape, reshape
1351  !---------------------------------------------------------------------------
1352 
1353  if ( present(datatype) ) then
1354  if ( datatype == 'REAL4' ) then
1355  dtype = file_real4
1356  elseif( datatype == 'REAL8' ) then
1357  dtype = file_real8
1358  else
1359  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
1360  call log('E',message)
1361  endif
1362  else
1363  dtype = file_real4
1364  endif
1365 
1366  dim_size = size(var)
1367 
1368  if ( history_assoc_count < history_assoc_limit ) then
1369  history_assoc_count = history_assoc_count + 1
1370  id = history_assoc_count
1371 
1372  allocate( history_assoc(id)%var(dim_size) )
1373 
1374  history_assoc(id)%name = name
1375  history_assoc(id)%desc = desc
1376  history_assoc(id)%units = units
1377  history_assoc(id)%ndims = 3
1378  history_assoc(id)%dims(:) = ''
1379  history_assoc(id)%dims(1:3) = dims(1:3)
1380  history_assoc(id)%dtype = dtype
1381  history_assoc(id)%var(:) = reshape( var, (/ dim_size /) )
1382 
1383  ! start and count are used for parallel I/O to a single shared file
1384  ! since var is reshaped into 1D array, we need to preserve its original shape in count
1385  history_assoc(id)%count(1:3) = shape(var)
1386  if ( present(start) ) then
1387  history_assoc(id)%start(1:3) = start(1:3)
1388  else
1389  history_assoc(id)%start = (/ 1, 1, 1, 1 /)
1390  end if
1391  else
1392  write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
1393  call log('E',message)
1394  endif
1395 
1396  return
1397  end subroutine historyput3dassociatedcoordinatessp
1398 
1399  !-----------------------------------------------------------------------------
1400  subroutine historyput3dassociatedcoordinatesdp( &
1401  name, &
1402  desc, &
1403  units, &
1404  dims, &
1405  var, &
1406  datatype, &
1407  start )
1408  use gtool_file_h, only: &
1409  file_real4, &
1410  file_real8
1411  implicit none
1412 
1413  character(len=*), intent(in) :: name
1414  character(len=*), intent(in) :: desc
1415  character(len=*), intent(in) :: units
1416  character(len=*), intent(in) :: dims(:)
1417  real(DP), intent(in) :: var(:,:,:)
1418  character(len=*), intent(in), optional :: datatype
1419  integer, intent(in), optional :: start(:)
1420 
1421  integer :: dtype
1422  integer :: dim_size
1423  integer :: id
1424 
1425  intrinsic size, shape, reshape
1426  !---------------------------------------------------------------------------
1427 
1428  if ( present(datatype) ) then
1429  if ( datatype == 'REAL4' ) then
1430  dtype = file_real4
1431  elseif( datatype == 'REAL8' ) then
1432  dtype = file_real8
1433  else
1434  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
1435  call log('E',message)
1436  endif
1437  else
1438  dtype = file_real8
1439  endif
1440 
1441  dim_size = size(var)
1442 
1443  if ( history_assoc_count < history_assoc_limit ) then
1444  history_assoc_count = history_assoc_count + 1
1445  id = history_assoc_count
1446 
1447  allocate( history_assoc(id)%var(dim_size) )
1448 
1449  history_assoc(id)%name = name
1450  history_assoc(id)%desc = desc
1451  history_assoc(id)%units = units
1452  history_assoc(id)%ndims = 3
1453  history_assoc(id)%dims(:) = ''
1454  history_assoc(id)%dims(1:3) = dims(1:3)
1455  history_assoc(id)%dtype = dtype
1456  history_assoc(id)%var(:) = reshape( var, (/ dim_size /) )
1457 
1458  ! start and count are used for parallel I/O to a single shared file
1459  ! since var is reshaped into 1D array, we need to preserve its original shape in count
1460  history_assoc(id)%count(1:3) = shape(var)
1461  if ( present(start) ) then
1462  history_assoc(id)%start(1:3) = start(1:3)
1463  else
1464  history_assoc(id)%start = (/ 1, 1, 1, 1 /)
1465  end if
1466  else
1467  write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
1468  call log('E',message)
1469  endif
1470 
1471  return
1472  end subroutine historyput3dassociatedcoordinatesdp
1473 
1474  !-----------------------------------------------------------------------------
1475  subroutine historyput4dassociatedcoordinatessp( &
1476  name, &
1477  desc, &
1478  units, &
1479  dims, &
1480  var, &
1481  datatype, &
1482  start )
1483  use gtool_file_h, only: &
1484  file_real4, &
1485  file_real8
1486  implicit none
1487 
1488  character(len=*), intent(in) :: name
1489  character(len=*), intent(in) :: desc
1490  character(len=*), intent(in) :: units
1491  character(len=*), intent(in) :: dims(:)
1492  real(SP), intent(in) :: var(:,:,:,:)
1493  character(len=*), intent(in), optional :: datatype
1494  integer, intent(in), optional :: start(:)
1495 
1496  integer :: dtype
1497  integer :: dim_size
1498  integer :: id
1499 
1500  intrinsic size, shape, reshape
1501  !---------------------------------------------------------------------------
1502 
1503  if ( present(datatype) ) then
1504  if ( datatype == 'REAL4' ) then
1505  dtype = file_real4
1506  elseif( datatype == 'REAL8' ) then
1507  dtype = file_real8
1508  else
1509  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
1510  call log('E',message)
1511  endif
1512  else
1513  dtype = file_real4
1514  endif
1515 
1516  dim_size = size(var)
1517 
1518  if ( history_assoc_count < history_assoc_limit ) then
1519  history_assoc_count = history_assoc_count + 1
1520  id = history_assoc_count
1521 
1522  allocate( history_assoc(id)%var(dim_size) )
1523 
1524  history_assoc(id)%name = name
1525  history_assoc(id)%desc = desc
1526  history_assoc(id)%units = units
1527  history_assoc(id)%ndims = 4
1528  history_assoc(id)%dims(:) = ''
1529  history_assoc(id)%dims(1:4) = dims(1:4)
1530  history_assoc(id)%dtype = dtype
1531  history_assoc(id)%var(:) = reshape( var, (/ dim_size /) )
1532 
1533  ! start and count are used for parallel I/O to a single shared file
1534  ! since var is reshaped into 1D array, we need to preserve its original shape in count
1535  history_assoc(id)%count(1:4) = shape(var)
1536  if ( present(start) ) then
1537  history_assoc(id)%start(1:4) = start(1:4)
1538  else
1539  history_assoc(id)%start = (/ 1, 1, 1, 1 /)
1540  end if
1541  else
1542  write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
1543  call log('E',message)
1544  endif
1545 
1546  return
1547  end subroutine historyput4dassociatedcoordinatessp
1548 
1549  !-----------------------------------------------------------------------------
1550  subroutine historyput4dassociatedcoordinatesdp( &
1551  name, &
1552  desc, &
1553  units, &
1554  dims, &
1555  var, &
1556  datatype, &
1557  start )
1558  use gtool_file_h, only: &
1559  file_real4, &
1560  file_real8
1561  implicit none
1562 
1563  character(len=*), intent(in) :: name
1564  character(len=*), intent(in) :: desc
1565  character(len=*), intent(in) :: units
1566  character(len=*), intent(in) :: dims(:)
1567  real(DP), intent(in) :: var(:,:,:,:)
1568  character(len=*), intent(in), optional :: datatype
1569  integer, intent(in), optional :: start(:)
1570 
1571  integer :: dtype
1572  integer :: dim_size
1573  integer :: id
1574 
1575  intrinsic size, shape, reshape
1576  !---------------------------------------------------------------------------
1577 
1578  if ( present(datatype) ) then
1579  if ( datatype == 'REAL4' ) then
1580  dtype = file_real4
1581  elseif( datatype == 'REAL8' ) then
1582  dtype = file_real8
1583  else
1584  write(message,*) 'xxx Not appropriate datatype. Check!', datatype
1585  call log('E',message)
1586  endif
1587  else
1588  dtype = file_real8
1589  endif
1590 
1591  dim_size = size(var)
1592 
1593  if ( history_assoc_count < history_assoc_limit ) then
1594  history_assoc_count = history_assoc_count + 1
1595  id = history_assoc_count
1596 
1597  allocate( history_assoc(id)%var(dim_size) )
1598 
1599  history_assoc(id)%name = name
1600  history_assoc(id)%desc = desc
1601  history_assoc(id)%units = units
1602  history_assoc(id)%ndims = 4
1603  history_assoc(id)%dims(:) = ''
1604  history_assoc(id)%dims(1:4) = dims(1:4)
1605  history_assoc(id)%dtype = dtype
1606  history_assoc(id)%var(:) = reshape( var, (/ dim_size /) )
1607 
1608  ! start and count are used for parallel I/O to a single shared file
1609  ! since var is reshaped into 1D array, we need to preserve its original shape in count
1610  history_assoc(id)%count(1:4) = shape(var)
1611  if ( present(start) ) then
1612  history_assoc(id)%start(1:4) = start(1:4)
1613  else
1614  history_assoc(id)%start = (/ 1, 1, 1, 1 /)
1615  end if
1616  else
1617  write(message,*) 'xxx Number of associate coordinates exceeds the limit.'
1618  call log('E',message)
1619  endif
1620 
1621  return
1622  end subroutine historyput4dassociatedcoordinatesdp
1623 
1624  !-----------------------------------------------------------------------------
1625  subroutine historysettattr( &
1626  varname, &
1627  key, &
1628  val )
1629  use gtool_file, only: &
1630  filesettattr
1631  implicit none
1632 
1633  character(len=*), intent(in) :: varname
1634  character(len=*), intent(in) :: key
1635  character(len=*), intent(in) :: val
1636 
1637  integer :: id
1638  !---------------------------------------------------------------------------
1639 
1640  do id = 1, history_id_count
1641  call filesettattr( history_vars(id)%fid, & ! [IN]
1642  varname, & ! [IN]
1643  key, & ! [IN]
1644  val ) ! [IN]
1645  enddo
1646 
1647  end subroutine historysettattr
1648 
1649  !-----------------------------------------------------------------------------
1650  subroutine historyquery( &
1651  item, &
1652  step_now, &
1653  answer )
1654  implicit none
1655 
1656  character(len=*), intent(in) :: item
1657  integer, intent(in) :: step_now
1658  logical, intent(out) :: answer
1659 
1660  integer :: id
1661  !---------------------------------------------------------------------------
1662 
1663  answer = .false.
1664 
1665  ! note: multiple put may be necessary for the item
1666  do id = 1, history_id_count
1667  if ( item == history_vars(id)%item ) then
1668  if ( history_vars(id)%taverage ) then
1669  answer = .true.
1670  elseif( step_now == history_vars(id)%laststep_write + history_vars(id)%dstep ) then
1671  answer = .true.
1672  endif
1673  endif
1674  enddo
1675 
1676  return
1677  end subroutine historyquery
1678 
1679  !-----------------------------------------------------------------------------
1680  subroutine historyput0didsp( &
1681  id, &
1682  step_now, &
1683  var )
1684  implicit none
1685 
1686  integer, intent(in) :: id
1687  integer, intent(in) :: step_now
1688  real(SP), intent(in) :: var
1689 
1690  real(DP) :: dt
1691  integer :: idx
1692 
1693  intrinsic shape
1694  !---------------------------------------------------------------------------
1695 
1696  if ( id < 0 ) return
1697 
1698  dt = ( step_now - history_vars(id)%laststep_put ) * history_dtsec
1699 
1700  if ( dt < eps .AND. ( .NOT. history_vars(id)%taverage ) ) then
1701  write(message,*) 'xxx History variable was put two times before output!: ', &
1702  trim(history_vars(id)%item), step_now, history_vars(id)%laststep_put
1703  call log('E',message)
1704  endif
1705 
1706  if ( history_vars(id)%taverage ) then
1707  idx = 1
1708  history_vars(id)%varsum(idx) = history_vars(id)%varsum(idx) + var * dt
1709 
1710  history_vars(id)%timesum = history_vars(id)%timesum + dt
1711  else
1712  idx = 1
1713  history_vars(id)%varsum(idx) = var
1714 
1715  history_vars(id)%timesum = 0.0_dp
1716  endif
1717 
1718  history_vars(id)%size = idx
1719  history_vars(id)%laststep_put = step_now
1720 
1721  return
1722  end subroutine historyput0didsp
1723 
1724  !-----------------------------------------------------------------------------
1725  subroutine historyput0diddp( &
1726  id, &
1727  step_now, &
1728  var )
1729  implicit none
1730 
1731  integer, intent(in) :: id
1732  integer, intent(in) :: step_now
1733  real(DP), intent(in) :: var
1734 
1735  real(DP) :: dt
1736  integer :: idx
1737 
1738  intrinsic shape
1739  !---------------------------------------------------------------------------
1740 
1741  if ( id < 0 ) return
1742 
1743  dt = ( step_now - history_vars(id)%laststep_put ) * history_dtsec
1744 
1745  if ( dt < eps .AND. ( .NOT. history_vars(id)%taverage ) ) then
1746  write(message,*) 'xxx History variable was put two times before output!: ', &
1747  trim(history_vars(id)%item), step_now, history_vars(id)%laststep_put
1748  call log('E',message)
1749  endif
1750 
1751  if ( history_vars(id)%taverage ) then
1752  idx = 1
1753  history_vars(id)%varsum(idx) = history_vars(id)%varsum(idx) + var * dt
1754 
1755  history_vars(id)%timesum = history_vars(id)%timesum + dt
1756  else
1757  idx = 1
1758  history_vars(id)%varsum(idx) = var
1759 
1760  history_vars(id)%timesum = 0.0_dp
1761  endif
1762 
1763  history_vars(id)%size = idx
1764  history_vars(id)%laststep_put = step_now
1765 
1766  return
1767  end subroutine historyput0diddp
1768 
1769  !-----------------------------------------------------------------------------
1770  subroutine historyput1didsp( &
1771  id, &
1772  step_now, &
1773  var )
1774  implicit none
1775 
1776  integer, intent(in) :: id
1777  integer, intent(in) :: step_now
1778  real(SP), intent(in) :: var(:)
1779 
1780  real(DP) :: dt
1781  integer :: idx
1782  integer :: vsize(1)
1783  integer :: i
1784 
1785  intrinsic shape
1786  !---------------------------------------------------------------------------
1787 
1788  if ( id < 0 ) return
1789 
1790  vsize = shape(var)
1791  dt = ( step_now - history_vars(id)%laststep_put ) * history_dtsec
1792 
1793  if ( dt < eps .AND. ( .NOT. history_vars(id)%taverage ) ) then
1794  write(message,*) 'xxx History variable was put two times before output!: ', &
1795  trim(history_vars(id)%item), step_now, history_vars(id)%laststep_put
1796  call log('E',message)
1797  endif
1798 
1799  if ( history_vars(id)%taverage ) then
1800  do i = 1, vsize(1)
1801  idx = i
1802  history_vars(id)%varsum(idx) = history_vars(id)%varsum(idx) + var(i) * dt
1803  enddo
1804 
1805  history_vars(id)%timesum = history_vars(id)%timesum + dt
1806  else
1807  do i = 1, vsize(1)
1808  idx = i
1809  history_vars(id)%varsum(idx) = var(i)
1810  enddo
1811 
1812  history_vars(id)%timesum = 0.0_dp
1813  endif
1814 
1815  history_vars(id)%size = idx
1816  history_vars(id)%laststep_put = step_now
1817 
1818  return
1819  end subroutine historyput1didsp
1820 
1821  !-----------------------------------------------------------------------------
1822  subroutine historyput1diddp( &
1823  id, &
1824  step_now, &
1825  var )
1826  implicit none
1827 
1828  integer, intent(in) :: id
1829  integer, intent(in) :: step_now
1830  real(DP), intent(in) :: var(:)
1831 
1832  real(DP) :: dt
1833  integer :: idx
1834  integer :: vsize(1)
1835  integer :: i
1836 
1837  intrinsic shape
1838  !---------------------------------------------------------------------------
1839 
1840  if ( id < 0 ) return
1841 
1842  vsize = shape(var)
1843  dt = ( step_now - history_vars(id)%laststep_put ) * history_dtsec
1844 
1845  if ( dt < eps .AND. ( .NOT. history_vars(id)%taverage ) ) then
1846  write(message,*) 'xxx History variable was put two times before output!: ', &
1847  trim(history_vars(id)%item), step_now, history_vars(id)%laststep_put
1848  call log('E',message)
1849  endif
1850 
1851  if ( history_vars(id)%taverage ) then
1852  do i = 1, vsize(1)
1853  idx = i
1854  history_vars(id)%varsum(idx) = history_vars(id)%varsum(idx) + var(i) * dt
1855  enddo
1856 
1857  history_vars(id)%timesum = history_vars(id)%timesum + dt
1858  else
1859  do i = 1, vsize(1)
1860  idx = i
1861  history_vars(id)%varsum(idx) = var(i)
1862  enddo
1863 
1864  history_vars(id)%timesum = 0.0_dp
1865  endif
1866 
1867  history_vars(id)%size = idx
1868  history_vars(id)%laststep_put = step_now
1869 
1870  return
1871  end subroutine historyput1diddp
1872 
1873  !-----------------------------------------------------------------------------
1874  subroutine historyput2didsp( &
1875  id, &
1876  step_now, &
1877  var )
1878  implicit none
1879 
1880  integer, intent(in) :: id
1881  integer, intent(in) :: step_now
1882  real(SP), intent(in) :: var(:,:)
1883 
1884  real(DP) :: dt
1885  integer :: idx
1886  integer :: vsize(2)
1887  integer :: i, j
1888 
1889  intrinsic shape
1890  !---------------------------------------------------------------------------
1891 
1892  if ( id < 0 ) return
1893 
1894  vsize = shape(var)
1895  dt = ( step_now - history_vars(id)%laststep_put ) * history_dtsec
1896 
1897  if ( dt < eps .AND. ( .NOT. history_vars(id)%taverage ) ) then
1898  write(message,*) 'xxx History variable was put two times before output!: ', &
1899  trim(history_vars(id)%item), step_now, history_vars(id)%laststep_put
1900  call log('E',message)
1901  endif
1902 
1903  if ( history_vars(id)%taverage ) then
1904  do j = 1, vsize(2)
1905  do i = 1, vsize(1)
1906  idx = (j-1)*vsize(1)+i
1907  history_vars(id)%varsum(idx) = history_vars(id)%varsum(idx) + var(i,j) * dt
1908  enddo
1909  enddo
1910 
1911  history_vars(id)%timesum = history_vars(id)%timesum + dt
1912  else
1913  do j = 1, vsize(2)
1914  do i = 1, vsize(1)
1915  idx = (j-1)*vsize(1)+i
1916  history_vars(id)%varsum(idx) = var(i,j)
1917  enddo
1918  enddo
1919 
1920  history_vars(id)%timesum = 0.0_dp
1921  endif
1922 
1923  history_vars(id)%size = idx
1924  history_vars(id)%laststep_put = step_now
1925 
1926  return
1927  end subroutine historyput2didsp
1928 
1929  !-----------------------------------------------------------------------------
1930  subroutine historyput2diddp( &
1931  id, &
1932  step_now, &
1933  var )
1934  implicit none
1935 
1936  integer, intent(in) :: id
1937  integer, intent(in) :: step_now
1938  real(DP), intent(in) :: var(:,:)
1939 
1940  real(DP) :: dt
1941  integer :: idx
1942  integer :: vsize(2)
1943  integer :: i, j
1944 
1945  intrinsic shape
1946  !---------------------------------------------------------------------------
1947 
1948  if ( id < 0 ) return
1949 
1950  vsize = shape(var)
1951  dt = ( step_now - history_vars(id)%laststep_put ) * history_dtsec
1952 
1953  if ( dt < eps .AND. ( .NOT. history_vars(id)%taverage ) ) then
1954  write(message,*) 'xxx History variable was put two times before output!: ', &
1955  trim(history_vars(id)%item), step_now, history_vars(id)%laststep_put
1956  call log('E',message)
1957  endif
1958 
1959  if ( history_vars(id)%taverage ) then
1960  do j = 1, vsize(2)
1961  do i = 1, vsize(1)
1962  idx = (j-1)*vsize(1)+i
1963  history_vars(id)%varsum(idx) = history_vars(id)%varsum(idx) + var(i,j) * dt
1964  enddo
1965  enddo
1966 
1967  history_vars(id)%timesum = history_vars(id)%timesum + dt
1968  else
1969  do j = 1, vsize(2)
1970  do i = 1, vsize(1)
1971  idx = (j-1)*vsize(1)+i
1972  history_vars(id)%varsum(idx) = var(i,j)
1973  enddo
1974  enddo
1975 
1976  history_vars(id)%timesum = 0.0_dp
1977  endif
1978 
1979  history_vars(id)%size = idx
1980  history_vars(id)%laststep_put = step_now
1981 
1982  return
1983  end subroutine historyput2diddp
1984 
1985  !-----------------------------------------------------------------------------
1986  subroutine historyput3didsp( &
1987  id, &
1988  step_now, &
1989  var )
1990  implicit none
1991 
1992  integer, intent(in) :: id
1993  integer, intent(in) :: step_now
1994  real(SP), intent(in) :: var(:,:,:)
1995 
1996  real(DP) :: dt
1997  integer :: idx
1998  integer :: vsize(3)
1999  integer :: i, j, k
2000 
2001  intrinsic shape
2002  !---------------------------------------------------------------------------
2003 
2004  if ( id < 0 ) return
2005 
2006  vsize = shape(var)
2007  dt = ( step_now - history_vars(id)%laststep_put ) * history_dtsec
2008 
2009  if ( dt < eps .AND. ( .NOT. history_vars(id)%taverage ) ) then
2010  write(message,*) 'xxx History variable was put two times before output!: ', &
2011  trim(history_vars(id)%item), step_now, history_vars(id)%laststep_put
2012  call log('E',message)
2013  endif
2014 
2015  if ( history_vars(id)%taverage ) then
2016  do k = 1, vsize(3)
2017  do j = 1, vsize(2)
2018  do i = 1, vsize(1)
2019  idx = ((k-1)*vsize(2)+(j-1))*vsize(1)+i
2020  history_vars(id)%varsum(idx) = history_vars(id)%varsum(idx) + var(i,j,k) * dt
2021  enddo
2022  enddo
2023  enddo
2024 
2025  history_vars(id)%timesum = history_vars(id)%timesum + dt
2026  else
2027  do k = 1, vsize(3)
2028  do j = 1, vsize(2)
2029  do i = 1, vsize(1)
2030  idx = ((k-1)*vsize(2)+(j-1))*vsize(1)+i
2031  history_vars(id)%varsum(idx) = var(i,j,k)
2032  enddo
2033  enddo
2034  enddo
2035 
2036  history_vars(id)%timesum = 0.0_dp
2037  endif
2038 
2039  history_vars(id)%size = idx
2040  history_vars(id)%laststep_put = step_now
2041 
2042  return
2043  end subroutine historyput3didsp
2044 
2045  !-----------------------------------------------------------------------------
2046  subroutine historyput3diddp( &
2047  id, &
2048  step_now, &
2049  var )
2050  implicit none
2051 
2052  integer, intent(in) :: id
2053  integer, intent(in) :: step_now
2054  real(DP), intent(in) :: var(:,:,:)
2055 
2056  real(DP) :: dt
2057  integer :: idx
2058  integer :: vsize(3)
2059  integer :: i, j, k
2060 
2061  intrinsic shape
2062  !---------------------------------------------------------------------------
2063 
2064  if ( id < 0 ) return
2065 
2066  vsize = shape(var)
2067  dt = ( step_now - history_vars(id)%laststep_put ) * history_dtsec
2068 
2069  if ( dt < eps .AND. ( .NOT. history_vars(id)%taverage ) ) then
2070  write(message,*) 'xxx History variable was put two times before output!: ', &
2071  trim(history_vars(id)%item), step_now, history_vars(id)%laststep_put
2072  call log('E',message)
2073  endif
2074 
2075  if ( history_vars(id)%taverage ) then
2076  do k = 1, vsize(3)
2077  do j = 1, vsize(2)
2078  do i = 1, vsize(1)
2079  idx = ((k-1)*vsize(2)+(j-1))*vsize(1)+i
2080  history_vars(id)%varsum(idx) = history_vars(id)%varsum(idx) + var(i,j,k) * dt
2081  enddo
2082  enddo
2083  enddo
2084 
2085  history_vars(id)%timesum = history_vars(id)%timesum + dt
2086  else
2087  do k = 1, vsize(3)
2088  do j = 1, vsize(2)
2089  do i = 1, vsize(1)
2090  idx = ((k-1)*vsize(2)+(j-1))*vsize(1)+i
2091  history_vars(id)%varsum(idx) = var(i,j,k)
2092  enddo
2093  enddo
2094  enddo
2095 
2096  history_vars(id)%timesum = 0.0_dp
2097  endif
2098 
2099  history_vars(id)%size = idx
2100  history_vars(id)%laststep_put = step_now
2101 
2102  return
2103  end subroutine historyput3diddp
2104 
2105  !-----------------------------------------------------------------------------
2106  subroutine historywriteall( &
2107  step_now )
2108  use gtool_file, only: &
2109  fileflush
2110  implicit none
2111  integer, intent(in) :: step_now
2112 
2113  integer :: id
2114  integer :: fid, prev_fid
2115  !---------------------------------------------------------------------------
2116 
2117  ! Note this subroutine must be called after all HIST_reg calls are completed
2118  ! Write registered history axes to history file
2119  call historywriteaxes
2120 
2121  ! Write registered history variables to history file
2122  do id = 1, history_id_count
2123  call historywrite( id, & ! [IN]
2124  step_now ) ! [IN]
2125  enddo
2126 
2127  prev_fid = -1
2128  do id = 1, history_id_count
2129  fid = history_vars(id)%fid
2130  if ( fid .NE. prev_fid ) then
2131  ! when using PnetCDF, the above HistoryWrite() only posts write requests
2132  ! Now we need to commit the requests to the file
2133  call fileflush( fid )
2134  prev_fid = fid
2135  end if
2136  end do
2137 
2138  return
2139  end subroutine historywriteall
2140 
2141  !-----------------------------------------------------------------------------
2142  subroutine historywriteaxes
2143  use gtool_file, only: &
2144  fileenddef, &
2145  fileflush, &
2146  filewriteaxis, &
2147  filewriteassociatedcoordinates
2148  implicit none
2149 
2150  integer :: m, id, fid
2151  integer :: start(1)
2152  !---------------------------------------------------------------------------
2153 
2154  if( history_req_count == 0 ) return
2155  if( history_axis_count == 0 ) return
2156 
2157  do id = 1, history_id_count
2158 
2159  fid = history_vars(id)%fid
2160 
2161  if ( history_axis_written(fid) ) cycle
2162 
2163  call fileenddef( fid )
2164 
2165  ! write registered history variables to file
2166  do m = 1, history_axis_count
2167  if ( history_axis(m)%start(1) > 0 ) then
2168  start(1) = history_axis(m)%start(1)
2169  call filewriteaxis( fid, & ! [IN]
2170  history_axis(m)%name, & ! [IN]
2171  history_axis(m)%var, & ! [IN]
2172  start ) ! [IN]
2173  end if
2174  enddo
2175 
2176  do m = 1, history_assoc_count
2177  call filewriteassociatedcoordinates( fid, & ! [IN]
2178  history_assoc(m)%name, & ! [IN]
2179  history_assoc(m)%var, & ! [IN]
2180  history_assoc(m)%start, & ! [IN]
2181  history_assoc(m)%count, & ! [IN]
2182  history_assoc(m)%ndims ) ! [IN]
2183  enddo
2184 
2185  ! for PnetCDF I/O, flush all pending nonblocking write requests
2186  call fileflush( fid )
2187 
2188  ! mark the axes have been written
2189  history_axis_written( fid ) = .true.
2190 
2191  end do
2192 
2193  return
2194  end subroutine historywriteaxes
2195 
2196  !-----------------------------------------------------------------------------
2197  subroutine historywrite( &
2198  id, &
2199  step_now )
2200  use dc_calendar, only: &
2201  calendarsec2ymdhms
2202  use gtool_file, only: &
2203  filewrite
2204  implicit none
2205 
2206  integer, intent(in) :: id
2207  integer, intent(in) :: step_now
2208 
2209  integer :: isize
2210  real(DP) :: time_str, time_end
2211  real(DP) :: sec_str, sec_end
2212  !---------------------------------------------------------------------------
2213 
2214  if( history_req_count == 0 ) return
2215 
2216  if ( step_now < history_vars(id)%laststep_write + history_vars(id)%dstep ) then
2217  return
2218  endif
2219 
2220  if ( history_vars(id)%laststep_put == history_vars(id)%laststep_write ) then
2221  write(message,*) 'xxx History variable was never put after the last output!: ', &
2222  trim(history_vars(id)%item)
2223  if ( history_error_putmiss ) then
2224  call log('E',message)
2225  else
2226  call log('I',message)
2227  endif
2228  endif
2229 
2230  isize = history_vars(id)%size
2231 
2232  if ( history_vars(id)%taverage ) then
2233  history_vars(id)%varsum(1:isize) = history_vars(id)%varsum(1:isize) / history_vars(id)%timesum
2234  endif
2235 
2236  if ( firsttime ) then
2237  firsttime = .false.
2238  call historyoutputlist
2239  endif
2240 
2241  sec_str = history_startdaysec + real(History_vars(id)%laststep_write-1,kind=DP) * history_dtsec
2242  sec_end = history_startdaysec + real(step_now -1,kind=DP) * history_dtsec
2243 
2244  if ( sec_end >= history_startdaysec + history_vars(id)%waitsec ) then
2245  if ( laststep_write < step_now ) then ! log only once in this step
2246  write(message,'(A)') '*** Output History'
2247  call log('I',message)
2248  endif
2249 
2250  ! convert time units [sec]->[sec,min,hour,day,month,year]
2251  call calendarsec2ymdhms( time_str, sec_str, history_time_units )
2252  call calendarsec2ymdhms( time_end, sec_end, history_time_units )
2253 
2254  if ( history_vars(id)%count(1) .GT. 0 ) then
2255 
2256  ! for one-file-per-process I/O method, History_vars(:)%count(1) == 1 always
2257  ! for one file shared by all processes, History_vars(:)%count(1) >= 0,
2258  ! being 0 indicates a 1D history variable, which will only be written by the
2259  ! south-most processes in parallel, or a z axis to be written by rank 0 only
2260  call filewrite( history_vars(id)%fid, & ! [IN]
2261  history_vars(id)%vid, & ! [IN]
2262  history_vars(id)%varsum(1:isize), & ! [IN]
2263  time_str, & ! [IN]
2264  time_end, & ! [IN]
2265  history_vars(id)%start, & ! global subarray start indices
2266  history_vars(id)%count, & ! global subarray lengths
2267  history_vars(id)%ndims ) ! ndims before reshape
2268  end if
2269  else
2270  if ( laststep_write < step_now ) then
2271  write(message,'(A)') '*** Output History: Suppressed.'
2272  call log('I',message)
2273  endif
2274  endif
2275 
2276  history_vars(id)%laststep_write = step_now
2277  history_vars(id)%laststep_put = step_now
2278  history_vars(id)%timesum = 0.0_dp
2279  history_vars(id)%varsum(:) = 0.0_dp
2280 
2281  laststep_write = step_now ! remember for multiple call in the same step
2282 
2283  return
2284  end subroutine historywrite
2285 
2286  ! interface HistoryGet
2287  !-----------------------------------------------------------------------------
2288  subroutine historyget1ddp( &
2289  var, &
2290  basename, &
2291  varname, &
2292  step, &
2293  allow_missing, &
2294  single )
2295  use gtool_file, only: &
2296  fileread
2297  implicit none
2298 
2299  real(DP), intent(out) :: var(:)
2300  character(len=*), intent(in) :: basename
2301  character(len=*), intent(in) :: varname
2302  integer, intent(in) :: step
2303  logical, intent(in), optional :: allow_missing
2304  logical, intent(in), optional :: single
2305 
2306  logical :: allow_missing_
2307  logical :: single_
2308  !---------------------------------------------------------------------------
2309 
2310  allow_missing_ = .false.
2311  single_ = .false.
2312 
2313  if ( present(allow_missing) ) then
2314  allow_missing_ = allow_missing
2315  endif
2316 
2317  if ( present(single) ) then
2318  single_ = single
2319  endif
2320 
2321  call fileread( var, & ! [OUT]
2322  basename, & ! [IN]
2323  varname, & ! [IN]
2324  step, & ! [IN]
2325  history_myrank, & ! [IN]
2326  allow_missing_, & ! [IN]
2327  single_ ) ! [IN]
2328 
2329  return
2330  end subroutine historyget1ddp
2331 
2332  !-----------------------------------------------------------------------------
2333  subroutine historyget1dsp( &
2334  var, &
2335  basename, &
2336  varname, &
2337  step, &
2338  allow_missing, &
2339  single )
2340  use gtool_file, only: &
2341  fileread
2342  implicit none
2343 
2344  real(SP), intent(out) :: var(:)
2345  character(len=*), intent(in) :: basename
2346  character(len=*), intent(in) :: varname
2347  integer, intent(in) :: step
2348  logical, intent(in), optional :: allow_missing
2349  logical, intent(in), optional :: single
2350 
2351  logical :: allow_missing_
2352  logical :: single_
2353  !---------------------------------------------------------------------------
2354 
2355  allow_missing_ = .false.
2356  single_ = .false.
2357 
2358  if ( present(allow_missing) ) then
2359  allow_missing_ = allow_missing
2360  endif
2361 
2362  if ( present(single) ) then
2363  single_ = single
2364  endif
2365 
2366  call fileread( var, & ! [OUT]
2367  basename, & ! [IN]
2368  varname, & ! [IN]
2369  step, & ! [IN]
2370  history_myrank, & ! [IN]
2371  allow_missing_, & ! [IN]
2372  single_ ) ! [IN]
2373 
2374  return
2375  end subroutine historyget1dsp
2376 
2377  !-----------------------------------------------------------------------------
2378  subroutine historyget2ddp( &
2379  var, &
2380  basename, &
2381  varname, &
2382  step, &
2383  allow_missing, &
2384  single )
2385  use gtool_file, only: &
2386  fileread
2387  implicit none
2388 
2389  real(DP), intent(out) :: var(:,:)
2390  character(len=*), intent(in) :: basename
2391  character(len=*), intent(in) :: varname
2392  integer, intent(in) :: step
2393  logical, intent(in), optional :: allow_missing
2394  logical, intent(in), optional :: single
2395 
2396  logical :: allow_missing_
2397  logical :: single_
2398  !---------------------------------------------------------------------------
2399 
2400  allow_missing_ = .false.
2401  single_ = .false.
2402 
2403  if ( present(allow_missing) ) then
2404  allow_missing_ = allow_missing
2405  endif
2406 
2407  if ( present(single) ) then
2408  single_ = single
2409  endif
2410 
2411  call fileread( var, & ! [OUT]
2412  basename, & ! [IN]
2413  varname, & ! [IN]
2414  step, & ! [IN]
2415  history_myrank, & ! [IN]
2416  allow_missing_, & ! [IN]
2417  single_ ) ! [IN]
2418 
2419  return
2420  end subroutine historyget2ddp
2421 
2422  !-----------------------------------------------------------------------------
2423  subroutine historyget2dsp( &
2424  var, &
2425  basename, &
2426  varname, &
2427  step, &
2428  allow_missing, &
2429  single )
2430  use gtool_file, only: &
2431  fileread
2432  implicit none
2433 
2434  real(SP), intent(out) :: var(:,:)
2435  character(len=*), intent(in) :: basename
2436  character(len=*), intent(in) :: varname
2437  integer, intent(in) :: step
2438  logical, intent(in), optional :: allow_missing
2439  logical, intent(in), optional :: single
2440 
2441  logical :: allow_missing_
2442  logical :: single_
2443  !---------------------------------------------------------------------------
2444 
2445  allow_missing_ = .false.
2446  single_ = .false.
2447 
2448  if ( present(allow_missing) ) then
2449  allow_missing_ = allow_missing
2450  endif
2451 
2452  if ( present(single) ) then
2453  single_ = single
2454  endif
2455 
2456  call fileread( var, & ! [OUT]
2457  basename, & ! [IN]
2458  varname, & ! [IN]
2459  step, & ! [IN]
2460  history_myrank, & ! [IN]
2461  allow_missing_, & ! [IN]
2462  single_ ) ! [IN]
2463 
2464  return
2465  end subroutine historyget2dsp
2466 
2467  !-----------------------------------------------------------------------------
2468  subroutine historyget3ddp( &
2469  var, &
2470  basename, &
2471  varname, &
2472  step, &
2473  allow_missing, &
2474  single )
2475  use gtool_file, only: &
2476  fileread
2477  implicit none
2478 
2479  real(DP), intent(out) :: var(:,:,:)
2480  character(len=*), intent(in) :: basename
2481  character(len=*), intent(in) :: varname
2482  integer, intent(in) :: step
2483  logical, intent(in), optional :: allow_missing
2484  logical, intent(in), optional :: single
2485 
2486  logical :: allow_missing_
2487  logical :: single_
2488  !---------------------------------------------------------------------------
2489 
2490  allow_missing_ = .false.
2491  single_ = .false.
2492 
2493  if ( present(allow_missing) ) then
2494  allow_missing_ = allow_missing
2495  endif
2496 
2497  if ( present(single) ) then
2498  single_ = single
2499  endif
2500 
2501  call fileread( var, & ! [OUT]
2502  basename, & ! [IN]
2503  varname, & ! [IN]
2504  step, & ! [IN]
2505  history_myrank, & ! [IN]
2506  allow_missing_, & ! [IN]
2507  single_ ) ! [IN]
2508 
2509  return
2510  end subroutine historyget3ddp
2511 
2512  !-----------------------------------------------------------------------------
2513  subroutine historyget3dsp( &
2514  var, &
2515  basename, &
2516  varname, &
2517  step, &
2518  allow_missing, &
2519  single )
2520  use gtool_file, only: &
2521  fileread
2522  implicit none
2523 
2524  real(SP), intent(out) :: var(:,:,:)
2525  character(len=*), intent(in) :: basename
2526  character(len=*), intent(in) :: varname
2527  integer, intent(in) :: step
2528  logical, intent(in), optional :: allow_missing
2529  logical, intent(in), optional :: single
2530 
2531  logical :: allow_missing_
2532  logical :: single_
2533  !---------------------------------------------------------------------------
2534 
2535  allow_missing_ = .false.
2536  single_ = .false.
2537 
2538  if ( present(allow_missing) ) then
2539  allow_missing_ = allow_missing
2540  endif
2541 
2542  if ( present(single) ) then
2543  single_ = single
2544  endif
2545 
2546  call fileread( var, & ! [OUT]
2547  basename, & ! [IN]
2548  varname, & ! [IN]
2549  step, & ! [IN]
2550  history_myrank, & ! [IN]
2551  allow_missing_, & ! [IN]
2552  single_ ) ! [IN]
2553 
2554  return
2555  end subroutine historyget3dsp
2556 
2557  !-----------------------------------------------------------------------------
2558  subroutine historyoutputlist
2559  implicit none
2560 
2561  real(DP) :: dtsec
2562  integer :: id
2563  !---------------------------------------------------------------------------
2564 
2565  call log('I','')
2566  write(message,'(A)') '*** [HIST] Output item list '
2567  call log('I',message)
2568  write(message,'(A,I4)') '*** Number of history item :', history_req_count
2569  call log('I',message)
2570  write(message,'(2A)') 'ITEM :OUTNAME ', &
2571  ': size:interval[sec]: step:timeavg?:zcoord'
2572  call log('I',message)
2573  write(message,'(2A)') '=================================================', &
2574  '================================================'
2575  call log('I',message)
2576 
2577  do id = 1, history_id_count
2578  dtsec = real(History_vars(id)%dstep,kind=DP) * history_dtsec
2579 
2580  write(message,'(A24,1x,A24,1x,I8,1x,F13.3,1x,I8,1x,L8,1x,A6)') history_vars(id)%item, &
2581  history_vars(id)%outname, &
2582  history_vars(id)%size, &
2583  dtsec, &
2584  history_vars(id)%dstep, &
2585  history_vars(id)%taverage, &
2586  history_vars(id)%zcoord
2587  call log('I',message)
2588  enddo
2589 
2590  write(message,'(2A)') '=================================================', &
2591  '================================================'
2592  call log('I',message)
2593  call log('I','')
2594 
2595  return
2596  end subroutine historyoutputlist
2597 
2598  !-----------------------------------------------------------------------------
2599  subroutine historyfinalize
2600  use gtool_file, only: &
2601  filedetachbuffer, &
2602  fileclose
2603  implicit none
2604 
2605  integer :: id
2606  integer :: fid, prev_fid
2607  !---------------------------------------------------------------------------
2608 
2609  prev_fid = -1
2610  do id = 1, history_id_count
2611  fid = history_vars(id)%fid
2612  if ( fid .NE. prev_fid ) then
2613  ! Release the internal buffer previously allowed to be used by PnetCDF
2614  call filedetachbuffer( fid )
2615  call fileclose( fid )
2616  prev_fid = fid
2617  end if
2618  enddo
2619 
2620  return
2621  end subroutine historyfinalize
2622 
2623 end module gtool_history
2624 
2625 
2626 
2627 !--
2628 ! vi:set readonly sw=4 ts=8
2629 !
2630 !Local Variables:
2631 !mode: f90
2632 !buffer-read-only:t
2633 !End:
2634 !
2635 !++
gtool_file
module GTOOL_FILE
Definition: gtool_file.f90:17
gtool_history::historyput2dassociatedcoordinatessp
subroutine historyput2dassociatedcoordinatessp(name, desc, units, dims, var, datatype, start)
Definition: gtool_history.f90:1183
gtool_history::historyget3ddp
subroutine historyget3ddp(var, basename, varname, step, allow_missing, single)
Definition: gtool_history.f90:2475
dc_calendar
module TIME
Definition: dc_calendar.f90:17
dc_log::log_fid
integer, public log_fid
Definition: dc_log.f90:49
gtool_history::historyput3dassociatedcoordinatesdp
subroutine historyput3dassociatedcoordinatesdp(name, desc, units, dims, var, datatype, start)
Definition: gtool_history.f90:1408
dc_log
module DC_Log
Definition: dc_log.f90:14
gtool_history::historyaddvariable
subroutine, public historyaddvariable(nregist, item, dims, desc, units, now_step, zcoord, options, start, count, comm)
Definition: gtool_history.f90:615
gtool_history::historycheck
subroutine, public historycheck(existed, item, zcoord)
Definition: gtool_history.f90:564
gtool_file_h::file_hlong
integer, parameter, public file_hlong
Definition: gtool_file_h.f90:40
dc_log::log_lmsg
integer, parameter, public log_lmsg
Definition: dc_log.f90:48
gtool_file::fileenddef
subroutine, public fileenddef(fid)
Definition: gtool_file.f90:3761
gtool_file::fileattachbuffer
subroutine, public fileattachbuffer(fid, buf_amount)
Definition: gtool_file.f90:3802
gtool_file_h::file_hmid
integer, parameter, public file_hmid
Definition: gtool_file_h.f90:39
dc_log::log_nml
subroutine, public log_nml(type, message)
Definition: dc_log.f90:203
gtool_history::historyget3dsp
subroutine historyget3dsp(var, basename, varname, step, allow_missing, single)
Definition: gtool_history.f90:2520
gtool_history::historywriteaxes
subroutine, public historywriteaxes
Definition: gtool_history.f90:2143
gtool_history
module Gtool_History
Definition: gtool_history.dox:150
gtool_history::historyput3dassociatedcoordinatessp
subroutine historyput3dassociatedcoordinatessp(name, desc, units, dims, var, datatype, start)
Definition: gtool_history.f90:1333
gtool_history::historyget1dsp
subroutine historyget1dsp(var, basename, varname, step, allow_missing, single)
Definition: gtool_history.f90:2340
gtool_history::historyget1ddp
subroutine historyget1ddp(var, basename, varname, step, allow_missing, single)
Definition: gtool_history.f90:2295
dc_log::log_fid_nml
integer, public log_fid_nml
Definition: dc_log.f90:50
gtool_file::fileclose
subroutine, public fileclose(fid)
Definition: gtool_file.f90:3925
gtool_file::filedefassociatedcoordinates
subroutine, public filedefassociatedcoordinates(fid, name, desc, units, dim_names, dtype)
Definition: gtool_file.f90:903
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:1501
gtool_file::filesetoption
subroutine, public filesetoption(fid, filetype, key, val)
Definition: gtool_file.f90:470
gtool_history::historyfinalize
subroutine, public historyfinalize
Definition: gtool_history.f90:2600
gtool_history::historyputaxisdp
subroutine historyputaxisdp(name, desc, units, dim, var, datatype, down, gsize, start)
Definition: gtool_history.f90:953
dc_log::log
subroutine, public log(type, message)
Definition: dc_log.f90:165
gtool_history::historyget2ddp
subroutine historyget2ddp(var, basename, varname, step, allow_missing, single)
Definition: gtool_history.f90:2385
gtool_file_h::file_preclist
integer, dimension(0:3), parameter, public file_preclist
Definition: gtool_file_h.f90:78
gtool_history::historyput2dassociatedcoordinatesdp
subroutine historyput2dassociatedcoordinatesdp(name, desc, units, dims, var, datatype, start)
Definition: gtool_history.f90:1258
dc_types
Definition: dc_types.f90:12
gtool_history::historyput4dassociatedcoordinatesdp
subroutine historyput4dassociatedcoordinatesdp(name, desc, units, dims, var, datatype, start)
Definition: gtool_history.f90:1558
gtool_history::historyput1dassociatedcoordinatessp
subroutine historyput1dassociatedcoordinatessp(name, desc, units, dims, var, datatype, start)
Definition: gtool_history.f90:1033
gtool_history::historyoutputlist
subroutine, public historyoutputlist
Definition: gtool_history.f90:2559
gtool_history::historywrite
subroutine, public historywrite(id, step_now)
Definition: gtool_history.f90:2200
dc_types::sp
integer, parameter, public sp
Definition: dc_types.f90:30
gtool_history::historyputaxissp
subroutine historyputaxissp(name, desc, units, dim, var, datatype, down, gsize, start)
Definition: gtool_history.f90:871
gtool_history::historyput1dassociatedcoordinatesdp
subroutine historyput1dassociatedcoordinatesdp(name, desc, units, dims, var, datatype, start)
Definition: gtool_history.f90:1108
gtool_file::filedetachbuffer
subroutine, public filedetachbuffer(fid)
Definition: gtool_file.f90:3842
gtool_history::historyput4dassociatedcoordinatessp
subroutine historyput4dassociatedcoordinatessp(name, desc, units, dims, var, datatype, start)
Definition: gtool_history.f90:1483
gtool_history::historywriteall
subroutine, public historywriteall(step_now)
Definition: gtool_history.f90:2108
gtool_file_h::file_real4
integer, parameter, public file_real4
Definition: gtool_file_h.f90:43
gtool_file::fileflush
subroutine, public fileflush(fid)
Definition: gtool_file.f90:3883
gtool_file::filecreate
subroutine, public filecreate(fid, existed, basename, title, source, institution, master, myrank, rankidx, single, time_units, append, comm)
Definition: gtool_file.f90:191
gtool_file_h
module FILE I/O HEADER
Definition: gtool_file_h.f90:14
gtool_file_h::file_hshort
integer, parameter, public file_hshort
Definition: gtool_file_h.f90:38
gtool_history::historyquery
subroutine, public historyquery(item, step_now, answer)
Definition: gtool_history.f90:1654
gtool_history::historyinit
subroutine, public historyinit(item_count, variant_count, isize, jsize, ksize, master, myrank, rankidx, title, source, institution, time_start, time_interval, time_units, time_since, default_basename, default_zcoord, default_tinterval, default_tunit, default_taverage, default_datatype, namelist_filename, namelist_fid)
Definition: gtool_history.f90:237
gtool_history::historyget2dsp
subroutine historyget2dsp(var, basename, varname, step, allow_missing, single)
Definition: gtool_history.f90:2430
gtool_file_h::file_real8
integer, parameter, public file_real8
Definition: gtool_file_h.f90:44
gtool_history::historysettattr
subroutine, public historysettattr(varname, key, val)
Definition: gtool_history.f90:1629
gtool_file::filedefaxis
subroutine, public filedefaxis(fid, name, desc, units, dim_name, dtype, dim_size)
Definition: gtool_file.f90:584
Generated by   doxygen 1.8.14