SUBROUTINE GetZoneContaminanInputs
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Dec. 2011
! MODIFIED NA
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the inputs related to generic contaminant internal gain.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger events.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor
USE ScheduleManager, ONLY: GetScheduleIndex, CheckScheduleValueMinMax, GetScheduleMinValue, GetScheduleMaxValue, &
CheckScheduleValue
USE General, ONLY: TrimSigDigits, RoundSigDigits, FindNumberInList
USE DataAirflowNetwork, ONLY: AirflowNetworkNumOfSurfaces, MultizoneSurfaceData
USE DataSurfaces, ONLY: Surface,TotSurfaces, ExternalEnvironment
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetSourcesAndSinks: '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: AlphaName
REAL(r64), DIMENSION(:), ALLOCATABLE :: IHGNumbers
REAL(r64) SchMin
REAL(r64) SchMax
INTEGER :: NumAlpha
INTEGER :: NumNumber
INTEGER :: IOSTAT
INTEGER :: MaxAlpha
INTEGER :: MaxNumber
INTEGER :: Loop
INTEGER :: ZonePtr
LOGICAL :: ErrorsFound = .FALSE.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
! LOGICAL :: ValidScheduleType
LOGICAL, DIMENSION(:), ALLOCATABLE :: RepVarSet
CHARACTER(len=MaxNameLength) :: CurrentModuleObject
! FLOW:
ALLOCATE(RepVarSet(NumOfZones))
RepVarSet=.true.
MaxAlpha=-100
MaxNumber=-100
CurrentModuleObject='ZoneContaminantSourceAndSink:Generic:Constant'
CALL GetObjectDefMaxArgs(CurrentModuleObject,Loop,NumAlpha,NumNumber)
MaxAlpha=MAX(MaxAlpha,NumAlpha)
MaxNumber=MAX(MaxNumber,NumNumber)
CurrentModuleObject='SurfaceContaminantSourceAndSink:Generic:PressureDriven'
CALL GetObjectDefMaxArgs(CurrentModuleObject,Loop,NumAlpha,NumNumber)
MaxAlpha=MAX(MaxAlpha,NumAlpha)
MaxNumber=MAX(MaxNumber,NumNumber)
CurrentModuleObject='ZoneContaminantSourceAndSink:Generic:CutoffModel'
CALL GetObjectDefMaxArgs(CurrentModuleObject,Loop,NumAlpha,NumNumber)
MaxAlpha=MAX(MaxAlpha,NumAlpha)
MaxNumber=MAX(MaxNumber,NumNumber)
CurrentModuleObject='ZoneContaminantSourceAndSink:Generic:DecaySource'
CALL GetObjectDefMaxArgs(CurrentModuleObject,Loop,NumAlpha,NumNumber)
MaxAlpha=MAX(MaxAlpha,NumAlpha)
MaxNumber=MAX(MaxNumber,NumNumber)
CurrentModuleObject='SurfaceContaminantSourceAndSink:Generic:BoundaryLayerDiffusion'
CALL GetObjectDefMaxArgs(CurrentModuleObject,Loop,NumAlpha,NumNumber)
MaxAlpha=MAX(MaxAlpha,NumAlpha)
MaxNumber=MAX(MaxNumber,NumNumber)
CurrentModuleObject='SurfaceContaminantSourceAndSink:Generic:DepositionVelocitySink'
CALL GetObjectDefMaxArgs(CurrentModuleObject,Loop,NumAlpha,NumNumber)
MaxAlpha=MAX(MaxAlpha,NumAlpha)
MaxNumber=MAX(MaxNumber,NumNumber)
CurrentModuleObject='ZoneContaminantSourceAndSink:Generic:DepositionRateSink'
CALL GetObjectDefMaxArgs(CurrentModuleObject,Loop,NumAlpha,NumNumber)
MaxAlpha=MAX(MaxAlpha,NumAlpha)
MaxNumber=MAX(MaxNumber,NumNumber)
ALLOCATE(IHGNumbers(MaxNumber))
ALLOCATE(AlphaName(MaxAlpha))
IHGNumbers=0.0d0
AlphaName=' '
CurrentModuleObject='ZoneContaminantSourceAndSink:Generic:Constant'
TotGCGenConstant=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ZoneContamGenericConstant(TotGCGenConstant))
DO Loop=1,TotGCGenConstant
AlphaName=' '
IHGNumbers=0.0d0
CALL GetObjectItem(CurrentModuleObject,Loop,AlphaName,NumAlpha,IHGNumbers,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(AlphaName(1),ZoneContamGenericConstant%Name,Loop-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) AlphaName(1) = 'xxxxx'
END IF
ZoneContamGenericConstant(Loop)%Name = AlphaName(1)
ZoneContamGenericConstant(Loop)%ZoneName=AlphaName(2)
ZoneContamGenericConstant(Loop)%ActualZoneNum=FindIteminList(AlphaName(2),Zone%Name,NumOfZones)
IF (ZoneContamGenericConstant(Loop)%ActualZoneNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(2))// &
' entered='//TRIM(AlphaName(2)))
ErrorsFound=.true.
ENDIF
ZoneContamGenericConstant(Loop)%GCGenerateRateSchedPtr=GetScheduleIndex(AlphaName(3))
IF (ZoneContamGenericConstant(Loop)%GCGenerateRateSchedPtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//' is required.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(3))//' entered='//TRIM(AlphaName(3)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ZoneContamGenericConstant(Loop)%GCGenerateRateSchedPtr)
SchMax=GetScheduleMaxValue(ZoneContamGenericConstant(Loop)%GCGenerateRateSchedPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', minimum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', maximum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ZoneContamGenericConstant(Loop)%GCGenerateRate = IHGNumbers(1)
ZoneContamGenericConstant(Loop)%GCRemovalCoef = IHGNumbers(2)
ZoneContamGenericConstant(Loop)%GCRemovalCoefSchedPtr=GetScheduleIndex(AlphaName(4))
IF (ZoneContamGenericConstant(Loop)%GCRemovalCoefSchedPtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(4))//' is required.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(4))//' entered='//TRIM(AlphaName(4)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ZoneContamGenericConstant(Loop)%GCRemovalCoefSchedPtr)
SchMax=GetScheduleMaxValue(ZoneContamGenericConstant(Loop)%GCRemovalCoefSchedPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(4))//', minimum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(4))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(4))//', maximum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(4))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
IF (ZoneContamGenericConstant(Loop)%ActualZoneNum <=0) CYCLE ! Error, will be caught and terminated later
! Object report variables
CALL SetupOutputVariable('Generic Air Contaminant Constant Source Generation Volume Flow Rate [m3/s]', &
ZoneContamGenericConstant(Loop)%GCGenRate, &
'Zone','Average',ZoneContamGenericConstant(Loop)%Name)
! Zone total report variables
ZonePtr = ZoneContamGenericConstant(Loop)%ActualZoneNum
IF (RepVarSet(ZonePtr)) THEN
RepVarSet(ZonePtr)=.false.
CALL SetupOutputVariable('Zone Generic Air Contaminant Generation Volume Flow Rate [m3/s]', &
ZnRpt(ZonePtr)%GCRate,'Zone','Average', Zone(ZonePtr)%Name)
ENDIF
CALL SetupZoneInternalGain(ZonePtr, 'ZoneContaminantSourceAndSink:GenericContaminant', &
ZoneContamGenericConstant(Loop)%Name, IntGainTypeOf_ZoneContaminantSourceAndSinkGenericContam, &
GenericContamGainRate = ZoneContamGenericConstant(Loop)%GCGenRate)
END DO
CurrentModuleObject='SurfaceContaminantSourceAndSink:Generic:PressureDriven'
TotGCGenPDriven=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ZoneContamGenericPDriven(TotGCGenPDriven))
DO Loop=1,TotGCGenPDriven
AlphaName=' '
IHGNumbers=0.0d0
CALL GetObjectItem(CurrentModuleObject,Loop,AlphaName,NumAlpha,IHGNumbers,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(AlphaName(1),ZoneContamGenericPDriven%Name,Loop-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) AlphaName(1) = 'xxxxx'
END IF
ZoneContamGenericPDriven(Loop)%Name = AlphaName(1)
ZoneContamGenericPDriven(Loop)%SurfName=AlphaName(2)
ZoneContamGenericPDriven(Loop)%SurfNum=FindIteminList(AlphaName(2),MultizoneSurfaceData%SurfName,AirflowNetworkNumOfSurfaces)
IF (ZoneContamGenericPDriven(Loop)%SurfNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(2))// &
' entered='//TRIM(AlphaName(2)))
ErrorsFound=.true.
ENDIF
! Ensure external surface
If (Surface(ZoneContamGenericPDriven(Loop)%SurfNum)%ExtBoundCond .NE. ExternalEnvironment) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'. The entered surface ('//TRIM(AlphaName(2))//') is not an exterior surface')
ErrorsFound=.true.
End If
ZoneContamGenericPDriven(Loop)%GCGenRateCoefSchedPtr=GetScheduleIndex(AlphaName(3))
IF (ZoneContamGenericPDriven(Loop)%GCGenRateCoefSchedPtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//' is required.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(3))//' entered='//TRIM(AlphaName(3)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ZoneContamGenericPDriven(Loop)%GCGenRateCoefSchedPtr)
SchMax=GetScheduleMaxValue(ZoneContamGenericPDriven(Loop)%GCGenRateCoefSchedPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', minimum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', maximum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ZoneContamGenericPDriven(Loop)%GCGenRateCoef = IHGNumbers(1)
If (IHGNumbers(1) .LT. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative values are not allowed for '//TRIM(cNumericFieldNames(1))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(1),2)))
ErrorsFound=.true.
End If
ZoneContamGenericPDriven(Loop)%GCExpo = IHGNumbers(2)
If (IHGNumbers(2) .LE. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative or zero value is not allowed for '//TRIM(cNumericFieldNames(2))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(2),2)))
ErrorsFound=.true.
End If
If (IHGNumbers(2) .GT. 1.d0) Then
CALL ShowSevereError(RoutineName//'The value greater than 1.0 is not allowed for '//TRIM(cNumericFieldNames(2))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(2),2)))
ErrorsFound=.true.
End If
! Object report variables
CALL SetupOutputVariable('Generic Air Contaminant Pressure Driven Generation Volume Flow Rate [m3/s]', &
ZoneContamGenericPDriven(Loop)%GCGenRate,'Zone','Average',ZoneContamGenericPDriven(Loop)%Name)
ZonePtr = Surface(ZoneContamGenericPDriven(Loop)%SurfNum)%Zone
! Zone total report variables
IF (RepVarSet(ZonePtr)) THEN
RepVarSet(ZonePtr)=.false.
CALL SetupOutputVariable('Zone Generic Air Contaminant Generation Volume Flow Rate [m3/s]', &
ZnRpt(ZonePtr)%GCRate,'Zone','Average', Zone(ZonePtr)%Name)
ENDIF
CALL SetupZoneInternalGain(ZonePtr, 'ZoneContaminantSourceAndSink:GenericContaminant', &
ZoneContamGenericPDriven(Loop)%Name, &
IntGainTypeOf_ZoneContaminantSourceAndSinkGenericContam, &
GenericContamGainRate = ZoneContamGenericPDriven(Loop)%GCGenRate)
END DO
CurrentModuleObject='ZoneContaminantSourceAndSink:Generic:CutoffModel'
TotGCGenCutoff=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ZoneContamGenericCutoff(TotGCGenCutoff))
DO Loop=1,TotGCGenCutoff
AlphaName=' '
IHGNumbers=0.0d0
CALL GetObjectItem(CurrentModuleObject,Loop,AlphaName,NumAlpha,IHGNumbers,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(AlphaName(1),ZoneContamGenericCutoff%Name,Loop-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) AlphaName(1) = 'xxxxx'
END IF
ZoneContamGenericCutoff(Loop)%Name = AlphaName(1)
ZoneContamGenericCutoff(Loop)%ZoneName=AlphaName(2)
ZoneContamGenericCutoff(Loop)%ActualZoneNum=FindIteminList(AlphaName(2),Zone%Name,NumOfZones)
IF (ZoneContamGenericCutoff(Loop)%ActualZoneNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(2))// &
' entered='//TRIM(AlphaName(2)))
ErrorsFound=.true.
ENDIF
ZoneContamGenericCutoff(Loop)%GCGenerateRateSchedPtr=GetScheduleIndex(AlphaName(3))
IF (ZoneContamGenericCutoff(Loop)%GCGenerateRateSchedPtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//' is required.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(3))//' entered='//TRIM(AlphaName(3)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ZoneContamGenericCutoff(Loop)%GCGenerateRateSchedPtr)
SchMax=GetScheduleMaxValue(ZoneContamGenericCutoff(Loop)%GCGenerateRateSchedPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', minimum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', maximum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ZoneContamGenericCutoff(Loop)%GCGenerateRate = IHGNumbers(1)
ZoneContamGenericCutoff(Loop)%GCCutoffValue = IHGNumbers(2)
If (IHGNumbers(1) .LT. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative values are not allowed for '//TRIM(cNumericFieldNames(1))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(1),2)))
ErrorsFound=.true.
End If
If (IHGNumbers(2) .LE. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative values or zero are not allowed for '//TRIM(cNumericFieldNames(2))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(2),2)))
ErrorsFound=.true.
End If
! Object report variables
CALL SetupOutputVariable('Generic Air Contaminant Cutoff Model Generation Volume Flow Rate [m3/s]', &
ZoneContamGenericCutoff(Loop)%GCGenRate,'Zone','Average',ZoneContamGenericCutoff(Loop)%Name)
! Zone total report variables
ZonePtr = ZoneContamGenericCutoff(Loop)%ActualZoneNum
IF (RepVarSet(ZonePtr)) THEN
RepVarSet(ZonePtr)=.false.
CALL SetupOutputVariable('Zone Generic Air Contaminant Generation Volume Flow Rate [m3/s]', &
ZnRpt(ZonePtr)%GCRate,'Zone','Average', Zone(ZonePtr)%Name)
ENDIF
CALL SetupZoneInternalGain(ZonePtr, 'ZoneContaminantSourceAndSink:GenericContaminant', &
ZoneContamGenericCutoff(Loop)%Name, IntGainTypeOf_ZoneContaminantSourceAndSinkGenericContam, &
GenericContamGainRate = ZoneContamGenericCutoff(Loop)%GCGenRate)
END DO
CurrentModuleObject='ZoneContaminantSourceAndSink:Generic:DecaySource'
TotGCGenDecay=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ZoneContamGenericDecay(TotGCGenDecay))
DO Loop=1,TotGCGenDecay
AlphaName=' '
IHGNumbers=0.0d0
CALL GetObjectItem(CurrentModuleObject,Loop,AlphaName,NumAlpha,IHGNumbers,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(AlphaName(1),ZoneContamGenericDecay%Name,Loop-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) AlphaName(1) = 'xxxxx'
END IF
ZoneContamGenericDecay(Loop)%Name = AlphaName(1)
ZoneContamGenericDecay(Loop)%ZoneName=AlphaName(2)
ZoneContamGenericDecay(Loop)%ActualZoneNum=FindIteminList(AlphaName(2),Zone%Name,NumOfZones)
IF (ZoneContamGenericDecay(Loop)%ActualZoneNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(2))// &
' entered='//TRIM(AlphaName(2)))
ErrorsFound=.true.
ENDIF
ZoneContamGenericDecay(Loop)%GCEmiRateSchedPtr=GetScheduleIndex(AlphaName(3))
IF (ZoneContamGenericDecay(Loop)%GCEmiRateSchedPtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//' is required.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(3))//' entered='//TRIM(AlphaName(3)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ZoneContamGenericDecay(Loop)%GCEmiRateSchedPtr)
SchMax=GetScheduleMaxValue(ZoneContamGenericDecay(Loop)%GCEmiRateSchedPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', minimum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', maximum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ZoneContamGenericDecay(Loop)%GCInitEmiRate = IHGNumbers(1)
ZoneContamGenericDecay(Loop)%GCDelayTime = IHGNumbers(2)
If (IHGNumbers(1) .LT. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative values are not allowed for '//TRIM(cNumericFieldNames(1))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(1),2)))
ErrorsFound=.true.
End If
If (IHGNumbers(2) .LE. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative values or zero are not allowed for '//TRIM(cNumericFieldNames(2))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(2),2)))
ErrorsFound=.true.
End If
! Object report variables
CALL SetupOutputVariable('Generic Air Contaminant Decay Model Generation Volume Flow Rate [m3/s]', &
ZoneContamGenericDecay(Loop)%GCGenRate,'Zone','Average',ZoneContamGenericDecay(Loop)%Name)
CALL SetupOutputVariable('Generic Air Contaminant Decay Model Generation Emission Start Elapsed Time [s]', &
ZoneContamGenericDecay(Loop)%GCTime,'Zone','Average',ZoneContamGenericDecay(Loop)%Name)
! Zone total report variables
ZonePtr = ZoneContamGenericDecay(Loop)%ActualZoneNum
IF (RepVarSet(ZonePtr)) THEN
RepVarSet(ZonePtr)=.false.
CALL SetupOutputVariable('Zone Generic Air Contaminant Generation Volume Flow Rate [m3/s]', &
ZnRpt(ZonePtr)%GCRate,'Zone','Average', Zone(ZonePtr)%Name)
ENDIF
CALL SetupZoneInternalGain(ZonePtr, 'ZoneContaminantSourceAndSink:GenericContaminant', &
ZoneContamGenericDecay(Loop)%Name, IntGainTypeOf_ZoneContaminantSourceAndSinkGenericContam, &
GenericContamGainRate = ZoneContamGenericDecay(Loop)%GCGenRate)
END DO
CurrentModuleObject='SurfaceContaminantSourceAndSink:Generic:BoundaryLayerDiffusion'
TotGCBLDiff =GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ZoneContamGenericBLDiff(TotGCBLDiff))
DO Loop=1,TotGCBLDiff
AlphaName=' '
IHGNumbers=0.0d0
CALL GetObjectItem(CurrentModuleObject,Loop,AlphaName,NumAlpha,IHGNumbers,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(AlphaName(1),ZoneContamGenericBLDiff%Name,Loop-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) AlphaName(1) = 'xxxxx'
END IF
ZoneContamGenericBLDiff(Loop)%Name = AlphaName(1)
ZoneContamGenericBLDiff(Loop)%SurfName=AlphaName(2)
ZoneContamGenericBLDiff(Loop)%SurfNum=FindIteminList(AlphaName(2),Surface%Name,TotSurfaces)
IF (ZoneContamGenericBLDiff(Loop)%SurfNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(2))// &
' entered='//TRIM(AlphaName(2)))
ErrorsFound=.true.
ENDIF
ZoneContamGenericBLDiff(Loop)%GCTranCoefSchedPtr=GetScheduleIndex(AlphaName(3))
IF (ZoneContamGenericBLDiff(Loop)%GCTranCoefSchedPtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//' is required.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(3))//' entered='//TRIM(AlphaName(3)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ZoneContamGenericBLDiff(Loop)%GCTranCoefSchedPtr)
SchMax=GetScheduleMaxValue(ZoneContamGenericBLDiff(Loop)%GCTranCoefSchedPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', minimum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', maximum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ZoneContamGenericBLDiff(Loop)%GCTranCoef = IHGNumbers(1)
ZoneContamGenericBLDiff(Loop)%GCHenryCoef = IHGNumbers(2)
If (IHGNumbers(1) .LT. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative values are not allowed for '//TRIM(cNumericFieldNames(1))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(1),2)))
ErrorsFound=.true.
End If
If (IHGNumbers(2) .LE. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative values or zero are not allowed for '//TRIM(cNumericFieldNames(2))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(2),2)))
ErrorsFound=.true.
End If
! Object report variables
CALL SetupOutputVariable('Generic Air Contaminant Boundary Layer Diffusion Generation Volume Flow Rate [m3/s]', &
ZoneContamGenericBLDiff(Loop)%GCGenRate,'Zone','Average',ZoneContamGenericBLDiff(Loop)%Name)
If (ZoneContamGenericBLDiff(Loop)%SurfNum .GT. 0) &
CALL SetupOutputVariable('Generic Air Contaminant Boundary Layer Diffusion Inside Face Concentration [ppm]', &
Surface(ZoneContamGenericBLDiff(Loop)%SurfNum)%GenericContam,'Zone','Average',ZoneContamGenericBLDiff(Loop)%SurfName)
ZonePtr = Surface(ZoneContamGenericBLDiff(Loop)%SurfNum)%Zone
! Zone total report variables
IF (RepVarSet(ZonePtr)) THEN
RepVarSet(ZonePtr)=.false.
CALL SetupOutputVariable('Zone Generic Air Contaminant Generation Volume Flow Rate [m3/s]', &
ZnRpt(ZonePtr)%GCRate,'Zone','Average', Zone(ZonePtr)%Name)
ENDIF
CALL SetupZoneInternalGain(ZonePtr, 'ZoneContaminantSourceAndSink:GenericContaminant', &
ZoneContamGenericBLDiff(Loop)%Name, IntGainTypeOf_ZoneContaminantSourceAndSinkGenericContam, &
GenericContamGainRate = ZoneContamGenericBLDiff(Loop)%GCGenRate)
END DO
CurrentModuleObject='SurfaceContaminantSourceAndSink:Generic:DepositionVelocitySink'
TotGCDVS =GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ZoneContamGenericDVS(TotGCDVS))
DO Loop=1,TotGCDVS
AlphaName=' '
IHGNumbers=0.0d0
CALL GetObjectItem(CurrentModuleObject,Loop,AlphaName,NumAlpha,IHGNumbers,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(AlphaName(1),ZoneContamGenericDVS%Name,Loop-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) AlphaName(1) = 'xxxxx'
END IF
ZoneContamGenericDVS(Loop)%Name = AlphaName(1)
ZoneContamGenericDVS(Loop)%SurfName=AlphaName(2)
ZoneContamGenericDVS(Loop)%SurfNum=FindIteminList(AlphaName(2),Surface%Name,TotSurfaces)
IF (ZoneContamGenericDVS(Loop)%SurfNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(2))// &
' entered='//TRIM(AlphaName(2)))
ErrorsFound=.true.
ENDIF
ZoneContamGenericDVS(Loop)%GCDepoVeloPtr=GetScheduleIndex(AlphaName(3))
IF (ZoneContamGenericDVS(Loop)%GCDepoVeloPtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//' is required.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(3))//' entered='//TRIM(AlphaName(3)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ZoneContamGenericDVS(Loop)%GCDepoVeloPtr)
SchMax=GetScheduleMaxValue(ZoneContamGenericDVS(Loop)%GCDepoVeloPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', minimum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', maximum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ZoneContamGenericDVS(Loop)%GCDepoVelo = IHGNumbers(1)
If (IHGNumbers(1) .LT. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative values are not allowed for '//TRIM(cNumericFieldNames(1))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(1),2)))
ErrorsFound=.true.
End If
! Object report variables
CALL SetupOutputVariable('Generic Air Contaminant Deposition Velocity Removal Volume Flow Rate [m3/s]', &
ZoneContamGenericDVS(Loop)%GCGenRate,'Zone','Average',ZoneContamGenericDVS(Loop)%Name)
ZonePtr = Surface(ZoneContamGenericDVS(Loop)%SurfNum)%Zone
! Zone total report variables
IF (RepVarSet(ZonePtr)) THEN
RepVarSet(ZonePtr)=.false.
CALL SetupOutputVariable('Zone Generic Air Contaminant Generation Volume Flow Rate [m3/s]', &
ZnRpt(ZonePtr)%GCRate,'Zone','Average', Zone(ZonePtr)%Name)
ENDIF
CALL SetupZoneInternalGain(ZonePtr, 'ZoneContaminantSourceAndSink:GenericContaminant', &
ZoneContamGenericDVS(Loop)%Name, IntGainTypeOf_ZoneContaminantSourceAndSinkGenericContam, &
GenericContamGainRate = ZoneContamGenericDVS(Loop)%GCGenRate)
END DO
CurrentModuleObject='ZoneContaminantSourceAndSink:Generic:DepositionRateSink'
TotGCDRS=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ZoneContamGenericDRS(TotGCDRS))
DO Loop=1,TotGCDRS
AlphaName=' '
IHGNumbers=0.0d0
CALL GetObjectItem(CurrentModuleObject,Loop,AlphaName,NumAlpha,IHGNumbers,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(AlphaName(1),ZoneContamGenericDRS%Name,Loop-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) AlphaName(1) = 'xxxxx'
END IF
ZoneContamGenericDRS(Loop)%Name = AlphaName(1)
ZoneContamGenericDRS(Loop)%ZoneName=AlphaName(2)
ZoneContamGenericDRS(Loop)%ActualZoneNum=FindIteminList(AlphaName(2),Zone%Name,NumOfZones)
IF (ZoneContamGenericDRS(Loop)%ActualZoneNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(2))// &
' entered='//TRIM(AlphaName(2)))
ErrorsFound=.true.
ENDIF
ZoneContamGenericDRS(Loop)%GCDepoRatePtr=GetScheduleIndex(AlphaName(3))
IF (ZoneContamGenericDRS(Loop)%GCDepoRatePtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//' is required.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", invalid '//TRIM(cAlphaFieldNames(3))//' entered='//TRIM(AlphaName(3)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ZoneContamGenericDRS(Loop)%GCDepoRatePtr)
SchMax=GetScheduleMaxValue(ZoneContamGenericDRS(Loop)%GCDepoRatePtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', minimum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(AlphaName(1))// &
'", '//TRIM(cAlphaFieldNames(3))//', maximum is < 0.0')
CALL ShowContinueError('Schedule="'//TRIM(AlphaName(3))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ZoneContamGenericDRS(Loop)%GCDepoRate = IHGNumbers(1)
If (IHGNumbers(1) .LT. 0.d0) Then
CALL ShowSevereError(RoutineName//'Negative values are not allowed for '//TRIM(cNumericFieldNames(1))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphaName(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(IHGNumbers(1),2)))
ErrorsFound=.true.
End If
! Object report variables
CALL SetupOutputVariable('Generic Air Contaminant Deposition Rate Removal Volume Flow Rate [m3/s]', &
ZoneContamGenericDRS(Loop)%GCGenRate,'Zone','Average',ZoneContamGenericDRS(Loop)%Name)
ZonePtr = ZoneContamGenericDRS(Loop)%ActualZoneNum
! Zone total report variables
IF (RepVarSet(ZonePtr)) THEN
RepVarSet(ZonePtr)=.false.
CALL SetupOutputVariable('Zone Generic Air Contaminant Generation Volume Flow Rate [m3/s]', &
ZnRpt(ZonePtr)%GCRate,'Zone','Average', Zone(ZonePtr)%Name)
ENDIF
CALL SetupZoneInternalGain(ZonePtr, 'ZoneContaminantSourceAndSink:GenericContaminant', &
ZoneContamGenericDRS(Loop)%Name, IntGainTypeOf_ZoneContaminantSourceAndSinkGenericContam, &
GenericContamGainRate = ZoneContamGenericDRS(Loop)%GCGenRate)
END DO
DEALLOCATE(RepVarSet)
DEALLOCATE(IHGNumbers)
DEALLOCATE(AlphaName)
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors getting Zone Contaminant Sources and Sinks input data. Preceding condition(s) cause termination.')
END IF
RETURN
END SUBROUTINE GetZoneContaminanInputs