SCALE-RM
Data Types | Functions/Subroutines | Variables
scale_file_history Module Reference

module file_history More...

Functions/Subroutines

subroutine, public file_history_setup (title, source, institution, time_start, time_interval, time_units, time_since, calendar, default_basename, default_postfix_timelabel, default_zcoord, default_tinterval, default_tunit, default_taverage, default_datatype, myrank)
 Setup. More...
 
subroutine, public file_history_reg (name, desc, unit, itemid, standard_name, ndims, dim_type, cell_measures, fill_halo)
 Register/Append variable to history file. More...
 
subroutine file_history_in_0d (var, name, desc, unit, standard_name, dim_type)
 Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put. More...
 
subroutine file_history_in_1d (var, name, desc, unit, standard_name, dim_type)
 Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put. More...
 
subroutine file_history_in_2d (var, name, desc, unit, standard_name, dim_type, fill_halo)
 Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put. More...
 
subroutine file_history_in_3d (var, name, desc, unit, standard_name, dim_type, fill_halo)
 Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put. More...
 
subroutine file_history_in_4d (var, name, desc, unit, standard_name, dim_type, fill_halo)
 Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put. More...
 
subroutine, public file_history_set_dim (name, ndims, nzcoords, dims, zcoords, start, count, mapping, area, area_x, area_y, volume, location, grid)
 set dimension information More...
 
subroutine, public file_history_set_axis (name, desc, units, dim, var, bounds, down, gsize, start)
 set axis information More...
 
subroutine, public file_history_write
 
subroutine, public file_history_set_nowdate (NOWDATE, NOWSUBSEC, NOWSTEP)
 set now step More...
 
subroutine, public file_history_set_disable (switch)
 set switch to turn on/off history More...
 
subroutine, public file_history_finalize
 finalization More...
 
subroutine file_history_set_associatedcoordinate_1d (name, desc, units, dims, var, datatype, start)
 
subroutine file_history_set_associatedcoordinate_2d (name, desc, units, dims, var, datatype, start)
 
subroutine file_history_set_associatedcoordinate_3d (name, desc, units, dims, var, datatype, start)
 
subroutine file_history_set_attribute_text (varname, key, val, add_variable)
 
subroutine file_history_set_attribute_logical (varname, key, val, add_variable)
 
subroutine file_history_set_attribute_int_ary (varname, key, val, add_variable)
 
subroutine file_history_set_attribute_int (varname, key, val, add_variable)
 
subroutine file_history_set_attribute_float (varname, key, val, add_variable)
 
subroutine file_history_set_attribute_double (varname, key, val, add_variable)
 

Variables

procedure(truncate_1d), pointer, public file_history_truncate_1d => NULL()
 
procedure(truncate_2d), pointer, public file_history_truncate_2d => NULL()
 
procedure(truncate_3d), pointer, public file_history_truncate_3d => NULL()
 
procedure(truncate_4d), pointer, public file_history_truncate_4d => NULL()
 
logical, public file_history_aggregate
 
logical, public switch
 
logical, public to
 
logical, public use
 
logical, public aggregate
 
logical, public file
 
logical, public i
 
logical, public o
 

Detailed Description

module file_history

Description
I/O handling for history output
Author
Team SCALE
NAMELIST
  • PARAM_FILE_HISTORY
    nametypedefault valuecomment
    FILE_HISTORY_TITLE character(len=H_MID) > Header information of the output file: title
    FILE_HISTORY_SOURCE character(len=H_MID) > Header information of the output file: model name
    FILE_HISTORY_INSTITUTION character(len=H_MID) > Header information of the output file: institution
    FILE_HISTORY_TIME_UNITS character(len=H_MID) > Unit for time axis
    FILE_HISTORY_DEFAULT_BASENAME character(len=H_LONG) > Base name of the file
    FILE_HISTORY_DEFAULT_POSTFIX_TIMELABEL logical > Add timelabel to the basename?
    FILE_HISTORY_DEFAULT_ZCOORD character(len=H_SHORT) > Default z-coordinate
    FILE_HISTORY_DEFAULT_TINTERVAL real(DP) > Time interval
    FILE_HISTORY_DEFAULT_TUNIT character(len=H_SHORT) > Time unit
    FILE_HISTORY_DEFAULT_TAVERAGE logical > Apply time average?
    FILE_HISTORY_DEFAULT_DATATYPE character(len=H_SHORT) > Data type
    FILE_HISTORY_OUTPUT_STEP0 logical .false. > Output value at step=0?
    FILE_HISTORY_OUTPUT_WAIT real(DP) > Time length to suppress output
    FILE_HISTORY_OUTPUT_WAIT_TUNIT character(len=H_SHORT) > Time unit
    FILE_HISTORY_OUTPUT_SWITCH_TINTERVAL real(DP) > Time interval to switch output file
    FILE_HISTORY_OUTPUT_SWITCH_TUNIT character(len=H_SHORT) > Time unit
    FILE_HISTORY_ERROR_PUTMISS logical .true. > Abort if the value is never stored after last output?
    FILE_HISTORY_AGGREGATE logical > Switch to use aggregate file I/O
    FILE_HISTORY_OPTIONS character(len=H_MID) '' !> option to give file. 'filetype1:key1=val1&filetype2:key2=val2&...'
    DEBUG logical .false.

  • HISTORY_ITEM
    nametypedefault valuecomment
    NAME character(len=*)
    OUTNAME character(len=H_SHORT) > name of variable (for output)
    BASENAME character(len=H_LONG) > base name of the file
    POSTFIX_TIMELABEL logical > Add timelabel to the basename?
    ZCOORD character(len=*)
    TINTERVAL real(DP) > time interval
    TUNIT character(len=H_SHORT) > time unit
    TAVERAGE logical > apply time average?
    DATATYPE character(len=*)

History Output
No history output

Function/Subroutine Documentation

◆ file_history_setup()

subroutine, public scale_file_history::file_history_setup ( character(len=*), intent(in)  title,
character(len=*), intent(in)  source,
character(len=*), intent(in)  institution,
real(dp), intent(in)  time_start,
real(dp), intent(in)  time_interval,
character(len=*), intent(in), optional  time_units,
character(len=*), intent(in), optional  time_since,
character(len=*), intent(in), optional  calendar,
character(len=*), intent(in), optional  default_basename,
logical, intent(in), optional  default_postfix_timelabel,
character(len=*), intent(in), optional  default_zcoord,
real(dp), intent(in), optional  default_tinterval,
character(len=*), intent(in), optional  default_tunit,
logical, intent(in), optional  default_taverage,
character(len=*), intent(in), optional  default_datatype,
integer, intent(in), optional  myrank 
)

Setup.

REAL4 : single precision REAL8 : double precision

Unit for time axis

Base name of the file

Add timelabel to the basename?

Default z-coordinate

Time interval

Time unit

Apply time average?

Data type

Time length to suppress output

Time unit

Time interval to switch output file

Time unit

Definition at line 342 of file scale_file_history.F90.

