Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | isostring | |||
integer, | intent(in) | :: | imin | |||
integer, | intent(in) | :: | imax | |||
integer, | intent(out), | optional | :: | rc |
function construct_ISO8601Duration(isostring, imin, imax, rc) result(duration) character(len=*), intent(in) :: isostring integer, intent(in) :: imin integer, intent(in) :: imax integer, optional, intent(out) :: rc type(ISO8601Duration) :: duration integer :: years = -1 integer :: months = -1 integer :: days = -1 integer :: hours = -1 integer :: minutes = -1 integer :: seconds = -1 integer :: istart = -1 integer :: istop = -1 logical :: time_found = .FALSE. logical :: successful = .FALSE. character :: c integer :: pos ! Check indices and first character is 'P' successful = ((imin > 0) .and. (imax <= len(isostring)) .and. & (imin <= imax) .and. (isostring(imin:imin) == 'P')) pos = imin + 1 ! This do loop reads a character at a time, digit and nondigit. ! A field string consists of digits forming an integer n followed by ! a field character. A field character must be preceded by an integer. ! A field character indicates that the preceding digit characters ! should be processed as values for the corresponding field. ! The field characters are: ! Y(ear) ! M(onth) ! D(ay) ! H(our) ! M(inute) ! S(econd) ! The date and time portions of the string are delimited by T. ! Fields can be omitted, but they must be in order (see above). ! Omitted fields are set to 0. A zero field cannot be specified by a ! field character without a preceding integer. do while(successful .and. (pos <= imax)) successful = .FALSE. c = isostring(pos:pos) if(time_found) then ! Once the time is found, M should be processed as M(inute). select case(c) case('H') ! Verify the field or preceding fields have not been set. ! Then process the preceding digit character as an integer. ! Once processed reset the istart index to start processing ! digits. The same logic applies for each case below. if(hours >= 0 .or. minutes >= 0 .or. & seconds >= 0 .or. istart < 1) cycle hours = read_whole_number_indexed(isostring, istart, istop) if(hours < 0) cycle istart = 0 case('M') if(minutes >= 0 .or. seconds >= 0 .or. istart < 1) cycle minutes = read_whole_number_indexed(isostring, istart, istop) if(minutes < 0) cycle if(hours < 0) hours = 0 istart = 0 case('S') if(seconds >= 0 .or. istart < 1) cycle seconds = read_whole_number_indexed(isostring, istart, istop) if(seconds < 0) cycle if(hours < 0) hours = 0 if(minutes < 0) minutes = 0 istart = 0 case default if(.not. is_digit(c)) cycle if(istart == 0) istart = pos istop = pos end select else ! Until the time is found, M should be processed as M(onth). select case(c) case('T') time_found = .TRUE. if(years < 0) years = 0 if(months < 0) months = 0 if(days < 0) days = 0 case('Y') if(years >= 0 .or. months >= 0 .or. & days >= 0 .or. istart < 1) cycle years = read_whole_number_indexed(isostring, istart, istop) if(years < 0) cycle istart = 0 case('M') if(months >= 0 .or. days >= 0 .or. istart < 1) cycle months = read_whole_number_indexed(isostring, istart, istop) if(months < 0) cycle if(years < 0) years = 0 istart = 0 case('D') if(days >= 0 .or. istart < 1) cycle days = read_whole_number_indexed(isostring, istart, istop) if(days < 0) cycle if(years < 0) years = 0 if(months < 0) months = 0 istart = 0 case default if(.not. is_digit(c)) cycle ! istart == 0 indicates that a new integer is being processed. if(istart == 0) istart = pos ! The istop index should be the current position. istop = pos end select end if successful = .TRUE. pos = pos + 1 end do if(successful) then duration%years_= years duration%months_= months duration%days_= days duration%hours_= hours duration%minutes_= minutes duration%seconds_= seconds _RETURN(_SUCCESS) else _FAIL('Invalid ISO 8601 datetime duration string') end if end function construct_ISO8601Duration