subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour,startmin,startsec,units,timeVector,rc)
class (FileMetadataUtils), intent(inout) :: this
type(ESMF_Time), optional, intent(inout) :: startTime
integer,optional,intent(out) :: startYear
integer,optional,intent(out) :: startMonth
integer,optional,intent(out) :: startDay
integer,optional,intent(out) :: startHour
integer,optional,intent(out) :: startMin
integer,optional,intent(out) :: startSec
type(ESMF_Time), allocatable, optional :: timeVector(:)
type(ESMF_Time), allocatable :: tVec(:)
character(len=*), optional, intent(out) :: units
integer, optional, intent(out) :: rc
integer :: status
character(:), allocatable :: fname
class(CoordinateVariable), pointer :: var
type(Attribute), pointer :: attr
class(*), pointer :: pTimeUnits
character(len=ESMF_MAXSTR) :: timeUnits,tUnits
integer :: i,tsize
integer ypos(2), mpos(2), dpos(2), hpos(2), spos(2)
integer strlen
integer firstdash, lastdash
integer firstcolon, lastcolon
integer lastspace,since_pos
integer year,month,day,hour,min,sec
type(ESMF_Time) :: unmodStartTime
class(*), pointer :: ptr(:)
real(REAL64), allocatable :: tr_r64(:)
type(ESMF_TimeInterval) :: tint
fname = this%get_file_name(_RC)
var => this%get_coordinate_variable('time',rc=status)
_VERIFY(status)
attr => var%get_attribute('units')
ptimeUnits => attr%get_value()
select type(pTimeUnits)
type is (character(*))
timeUnits = pTimeUnits
strlen = LEN_TRIM (TimeUnits)
since_pos = index(TimeUnits, 'since')
tUnits = trim(TimeUnits(:since_pos-1))
if (present(units)) units = trim(tUnits)
firstdash = index(TimeUnits, '-')
lastdash = index(TimeUnits, '-', BACK=.TRUE.)
if (firstdash .LE. 0 .OR. lastdash .LE. 0) then
rc = -1
return
endif
ypos(2) = firstdash - 1
mpos(1) = firstdash + 1
ypos(1) = ypos(2) - 3
mpos(2) = lastdash - 1
dpos(1) = lastdash + 1
dpos(2) = dpos(1) + 1
read ( TimeUnits(ypos(1):ypos(2)), * ) year
read ( TimeUnits(mpos(1):mpos(2)), * ) month
read ( TimeUnits(dpos(1):dpos(2)), * ) day
firstcolon = index(TimeUnits, ':')
if (firstcolon .LE. 0) then
! If no colons, check for hour.
! Logic below assumes a null character or something else is after the hour
! if we do not find a null character add one so that it correctly parses time
if (TimeUnits(strlen:strlen) /= char(0)) then
TimeUnits = trim(TimeUnits)//char(0)
strlen=len_trim(TimeUnits)
endif
lastspace = index(TRIM(TimeUnits), ' ', BACK=.TRUE.)
if ((strlen-lastspace).eq.2 .or. (strlen-lastspace).eq.3) then
hpos(1) = lastspace+1
hpos(2) = strlen-1
read (TimeUnits(hpos(1):hpos(2)), * ) hour
min = 0
sec = 0
else
hour = 0
min = 0
sec = 0
endif
else
hpos(1) = firstcolon - 2
hpos(2) = firstcolon - 1
lastcolon = index(TimeUnits, ':', BACK=.TRUE.)
if ( lastcolon .EQ. firstcolon ) then
mpos(1) = firstcolon + 1
mpos(2) = firstcolon + 2
read (TimeUnits(hpos(1):hpos(2)), * ) hour
read (TimeUnits(mpos(1):mpos(2)), * ) min
sec = 0
else
mpos(1) = firstcolon + 1
mpos(2) = lastcolon - 1
spos(1) = lastcolon + 1
spos(2) = lastcolon + 2
read (TimeUnits(hpos(1):hpos(2)), * ) hour
read (TimeUnits(mpos(1):mpos(2)), * ) min
read (TimeUnits(spos(1):spos(2)), * ) sec
endif
endif
class default
_FAIL("Time unit must be character in "//fname)
end select
call ESMF_TimeSet(unmodStartTime,yy=year,mm=month,dd=day,h=hour,m=min,s=sec,rc=status)
_VERIFY(status)
call this%get_coordinate_info('time',coordSize=tsize,rc=status)
_VERIFY(status)
allocate(tr_r64(tsize))
allocate(tvec(tsize))
ptr => var%get_coordinate_data()
_ASSERT(associated(ptr),"time variable coordinate data not found in "//fname)
select type (ptr)
type is (real(kind=REAL64))
tr_r64=ptr
type is (real(kind=REAL32))
tr_r64=ptr
type is (integer(kind=INT64))
tr_r64=ptr
type is (integer(kind=INT32))
tr_r64=ptr
class default
_FAIL("unsupported time variable type in "//fname)
end select
do i=1,tsize
select case (trim(tUnits))
case ("days")
call ESMF_TimeIntervalSet(tint,d_r8=tr_r64(i),rc=status)
_VERIFY(status)
tvec(i)=unmodStartTime+tint
case ("hours")
call ESMF_TimeIntervalSet(tint,h_r8=tr_r64(i),rc=status)
_VERIFY(status)
tvec(i)=unmodStartTime+tint
case ("minutes")
call ESMF_TimeIntervalSet(tint,m_r8=tr_r64(i),rc=status)
_VERIFY(status)
tvec(i)=unmodStartTime+tint
case ("seconds")
call ESMF_TimeIntervalSet(tint,s_r8=tr_r64(i),rc=status)
_VERIFY(status)
tvec(i)=unmodStartTime+tint
case default
_FAIL("unsupported time unit in "//fname)
end select
enddo
call ESMF_TimeGet(tVec(1),yy=year,mm=month,dd=day,h=hour,m=min,s=sec,rc=status)
_VERIFY(status)
if (present(startYear)) startYear=year
if (present(startMonth)) startMonth=month
if (present(startDay)) startDay=day
if (present(startHour)) startHour=hour
if (present(startmin)) startMin=min
if (present(startsec)) startSec=sec
if (present(startTime)) then
startTime=tVec(1)
end if
if (present(timeVector)) then
allocate(timeVector,source=tVec,stat=status)
_VERIFY(status)
end if
_RETURN(_SUCCESS)
end subroutine get_time_info