342  use scale_file_h, only: &
343  file_real4, &
344  file_real8
345  use scale_file, only: &
346  file_aggregate
347  use scale_calendar, only: &
349  implicit none
350 
351  character(len=*), intent(in) :: title
352  character(len=*), intent(in) :: source
353  character(len=*), intent(in) :: institution
354  real(DP), intent(in) :: time_start
355  real(DP), intent(in) :: time_interval
356 
357  character(len=*), intent(in), optional :: time_units
358  character(len=*), intent(in), optional :: time_since
359  character(len=*), intent(in), optional :: calendar
360  character(len=*), intent(in), optional :: default_basename
361  logical, intent(in), optional :: default_postfix_timelabel
362  character(len=*), intent(in), optional :: default_zcoord
363  real(DP), intent(in), optional :: default_tinterval
364  character(len=*), intent(in), optional :: default_tunit
365  logical, intent(in), optional :: default_taverage
366  character(len=*), intent(in), optional :: default_datatype
367  integer, intent(in), optional :: myrank
368 
369  character(len=H_LONG) :: FILE_HISTORY_DEFAULT_BASENAME
370  logical :: FILE_HISTORY_DEFAULT_POSTFIX_TIMELABEL
371  character(len=H_SHORT) :: FILE_HISTORY_DEFAULT_ZCOORD
372  real(DP) :: FILE_HISTORY_DEFAULT_TINTERVAL
373  character(len=H_SHORT) :: FILE_HISTORY_DEFAULT_TUNIT
374  logical :: FILE_HISTORY_DEFAULT_TAVERAGE
375  character(len=H_SHORT) :: FILE_HISTORY_DEFAULT_DATATYPE
378  real(DP) :: FILE_HISTORY_OUTPUT_WAIT
379  character(len=H_SHORT) :: FILE_HISTORY_OUTPUT_WAIT_TUNIT
380  real(DP) :: FILE_HISTORY_OUTPUT_SWITCH_TINTERVAL
381  character(len=H_SHORT) :: FILE_HISTORY_OUTPUT_SWITCH_TUNIT
382 
383  namelist / param_file_history / &
384  file_history_title, &
385  file_history_source, &
386  file_history_institution, &
387  file_history_time_units, &
388  file_history_default_basename, &
389  file_history_default_postfix_timelabel, &
390  file_history_default_zcoord, &
391  file_history_default_tinterval, &
392  file_history_default_tunit, &
393  file_history_default_taverage, &
394  file_history_default_datatype, &
395  file_history_output_step0, &
396  file_history_output_wait, &
397  file_history_output_wait_tunit, &
398  file_history_output_switch_tinterval, &
399  file_history_output_switch_tunit, &
400  file_history_error_putmiss, &
401  file_history_aggregate, &
402  file_history_options, &
403  debug
404 
405  character(len=H_SHORT) :: NAME
406  character(len=H_SHORT) :: OUTNAME
407  character(len=H_LONG) :: BASENAME
408  logical :: POSTFIX_TIMELABEL
409  character(len=H_SHORT) :: ZCOORD
410  real(DP) :: TINTERVAL
411  character(len=H_SHORT) :: TUNIT
412  logical :: TAVERAGE
413  character(len=H_SHORT) :: DATATYPE
414 
415  namelist / history_item / &
416  name, &
417  outname, &
418  basename, &
419  postfix_timelabel, &
420  zcoord, &
421  tinterval, &
422  tunit, &
423  taverage, &
424  datatype
425 
426 
427  integer :: reqid
428  real(DP) :: dtsec
429  integer :: dstep
430 
431  integer :: ierr
432  integer :: n, id
433 
434  intrinsic size
435  !---------------------------------------------------------------------------
436 
437  log_newline
438  log_info("FILE_HISTORY_Setup",*) 'Setup'
439 
440  ! setup
441  file_history_myrank = myrank
442 
443  file_history_startdaysec = time_start
444  file_history_dtsec = time_interval
445  if ( present(time_since) ) then
446  file_history_time_since = time_since
447  else
448  file_history_time_since = ''
449  endif
450 
451  if ( present(calendar) ) then
452  file_history_calendar = calendar
453  else
454  file_history_calendar = ""
455  end if
456 
457  file_history_time_units = 'seconds'
458  file_history_default_basename = ''
459  file_history_default_postfix_timelabel = .false.
460  file_history_default_zcoord = ''
461  file_history_default_tinterval = -1.0_dp
462  file_history_default_tunit = 'SEC'
463  file_history_default_taverage = .false.
464  file_history_default_datatype = 'REAL4'
465  file_history_output_wait = 0.0_dp
466  file_history_output_wait_tunit = 'SEC'
467  file_history_output_switch_tinterval = -1.0_dp
468  file_history_output_switch_tunit = 'SEC'
469 
470  file_history_aggregate = file_aggregate
471 
472  !--- read namelist
473  file_history_title = title
474  file_history_source = source
475  file_history_institution = institution
476  if( present(time_units) ) file_history_time_units = time_units
477  if( present(default_basename) ) file_history_default_basename = default_basename
478  if( present(default_postfix_timelabel) ) file_history_default_postfix_timelabel = default_postfix_timelabel
479  if( present(default_zcoord) ) file_history_default_zcoord = default_zcoord
480  if( present(default_tinterval) ) file_history_default_tinterval = default_tinterval
481  if( present(default_tunit) ) file_history_default_tunit = default_tunit
482  if( present(default_taverage) ) file_history_default_taverage = default_taverage
483  if( present(default_datatype) ) file_history_default_datatype = default_datatype
484 
485  !--- read namelist
486  rewind(io_fid_conf)
487  read(io_fid_conf,nml=param_file_history,iostat=ierr)
488  if( ierr < 0 ) then !--- missing
489  log_info("FILE_HISTORY_Setup",*) 'Not found namelist. Default used.'
490  elseif( ierr > 0 ) then !--- fatal error
491  log_error("FILE_HISTORY_Setup",*) 'Not appropriate names in namelist PARAM_FILE_HISTORY. Check!'
492  call prc_abort
493  endif
494  log_nml(param_file_history)
495 
496 
497 
498  if ( file_history_output_wait >= 0.0_dp ) then
499  call calendar_unit2sec( dtsec, file_history_output_wait, file_history_output_wait_tunit )
500  file_history_output_wait_step = int( dtsec / file_history_dtsec )
501  else
502  log_error("FILE_HISTORY_Setup",*) 'FILE_HISTORY_OUTPUT_WAIT must be positive. STOP'
503  call prc_abort
504  endif
505 
506  if ( file_history_output_switch_tinterval >= 0.0_dp ) then
507  call calendar_unit2sec( dtsec, file_history_output_switch_tinterval, file_history_output_switch_tunit )
508  file_history_output_switch_step = int( dtsec / file_history_dtsec )
509  else
510  file_history_output_switch_step = -1
511  endif
512  file_history_output_switch_laststep = 0
513 
514 
515  ! count history request
516  file_history_nreqs = 0
517  if ( io_fid_conf > 0 ) rewind(io_fid_conf)
518  do n = 1, file_history_req_max
519  name = ''
520  outname = 'undefined'
521  basename = file_history_default_basename
522 
523  read(io_fid_conf,nml=history_item,iostat=ierr)
524  if( ierr /= 0 ) exit
525  if( basename == '' .OR. name == '' .OR. outname == '' ) cycle ! invalid HISTORY_ITEM
526 
527  file_history_nreqs = file_history_nreqs + 1
528  enddo
529 
530  if ( file_history_nreqs > file_history_req_max ) then
531  log_error("FILE_HISTORY_Setup",*) 'request of history file is exceed! n >', file_history_req_max
532  call prc_abort
533  elseif( file_history_nreqs == 0 ) then
534  log_info("FILE_HISTORY_Setup",*) 'No history file specified.'
535  return
536  endif
537 
538  allocate( file_history_req(file_history_nreqs) )
539 
540  ! read history request
541  reqid = 0
542  if ( io_fid_conf > 0 ) rewind(io_fid_conf)
543  do n = 1, file_history_req_max
544  ! set default
545  name = ''
546  outname = 'undefined'
547  basename = file_history_default_basename
548  postfix_timelabel = file_history_default_postfix_timelabel
549  zcoord = file_history_default_zcoord
550  tinterval = file_history_default_tinterval
551  tunit = file_history_default_tunit
552  taverage = file_history_default_taverage
553  datatype = file_history_default_datatype
554 
555  read(io_fid_conf,nml=history_item,iostat=ierr)
556  if ( ierr < 0 ) then
557  exit ! no more items
558  elseif( ierr > 0 ) then
559  log_error("FILE_HISTORY_Setup",*) 'Not appropriate names in namelist HISTORY_ITEM. Check!'
560  call prc_abort
561  endif
562  if( basename == '' .OR. name == '' .OR. outname == '' ) cycle ! invalid HISTORY_ITEM
563 
564  log_nml(history_item)
565 
566  ! check duplicated request
567  if ( outname == 'undefined' ) outname = name ! set default name
568  do id = 1, reqid
569  if ( file_history_req(id)%outname == outname ) then
570  log_error("FILE_HISTORY_Setup",*) 'Same name of history output is already registered. Check!', trim(outname)
571  call prc_abort
572  endif
573  enddo
574 
575  reqid = reqid + 1
576 
577  file_history_req(reqid)%name = name
578  file_history_req(reqid)%outname = outname
579  file_history_req(reqid)%basename = basename
580  file_history_req(reqid)%postfix_timelabel = postfix_timelabel
581  if( file_history_output_switch_step >= 0 ) file_history_req(reqid)%postfix_timelabel = .true. ! force true
582  file_history_req(reqid)%zcoord = zcoord
583  file_history_req(reqid)%taverage = taverage
584 
585  call calendar_unit2sec( dtsec, tinterval, tunit )
586  dstep = int( dtsec / file_history_dtsec )
587 
588  if ( dtsec <= 0.d0 ) then
589  log_error("FILE_HISTORY_Setup",*) 'Not appropriate time interval. Check!', trim(name), tinterval, trim(tunit)
590  call prc_abort
591  endif
592 
593  if ( abs(dtsec-real(dstep,kind=dp)*file_history_dtsec) > dtsec*1.e-3_dp ) then
594  log_error("FILE_HISTORY_Setup",*) 'time interval must be a multiple of delta t. (interval,dt)=', dtsec, file_history_dtsec
595  call prc_abort
596  endif
597 
598  file_history_req(reqid)%dstep = dstep
599 
600  if ( datatype == 'REAL4' ) then
601  file_history_req(reqid)%dtype = file_real4
602  elseif( datatype == 'REAL8' ) then
603  file_history_req(reqid)%dtype = file_real8
604  else
605  log_error("FILE_HISTORY_Setup",*) 'Not appropriate DATATYPE. Check!', datatype
606  call prc_abort
607  endif
608 
609  file_history_req(reqid)%registered = .false.
610  enddo
611 
612  log_newline
613  log_info("FILE_HISTORY_Setup",*) 'Number of requested history item : ', file_history_nreqs
614  log_info("FILE_HISTORY_Setup",*) 'Output default data type : ', trim(file_history_default_datatype)
615  log_info("FILE_HISTORY_Setup",*) 'Output value at the initial step? : ', file_history_output_step0
616  if ( file_history_output_wait_step > 0 ) then
617  log_info("FILE_HISTORY_Setup",*) 'Time when the output is suppressed [step] : ', file_history_output_wait_step
618  end if
619  if ( file_history_output_switch_step >= 0 ) then
620  log_info("FILE_HISTORY_Setup",*) 'Interval for switching the file [step] : ', file_history_output_switch_step
621  end if
622  log_info("FILE_HISTORY_Setup",*) 'Check if requested item is not registered? : ', file_history_error_putmiss
623 
624  file_history_nitems = 0
625  allocate( file_history_vars(file_history_nreqs) )
626 
627  file_history_nvar_inputs = 0
628  allocate( file_history_var_inputs(file_history_nreqs) )
629 
630  file_history_truncate_1d => file_history_truncate_1d_default
631  file_history_truncate_2d => file_history_truncate_2d_default
632  file_history_truncate_3d => file_history_truncate_3d_default
633  file_history_truncate_4d => file_history_truncate_4d_default
634 
635  file_history_disabled = .false.
636 
637  return

