Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | ForDayField | |||
logical, | intent(inout), | DIMENSION(MaxDayTypes) | :: | TheseDays | ||
logical, | intent(inout), | DIMENSION(MaxDayTypes) | :: | AlReady | ||
logical, | intent(inout) | :: | ErrorsFound |
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 ProcessForDayTypes(ForDayField,TheseDays,AlReady,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN February 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine processes a field "For: day types" and returns
! those day types (can be multiple) from field.
! 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) :: ForDayField ! Field containing the "FOR:..."
LOGICAL, DIMENSION(MaxDayTypes), INTENT(INOUT) :: TheseDays ! Array to contain returned "true" days
LOGICAL, DIMENSION(MaxDayTypes), INTENT(INOUT) :: AlReady ! Array of days already done
LOGICAL, INTENT(INOUT) :: ErrorsFound ! Will be true if error found.
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: DayT
LOGICAL :: OneValid
LOGICAL :: DupAssignment
OneValid=.false.
DupAssignment=.false.
! Just test for specific days
IF (INDEX(ForDayField,'WEEKDAY') > 0) THEN
TheseDays(2:6)=.true.
IF (ANY(AlReady(2:6))) THEN
DupAssignment=.true.
ELSE
AlReady(2:6)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'MONDAY') > 0) THEN
TheseDays(2)=.true.
IF (AlReady(2)) THEN
DupAssignment=.true.
ELSE
AlReady(2)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'TUESDAY') > 0) THEN
TheseDays(3)=.true.
IF (AlReady(3)) THEN
DupAssignment=.true.
ELSE
AlReady(3)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'WEDNESDAY') > 0) THEN
TheseDays(4)=.true.
IF (AlReady(4)) THEN
DupAssignment=.true.
ELSE
AlReady(4)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'THURSDAY') > 0) THEN
TheseDays(5)=.true.
IF (AlReady(5)) THEN
DupAssignment=.true.
ELSE
AlReady(5)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'FRIDAY') > 0) THEN
TheseDays(6)=.true.
IF (AlReady(6)) THEN
DupAssignment=.true.
ELSE
AlReady(6)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'WEEKEND') > 0) THEN
TheseDays(1)=.true.
TheseDays(7)=.true.
IF (AlReady(1)) THEN
DupAssignment=.true.
ELSE
AlReady(1)=.true.
ENDIF
IF (AlReady(7)) THEN
DupAssignment=.true.
ELSE
AlReady(7)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'SATURDAY') > 0) THEN
TheseDays(7)=.true.
IF (AlReady(7)) THEN
DupAssignment=.true.
ELSE
AlReady(7)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'SUNDAY') > 0) THEN
TheseDays(1)=.true.
IF (AlReady(1)) THEN
DupAssignment=.true.
ELSE
AlReady(1)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'CUSTOMDAY1') > 0) THEN
TheseDays(11)=.true.
IF (AlReady(11)) THEN
DupAssignment=.true.
ELSE
AlReady(11)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'CUSTOMDAY2') > 0) THEN
TheseDays(12)=.true.
IF (AlReady(12)) THEN
DupAssignment=.true.
ELSE
AlReady(12)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'ALLDAY') > 0) THEN
TheseDays(1:MaxDayTypes)=.true.
IF (ANY(AlReady(1:MaxDayTypes))) THEN
DupAssignment=.true.
ELSE
AlReady(1:MaxDayTypes)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'HOLIDAY') > 0) THEN
TheseDays(8)=.true.
IF (AlReady(8)) THEN
DupAssignment=.true.
ELSE
AlReady(8)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'SUMMER') > 0) THEN
TheseDays(9)=.true.
IF (AlReady(9)) THEN
DupAssignment=.true.
ELSE
AlReady(9)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'WINTER') > 0) THEN
TheseDays(10)=.true.
IF (AlReady(10)) THEN
DupAssignment=.true.
ELSE
AlReady(10)=.true.
ENDIF
OneValid=.true.
ENDIF
IF (INDEX(ForDayField,'ALLOTHERDAY') > 0) THEN
DO DayT=1,MaxDayTypes
IF (AlReady(DayT)) CYCLE
TheseDays(DayT)=.true.
AlReady(DayT)=.true.
ENDDO
OneValid=.true.
ENDIF
IF (DupAssignment) THEN
CALL ShowSevereError('ProcessScheduleInput: ProcessForDayTypes, '// &
'Duplicate assignment attempted in "for" days field='//TRIM(ForDayField))
ErrorsFound=.true.
ENDIF
IF (.not. OneValid) THEN
CALL ShowSevereError('ProcessScheduleInput: ProcessForDayTypes, '// &
'No valid day assignments found in "for" days field='//TRIM(ForDayField))
ErrorsFound=.true.
ENDIF
RETURN
END SUBROUTINE ProcessForDayTypes