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 | ||
---|---|---|---|---|---|---|
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 GetRunPeriodDesignData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the run period design info from User input and the
! simulation dates
! METHODOLOGY EMPLOYED:
!
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList, GetObjectItem, FindItem, GetNumObjectsFound, VerifyName, SameString
USE General, ONLY: JulianDay,TrimSigDigits
USE DataSystemVariables
USE DataIPShortCuts
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER, DIMENSION(12) :: ValidNames=(/"SUNDAY ","MONDAY ","TUESDAY ", &
"WEDNESDAY ","THURSDAY ","FRIDAY ", &
"SATURDAY ","HOLIDAY ","SUMMERDESIGNDAY", &
"WINTERDESIGNDAY","CUSTOMDAY1 ","CUSTOMDAY2 "/)
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumAlphas ! Number of alphas being input
INTEGER :: NumNumerics ! Number of Numerics 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 :: RPD1
INTEGER :: RPD2
INTEGER :: Count
INTEGER :: WhichPeriod
!unused1208 CHARACTER(len=MaxNameLength) :: ThisObject
! FLOW:
!Call Input Get routine to retrieve annual run data
RPD1=GetNumObjectsFound('SizingPeriod:WeatherFileDays')
RPD2=GetNumObjectsFound('SizingPeriod:WeatherFileConditionType')
TotRunDesPers=RPD1+RPD2
ALLOCATE (RunPeriodDesignInput(RPD1+RPD2))
Count=0
cCurrentModuleObject='SizingPeriod:WeatherFileDays'
DO Loop=1,RPD1
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlphas,rNumericArgs,NumNumerics,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),RunPeriodDesignInput%Title,Count,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
Count=Count+1
RunPeriodDesignInput(Count)%Title=cAlphaArgs(1)
RunPeriodDesignInput(Count)%PeriodType='User Selected WeatherFile RunPeriod (Design)'
!set the start and end day of month from user input
RunPeriodDesignInput(Count)%StartMonth = Int(rNumericArgs(1))
RunPeriodDesignInput(Count)%StartDay = Int(rNumericArgs(2))
RunPeriodDesignInput(Count)%EndMonth = Int(rNumericArgs(3))
RunPeriodDesignInput(Count)%EndDay = Int(rNumericArgs(4))
SELECT CASE (RunPeriodDesignInput(Count)%StartMonth)
CASE (1,3,5,7,8,10,12)
IF (RunPeriodDesignInput(Count)%StartDay > 31) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cNumericFieldNames(2))//' invalid (Day of Month) ['// &
TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartDay))//']')
ErrorsFound=.true.
ENDIF
CASE (4,6,9,11)
IF (RunPeriodDesignInput(Count)%StartDay > 30) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cNumericFieldNames(2))//' invalid (Day of Month) ['// &
TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartDay))//']')
ErrorsFound=.true.
ENDIF
CASE (2)
IF (RunPeriodDesignInput(Count)%StartDay > 28+LeapYearAdd) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cNumericFieldNames(2))//' invalid (Day of Month) ['// &
TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartDay))//']')
ErrorsFound=.true.
ENDIF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cNumericFieldNames(1))//' invalid (Month) ['// &
TRIM(TrimSigDigits(RunPeriodInput(Loop)%StartMonth))//']')
ErrorsFound=.true.
END SELECT
IF (lAlphaFieldBlanks(2)) THEN
RunPeriodDesignInput(Count)%DayOfWeek=2 ! Defaults to Monday
ELSE
RunPeriodDesignInput(Count)%DayOfWeek=FindItemInList(cAlphaArgs(2),ValidNames,12)
IF (RunPeriodDesignInput(Count)%DayOfWeek == 0 .or. RunPeriodDesignInput(Count)%DayOfWeek == 8) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cAlphaFieldNames(1))//' invalid (Day of Week) ['// &
TRIM(cAlphaArgs(1))//' for Start is not Valid, Monday will be Used.')
RunPeriodDesignInput(Count)%DayOfWeek=2 ! Defaults to Monday
ENDIF
ENDIF
IF (lAlphaFieldBlanks(3) .or. SameString(cAlphaArgs(3),'YES')) THEN
RunPeriodDesignInput(Count)%UseDST=.true.
ELSEIF (SameString(cAlphaArgs(3),'NO')) THEN
RunPeriodDesignInput(Count)%UseDST=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(3))//' invalid ['//TRIM(cAlphaArgs(3))//']')
ErrorsFound=.true.
ENDIF
IF (lAlphaFieldBlanks(4) .or. SameString(cAlphaArgs(4),'YES')) THEN
RunPeriodDesignInput(Count)%UseRain=.true.
RunPeriodDesignInput(Count)%UseSnow=.true.
ELSEIF (SameString(cAlphaArgs(4),'NO')) THEN
RunPeriodDesignInput(Count)%UseRain=.false.
RunPeriodDesignInput(Count)%UseSnow=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(4))//' invalid ['//TRIM(cAlphaArgs(4))//']')
ErrorsFound=.true.
ENDIF
!calculate the annual start and end days from the user inputted month and day
RunPeriodDesignInput(Count)%StartDate = JulianDay(RunPeriodDesignInput(Count)%StartMonth, &
RunPeriodDesignInput(Count)%StartDay,LeapYearAdd)
RunPeriodDesignInput(Count)%EndDate = JulianDay(RunPeriodDesignInput(Count)%EndMonth, &
RunPeriodDesignInput(Count)%EndDay,LeapYearAdd)
IF (RunPeriodDesignInput(Count)%StartDate <= RunPeriodDesignInput(Count)%EndDate) THEN
RunPeriodDesignInput(Count)%TotalDays=(RunPeriodDesignInput(Count)%EndDate-RunPeriodDesignInput(Count)%StartDate+1) &
* RunPeriodDesignInput(Count)%NumSimYears
ELSE
RunPeriodDesignInput(Count)%TotalDays=(JulianDay(12,31,LeapYearAdd) - &
RunPeriodDesignInput(Count)%StartDate+1+RunPeriodDesignInput(Count)%EndDate) &
* RunPeriodDesignInput(Count)%NumSimYears
ENDIF
RunPeriodDesignInput(Count)%MonWeekDay=0
IF (RunPeriodDesignInput(1)%DayOfWeek /= 0 .and. .not. ErrorsFound) THEN
CALL SetupWeekDaysByMonth(RunPeriodDesignInput(1)%StartMonth,RunPeriodDesignInput(1)%StartDay, &
RunPeriodDesignInput(1)%DayOfWeek,RunPeriodDesignInput(1)%MonWeekDay)
ENDIF
ENDDO
cCurrentModuleObject='SizingPeriod:WeatherFileConditionType'
DO Loop=1,RPD2
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlphas,rNumericArgs,NumNumerics,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),RunPeriodDesignInput%Title,Count,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Title')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
Count=Count+1
RunPeriodDesignInput(Count)%Title=cAlphaArgs(1)
RunPeriodDesignInput(Count)%PeriodType='User Selected WeatherFile Typical/Extreme Period (Design)='//TRIM(cAlphaArgs(2))
! Period Selection
IF (.not. lAlphaFieldBlanks(2)) THEN
WhichPeriod=FindItem(cAlphaArgs(2),TypicalExtremePeriods%MatchValue,NumEPWTypExtSets)
IF (WhichPeriod /= 0) THEN
RunPeriodDesignInput(Count)%StartDay=TypicalExtremePeriods(WhichPeriod)%StartDay
RunPeriodDesignInput(Count)%StartMonth=TypicalExtremePeriods(WhichPeriod)%StartMonth
RunPeriodDesignInput(Count)%StartDate=TypicalExtremePeriods(WhichPeriod)%StartJDay
RunPeriodDesignInput(Count)%EndDay=TypicalExtremePeriods(WhichPeriod)%EndDay
RunPeriodDesignInput(Count)%EndMonth=TypicalExtremePeriods(WhichPeriod)%EndMonth
RunPeriodDesignInput(Count)%EndDate=TypicalExtremePeriods(WhichPeriod)%EndJDay
RunPeriodDesignInput(Count)%TotalDays=TypicalExtremePeriods(WhichPeriod)%TotalDays
ELSE
WhichPeriod=FindItem(cAlphaArgs(2),TypicalExtremePeriods%MatchValue1,NumEPWTypExtSets)
IF (WhichPeriod /= 0) THEN
RunPeriodDesignInput(Count)%StartDay=TypicalExtremePeriods(WhichPeriod)%StartDay
RunPeriodDesignInput(Count)%StartMonth=TypicalExtremePeriods(WhichPeriod)%StartMonth
RunPeriodDesignInput(Count)%StartDate=TypicalExtremePeriods(WhichPeriod)%StartJDay
RunPeriodDesignInput(Count)%EndDay=TypicalExtremePeriods(WhichPeriod)%EndDay
RunPeriodDesignInput(Count)%EndMonth=TypicalExtremePeriods(WhichPeriod)%EndMonth
RunPeriodDesignInput(Count)%EndDate=TypicalExtremePeriods(WhichPeriod)%EndJDay
RunPeriodDesignInput(Count)%TotalDays=TypicalExtremePeriods(WhichPeriod)%TotalDays
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cAlphaFieldnames(2))//'='//TRIM(cAlphaArgs(2))//' matched to '// &
trim(TypicalExtremePeriods(WhichPeriod)%MatchValue))
ELSE
WhichPeriod=FindItem(cAlphaArgs(2),TypicalExtremePeriods%MatchValue2,NumEPWTypExtSets)
IF (WhichPeriod /= 0) THEN
RunPeriodDesignInput(Count)%StartDay=TypicalExtremePeriods(WhichPeriod)%StartDay
RunPeriodDesignInput(Count)%StartMonth=TypicalExtremePeriods(WhichPeriod)%StartMonth
RunPeriodDesignInput(Count)%StartDate=TypicalExtremePeriods(WhichPeriod)%StartJDay
RunPeriodDesignInput(Count)%EndDay=TypicalExtremePeriods(WhichPeriod)%EndDay
RunPeriodDesignInput(Count)%EndMonth=TypicalExtremePeriods(WhichPeriod)%EndMonth
RunPeriodDesignInput(Count)%EndDate=TypicalExtremePeriods(WhichPeriod)%EndJDay
RunPeriodDesignInput(Count)%TotalDays=TypicalExtremePeriods(WhichPeriod)%TotalDays
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cAlphaFieldnames(2))//'='//TRIM(cAlphaArgs(2))//' matched to '// &
trim(TypicalExtremePeriods(WhichPeriod)%MatchValue))
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cAlphaFieldnames(2))//' invalid (not on Weather File)='//TRIM(cAlphaArgs(2)))
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cAlphaFieldnames(2))//' invalid (blank).')
ErrorsFound=.true.
ENDIF
IF (lAlphaFieldBlanks(3)) THEN
RunPeriodDesignInput(Count)%DayOfWeek=2 ! Defaults to Monday
ELSE
RunPeriodDesignInput(Count)%DayOfWeek=FindItemInList(cAlphaArgs(3),ValidNames,12)
IF (RunPeriodDesignInput(Count)%DayOfWeek == 0 .or. RunPeriodDesignInput(Count)%DayOfWeek == 8) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': object='//TRIM(RunPeriodDesignInput(Count)%Title)// &
' '//TRIM(cAlphaFieldNames(3))//' invalid (Day of Week) ['// &
TRIM(cAlphaArgs(3))//' for Start is not Valid, Monday will be Used.')
RunPeriodDesignInput(Count)%DayOfWeek=2 ! Defaults to Monday
ENDIF
ENDIF
IF (lAlphaFieldBlanks(4) .or. SameString(cAlphaArgs(4),'YES')) THEN
RunPeriodDesignInput(Count)%UseDST=.true.
ELSEIF (SameString(cAlphaArgs(4),'NO')) THEN
RunPeriodDesignInput(Count)%UseDST=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(4))//' invalid ['//TRIM(cAlphaArgs(4))//']')
ErrorsFound=.true.
ENDIF
IF (lAlphaFieldBlanks(5) .or. SameString(cAlphaArgs(5),'YES')) THEN
RunPeriodDesignInput(Count)%UseRain=.true.
RunPeriodDesignInput(Count)%UseSnow=.true.
ELSEIF (SameString(cAlphaArgs(5),'NO')) THEN
RunPeriodDesignInput(Count)%UseRain=.false.
RunPeriodDesignInput(Count)%UseSnow=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': object #'//TRIM(TrimSigDigits(Loop))// &
TRIM(cAlphaFieldNames(5))//' invalid ['//TRIM(cAlphaArgs(5))//']')
ErrorsFound=.true.
ENDIF
RunPeriodDesignInput(1)%MonWeekDay=0
IF (RunPeriodDesignInput(1)%DayOfWeek /= 0 .and. .not. ErrorsFound) THEN
CALL SetupWeekDaysByMonth(RunPeriodDesignInput(1)%StartMonth,RunPeriodDesignInput(1)%StartDay, &
RunPeriodDesignInput(1)%DayOfWeek,RunPeriodDesignInput(1)%MonWeekDay)
ENDIF
ENDDO
Return
END SUBROUTINE GetRunPeriodDesignData