References scale_calendar::calendar_unit2sec(), scale_precision::dp, scale_file::file_aggregate, file_history_aggregate, file_history_truncate_1d, file_history_truncate_2d, file_history_truncate_3d, file_history_truncate_4d, scale_file_h::file_real4, scale_file_h::file_real8, scale_io::io_fid_conf, and scale_prc::prc_abort().

Referenced by scale_file_history_cartesc::file_history_cartesc_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ file_history_reg()

subroutine, public scale_file_history::file_history_reg ( character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  unit,
integer, intent(out)  itemid,
character(len=*), intent(in), optional  standard_name,
integer, intent(in), optional  ndims,
character(len=*), intent(in), optional  dim_type,
character(len=*), intent(in), optional  cell_measures,
logical, intent(in), optional  fill_halo 
)

Register/Append variable to history file.

Parameters
[in]namename of the item
[in]descdescription of the item
[in]unitunit of the item
[out]itemidindex number of the item
[in]ndimsif ndims is set and dim_type is not set, the dim_type that set firstry by FILE_HISTORY_set_dim of ndims is used

Definition at line 650 of file scale_file_history.F90.

650  implicit none
651 
652  character(len=*), intent(in) :: name
653  character(len=*), intent(in) :: desc
654  character(len=*), intent(in) :: unit
655 
656  integer, intent(out) :: itemid
657 
658  character(len=*), intent(in), optional :: standard_name
659  integer, intent(in), optional :: ndims
660  character(len=*), intent(in), optional :: dim_type
661  character(len=*), intent(in), optional :: cell_measures
662  logical, intent(in), optional :: fill_halo
663 
664  character(len=H_SHORT) :: standard_name_
665  character(len=H_SHORT) :: cell_measures_
666  integer :: dimid, iid
667  integer :: n
668  !---------------------------------------------------------------------------
669 
670  itemid = -1
671  if ( file_history_nreqs == 0 ) return
672 
673  itemid = file_history_find_id( name )
674  if ( itemid > 0 ) return ! already registered
675 
676  call prof_rapstart('FILE_HISTORY_OUT', 2)
677 
678  if ( len_trim(name) >= h_short ) then
679  log_error("FILE_HISTORY_reg",'(1x,A,I2,A,A)') 'Length of history name should be <= ', h_short-1 ,' chars. name=', trim(name)
680  call prc_abort
681  endif
682 
683  ! standard_name
684  if ( present(standard_name) ) then
685  standard_name_ = standard_name
686  else
687  standard_name_ = ""
688  end if
689 
690  ! get dimension id
691  if ( file_history_ndims < 1 ) then
692  log_error("FILE_HISTORY_reg",*) 'at least one dim_type must be registerd with FILE_HISTORY_set_dim. name=', trim(name)
693  call prc_abort
694  end if
695  dimid = -1
696  if ( present(dim_type) ) then
697  do n = 1, file_history_ndims
698  if ( file_history_dims(n)%name == dim_type ) then
699  dimid = n
700  exit
701  end if
702  end do
703  if ( dimid == -1 ) then
704  log_error("FILE_HISTORY_reg",*) 'dim_type must be registerd with FILE_HISTORY_set_dim: ', trim(dim_type) ,' name=', trim(name)
705  call prc_abort
706  end if
707  else if ( present(ndims) ) then
708  do n = 1, file_history_ndims
709  if ( file_history_dims(n)%ndims == ndims ) then
710  dimid = n
711  exit
712  end if
713  end do
714  if ( dimid == -1 ) then
715  log_error("FILE_HISTORY_reg",'(a,i1,a)') 'dim_type of ', ndims, 'D must be registerd with FILE_HISTORY_set_dim. name=', trim(name)
716  call prc_abort
717  end if
718  else
719  ! ndims = 3 is assumed as default
720  do n = 1, file_history_ndims
721  if ( file_history_dims(n)%ndims == 3 ) then
722  dimid = n
723  exit
724  end if
725  end do
726  if ( dimid == -1 ) then
727  log_error("FILE_HISTORY_reg",'(a,i1,a)') 'dim_type or ndims must be specified. name=', trim(name)
728  call prc_abort
729  end if
730  end if
731 
732  if ( present(cell_measures) ) then
733  select case ( cell_measures )
734  case ( "area" )
735  if ( file_history_dims(dimid)%area == "" ) then
736  log_error("FILE_HISTORY_reg",*) 'area is not supported for cell_measures. name=', trim(name)
737  call prc_abort
738  end if
739  case ( "area_z" )
740  if ( file_history_dims(dimid)%area == "" ) then
741  log_error("FILE_HISTORY_reg",*) 'area_z is not supported for cell_measures. name=', trim(name)
742  call prc_abort
743  end if
744  case ( "area_x" )
745  if ( file_history_dims(dimid)%area_x == "" ) then
746  log_error("FILE_HISTORY_reg",*) 'area_x is not supported for cell_measures. name=', trim(name)
747  call prc_abort
748  end if
749  case ( "area_y" )
750  if ( file_history_dims(dimid)%area_y == "" ) then
751  log_error("FILE_HISTORY_reg",*) 'area_y is not supported for cell_measures. name=', trim(name)
752  call prc_abort
753  end if
754  case ( "volume" )
755  if ( file_history_dims(dimid)%volume == "" ) then
756  log_error("FILE_HISTORY_reg",*) 'volume is not supported for cell_measures. name=', trim(name)
757  call prc_abort
758  end if
759  case default
760  log_error("FILE_HISTORY_reg",*) 'cell_measures must be "area" or "volume". name=', trim(name)
761  call prc_abort
762  end select
763  cell_measures_ = cell_measures
764  else if ( file_history_dims(dimid)%ndims == 2 ) then
765  cell_measures_ = "area"
766  else if ( file_history_dims(dimid)%ndims == 3 ) then
767  cell_measures_ = "volume"
768  else
769  cell_measures_ = ""
770  end if
771 
772  if ( file_history_dims(dimid)%nzcoords > 1 ) then
773 
774  itemid = -1
775  do n = 1, file_history_dims(dimid)%nzcoords
776  if ( file_history_dims(dimid)%zcoords(n) == "model" ) then
777  call file_history_add_variable( name, desc, unit, standard_name_, & ! (in)
778  dimid, & ! (in)
779  file_history_dims(dimid)%zcoords(n), & ! (in)
780  iid, & ! (out)
781  cell_measures = cell_measures_, & ! (in)
782  fill_halo = fill_halo ) ! (in)
783  else
784  call file_history_add_variable( name, desc, unit, standard_name_, & ! (in)
785  dimid, & ! (in)
786  file_history_dims(dimid)%zcoords(n), & ! (in)
787  iid, & ! (out)
788  fill_halo = fill_halo ) ! (in)
789  end if
790  if ( iid > 0 ) itemid = iid
791  end do
792 
793  else
794 
795  call file_history_add_variable( name, desc, unit, standard_name_, & ! (in)
796  dimid, & ! (in)
797  "model", & ! (in)
798  itemid, & ! (out)
799  cell_measures = cell_measures_, & ! (in)
800  fill_halo = fill_halo ) ! (in)
801 
802  end if
803 
804  call prof_rapend('FILE_HISTORY_OUT', 2)
805 
806  return

