Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in), | DIMENSION(:) | :: | Untils | ||
real(kind=r64), | intent(in), | DIMENSION(:) | :: | Numbers | ||
integer, | intent(in) | :: | NumUntils | |||
integer, | intent(in) | :: | NumNumbers | |||
real(kind=r64), | intent(out), | DIMENSION(24,60) | :: | MinuteValue | ||
logical, | intent(out), | DIMENSION(24,60) | :: | SetMinuteValue | ||
logical, | intent(inout) | :: | ErrorsFound | |||
character(len=*), | intent(in) | :: | DayScheduleName | |||
character(len=*), | intent(in) | :: | ErrContext |
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 ProcessIntervalFields(Untils,Numbers,NumUntils,NumNumbers,MinuteValue,SetMinutevalue,ErrorsFound, &
DayScheduleName,ErrContext)
! SUBROUTINE INFORMATION:
! AUTHOR <author>
! DATE WRITTEN <date_written>
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine processes the "interval" fields with/without optional "until" in front of
! time (hh:mm).
! METHODOLOGY EMPLOYED:
! na.
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), DIMENSION(:), INTENT(IN) :: Untils
REAL(r64), DIMENSION(:), INTENT(IN) :: Numbers
INTEGER, INTENT(IN) :: NumUntils
INTEGER, INTENT(IN) :: NumNumbers
REAL(r64), DIMENSION(24,60), INTENT(OUT) :: MinuteValue
LOGICAL, DIMENSION(24,60), INTENT(OUT) :: SetMinuteValue
LOGICAL, INTENT(INOUT) :: ErrorsFound
CHARACTER(len=*), INTENT(IN) :: DayScheduleName ! Name (used for errors)
CHARACTER(len=*), INTENT(IN) :: ErrContext ! Context (used for errors)
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Count
INTEGER Pos
INTEGER HHField
INTEGER MMField
INTEGER Hr
INTEGER Min
INTEGER SHr
INTEGER SMin
INTEGER EHr
INTEGER EMin
INTEGER sFld
MinuteValue=0.0d0
SetMinuteValue=.false.
SHr=1
SMin=1
EHr=0
EMin=0
sFld=0
IF (NumUntils /= NumNumbers) THEN
CALL ShowSevereError('ProcessScheduleInput: ProcessIntervalFields, '// &
' number of Time fields does not match number of value fields, '// &
TRIM(ErrContext)//'='//TRIM(DayScheduleName))
ErrorsFound=.true.
RETURN
ENDIF
UntilLoop: DO Count=1,NumUntils
Pos=INDEX(Untils(Count),'UNTIL')
IF (Pos /= 0 .and. Pos == 1) THEN
IF (Untils(Count)(6:6) == ':') THEN
sFld=7
ELSE
sFld=6
ENDIF
ENDIF
IF (Pos /= 0 .and. Pos == 1) THEN
CALL DecodeHHMMField(Untils(Count)(sFld:),HHField,MMField,ErrorsFound,DayScheduleName,Untils(Count))
ELSEIF (Pos == 0) THEN
CALL DecodeHHMMField(Untils(Count),HHField,MMField,ErrorsFound,DayScheduleName,Untils(Count))
ELSE ! Until found but wasn't first field
CALL ShowSevereError('ProcessScheduleInput: ProcessIntervalFields, '// &
'Invalid "Until" field encountered='//TRIM(Untils(Count)))
CALL ShowContinueError('Occurred in Day Schedule='//TRIM(DayScheduleName))
ErrorsFound=.true.
CYCLE
ENDIF
! Field decoded
IF (HHField < 0 .or. HHField > 24 .or. MMField < 0 .or. MMField > 60) THEN
CALL ShowSevereError('ProcessScheduleInput: ProcessIntervalFields, '// &
'Invalid "Until" field encountered='//TRIM(Untils(Count)))
CALL ShowContinueError('Occurred in Day Schedule='//TRIM(DayScheduleName))
ErrorsFound=.true.
CYCLE
ENDIF
IF (HHFIeld == 24 .and. MMField > 0 .and. MMField < 60) THEN
CALL ShowWarningError('ProcessScheduleInput: ProcessIntervalFields, '// &
'Invalid "Until" field encountered='//TRIM(Untils(Count)))
CALL ShowContinueError('Occurred in Day Schedule='//TRIM(DayScheduleName))
CALL ShowContinueError('Terminating the field at 24:00')
MMField=0
ENDIF
! Fill in values
IF (MMField == 0) THEN
EHr=HHField+1
EMin=60
ENDIF
IF (MMField < 60) THEN
EHr=HHField+1
EMin=MMField
ENDIF
IF (SHr == EHr) THEN
DO Min=SMin,EMin
IF (SetMinuteValue(SHr,Min)) THEN
CALL ShowSevereError('ProcessScheduleInput: ProcessIntervalFields, '// &
'Processing time fields, overlapping times detected, '// &
TRIM(ErrContext)//'='//TRIM(DayScheduleName))
ErrorsFound=.true.
EXIT UntilLoop
ENDIF
MinuteValue(SHr,Min)=Numbers(Count)
SetMinutevalue(SHr,Min)=.true.
ENDDO
SMin=EMin+1
IF (SMin > 60) THEN
SHr=SHr+1
SMin=1
ENDIF
ELSEIF (EHr < SHr) THEN
CALL ShowSevereError('ProcessScheduleInput: ProcessIntervalFields, '// &
'Processing time fields, overlapping times detected, '// &
TRIM(ErrContext)//'='//TRIM(DayScheduleName))
ErrorsFound=.true.
ELSE
DO Min=SMin,60
MinuteValue(SHr,Min)=Numbers(Count)
SetMinutevalue(SHr,Min)=.true.
ENDDO
DO Hr=SHr+1,EHr-1
MinuteValue(Hr,:)=Numbers(Count)
SetMinutevalue(Hr,:)=.true.
ENDDO
DO Min=1,EMin
MinuteValue(EHr,Min)=Numbers(Count)
SetMinutevalue(EHr,Min)=.true.
ENDDO
SHr=EHr
SMin=EMin+1
IF (SMin > 60) THEN
SHr=SHr+1
SMin=1
ENDIF
ENDIF
ENDDO UntilLoop
IF (.not. ALL(SetMinuteValue)) THEN
CALL ShowSevereError('ProcessScheduleInput: ProcessIntervalFields, '// &
'Processing time fields, incomplete day detected, '// &
TRIM(ErrContext)//'='//TRIM(DayScheduleName))
ErrorsFound=.true.
ENDIF
RETURN
END SUBROUTINE ProcessIntervalFields