11 & title, source, institution, & ! (in)
12 & dims, dimsizes, longnames, units, &
14 & xtypes, conventions, gt_version, &
17 & namelist_filename, &
19 & slice_start, slice_end, slice_stride, &
24 & origin_date, origin_date_invalid, &
26 & flag_mpi_gather, flag_mpi_split &
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, &
96 & dccaldateinquire, dccalinquire, dccaldefault
97 use dc_date, only: dcdifftimecreate, evalbyunit, tochar, tocharcal, eval
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 745 call dccaldefault( cal_save )
751 if (
present(start_date) )
then 753 call dccaldateinquire( &
754 & date_str = date_str, &
755 & date = start_date, &
760 call dccaldateinquire( &
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', &
838 &
value = tocharcal(origin_date) )
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
866 origin_work = evalbyunit( origin,
'sec' )
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/) )
1090 & title, source, institution, & ! (in)
1091 & dims, dimsizes, longnames, units, &
1092 & xtypes, conventions, gt_version,&
1095 & namelist_filename, &
1096 & interval, origin, terminus, &
1097 & slice_start, slice_end, slice_stride, &
1100 & newfile_interval, &
1102 & origin_date, origin_date_invalid, &
1103 & start_date, cal, &
1104 & flag_mpi_gather, flag_mpi_split &
1156 use gtool_historyauto_generic
, only: historyautocreate
1157 use gtool_historyauto_internal
, only: initialized, numdims, time_unit_bycreate, time_unit_suffix
1162 use dc_trace
, only: beginsub, endsub
1165 use netcdf
, only: nf90_emaxdims, nf90_max_dims
1166 use dc_string
, only: putline, printf, split, strinclude, stoa, joinchar
1167 use dc_present
, only: present_and_not_empty, present_and_true, &
1170 use dc_date, only: dcdifftimecreate, evalbyunit
1172 use dc_message
, only: messagenotify
1176 character(*),
intent(in):: title
1179 character(*),
intent(in):: source
1182 character(*),
intent(in):: institution
1185 character(*),
intent(in):: dims(:)
1204 integer,
intent(in):: dimsizes (:)
1232 character(*),
intent(in):: longnames (:)
1252 character(*),
intent(in):: units(:)
1272 character(*),
intent(in),
optional:: xtypes(:)
1302 character(*),
intent(in),
optional:: conventions
1321 character(*),
intent(in),
optional:: gt_version
1343 logical,
intent(in),
optional:: all_output
1379 character(*),
intent(in),
optional:: file_prefix
1382 character(*),
intent(in),
optional:: namelist_filename
1394 real,
intent(in),
optional:: interval
1406 real,
intent(in),
optional:: origin
1418 real,
intent(in),
optional:: terminus
1430 integer,
intent(in),
optional:: slice_start(:)
1440 integer,
intent(in),
optional:: slice_end(:)
1450 integer,
intent(in),
optional:: slice_stride(:)
1460 logical,
intent(in),
optional:: space_average(:)
1473 logical,
intent(in),
optional:: time_average
1478 integer,
intent(in),
optional:: newfile_interval
1489 character(*),
intent(in),
optional:: rank
1496 type(dc_datetime),
intent(in),
optional:: origin_date
1503 logical,
intent(in),
optional:: origin_date_invalid
1508 type(dc_cal_date),
intent(in),
optional:: start_date
1513 type(dc_cal),
intent(in),
optional:: cal
1522 logical,
intent(in),
optional:: flag_mpi_gather
1539 logical,
intent(in),
optional:: flag_mpi_split
1550 integer:: blank_index
1551 type(dc_difftime):: interval_difftime, origin_difftime, terminus_difftime
1553 character(STRING):: cause_c
1554 character(*),
parameter:: subname =
"HistoryAutoCreate2" 1556 call beginsub(subname)
1563 if ( initialized )
then 1565 cause_c =
'gtool_historyauto' 1572 numdims =
size(dims)
1574 if (
size(dimsizes) /= numdims )
then 1575 cause_c =
'dimsizes, dims' 1576 elseif (
size(longnames) /= numdims )
then 1577 cause_c =
'longnames, dims' 1578 elseif (
size(units) /= numdims )
then 1579 cause_c =
'units, dims' 1581 if ( trim(cause_c) /=
"" )
then 1586 if ( numdims > nf90_max_dims )
then 1587 stat = nf90_emaxdims
1594 if ( dimsizes(numdims) /= 0 )
then 1595 call messagenotify(
'W', subname, &
1596 &
'time dimension must be specified to the last of "dims"' )
1604 time_unit_bycreate = units(numdims)
1605 time_unit_suffix =
'' 1606 blank_index = index( trim( adjustl(time_unit_bycreate) ),
' ' )
1607 if ( blank_index > 1 )
then 1608 time_unit_suffix = time_unit_bycreate(blank_index+1:)
1609 time_unit_bycreate = time_unit_bycreate(1:blank_index-1)
1615 if (
present(interval) )
then 1616 call dcdifftimecreate( &
1617 & interval_difftime, &
1618 & interval, time_unit_bycreate )
1620 call dcdifftimecreate( &
1621 & interval_difftime, &
1622 & 1.0, time_unit_bycreate )
1628 if (
present(origin) )
then 1629 call dcdifftimecreate( &
1630 & origin_difftime, &
1631 & origin, time_unit_bycreate )
1633 call dcdifftimecreate( &
1634 & origin_difftime, &
1635 & 0.0, time_unit_bycreate )
1638 if (
present(terminus) )
then 1639 call dcdifftimecreate( &
1640 & terminus_difftime, &
1641 & terminus, time_unit_bycreate )
1643 call dcdifftimecreate( &
1644 & terminus_difftime, &
1645 & -1.0, time_unit_bycreate )
1651 call historyautocreate( &
1652 & title = title, source = source, &
1653 & institution = institution, &
1654 & dims = dims, dimsizes = dimsizes, &
1655 & longnames = longnames, units = units, &
1656 & origin = origin_difftime, &
1657 & terminus = terminus_difftime, &
1658 & xtypes = xtypes, &
1659 & conventions = conventions, &
1660 & gt_version = gt_version, &
1661 & all_output = all_output, &
1662 & file_prefix = file_prefix, &
1663 & namelist_filename = namelist_filename, &
1664 & interval = interval_difftime, &
1665 & slice_start = slice_start, &
1666 & slice_end = slice_end, &
1667 & slice_stride = slice_stride, &
1668 & space_average = space_average, &
1669 & time_average = time_average, &
1670 & newfile_interval = newfile_interval, &
1672 & origin_date = origin_date, &
1673 & origin_date_invalid = origin_date_invalid, &
1674 & start_date = start_date, &
1676 & flag_mpi_gather = flag_mpi_gather, &
1677 & flag_mpi_split = flag_mpi_split )
1680 call storeerror(stat, subname, cause_c = cause_c)
1681 call endsub(subname)
1687 & title, source, institution, & ! (in)
1688 & dims, dimsizes, longnames, units, &
1689 & origin, terminus, &
1690 & xtypes, conventions, gt_version, &
1693 & namelist_filename, &
1695 & slice_start, slice_end, slice_stride, &
1698 & newfile_interval, &
1700 & origin_date, origin_date_invalid, &
1701 & start_date, cal, &
1702 & flag_mpi_gather, flag_mpi_split &
1754 use gtool_historyauto_internal
, only: initialized, version, sub_sname, &
1755 & zero_time, numdims, &
1756 & title_save, source_save, institution_save, conventions_save, &
1757 & gt_version_save, rank_save, save_mpi_split, save_mpi_gather, &
1758 & time_unit_bycreate, time_unit_suffix, gthst_axes, data_axes, &
1759 & all_output_save, gthstnml, cal_save
1760 use gtool_history, only: historyaxiscreate, historyaxisaddattr
1764 use dc_trace
, only: beginsub, endsub
1767 use netcdf
, only: nf90_emaxdims, nf90_max_dims
1768 use dc_string
, only: putline, printf, split, strinclude, stoa, joinchar
1769 use dc_present
, only: present_and_not_empty, present_and_true, &
1772 & dccaldateinquire, dccalinquire, dccaldefault, dccalconvertbyunit
1773 use dc_date, only: dcdifftimecreate, evalbyunit, tochar, tocharcal, eval
1775 use dc_message
, only: messagenotify
1779 character(*),
intent(in):: title
1782 character(*),
intent(in):: source
1785 character(*),
intent(in):: institution
1788 character(*),
intent(in):: dims(:)
1807 integer,
intent(in):: dimsizes (:)
1835 character(*),
intent(in):: longnames (:)
1855 character(*),
intent(in):: units(:)
1875 real(DP),
intent(in):: origin
1880 real(DP),
intent(in):: terminus
1885 character(*),
intent(in),
optional:: xtypes(:)
1915 character(*),
intent(in),
optional:: conventions
1934 character(*),
intent(in),
optional:: gt_version
1956 logical,
intent(in),
optional:: all_output
1992 character(*),
intent(in),
optional:: file_prefix
1995 character(*),
intent(in),
optional:: namelist_filename
2007 real(DP),
intent(in),
optional:: interval
2019 integer,
intent(in),
optional:: slice_start(:)
2029 integer,
intent(in),
optional:: slice_end(:)
2041 integer,
intent(in),
optional:: slice_stride(:)
2051 logical,
intent(in),
optional:: space_average(:)
2064 logical,
intent(in),
optional:: time_average
2069 integer,
intent(in),
optional:: newfile_interval
2080 character(*),
intent(in),
optional:: rank
2085 type(dc_datetime),
intent(in),
optional:: origin_date
2092 logical,
intent(in),
optional:: origin_date_invalid
2096 type(dc_cal_date),
intent(in),
optional:: start_date
2101 type(dc_cal),
intent(in),
optional:: cal
2110 logical,
intent(in),
optional:: flag_mpi_gather
2127 logical,
intent(in),
optional:: flag_mpi_split
2141 character(STRING):: Name
2158 character(STRING):: File
2173 character(TOKEN):: IntUnit
2176 character(TOKEN):: Precision
2192 character(STRING):: FilePrefix
2195 logical:: TimeAverage
2208 real(DP):: OriginValue
2211 character(TOKEN):: OriginUnit
2214 real(DP):: TerminusValue
2217 character(TOKEN):: TerminusUnit
2220 integer:: SliceStart(1:nf90_max_dims)
2223 integer:: SliceEnd(1:nf90_max_dims)
2235 integer:: SliceStride(1:nf90_max_dims)
2238 logical:: SpaceAverage(1:nf90_max_dims)
2241 integer:: NewFileIntValue
2244 character(TOKEN):: NewFileIntUnit
2248 namelist /gtool_historyauto_nml/ &
2250 & intvalue, intunit, &
2253 & timeaverage, alloutput, &
2254 & originvalue, originunit, &
2255 & terminusvalue, terminusunit, &
2256 & slicestart, sliceend, slicestride, spaceaverage, &
2257 & newfileintvalue, newfileintunit
2278 integer:: blank_index
2280 character(STRING):: cause_c
2283 integer:: iostat_nml
2285 character(TOKEN):: pos_nml
2289 character(TOKEN):: my_xtype
2291 real(DP):: interval_work, origin_work, terminus_work
2294 integer:: msnot_rank
2295 character(STRING):: date_str
2296 character(TOKEN):: cal_str, cal_type
2297 integer:: origin_year, origin_month, origin_day, origin_hour, origin_min
2298 real(DP):: origin_sec
2299 integer:: month_in_year, hour_in_day, min_in_hour
2300 integer,
pointer:: day_in_month(:) =>null()
2301 real(DP):: sec_in_min
2302 character(*),
parameter:: subname =
"HistoryAutoCreate1" 2304 call beginsub(subname, version = version)
2311 if ( initialized )
then 2313 cause_c =
'gtool_historyauto' 2328 numdims =
size(dims)
2330 if (
size(dimsizes) /= numdims )
then 2331 cause_c =
'dimsizes, dims' 2332 elseif (
size(longnames) /= numdims )
then 2333 cause_c =
'longnames, dims' 2334 elseif (
size(units) /= numdims )
then 2335 cause_c =
'units, dims' 2337 if ( trim(cause_c) /=
"" )
then 2342 if ( numdims > nf90_max_dims )
then 2343 stat = nf90_emaxdims
2350 if ( dimsizes(numdims) /= 0 )
then 2351 call messagenotify(
'W', subname, &
2352 &
'time dimension must be specified to the last of "dims"' )
2361 source_save = source
2362 institution_save = institution
2364 conventions_save =
'' 2365 if (
present(conventions) ) conventions_save = conventions
2367 gt_version_save =
'' 2368 if (
present(gt_version) ) gt_version_save = gt_version
2371 if (
present(rank) ) rank_save = rank
2376 save_mpi_split = present_and_true( flag_mpi_split )
2377 save_mpi_gather = present_and_true( flag_mpi_gather )
2380 if ( save_mpi_gather ) msnot_rank = 0
2385 time_unit_bycreate = units(numdims)
2386 time_unit_suffix =
'' 2387 blank_index = index( trim( adjustl(time_unit_bycreate) ),
' ' )
2388 if ( blank_index > 1 )
then 2389 time_unit_suffix = time_unit_bycreate(blank_index+1:)
2390 time_unit_bycreate = time_unit_bycreate(1:blank_index-1)
2398 if (
present(xtypes) )
then 2399 if (
size(xtypes) >= i )
then 2400 my_xtype = xtypes(i)
2404 call historyaxiscreate( &
2405 & axis = gthst_axes(i), &
2406 & name = dims(i),
size = dimsizes(i), &
2407 & longname = longnames(i), units = units(i), &
2408 & xtype = my_xtype )
2410 allocate( data_axes(i) % a_axis( dimsizes(i) ) )
2411 data_axes(i) % a_axis = (/ (
real( j, DP ), j = 1, dimsizes(i) ) /)
2418 if (
present(cal) )
then 2421 call dccaldefault( cal_save )
2427 if (
present(start_date) )
then 2429 call dccaldateinquire( &
2430 & date_str = date_str, &
2431 & date = start_date, &
2436 call dccaldateinquire( &
2437 & origin_year, origin_month, origin_day, &
2438 & origin_hour, origin_min, origin_sec, &
2439 & date = start_date, &
2443 call dccalinquire( &
2445 & month_in_year = month_in_year, &
2446 & day_in_month_ptr = day_in_month , &
2447 & hour_in_day = hour_in_day , &
2448 & min_in_hour = min_in_hour , &
2449 & sec_in_min = sec_in_min , &
2454 select case ( trim(cal_str) )
2455 case (
'gregorian' )
2456 time_unit_suffix = trim(time_unit_suffix) // &
2457 &
' since ' // trim(date_str)
2459 time_unit_suffix = trim(time_unit_suffix) // &
2460 &
' since ' // trim(date_str)
2462 time_unit_suffix = trim(time_unit_suffix) // &
2463 &
' since ' // trim(date_str)
2465 time_unit_suffix = trim(time_unit_suffix) // &
2466 &
' since ' // trim(date_str)
2468 time_unit_suffix = trim(time_unit_suffix) // &
2469 &
' since ' // trim(date_str)
2474 call historyaxisaddattr( &
2475 & axis = gthst_axes(numdims), &
2476 & attrname =
'origin', &
2477 &
value =
'origin_year origin_month origin_day ' // &
2478 &
'origin_hour origin_min origin_sec' )
2480 call historyaxisaddattr( gthst_axes(numdims),
'origin_year', origin_year )
2481 call historyaxisaddattr( gthst_axes(numdims),
'origin_month', origin_month )
2482 call historyaxisaddattr( gthst_axes(numdims),
'origin_day', origin_day )
2483 call historyaxisaddattr( gthst_axes(numdims),
'origin_hour', origin_hour )
2484 call historyaxisaddattr( gthst_axes(numdims),
'origin_min', origin_min )
2488 call historyaxisaddattr( &
2489 & axis = gthst_axes(numdims), &
2490 & attrname =
'calendar', &
2493 if ( trim(cal_str) ==
'user_defined' )
then 2494 call historyaxisaddattr( gthst_axes(numdims),
'month_in_year', month_in_year )
2495 call historyaxisaddattr( gthst_axes(numdims),
'day_in_month', day_in_month )
2496 call historyaxisaddattr( gthst_axes(numdims),
'hour_in_day', hour_in_day )
2497 call historyaxisaddattr( gthst_axes(numdims),
'min_in_hour', min_in_hour )
2498 call historyaxisaddattr( gthst_axes(numdims),
'sec_in_min', sec_in_min )
2501 deallocate( day_in_month )
2503 elseif (
present(origin_date) &
2504 & .and. .not. present_and_true(origin_date_invalid) )
then 2505 call eval( origin_date, &
2506 & day = date_day, sec = date_sec )
2507 if ( date_day /= 0 .or. date_sec /= 0.0 )
then 2508 time_unit_suffix = trim(time_unit_suffix) // &
2509 &
' since ' // tochar(origin_date)
2511 call historyaxisaddattr( &
2512 & axis = gthst_axes(numdims), &
2513 & attrname =
'calendar', &
2514 &
value = tocharcal(origin_date) )
2522 if (
present(all_output) ) all_output_save = all_output
2523 if ( .not. present_and_not_empty(namelist_filename) ) all_output_save = .true.
2524 alloutput = all_output_save
2529 if ( all_output_save )
then 2530 if (
present(interval) )
then 2531 interval_work = interval
2537 interval_work = - 1.0
2544 & dccalconvertbyunit( origin, time_unit_bycreate,
'sec', cal_save )
2545 terminus_work = terminus
2556 & gthstnml = gthstnml, &
2558 & precision =
'float', &
2559 & fileprefix = file_prefix, &
2560 & interval_value = interval_work, &
2561 & interval_unit = time_unit_bycreate, &
2562 & origin_value = origin_work, &
2563 & origin_unit =
'sec', &
2565 & terminus_value = terminus_work, &
2566 & terminus_unit = time_unit_bycreate, &
2567 & time_average = time_average, &
2568 & slice_start = slice_start, &
2569 & slice_end = slice_end, &
2570 & slice_stride = slice_stride, &
2571 & space_average = space_average, &
2572 & newfile_intvalue = newfile_interval, &
2573 & newfile_intunit = time_unit_bycreate )
2578 if ( present_and_not_empty(namelist_filename) )
then 2580 & namelist_filename, mode =
'r' )
2585 call messagenotify(
'M', sub_sname,
'----- "gtool_historyauto_nml" is loaded from "%c" -----', &
2586 & c1 = trim(namelist_filename), rank_mpi = msnot_rank )
2588 do while ( trim(pos_nml) /=
'APPEND' .and. iostat_nml == 0 )
2593 & gthstnml = gthstnml, &
2594 & interval_value = intvalue, &
2595 & interval_unit = intunit, &
2596 & precision = precision, &
2597 & time_average = timeaverage, &
2598 & origin_value = originvalue, &
2599 & origin_unit = originunit, &
2600 & terminus_value = terminusvalue, &
2601 & terminus_unit = terminusunit, &
2602 & slice_start = slicestart, &
2603 & slice_end = sliceend, &
2604 & slice_stride = slicestride, &
2605 & space_average = spaceaverage, &
2606 & newfile_intvalue = newfileintvalue, &
2607 & newfile_intunit = newfileintunit, &
2608 & fileprefix = fileprefix )
2610 read( unit = unit_nml, &
2611 & nml = gtool_historyauto_nml, &
2612 & iostat = iostat_nml )
2613 inquire( unit = unit_nml, &
2614 & position = pos_nml )
2616 if ( iostat_nml == 0 )
then 2621 if ( .not. intvalue > 0.0 )
then 2622 intvalue = interval_work
2623 intunit = time_unit_bycreate
2625 if ( .not. originvalue > 0.0 )
then 2626 originvalue = origin_work
2629 if ( .not. terminusvalue > 0.0 )
then 2630 terminusvalue = terminus_work
2631 terminusunit = time_unit_bycreate
2638 & gthstnml = gthstnml, &
2641 & interval_value = intvalue, &
2642 & interval_unit = intunit, &
2643 & precision = precision, &
2644 & time_average = timeaverage, &
2645 & origin_value = originvalue, &
2646 & origin_unit = originunit, &
2647 & terminus_value = terminusvalue, &
2648 & terminus_unit = terminusunit, &
2649 & slice_start = slicestart, &
2650 & slice_end = sliceend, &
2651 & slice_stride = slicestride, &
2652 & space_average = spaceaverage, &
2653 & newfile_intvalue = newfileintvalue, &
2654 & newfile_intunit = newfileintunit, &
2655 & fileprefix = fileprefix )
2660 if ( trim(name) ==
'' )
then 2661 all_output_save = alloutput
2666 if ( trim(file) ==
'' ) file = trim(fileprefix) //
'<Name>.nc' 2668 if ( trim(name) ==
'' )
then 2669 call messagenotify(
'M', sub_sname,
'Global Settings:', rank_mpi = msnot_rank )
2670 call messagenotify(
'M', sub_sname,
' AllOutput = %b', l = (/ alloutput /), rank_mpi = msnot_rank )
2671 call messagenotify(
'M', sub_sname,
' FilePrefix = %c', c1 = trim(fileprefix ), rank_mpi = msnot_rank )
2673 call messagenotify(
'M', sub_sname,
'Individual Settings:', rank_mpi = msnot_rank )
2674 call messagenotify(
'M', sub_sname,
' Name = %c', c1 = trim(name ), rank_mpi = msnot_rank )
2675 call messagenotify(
'M', sub_sname,
' File = %c', c1 = trim(file ), rank_mpi = msnot_rank )
2677 call messagenotify(
'M', sub_sname,
' Interval = %f [%c]', &
2678 & d = (/ intvalue /), c1 = trim( intunit ), rank_mpi = msnot_rank )
2679 call messagenotify(
'M', sub_sname,
' Precision = %c', c1 = trim(precision ), rank_mpi = msnot_rank )
2680 call messagenotify(
'M', sub_sname,
' TimeAverage = %b', l = (/ timeaverage /), rank_mpi = msnot_rank )
2681 call messagenotify(
'M', sub_sname,
' Origin = %f [%c]', &
2682 & d = (/ originvalue /), c1 = trim( originunit ), rank_mpi = msnot_rank )
2683 call messagenotify(
'M', sub_sname,
' Terminus = %f [%c]', &
2684 & d = (/ terminusvalue /), c1 = trim( terminusunit ), rank_mpi = msnot_rank )
2685 call messagenotify(
'M', sub_sname,
' SliceStart = (/ %*d /)', &
2686 & i = slicestart(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
2687 call messagenotify(
'M', sub_sname,
' SliceEnd = (/ %*d /)', &
2688 & i = sliceend(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
2689 call messagenotify(
'M', sub_sname,
' SliceStride = (/ %*d /)', &
2690 & i = slicestride(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
2691 call messagenotify(
'M', sub_sname,
' SpaceAverage = (/ %*b /)', &
2692 & l = spaceaverage(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
2693 call messagenotify(
'M', sub_sname,
' NewFileInterval = %d [%c]', &
2694 & i = (/ newfileintvalue /), c1 = trim( newfileintunit ), rank_mpi = msnot_rank )
2695 call messagenotify(
'M', sub_sname,
'', rank_mpi = msnot_rank )
2698 call messagenotify(
'M', sub_sname,
'----- loading is finished (iostat=%d) -----', &
2699 & i = (/iostat_nml/), rank_mpi = msnot_rank )
2710 call messagenotify(
'M', sub_sname,
'----- "gtool_historyauto_nml" is not loaded" -----', rank_mpi = msnot_rank )
2714 & gthstnml = gthstnml, &
2715 & interval_value = intvalue, &
2716 & interval_unit = intunit, &
2717 & precision = precision, &
2718 & time_average = timeaverage, &
2719 & origin_value = originvalue, &
2720 & origin_unit = originunit, &
2721 & terminus_value = terminusvalue, &
2722 & terminus_unit = terminusunit, &
2723 & slice_start = slicestart, &
2724 & slice_end = sliceend, &
2725 & slice_stride = slicestride, &
2726 & space_average = spaceaverage, &
2727 & newfile_intvalue = newfileintvalue, &
2728 & newfile_intunit = newfileintunit, &
2729 & fileprefix = fileprefix )
2733 call messagenotify(
'M', sub_sname,
'Global Settings:', rank_mpi = msnot_rank )
2734 call messagenotify(
'M', sub_sname,
' AllOutput = %b', l = (/ alloutput /), rank_mpi = msnot_rank )
2735 call messagenotify(
'M', sub_sname,
' FilePrefix = %c', c1 = trim(fileprefix ), rank_mpi = msnot_rank )
2736 call messagenotify(
'M', sub_sname,
' Interval = %f [%c]', &
2737 & d = (/ intvalue /), c1 = trim( intunit ), rank_mpi = msnot_rank )
2738 call messagenotify(
'M', sub_sname,
' Precision = %c', c1 = trim(precision ), rank_mpi = msnot_rank )
2739 call messagenotify(
'M', sub_sname,
' TimeAverage = %b', l = (/ timeaverage /), rank_mpi = msnot_rank )
2740 call messagenotify(
'M', sub_sname,
' Origin = %f [%c]', &
2741 & d = (/ originvalue /), c1 = trim( originunit ), rank_mpi = msnot_rank )
2742 call messagenotify(
'M', sub_sname,
' Terminus = %f [%c]', &
2743 & d = (/ terminusvalue /), c1 = trim( terminusunit ), rank_mpi = msnot_rank )
2744 call messagenotify(
'M', sub_sname,
' SliceStart = (/ %*d /)', &
2745 & i = slicestart(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
2746 call messagenotify(
'M', sub_sname,
' SliceEnd = (/ %*d /)', &
2747 & i = sliceend(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
2748 call messagenotify(
'M', sub_sname,
' SliceStride = (/ %*d /)', &
2749 & i = slicestride(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
2750 call messagenotify(
'M', sub_sname,
' SpaceAverage = (/ %*b /)', &
2751 & l = spaceaverage(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
2752 call messagenotify(
'M', sub_sname,
' NewFileInterval = %d [%c]', &
2753 & i = (/ newfileintvalue /), c1 = trim( newfileintunit ), rank_mpi = msnot_rank )
2754 call messagenotify(
'M', sub_sname,
'' , rank_mpi = msnot_rank)
2761 initialized = .true.
2764 call storeerror(stat, subname, cause_c = cause_c)
2765 call endsub(subname,
'stat=%d', i = (/stat/) )
subroutine historyautocreate1(title, source, institution, dims, dimsizes, longnames, units, origin, terminus, xtypes, conventions, gt_version, all_output, file_prefix, namelist_filename, interval, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval, rank, origin_date, origin_date_invalid, start_date, cal, flag_mpi_gather, flag_mpi_split)
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.
subroutine historyautocreate3(title, source, institution, dims, dimsizes, longnames, units, origin, terminus, xtypes, conventions, gt_version, all_output, file_prefix, namelist_filename, interval, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval, rank, origin_date, origin_date_invalid, start_date, cal, flag_mpi_gather, flag_mpi_split)
integer, parameter, public dc_ealreadyinit
subroutine historyautocreate2(title, source, institution, dims, dimsizes, longnames, units, xtypes, conventions, gt_version, all_output, file_prefix, namelist_filename, interval, origin, terminus, slice_start, slice_end, slice_stride, space_average, time_average, newfile_interval, rank, origin_date, origin_date_invalid, start_date, cal, flag_mpi_gather, flag_mpi_split)
integer, parameter, public dc_enegative
integer, parameter, public string
Character length for string.