ESMF_ParseDurDateString Subroutine

private subroutine ESMF_ParseDurDateString(timeIntervalString, yy_i8, mm_i8, d_i8, d_r8, rc)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: timeIntervalString
integer(kind=ESMF_KIND_I8), intent(out) :: yy_i8
integer(kind=ESMF_KIND_I8), intent(out) :: mm_i8
integer(kind=ESMF_KIND_I8), intent(out) :: d_i8
real(kind=ESMF_KIND_R8), intent(out) :: d_r8
integer, intent(out), optional :: rc

Calls

proc~~esmf_parsedurdatestring~~CallsGraph proc~esmf_parsedurdatestring ESMF_ParseDurDateString proc~esmf_logseterror ESMF_LogSetError proc~esmf_parsedurdatestring->proc~esmf_logseterror esmf_breakpoint esmf_breakpoint proc~esmf_logseterror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logseterror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logseterror->proc~esmf_logwrite c_esmc_loggeterrormsg c_esmc_loggeterrormsg proc~esmf_logrc2msg->c_esmc_loggeterrormsg c_esmc_vmwtime c_esmc_vmwtime proc~esmf_logwrite->c_esmc_vmwtime proc~esmf_logclose ESMF_LogClose proc~esmf_logwrite->proc~esmf_logclose proc~esmf_logflush ESMF_LogFlush proc~esmf_logwrite->proc~esmf_logflush proc~esmf_logopenfile ESMF_LogOpenFile proc~esmf_logwrite->proc~esmf_logopenfile proc~esmf_utiliounitflush ESMF_UtilIOUnitFlush proc~esmf_logwrite->proc~esmf_utiliounitflush proc~esmf_utilstring2array ESMF_UtilString2Array proc~esmf_logwrite->proc~esmf_utilstring2array proc~esmf_logclose->proc~esmf_logflush proc~esmf_logflush->proc~esmf_utiliounitflush proc~esmf_utilarray2string ESMF_UtilArray2String proc~esmf_logflush->proc~esmf_utilarray2string proc~esmf_logopenfile->proc~esmf_utiliounitflush proc~esmf_utiliounitget ESMF_UtilIOUnitGet proc~esmf_logopenfile->proc~esmf_utiliounitget

Called by

proc~~esmf_parsedurdatestring~~CalledByGraph proc~esmf_parsedurdatestring ESMF_ParseDurDateString proc~esmf_parsedurstring ESMF_ParseDurString proc~esmf_parsedurstring->proc~esmf_parsedurdatestring proc~esmf_timeintervalsetstr ESMF_TimeIntervalSetStr proc~esmf_timeintervalsetstr->proc~esmf_parsedurstring proc~esmf_timeintervalsetstrcal ESMF_TimeIntervalSetStrCal proc~esmf_timeintervalsetstrcal->proc~esmf_parsedurstring proc~esmf_timeintervalsetstrcaltyp ESMF_TimeIntervalSetStrCalTyp proc~esmf_timeintervalsetstrcaltyp->proc~esmf_parsedurstring proc~esmf_timeintervalsetstrstart ESMF_TimeIntervalSetStrStart proc~esmf_timeintervalsetstrstart->proc~esmf_parsedurstring interface~esmf_timeintervalset ESMF_TimeIntervalSet interface~esmf_timeintervalset->proc~esmf_timeintervalsetstr interface~esmf_timeintervalset->proc~esmf_timeintervalsetstrcal interface~esmf_timeintervalset->proc~esmf_timeintervalsetstrcaltyp interface~esmf_timeintervalset->proc~esmf_timeintervalsetstrstart

Source Code

subroutine ESMF_ParseDurDateString(timeintervalString, &
     yy_i8, mm_i8, d_i8, d_r8, rc)

        character(*),            intent(in)  :: timeIntervalString  
        integer(ESMF_KIND_I8),   intent(out)  :: yy_i8
        integer(ESMF_KIND_I8),   intent(out)  :: mm_i8
        integer(ESMF_KIND_I8),   intent(out)  :: d_i8
        real(ESMF_KIND_R8),      intent(out)  :: d_r8
        integer,                 intent(out), optional :: rc

        integer :: localrc
        integer :: beg_loc, end_loc
        integer :: t_loc
        integer :: ioStatus
        
      ! Init output to 0
      yy_i8=0
      mm_i8=0
      d_i8=0
      d_r8=0.0
      
      ! Start at the beginning of the string
      beg_loc=1

      ! Look for Y (year), and if it exists process it
      end_loc=INDEX(timeIntervalString,"Y")
      if (end_loc > 0) then
         ! Shift position before Y for end loc
         end_loc=end_loc-1

         ! Make sure that it isn't empty
         if (end_loc < beg_loc) then
            Call Esmf_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
                 msg=" Y value missing in ISO duration string.", &
                 ESMF_CONTEXT, rcToReturn=rc)
            return           
         endif

         ! Read year value
         read(timeIntervalString(beg_loc:end_loc), *, ioStat=ioStatus) yy_i8
         if (ioStatus /=0) then
            call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
                 msg=" An error occurred while reading Y value in ISO duration string.", &
                 ESMF_CONTEXT, rcToReturn=rc)
            return           
         endif

         
         ! New beg_loc is after indicator
         beg_loc=end_loc+2
      endif

      ! Look for M (month), and if it exists process it
      end_loc=INDEX(timeIntervalString,"M")
      if (end_loc > 0) then
         ! Shift position before M for end loc
         end_loc=end_loc-1

         ! Make sure that it isn't empty
         if (end_loc < beg_loc) then
            call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
                 msg=" M value missing in ISO duration string.", &
                 ESMF_CONTEXT, rcToReturn=rc)
            return           
         endif

         ! Read year value
         read(timeIntervalString(beg_loc:end_loc), *, ioStat=ioStatus) mm_i8
         if (ioStatus /=0) then
            call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
                 msg=" An error occurred while reading M value in ISO duration string.", &
                 ESMF_CONTEXT, rcToReturn=rc)
            return           
         endif

         
         ! New beg_loc is after indicator
         beg_loc=end_loc+2
      endif

      ! Look for D (days), and if it exists process it
      end_loc=INDEX(timeIntervalString,"D")
      if (end_loc > 0) then
         ! Shift position before M for end loc
         end_loc=end_loc-1

         ! Make sure that it isn't empty
         if (end_loc < beg_loc) then
            call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
                 msg=" D value missing in ISO duration string.", &
                 ESMF_CONTEXT, rcToReturn=rc)
            return           
         endif

         ! Read day value depending on if it looks like an integer or a real
         if (VERIFY(timeIntervalString(beg_loc:end_loc),"+-0123456789") == 0) then
            read(timeIntervalString(beg_loc:end_loc), *, ioStat=ioStatus) d_i8
         else
            read(timeIntervalString(beg_loc:end_loc), *, ioStat=ioStatus) d_r8
         endif         
         if (ioStatus /=0) then
            call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
                 msg=" An error occurred while reading D value in ISO duration string.", &
                 ESMF_CONTEXT, rcToReturn=rc)
            return           
         endif

         
         ! New beg_loc is after indicator
         beg_loc=end_loc+2
      endif

      ! DEBUG OUTPUT
      ! write(*,*) "Year value=",yy_i8
      ! write(*,*) "Month value=",mm_i8
      ! write(*,*) "Days value (I8)=",d_i8
      ! write(*,*) "Days value (R8)=",d_r8

      ! Return success
      if (present(rc)) rc = ESMF_SUCCESS      
      
end subroutine ESMF_ParseDurDateString