References scale_const::const_eps, scale_const::const_undef, scale_file_h::file_rmiss, scale_io::h_short, i, scale_prc::prc_abort(), scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Referenced by scale_atmos_dyn_tstep_large_fvm_heve::atmos_dyn_tstep_large_fvm_heve_setup(), mod_atmos_phy_ae_vars::atmos_phy_ae_vars_setup(), scale_atmos_phy_cp_kf::atmos_phy_cp_kf_setup(), mod_atmos_phy_lt_driver::atmos_phy_lt_driver_setup(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_sato2019_setup(), mod_atmos_phy_mp_driver::atmos_phy_mp_driver_setup(), scale_atmos_phy_mp_tomita08::atmos_phy_mp_tomita08_setup(), mod_atmos_phy_mp_vars::atmos_phy_mp_vars_setup(), mod_atmos_vars::atmos_vars_setup(), file_history_in_0d(), file_history_in_1d(), file_history_in_2d(), file_history_in_3d(), file_history_in_4d(), and scale_urban_dyn_kusaka01::urban_dyn_kusaka01_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ file_history_in_0d()

subroutine scale_file_history::file_history_in_0d ( real(rp), intent(in)  var,
character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  unit,
character(len=*), intent(in), optional  standard_name,
character(len=*), intent(in), optional  dim_type 
)

Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put.

Parameters
[in]varvalue
[in]namename of the item
[in]descdescription of the item
[in]unitunit of the item

Definition at line 892 of file scale_file_history.F90.

892  implicit none
893 
894  real(RP), intent(in) :: var
895  character(len=*), intent(in) :: name
896  character(len=*), intent(in) :: desc
897  character(len=*), intent(in) :: unit
898 
899  character(len=*), intent(in), optional :: standard_name
900  character(len=*), intent(in), optional :: dim_type
901 
902  logical, parameter :: fill_halo = .false.
903 
904  integer, parameter :: ndim = 0
905  integer :: itemid
906  logical :: do_put
907  !---------------------------------------------------------------------------
908 
909  if ( file_history_disabled ) return
910 
911  ! Check whether the item has been already registered
912  call file_history_reg( name, desc, unit, & ! [IN]
913  itemid, & ! [OUT]
914  standard_name=standard_name, & ! [IN]
915  ndims=ndim, & ! [IN]
916  dim_type=dim_type, & ! [IN]
917  fill_halo=fill_halo ) ! [IN]
918 
919  if ( itemid < 0 ) return
920 
921  ! Check whether it is time to input the item
922  call file_history_query( itemid, do_put ) ! [IN], [OUT]
923 
924  if ( do_put ) call file_history_put( itemid, var )
925 
926  return

References scale_const::const_eps, scale_const::const_undef, file_history_reg(), file_history_truncate_1d, scale_file_h::file_rmiss, scale_prc::prc_abort(), scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ file_history_in_1d()

subroutine scale_file_history::file_history_in_1d ( real(rp), dimension(:), intent(in)  var,
character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  unit,
character(len=*), intent(in), optional  standard_name,
character(len=*), intent(in), optional  dim_type 
)

Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put.

Parameters
[in]varvalue
[in]namename of the item
[in]descdescription of the item
[in]unitunit of the item

Definition at line 1024 of file scale_file_history.F90.

1024  implicit none
1025 
1026  real(RP), intent(in) :: var(:)
1027  character(len=*), intent(in) :: name
1028  character(len=*), intent(in) :: desc
1029  character(len=*), intent(in) :: unit
1030 
1031  character(len=*), intent(in), optional :: standard_name
1032  character(len=*), intent(in), optional :: dim_type
1033 
1034  logical, parameter :: fill_halo = .false.
1035 
1036  integer, parameter :: ndim = 1
1037  integer :: itemid
1038  logical :: do_put
1039  !---------------------------------------------------------------------------
1040 
1041  if ( file_history_disabled ) return
1042 
1043  ! Check whether the item has been already registered
1044  call file_history_reg( name, desc, unit, & ! [IN]
1045  itemid, & ! [OUT]
1046  standard_name=standard_name, & ! [IN]
1047  ndims=ndim, & ! [IN]
1048  dim_type=dim_type, & ! [IN]
1049  fill_halo=fill_halo ) ! [IN]
1050 
1051  if ( itemid < 0 ) return
1052 
1053  ! Check whether it is time to input the item
1054  call file_history_query( itemid, do_put ) ! [IN], [OUT]
1055 
1056  if ( do_put ) call file_history_put( itemid, var(:) )
1057 
1058  return

References scale_const::const_eps, scale_const::const_undef, file_history_reg(), file_history_truncate_2d, scale_file_h::file_rmiss, scale_prc::prc_abort(), scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ file_history_in_2d()

subroutine scale_file_history::file_history_in_2d ( real(rp), dimension(:,:), intent(in)  var,
character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  unit,
character(len=*), intent(in), optional  standard_name,
character(len=*), intent(in), optional  dim_type,
logical, intent(in), optional  fill_halo 
)

Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put.

Parameters
[in]varvalue
[in]namename of the item
[in]descdescription of the item
[in]unitunit of the item

Definition at line 1157 of file scale_file_history.F90.

1157  implicit none
1158 
1159  real(RP), intent(in) :: var(:,:)
1160  character(len=*), intent(in) :: name
1161  character(len=*), intent(in) :: desc
1162  character(len=*), intent(in) :: unit
1163 
1164  character(len=*), intent(in), optional :: standard_name
1165  character(len=*), intent(in), optional :: dim_type
1166  logical, intent(in), optional :: fill_halo
1167 
1168  integer, parameter :: ndim = 2
1169  integer :: itemid
1170  logical :: do_put
1171  !---------------------------------------------------------------------------
1172 
1173  if ( file_history_disabled ) return
1174 
1175  ! Check whether the item has been already registered
1176  call file_history_reg( name, desc, unit, & ! [IN]
1177  itemid, & ! [OUT]
1178  standard_name=standard_name, & ! [IN]
1179  ndims=ndim, & ! [IN]
1180  dim_type=dim_type, & ! [IN]
1181  fill_halo=fill_halo ) ! [IN]
1182 
1183  if ( itemid < 0 ) return
1184 
1185  ! Check whether it is time to input the item
1186  call file_history_query( itemid, do_put ) ! [IN], [OUT]
1187 
1188  if ( do_put ) call file_history_put( itemid, var(:,:) )
1189 
1190  return

References scale_const::const_eps, scale_const::const_undef, file_history_reg(), file_history_truncate_3d, scale_file_h::file_rmiss, scale_prc::prc_abort(), scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ file_history_in_3d()

subroutine scale_file_history::file_history_in_3d ( real(rp), dimension(:,:,:), intent(in)  var,
character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  unit,
character(len=*), intent(in), optional  standard_name,
character(len=*), intent(in), optional  dim_type,
logical, intent(in), optional  fill_halo 
)

Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put.

Parameters
[in]varvalue
[in]namename of the item
[in]descdescription of the item
[in]unitunit of the item

Definition at line 1289 of file scale_file_history.F90.

1289  implicit none
1290 
1291  real(RP), intent(in) :: var(:,:,:)
1292  character(len=*), intent(in) :: name
1293  character(len=*), intent(in) :: desc
1294  character(len=*), intent(in) :: unit
1295 
1296  character(len=*), intent(in), optional :: standard_name
1297  character(len=*), intent(in), optional :: dim_type
1298  logical, intent(in), optional :: fill_halo
1299 
1300  integer, parameter :: ndim = 3
1301  integer :: itemid
1302  logical :: do_put
1303  !---------------------------------------------------------------------------
1304 
1305  if ( file_history_disabled ) return
1306 
1307  ! Check whether the item has been already registered
1308  call file_history_reg( name, desc, unit, & ! [IN]
1309  itemid, & ! [OUT]
1310  standard_name=standard_name, & ! [IN]
1311  ndims=ndim, & ! [IN]
1312  dim_type=dim_type, & ! [IN]
1313  fill_halo=fill_halo ) ! [IN]
1314 
1315  if ( itemid < 0 ) return
1316 
1317  ! Check whether it is time to input the item
1318  call file_history_query( itemid, do_put ) ! [IN], [OUT]
1319 
1320  if ( do_put ) call file_history_put( itemid, var(:,:,:) )
1321 
1322  return

References scale_const::const_eps, scale_const::const_undef, file_history_reg(), file_history_truncate_4d, scale_file_h::file_rmiss, scale_prc::prc_abort(), scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ file_history_in_4d()

subroutine scale_file_history::file_history_in_4d ( real(rp), dimension(:,:,:,:), intent(in)  var,
character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  unit,
character(len=*), intent(in), optional  standard_name,
character(len=*), intent(in), optional  dim_type,
logical, intent(in), optional  fill_halo 
)

Wrapper routine of FILE_HISTORY_reg + FILE_HISTORY_put.

Parameters
[in]varvalue
[in]namename of the item
[in]descdescription of the item
[in]unitunit of the item

Definition at line 1421 of file scale_file_history.F90.

1421  implicit none
1422 
1423  real(RP), intent(in) :: var(:,:,:,:)
1424  character(len=*), intent(in) :: name
1425  character(len=*), intent(in) :: desc
1426  character(len=*), intent(in) :: unit
1427 
1428  character(len=*), intent(in), optional :: standard_name
1429  character(len=*), intent(in), optional :: dim_type
1430  logical, intent(in), optional :: fill_halo
1431 
1432  integer, parameter :: ndim = 4
1433  integer :: itemid
1434  logical :: do_put
1435  !---------------------------------------------------------------------------
1436 
1437  if ( file_history_disabled ) return
1438 
1439  ! Check whether the item has been already registered
1440  call file_history_reg( name, desc, unit, & ! [IN]
1441  itemid, & ! [OUT]
1442  standard_name=standard_name, & ! [IN]
1443  ndims=ndim, & ! [IN]
1444  dim_type=dim_type, & ! [IN]
1445  fill_halo=fill_halo ) ! [IN]
1446 
1447  if ( itemid < 0 ) return
1448 
1449  ! Check whether it is time to input the item
1450  call file_history_query( itemid, do_put ) ! [IN], [OUT]
1451 
1452  if ( do_put ) call file_history_put( itemid, var(:,:,:,:) )
1453 
1454  return

References file_history_reg().

Here is the call graph for this function:

◆ file_history_set_dim()

subroutine, public scale_file_history::file_history_set_dim ( character(len=*), intent(in)  name,
integer, intent(in)  ndims,
integer, intent(in)  nzcoords,
character(len=*), dimension(ndims,nzcoords), intent(in)  dims,
character(len=*), dimension(nzcoords), intent(in)  zcoords,
integer, dimension(ndims,nzcoords), intent(in)  start,
integer, dimension(ndims,nzcoords), intent(in)  count,
character(len=*), intent(in), optional  mapping,
character(len=*), intent(in), optional  area,
character(len=*), intent(in), optional  area_x,
character(len=*), intent(in), optional  area_y,
character(len=*), intent(in), optional  volume,
character(len=*), intent(in), optional  location,
character(len=*), intent(in), optional  grid 
)

set dimension information

Definition at line 1470 of file scale_file_history.F90.

1470  implicit none
1471 
1472  character(len=*), intent(in) :: name
1473  integer, intent(in) :: ndims
1474  integer, intent(in) :: nzcoords
1475  character(len=*), intent(in) :: dims(ndims,nzcoords)
1476  character(len=*), intent(in) :: zcoords(nzcoords)
1477  integer, intent(in) :: start(ndims,nzcoords)
1478  integer, intent(in) :: count(ndims,nzcoords)
1479 
1480  character(len=*), intent(in), optional :: mapping
1481  character(len=*), intent(in), optional :: area
1482  character(len=*), intent(in), optional :: area_x
1483  character(len=*), intent(in), optional :: area_y
1484  character(len=*), intent(in), optional :: volume
1485  character(len=*), intent(in), optional :: location
1486  character(len=*), intent(in), optional :: grid
1487 
1488  integer :: id
1489  integer :: size, n, m
1490 
1491  if ( file_history_ndims >= file_history_dim_max ) then
1492  log_error("FILE_HISTORY_Set_Dim",*) 'number of dimension exceed max limit: ', file_history_dim_max
1493  call prc_abort
1494  end if
1495  file_history_ndims = file_history_ndims + 1
1496  id = file_history_ndims
1497 
1498  allocate( file_history_dims(id)%dims (max(ndims,1),nzcoords) )
1499  allocate( file_history_dims(id)%start(max(ndims,1),nzcoords) )
1500  allocate( file_history_dims(id)%count(max(ndims,1),nzcoords) )
1501  allocate( file_history_dims(id)%zcoords(nzcoords) )
1502  allocate( file_history_dims(id)%size(nzcoords) )
1503 
1504  file_history_dims(id)%name = name
1505  file_history_dims(id)%ndims = ndims
1506  file_history_dims(id)%nzcoords = nzcoords
1507  file_history_dims(id)%zcoords(:) = zcoords(:)
1508  if ( ndims > 0 ) then
1509  file_history_dims(id)%dims(:,:) = dims(:,:)
1510  file_history_dims(id)%start(:,:) = start(:,:)
1511  file_history_dims(id)%count(:,:) = count(:,:)
1512  else ! 0D
1513  file_history_dims(id)%dims(1,1) = ""
1514  file_history_dims(id)%start(1,1) = 1
1515  file_history_dims(id)%count(1,1) = 1
1516  end if
1517 
1518  do m = 1, nzcoords
1519  size = 1
1520  do n = 1, ndims
1521  size = size * count(n,m)
1522  end do
1523  file_history_dims(id)%size(m) = size
1524  end do
1525 
1526  if ( present(mapping) ) then
1527  file_history_dims(id)%mapping = mapping
1528  else
1529  file_history_dims(id)%mapping = ""
1530  end if
1531 
1532  if ( present(area) ) then
1533  file_history_dims(id)%area = area
1534  else
1535  file_history_dims(id)%area = ""
1536  end if
1537  if ( present(area_x) ) then
1538  file_history_dims(id)%area_x = area_x
1539  else
1540  file_history_dims(id)%area_x = ""
1541  end if
1542  if ( present(area_y) ) then
1543  file_history_dims(id)%area_y = area_y
1544  else
1545  file_history_dims(id)%area_y = ""
1546  end if
1547  if ( present(volume) ) then
1548  file_history_dims(id)%volume = volume
1549  else
1550  file_history_dims(id)%volume = ""
1551  end if
1552 
1553  if ( present(location) ) then
1554  file_history_dims(id)%location = location
1555  if ( present(grid) ) then
1556  file_history_dims(id)%grid = "grid_"//trim(grid)
1557  else
1558  file_history_dims(id)%grid = "grid"
1559  end if
1560  else
1561  file_history_dims(id)%location = ""
1562  file_history_dims(id)%grid = ""
1563  end if
1564 
1565  return

References scale_prc::prc_abort().

Referenced by scale_file_history_cartesc::file_history_cartesc_set_pres().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ file_history_set_axis()

subroutine, public scale_file_history::file_history_set_axis ( character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  units,
character(len=*), intent(in)  dim,
real(rp), dimension(:), intent(in)  var,
real(rp), dimension(:,:), intent(in), optional  bounds,
logical, intent(in), optional  down,
integer, intent(in), optional  gsize,
integer, intent(in), optional  start 
)

set axis information

Definition at line 1579 of file scale_file_history.F90.

1579  implicit none
1580 
1581  character(len=*), intent(in) :: name
1582  character(len=*), intent(in) :: desc
1583  character(len=*), intent(in) :: units
1584  character(len=*), intent(in) :: dim
1585  real(RP), intent(in) :: var(:)
1586 
1587  real(RP), intent(in), optional :: bounds(:,:)
1588  logical, intent(in), optional :: down
1589  integer, intent(in), optional :: gsize ! global dim size
1590  integer, intent(in), optional :: start ! global subarray start indices
1591 
1592  integer :: dim_size
1593  integer :: id
1594 
1595  intrinsic size
1596  !---------------------------------------------------------------------------
1597 
1598  dim_size = size(var)
1599 
1600  if ( file_history_naxes >= file_history_axis_max ) then
1601  log_error("FILE_HISTORY_Set_Axis",*) 'Number of axis exceeds the limit.'
1602  call prc_abort
1603  endif
1604 
1605  file_history_naxes = file_history_naxes + 1
1606  id = file_history_naxes
1607 
1608  allocate( file_history_axes(id)%var(dim_size) )
1609 
1610  file_history_axes(id)%name = name
1611  file_history_axes(id)%desc = desc
1612  file_history_axes(id)%units = units
1613  file_history_axes(id)%dim = dim
1614  file_history_axes(id)%dim_size = dim_size
1615  file_history_axes(id)%var(:) = var(:)
1616 
1617  if ( present(down) ) then
1618  file_history_axes(id)%down = down
1619  else
1620  file_history_axes(id)%down = .false.
1621  endif
1622  if ( present(gsize) ) then ! global dimension size
1623  file_history_axes(id)%gdim_size = gsize
1624  else
1625  file_history_axes(id)%gdim_size = -1
1626  end if
1627  if ( present(start) ) then ! global subarray starting indices
1628  file_history_axes(id)%start = start
1629  else
1630  file_history_axes(id)%start = 1
1631  end if
1632 
1633  if ( present(bounds) ) then
1634  allocate( file_history_axes(id)%bounds(2,dim_size) )
1635  file_history_axes(id)%bounds(:,:) = bounds(:,:)
1636  end if
1637 
1638  return

References scale_prc::prc_abort().

Referenced by scale_file_history_cartesc::file_history_cartesc_truncate_3d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ file_history_write()

subroutine, public scale_file_history::file_history_write

Definition at line 1643 of file scale_file_history.F90.

1643  use scale_file, only: &
1644  file_enddef, &
1645  file_flush
1646  implicit none
1647 
1648  integer :: fid, prev_fid
1649  integer :: id
1650  !---------------------------------------------------------------------------
1651 
1652  if ( file_history_disabled ) return
1653 
1654  call prof_rapstart('FILE_HISTORY_OUT', 2)
1655 
1656  ! Write registered history variables to history file
1657  do id = 1, file_history_nitems
1658  call file_history_write_onevar( id, file_history_nowstep ) ! [IN]
1659  enddo
1660 
1661  ! when using PnetCDF, the above FILE_HISTORY_Write() only posts write requests
1662  ! Now we need to commit the requests to the file
1663  prev_fid = -1
1664  do id = 1, file_history_nitems
1665  fid = file_history_vars(id)%fid
1666  if ( fid > 0 .AND. fid /= prev_fid ) then
1667  call file_flush( fid )
1668  prev_fid = fid
1669  endif
1670  enddo
1671 
1672  ! check time to switching output file
1673  if ( file_history_output_switch_step >= 0 &
1674  .AND. file_history_nowstep-file_history_output_switch_laststep > file_history_output_switch_step ) then
1675 
1676  call file_history_close
1677 
1678  log_info("FILE_HISTORY_Write",*) 'FILE_HISTORY file is switched.'
1679 
1680  do id = 1, file_history_nitems
1681  file_history_vars(id)%fid = -1 ! reset
1682  file_history_vars(id)%vid = -1 ! reset
1683  enddo
1684 
1685  file_history_output_switch_laststep = file_history_nowstep - 1
1686  endif
1687 
1688  call prof_rapend('FILE_HISTORY_OUT', 2)
1689 
1690  return

References scale_file::file_enddef(), scale_file::file_flush(), scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Referenced by mod_rm_driver::rm_driver().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ file_history_set_nowdate()

subroutine, public scale_file_history::file_history_set_nowdate ( integer, dimension(:), intent(in)  NOWDATE,
real(dp), intent(in)  NOWSUBSEC,
integer, intent(in)  NOWSTEP 
)

set now step

Definition at line 1697 of file scale_file_history.F90.

1697  integer, intent(in) :: NOWDATE(:)
1698  real(DP), intent(in) :: NOWSUBSEC
1699  integer, intent(in) :: NOWSTEP
1700 
1701  file_history_nowdate(:) = nowdate(:)
1702  file_history_nowsubsec = nowsubsec
1703  file_history_nowstep = nowstep
1704 
1705  return

Referenced by scale_file_history_cartesc::file_history_cartesc_setup(), and mod_rm_driver::rm_driver().

Here is the caller graph for this function:

◆ file_history_set_disable()

subroutine, public scale_file_history::file_history_set_disable ( logical, intent(in)  switch)

set switch to turn on/off history

Definition at line 1712 of file scale_file_history.F90.

1712  implicit none
1713 
1714  logical, intent(in) :: switch
1715  !---------------------------------------------------------------------------
1716 
1717  file_history_disabled = switch
1718 
1719  return

References switch.

Referenced by scale_atmos_dyn_tstep_large_fvm_heve::atmos_dyn_tstep_large_fvm_heve().

Here is the caller graph for this function:

◆ file_history_finalize()

subroutine, public scale_file_history::file_history_finalize

◆ file_history_set_associatedcoordinate_1d()

subroutine scale_file_history::file_history_set_associatedcoordinate_1d ( character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  units,
character(len=*), dimension(:), intent(in)  dims,
real(rp), dimension(:), intent(in)  var,
character(len=*), intent(in), optional  datatype,
integer, dimension(:), intent(in), optional  start 
)

Definition at line 2198 of file scale_file_history.F90.

2198  use scale_file_h, only: &
2199  file_real4, &
2200  file_real8
2201  implicit none
2202 
2203  character(len=*), intent(in) :: name
2204  character(len=*), intent(in) :: desc
2205  character(len=*), intent(in) :: units
2206  character(len=*), intent(in) :: dims(:)
2207  real(RP), intent(in) :: var(:)
2208  character(len=*), intent(in), optional :: datatype
2209  integer, intent(in), optional :: start(:)
2210 
2211  integer :: dtype
2212  integer :: dim_size
2213  integer :: id
2214 
2215  intrinsic size, shape, reshape
2216  !---------------------------------------------------------------------------
2217 
2218  if ( present(datatype) ) then
2219  if ( datatype == 'REAL4' ) then
2220  dtype = file_real4
2221  elseif( datatype == 'REAL8' ) then
2222  dtype = file_real8
2223  else
2224  log_error("FILE_HISTORY_Set_AssociatedCoordinate_1D",*) 'Not appropriate datatype. Check!', datatype
2225  call prc_abort
2226  endif
2227  else if ( rp == sp ) then
2228  dtype = file_real4
2229  else
2230  dtype = file_real8
2231  endif
2232 
2233  dim_size = size(var)
2234 
2235  if ( file_history_nassocs < file_history_assoc_max ) then
2236  file_history_nassocs = file_history_nassocs + 1
2237  id = file_history_nassocs
2238 
2239  allocate( file_history_assocs(id)%var(dim_size) )
2240 
2241  file_history_assocs(id)%name = name
2242  file_history_assocs(id)%desc = desc
2243  file_history_assocs(id)%units = units
2244  file_history_assocs(id)%ndims = 1
2245  file_history_assocs(id)%dims(:) = ''
2246  file_history_assocs(id)%dims(1:1) = dims(1:1)
2247  file_history_assocs(id)%dtype = dtype
2248  file_history_assocs(id)%var(:) = real(reshape( var, (/ dim_size /) ),kind=dp)
2249 
2250  ! start and count are used for parallel I/O to a single shared file
2251  ! since var is reshaped into 1D array, we need to preserve its original shape in count
2252  file_history_assocs(id)%count(1:1) = shape(var)
2253  if ( present(start) ) then
2254  file_history_assocs(id)%start(1:1) = start(1:1)
2255  else
2256  file_history_assocs(id)%start = (/ 1, 1, 1, 1 /)
2257  end if
2258  else
2259  log_error("FILE_HISTORY_Set_AssociatedCoordinate_1D",*) 'Number of associate coordinates exceeds the limit.'
2260  call prc_abort
2261  endif
2262 
2263  return

References scale_precision::dp, scale_file_h::file_real4, scale_file_h::file_real8, scale_prc::prc_abort(), and scale_precision::sp.

Here is the call graph for this function:

◆ file_history_set_associatedcoordinate_2d()

subroutine scale_file_history::file_history_set_associatedcoordinate_2d ( character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  units,
character(len=*), dimension(:), intent(in)  dims,
real(rp), dimension(:,:), intent(in)  var,
character(len=*), intent(in), optional  datatype,
integer, dimension(:), intent(in), optional  start 
)

Definition at line 2275 of file scale_file_history.F90.

2275  use scale_file_h, only: &
2276  file_real4, &
2277  file_real8
2278  implicit none
2279 
2280  character(len=*), intent(in) :: name
2281  character(len=*), intent(in) :: desc
2282  character(len=*), intent(in) :: units
2283  character(len=*), intent(in) :: dims(:)
2284  real(RP), intent(in) :: var(:,:)
2285  character(len=*), intent(in), optional :: datatype
2286  integer, intent(in), optional :: start(:)
2287 
2288  integer :: dtype
2289  integer :: dim_size
2290  integer :: id
2291 
2292  intrinsic size, shape, reshape
2293  !---------------------------------------------------------------------------
2294 
2295  if ( present(datatype) ) then
2296  if ( datatype == 'REAL4' ) then
2297  dtype = file_real4
2298  elseif( datatype == 'REAL8' ) then
2299  dtype = file_real8
2300  else
2301  log_error("FILE_HISTORY_Set_AssociatedCoordinate_2D",*) 'Not appropriate datatype. Check!', datatype
2302  call prc_abort
2303  endif
2304  else if ( rp == sp ) then
2305  dtype = file_real4
2306  else
2307  dtype = file_real8
2308  endif
2309 
2310  dim_size = size(var)
2311 
2312  if ( file_history_nassocs < file_history_assoc_max ) then
2313  file_history_nassocs = file_history_nassocs + 1
2314  id = file_history_nassocs
2315 
2316  allocate( file_history_assocs(id)%var(dim_size) )
2317 
2318  file_history_assocs(id)%name = name
2319  file_history_assocs(id)%desc = desc
2320  file_history_assocs(id)%units = units
2321  file_history_assocs(id)%ndims = 2
2322  file_history_assocs(id)%dims(:) = ''
2323  file_history_assocs(id)%dims(1:2) = dims(1:2)
2324  file_history_assocs(id)%dtype = dtype
2325  file_history_assocs(id)%var(:) = real(reshape( var, (/ dim_size /) ),kind=dp)
2326 
2327  ! start and count are used for parallel I/O to a single shared file
2328  ! since var is reshaped into 1D array, we need to preserve its original shape in count
2329  file_history_assocs(id)%count(1:2) = shape(var)
2330  if ( present(start) ) then
2331  file_history_assocs(id)%start(1:2) = start(1:2)
2332  else
2333  file_history_assocs(id)%start = (/ 1, 1, 1, 1 /)
2334  end if
2335  else
2336  log_error("FILE_HISTORY_Set_AssociatedCoordinate_2D",*) 'Number of associate coordinates exceeds the limit.'
2337  call prc_abort
2338  endif
2339 
2340  return

References scale_precision::dp, scale_file_h::file_real4, scale_file_h::file_real8, scale_prc::prc_abort(), and scale_precision::sp.

Here is the call graph for this function:

◆ file_history_set_associatedcoordinate_3d()

subroutine scale_file_history::file_history_set_associatedcoordinate_3d ( character(len=*), intent(in)  name,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  units,
character(len=*), dimension(:), intent(in)  dims,
real(rp), dimension(:,:,:), intent(in)  var,
character(len=*), intent(in), optional  datatype,
integer, dimension(:), intent(in), optional  start 
)

Definition at line 2352 of file scale_file_history.F90.

2352  use scale_file_h, only: &
2353  file_real4, &
2354  file_real8
2355  implicit none
2356 
2357  character(len=*), intent(in) :: name
2358  character(len=*), intent(in) :: desc
2359  character(len=*), intent(in) :: units
2360  character(len=*), intent(in) :: dims(:)
2361  real(RP), intent(in) :: var(:,:,:)
2362  character(len=*), intent(in), optional :: datatype
2363  integer, intent(in), optional :: start(:)
2364 
2365  integer :: dtype
2366  integer :: dim_size
2367  integer :: id
2368 
2369  intrinsic size, shape, reshape
2370  !---------------------------------------------------------------------------
2371 
2372  if ( present(datatype) ) then
2373  if ( datatype == 'REAL4' ) then
2374  dtype = file_real4
2375  elseif( datatype == 'REAL8' ) then
2376  dtype = file_real8
2377  else
2378  log_error("FILE_HISTORY_Set_AssociatedCoordinate_3D",*) 'Not appropriate datatype. Check!', datatype
2379  call prc_abort
2380  endif
2381  else if ( rp == sp ) then
2382  dtype = file_real4
2383  else
2384  dtype = file_real8
2385  endif
2386 
2387  dim_size = size(var)
2388 
2389  if ( file_history_nassocs < file_history_assoc_max ) then
2390  file_history_nassocs = file_history_nassocs + 1
2391  id = file_history_nassocs
2392 
2393  allocate( file_history_assocs(id)%var(dim_size) )
2394 
2395  file_history_assocs(id)%name = name
2396  file_history_assocs(id)%desc = desc
2397  file_history_assocs(id)%units = units
2398  file_history_assocs(id)%ndims = 3
2399  file_history_assocs(id)%dims(:) = ''
2400  file_history_assocs(id)%dims(1:3) = dims(1:3)
2401  file_history_assocs(id)%dtype = dtype
2402  file_history_assocs(id)%var(:) = real(reshape( var, (/ dim_size /) ),kind=dp)
2403 
2404  ! start and count are used for parallel I/O to a single shared file
2405  ! since var is reshaped into 1D array, we need to preserve its original shape in count
2406  file_history_assocs(id)%count(1:3) = shape(var)
2407  if ( present(start) ) then
2408  file_history_assocs(id)%start(1:3) = start(1:3)
2409  else
2410  file_history_assocs(id)%start = (/ 1, 1, 1, 1 /)
2411  end if
2412  else
2413  log_error("FILE_HISTORY_Set_AssociatedCoordinate_3D",*) 'Number of associate coordinates exceeds the limit.'
2414  call prc_abort
2415  endif
2416 
2417  return

References scale_precision::dp, scale_file_h::file_real4, scale_file_h::file_real8, scale_prc::prc_abort(), and scale_precision::sp.

Here is the call graph for this function:

◆ file_history_set_attribute_text()

subroutine scale_file_history::file_history_set_attribute_text ( character(len=*), intent(in)  varname,
character(len=*), intent(in)  key,
character(len=*), intent(in)  val,
logical, intent(in), optional  add_variable 
)

Definition at line 2427 of file scale_file_history.F90.

2427  use scale_prc, only: &
2428  prc_abort
2429  use scale_file, only: &
2430  file_set_attribute
2431  implicit none
2432  character(len=*), intent(in) :: varname
2433  character(len=*), intent(in) :: key
2434  character(len=*), intent(in) :: val
2435  logical, intent(in), optional :: add_variable
2436 
2437  integer :: id
2438  !---------------------------------------------------------------------------
2439 
2440  file_history_nattrs = file_history_nattrs + 1
2441  if ( file_history_nattrs > file_history_attr_max ) then
2442  log_error("FILE_HISTORY_Set_Attribute_Text",*) 'number of attributes exceeds the limit'
2443  call prc_abort
2444  end if
2445 
2446  id = file_history_nattrs
2447 
2448  file_history_attrs(id)%varname = varname
2449  file_history_attrs(id)%key = key
2450  file_history_attrs(id)%text = val
2451  file_history_attrs(id)%type = i_text
2452 
2453  if ( present(add_variable) ) then
2454  file_history_attrs(id)%add_variable = add_variable
2455  else
2456  file_history_attrs(id)%add_variable = .false.
2457  end if
2458 
2459  return

References scale_prc::prc_abort().

Referenced by file_history_set_attribute_logical().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ file_history_set_attribute_logical()

subroutine scale_file_history::file_history_set_attribute_logical ( character(len=*), intent(in)  varname,
character(len=*), intent(in)  key,
logical, intent(in)  val,
logical, intent(in), optional  add_variable 
)

Definition at line 2466 of file scale_file_history.F90.

2466  use scale_file, only: &
2467  file_set_attribute
2468  implicit none
2469  character(len=*), intent(in) :: varname
2470  character(len=*), intent(in) :: key
2471  logical, intent(in) :: val
2472  logical, intent(in), optional :: add_variable
2473 
2474  character(len=5) :: buf
2475  !---------------------------------------------------------------------------
2476 
2477  if ( val ) then
2478  buf = "true"
2479  else
2480  buf = "false"
2481  end if
2482 
2483  call file_history_set_attribute_text( varname, key, buf, add_variable=add_variable )
2484 
2485  return

References file_history_set_attribute_text().

Here is the call graph for this function:

◆ file_history_set_attribute_int_ary()

subroutine scale_file_history::file_history_set_attribute_int_ary ( character(len=*), intent(in)  varname,
character(len=*), intent(in)  key,
integer, dimension(:), intent(in)  val,
logical, intent(in), optional  add_variable 
)

Definition at line 2493 of file scale_file_history.F90.

2493  use scale_prc, only: &
2494  prc_abort
2495  use scale_file, only: &
2496  file_set_attribute
2497  implicit none
2498  character(len=*), intent(in) :: varname
2499  character(len=*), intent(in) :: key
2500  integer, intent(in) :: val(:)
2501  logical, intent(in), optional :: add_variable
2502 
2503  integer :: id
2504 
2505  intrinsic size
2506  !---------------------------------------------------------------------------
2507 
2508  file_history_nattrs = file_history_nattrs + 1
2509  if ( file_history_nattrs > file_history_attr_max ) then
2510  log_error("FILE_HISTORY_Set_Attribute_Int",*) 'number of attributes exceeds the limit'
2511  call prc_abort
2512  end if
2513 
2514  id = file_history_nattrs
2515 
2516  allocate( file_history_attrs(id)%int( size(val) ) )
2517 
2518  file_history_attrs(id)%varname = varname
2519  file_history_attrs(id)%key = key
2520  file_history_attrs(id)%int(:) = val(:)
2521  file_history_attrs(id)%type = i_int
2522 
2523  if ( present(add_variable) ) then
2524  file_history_attrs(id)%add_variable = add_variable
2525  else
2526  file_history_attrs(id)%add_variable = .false.
2527  end if
2528 
2529  return

References scale_prc::prc_abort().

Referenced by file_history_set_attribute_int().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ file_history_set_attribute_int()

subroutine scale_file_history::file_history_set_attribute_int ( character(len=*), intent(in)  varname,
character(len=*), intent(in)  key,
integer, intent(in)  val,
logical, intent(in), optional  add_variable 
)

Definition at line 2537 of file scale_file_history.F90.

2537  implicit none
2538  character(len=*), intent(in) :: varname
2539  character(len=*), intent(in) :: key
2540  integer, intent(in) :: val
2541  logical, intent(in), optional :: add_variable
2542 
2543  integer :: ary(1)
2544  !---------------------------------------------------------------------------
2545 
2546  ary(1) = val
2547  call file_history_set_attribute_int_ary( varname, & ! (in)
2548  key, ary(:), & ! (in)
2549  add_variable=add_variable ) ! (in)
2550 
2551  return

References file_history_set_attribute_int_ary(), and scale_prc::prc_abort().

Here is the call graph for this function:

◆ file_history_set_attribute_float()

subroutine scale_file_history::file_history_set_attribute_float ( character(len=*), intent(in)  varname,
character(len=*), intent(in)  key,
real(sp), intent(in)  val,
logical, intent(in), optional  add_variable 
)

Definition at line 2602 of file scale_file_history.F90.

2602  implicit none
2603  character(len=*), intent(in) :: varname
2604  character(len=*), intent(in) :: key
2605  real(SP), intent(in) :: val
2606  logical, intent(in), optional :: add_variable
2607 
2608  real(SP) :: ary(1)
2609 
2610  ary(1) = val
2611  call file_history_set_attribute_float_ary( varname, & ! (in)
2612  key, ary(:), & ! (in)
2613  add_variable ) ! (in)
2614 
2615  return

References scale_prc::prc_abort().

Here is the call graph for this function:

◆ file_history_set_attribute_double()

subroutine scale_file_history::file_history_set_attribute_double ( character(len=*), intent(in)  varname,
character(len=*), intent(in)  key,
real(dp), intent(in)  val,
logical, intent(in), optional  add_variable 
)

Definition at line 2665 of file scale_file_history.F90.

2665  implicit none
2666  character(len=*), intent(in) :: varname
2667  character(len=*), intent(in) :: key
2668  real(DP), intent(in) :: val
2669  logical, intent(in), optional :: add_variable
2670 
2671  real(DP) :: ary(1)
2672 
2673  ary(1) = val
2674  call file_history_set_attribute_double_ary( varname, & ! (in)
2675  key, ary(:), & ! (in)
2676  add_variable ) ! (in)
2677 
2678  return

References scale_calendar::calendar_sec2unit(), scale_file::file_enddef(), scale_file::file_flush(), scale_file_h::file_rmiss, and scale_prc::prc_abort().

Here is the call graph for this function:

Variable Documentation

◆ file_history_truncate_1d

procedure(truncate_1d), pointer, public scale_file_history::file_history_truncate_1d => NULL()

Definition at line 77 of file scale_file_history.F90.

77  procedure(truncate_1D), pointer :: FILE_HISTORY_truncate_1D => null()

Referenced by scale_file_history_cartesc::file_history_cartesc_setup(), file_history_in_0d(), and file_history_setup().

◆ file_history_truncate_2d

procedure(truncate_2d), pointer, public scale_file_history::file_history_truncate_2d => NULL()

Definition at line 89 of file scale_file_history.F90.

89  procedure(truncate_2D), pointer :: FILE_HISTORY_truncate_2D => null()

Referenced by scale_file_history_cartesc::file_history_cartesc_setup(), file_history_in_1d(), and file_history_setup().

◆ file_history_truncate_3d

procedure(truncate_3d), pointer, public scale_file_history::file_history_truncate_3d => NULL()

Definition at line 101 of file scale_file_history.F90.

101  procedure(truncate_3D), pointer :: FILE_HISTORY_truncate_3D => null()

Referenced by scale_file_history_cartesc::file_history_cartesc_setup(), file_history_in_2d(), and file_history_setup().

◆ file_history_truncate_4d

procedure(truncate_4d), pointer, public scale_file_history::file_history_truncate_4d => NULL()

Definition at line 113 of file scale_file_history.F90.

113  procedure(truncate_4D), pointer :: FILE_HISTORY_truncate_4D => null()

Referenced by file_history_in_3d(), and file_history_setup().

◆ file_history_aggregate

logical, public scale_file_history::file_history_aggregate

Definition at line 143 of file scale_file_history.F90.

143  logical, public :: FILE_HISTORY_AGGREGATE

Referenced by scale_file_history_cartesc::file_history_cartesc_truncate_3d(), file_history_finalize(), and file_history_setup().

◆ switch

integer public scale_file_history::switch

Definition at line 143 of file scale_file_history.F90.

Referenced by file_history_set_disable().

◆ to

integer public scale_file_history::to

Definition at line 143 of file scale_file_history.F90.

◆ use

logical, public scale_file_history::use

Definition at line 143 of file scale_file_history.F90.

◆ aggregate

logical, public scale_file_history::aggregate

Definition at line 143 of file scale_file_history.F90.

Referenced by file_history_finalize().

◆ file

integer public scale_file_history::file

Definition at line 143 of file scale_file_history.F90.

◆ i

logical, public scale_file_history::i

Definition at line 143 of file scale_file_history.F90.

Referenced by file_history_finalize(), and file_history_reg().

◆ o

logical, public scale_file_history::o

Definition at line 143 of file scale_file_history.F90.

scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_file::file_enddef
subroutine, public file_enddef(fid)
Definition: scale_file.F90:4585
scale_file::file_flush
subroutine, public file_flush(fid)
Definition: scale_file.F90:4709
scale_calendar
module CALENDAR
Definition: scale_calendar.F90:13
scale_file
module file
Definition: scale_file.F90:15
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_file_h
module file_h
Definition: scale_file_h.F90:11
scale_calendar::calendar_unit2sec
subroutine, public calendar_unit2sec(second, value, unit)
Convert several units to second.
Definition: scale_calendar.F90:424