Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer | :: | TotRunPers | ||||
logical, | intent(inout) | :: | ErrorsFound |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE GetRunPeriodData(TotRunPers,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Liesen
! DATE WRITTEN October 1997
! MODIFIED February 1999, Add multiple run periods, Change name.
! March 2012, LKL, Add features to object; New "actual weather" object;
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the run period info from User input and the
! simulation dates
! METHODOLOGY EMPLOYED:
!
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList, GetObjectItem, SameString, VerifyName, GetNumObjectsFound
USE General, ONLY: JulianDay,TrimSigDigits
USE DataSystemVariables
USE DataIPShortCuts
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer :: TotRunPers ! Total number of Run Periods requested
LOGICAL, INTENT(INOUT) :: ErrorsFound
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumAlpha ! Number of alphas being input
INTEGER :: NumNumeric ! Number of numbers being input
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: Loop
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: Count
TYPE (EnvironmentData), ALLOCATABLE, DIMENSION(:) :: TempEnvironment ! Environment data
Integer :: RP ! number of run periods
Integer :: RPAW ! number of run periods, actual weather
Integer :: Ptr
Integer :: LocalLeapYearAdd
! FLOW:
RP=GetNumObjectsFound('RunPeriod')
RPAW=GetNumObjectsFound('RunPeriod:CustomRange')
!Call Input Get routine to retrieve annual run data
ALLOCATE (RunPeriodInput(TotRunPers))
cCurrentModuleObject='RunPeriod'
count=0
IF(.not. WFAllowsLeapYears) THEN
LocalLeapYearAdd=0
ELSE
LocalLeapYearAdd=1
ENDIF
DO Loop=1,RP
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlpha,rNumericArgs,NumNumeric,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IF (.not. lAlphaFieldBlanks(1)) THEN
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),RunPeriodInput%Title,Count,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
ENDIF
Count=Count+1
RunPeriodInput(Loop)%Title=cAlphaArgs(1)
!set the start and end day of month from user input
! N1 , \field Begin Month
! N2 , \field Begin Day of Month
! N3 , \field End Month
! N4 , \field End Day of Month
RunPeriodInput(Loop)%StartMonth = Int(rNumericArgs(1))
RunPeriodInput(Loop)%StartDay = Int(rNumericArgs(2))
RunPeriodInput(Loop)%EndMonth = Int(rNumericArgs(3))
RunPeriodInput(Loop)%EndDay = Int(rNumericArgs(4))
! N5, \field Number of Times Runperiod to be Repeated
IF (INT(rNumericArgs(5))==0) THEN
RunPeriodInput(Loop)%NumSimYears = 1
ELSE
RunPeriodInput(Loop)%NumSimYears = INT(rNumericArgs(5))
ENDIF
! N6; \field Start Year
IF (INT(rNumericArgs(6))==0) THEN
RunPeriodInput(Loop)%BeginYear = autocalculate
RunPeriodInput(Loop)%TreatYearsAsConsecutive = .false.
ELSE
RunPeriodInput(Loop)%BeginYear = INT(rNumericArgs(6))
RunPeriodInput(Loop)%TreatYearsAsConsecutive = .true.
ENDIF
IF (FullAnnualRun .and. Loop == 1) THEN
RunPeriodInput(Loop)%StartMonth = 1
RunPeriodInput(Loop)%StartDay = 1
RunPeriodInput(Loop)%EndMonth = 12
RunPeriodInput(Loop)%EndDay = 31
ENDIF
SELECT CASE (RunPeriodInput(Loop)%StartMonth)
CASE (1,3,5,7,8,10,12)
IF (RunPeriodInput(Loop)%StartDay > 31) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(2))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(1))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%StartMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE (4,6,9,11)
IF (RunPeriodInput(Loop)%StartDay > 30) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(2))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(1))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%StartMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE (2)
IF (RunPeriodInput(Loop)%StartDay > 28+LocalLeapYearAdd) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(2))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(1))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%StartMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cNumericFieldNames(2))//' invalid=['// &
TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartMonth))//']')
ErrorsFound=.true.
END SELECT
SELECT CASE (RunPeriodInput(Loop)%EndMonth)
CASE (1,3,5,7,8,10,12)
IF (RunPeriodInput(Loop)%EndDay > 31) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(4))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%EndDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(3))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%EndMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE (4,6,9,11)
IF (RunPeriodInput(Loop)%EndDay > 30) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(4))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%EndDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(3))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%EndMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE (2)
IF (RunPeriodInput(Loop)%EndDay > 28+LocalLeapYearAdd) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(4))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%EndDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(3))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%EndMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cNumericFieldNames(3))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%EndMonth))//']')
ErrorsFound=.true.
END SELECT
! A2 , \field Day of Week for Start Day
IF (lAlphaFieldBlanks(2) .or. cAlphaArgs(2) == 'USEWEATHERFILE') THEN
RunPeriodInput(Loop)%DayOfWeek=0 ! Defaults to Day of Week from Weather File
ELSE
RunPeriodInput(Loop)%DayOfWeek=FindItemInList(cAlphaArgs(2),DaysOfWeek,7)
IF (RunPeriodInput(Loop)%DayOfWeek == 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(2))//' invalid (Day of Week) ['// &
TRIM(cAlphaArgs(2))//' for Start is not Valid, DayofWeek from WeatherFile will be used.')
ENDIF
ENDIF
! A3, \field Use Weather File Holidays and Special Days
IF (lAlphaFieldBlanks(3) .or. SameString(cAlphaArgs(3),'YES')) THEN
RunPeriodInput(Loop)%UseHolidays=.true.
ELSEIF (SameString(cAlphaArgs(3),'NO')) THEN
RunPeriodInput(Loop)%UseHolidays=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(3))//' invalid ['//TRIM(cAlphaArgs(3))//']')
ErrorsFound=.true.
ENDIF
! A4, \field Use Weather File Daylight Saving Period
IF (lAlphaFieldBlanks(4) .or. SameString(cAlphaArgs(4),'YES')) THEN
RunPeriodInput(Loop)%UseDST=.true.
ELSEIF (SameString(cAlphaArgs(4),'NO')) THEN
RunPeriodInput(Loop)%UseDST=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(4))//' invalid ['//TRIM(cAlphaArgs(4))//']')
ErrorsFound=.true.
ENDIF
! A5, \field Apply Weekend Holiday Rule
IF (lAlphaFieldBlanks(5) .or. SameString(cAlphaArgs(5),'YES')) THEN
RunPeriodInput(Loop)%ApplyWeekendRule=.true.
ELSEIF (SameString(cAlphaArgs(5),'NO')) THEN
RunPeriodInput(Loop)%ApplyWeekendRule=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(5))//' invalid ['//TRIM(cAlphaArgs(5))//']')
ErrorsFound=.true.
ENDIF
! A6, \field Use Weather File Rain Indicators
IF (lAlphaFieldBlanks(6) .or. SameString(cAlphaArgs(6),'YES')) THEN
RunPeriodInput(Loop)%UseRain=.true.
ELSEIF (SameString(cAlphaArgs(6),'NO')) THEN
RunPeriodInput(Loop)%UseRain=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(6))//' invalid ['//TRIM(cAlphaArgs(6))//']')
ErrorsFound=.true.
ENDIF
! A7, \field Use Weather File Snow Indicators
IF (lAlphaFieldBlanks(7) .or. SameString(cAlphaArgs(7),'YES')) THEN
RunPeriodInput(Loop)%UseSnow=.true.
ELSEIF (SameString(cAlphaArgs(7),'NO')) THEN
RunPeriodInput(Loop)%UseSnow=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(7))//' invalid ['//TRIM(cAlphaArgs(7))//']')
ErrorsFound=.true.
ENDIF
! A8, \field Increment Day of Week on repeat
IF (lAlphaFieldBlanks(8) .or. SameString(cAlphaArgs(8),'YES')) THEN
RunPeriodInput(Loop)%RollDayTypeOnRepeat=.true.
ELSEIF (SameString(cAlphaArgs(8),'NO')) THEN
RunPeriodInput(Loop)%RollDayTypeOnRepeat=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//' '// &
TRIM(cAlphaFieldNames(8))//' invalid ['//TRIM(cAlphaArgs(8))//']')
ErrorsFound=.true.
ENDIF
!calculate the annual start and end dates from the user inputted month and day
RunPeriodInput(Loop)%StartDate = JulianDay(RunPeriodInput(Loop)%StartMonth,RunPeriodInput(Loop)%StartDay,LeapYearAdd)
RunPeriodInput(Loop)%EndDate = JulianDay(RunPeriodInput(Loop)%EndMonth,RunPeriodInput(Loop)%EndDay,LeapYearAdd)
RunPeriodInput(Loop)%MonWeekDay=0
IF (RunPeriodInput(Loop)%DayOfWeek /= 0 .and. .not. ErrorsFound) THEN
CALL SetupWeekDaysByMonth(RunPeriodInput(Loop)%StartMonth,RunPeriodInput(Loop)%StartDay, &
RunPeriodInput(Loop)%DayOfWeek,RunPeriodInput(Loop)%MonWeekDay)
ENDIF
ENDDO
cCurrentModuleObject='RunPeriod:CustomRange'
count=0
DO Ptr=1,RPAW
CALL GetObjectItem(cCurrentModuleObject,Ptr,cAlphaArgs,NumAlpha,rNumericArgs,NumNumeric,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IF (.not. lAlphaFieldBlanks(1)) THEN
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),RunPeriodInput%Title,Count,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
ENDIF
Count=Count+1
Loop=RP+Ptr
RunPeriodInput(Loop)%Title=cAlphaArgs(1)
!set the start and end day of month from user input
! N1 , \field Begin Month
! N2 , \field Begin Day of Month
! N3, \field Start Year
! N4 , \field End Month
! N5 , \field End Day of Month
! N6, \field End Year
RunPeriodInput(Loop)%StartMonth = Int(rNumericArgs(1))
RunPeriodInput(Loop)%StartDay = Int(rNumericArgs(2))
RunPeriodInput(Loop)%StartYear = Int(rNumericArgs(3))
RunPeriodInput(Loop)%EndMonth = Int(rNumericArgs(4))
RunPeriodInput(Loop)%EndDay = Int(rNumericArgs(5))
RunPeriodInput(Loop)%EndYear = Int(rNumericArgs(6))
RunPeriodInput(Loop)%TreatYearsAsConsecutive = .true.
IF (FullAnnualRun .and. Loop == 1) THEN
RunPeriodInput(Loop)%StartMonth = 1
RunPeriodInput(Loop)%StartDay = 1
RunPeriodInput(Loop)%EndMonth = 12
RunPeriodInput(Loop)%EndDay = 31
ENDIF
SELECT CASE (RunPeriodInput(Loop)%StartMonth)
CASE (1,3,5,7,8,10,12)
IF (RunPeriodInput(Loop)%StartDay > 31) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(2))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(1))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%StartMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE (4,6,9,11)
IF (RunPeriodInput(Loop)%StartDay > 30) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(2))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(1))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%StartMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE (2)
IF (RunPeriodInput(Loop)%StartDay > 28+LeapYearAdd) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(2))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(1))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%StartMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//' '// &
TRIM(cNumericFieldNames(2))//' invalid=['// &
TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartMonth))//']')
ErrorsFound=.true.
END SELECT
SELECT CASE (RunPeriodInput(Loop)%EndMonth)
CASE (1,3,5,7,8,10,12)
IF (RunPeriodInput(Loop)%EndDay > 31) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(4))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%EndDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(3))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%EndMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE (4,6,9,11)
IF (RunPeriodInput(Loop)%EndDay > 30) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(4))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%EndDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(3))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%EndMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE (2)
IF (RunPeriodInput(Loop)%EndDay > 28+LeapYearAdd) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))//', '// &
TRIM(cNumericFieldNames(4))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%EndDay))//']')
CALL ShowContinueError('Indicated '//trim(cNumericFieldNames(3))//'=['// &
trim(TrimSigDigits(RunPeriodInput(Loop)%EndMonth))//'].')
ErrorsFound=.true.
ENDIF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cNumericFieldNames(3))//' invalid=['//TRIM(TrimSigDigits(RunPeriodInput(Loop)%EndMonth))//']')
ErrorsFound=.true.
END SELECT
! A2 , \field Day of Week for Start Day
IF (lAlphaFieldBlanks(2) .or. cAlphaArgs(2) == 'USEWEATHERFILE') THEN
RunPeriodInput(Loop)%DayOfWeek=0 ! Defaults to Day of Week from Weather File
ELSE
RunPeriodInput(Loop)%DayOfWeek=FindItemInList(cAlphaArgs(2),DaysOfWeek,7)
IF (RunPeriodInput(Loop)%DayOfWeek == 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(2))//' invalid (Day of Week) ['// &
TRIM(cAlphaArgs(2))//' for Start is not Valid, DayofWeek from WeatherFile will be used.')
ENDIF
ENDIF
! A3, \field Use Weather File Holidays and Special Days
IF (lAlphaFieldBlanks(3) .or. SameString(cAlphaArgs(3),'YES')) THEN
RunPeriodInput(Loop)%UseHolidays=.true.
ELSEIF (SameString(cAlphaArgs(3),'NO')) THEN
RunPeriodInput(Loop)%UseHolidays=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(3))//' invalid ['//TRIM(cAlphaArgs(3))//']')
ErrorsFound=.true.
ENDIF
! A4, \field Use Weather File Daylight Saving Period
IF (lAlphaFieldBlanks(4) .or. SameString(cAlphaArgs(4),'YES')) THEN
RunPeriodInput(Loop)%UseDST=.true.
ELSEIF (SameString(cAlphaArgs(4),'NO')) THEN
RunPeriodInput(Loop)%UseDST=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(4))//' invalid ['//TRIM(cAlphaArgs(4))//']')
ErrorsFound=.true.
ENDIF
! A5, \field Apply Weekend Holiday Rule
IF (lAlphaFieldBlanks(5) .or. SameString(cAlphaArgs(5),'YES')) THEN
RunPeriodInput(Loop)%ApplyWeekendRule=.true.
ELSEIF (SameString(cAlphaArgs(5),'NO')) THEN
RunPeriodInput(Loop)%ApplyWeekendRule=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(5))//' invalid ['//TRIM(cAlphaArgs(5))//']')
ErrorsFound=.true.
ENDIF
! A6, \field Use Weather File Rain Indicators
IF (lAlphaFieldBlanks(6) .or. SameString(cAlphaArgs(6),'YES')) THEN
RunPeriodInput(Loop)%UseRain=.true.
ELSEIF (SameString(cAlphaArgs(6),'NO')) THEN
RunPeriodInput(Loop)%UseRain=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(6))//' invalid ['//TRIM(cAlphaArgs(6))//']')
ErrorsFound=.true.
ENDIF
! A7, \field Use Weather File Snow Indicators
IF (lAlphaFieldBlanks(7) .or. SameString(cAlphaArgs(7),'YES')) THEN
RunPeriodInput(Loop)%UseSnow=.true.
ELSEIF (SameString(cAlphaArgs(7),'NO')) THEN
RunPeriodInput(Loop)%UseSnow=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(7))//' invalid ['//TRIM(cAlphaArgs(7))//']')
ErrorsFound=.true.
ENDIF
!calculate the annual start and end days from the user inputted month and day
RunPeriodInput(Loop)%ActualWeather=.true.
CALL JGDate(GregorianToJulian,RunPeriodInput(Loop)%StartDate, &
RunPeriodInput(Loop)%StartYear,RunPeriodInput(Loop)%StartMonth,RunPeriodInput(Loop)%StartDay)
CALL JGDate(GregorianToJulian,RunPeriodInput(Loop)%EndDate, &
RunPeriodInput(Loop)%EndYear,RunPeriodInput(Loop)%EndMonth,RunPeriodInput(Loop)%EndDay)
RunPeriodInput(Loop)%MonWeekDay=0
IF (RunPeriodInput(Loop)%DayOfWeek /= 0 .and. .not. ErrorsFound) THEN
CALL SetupWeekDaysByMonth(RunPeriodInput(Loop)%StartMonth,RunPeriodInput(Loop)%StartDay, &
RunPeriodInput(Loop)%DayOfWeek,RunPeriodInput(Loop)%MonWeekDay)
ENDIF
ENDDO
IF (TotRunPers == 0 .and. FullAnnualRun) THEN
DEALLOCATE(RunPeriodInput)
CALL ShowWarningError('No Run Periods input but Full Annual Simulation selected. Adding Run Period to 1/1 through 12/31.')
NumOfEnvrn=NumOfEnvrn+1
ALLOCATE(TempEnvironment(NumOfEnvrn))
IF (NumOfEnvrn > 1) THEN
TempEnvironment(1:NumOfEnvrn-1)=Environment(1:NumOfEnvrn-1)
ENDIF
DEALLOCATE(Environment)
ALLOCATE(Environment(NumOfEnvrn))
Environment=TempEnvironment
DEALLOCATE(TempEnvironment)
Environment(NumOfEnvrn)%KindOfEnvrn = ksRunPeriodWeather
TotRunPers=1
WeathSimReq=.true.
ALLOCATE(RunPeriodInput(TotRunPers))
RunPeriodInput(1)%StartDate = JulianDay(RunPeriodInput(1)%StartMonth,RunPeriodInput(1)%StartDay,LeapYearAdd)
RunPeriodInput(1)%EndDate = JulianDay(RunPeriodInput(1)%EndMonth,RunPeriodInput(1)%EndDay,LeapYearAdd)
RunPeriodInput(1)%MonWeekDay=0
IF (RunPeriodInput(1)%DayOfWeek /= 0 .and. .not. ErrorsFound) THEN
CALL SetupWeekDaysByMonth(RunPeriodInput(1)%StartMonth,RunPeriodInput(1)%StartDay, &
RunPeriodInput(1)%DayOfWeek,RunPeriodInput(1)%MonWeekDay)
ENDIF
ENDIF
Return
END SUBROUTINE GetRunPeriodData