diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 8b1e9c3de350..467e64ea8ce6 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -30,7 +30,7 @@ jobs: OMPI_MCA_btl_vader_single_copy_mechanism: none steps: - name: Cancel Previous Runs - uses: styfle/cancel-workflow-action@0.11.0 + uses: styfle/cancel-workflow-action@0.12.0 with: access_token: ${{ github.token }} - name: Checkout @@ -86,7 +86,7 @@ jobs: #password: ${{ secrets.DOCKERHUB_TOKEN }} steps: - name: Cancel Previous Runs - uses: styfle/cancel-workflow-action@0.11.0 + uses: styfle/cancel-workflow-action@0.12.0 with: access_token: ${{ github.token }} - name: Checkout diff --git a/CHANGELOG.md b/CHANGELOG.md index 9818a446b6f3..662295da8f90 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,9 +14,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Non-support for `ierror` keyword arguments with `use mpi` ((MPICH Issue #6693)[https://github.com/pmodels/mpich/issues/6693]) ### Changed - - Modified fpp macro `_UNUSED_DUMMY(x) to use ASSOCIATE instead of PRINT. With this change it can be used in PURE procedures. - Make error handling in Plain_netCDF_Time consistent with MAPL standard error handling +- Updated handling of NetCDF time values ### Fixed @@ -158,6 +158,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Suppress some common warnings with Intel Debug - Make the GEOSadas CI build separate as it often fails due to race conditions in GSI - Update CI to use BCs v11.1.0 and Baselibs 7.14.0 +- Update MAPL_NetCDF public subroutine returns and support for real time - Updates to support building MAPL with spack instead of Baselibs - Add `FindESMF.cmake` file to `cmake` directory (as it can't easily be found via spack) - Move `CMAKE_MODULE_PATH` append statement up to find `FindESMF.cmake` before we `find_package(ESMF)` diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index 95edd9be0d81..a08dacd1250a 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -55,6 +55,7 @@ set (srcs MAPL_Resource.F90 MAPL_XYGridFactory.F90 MAPL_NetCDF.F90 Plain_netCDF_Time.F90 + MAPL_DateTime_Parsing_ESMF.F90 # Orphaned program: should not be in this library. # tstqsat.F90 ) diff --git a/base/MAPL_DateTime_Parsing_ESMF.F90 b/base/MAPL_DateTime_Parsing_ESMF.F90 new file mode 100644 index 000000000000..5491b6702159 --- /dev/null +++ b/base/MAPL_DateTime_Parsing_ESMF.F90 @@ -0,0 +1,75 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_DateTime_Parsing_ESMF + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_DateTime_Parsing + use ESMF + + implicit none + + public :: set_ESMF_TimeInterval, set_ESMF_Time_from_ISO8601 + + interface set_ESMF_TimeInterval + module procedure :: set_ESMF_TimeInterval_from_datetime_duration + end interface set_ESMF_TimeInterval + +contains + + subroutine set_ESMF_TimeInterval_from_datetime_duration(interval, duration, rc) + type(ESMF_TimeInterval), intent(inout) :: interval + class(datetime_duration), intent(in) :: duration + integer, optional, intent(out) :: rc + integer :: status + + ! Get duration(s) from datetime_duration + + ! Set ESMF_TimeInterval + + if(duration % year_is_set()) then + call ESMF_TimeIntervalSet(interval, yy = duration % year, _RC) + end if + + if(duration % month_is_set()) then + call ESMF_TimeIntervalSet(interval, yy = duration % month, _RC) + end if + + if(duration % day_is_set()) then + call ESMF_TimeIntervalSet(interval, yy = duration % day, _RC) + end if + + if(duration % hour_is_real()) then + call ESMF_TimeIntervalSet(interval, h_r8 = duration % hour_real, _RC) + else if(duration % hour_is_set()) then + call ESMF_TimeIntervalSet(interval, h = duration % hour, _RC) + end if + + if(duration % minute_is_real()) then + call ESMF_TimeIntervalSet(interval, m_r8 = duration % minute_real, _RC) + else if(duration % minute_is_set()) then + call ESMF_TimeIntervalSet(interval, m = duration % minute, _RC) + end if + + if(duration % second_is_real()) then + call ESMF_TimeIntervalSet(interval, s_r8 = duration % second_real, _RC) + else if(duration % second_is_set()) then + call ESMF_TimeIntervalSet(interval, s = duration % second, _RC) + end if + + _RETURN(_SUCCESS) + + end subroutine set_ESMF_TimeInterval_from_datetime_duration + + subroutine set_ESMF_Time_from_ISO8601(time, isostring, rc) + type(ESMF_Time), intent(inout) :: time + character(len=*), intent(in) :: isostring + integer, optional, intent(out) :: rc + integer :: status + + call ESMF_TimeSet(time, isostring, _RC) + + _RETURN(_SUCCESS) + + end subroutine set_ESMF_Time_from_ISO8601 + +end module MAPL_DateTime_Parsing_ESMF diff --git a/base/MAPL_ISO8601_DateTime_ESMF.F90 b/base/MAPL_ISO8601_DateTime_ESMF.F90 index 11e91b0d97e0..891147caf030 100644 --- a/base/MAPL_ISO8601_DateTime_ESMF.F90 +++ b/base/MAPL_ISO8601_DateTime_ESMF.F90 @@ -7,6 +7,7 @@ module MAPL_ISO8601_DateTime_ESMF use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling use MAPL_ISO8601_DateTime + use MAPL_DateTime_Parsing use ESMF implicit none diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 773a297cd2b8..93adc5c2400c 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -1,8 +1,3 @@ -!wdb todo -!subroutine to convert -!From: integer: array(2) = [ 20010101 010101 (HHMMSS) ] ![ (YYYYMMDD) (HHMMSS) ] -!To: !ESMF_TIME: with gregorian calendar -!And vice versa. #include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" ! Procedures to convert from NetCDF datetime to ESMF_Time and ESMF_TimeInterval @@ -13,412 +8,119 @@ module MAPL_NetCDF use MAPL_ExceptionHandling use MAPL_KeywordEnforcerMod - use MAPL_DateTime_Parsing - use ESMF + use MAPL_DateTime_Parsing, only: datetime_duration + use MAPL_DateTime_Parsing_ESMF + use MAPL_CF_Time implicit none public :: convert_NetCDF_DateTime_to_ESMF - public :: convert_ESMF_to_NetCDF_DateTime + public :: get_ESMF_Time_from_NetCDF_DateTime private - public :: make_ESMF_TimeInterval - public :: make_NetCDF_DateTime_int_time - public :: make_NetCDF_DateTime_units_string - public :: convert_ESMF_Time_to_NetCDF_DateTimeString - public :: convert_to_integer - public :: convert_NetCDF_DateTimeString_to_ESMF_Time - public :: is_time_unit - public :: is_valid_netcdf_datetime_string - public :: get_shift_sign - public :: split - public :: split_all - public :: lr_trim - character, parameter :: PART_DELIM = ' ' - character, parameter :: ISO_DELIM = 'T' - character, parameter :: DATE_DELIM = '-' - character, parameter :: TIME_DELIM = ':' - character(len=*), parameter :: NETCDF_DATE = '0000' // DATE_DELIM // '00' // DATE_DELIM // '00' - character(len=*), parameter :: NETCDF_TIME = '00' // TIME_DELIM // '00' // TIME_DELIM // '00' - character(len=*), parameter :: NETCDF_DATETIME_FORMAT = NETCDF_DATE // PART_DELIM // NETCDF_TIME - integer, parameter :: LEN_DATE = len(NETCDF_DATE) - integer, parameter :: LEN_TIME = len(NETCDF_TIME) - integer, parameter :: LEN_NETCDF_DATETIME = len(NETCDF_DATETIME_FORMAT) - character(len=*), parameter :: TIME_UNITS(7) = & - [ 'years ', 'months ', 'days ', & - 'hours ', 'minutes ', 'seconds ', 'milliseconds' ] - character, parameter :: SPACE = ' ' - type(ESMF_CalKind_Flag), parameter :: CALKIND_FLAG = ESMF_CALKIND_GREGORIAN - integer, parameter :: MAX_WIDTH = 10 + interface convert_NetCDF_DateTime_to_ESMF + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_integer + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_real + end interface convert_NetCDF_DateTime_to_ESMF + + interface get_ESMF_Time_from_NetCDF_DateTime + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_integer + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_real + end interface get_ESMF_Time_from_NetCDF_DateTime + +! integer, parameter :: MAX_CHARACTER_LENGTH = 64 contains +!=============================================================================== +!========================= HIGH-LEVEL PROCEDURES =========================== + ! Convert NetCDF_DateTime {int_time, units_string} to - ! ESMF time variables {interval, time0, time1} and time unit {tunit} - ! time0 is the start time, and time1 is time0 + interval - subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & - interval, time0, unusable, time1, tunit, rc) - integer, intent(in) :: int_time + ! ESMF time variables {interval, basetime, time} and time unit {time_unit} + ! basetime is the start time, and time is basetime + interval + subroutine get_ESMF_Time_from_NetCDF_DateTime_integer(duration, units_string, & + interval, basetime, unusable, time, time_unit, rc) + integer, intent(in) :: duration character(len=*), intent(in) :: units_string type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: time0 + type(ESMF_Time), intent(inout) :: basetime class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), optional, intent(inout) :: time1 - character(len=:), allocatable, optional, intent(out) :: tunit + type(ESMF_Time), optional, intent(inout) :: time + character(len=:), allocatable, optional, intent(out) :: time_unit integer, optional, intent(out) :: rc - character(len=:), allocatable :: tunit_ - character(len=len_trim(units_string)) :: parts(2) - character(len=len_trim(units_string)) :: head - character(len=len_trim(units_string)) :: tail - - integer :: span, factor - integer :: status - - _UNUSED_DUMMY(unusable) - - _ASSERT(int_time >= 0, 'Negative span not supported') - _ASSERT((len(lr_trim(units_string)) > 0), 'units empty') - - ! get time unit, tunit - parts = split(lr_trim(units_string), PART_DELIM) - head = parts(1) - tail = parts(2) - tunit_ = lr_trim(head) - _ASSERT(is_time_unit(tunit_), 'Unrecognized time unit') - if(present(tunit)) tunit = tunit_ - - ! get span - parts = split(lr_trim(tail), PART_DELIM) - head = parts(1) - tail = parts(2) - - factor = get_shift_sign(head) - _ASSERT(factor /= 0, 'Unrecognized preposition') - span = factor * int_time - call convert_NetCDF_DateTimeString_to_ESMF_Time(lr_trim(tail), time0, _RC) - call make_ESMF_TimeInterval(span, tunit_, time0, interval, _RC) - - ! get time1 - if(present(time1)) time1 = time0 + interval - - _RETURN(_SUCCESS) - - end subroutine convert_NetCDF_DateTime_to_ESMF - - ! Convert ESMF time variables to an NetCDF datetime - subroutine convert_ESMF_to_NetCDF_DateTime(tunit, t0, int_time, units_string, unusable, t1, interval, rc) - character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: t0 - integer, intent(out) :: int_time - character(len=:), allocatable, intent(out) :: units_string - class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), optional, intent(inout) :: t1 - type(ESMF_TimeInterval), optional, intent(inout) :: interval - integer, optional, intent(out) :: rc - type(ESMF_TimeInterval) :: interval_ + type(CF_Time_Integer) :: cft + type(datetime_duration) :: dt_duration + character(len=MAX_CHARACTER_LENGTH) :: isostring + character(len=MAX_CHARACTER_LENGTH) :: tunit_ integer :: status - + _UNUSED_DUMMY(unusable) - if(present(interval)) then - interval_ = interval - elseif(present(t1)) then - interval_ = t1 - t0 - else - _FAIL( 'Only one input argument present') - end if + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units empty') - call make_NetCDF_DateTime_int_time(interval_, t0, tunit, int_time, _RC) - call make_NetCDF_DateTime_units_string(t0, tunit, units_string, _RC) + cft = CF_Time_Integer(duration, units_string) + call convert_CF_Time_to_datetime_duration(cft, dt_duration, _RC) + call set_ESMF_TimeInterval(interval, dt_duration, _RC) - _RETURN(_SUCCESS) - - end subroutine convert_ESMF_to_NetCDF_DateTime + call extract_ISO8601_from_CF_Time(cft, isostring, _RC) + call set_ESMF_Time_from_ISO8601(basetime, isostring, _RC) - ! Make ESMF_TimeInterval from a span of time, time unit, and start time - subroutine make_ESMF_TimeInterval(span, tunit, t0, interval, unusable, rc) - integer, intent(in) :: span - character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: t0 - type(ESMF_TimeInterval), intent(inout) :: interval - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) + if(present(time)) time = basetime + interval - select case(lr_trim(tunit)) - case('years') - call ESMF_TimeIntervalSet(interval, startTime=t0, yy=span, _RC) - case('months') - call ESMF_TimeIntervalSet(interval, startTime=t0, mm=span, _RC) - case('hours') - call ESMF_TimeIntervalSet(interval, startTime=t0, h=span, _RC) - case('minutes') - call ESMF_TimeIntervalSet(interval, startTime=t0, m=span, _RC) - case('seconds') - call ESMF_TimeIntervalSet(interval, startTime=t0, s=span, _RC) - case default - _FAIL('Unrecognized unit') - end select + if(present(time_unit)) then + call extract_CF_Time_unit(cft, tunit_, _RC) + time_unit = trim(tunit_) + end if _RETURN(_SUCCESS) - end subroutine make_ESMF_TimeInterval + end subroutine get_ESMF_Time_from_NetCDF_DateTime_integer - ! Get time span from NetCDF datetime - subroutine make_NetCDF_DateTime_int_time(interval, t0, tunit, int_time, unusable, rc) + ! Convert NetCDF_DateTime {real_time, units_string} to + ! ESMF time variables {interval, basetime, time} and time unit {time_unit} + ! basetime is the start time, and time is basetime + interval + subroutine get_ESMF_Time_from_NetCDF_DateTime_real(duration, units_string, & + interval, basetime, unusable, time, time_unit, rc) + real(kind=ESMF_KIND_R8), intent(in) :: duration + character(len=*), intent(in) :: units_string type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: t0 - character(len=*), intent(in) :: tunit - integer, intent(out) :: int_time + type(ESMF_Time), intent(inout) :: basetime class (KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), optional, intent(inout) :: time + character(len=:), allocatable, optional, intent(out) :: time_unit integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - ! get int_time - select case(lr_trim(tunit)) - case('years') - call ESMF_TimeIntervalGet(interval, t0, yy=int_time, _RC) - case('months') - call ESMF_TimeIntervalGet(interval, t0, mm=int_time, _RC) - case('hours') - call ESMF_TimeIntervalGet(interval, t0, h=int_time, _RC) - case('minutes') - call ESMF_TimeIntervalGet(interval, t0, m=int_time, _RC) - case('seconds') - call ESMF_TimeIntervalGet(interval, t0, s=int_time, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_NetCDF_DateTime_int_time - ! Make 'units' for NetCDF datetime - subroutine make_NetCDF_DateTime_units_string(t0, tunit, units_string, unusable, rc) - type(ESMF_Time), intent(inout) :: t0 - character(len=*), intent(in) :: tunit - character(len=:), allocatable, intent(out) :: units_string - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - character(len=*), parameter :: preposition = 'since' - character(len=:), allocatable :: datetime_string + type(CF_Time_Real) :: cft + type(datetime_duration) :: dt_duration + character(len=MAX_CHARACTER_LENGTH) :: isostring + character(len=MAX_CHARACTER_LENGTH) :: tunit_ integer :: status _UNUSED_DUMMY(unusable) - ! make units_string - call convert_ESMF_Time_to_NetCDF_DateTimeString(t0, datetime_string, _RC) - units_string = tunit //SPACE// preposition //SPACE// datetime_string + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units empty') - _RETURN(_SUCCESS) + cft = CF_Time_Real(duration, units_string) + call convert_CF_Time_to_datetime_duration(cft, dt_duration, _RC) + call set_ESMF_TimeInterval(interval, dt_duration, _RC) - end subroutine make_NetCDF_DateTime_units_string + call extract_ISO8601_from_CF_Time(cft, isostring, _RC) + call set_ESMF_Time_from_ISO8601(basetime, isostring, _RC) - ! Convert ESMF_Time to a NetCDF datetime string (start datetime) - subroutine convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, datetime_string, unusable, rc) - type(ESMF_Time), intent(inout) :: esmf_datetime - character(len=:), allocatable, intent(out) :: datetime_string - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - character(len=*), parameter :: ERR_PRE = 'Failed to write string: ' - integer :: yy, mm, dd, h, m, s - character(len=10) :: FMT - character(len=4) :: yy_string - character(len=2) :: mm_string - character(len=2) :: dd_string - character(len=2) :: h_string - character(len=2) :: m_string - character(len=2) :: s_string - character(len=LEN_NETCDF_DATETIME) :: tmp_string - integer :: status, iostatus + if(present(time)) time = basetime + interval - _UNUSED_DUMMY(unusable) - - call ESMF_TimeGet(esmf_datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - - FMT='(BZ, I2.2)' - write(s_string, fmt=FMT, iostat=iostatus) s - _ASSERT(iostatus == 0, ERR_PRE // 'second') - write(m_string, fmt=FMT, iostat=iostatus) m - _ASSERT(iostatus == 0, ERR_PRE // 'minute') - write(h_string, fmt=FMT, iostat=iostatus) h - _ASSERT(iostatus == 0, ERR_PRE // 'hour') - write(dd_string, fmt=FMT, iostat=iostatus) dd - _ASSERT(iostatus == 0, ERR_PRE // 'day') - write(mm_string, fmt=FMT, iostat=iostatus) mm - _ASSERT(iostatus == 0, ERR_PRE // 'month') - FMT='(BZ, I4.4)' - write(yy_string, fmt=FMT, iostat=iostatus) yy - _ASSERT(iostatus == 0, ERR_PRE // 'year') - - tmp_string = yy_string // DATE_DELIM // mm_string // DATE_DELIM // dd_string // PART_DELIM // & - h_string // TIME_DELIM // m_string // TIME_DELIM // s_string - - datetime_string = tmp_string - - _RETURN(_SUCCESS) - - end subroutine convert_ESMF_Time_to_NetCDF_DateTimeString - - ! Convert string representing an integer to the integer - subroutine convert_to_integer(string_in, int_out, rc) - character(len=*), intent(in) :: string_in - integer, intent(out) :: int_out - integer, optional, intent(out) :: rc - integer :: stat - - read(string_in, '(I16)', iostat=stat) int_out - - if(present(rc)) rc = stat - - end subroutine convert_to_integer - - ! Convert NetCDF datetime to ESMF_Time - subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, unusable, rc) - character(len=*), intent(in) :: datetime_string - type(ESMF_Time), intent(inout) :: datetime - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - integer :: yy, mm, dd, h, m, s, i, j - character(len=4) :: part - - _UNUSED_DUMMY(unusable) - - _ASSERT(is_valid_netcdf_datetime_string(datetime_string), 'Invalid datetime string') - - i = 1 - j = i + 3 - part = datetime_string(i:j) - call convert_to_integer(part, yy, rc = status) - _ASSERT(status == 0, 'Unable to convert year string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, mm, rc = status) - _ASSERT(status == 0, 'Unable to convert month string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, dd, rc = status) - _ASSERT(status == 0, 'Unable to convert day string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, h, rc = status) - _ASSERT(status == 0, 'Unable to convert hour string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, m, rc = status) - _ASSERT(status == 0, 'Unable to convert minute string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, s, rc = status) - _ASSERT(status == 0, 'Unable to convert second string') - call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) - call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) + if(present(time_unit)) then + call extract_CF_Time_unit(cft, tunit_, _RC) + time_unit = trim(tunit_) + end if _RETURN(_SUCCESS) - end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time - - function is_valid_netcdf_datetime_string(string) result(tval) - character(len=*), parameter :: DIGITS = '0123456789' - character(len=*), intent(in) :: string - logical :: tval - integer :: i - - tval = .false. - - if(len(string) /= len(NETCDF_DATETIME_FORMAT)) return - - do i=1, len(string) - if(scan(NETCDF_DATETIME_FORMAT(i:i), DIGITS) > 0) then - if(scan(string(i:i), DIGITS) <= 0) return - else - if(string(i:i) /= NETCDF_DATETIME_FORMAT(i:i)) return - end if - end do - - tval = .true. - - end function is_valid_netcdf_datetime_string - - function is_time_unit(tunit) - character(len=*), intent(in) :: tunit - logical :: is_time_unit - integer :: i - - is_time_unit = .TRUE. - do i = 1, size(TIME_UNITS) - if(lr_trim(tunit) == lr_trim(TIME_UNITS(i))) return - end do - is_time_unit = .FALSE. - - end function is_time_unit - - function lr_trim(string) - character(len=*), intent(in) :: string - character(len=:), allocatable :: lr_trim - - lr_trim = trim(adjustl(string)) - - end function lr_trim - - ! Get the sign of integer represening a time span based on preposition - function get_shift_sign(preposition) - character(len=*), intent(in) :: preposition - integer :: get_shift_sign - integer, parameter :: POSITIVE = 1 - get_shift_sign = 0 - if(lr_trim(preposition) == 'since') get_shift_sign = POSITIVE - end function get_shift_sign - - ! Split string at delimiter - function split(string, delimiter) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: delimiter - character(len=len(string)) :: split(2) - integer start - - split = ['', ''] - split(1) = string - start = index(string, delimiter) - if(start < 1) return - split(1) = string(1:(start - 1)) - split(2) = string((start+len(delimiter)):len(string)) - end function split - - ! Split string into all substrings based on delimiter - recursive function split_all(string, delimiter) result(parts) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: delimiter - character(len=:), allocatable :: parts(:) - integer :: start - - start = index(string, delimiter) - - if(start == 0) then - parts = [string] - else - parts = [string(1:(start-1)), split_all(string((start+len(delimiter)):len(string)), delimiter)] - end if + end subroutine get_ESMF_Time_from_NetCDF_DateTime_real - end function split_all +!======================= END HIGH-LEVEL PROCEDURES ========================= +!=============================================================================== end module MAPL_NetCDF diff --git a/base/Plain_netCDF_Time.F90 b/base/Plain_netCDF_Time.F90 index a13b97c0683b..85ff1507b407 100644 --- a/base/Plain_netCDF_Time.F90 +++ b/base/Plain_netCDF_Time.F90 @@ -217,7 +217,6 @@ subroutine get_v1d_netcdf_R8(filename, name, array, Xdim, group_name, rc) integer, optional, intent(out) :: rc integer :: status integer :: ncid, varid, ncid2 - integer :: iret call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) if(present(group_name)) then diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index e1d34f91927b..46577909e502 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -17,6 +17,7 @@ set (TEST_SRCS test_MAPL_NetCDF.pf Test_MAPL_Resource.pf # test_MAPL_ISO8601_DateTime_ESMF.pf +# test_MAPL_DateTime_Parsing_ESMF.pf ) # SRCS are mostly mocks to facilitate tests diff --git a/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf b/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf new file mode 100644 index 000000000000..84032689f55e --- /dev/null +++ b/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf @@ -0,0 +1,59 @@ +#include "MAPL_Exceptions.h" +!=============================================================================== +! TEST_MAPL_DATETIMEPARSING_ESMF +!=============================================================================== +module test_MAPL_DateTime_Parsing_ESMF + use MAPL_DateTime_Parsing + use MAPL_DateTime_Parsing_ESMF + use MAPL_CF_Time + use ESMF + use, intrinsic :: iso_fortran_env, only: R64 => real64, R32 => real32 + + implicit none + + integer, parameter :: SUCCESS = _SUCCESS !wdb deleteme + +contains + + @test + subroutine test_set_ESMF_TimeInterval_integer() + integer :: duration = 1800, actual + type(datetime_duration) :: dt_dur + character(len=*), parameter :: units = 'seconds since 1999-12-31 23:29:59' + type(ESMF_TimeInterval) :: interval + integer :: status + + call convert_CF_Time_to_datetime_duration(duration, units, dt_dur, rc = status) + @assertEqual(_SUCCESS, status, 'Conversion unsuccessful') + + end subroutine test_set_ESMF_TimeInterval_integer + + @test + subroutine test_set_ESMF_TimeInterval_real() + real(R64) :: duration = 1800.0, actual + type(datetime_duration) :: dt_dur + character(len=*), parameter :: units = 'seconds since 1999-12-31 23:29:59' + type(ESMF_TimeInterval) :: interval + integer :: status + + call convert_CF_Time_to_datetime_duration(duration, units, dt_dur, rc = status) + @assertEqual(_SUCCESS, status, 'Conversion unsuccessful') + + end subroutine test_set_ESMF_TimeInterval_real + + @test + subroutine test_ESMF_Time_from_ISO8601() + character(len=*), parameter :: isostring = '1999-12-31T23:29:59' + character(len=len(isostring)) :: actual + type(ESMF_Time) :: time + integer :: status + + call set_ESMF_Time_from_ISO8601(time, isostring, rc = status) + @assertTrue(status == _SUCCESS, 'Failed to set ESMF_Time') + call ESMF_TimeGet(time, timeStringISOFrac = actual, rc = status) + @assertTrue(status == _SUCCESS, 'Failed to get isostring') + @assertEqual(isostring, actual, 'ISO8601 strings do not match.') + + end subroutine test_ESMF_Time_from_ISO8601 + +end module test_MAPL_DateTime_Parsing_ESMF diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index db929d3348cc..82b85029c50c 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -1,6 +1,10 @@ #include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" +!=============================================================================== +! TEST_MAPL_NETCDF +!=============================================================================== module test_MAPL_NetCDF + use MAPL_ExceptionHandling use MAPL_NetCDF use ESMF @@ -9,6 +13,7 @@ module test_MAPL_NetCDF implicit none type(ESMF_CalKind_Flag), parameter :: CALKIND_FLAG_DEF = ESMF_CALKIND_GREGORIAN + integer, parameter :: SECONDS_PER_MINUTE = 60 contains @@ -17,260 +22,133 @@ contains integer :: status call ESMF_CalendarSetDefault(CALKIND_FLAG_DEF, rc=status) - if(status /= 0) write(*, *) 'Failed to set ESMF_Calendar' + if(status /= _SUCCESS) write(*, *) 'Failed to set ESMF_Calendar' end subroutine set_up - @Test - subroutine test_convert_NetCDF_DateTime_to_ESMF() - character(len=*), parameter :: expected_tunit = 'seconds' - integer, parameter :: int_time = 1800 - character(len=*), parameter :: units_string = expected_tunit // ' since 2012-08-26 12:36:37' - character(len=*), parameter :: t0_iso_string = '2012-08-26T12:36:37' - character(len=*), parameter :: t1_iso_string = '2012-08-26T13:06:37' - type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: expected_time0 - type(ESMF_Time) :: expected_time1 - - type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: time0 - type(ESMF_Time) :: time1 - character(len=:), allocatable :: tunit - integer :: rc, status - - call ESMF_TimeSet(expected_time0, timeString=t0_iso_string, _RC) - call ESMF_TimeSet(expected_time1, timeString=t1_iso_string, _RC) - call ESMF_TimeIntervalSet(expected_interval, startTime=expected_time0, s=int_time, _RC) - - call convert_NetCDF_DateTime_to_ESMF(int_time, units_string, interval, time0, time1=time1, tunit=tunit, _RC) - @assertTrue(expected_time0 == time0, 'Mismatch for time0') - @assertTrue(expected_time1 == time1, 'Mismatch for time1') - @assertTrue(expected_interval == interval, 'Mismatch for interval') - - end subroutine test_convert_NetCDF_DateTime_to_ESMF - - @Test - subroutine test_convert_ESMF_to_NetCDF_DateTime() - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: t0_iso_string = '2013-08-26T12:34:56' - type(ESMF_Time) :: t0 - character(len=*), parameter :: t1_iso_string = '2013-08-26T13:04:56' - type(ESMF_Time) :: t1 - type(ESMF_TimeInterval) :: interval - integer, parameter :: span = 1800 - character(len=*), parameter :: expected_units_string = tunit // ' since 2013-08-26 12:34:56' - integer, parameter :: expected_int_time = span - integer :: int_time - character(len=:), allocatable :: units_string - integer :: rc, status - - call ESMF_TimeSet(t0, t0_iso_string, _RC) - call ESMF_TimeSet(t1, t1_iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=t0, s=span, _RC) - - call convert_ESMF_to_NetCDF_DateTime(tunit, t0, int_time, units_string, t1=t1, _RC) - @assertEqual(expected_int_time, int_time, 'Using t1, expected_int_time /= int_time') - @assertEqual(expected_units_string, units_string, 'Using t1, expected_units_strin g/= units_string') + logical function rational_equals(na, nb) + integer, intent(in) :: na(2) + integer, intent(in) :: nb(2) - call convert_ESMF_to_NetCDF_DateTime(tunit, t0, int_time, units_string, interval=interval, _RC) - @assertEqual(expected_int_time, int_time, 'Using interval, expected_int_time /= int_time') - @assertEqual(expected_units_string, units_string, 'Using interval, expected_units_strin g/= units_string') - - end subroutine test_convert_ESMF_to_NetCDF_DateTime - - @Test - subroutine test_make_ESMF_TimeInterval() - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - integer, parameter :: span = 1800 - type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: t0 - type(ESMF_TimeInterval) :: interval - integer :: rc, status + rational_equals = ( na(1) * nb(2) == na(2) * nb(1) ) - call ESMF_TimeSet(t0, iso_string, _RC) - call ESMF_TimeIntervalSet(expected_interval, startTime=t0, s=span, _RC) - call make_ESMF_TimeInterval(span, tunit, t0, interval, _RC) - @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') + end function rational_equals - end subroutine test_make_ESMF_TimeInterval - - @Test - subroutine test_make_NetCDF_DateTime_int_time() - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: t0 - integer, parameter :: expected_int_time = 1800 - integer :: int_time - integer :: status, rc - - call ESMF_TimeSet(t0, iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=t0, s=expected_int_time, _RC) - - call make_NetCDF_DateTime_int_time(interval, t0, tunit, int_time, _RC) - @assertEqual(expected_int_time, int_time, 'int_time does not match.') + function ESMF_Times_Equal(timeu, timev) result(tval) + type(ESMF_Time), intent(in) :: timeu, timev + logical :: tval + integer :: uyy, umm, udd, uh, um, us, usN, usD + integer :: vyy, vmm, vdd, vh, vm, vs, vsN, vsD + integer :: status - end subroutine test_make_NetCDF_DateTime_int_time + tval = .FALSE. + call ESMF_TimeGet(timeu, yy=uyy, mm=umm, dd=udd, h=uh, m=um, d=us, sN=usN, sD=usD, rc = status) + if(status /= _SUCCESS) return + call ESMF_TimeGet(timev, yy=vyy, mm=vmm, dd=vdd, h=vh, m=vm, d=vs, sN=vsN, sD=vsD, rc = status) + if(status /= _SUCCESS) return - @Test - subroutine test_make_NetCDF_DateTime_units_string() - type(ESMF_Time) :: t0 - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: expected = tunit // ' since 2012-08-26 08:36:37' - character(len=:), allocatable :: actual - integer :: status, rc + tval = ( (uyy == vyy) .and. (umm == vmm) .and. (udd == vdd) & + .and. (uh == vh) .and. (um == vm) .and. (us == vs) & + .and. rational_equals([usN, usD], [vsN, vsD]) ) - call ESMF_TimeSet(t0, yy=2012, mm=08, dd=26, h=08, m=36, s=37, _RC) - call make_NetCDF_DateTime_units_string(t0, tunit, actual, _RC) - @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) - end subroutine test_make_NetCDF_DateTime_units_string + end function ESMF_Times_Equal @Test - subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString() - type(ESMF_Time) :: esmf_datetime - character(len=*), parameter :: expected = '2022-08-26 07:30:37' - integer, parameter :: yy = 2022 - integer, parameter :: mm = 08 - integer, parameter :: dd = 26 - integer, parameter :: h = 07 - integer, parameter :: m = 30 - integer, parameter :: s = 37 - character(len=:), allocatable :: actual - integer :: status, rc + subroutine test_convert_NetCDF_DateTime_to_ESMF_integer() + integer :: duration + integer :: yy, mm, dd, h, m, s, m_time + character(len=*), parameter :: UNITS = 'seconds' + character(len=*), parameter :: NOT_EQUAL = ' /= ' + character(len=:), allocatable :: tunit, units_string + type(ESMF_Time) :: time, etime, btime, ebtime + type(ESMF_TimeInterval) :: time_interval + character(len=ESMF_MAXSTR) :: expected_base_datetime_string + character(len=ESMF_MAXSTR) :: expected_datetime_string + character(len=ESMF_MAXSTR) :: actual_base_datetime_string + character(len=ESMF_MAXSTR) :: actual_datetime_string + character(len=:), allocatable :: msg_time, msg_base_time, msg_tunit + integer :: status - call ESMF_TimeSet(esmf_datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - call convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, actual, _RC) - @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) - end subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString + yy = 1999 + mm = 12 + dd = 31 + h = 23 + m = 29 + m_time = 59 + s = 59 + duration = ( m_time - m ) * SECONDS_PER_MINUTE + units_string = UNITS // ' since 1999-12-31 23:29:59' + + call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) + @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') + call ESMF_TimeGet(etime, timeString = expected_datetime_string, rc=status) + + call ESMF_TimeSet(ebtime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) + @assertTrue(status == _SUCCESS, 'Unable to create expected base ESMF_Time') + call ESMF_TimeGet(ebtime, timeString = expected_base_datetime_string, rc=status) + + call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & + time = time, time_unit = tunit, rc = status) + @assertTrue(status == _SUCCESS, 'Conversion failed') + call ESMF_TimeGet(btime, timeString = actual_base_datetime_string, rc=status) + call ESMF_TimeGet(time, timeString = actual_datetime_string, rc=status) + msg_time = trim(actual_datetime_string) // NOT_EQUAL // trim(expected_datetime_string) + msg_base_time = trim(actual_base_datetime_string) // NOT_EQUAL // trim(expected_base_datetime_string) + msg_tunit = trim(tunit) // NOT_EQUAL // trim(UNITS) + + @assertTrue(ESMF_Times_Equal(ebtime, btime), 'base ESMF_Time values do not match: ' // msg_base_time) + @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match: " // msg_tunit) + @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match: ' // msg_time) + + end subroutine test_convert_NetCDF_DateTime_to_ESMF_integer @Test - subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time() - character(len=19), parameter:: netcdf_string='2023-01-31 14:04:37' - type(ESMF_Time) :: etime - integer :: yy, mm, dd, h, m, s - integer :: status, rc - - call convert_NetCDF_DateTimeString_to_ESMF_Time(netcdf_string, etime, _RC) - call ESMF_TimeGet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - @assertEqual(2023, yy, 'Incorrect year') - @assertEqual(01, mm, 'Incorrect month') - @assertEqual(31, dd, 'Incorrect day') - @assertEqual(14, h, 'Incorrect hour') - @assertEqual(04, m, 'Incorrect minute') - @assertEqual(37, s, 'Incorrect second') - - end subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time - -! @Test - subroutine test_is_time_unit() - - @assertTrue(is_time_unit('years')) - @assertTrue(is_time_unit('months')) - @assertTrue(is_time_unit('days')) - @assertTrue(is_time_unit('hours')) - @assertTrue(is_time_unit('minutes')) - @assertTrue(is_time_unit('seconds')) - @assertTrue(is_time_unit('milliseconds')) - @assertTrue(is_time_unit(' milliseconds ')) - - @assertFalse(is_time_unit('nanoseconds')) - @assertFalse(is_time_unit('year')) - - end subroutine test_is_time_unit - -! @Test - subroutine test_lr_trim() - @assertEqual('word', lr_trim(' word')) - @assertEqual('word', lr_trim('word ')) - @assertEqual('word', lr_trim(' word ')) - end subroutine test_lr_trim - -! @test - subroutine test_get_shift_sign() - character(len=:), allocatable :: preposition - integer, parameter :: expected = 1 - - preposition = 'since' - @assertEqual(expected, get_shift_sign(preposition)) - preposition = 'before' - @assertFalse(get_shift_sign(preposition) == expected) - preposition = '' - @assertFalse(get_shift_sign(preposition) == expected) - end subroutine test_get_shift_sign - -! @test - subroutine test_split() - character(len=*), parameter :: head = 'head' - character(len=*), parameter :: tail = 'tail' - character(len=*), parameter :: delim = '::' - character(len=*), parameter :: test_string = head // delim // tail - character(len=:), allocatable :: parts(:) - - parts = split_all(test_string, delim) - @assertEqual(2, size(parts)) - @assertEqual(head, parts(1)) - @assertEqual(tail, parts(2)) - - end subroutine test_split - -! @test - subroutine test_split_all() - character(len=4), parameter :: chunk(6) = ['mice', 'dogs', 'rats', 'fish', 'deer', 'pigs'] - character(len=*), parameter :: dlm = '::' - character(len=:), allocatable :: test_string - character(len=:), allocatable :: parts(:) - integer :: i - - test_string = chunk(1) - do i = 2, size(chunk) - test_string = test_string // dlm // chunk(i) - end do - - parts = split_all(test_string, dlm) - @assertEqual(size(parts), size(chunk)) - do i = 1, size(chunk) - @assertEqual(chunk(i), parts(i)) - end do - - end subroutine test_split_all - -! @test - subroutine test_is_valid_netcdf_datetime_string() - character(len=:), allocatable :: string - -! string = '' -! @assertTrue(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01 23:59:59' - @assertTrue(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01 23:59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970:01-01 23:59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01 23-59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01T23:59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - end subroutine test_is_valid_netcdf_datetime_string - -! @test - subroutine test_convert_to_integer() - character(len=:), allocatable :: str - integer :: expected, actual, status - integer, parameter :: SUCCESSFUL = 0 - - expected = 2023 - str = '2023' - call convert_to_integer(str, actual, rc = status) - @assertEqual(SUCCESSFUL, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, 'Incorrect conversion: ' // str) + subroutine test_convert_NetCDF_DateTime_to_ESMF_real() + real(kind=ESMF_KIND_R8) :: duration + integer :: yy, mm, dd, h, m, s, m_time + character(len=*), parameter :: UNITS = 'seconds' + character(len=*), parameter :: NOT_EQUAL = ' /= ' + character(len=:), allocatable :: tunit, units_string + type(ESMF_Time) :: time, etime, btime, ebtime + type(ESMF_TimeInterval) :: time_interval + character(len=ESMF_MAXSTR) :: expected_base_datetime_string + character(len=ESMF_MAXSTR) :: expected_datetime_string + character(len=ESMF_MAXSTR) :: actual_base_datetime_string + character(len=ESMF_MAXSTR) :: actual_datetime_string + character(len=:), allocatable :: msg_time, msg_base_time, msg_tunit + integer :: status - end subroutine test_convert_to_integer + yy = 1999 + mm = 12 + dd = 31 + h = 23 + m = 29 + m_time = 59 + s = 59 + duration = ( m_time - m ) * SECONDS_PER_MINUTE + units_string = UNITS // ' since 1999-12-31 23:29:59' + + call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) + @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') + call ESMF_TimeGet(etime, timeString = expected_datetime_string, rc=status) + + call ESMF_TimeSet(ebtime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) + @assertTrue(status == _SUCCESS, 'Unable to create expected base ESMF_Time') + call ESMF_TimeGet(ebtime, timeString = expected_base_datetime_string, rc=status) + + call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & + time = time, time_unit = tunit, rc = status) + @assertTrue(status == _SUCCESS, 'Conversion failed') + call ESMF_TimeGet(btime, timeString = actual_base_datetime_string, rc=status) + call ESMF_TimeGet(time, timeString = actual_datetime_string, rc=status) + msg_time = trim(actual_datetime_string) // NOT_EQUAL // trim(expected_datetime_string) + msg_base_time = trim(actual_base_datetime_string) // NOT_EQUAL // trim(expected_base_datetime_string) + msg_tunit = trim(tunit) // NOT_EQUAL // trim(UNITS) + + @assertTrue(ESMF_Times_Equal(ebtime, btime), 'base ESMF_Time values do not match: ' // msg_base_time) + @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match: " // msg_tunit) + @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match: ' // msg_time) + + end subroutine test_convert_NetCDF_DateTime_to_ESMF_real end module test_MAPL_NetCDF diff --git a/gridcomps/History/MAPL_HistoryTrajectoryMod_smod.F90 b/gridcomps/History/MAPL_HistoryTrajectoryMod_smod.F90 index 3760c8b54cbf..012c3ba6b48d 100644 --- a/gridcomps/History/MAPL_HistoryTrajectoryMod_smod.F90 +++ b/gridcomps/History/MAPL_HistoryTrajectoryMod_smod.F90 @@ -1152,7 +1152,7 @@ len = size (this%times_R8) do i=1, len int_time = this%times_R8(i) - call convert_NetCDF_DateTime_to_ESMF(int_time, datetime_units, interval, time0, time1=time1, tunit=tunit, _RC) + call convert_NetCDF_DateTime_to_ESMF(int_time, datetime_units, interval, time0, time=time1, time_unit=tunit, _RC) this%times(i) = time1 enddo diff --git a/include/unused_dummy.H b/include/unused_dummy.H index 815cbf687f85..6d7063924148 100644 --- a/include/unused_dummy.H +++ b/include/unused_dummy.H @@ -10,4 +10,4 @@ #ifdef _UNUSED_DUMMY # undef _UNUSED_DUMMY #endif -#define _UNUSED_DUMMY(x) associate (q____ => x); end associate +#define _UNUSED_DUMMY(x) if (.false.) then; associate (q____ => x); end associate; endif diff --git a/shared/CMakeLists.txt b/shared/CMakeLists.txt index 637e0f615ea8..94f9336e8c79 100644 --- a/shared/CMakeLists.txt +++ b/shared/CMakeLists.txt @@ -28,6 +28,7 @@ set (srcs DownBit.F90 ShaveMantissa.c MAPL_Sleep.F90 + MAPL_CF_Time.F90 # Fortran submodules Interp/Interp.F90 Interp/Interp_implementation.F90 Shmem/Shmem.F90 Shmem/Shmem_implementation.F90 diff --git a/shared/MAPL_CF_Time.F90 b/shared/MAPL_CF_Time.F90 new file mode 100644 index 000000000000..c6b48b43d9e8 --- /dev/null +++ b/shared/MAPL_CF_Time.F90 @@ -0,0 +1,505 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_CF_Time + + use, intrinsic :: iso_fortran_env, only : R64 => real64 + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_DateTime_Parsing + + implicit none + +! Comment to test all procedures + private + +! PUBLIC PROCEDURES (ACCESS): + public :: extract_ISO8601_from_CF_Time + public :: extract_CF_Time_duration + public :: extract_CF_Time_unit + public :: convert_CF_Time_to_datetime_duration +! Convert ISO8601 datetime string to CF_Time_base_datetime + public :: convert_ISO8601_to_CF_Time_base_datetime + public :: CF_Time, CF_Time_Integer, CF_Time_Real + + public :: MAX_CHARACTER_LENGTH + +! PUBLIC PROCEDURES (INTERFACES): + +! Extract an ISO8601 datetime string from the base datetime string in a CF_Time. + interface extract_ISO8601_from_CF_Time + module procedure :: extract_ISO8601_from_CF_Time_units + module procedure :: extract_ISO8601_from_CF_Time_cf_time + end interface extract_ISO8601_from_CF_Time + +! Extract the duration of a CF Time. + interface extract_CF_Time_duration + module procedure :: extract_CF_Time_duration_cf_time_real + module procedure :: extract_CF_Time_duration_cf_time_integer + end interface extract_CF_Time_duration + +! Extract the time units from a CF Time. + interface extract_CF_Time_unit + module procedure :: extract_CF_Time_unit_cf_time + module procedure :: extract_CF_Time_unit_units + end interface extract_CF_Time_unit + +! Extract datetime_duration from CF Time. + interface convert_CF_Time_to_datetime_duration + module procedure :: convert_CF_Time_to_datetime_duration_integer + module procedure :: convert_CF_Time_to_datetime_duration_real + module procedure :: convert_CF_Time_to_datetime_duration_integer_duration + module procedure :: convert_CF_Time_to_datetime_duration_real_duration + end interface convert_CF_Time_to_datetime_duration + + +! PRIVATE INTERFACES: + + interface split + module procedure :: split_characters + end interface split + + +! TYPES (DEFINITIONS): + +! CF_TIME: derived type to hold the data for CF Time values + type, abstract :: CF_Time + logical :: is_valid + character(len=:), allocatable :: time_unit + character(len=:), allocatable :: base_datetime + end type CF_Time + + type, extends(CF_Time) :: CF_Time_Integer + integer :: duration + end type CF_Time_Integer + + type, extends(CF_Time) :: CF_Time_Real + real(kind=R64) :: duration + end type CF_Time_Real + + interface CF_Time_Integer + module procedure :: construct_cf_time_integer + end interface CF_Time_Integer + + interface CF_Time_Real + module procedure :: construct_cf_time_real + end interface CF_Time_Real + +! END CF_TIME + + +! CONSTANTS: + character, parameter :: DATE_DELIM = '-' + character, parameter :: TIME_DELIM = ':' + character, parameter :: ISO_DELIM = 'T' + character(len=2), parameter :: CF_DELIM = ' ' // ISO_DELIM + character(len=*), parameter :: EMPTY_STRING = '' + character, parameter :: DECIMAL_POINT = '.' + !character(len=*), parameter :: DIGIT_CHARACTERS = '1234567890' + +contains + + +! PUBLIC PROCEDURES (DEFINITION): + + subroutine extract_ISO8601_from_CF_Time_units(units, isostring, rc) + character(len=*), intent(in) :: units + character(len=MAX_CHARACTER_LENGTH), intent(out) :: isostring + integer, optional, intent(out) :: rc + integer :: status + + call extract_ISO8601_from_CF_Time(CF_Time_Integer(0, units), isostring, _RC) + + _RETURN(_SUCCESS) + + end subroutine extract_ISO8601_from_CF_Time_units + + subroutine extract_ISO8601_from_CF_Time_cf_time(cft, isostring, rc) + class(CF_Time), intent(in) :: cft + character(len=MAX_CHARACTER_LENGTH), intent(out) :: isostring + integer, optional, intent(out) :: rc + + if(cft % is_valid) then + isostring = convert_CF_Time_datetime_string_to_ISO8601(cft % base_datetime) + _RETURN(_SUCCESS) + end if + + _RETURN(_FAILURE) + + end subroutine extract_ISO8601_from_CF_Time_cf_time + + subroutine extract_CF_Time_duration_cf_time_real(cft, duration, rc) + class(CF_Time_Real), intent(in) :: cft + real(kind=R64), intent(out) :: duration + integer, optional, intent(out) :: rc + + if(cft % is_valid) then + duration = cft % duration + _RETURN(_SUCCESS) + end if + + _RETURN(_FAILURE) + + end subroutine extract_CF_Time_duration_cf_time_real + + subroutine extract_CF_Time_duration_cf_time_integer(cft, duration, rc) + class(CF_Time_Integer), intent(in) :: cft + integer, intent(out) :: duration + integer, optional, intent(out) :: rc + + if(cft % is_valid) then + duration = cft % duration + _RETURN(_SUCCESS) + end if + + _RETURN(_FAILURE) + + end subroutine extract_CF_Time_duration_cf_time_integer + + subroutine extract_CF_Time_unit_cf_time(cft, time_unit, rc) + class(CF_Time), intent(in) :: cft + character(len=MAX_CHARACTER_LENGTH), intent(out) :: time_unit + integer, optional, intent(out) :: rc + + if(cft % is_valid) then + time_unit = cft % time_unit + _RETURN(_SUCCESS) + end if + + _RETURN(_FAILURE) + + end subroutine extract_CF_Time_unit_cf_time + + subroutine extract_CF_Time_unit_units(units, time_unit, rc) + character(len=*), intent(in) :: units + character(len=MAX_CHARACTER_LENGTH), intent(out) :: time_unit + integer, optional, intent(out) :: rc + integer :: status + + call extract_CF_Time_unit(CF_Time_Integer(0, units), time_unit, _RC) + + _RETURN(_SUCCESS) + + end subroutine extract_CF_Time_unit_units + + subroutine convert_CF_Time_to_datetime_duration_integer(cft, dt_duration, rc) + class(CF_Time_Integer), intent(in) :: cft + type(datetime_duration), intent(out) :: dt_duration + integer, optional, intent(out) :: rc + integer(kind(TIME_UNIT)) :: tu + + if(.not. cft % is_valid) then + _RETURN(_FAILURE) + end if + + tu = get_time_unit(cft % time_unit) + _ASSERT(tu /= UNKNOWN_TIME_UNIT, 'Unable to find TIME_UNIT ' // cft % time_unit) + + call dt_duration % set_value(tu, cft % duration) + + _RETURN(_SUCCESS) + + end subroutine convert_CF_Time_to_datetime_duration_integer + + subroutine convert_CF_Time_to_datetime_duration_real(cft, dt_duration, rc) + class(CF_Time_Real), intent(in) :: cft + type(datetime_duration), intent(out) :: dt_duration + integer, optional, intent(out) :: rc + integer(kind(TIME_UNIT)) :: tu + + if(.not. cft % is_valid) then + _RETURN(_FAILURE) + end if + + tu = get_time_unit(cft % time_unit) + _ASSERT(tu /= UNKNOWN_TIME_UNIT, 'Unable to find TIME_UNIT ' // cft % time_unit) + + call dt_duration % set_value(tu, cft % duration) + + _RETURN(_SUCCESS) + + end subroutine convert_CF_Time_to_datetime_duration_real + + subroutine convert_CF_Time_to_datetime_duration_integer_duration(duration, units, dt_duration, rc) + integer, intent(in) :: duration + character(len=*), intent(in) :: units + type(datetime_duration), intent(out) :: dt_duration + integer, optional, intent(out) :: rc + integer :: status + + call convert_CF_Time_to_datetime_duration(CF_Time_Integer(duration, units), dt_duration, _RC) + + _RETURN(_SUCCESS) + + end subroutine convert_CF_Time_to_datetime_duration_integer_duration + + subroutine convert_CF_Time_to_datetime_duration_real_duration(duration, units, dt_duration, rc) + real(kind=R64), intent(in) :: duration + character(len=*), intent(in) :: units + type(datetime_duration), intent(out) :: dt_duration + integer, optional, intent(out) :: rc + integer :: status + + call convert_CF_Time_to_datetime_duration(CF_Time_Real(duration, units), dt_duration, _RC) + + _RETURN(_SUCCESS) + + end subroutine convert_CF_Time_to_datetime_duration_real_duration + + function convert_CF_Time_datetime_string_to_ISO8601(datetime_string) result(isodatetime) + character(len=*), intent(in) :: datetime_string + character(len=MAX_CHARACTER_LENGTH) :: isodatetime + character(len=MAX_CHARACTER_LENGTH) :: remainder + character(len=MAX_CHARACTER_LENGTH) :: part(NUM_TIME_UNITS) + + isodatetime = EMPTY_STRING + remainder = datetime_string + + call split(trim(remainder), part(YEAR_TIME_UNIT), remainder, DATE_DELIM) + call split(trim(remainder), part(MONTH_TIME_UNIT), remainder, DATE_DELIM) + call split(trim(remainder), part(DAY_TIME_UNIT), remainder, CF_DELIM) + call split(trim(remainder), part(HOUR_TIME_UNIT), remainder, TIME_DELIM) + call split(trim(remainder), part(MINUTE_TIME_UNIT), remainder, TIME_DELIM) + part(SECOND_TIME_UNIT) = trim(remainder) + + call update_datetime(isodatetime, part(YEAR_TIME_UNIT), 4, DATE_DELIM) + call update_datetime(isodatetime, part(MONTH_TIME_UNIT), 2, DATE_DELIM) + call update_datetime(isodatetime, part(DAY_TIME_UNIT), 2, ISO_DELIM) + call update_datetime(isodatetime, part(HOUR_TIME_UNIT), 2, TIME_DELIM) + call update_datetime(isodatetime, part(MINUTE_TIME_UNIT), 2, TIME_DELIM) + call update_datetime(isodatetime, part(SECOND_TIME_UNIT), 2) + + contains + + subroutine update_datetime(datetime_, text, width, delm) + character(len=MAX_CHARACTER_LENGTH), intent(inout) :: datetime_ + character(len=*), intent(in) :: text + integer, optional, intent(in) :: width + character(len=*), optional, intent(in) :: delm + character(len=MAX_CHARACTER_LENGTH) :: text_ + + text_ = text + if(present(width)) text_ = zero_pad(text, width) + datetime_ = trim(datetime_) // trim(text_) + if(present(delm)) datetime_ = trim(datetime_) // trim(delm) + + end subroutine update_datetime + + end function convert_CF_Time_datetime_string_to_ISO8601 + + function convert_ISO8601_to_CF_Time_base_datetime(isostring) result(base_datetime) + character(len=*), intent(in) :: isostring + character(len=len(isostring)) :: base_datetime + + base_datetime = remove_zero_pad(isostring) + base_datetime = substitute(base_datetime, 'T', ' ') + + end function convert_ISO8601_to_CF_Time_base_datetime + +! END PUBLIC PROCEDURES (DEFINITION) + + +! CONSTRUCTORS: + +! CF_TIME (CONSTRUCTORS): + + function construct_cf_time_integer(duration, units) result (cft) + integer, intent(in) :: duration + character(len=*), intent(in) :: units + type(CF_Time_Integer) :: cft + + cft % duration = duration + call initialize_cf_time(cft, units) + + end function construct_cf_time_integer + + function construct_cf_time_real(duration, units) result (cft) + real(kind=R64), intent(in) :: duration + character(len=*), intent(in) :: units + type(CF_Time_Real) :: cft + + cft % duration = duration + call initialize_cf_time(cft, units) + + end function construct_cf_time_real + + subroutine initialize_cf_time(cft, units) + class(CF_Time), intent(inout) :: cft + character(len=*), intent(in) :: units + character(len=MAX_CHARACTER_LENGTH) :: token, remainder + + cft % is_valid = .FALSE. + remainder = units + if(len_trim(remainder) == 0) return + call split(trim(remainder), token, remainder, CF_DELIM) + cft % time_unit = token + call split(trim(remainder), token, remainder, CF_DELIM) + cft % base_datetime = remainder + cft % is_valid = .TRUE. + + end subroutine initialize_cf_time + +! END CONSTRUCTORS + + +! UTILITY PROCEDURES: + +! ZERO_PAD - UTILITY + function zero_pad(number_string, width) result(padded) + character(len=*), intent(in) :: number_string + integer, intent(in) :: width + character(len=MAX_CHARACTER_LENGTH) :: padded + integer :: num_zeros + + num_zeros = width - len_trim(number_string) + if(num_zeros > 0) then + padded = repeat('0', num_zeros) // number_string + else + padded = number_string + end if + + end function zero_pad + +! SPLITTER - UTILITY + subroutine split_characters(characters, token, remainder, delimiters) + character(len=*), intent(in) :: characters + character(len=MAX_CHARACTER_LENGTH), intent(out) :: token + character(len=MAX_CHARACTER_LENGTH), intent(out) :: remainder + character(len=*), optional, intent(in) :: delimiters + character(len=:), allocatable :: delims + integer :: i + + delims = ' ' + if(present(delimiters)) delims = delimiters + + i = scan(characters, delims) + + if(i > 0) then + token = characters(:(i-1)) + remainder = characters((i+1):) + else + token = characters + remainder = EMPTY_STRING + endif + + end subroutine split_characters + +! UTILITIES + + function remove_zero_pad(isostring) result(unpadded) + character(len=*), intent(in) :: isostring + character(len=len(isostring)) :: unpadded + character(len=:), allocatable :: part(:) + character(len=len(isostring)) :: fraction_part + integer :: i + + part = get_ISO8601_substrings(isostring) + fraction_part = get_ISO8601_fractional_seconds(isostring) + unpadded = trim(part(1)) + do i = 2, size(part) + part(i) = strip_zero(part(i)) + unpadded = trim(unpadded) // trim(part(i)) + end do + + fraction_part = strip_zero(fraction_part, back = .TRUE.) + if(len_trim(fraction_part) > 0) unpadded = trim(unpadded) // DECIMAL_POINT // trim(fraction_part) + + end function remove_zero_pad + + function substitute(string, ch1, ch2) result(replaced) + character(len=*), intent(in) :: string + character, intent(in) :: ch1, ch2 + character(len=len(string)) :: replaced + integer :: i, j + + j = 0 + replaced = string + i = index(replaced((j+1):), ch1) + do while (i > 0) + j = j + i + if(j > len(replaced)) exit + replaced(j:j) = ch2 + if(j == len(replaced)) exit + i = index(replaced((j+1):), ch1) + end do + + end function substitute + + elemental logical function is_zero(ch) + character, intent(in) :: ch + is_zero = (ch == '0') + end function is_zero + + function get_ISO8601_substrings(isostring) result(substring) + character(len=*), intent(in) :: isostring + integer, parameter :: NUM_DT_PARTS = 6 + integer, parameter :: DT_PART_WIDTH = 5 + character(len=DT_PART_WIDTH) :: substring(NUM_DT_PARTS) + + substring = EMPTY_STRING + + substring(1) = isostring(1:5) + substring(2) = isostring(6:8) + substring(3) = isostring(9:11) + substring(4) = isostring(12:14) + substring(5) = isostring(15:17) + substring(6) = isostring(18:19) + + end function get_ISO8601_substrings + + function get_ISO8601_fractional_seconds(isostring) result(fs) + character(len=*), intent(in) :: isostring + integer, parameter :: FIRST_INDEX = 20 + character(len=len(isostring)) :: fs + integer :: i, j + + fs = EMPTY_STRING + if(len_trim(isostring) < FIRST_INDEX) return + i = FIRST_INDEX + if(isostring(i:i) /= DECIMAL_POINT) return + i = i + 1 + j = verify(isostring(i:), DIGIT_CHARACTERS) + select case(j) + case(0) + fs = isostring(i:) + case(1) + return + case default + j = j + i - 2 + fs = isostring(i:j) + end select + + end function get_ISO8601_fractional_seconds + + function strip_zero(string, back) result(stripped) + character(len=*), intent(in) :: string + logical, optional, intent(in) :: back + character(len=len(string)) :: stripped + logical :: back_ + integer :: i, j, n + character :: ch + + stripped = EMPTY_STRING + back_ = .FALSE. + if(present(back)) back_ = back + + n = len_trim(string) + if(back_) then + i = 1 + do j = n, i, -1 + ch = string(j:j) + if(.not. is_zero(ch)) exit + end do + else + j = n + do i = 1, n + ch = string(i:i) + if(.not. is_zero(ch)) exit + end do + i = min(i, j) + end if + + stripped = string(i:j) + + end function strip_zero + +end module MAPL_CF_Time diff --git a/shared/MAPL_DateTime_Parsing.F90 b/shared/MAPL_DateTime_Parsing.F90 index 7c26fc227ceb..e16672061745 100644 --- a/shared/MAPL_DateTime_Parsing.F90 +++ b/shared/MAPL_DateTime_Parsing.F90 @@ -28,29 +28,45 @@ ! hh?mm or Thhmm ! hh ! hh is the zero-padded hour (24 hour system). -! mm is the zero-padded minute. +! mm is the zero-padded minute. ! ss is the zero-padded second. ! sss is the fractional second. It represents an arbitrary number of digits (currrently limited to 3). ! ! Fully-formed time with time zone. Local time not-supported !