Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | FieldValue | |||
integer, | intent(out) | :: | RetHH | |||
integer, | intent(out) | :: | RetMM | |||
logical, | intent(inout) | :: | ErrorsFound | |||
character(len=*), | intent(in) | :: | DayScheduleName | |||
character(len=*), | intent(in) | :: | FullFieldValue |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE DecodeHHMMField(FieldValue,RetHH,RetMM,ErrorsFound,DayScheduleName,FullFieldValue)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K Lawrie
! DATE WRITTEN January 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine decodes a hhmm date field input as part of the "until" time in a schedule
! representation.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: FieldValue ! Input field value
INTEGER, INTENT(OUT) :: RetHH ! Returned "hour"
INTEGER, INTENT(OUT) :: RetMM ! Returned "minute"
LOGICAL, INTENT(INOUT) :: ErrorsFound ! True if errors found in this field
CHARACTER(len=*), INTENT(IN) :: DayScheduleName ! originating day schedule name
CHARACTER(len=*), INTENT(IN) :: FullFieldValue ! Full Input field value
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: hhmmFormat='(I2.2)'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Pos ! Position value for scanning the Field
CHARACTER(len=LEN(FieldValue)) String
INTEGER :: IOS
REAL(r64) :: rRetHH ! real Returned "hour"
REAL(r64) :: rRetMM ! real Returned "minute"
LOGICAL :: nonIntegral
CHARACTER(len=2) :: hHour
CHARACTER(len=2) :: mMinute
String=ADJUSTL(FieldValue)
Pos=INDEX(String,':')
nonIntegral=.false.
IF (Pos == 0) THEN
CALL ShowSevereError('ProcessScheduleInput: DecodeHHMMField, '// &
'Invalid "until" field submitted (no : separator in hh:mm)='//TRIM(ADJUSTL(FullFieldValue)))
CALL ShowContinueError('Occurred in Day Schedule='//TRIM(DayScheduleName))
ErrorsFound=.true.
RETURN
ELSEIF (Pos == 1) THEN
RetHH=0
ELSE
READ(String(1:Pos-1),*,IOSTAT=IOS) rRetHH
RetHH=INT(rRetHH)
IF (REAL(RetHH,r64) /= rRetHH .or. IOS /= 0 .or. rRetHH < 0.0d0) THEN
IF (REAL(RetHH,r64) /= rRetHH .and. rRetHH >= 0.0d0) THEN
CALL ShowWarningError('ProcessScheduleInput: DecodeHHMMField, '// &
'Invalid "until" field submitted (non-integer numeric in HH)='//TRIM(ADJUSTL(FullFieldValue)))
CALL ShowContinueError('Other errors may result. Occurred in Day Schedule='//TRIM(DayScheduleName))
nonIntegral=.true.
ELSE
CALL ShowSevereError('ProcessScheduleInput: DecodeHHMMField, '// &
'Invalid "until" field submitted (invalid numeric in HH)='//TRIM(ADJUSTL(FullFieldValue)))
CALL ShowContinueError('Field values must be integer and represent hours:minutes. Occurred in Day Schedule='// &
TRIM(DayScheduleName))
ErrorsFound=.true.
RETURN
ENDIF
ENDIF
ENDIF
String=String(Pos+1:)
READ(String,*,IOSTAT=IOS) rRetMM
RetMM=INT(rRetMM)
IF (REAL(RetMM,r64) /= rRetMM .or. IOS /=0 .or. rRetMM < 0.0d0) THEN
IF (REAL(RetMM,r64) /= rRetMM .and. rRetMM >= 0.0d0) THEN
CALL ShowWarningError('ProcessScheduleInput: DecodeHHMMField, '// &
'Invalid "until" field submitted (non-integer numeric in MM)='//TRIM(ADJUSTL(FullFieldValue)))
CALL ShowContinueError('Other errors may result. Occurred in Day Schedule='//TRIM(DayScheduleName))
nonIntegral=.true.
ELSE
CALL ShowSevereError('ProcessScheduleInput: DecodeHHMMField, '// &
'Invalid "until" field submitted (invalid numeric in MM)='//TRIM(ADJUSTL(FullFieldValue)))
CALL ShowContinueError('Field values must be integer and represent hours:minutes. Occurred in Day Schedule='// &
TRIM(DayScheduleName))
ErrorsFound=.true.
RETURN
ENDIF
ENDIF
IF (nonIntegral) THEN
write(hHour,hhmmFormat) RetHH
write(mMinute,hhmmFormat) RetMM
CALL ShowContinueError('Until value to be used will be: '//hhour//':'//mMinute)
ENDIF
RETURN
END SUBROUTINE DecodeHHMMField