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