Most initializations in the schedule data structures are taken care of in the definitions (see above)
! Get Schedule Types
! Get Day Schedules (all types)
!=> Get "DAYSCHEDULE" (Hourly)
! Get "DaySchedule:Interval"
! Get "DaySchedule:List"
! Get Week Schedules - regular
! Get Week Schedules - compact ! Get Schedules (all types)
! Get Regular Schedules
! Get Compact Schedules
SUBROUTINE ProcessScheduleInput
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN September 1997
! MODIFIED Rui Zhang February 2010
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine processes the schedules input for EnergyPlus.
! METHODOLOGY EMPLOYED:
! Uses the standard get routines in the InputProcessor.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, ProcessNumber, VerifyName, &
GetObjectDefMaxArgs, SameString, FindItem
USE General, ONLY: ProcessDateString, JulianDay, RoundSigDigits, TrimSigDigits
USE DataIPShortCuts
USE DataStringGlobals, ONLY: CharTab,CharComma,CharSpace,CharSemicolon
Use DataGlobals, ONLY: AnyEnergyManagementSystemInModel
Use DataInterfaces, ONLY: SetupEMSActuator
USE DataSystemVariables, ONLY: iASCII_CR, iUnicode_end, TempFullFileName,CheckForActualFileName
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='ProcessScheduleInput: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER,EXTERNAL :: GetNewUnitNumber ! Function to call if file not opened
INTEGER DaysInYear(366)
INTEGER UnitNumber
INTEGER, EXTERNAL :: FindUnitNumber
INTEGER LoopIndex
INTEGER InLoopIndex
INTEGER DayIndex,WeekIndex
CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: Alphas
CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields
CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields
REAL(r64), ALLOCATABLE, DIMENSION(:) :: Numbers
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks
INTEGER NumAlphas
INTEGER NumNumbers
INTEGER Status
INTEGER StartMonth,StartDay,EndMonth,EndDay
INTEGER StartPointer,EndPointer
INTEGER NumPointer
INTEGER Count
INTEGER CheckIndex
LOGICAL :: ErrorsFound=.false.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL NumErrorFlag
INTEGER SchedTypePtr
CHARACTER(len=20) CFld ! Character field for error message
! CHARACTER(len=20) CFld1 ! Character field for error message
INTEGER NumHrDaySchedules ! Number of "hourly" dayschedules
INTEGER NumIntDaySchedules ! Number of "interval" dayschedules
INTEGER NumExternalInterfaceSchedules ! Number of "PtolemyServer ExternalInterface" "compact" Schedules
INTEGER NumExternalInterfaceFunctionalMockupUnitImportSchedules ! Number of "FunctionalMockupUnitImport ExternalInterface"
! "compact" Schedules ! added for FMU Import
INTEGER NumExternalInterfaceFunctionalMockupUnitExportSchedules ! Number of "FunctionalMockupUnitExport ExternalInterface"
! "compact" Schedules ! added for FMU Export
INTEGER NumLstDaySchedules ! Number of "list" dayschedules
INTEGER NumRegDaySchedules ! Number of hourly+interval+list dayschedules
INTEGER NumRegWeekSchedules ! Number of "regular" Weekschedules
INTEGER NumRegSchedules ! Number of "regular" Schedules
INTEGER NumCptWeekSchedules ! Number of "compact" WeekSchedules
INTEGER NumCptSchedules ! Number of "compact" Schedules
INTEGER NumCommaFileSchedules ! Number of Schedule:File schedules
INTEGER NumConstantSchedules ! Number of "constant" schedules
INTEGER TS ! Counter for Num Of Time Steps in Hour
INTEGER Hr ! Hour Counter
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: MinuteValue ! Temporary for processing interval schedules
LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: SetMinuteValue ! Temporary for processing interval schedules
INTEGER NumFields
INTEGER SCount
! LOGICAL RptSchedule
INTEGER RptLevel
INTEGER CurMinute
INTEGER MinutesPerItem
INTEGER NumExpectedItems
INTEGER MaxNums
INTEGER MaxAlps
INTEGER AddWeekSch
INTEGER AddDaySch
LOGICAL AllDays(MaxDayTypes)
LOGICAL Thesedays(MaxDayTypes)
LOGICAL ErrorHere
INTEGER SchNum
INTEGER WkCount
INTEGER DyCount
INTEGER NumField
INTEGER PDateType
INTEGER PWeekDay
INTEGER ThruField
CHARACTER(len=25) ExtraField
INTEGER UntilFld
INTEGER xxcount
! REAL(r64) tempval
LOGICAL :: FullYearSet=.false.
CHARACTER(len=MaxNameLength) :: CurrentThrough=blank
CHARACTER(len=MaxNameLength) :: LastFor=blank
CHARACTER(len=220) :: errmsg=blank
integer kdy
LOGICAL :: FileExists
! for SCHEDULE:FILE
REAL(r64), ALLOCATABLE, DIMENSION(:) :: hourlyFileValues
INTEGER :: SchdFile
INTEGER :: colCnt
INTEGER :: rowCnt
INTEGER :: wordStart
INTEGER :: wordEnd
INTEGER :: sepPos
CHARACTER(len=1000) :: LineIn
CHARACTER(len=MaxNameLength) :: subString
REAL(r64) :: columnValue
INTEGER :: read_stat
INTEGER :: iDay
INTEGER :: hDay
INTEGER :: jHour
INTEGER :: kDayType
REAL(r64) :: curHrVal
LOGICAL :: errflag
INTEGER :: sPos
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in getting objects
INTEGER :: MaxNums1
LOGICAL :: StripCR ! If true, strip last character (<cr> off each schedule:file line)
INTEGER :: endLine
CHARACTER(len=1) :: ColumnSep
LOGICAL :: firstLine
LOGICAL :: FileIntervalInterpolated
INTEGER :: rowLimitCount
INTEGER :: skiprowCount
INTEGER :: curcolCount
INTEGER :: numHourlyValues
INTEGER :: numerrors
INTEGER :: ifld
INTEGER :: hrLimitCount
MaxNums=1 ! Need at least 1 number because it's used as a local variable in the Schedule Types loop
MaxAlps=0
CurrentModuleObject='ScheduleTypeLimits'
NumScheduleTypes=GetNumObjectsFound(CurrentModuleObject)
IF (NumScheduleTypes > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ENDIF
CurrentModuleObject='Schedule:Day:Hourly'
NumHrDaySchedules=GetNumObjectsFound(CurrentModuleObject)
IF (NumHrDaySchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ENDIF
CurrentModuleObject='Schedule:Day:Interval'
NumIntDaySchedules=GetNumObjectsFound(CurrentModuleObject)
IF (NumIntDaySchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ENDIF
CurrentModuleObject='Schedule:Day:List'
NumLstDaySchedules=GetNumObjectsFound(CurrentModuleObject)
IF (NumLstDaySchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ENDIF
CurrentModuleObject='Schedule:Week:Daily'
NumRegWeekSchedules=GetNumObjectsFound(CurrentModuleObject)
IF (NumRegWeekSchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ENDIF
CurrentModuleObject='Schedule:Week:Compact'
NumCptWeekSchedules=GetNumObjectsFound(CurrentModuleObject)
IF (NumCptWeekSchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ENDIF
CurrentModuleObject='Schedule:Year'
NumRegSchedules=GetNumObjectsFound(CurrentModuleObject)
IF (NumRegSchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ENDIF
CurrentModuleObject='Schedule:Compact'
NumCptSchedules=GetNumObjectsFound(CurrentModuleObject)
IF (NumCptSchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas+1)
ENDIF
CurrentModuleObject='Schedule:File'
NumCommaFileSchedules = GetNumObjectsFound(CurrentModuleObject)
IF (NumCommaFileSchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ENDIF
CurrentModuleObject='Schedule:Constant'
NumConstantSchedules = GetNumObjectsFound(CurrentModuleObject)
IF (NumConstantSchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ENDIF
CurrentModuleObject='ExternalInterface:Schedule'
NumExternalInterfaceSchedules=GetNumObjectsFound(CurrentModuleObject)
! added for FMI
IF (NumCptSchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas+1)
ENDIF
! added for FMU Import
CurrentModuleObject='ExternalInterface:FunctionalMockupUnitImport:To:Schedule'
NumExternalInterfaceFunctionalMockupUnitImportSchedules=GetNumObjectsFound(CurrentModuleObject)
IF (NumCptSchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas+1)
ENDIF
! added for FMU Export
CurrentModuleObject='ExternalInterface:FunctionalMockupUnitExport:To:Schedule'
NumExternalInterfaceFunctionalMockupUnitExportSchedules=GetNumObjectsFound(CurrentModuleObject)
IF (NumCptSchedules > 0) THEN
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas+1)
ENDIF
CurrentModuleObject='Output:Schedules'
CALL GetObjectDefMaxArgs(CurrentModuleObject,Count,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlps=MAX(MaxAlps,NumAlphas)
ALLOCATE(Alphas(MaxAlps)) ! Maximum Alphas possible
Alphas=' '
ALLOCATE(cAlphaFields(MaxAlps))
cAlphaFields=' '
ALLOCATE(cNumericFields(MaxNums))
cNumericFields=' '
ALLOCATE(Numbers(MaxNums)) ! Maximum Numbers possible
Numbers=0.0d0
ALLOCATE(lAlphaBlanks(MaxAlps))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.true.
! Prescan to determine extra day and week schedules due to compact schedule input
AddWeekSch=0
AddDaySch=0
CurrentModuleObject='Schedule:Compact'
MaxNums1=0
DO LoopIndex=1,NumCptSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status)
! # 'THROUGH" => Number of additional week schedules
! # 'FOR' => Number of additional day schedules
DO Count=3,NumAlphas
IF (Alphas(Count)(1:7) == 'THROUGH') AddWeekSch=AddWeekSch+1
IF (Alphas(Count)(1:3) == 'FOR') AddDaySch=AddDaySch+1
IF (Alphas(Count)(1:5) == 'UNTIL') MaxNums1=MaxNums1+1
ENDDO
ENDDO
IF (MaxNums1 > MaxNums) THEN
MaxNums=MaxNums1
DEALLOCATE(cNumericFields)
DEALLOCATE(Numbers)
DEALLOCATE(lNumericBlanks)
ALLOCATE(cNumericFields(MaxNums))
cNumericFields=' '
ALLOCATE(Numbers(MaxNums)) ! Maximum Numbers possible
Numbers=0.0d0
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.true.
ENDIF
! add week and day schedules for each FILE:COMMA schedule
AddWeekSch = AddWeekSch + NumCommaFileSchedules * 366 !number of days/year because need a week for each day
AddDaySch = AddDaySch + NumCommaFileSchedules * 366 !number of days/year
AddWeekSch = AddWeekSch + NumConstantSchedules
AddDaySch = AddDaySch + NumConstantSchedules
! add week and day schedules for each ExternalInterface:Schedule schedule
AddWeekSch = AddWeekSch + NumExternalInterfaceSchedules * 366 !number of days/year because need a week for each day
AddDaySch = AddDaySch + NumExternalInterfaceSchedules !one day schedule for ExternalInterface to update during run time
! added for FMU Import
! add week and day schedules for each ExternalInterface:FunctionalMockupUnitImport:Schedule
AddWeekSch = AddWeekSch + NumExternalInterfaceFunctionalMockupUnitImportSchedules * 366 !number of days/year
!because need a week for each day
AddDaySch = AddDaySch + NumExternalInterfaceFunctionalMockupUnitImportSchedules ! one day schedule for ExternalInterface
! to update during run time
! added for FMU Export
! add week and day schedules for each ExternalInterface:FunctionalMockupUnitExport:Schedule
AddWeekSch = AddWeekSch + NumExternalInterfaceFunctionalMockupUnitExportSchedules * 366 !number of days/year
!because need a week for each day
AddDaySch = AddDaySch + NumExternalInterfaceFunctionalMockupUnitExportSchedules ! one day schedule for ExternalInterface
! to update during run time
! include additional schedules in with count
NumRegDaySchedules=NumHrDaySchedules+NumIntDaySchedules+NumLstDaySchedules
NumDaySchedules=NumRegDaySchedules+AddDaySch
NumWeekSchedules=NumRegWeekSchedules+NumCptWeekSchedules+AddWeekSch
NumSchedules = NumRegSchedules + NumCptSchedules + NumCommaFileSchedules &
+ NumConstantSchedules + NumExternalInterfaceSchedules &
+ NumExternalInterfaceFunctionalMockupUnitImportSchedules &
+ NumExternalInterfaceFunctionalMockupUnitExportSchedules
!! Most initializations in the schedule data structures are taken care of in
!! the definitions (see above)
ALLOCATE (ScheduleType(0:NumScheduleTypes))
ALLOCATE (DaySchedule(0:NumDaySchedules))
! Initialize
DO LoopIndex=0,NumDaySchedules
ALLOCATE(DaySchedule(LoopIndex)%TSValue(24,NumOfTimeStepInHour))
DO Count=1,24
DO TS=1,NumOfTimeStepInHour
DaySchedule(LoopIndex)%TSValue(Count,TS)=0.0d0
ENDDO
ENDDO
ENDDO
ALLOCATE (WeekSchedule(0:NumWeekSchedules))
ALLOCATE (Schedule(-1:NumSchedules))
Schedule(-1)%ScheduleTypePtr=-1
Schedule(-1)%WeekSchedulePointer=1
Schedule(0)%ScheduleTypePtr=0
Schedule(0)%WeekSchedulePointer=0
UnitNumber=FindUnitNumber('eplusout.audit')
WRITE(UnitNumber,*) ' Processing Schedule Input -- Start'
!!! Get Schedule Types
CurrentModuleObject='ScheduleTypeLimits'
DO LoopIndex=1,NumScheduleTypes
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),ScheduleType(1:NumScheduleTypes)%Name,LoopIndex-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
ScheduleType(LoopIndex)%Name=Alphas(1)
IF (lNumericBlanks(1) .or. lNumericBlanks(2)) THEN
ScheduleType(LoopIndex)%Limited=.false.
ELSEIF (.not. lNumericBlanks(1) .and. .not. lNumericBlanks(2)) THEN
ScheduleType(LoopIndex)%Limited=.true.
ENDIF
IF (.not. lNumericBlanks(1)) THEN
ScheduleType(LoopIndex)%Minimum=Numbers(1)
ENDIF
IF (.not. lNumericBlanks(2)) THEN
ScheduleType(LoopIndex)%Maximum=Numbers(2)
ENDIF
IF (ScheduleType(LoopIndex)%Limited) THEN
IF (Alphas(2) == 'DISCRETE' .or. Alphas(2) == 'INTEGER') THEN
ScheduleType(LoopIndex)%IsReal=.false.
ELSE
IF (Alphas(2) /= 'CONTINUOUS' .and. Alphas(2) /= 'REAL') THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
TRIM(ScheduleType(LoopIndex)%Name)//'", invalid '//TRIM(cAlphaFields(2))//'='//TRIM(Alphas(2)))
ErrorsFound=.true.
ENDIF
ScheduleType(LoopIndex)%IsReal=.true.
ENDIF
ENDIF
IF (NumAlphas .ge. 3) THEN
IF (.not. lAlphaBlanks(3)) THEN
ScheduleType(LoopIndex)%UnitType = FindItem(Alphas(3), &
ScheduleTypeLimitUnitTypes,NumScheduleTypeLimitUnitTypes)
IF (ScheduleType(LoopIndex)%UnitType .eq. 0) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="' // TRIM(Alphas(1)) // &
'", '//trim(cAlphaFields(3))//'="' // TRIM(Alphas(3)) //'" is invalid.')
END IF
END IF
END IF
IF (ScheduleType(LoopIndex)%Limited) THEN
IF (ScheduleType(LoopIndex)%Minimum > ScheduleType(LoopIndex)%Maximum) THEN
IF (ScheduleType(LoopIndex)%IsReal) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="' // TRIM(Alphas(1)) // &
'", '//trim(cNumericFields(1))//' ['//trim(RoundSigDigits(ScheduleType(LoopIndex)%Minimum,2))// &
'] > '//trim(cNumericFields(2))//' ['//trim(RoundSigDigits(ScheduleType(LoopIndex)%Maximum,2))//'].')
CALL ShowContinueError(' Other warning/severes about schedule values may appear.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="' // TRIM(Alphas(1)) // &
'", '//trim(cNumericFields(1))//' ['//trim(RoundSigDigits(ScheduleType(LoopIndex)%Minimum,0))// &
'] > '//trim(cNumericFields(2))//' ['//trim(RoundSigDigits(ScheduleType(LoopIndex)%Maximum,0))//'].')
CALL ShowContinueError(' Other warning/severes about schedule values may appear.')
ENDIF
ENDIF
ENDIF
ENDDO
!!! Get Day Schedules (all types)
!!!=> Get "DAYSCHEDULE" (Hourly)
Count=0
CurrentModuleObject='Schedule:Day:Hourly'
DO LoopIndex=1,NumHrDaySchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DaySchedule%Name,Count,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
Count=Count+1
DaySchedule(Count)%Name=Alphas(1)
! Validate ScheduleType
IF (NumScheduleTypes > 0) THEN
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
DaySchedule(Count)%ScheduleTypePtr=CheckIndex
ENDIF
ENDIF
DO HR=1,24
DaySchedule(Count)%TSValue(Hr,1:NumOfTimeStepInHour)=Numbers(Hr)
ENDDO
DaySchedule(Count)%IntervalInterpolated=.false.
SchedTypePtr=DaySchedule(Count)%ScheduleTypePtr
IF (ScheduleType(SchedTypePtr)%Limited) THEN
IF (ANY(DaySchedule(Count)%TSValue < ScheduleType(SchedTypePtr)%Minimum) .or. &
ANY(DaySchedule(Count)%TSValue > ScheduleType(SchedTypePtr)%Maximum) ) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Values are outside of range for '//TRIM(cAlphaFields(2))//'='//TRIM(Alphas(2)))
ENDIF
ENDIF
IF (.not. ScheduleType(SchedTypePtr)%IsReal) THEN
! Make sure each is integer
NumErrorFlag=.false. ! only show error message once
DO Hr=1,24
DO TS=1,NumOfTimeStepInHour
IF (DaySchedule(Count)%TSValue(Hr,TS) /= INT(DaySchedule(Count)%TSValue(Hr,TS)) ) THEN
IF (.not. NumErrorFlag) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", One or more values are not integer as required by '//TRIM(cAlphaFields(2))//'='//TRIM(Alphas(2)))
NumErrorFlag=.true.
ENDIF
ENDIF
ENDDO
ENDDO
ENDIF
END DO
ALLOCATE(MinuteValue(24,60))
ALLOCATE(SetMinuteValue(24,60))
!!! Get "DaySchedule:Interval"
CurrentModuleObject='Schedule:Day:Interval'
DO LoopIndex=1,NumIntDaySchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DaySchedule%Name,Count,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
Count=Count+1
DaySchedule(Count)%Name=Alphas(1)
! Validate ScheduleType
IF (NumScheduleTypes > 0) THEN
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
DaySchedule(Count)%ScheduleTypePtr=CheckIndex
ENDIF
ENDIF
NumFields=NumAlphas-3
! check to see if numfield=0
IF (NumFields == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Insufficient data entered for a full schedule day.')
CALL ShowContinueError('...Number of interval fields = = ['//trim(RoundSigDigits(NumFields))//'].')
ErrorsFound=.true.
ENDIF
CALL ProcessIntervalFields(Alphas(4:),Numbers,NumFields,NumNumbers,MinuteValue,SetMinuteValue,ErrorsFound, &
Alphas(1),TRIM(CurrentModuleObject))
! Depending on value of "Interpolate" field, the value for each time step in each hour gets processed:
IF (Alphas(3) /= 'NO' .and. Alphas(3) /= 'YES') THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'Invalid value for "'//TRIM(cAlphaFields(3))//'" field="'//TRIM(Alphas(3))//'"')
ErrorsFound=.true.
ELSEIF (Alphas(3) /= 'YES') THEN ! No validation done on the value of the interpolation field
DaySchedule(Count)%IntervalInterpolated=.false.
DO Hr=1,24
CurMinute=MinutesPerTimeStep
DO TS=1,NumOfTimeStepInHour
DaySchedule(Count)%TSValue(Hr,TS)=MinuteValue(Hr,CurMinute)
Curminute=CurMinute+MinutesPerTimeStep
ENDDO
ENDDO
ELSE
DaySchedule(Count)%IntervalInterpolated=.true.
DO Hr=1,24
SCount=1
CurMinute=MinutesPerTimeStep
DO TS=1,NumOfTimeStepInHour
DaySchedule(Count)%TSValue(Hr,TS)=SUM(MinuteValue(Hr,SCount:CurMinute))/REAL(MinutesPerTimeStep,r64)
SCount=CurMinute+1
CurMinute=CurMinute+MinutesPerTimeStep
ENDDO
ENDDO
ENDIF
SchedTypePtr=DaySchedule(Count)%ScheduleTypePtr
IF (ScheduleType(SchedTypePtr)%Limited) THEN
IF (ANY(DaySchedule(Count)%TSValue < ScheduleType(SchedTypePtr)%Minimum) .or. &
ANY(DaySchedule(Count)%TSValue > ScheduleType(SchedTypePtr)%Maximum) ) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Values are outside of range for '//TRIM(cAlphaFields(2))//'='//TRIM(Alphas(2)))
ENDIF
ENDIF
IF (.not. ScheduleType(SchedTypePtr)%IsReal) THEN
! Make sure each is integer
NumErrorFlag=.false. ! only show error message once
DO Hr=1,24
DO TS=1,NumOfTimeStepInHour
IF (DaySchedule(Count)%TSValue(Hr,TS) /= INT(DaySchedule(Count)%TSValue(Hr,TS)) ) THEN
IF (.not. NumErrorFlag) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", , One or more values are not integer as required by '//TRIM(cAlphaFields(2))//'='//TRIM(Alphas(2)))
NumErrorFlag=.true.
ENDIF
ENDIF
ENDDO
ENDDO
ENDIF
ENDDO
!!! Get "DaySchedule:List"
CurrentModuleObject='Schedule:Day:List'
DO LoopIndex=1,NumLstDaySchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DaySchedule%Name,Count,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
Count=Count+1
DaySchedule(Count)%Name=Alphas(1)
! Validate ScheduleType
IF (NumScheduleTypes > 0) THEN
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
DaySchedule(Count)%ScheduleTypePtr=CheckIndex
ENDIF
ENDIF
! Depending on value of "Interpolate" field, the value for each time step in each hour gets processed:
IF (Alphas(3) /= 'NO' .and. Alphas(3) /= 'YES') THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'Invalid value for "'//TRIM(cAlphaFields(3))//'" field="'//TRIM(Alphas(3))//'"')
ErrorsFound=.true.
ELSEIF (Alphas(3) /= 'YES') THEN ! No validation done on the value of the interpolation field
DaySchedule(Count)%IntervalInterpolated=.false.
ELSE
DaySchedule(Count)%IntervalInterpolated=.true.
ENDIF
! check to see if there are any fields
IF (Numbers(1) <= 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Insufficient data entered for a full schedule day.')
CALL ShowContinueError('...Minutes per Item field = ['//trim(RoundSigDigits(INT(Numbers(1))))//'].')
ErrorsFound=.true.
CYCLE
ENDIF
IF (NumNumbers < 25) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Insufficient data entered for a full schedule day.')
CALL ShowContinueError('...Minutes per Item field = ['//trim(RoundSigDigits(INT(Numbers(1))))//'] and '// &
' only ['//trim(RoundSigDigits(NumNumbers-1))//'] to apply to list fields.')
ErrorsFound=.true.
CYCLE
ENDIF
MinutesPerItem=INT(Numbers(1))
NumExpectedItems=1440/MinutesPerItem
IF ((NumNumbers-1) /= NumExpectedItems) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
', Number of Entered Items='//TRIM(RoundSigDigits(NumNumbers-1))// &
' not equal number of expected items='//TRIM(RoundSigDigits(NumExpectedItems)))
CALL ShowContinueError('based on '//TRIM(cNumericFields(1))//' field value='//TRIM(RoundSigDigits(MinutesPerItem)))
ErrorsFound=.true.
CYCLE
ENDIF
IF (MOD(60,MinutesPerItem) /= 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1)))
CALL ShowContinueError('Requested '//TRIM(cNumericFields(1))//' field value ('// &
TRIM(RoundSigDigits(MinutesPerItem))//') not evenly divisible into 60')
ErrorsFound=.true.
CYCLE
ENDIF
! Number of numbers in the Numbers list okay to process
Hr=1
CurMinute=MinutesPerItem
SCount=1
DO NumFields=2,NumNumbers
MinuteValue(Hr,SCount:CurMinute)=Numbers(NumFields)
SCount=CurMinute+1
CurMinute=CurMinute+MinutesPerItem
IF (CurMinute > 60) THEN
CurMinute=MinutesPerItem
SCount=1
Hr=Hr+1
ENDIF
ENDDO
! Now parcel into TS Value....
IF (DaySchedule(Count)%IntervalInterpolated) THEN
DO Hr=1,24
SCount=1
CurMinute=MinutesPerTimeStep
DO TS=1,NumOfTimeStepInHour
DaySchedule(Count)%TSValue(Hr,TS)=SUM(MinuteValue(Hr,SCount:CurMinute))/REAL(MinutesPerTimeStep,r64)
SCount=CurMinute+1
CurMinute=CurMinute+MinutesPerTimeStep
ENDDO
ENDDO
ELSE
DO Hr=1,24
CurMinute=MinutesPerTimeStep
DO TS=1,NumOfTimeStepInHour
DaySchedule(Count)%TSValue(Hr,TS)=MinuteValue(Hr,CurMinute)
Curminute=CurMinute+MinutesPerTimeStep
ENDDO
ENDDO
ENDIF
SchedTypePtr=DaySchedule(Count)%ScheduleTypePtr
IF (ScheduleType(SchedTypePtr)%Limited) THEN
IF (ANY(DaySchedule(Count)%TSValue < ScheduleType(SchedTypePtr)%Minimum) .or. &
ANY(DaySchedule(Count)%TSValue > ScheduleType(SchedTypePtr)%Maximum) ) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Values are outside of range for '//TRIM(cAlphaFields(2))//'='//TRIM(Alphas(2)))
ENDIF
ENDIF
IF (.not. ScheduleType(SchedTypePtr)%IsReal) THEN
! Make sure each is integer
NumErrorFlag=.false. ! only show error message once
DO Hr=1,24
DO TS=1,NumOfTimeStepInHour
IF (DaySchedule(Count)%TSValue(Hr,TS) /= INT(DaySchedule(Count)%TSValue(Hr,TS)) ) THEN
IF (.not. NumErrorFlag) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", , One or more values are not integer as required by '//TRIM(cAlphaFields(2))//'='//TRIM(Alphas(2)))
NumErrorFlag=.true.
ENDIF
ENDIF
ENDDO
ENDDO
ENDIF
ENDDO
!!! Get Week Schedules - regular
CurrentModuleObject='Schedule:Week:Daily'
DO LoopIndex=1,NumRegWeekSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),WeekSchedule(1:NumRegWeekSchedules)%Name,LoopIndex-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
WeekSchedule(LoopIndex)%Name=Alphas(1)
! Rest of Alphas are processed into Pointers
DO InLoopIndex=1,MaxDayTypes
DayIndex=FindIteminList(Alphas(InLoopIndex+1),DaySchedule(1:NumRegDaySchedules)%Name,NumRegDaySchedules)
IF (DayIndex == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(InLoopIndex+1))//' "'//TRIM(Alphas(InLoopIndex+1))//'" not Found',UnitNumber)
ErrorsFound=.true.
ELSE
WeekSchedule(LoopIndex)%DaySchedulePointer(InLoopIndex)=DayIndex
ENDIF
END DO
END DO
!!! Get Week Schedules - compact
Count=NumRegWeekSchedules
CurrentModuleObject='Schedule:Week:Compact'
DO LoopIndex=1,NumCptWeekSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
IF (Count > 0) THEN
CALL VerifyName(Alphas(1),WeekSchedule(1:Count)%Name,Count,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
ENDIF
Count=Count+1
WeekSchedule(Count)%Name=Alphas(1)
AllDays=.false.
! Rest of Alphas are processed into Pointers
DO InLoopIndex=2,NumAlphas,2
DayIndex=FindIteminList(Alphas(InLoopIndex+1),DaySchedule(1:NumRegDaySchedules)%Name,NumRegDaySchedules)
IF (DayIndex == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(InLoopIndex+1))//' "'//TRIM(Alphas(InLoopIndex+1))//'" not Found',UnitNumber)
CALL ShowContinueError('ref: '//TRIM(cAlphaFields(InLoopIndex))//' "'//TRIM(Alphas(InLoopIndex))//'"')
ErrorsFound=.true.
ELSE
TheseDays=.false.
ErrorHere=.false.
CALL ProcessForDayTypes(Alphas(InLoopIndex),TheseDays,AllDays,ErrorHere)
IF (ErrorHere) THEN
CALL ShowContinueError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1)))
ErrorsFound=.true.
ELSE
DO Hr=1,MaxDayTypes
IF (TheseDays(Hr)) THEN
WeekSchedule(Count)%DaySchedulePointer(Hr)=DayIndex
ENDIF
ENDDO
ENDIF
ENDIF
END DO
! Have processed all named days, check to make sure all given
IF (.not. ALL(AllDays)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Missing some day assignments')
ErrorsFound=.true.
ENDIF
END DO
NumRegWeekSchedules=Count
!!! Get Schedules (all types)
!!! Get Regular Schedules
CurrentModuleObject='Schedule:Year'
DO LoopIndex=1,NumRegSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),Schedule(1:NumSchedules)%Name,LoopIndex-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
Schedule(LoopIndex)%Name=Alphas(1)
Schedule(LoopIndex)%SchType=ScheduleInput_year
! Validate ScheduleType
IF (NumScheduleTypes > 0) THEN
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
Schedule(LoopIndex)%ScheduleTypePtr=CheckIndex
ENDIF
ENDIF
NumPointer=0
DaysInYear=0
! Rest of Alphas (Weekschedules) are processed into Pointers
DO InLoopIndex=3,NumAlphas
WeekIndex=FindIteminList(Alphas(InLoopIndex),WeekSchedule(1:NumRegWeekSchedules)%Name,NumRegWeekSchedules)
IF (WeekIndex == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(InLoopIndex))//'="'//TRIM(Alphas(InLoopIndex))// &
'" not found.',UnitNumber)
ErrorsFound=.true.
ELSE
! Process for month, day
StartMonth=INT(Numbers(NumPointer+1))
StartDay=INT(Numbers(NumPointer+2))
EndMonth=INT(Numbers(NumPointer+3))
EndDay=INT(Numbers(NumPointer+4))
NumPointer=NumPointer+4
StartPointer=JulianDay(StartMonth,StartDay,1)
EndPointer=JulianDay(EndMonth,EndDay,1)
IF (StartPointer <= EndPointer) THEN
DO Count=StartPointer,EndPointer
DaysInYear(Count)=DaysInYear(Count)+1
Schedule(LoopIndex)%WeekSchedulePointer(Count)=WeekIndex
END DO
ELSE
DO Count=StartPointer,366
DaysInYear(Count)=DaysInYear(Count)+1
Schedule(LoopIndex)%WeekSchedulePointer(Count)=WeekIndex
END DO
DO Count=1,EndPointer
DaysInYear(Count)=DaysInYear(Count)+1
Schedule(LoopIndex)%WeekSchedulePointer(Count)=WeekIndex
END DO
ENDIF
ENDIF
END DO
! Perform Error checks on this item
! Do special test for Feb 29. Make equal to Feb 28.
IF (DaysinYear(60) == 0) THEN
DaysinYear(60)=DaysinYear(59)
Schedule(LoopIndex)%WeekSchedulePointer(60)=Schedule(LoopIndex)%WeekSchedulePointer(59)
ENDIF
IF (ANY(DaysinYear == 0)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(LoopIndex)%Name)// &
'" has missing days in its schedule pointers',UnitNumber)
ErrorsFound=.true.
ENDIF
IF (ANY(DaysinYear > 1)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(LoopIndex)%Name)// &
'" has overlapping days in its schedule pointers',UnitNumber)
ErrorsFound=.true.
ENDIF
IF (AnyEnergyManagementSystemInModel) THEN ! setup constant schedules as actuators
CALL SetupEMSActuator('Schedule:Year', &
Schedule(LoopIndex)%Name, 'Schedule Value', '[ ]',&
Schedule(LoopIndex)%EMSActuatedOn, Schedule(LoopIndex)%EMSValue )
ENDIF
END DO
!!! Get Compact Schedules
!SCHEDULE:COMPACT,
! \memo Irregular object. Does not follow the usual definition for fields. Fields A3... are:
! \memo Through: Date
! \memo For: Applicable days (ref: Weekschedule:Compact)
! \memo Interpolate: Yes/No (ref: Dayschedule:interval) -- optional, if not used will be "No"
! \memo Until: <Time> (ref: Dayschedule:Interval)
! \memo <numeric value>
! \memo words "Through","For","Interpolate","Until" must be included.
! A1 , \field Name
! \required-field
! \type alpha
! \reference ScheduleNames
! A2 , \field ScheduleType
! \type object-list
! \object-list ScheduleTypeNames
! A3 , \field Complex Field #1
! A4 , \field Complex Field #2
! A5 , \field Complex Field #3
SchNum=NumRegSchedules
AddWeekSch=NumRegWeekSchedules
AddDaySch=NumRegDaySchedules
CurrentModuleObject='Schedule:Compact'
DO LoopIndex=1,NumCptSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),Schedule(1:NumSchedules)%Name,SchNum,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
SchNum=SchNum+1
Schedule(SchNum)%Name=Alphas(1)
Schedule(SchNum)%SchType=ScheduleInput_compact
! Validate ScheduleType
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
Schedule(SchNum)%ScheduleTypePtr=CheckIndex
ENDIF
NumPointer=0
DaysInYear=0
! Process the "complex" fields -- so named because they are not a 1:1 correspondence
! as other objects are
NumField=3
StartPointer=1
WkCount=0
DyCount=0
FullYearSet=.false.
Through: DO WHILE (NumField < NumAlphas)
! Process "Through"
IF (Alphas(NumField)(1:8) /= 'THROUGH:' .and. Alphas(NumField)(1:7) /= 'THROUGH') THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(SchNum)%Name)// &
'", Expecting "Through:" date')
CALL ShowContinueError('Instead, found entry='//TRIM(Alphas(NumField)))
ErrorsFound=.true.
EXIT Through
ELSE
IF (Alphas(NumField)(8:8) == ':') THEN
sPos=9
ELSE
sPos=8
ENDIF
Alphas(NumField)=Alphas(NumField)(sPos:)
Alphas(NumField)=ADJUSTL(Alphas(NumField))
ENDIF
CurrentThrough=Alphas(NumField)
ErrorHere=.false.
CALL ProcessDateString(Alphas(NumField),EndMonth,EndDay,PWeekDay,PDateType,ErrorHere)
IF (PDateType > 1) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(SchNum)%Name)// &
'", Invalid "Through:" date')
CALL ShowContinueError('Found entry='//TRIM(Alphas(NumField)))
ErrorsFound=.true.
EXIT Through
ELSEIF (ErrorHere) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(SchNum)%Name)// &
'", Invalid "Through:" date')
CALL ShowContinueError('Found entry='//TRIM(Alphas(NumField)))
ErrorsFound=.true.
EXIT Through
ELSE
EndPointer=JulianDay(EndMonth,EndDay,1)
IF (EndPointer == 366) THEN
IF (FullYearSet) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(SchNum)%Name)// &
'", New "Through" entry when "full year" already set')
CALL ShowContinueError('"Through" field='//TRIM(CurrentThrough))
ErrorsFound=.true.
ENDIF
FullYearSet=.true.
ENDIF
ENDIF
WkCount=WkCount+1
AddWeekSch=AddWeekSch+1
WRITE(ExtraField,*) WkCount
ExtraField=ADJUSTL(ExtraField)
WeekSchedule(AddWeekSch)%Name=TRIM(Alphas(1))//'_wk_'//TRIM(ExtraField)
WeekSchedule(AddWeekSch)%Used=.true.
DO Hr=StartPointer,EndPointer
Schedule(SchNum)%WeekSchedulePointer(Hr)=AddWeekSch
DaysInYear(Hr)=DaysInYear(Hr)+1
ENDDO
StartPointer=EndPointer+1
ThruField=NumField
AllDays=.false.
NumField=NumField+1
For: DO WHILE (NumField < NumAlphas) ! Continues until next "Through"
IF (Alphas(NumField)(1:7) == 'THROUGH') EXIT For
! "For" must be next, adds to "# Day Schedules"
IF (Alphas(NumField)(1:3) == 'FOR') THEN
DyCount=DyCount+1
AddDaySch=AddDaySch+1
WRITE(ExtraField,*) DyCount
ExtraField=ADJUSTL(ExtraField)
DaySchedule(AddDaySch)%Name=TRIM(Alphas(1))//'_dy_'//TRIM(ExtraField)
DaySchedule(AddDaySch)%ScheduleTypePtr=Schedule(SchNum)%ScheduleTypePtr
DaySchedule(AddDaySch)%Used=.true.
TheseDays=.false.
ErrorHere=.false.
LastFor=Alphas(NumField)
CALL ProcessForDayTypes(Alphas(NumField),TheseDays,AllDays,ErrorHere)
IF (ErrorHere) THEN
CALL ShowContinueError('ref '//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'"')
CALL ShowContinueError('ref Through field='//TRIM(Alphas(ThruField)))
ErrorsFound=.true.
ELSE
DO Hr=1,MaxDayTypes
IF (TheseDays(Hr)) THEN
WeekSchedule(AddWeekSch)%DaySchedulePointer(Hr)=AddDaySch
ENDIF
ENDDO
ENDIF
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Looking for "For" field, found='//TRIM(Alphas(NumField)))
ErrorsFound=.true.
! CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(SchNum)%Name)// &
! '", Expecting "For:" day types')
! CALL ShowContinueError('Instead, found entry='//TRIM(Alphas(NumField)))
EXIT Through
ENDIF
! Check for "Interpolate"
NumField=NumField+1
IF (Alphas(NumField)(1:11) == 'INTERPOLATE') THEN
IF (INDEX(Alphas(NumField),'YES') > 0) THEN
DaySchedule(AddDaySch)%IntervalInterpolated=.true.
ELSE
DaySchedule(AddDaySch)%IntervalInterpolated=.false.
ENDIF
NumField=NumField+1
ELSE
IF (Alphas(NumField)(1:5) /= 'UNTIL') THEN
IF (INDEX(Alphas(NumField),'YES') > 0) THEN
DaySchedule(AddDaySch)%IntervalInterpolated=.true.
ELSEIF (INDEX(Alphas(NumField),'NO') > 0) THEN
DaySchedule(AddDaySch)%IntervalInterpolated=.false.
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Illegal Field entered ='//TRIM(Alphas(NumField)))
ErrorsFound=.true.
ENDIF
NumField=NumField+1
ENDIF
ENDIF
NumNumbers=0
xxcount=0
UntilFld=NumField
Until: DO
IF (Alphas(NumField)(1:3) == 'FOR') EXIT Until
IF (Alphas(NumField)(1:7) == 'THROUGH') EXIT Until
IF (Alphas(NumField)(1:5) == 'UNTIL') THEN
! Process Until/Value pairs for later processing by other routine.
NumField=NumField+1
xxcount=xxcount+1
NumNumbers=NumNumbers+1
Numbers(NumNumbers)=ProcessNumber(Alphas(NumField),ErrorHere)
IF (ErrorHere) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'"')
CALL ShowContinueError('Until field=['//trim(Alphas(NumField-1))//'] has illegal value field=['// &
trim(Alphas(NumField))//'].')
ErrorsFound=.true.
ENDIF
NumField=NumField+1
Alphas(UntilFld+xxcount)=Alphas(NumField) ! Incase next is "until"
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Looking for "Until" field, found='//TRIM(Alphas(NumField)))
ErrorsFound=.true.
EXIT Through
ENDIF
IF (Alphas(NumField) == Blank) EXIT Until
ENDDO Until
! Process Untils, Numbers
IF (NumNumbers > 0) THEN
NumFields=NumNumbers
ErrorHere=.false.
CALL ProcessIntervalFields(Alphas(UntilFld:),Numbers,NumFields,NumNumbers,MinuteValue,SetMinuteValue, &
ErrorHere,DaySchedule(AddDaySch)%Name,TRIM(CurrentModuleObject)//' DaySchedule Fields')
! Depending on value of "Interpolate" field, the value for each time step in each hour gets processed:
IF (ErrorHere) THEN
CALL ShowContinueError('ref '//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))//'"')
ErrorsFound=.true.
ENDIF
IF (.not. DaySchedule(AddDaySch)%IntervalInterpolated) THEN ! No validation done on the value of the interpolation field
DO Hr=1,24
CurMinute=MinutesPerTimeStep
DO TS=1,NumOfTimeStepInHour
DaySchedule(AddDaySch)%TSValue(Hr,TS)=MinuteValue(Hr,CurMinute)
Curminute=CurMinute+MinutesPerTimeStep
ENDDO
ENDDO
ELSE
DO Hr=1,24
SCount=1
CurMinute=MinutesPerTimeStep
DO TS=1,NumOfTimeStepInHour
! tempval=SUM(MinuteValue(Hr,SCount:CurMinute))/REAL(MinutesPerTimeStep,r64)
DaySchedule(AddDaySch)%TSValue(Hr,TS)=SUM(MinuteValue(Hr,SCount:CurMinute))/REAL(MinutesPerTimeStep,r64)
SCount=CurMinute+1
CurMinute=CurMinute+MinutesPerTimeStep
ENDDO
ENDDO
ENDIF
ENDIF
ENDDO For
IF (Any(.not. AllDays)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(SchNum)%Name)// &
'" has missing day types in Through='//TRIM(CurrentThrough))
CALL ShowContinueError('Last "For" field='//TRIM(LastFor))
errmsg='Missing day types=,'
DO kdy=1,MaxDayTypes
IF (AllDays(kdy)) CYCLE
errmsg=errmsg(1:len_trim(errmsg)-1)//'"'//trim(ValidDayTypes(kdy))//'",-'
ENDDO
errmsg=errmsg(1:len_trim(errmsg)-2)
CALL ShowContinueError(trim(errmsg))
CALL ShowContinueError('Missing day types will have 0.0 as Schedule Values')
ENDIF
ENDDO Through
IF (DaysinYear(60) == 0) THEN
DaysinYear(60)=DaysinYear(59)
Schedule(LoopIndex)%WeekSchedulePointer(60)=Schedule(LoopIndex)%WeekSchedulePointer(59)
ENDIF
IF (ANY(DaysinYear == 0)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(SchNum)%Name)// &
'" has missing days in its schedule pointers',UnitNumber)
ErrorsFound=.true.
ENDIF
IF (ANY(DaysinYear > 1)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Schedule(SchNum)%Name)// &
'" has overlapping days in its schedule pointers',UnitNumber)
ErrorsFound=.true.
ENDIF
IF (AnyEnergyManagementSystemInModel) THEN ! setup constant schedules as actuators
Call SetupEMSActuator('Schedule:Compact', &
Schedule(SchNum)%Name, 'Schedule Value', '[ ]',&
Schedule(SchNum)%EMSActuatedOn, Schedule(SchNum)%EMSValue )
ENDIF
END DO
! Schedule:File,
! \min-fields 5
! \memo A Schedule:File points to a text computer file that has 8760-8784 hours of data.
! A1 , \field Name
! \required-field
! \type alpha
! \reference ScheduleNames
! A2 , \field Schedule Type Limits Name
! \type object-list
! \object-list ScheduleTypeLimitsNames
! A3 , \field File Name
! \required-field
! \retaincase
! N1 , \field Column Number
! \required-field
! \type integer
! \minimum 1
! N2 , \field Rows to Skip at Top
! \required-field
! \type integer
! \minimum 0
! N3 , \field Number of Hours of Data
! \note 8760 hours does not account for leap years, 8784 does.
! \note should be either 8760 or 8784
! \default 8760
! \minimum 8760
! \maximum 8784
! A4 , \field Column Separator
! \type choice
! \key Comma
! \key Tab
! \key Fixed
! \key Semicolon
! \default Comma
! A5 , \field Interpolate to Timestep
! \note when the interval does not match the user specified timestep a "Yes" choice will average between the intervals request (to
! \note timestep resolution. a "No" choice will use the interval value at the simulation timestep without regard to if it matches
! \note the boundary or not.
! \type choice
! \key Yes
! \key No
! \default No
! N4 ; \field Minutes per Item
! \note Must be evenly divisible into 60
! \type integer
! \minimum 1
! \maximum 60
! continue adding to SchNum,AddWeekSch,AddDaySch
IF (NumCommaFileSchedules > 0) THEN
ALLOCATE(hourlyFileValues(8784*60)) ! sized to accomodate any interval for schedule file.
ENDIF
CurrentModuleObject='Schedule:File'
DO LoopIndex=1,NumCommaFileSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),Schedule(1:NumSchedules)%Name,SchNum,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
SchNum = SchNum + 1
Schedule(SchNum)%Name=Alphas(1)
Schedule(SchNum)%SchType=ScheduleInput_file
! Validate ScheduleType
IF (NumScheduleTypes > 0) THEN
CheckIndex=0
IF (.not. lAlphaBlanks(2)) &
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError('ProcessScheduleInput: For '//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError('For '//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
Schedule(SchNum)%ScheduleTypePtr=CheckIndex
ENDIF
ENDIF
hourlyFileValues = 0.0d0 !set default values to zero
! Numbers(1) - which column
curcolCount=Numbers(1)
! Numbers(2) - number of rows to skip
skiprowCount=Numbers(2)
IF (Numbers(3) == 0) Numbers(3)=8760.0d0
IF (Numbers(3) /= 8760 .and. Numbers(3) /= 8784) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cNumericFields(3))//' must = 8760 or 8784 (for a leap year)')
CALL ShowContinueError('..Value for field = '//TRIM(TrimSigDigits(Numbers(3),0))//', Schedule not processed.')
ErrorsFound=.true.
CYCLE
ENDIF
IF (lAlphaBlanks(4) .or. SameString(Alphas(4),'comma')) THEN
ColumnSep=CharComma
Alphas(4)='comma'
ELSEIF (SameString(Alphas(4),'semicolon')) THEN
ColumnSep=CharSemicolon
ELSEIF (SameString(Alphas(4),'tab')) THEN
ColumnSep=CharTab
ELSEIF (SameString(Alphas(4),'space')) THEN
ColumnSep=CharSpace
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(4))//' illegal value="'//trim(Alphas(4))//'".')
CALL ShowContinueError('..must be Comma, Semicolon, Tab, or Space.')
ErrorsFound=.true.
CYCLE
ENDIF
! Depending on value of "Interpolate" field, the value for each time step in each hour gets processed:
FileIntervalInterpolated=.false.
IF (lAlphaBlanks(5)) Alphas(5)='NO'
IF (Alphas(5) /= 'NO' .and. Alphas(5) /= 'YES') THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'Invalid value for "'//TRIM(cAlphaFields(5))//'" field="'//TRIM(Alphas(5))//'"')
ErrorsFound=.true.
ELSEIF (Alphas(5) /= 'YES') THEN ! No validation done on the value of the interpolation field
FileIntervalInterpolated=.false.
ELSE
FileIntervalInterpolated=.true.
ENDIF
! is it a sub-hourly schedule or not?
MinutesPerItem=60
IF (NumNumbers > 3) THEN
MinutesPerItem=INT(Numbers(4))
NumExpectedItems=1440/MinutesPerItem
IF (MOD(60,MinutesPerItem) /= 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1)))
CALL ShowContinueError('Requested '//TRIM(cNumericFields(4))//' field value ('// &
TRIM(RoundSigDigits(MinutesPerItem))//') not evenly divisible into 60')
ErrorsFound=.true.
CYCLE
ENDIF
ENDIF
numHourlyValues=Numbers(3)
rowLimitCount=(Numbers(3)*60.0d0)/MinutesPerItem
hrLimitCount=60/MinutesPerItem
! ! Number of numbers in the Numbers list okay to process
! Hr=1
! CurMinute=MinutesPerItem
! SCount=1
! DO NumFields=2,NumNumbers
! MinuteValue(Hr,SCount:CurMinute)=Numbers(NumFields)
! SCount=CurMinute+1
! CurMinute=CurMinute+MinutesPerItem
! IF (CurMinute > 60) THEN
! CurMinute=MinutesPerItem
! SCount=1
! Hr=Hr+1
! ENDIF
! ENDDO
!
! ! Now parcel into TS Value....
!
! IF (DaySchedule(Count)%IntervalInterpolated) THEN
! DO Hr=1,24
! SCount=1
! CurMinute=MinutesPerTimeStep
! DO TS=1,NumOfTimeStepInHour
! DaySchedule(Count)%TSValue(Hr,TS)=SUM(MinuteValue(Hr,SCount:CurMinute))/REAL(MinutesPerTimeStep,r64)
! SCount=CurMinute+1
! CurMinute=CurMinute+MinutesPerTimeStep
! ENDDO
! ENDDO
! ELSE
! DO Hr=1,24
! CurMinute=MinutesPerTimeStep
! DO TS=1,NumOfTimeStepInHour
! DaySchedule(Count)%TSValue(Hr,TS)=MinuteValue(Hr,CurMinute)
! Curminute=CurMinute+MinutesPerTimeStep
! ENDDO
! ENDDO
! ENDIF
CALL CheckForActualFileName(Alphas(3),FileExists,TempFullFileName)
! INQUIRE(file=Alphas(3),EXIST=FileExists)
! Setup file reading parameters
StripCR=.false.
IF (.not. FileExists) THEN
CALL DisplayString('Missing '//TRIM(Alphas(3)))
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(3))//'="'//TRIM(Alphas(3))//'" not found.')
CALL ShowContinueError('Certain run environments require a full path to be included with the file name in the input field.')
CALL ShowContinueError('Try again with putting full path and file name in the field.')
ErrorsFound=.true.
ELSE
SchdFile = GetNewUnitNumber()
OPEN(unit=SchdFile, file=TempFullFileName, action='read', IOSTAT=read_stat)
IF (read_stat /= 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(3))//'="'//TRIM(Alphas(3))//'" cannot be opened.')
CALL ShowContinueError('... It may be open in another program (such as Excel). Please close and try again.')
CALL ShowFatalError('Program terminates due to previous condition.')
ENDIF
! check for stripping
READ(Unit=SchdFile, FMT="(A)", IOSTAT=read_stat) LineIn
endLine=LEN_TRIM(LineIn)
IF (endLine > 0) THEN
IF (ICHAR(LineIn(endLine:endLine)) == iASCII_CR) THEN
StripCR=.true.
LineIn(endLine:endLine)=Blank
ENDIF
IF (ICHAR(LineIn(endLine:endLine)) == iUnicode_end) THEN
CLOSE(unit=SchdFile)
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(3))//'="'//TRIM(Alphas(3))//' appears to be a Unicode or binary file.')
CALL ShowContinueError('...This file cannot be read by this program. Please save as PC or Unix file and try again')
CALL ShowFatalError('Program terminates due to previous condition.')
ENDIF
ENDIF
BACKSPACE(Unit=SchdFile)
! skip lines if any need to be skipped.
numerrors=0
rowCnt = 0
read_stat=0
IF (skiprowCount > 0) THEN ! Numbers(2) has number of rows to skip
DO WHILE (read_stat == 0) !end of file
READ(UNIT=SchdFile, FMT="(A)", IOSTAT=read_stat) LineIn
IF (StripCR) THEN
endLine=LEN_TRIM(LineIn)
IF (endLine > 0) THEN
IF (ICHAR(LineIn(endLine:endLine)) == iASCII_CR) LineIn(endLine:endLine)=Blank
ENDIF
ENDIF
rowCnt = rowCnt + 1
IF (rowCnt == skiprowCount) THEN
EXIT
END IF
END DO
ENDIF
! proper number of lines are skipped. read the file
! for the rest of the lines read from the file
rowCnt = 0
firstLine=.true.
DO WHILE (read_stat == 0) !end of file
READ(UNIT=SchdFile, FMT="(A)", IOSTAT=read_stat) LineIn
IF (StripCR) THEN
endLine=LEN_TRIM(LineIn)
IF (endLine > 0) THEN
IF (ICHAR(LineIn(endLine:endLine)) == iASCII_CR) LineIn(endLine:endLine)=Blank
ENDIF
ENDIF
rowCnt = rowCnt + 1
colCnt = 0
wordStart = 1
columnValue = 0.0d0
!scan through the line looking for a specific column
DO
sepPos = INDEX(LineIn, ColumnSep)
colCnt = colCnt + 1
IF (sepPos > 0) THEN
if (sepPos > 1) then
wordEnd = sepPos - 1
else
wordEnd = wordStart
endif
subString = TRIM(LineIn(wordStart:wordEnd))
!the next word will start after the comma
wordStart = sepPos + 1
!get rid of separator so next INDEX will find next separator
LineIn=LineIn(wordStart:)
firstLine=.false.
wordStart=1
ELSE
!no more commas
subString = LineIn(wordStart:)
if (firstLine .and. subString == Blank) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'" first line does not contain the indicated column separator='//trim(Alphas(4))//'.')
CALL ShowContinueError('...first 40 characters of line=['//trim(LineIn(1:40))//']')
firstLine=.false.
endif
EXIT
END IF
IF (colCnt .eq. curcolCount) EXIT
END DO
IF (colCnt .eq. curcolCount) THEN
columnValue = ProcessNumber(subString,errflag)
IF (errflag) THEN
numerrors=numerrors+1
columnValue = 0.0d0
ENDIF
ELSE
columnValue = 0.0d0
END IF
hourlyFileValues(rowCnt) = columnValue
IF (rowCnt .eq. rowLimitCount) EXIT
END DO
CLOSE(SchdFile)
! schedule values have been filled into the hourlyFileValues array.
IF (numerrors > 0) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'" '//trim(RoundSigDigits(numerrors))//' records had errors - these values are set to 0.')
CALL ShowContinueError('Use Output:Diagnostics,DisplayExtraWarnings; to see individual records in error.')
ENDIF
IF (rowCnt < rowLimitCount) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'" less than '//trim(RoundSigDigits(numHourlyValues))//' hourly values read from file.')
CALL ShowContinueError('..Number read='//TRIM(TrimSigDigits((rowCnt*60)/MinutesPerItem))//'.')
END IF
IF (rowCnt < rowLimitCount) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'" less than specified hourly values read from file.')
CALL ShowContinueError('..Specified Number of Hourly Values='//TRIM(TrimSigDigits(numHourlyValues,0))// &
' Actual number of hourly values included='//TRIM(TrimSigDigits((rowCnt*60)/MinutesPerItem)))
ENDIF
! process the data into the normal schedule data structures
! note -- schedules are ALWAYS 366 days so some special measures have to be done at 29 Feb "day of year" (60)
iDay=0
hDay=0
ifld=0
DO
! create string of which day of year
iDay=iDay+1
hDay=hDay+1
IF (iDay > 366) EXIT
ExtraField=RoundSigDigits(iDay)
! increment both since a week schedule is being defined for each day so that a day is valid
! no matter what the day type that is used in a design day.
AddWeekSch = AddWeekSch + 1
AddDaySch = AddDaySch + 1
! define week schedule
WeekSchedule(AddWeekSch)%Name=TRIM(Alphas(1))//'_wk_'//ExtraField
! for all day types point the week schedule to the newly defined day schedule
DO kDayType = 1, MaxDayTypes
WeekSchedule(AddWeekSch)%DaySchedulePointer(kDayType) = AddDaySch
END DO
! day schedule
DaySchedule(AddDaySch)%Name=TRIM(Alphas(1))//'_dy_'//ExtraField
DaySchedule(AddDaySch)%ScheduleTypePtr = Schedule(SchNum)%ScheduleTypePtr
! schedule is pointing to the week schedule
Schedule(SchNum)%WeekSchedulePointer(iDay) = AddWeekSch
IF (MinutesPerItem == 60) THEN
DO jHour = 1, 24
ifld=ifld+1
curHrVal = hourlyFileValues(ifld) ! hourlyFileValues((hDay - 1) * 24 + jHour)
DO TS=1,NumOfTimeStepInHour
DaySchedule(AddDaySch)%TSValue(jHour,TS) = curHrVal
END DO
END DO
ELSE ! Minutes Per Item < 60
DO Hr=1,24
CurMinute=MinutesPerItem
SCount=1
DO NumFields=1,hrLimitCount
ifld=ifld+1
MinuteValue(Hr,SCount:CurMinute)=hourlyFileValues(ifld)
SCount=CurMinute+1
CurMinute=CurMinute+MinutesPerItem
ENDDO
ENDDO
IF (FileIntervalInterpolated) THEN
DO Hr=1,24
SCount=1
CurMinute=MinutesPerTimeStep
DO TS=1,NumOfTimeStepInHour
DaySchedule(AddDaySch)%TSValue(Hr,TS)=SUM(MinuteValue(Hr,SCount:CurMinute))/REAL(MinutesPerTimeStep,r64)
SCount=CurMinute+1
CurMinute=CurMinute+MinutesPerTimeStep
ENDDO
ENDDO
ELSE
DO Hr=1,24
CurMinute=MinutesPerTimeStep
DO TS=1,NumOfTimeStepInHour
DaySchedule(AddDaySch)%TSValue(Hr,TS)=MinuteValue(Hr,CurMinute)
Curminute=CurMinute+MinutesPerTimeStep
ENDDO
ENDDO
ENDIF
ENDIF
IF (iDay == 59 .and. rowCnt < 8784*hrlimitcount) THEN ! 28 Feb
! Dup 28 Feb to 29 Feb (60)
iDay=iDay+1
Schedule(SchNum)%WeekSchedulePointer(iDay)=Schedule(SchNum)%WeekSchedulePointer(iDay-1)
ENDIF
END DO
ENDIF
IF (AnyEnergyManagementSystemInModel) THEN ! setup constant schedules as actuators
Call SetupEMSActuator('Schedule:File', &
Schedule(SchNum)%Name, 'Schedule Value', '[ ]',&
Schedule(SchNum)%EMSActuatedOn, Schedule(SchNum)%EMSValue )
ENDIF
END DO
IF (NumCommaFileSchedules > 0) THEN
DEALLOCATE(hourlyFileValues)
ENDIF
DEALLOCATE(MinuteValue)
DEALLOCATE(SetMinuteValue)
! Constant Schedules
CurrentModuleObject='Schedule:Constant'
DO LoopIndex=1,NumConstantSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),Schedule(1:NumSchedules)%Name,SchNum,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
SchNum = SchNum + 1
Schedule(SchNum)%Name=Alphas(1)
Schedule(SchNum)%SchType=ScheduleInput_constant
! Validate ScheduleType
IF (NumScheduleTypes > 0) THEN
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
Schedule(SchNum)%ScheduleTypePtr=CheckIndex
ENDIF
ENDIF
AddWeekSch = AddWeekSch + 1
AddDaySch = AddDaySch + 1
! define week schedule
WeekSchedule(AddWeekSch)%Name=TRIM(Alphas(1))//'_wk_'
! for all day types point the week schedule to the newly defined day schedule
DO kDayType = 1, MaxDayTypes
WeekSchedule(AddWeekSch)%DaySchedulePointer(kDayType) = AddDaySch
END DO
! day schedule
DaySchedule(AddDaySch)%Name=TRIM(Alphas(1))//'_dy_'
DaySchedule(AddDaySch)%ScheduleTypePtr = Schedule(SchNum)%ScheduleTypePtr
! schedule is pointing to the week schedule
Schedule(SchNum)%WeekSchedulePointer = AddWeekSch
curHrVal = Numbers(1)
DaySchedule(AddDaySch)%TSValue = Numbers(1)
IF (AnyEnergyManagementSystemInModel) THEN ! setup constant schedules as actuators
Call SetupEMSActuator('Schedule:Constant', &
Schedule(SchNum)%Name, 'Schedule Value', '[ ]',&
Schedule(SchNum)%EMSActuatedOn, Schedule(SchNum)%EMSValue )
ENDIF
END DO
CurrentModuleObject='ExternalInterface:Schedule'
DO LoopIndex=1,NumExternalInterfaceSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),Schedule(1:NumSchedules)%Name,SchNum,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name') ! Bug fix
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
SchNum=SchNum+1
Schedule(SchNum)%Name=Alphas(1)
Schedule(SchNum)%SchType=ScheduleInput_external
! Validate ScheduleType
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
Schedule(SchNum)%ScheduleTypePtr=CheckIndex
ENDIF
AddWeekSch=AddWeekSch+1
WeekSchedule(AddWeekSch)%Name=TRIM(Alphas(1))
WeekSchedule(AddWeekSch)%Used=.true.
DO Hr=1,366
Schedule(SchNum)%WeekSchedulePointer(Hr)=AddWeekSch
ENDDO
AddDaySch=AddDaySch+1
DaySchedule(AddDaySch)%Name=TRIM(Alphas(1))
DaySchedule(AddDaySch)%ScheduleTypePtr=Schedule(SchNum)%ScheduleTypePtr
DaySchedule(AddDaySch)%Used=.true.
DO Hr = 1, MaxDayTypes
WeekSchedule(AddWeekSch)%DaySchedulePointer(Hr) = AddDaySch
END DO
! Initialize the ExternalInterface day schedule for the ExternalInterface compact schedule.
! It will be overwritten during run time stepping after the warm up period
IF (NumNumbers<1) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", initial value is not numeric or is missing. Fix idf file.')
NumErrorFlag=.true.
ENDIF
CALL ExternalInterfaceSetSchedule(AddDaySch, Numbers(1))
ENDDO
! added for FMU Import
CurrentModuleObject='ExternalInterface:FunctionalMockupUnitImport:To:Schedule'
DO LoopIndex=1,NumExternalInterfaceFunctionalMockupUnitImportSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
IF (NumExternalInterfaceSchedules .ge. 1) THEN
CALL VerifyName(Alphas(1),Schedule(1:NumSchedules)%Name,SchNum,IsNotOK,IsBlank, 'The schedule object with the name "' &
//TRIM(Alphas(1))//'" is defined as an ExternalInterface:Schedule and ' &
//'ExternalInterface:FunctionalMockupUnitImport:To:Schedule. This will cause the schedule to be overwritten' &
//' by PtolemyServer and FunctionalMockUpUnitImport.')
ELSE
CALL VerifyName(Alphas(1),Schedule(1:NumSchedules)%Name,SchNum,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
END IF
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
! END IF
SchNum=SchNum+1
Schedule(SchNum)%Name=Alphas(1)
Schedule(SchNum)%SchType=ScheduleInput_external
! Validate ScheduleType
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
Schedule(SchNum)%ScheduleTypePtr=CheckIndex
ENDIF
AddWeekSch=AddWeekSch+1
WeekSchedule(AddWeekSch)%Name=TRIM(Alphas(1))
WeekSchedule(AddWeekSch)%Used=.true.
DO Hr=1,366
Schedule(SchNum)%WeekSchedulePointer(Hr)=AddWeekSch
ENDDO
AddDaySch=AddDaySch+1
DaySchedule(AddDaySch)%Name=TRIM(Alphas(1))
DaySchedule(AddDaySch)%ScheduleTypePtr=Schedule(SchNum)%ScheduleTypePtr
DaySchedule(AddDaySch)%Used=.true.
DO Hr = 1, MaxDayTypes
WeekSchedule(AddWeekSch)%DaySchedulePointer(Hr) = AddDaySch
END DO
! Initialize the ExternalInterface day schedule for the ExternalInterface compact schedule.
! It will be overwritten during run time stepping after the warm up period
IF (NumNumbers<1) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", initial value is not numeric or is missing. Fix idf file.')
NumErrorFlag=.true.
ENDIF
CALL ExternalInterfaceSetSchedule(AddDaySch, Numbers(1))
ENDDO
! added for FMU Export
CurrentModuleObject='ExternalInterface:FunctionalMockupUnitExport:To:Schedule'
DO LoopIndex=1,NumExternalInterfaceFunctionalMockupUnitExportSchedules
CALL GetObjectItem(CurrentModuleObject,LoopIndex,Alphas,NumAlphas,Numbers,NumNumbers,Status, &
AlphaBlank=lAlphaBlanks,NumBlank=lNumericBlanks, &
AlphaFieldnames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
IF (NumExternalInterfaceSchedules .ge. 1) THEN
CALL VerifyName(Alphas(1),Schedule(1:NumSchedules)%Name,SchNum,IsNotOK,IsBlank, 'The schedule object with the name "' &
//TRIM(Alphas(1))//'" is defined as an ExternalInterface:Schedule and ' &
//'ExternalInterface:FunctionalMockupUnitExport:To:Schedule. This will cause the schedule to be overwritten' &
//' by PtolemyServer and FunctionalMockUpUnitExport.')
ELSE
CALL VerifyName(Alphas(1),Schedule(1:NumSchedules)%Name,SchNum,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
END IF
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
SchNum=SchNum+1
Schedule(SchNum)%Name=Alphas(1)
Schedule(SchNum)%SchType=ScheduleInput_external
! Validate ScheduleType
CheckIndex=FindIteminList(Alphas(2),ScheduleType(1:NumScheduleTypes)%Name,NumScheduleTypes)
IF (CheckIndex == 0) THEN
IF (.not. lAlphaBlanks(2)) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", '//TRIM(cAlphaFields(2))//'="'//TRIM(Alphas(2))// &
'" not found -- will not be validated')
ELSE
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", Blank '//TRIM(cAlphaFields(2))//' input -- will not be validated.')
ENDIF
ELSE
Schedule(SchNum)%ScheduleTypePtr=CheckIndex
ENDIF
AddWeekSch=AddWeekSch+1
WeekSchedule(AddWeekSch)%Name=TRIM(Alphas(1))
WeekSchedule(AddWeekSch)%Used=.true.
DO Hr=1,366
Schedule(SchNum)%WeekSchedulePointer(Hr)=AddWeekSch
ENDDO
AddDaySch=AddDaySch+1
DaySchedule(AddDaySch)%Name=TRIM(Alphas(1))
DaySchedule(AddDaySch)%ScheduleTypePtr=Schedule(SchNum)%ScheduleTypePtr
DaySchedule(AddDaySch)%Used=.true.
DO Hr = 1, MaxDayTypes
WeekSchedule(AddWeekSch)%DaySchedulePointer(Hr) = AddDaySch
END DO
! Initialize the ExternalInterface day schedule for the ExternalInterface compact schedule.
! It will be overwritten during run time stepping after the warm up period
IF (NumNumbers<1) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(Alphas(1))// &
'", initial value is not numeric or is missing. Fix idf file.')
NumErrorFlag=.true.
ENDIF
CALL ExternalInterfaceSetSchedule(AddDaySch, Numbers(1))
ENDDO
! Validate by ScheduleLimitsType
DO SchNum=1,NumSchedules
NumPointer=Schedule(SchNum)%ScheduleTypePtr
IF (.not. ScheduleType(NumPointer)%Limited) CYCLE
IF (CheckScheduleValueMinMax(SchNum,'>=',ScheduleType(NumPointer)%Minimum,'<=',ScheduleType(NumPointer)%Maximum)) CYCLE
CALL ShowSevereError(RoutineName//'Schedule="'//TRIM(Schedule(SchNum)%Name)// &
'" has values outside its Schedule Type ('// &
TRIM(ScheduleType(NumPointer)%Name)//') range')
CALL ShowContinueError(' Minimum should be >='//TRIM(RoundSigDigits(ScheduleType(NumPointer)%Minimum,3))// &
' and Maximum should be <='//TRIM(RoundSigDigits(ScheduleType(NumPointer)%Maximum,3)))
ErrorsFound=.true.
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Preceding Errors cause termination.')
ENDIF
IF (NumScheduleTypes+NumDaySchedules+NumWeekSchedules+NumSchedules > 0) THEN ! Report to EIO file
CurrentModuleObject='Output:Schedules'
NumFields=GetNumObjectsFound(CurrentModuleObject)
! RptSchedule=.false.
RptLevel=1
DO Count=1,NumFields
CALL GetObjectItem(CurrentModuleObject,Count,Alphas,NumAlphas,Numbers,NumNumbers,Status)
! RptSchedule=.true.
SELECT CASE (Alphas(1))
CASE ('HOURLY')
RptLevel=1
CALL ReportScheduleDetails(RptLevel)
CASE ('TIMESTEP','DETAILED')
RptLevel=2
CALL ReportScheduleDetails(RptLevel)
CASE ('IDF')
RptLevel=3
CALL ReportScheduleDetails(RptLevel)
CASE DEFAULT
CALL ShowWarningError(RoutineName//'Report for Schedules should specify "HOURLY" or "TIMESTEP" ("DETAILED")')
CALL ShowContinueError('HOURLY report will be done')
RptLevel=1
CALL ReportScheduleDetails(RptLevel)
END SELECT
ENDDO
ENDIF
DEALLOCATE(Alphas)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(Numbers)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
WRITE(UnitNumber,*) ' Processing Schedule Input -- Complete'
RETURN
END SUBROUTINE ProcessScheduleInput