78 use gtool_historyauto_internal
, only: initialized, version, sub_sname, &
79 & zero_time, numdims, &
80 & title_save, source_save, institution_save, conventions_save, &
81 & gt_version_save, rank_save, save_mpi_split, save_mpi_gather, &
82 & time_unit_bycreate, time_unit_suffix, gthst_axes, data_axes, &
83 & all_output_save, gthstnml, cal_save
84 use gtool_history, only: historyaxiscreate, historyaxisaddattr
88 use dc_trace
, only: beginsub, endsub
91 use netcdf
, only: nf90_emaxdims, nf90_max_dims
92 use dc_string
, only: putline, printf, split, strinclude, stoa, joinchar
93 use dc_present
, only: present_and_not_empty, present_and_true, &
99 use dc_message
, only: messagenotify
103 character(*),
intent(in):: title
106 character(*),
intent(in):: source
109 character(*),
intent(in):: institution
112 character(*),
intent(in):: dims(:)
131 integer,
intent(in):: dimsizes (:)
159 character(*),
intent(in):: longnames (:)
179 character(*),
intent(in):: units(:)
199 type(dc_difftime),
intent(in):: origin
204 type(dc_difftime),
intent(in):: terminus
209 character(*),
intent(in),
optional:: xtypes(:)
239 character(*),
intent(in),
optional:: conventions
258 character(*),
intent(in),
optional:: gt_version
280 logical,
intent(in),
optional:: all_output
316 character(*),
intent(in),
optional:: file_prefix
319 character(*),
intent(in),
optional:: namelist_filename
331 type(dc_difftime),
intent(in),
optional:: interval
343 integer,
intent(in),
optional:: slice_start(:)
353 integer,
intent(in),
optional:: slice_end(:)
365 integer,
intent(in),
optional:: slice_stride(:)
375 logical,
intent(in),
optional:: space_average(:)
388 logical,
intent(in),
optional:: time_average
393 integer,
intent(in),
optional:: newfile_interval
404 character(*),
intent(in),
optional:: rank
409 type(dc_datetime),
intent(in),
optional:: origin_date
416 logical,
intent(in),
optional:: origin_date_invalid
420 type(dc_cal_date),
intent(in),
optional:: start_date
425 type(dc_cal),
intent(in),
optional:: cal
434 logical,
intent(in),
optional:: flag_mpi_gather
451 logical,
intent(in),
optional:: flag_mpi_split
465 character(STRING):: name
482 character(STRING):: file
497 character(TOKEN):: intunit
500 character(TOKEN):: precision
516 character(STRING):: fileprefix
519 logical:: timeaverage
532 real(DP):: originvalue
535 character(TOKEN):: originunit
538 real(DP):: terminusvalue
541 character(TOKEN):: terminusunit
544 integer:: slicestart(1:nf90_max_dims)
547 integer:: sliceend(1:nf90_max_dims)
559 integer:: slicestride(1:nf90_max_dims)
562 logical:: spaceaverage(1:nf90_max_dims)
565 integer:: newfileintvalue
568 character(TOKEN):: newfileintunit
572 namelist /gtool_historyauto_nml/ &
574 & intvalue, intunit, &
577 & timeaverage, alloutput, &
578 & originvalue, originunit, &
579 & terminusvalue, terminusunit, &
580 & slicestart, sliceend, slicestride, spaceaverage, &
581 & newfileintvalue, newfileintunit
602 integer:: blank_index
604 character(STRING):: cause_c
609 character(TOKEN):: pos_nml
613 character(TOKEN):: my_xtype
615 real(DP):: interval_work, origin_work, terminus_work
619 character(STRING):: date_str
620 character(TOKEN):: cal_str, cal_type
621 integer:: origin_year, origin_month, origin_day, origin_hour, origin_min
622 real(DP):: origin_sec
623 integer:: month_in_year, hour_in_day, min_in_hour
624 integer,
pointer:: day_in_month(:) =>null()
625 real(DP):: sec_in_min
626 character(*),
parameter:: subname =
"HistoryAutoCreate3" 628 call beginsub(subname, version = version)
635 if ( initialized )
then 637 cause_c =
'gtool_historyauto' 654 if (
size(dimsizes) /= numdims )
then 655 cause_c =
'dimsizes, dims' 656 elseif (
size(longnames) /= numdims )
then 657 cause_c =
'longnames, dims' 658 elseif (
size(units) /= numdims )
then 659 cause_c =
'units, dims' 661 if ( trim(cause_c) /=
"" )
then 666 if ( numdims > nf90_max_dims )
then 674 if ( dimsizes(numdims) /= 0 )
then 675 call messagenotify(
'W', subname, &
676 &
'time dimension must be specified to the last of "dims"' )
686 institution_save = institution
688 conventions_save =
'' 689 if (
present(conventions) ) conventions_save = conventions
692 if (
present(gt_version) ) gt_version_save = gt_version
695 if (
present(rank) ) rank_save = rank
700 save_mpi_split = present_and_true( flag_mpi_split )
701 save_mpi_gather = present_and_true( flag_mpi_gather )
704 if ( save_mpi_gather ) msnot_rank = 0
709 time_unit_bycreate = units(numdims)
710 time_unit_suffix =
'' 711 blank_index = index( trim( adjustl(time_unit_bycreate) ),
' ' )
712 if ( blank_index > 1 )
then 713 time_unit_suffix = time_unit_bycreate(blank_index+1:)
714 time_unit_bycreate = time_unit_bycreate(1:blank_index-1)
722 if (
present(xtypes) )
then 723 if (
size(xtypes) >= i )
then 728 call historyaxiscreate( &
729 & axis = gthst_axes(i), &
730 & name = dims(i),
size = dimsizes(i), &
731 & longname = longnames(i), units = units(i), &
734 allocate( data_axes(i) % a_axis( dimsizes(i) ) )
735 data_axes(i) % a_axis = (/ (
real( j, DP ), j = 1, dimsizes(i) ) /)
742 if (
present(cal) )
then 751 if (
present(start_date) )
then 754 & date_str = date_str, &
755 & date = start_date, &
761 & origin_year, origin_month, origin_day, &
762 & origin_hour, origin_min, origin_sec, &
763 & date = start_date, &
769 & month_in_year = month_in_year, &
770 & day_in_month_ptr = day_in_month , &
771 & hour_in_day = hour_in_day , &
772 & min_in_hour = min_in_hour , &
773 & sec_in_min = sec_in_min , &
778 select case ( trim(cal_str) )
780 time_unit_suffix = trim(time_unit_suffix) // &
781 &
' since ' // trim(date_str)
783 time_unit_suffix = trim(time_unit_suffix) // &
784 &
' since ' // trim(date_str)
786 time_unit_suffix = trim(time_unit_suffix) // &
787 &
' since ' // trim(date_str)
789 time_unit_suffix = trim(time_unit_suffix) // &
790 &
' since ' // trim(date_str)
792 time_unit_suffix = trim(time_unit_suffix) // &
793 &
' since ' // trim(date_str)
798 call historyaxisaddattr( &
799 & axis = gthst_axes(numdims), &
800 & attrname =
'origin', &
801 &
value =
'origin_year origin_month origin_day ' // &
802 &
'origin_hour origin_min origin_sec' )
804 call historyaxisaddattr( gthst_axes(numdims),
'origin_year', origin_year )
805 call historyaxisaddattr( gthst_axes(numdims),
'origin_month', origin_month )
806 call historyaxisaddattr( gthst_axes(numdims),
'origin_day', origin_day )
807 call historyaxisaddattr( gthst_axes(numdims),
'origin_hour', origin_hour )
808 call historyaxisaddattr( gthst_axes(numdims),
'origin_min', origin_min )
812 call historyaxisaddattr( &
813 & axis = gthst_axes(numdims), &
814 & attrname =
'calendar', &
817 if ( trim(cal_str) ==
'user_defined' )
then 818 call historyaxisaddattr( gthst_axes(numdims),
'month_in_year', month_in_year )
819 call historyaxisaddattr( gthst_axes(numdims),
'day_in_month', day_in_month )
820 call historyaxisaddattr( gthst_axes(numdims),
'hour_in_day', hour_in_day )
821 call historyaxisaddattr( gthst_axes(numdims),
'min_in_hour', min_in_hour )
822 call historyaxisaddattr( gthst_axes(numdims),
'sec_in_min', sec_in_min )
825 deallocate( day_in_month )
827 elseif (
present(origin_date) &
828 & .and. .not. present_and_true(origin_date_invalid) )
then 829 call eval( origin_date, &
830 & day = date_day, sec = date_sec )
831 if ( date_day /= 0 .or. date_sec /= 0.0 )
then 832 time_unit_suffix = trim(time_unit_suffix) // &
833 &
' since ' //
tochar(origin_date)
835 call historyaxisaddattr( &
836 & axis = gthst_axes(numdims), &
837 & attrname =
'calendar', &
846 if (
present(all_output) ) all_output_save = all_output
847 if ( .not. present_and_not_empty(namelist_filename) ) all_output_save = .true.
848 alloutput = all_output_save
853 if ( all_output_save )
then 854 if (
present(interval) )
then 855 interval_work =
evalbyunit( interval, time_unit_bycreate )
860 interval_work = - 1.0
867 terminus_work =
evalbyunit( terminus, time_unit_bycreate )
875 & gthstnml = gthstnml, &
877 & precision =
'float', &
878 & fileprefix = file_prefix, &
879 & interval_value = interval_work, &
880 & interval_unit = time_unit_bycreate, &
881 & origin_value = origin_work, &
882 & origin_unit =
'sec', &
884 & terminus_value = terminus_work, &
885 & terminus_unit = time_unit_bycreate, &
886 & time_average = time_average, &
887 & slice_start = slice_start, &
888 & slice_end = slice_end, &
889 & slice_stride = slice_stride, &
890 & space_average = space_average, &
891 & newfile_intvalue = newfile_interval, &
892 & newfile_intunit = time_unit_bycreate )
897 if ( present_and_not_empty(namelist_filename) )
then 899 & namelist_filename, mode =
'r' )
904 call messagenotify(
'M', sub_sname,
'----- "gtool_historyauto_nml" is loaded from "%c" -----', &
905 & c1 = trim(namelist_filename), rank_mpi = msnot_rank )
907 do while ( trim(pos_nml) /=
'APPEND' .and. iostat_nml == 0 )
912 & gthstnml = gthstnml, &
913 & interval_value = intvalue, &
914 & interval_unit = intunit, &
915 & precision = precision, &
916 & time_average = timeaverage, &
917 & origin_value = originvalue, &
918 & origin_unit = originunit, &
919 & terminus_value = terminusvalue, &
920 & terminus_unit = terminusunit, &
921 & slice_start = slicestart, &
922 & slice_end = sliceend, &
923 & slice_stride = slicestride, &
924 & space_average = spaceaverage, &
925 & newfile_intvalue = newfileintvalue, &
926 & newfile_intunit = newfileintunit, &
927 & fileprefix = fileprefix )
929 read( unit = unit_nml, &
930 & nml = gtool_historyauto_nml, &
931 & iostat = iostat_nml )
932 inquire( unit = unit_nml, &
933 & position = pos_nml )
935 if ( iostat_nml == 0 )
then 940 if ( .not. intvalue > 0.0 )
then 941 intvalue = interval_work
942 intunit = time_unit_bycreate
944 if ( .not. originvalue > 0.0 )
then 945 originvalue = origin_work
948 if ( .not. terminusvalue > 0.0 )
then 949 terminusvalue = terminus_work
950 terminusunit = time_unit_bycreate
957 & gthstnml = gthstnml, &
960 & interval_value = intvalue, &
961 & interval_unit = intunit, &
962 & precision = precision, &
963 & time_average = timeaverage, &
964 & origin_value = originvalue, &
965 & origin_unit = originunit, &
966 & terminus_value = terminusvalue, &
967 & terminus_unit = terminusunit, &
968 & slice_start = slicestart, &
969 & slice_end = sliceend, &
970 & slice_stride = slicestride, &
971 & space_average = spaceaverage, &
972 & newfile_intvalue = newfileintvalue, &
973 & newfile_intunit = newfileintunit, &
974 & fileprefix = fileprefix )
979 if ( trim(name) ==
'' )
then 980 all_output_save = alloutput
985 if ( trim(file) ==
'' ) file = trim(fileprefix) //
'<Name>.nc' 987 if ( trim(name) ==
'' )
then 988 call messagenotify(
'M', sub_sname,
'Global Settings:', rank_mpi = msnot_rank )
989 call messagenotify(
'M', sub_sname,
' AllOutput = %b', l = (/ alloutput /), rank_mpi = msnot_rank )
990 call messagenotify(
'M', sub_sname,
' FilePrefix = %c', c1 = trim(fileprefix ), rank_mpi = msnot_rank )
992 call messagenotify(
'M', sub_sname,
'Individual Settings:', rank_mpi = msnot_rank )
993 call messagenotify(
'M', sub_sname,
' Name = %c', c1 = trim(name ), rank_mpi = msnot_rank )
994 call messagenotify(
'M', sub_sname,
' File = %c', c1 = trim(file ), rank_mpi = msnot_rank )
996 call messagenotify(
'M', sub_sname,
' Interval = %f [%c]', &
997 & d = (/ intvalue /), c1 = trim( intunit ), rank_mpi = msnot_rank )
998 call messagenotify(
'M', sub_sname,
' Precision = %c', c1 = trim(precision ), rank_mpi = msnot_rank )
999 call messagenotify(
'M', sub_sname,
' TimeAverage = %b', l = (/ timeaverage /), rank_mpi = msnot_rank )
1000 call messagenotify(
'M', sub_sname,
' Origin = %f [%c]', &
1001 & d = (/ originvalue /), c1 = trim( originunit ), rank_mpi = msnot_rank )
1002 call messagenotify(
'M', sub_sname,
' Terminus = %f [%c]', &
1003 & d = (/ terminusvalue /), c1 = trim( terminusunit ), rank_mpi = msnot_rank )
1004 call messagenotify(
'M', sub_sname,
' SliceStart = (/ %*d /)', &
1005 & i = slicestart(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1006 call messagenotify(
'M', sub_sname,
' SliceEnd = (/ %*d /)', &
1007 & i = sliceend(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1008 call messagenotify(
'M', sub_sname,
' SliceStride = (/ %*d /)', &
1009 & i = slicestride(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1010 call messagenotify(
'M', sub_sname,
' SpaceAverage = (/ %*b /)', &
1011 & l = spaceaverage(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1012 call messagenotify(
'M', sub_sname,
' NewFileInterval = %d [%c]', &
1013 & i = (/ newfileintvalue /), c1 = trim( newfileintunit ), rank_mpi = msnot_rank )
1014 call messagenotify(
'M', sub_sname,
'', rank_mpi = msnot_rank )
1017 call messagenotify(
'M', sub_sname,
'----- loading is finished (iostat=%d) -----', &
1018 & i = (/iostat_nml/), rank_mpi = msnot_rank )
1029 call messagenotify(
'M', sub_sname,
'----- "gtool_historyauto_nml" is not loaded" -----', rank_mpi = msnot_rank )
1033 & gthstnml = gthstnml, &
1034 & interval_value = intvalue, &
1035 & interval_unit = intunit, &
1036 & precision = precision, &
1037 & time_average = timeaverage, &
1038 & origin_value = originvalue, &
1039 & origin_unit = originunit, &
1040 & terminus_value = terminusvalue, &
1041 & terminus_unit = terminusunit, &
1042 & slice_start = slicestart, &
1043 & slice_end = sliceend, &
1044 & slice_stride = slicestride, &
1045 & space_average = spaceaverage, &
1046 & newfile_intvalue = newfileintvalue, &
1047 & newfile_intunit = newfileintunit, &
1048 & fileprefix = fileprefix )
1052 call messagenotify(
'M', sub_sname,
'Global Settings:', rank_mpi = msnot_rank )
1053 call messagenotify(
'M', sub_sname,
' AllOutput = %b', l = (/ alloutput /), rank_mpi = msnot_rank )
1054 call messagenotify(
'M', sub_sname,
' FilePrefix = %c', c1 = trim(fileprefix ), rank_mpi = msnot_rank )
1055 call messagenotify(
'M', sub_sname,
' Interval = %f [%c]', &
1056 & d = (/ intvalue /), c1 = trim( intunit ), rank_mpi = msnot_rank )
1057 call messagenotify(
'M', sub_sname,
' Precision = %c', c1 = trim(precision ), rank_mpi = msnot_rank )
1058 call messagenotify(
'M', sub_sname,
' TimeAverage = %b', l = (/ timeaverage /), rank_mpi = msnot_rank )
1059 call messagenotify(
'M', sub_sname,
' Origin = %f [%c]', &
1060 & d = (/ originvalue /), c1 = trim( originunit ), rank_mpi = msnot_rank )
1061 call messagenotify(
'M', sub_sname,
' Terminus = %f [%c]', &
1062 & d = (/ terminusvalue /), c1 = trim( terminusunit ), rank_mpi = msnot_rank )
1063 call messagenotify(
'M', sub_sname,
' SliceStart = (/ %*d /)', &
1064 & i = slicestart(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1065 call messagenotify(
'M', sub_sname,
' SliceEnd = (/ %*d /)', &
1066 & i = sliceend(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1067 call messagenotify(
'M', sub_sname,
' SliceStride = (/ %*d /)', &
1068 & i = slicestride(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1069 call messagenotify(
'M', sub_sname,
' SpaceAverage = (/ %*b /)', &
1070 & l = spaceaverage(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1071 call messagenotify(
'M', sub_sname,
' NewFileInterval = %d [%c]', &
1072 & i = (/ newfileintvalue /), c1 = trim( newfileintunit ), rank_mpi = msnot_rank )
1073 call messagenotify(
'M', sub_sname,
'' , rank_mpi = msnot_rank)
1080 initialized = .true.
1083 call storeerror(stat, subname, cause_c = cause_c)
1084 call endsub(subname,
'stat=%d', i = (/stat/) )
subroutine, public fileopen(unit, file, mode, err)
integer, parameter, public token
Character length for word, token.
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_noerr
integer, parameter, public hst_enotimedim
integer, parameter, public dp
Double Precision Real number.
subroutine hstnmlinfocreate(gthstnml, interval_value, interval_unit, precision, time_average, average, fileprefix, origin_value, origin_unit, terminus_value, terminus_unit, slice_start, slice_end, slice_stride, space_average, newfile_intvalue, newfile_intunit, err)
integer, parameter, public gt_eargsizemismatch
Provides kind type parameter values.
integer, parameter, public dc_ealreadyinit
integer, parameter, public dc_enegative
integer, parameter, public string
Character length for string.