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.
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 GetZoneContaminanSetpoints
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN May 2010
! MODIFIED NA
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the inputs related to contaminant control.
! 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
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
TYPE NeededControlTypes
LOGICAL, DIMENSION(4) :: MustHave=.false. ! 4= the four control types
LOGICAL, DIMENSION(4) :: DidHave =.false.
END TYPE
TYPE NeededComfortControlTypes
LOGICAL, DIMENSION(12) :: MustHave=.false. ! 4= the four control types
LOGICAL, DIMENSION(12) :: DidHave =.false.
END TYPE
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ContControlledZoneNum ! The Splitter that you are currently loading input into
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: IOSTAT
!unused1208 REAL(r64), DIMENSION(2) :: NumArray
!unused1208 CHARACTER(len=MaxNameLength), DIMENSION(29) :: AlphArray
LOGICAL :: ErrorsFound = .FALSE.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: ValidScheduleType
! FLOW:
cCurrentModuleObject='ZoneControl:ContaminantController'
NumContControlledZones = GetNumObjectsFound(cCurrentModuleObject)
IF (NumContControlledZones .GT. 0) THEN
ALLOCATE(ContaminantControlledZone(NumContControlledZones))
ENDIF
DO ContControlledZoneNum = 1, NumContControlledZones
CALL GetObjectItem(cCurrentModuleObject,ContControlledZoneNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1),ContaminantControlledZone%Name,ContControlledZoneNum-1,IsNotOK,IsBlank, &
trim(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
ContaminantControlledZone(ContControlledZoneNum)%Name = cAlphaArgs(1)
ContaminantControlledZone(ContControlledZoneNum)%ZoneName = cAlphaArgs(2)
ContaminantControlledZone(ContControlledZoneNum)%ActualZoneNum = FindIteminList(cAlphaArgs(2),Zone%Name,NumOfZones)
IF (ContaminantControlledZone(ContControlledZoneNum)%ActualZoneNum == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(2))//'="'//trim(cAlphaArgs(2))//'" not found.')
ErrorsFound = .TRUE.
ELSE
! Zone(ContaminantControlledZone(ContControlledZoneNum)%ActualZoneNum)%TempControlledZoneIndex = ContControlledZoneNum
END IF
ContaminantControlledZone(ContControlledZoneNum)%AvaiSchedule = cAlphaArgs(3)
IF (lAlphaFieldBlanks(3)) THEN
ContaminantControlledZone(ContControlledZoneNum)%AvaiSchedPtr=ScheduleAlwaysOn ! (Returns 1.0)
ELSE
ContaminantControlledZone(ContControlledZoneNum)%AvaiSchedPtr=GetScheduleIndex(cAlphaArgs(3))
IF (ContaminantControlledZone(ContControlledZoneNum)%AvaiSchedPtr == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(3))//'="'//trim(cAlphaArgs(3))//'" not found.')
ErrorsFound = .TRUE.
ELSE
! Check validity of control types.
ValidScheduleType= &
CheckScheduleValueMinMax(ContaminantControlledZone(ContControlledZoneNum)%AvaiSchedPtr,'>=',0.0d0,'<=',1.0d0)
IF (.not. ValidScheduleType) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid range '// &
trim(cAlphaFieldNames(3))//'="'//trim(cAlphaArgs(3))//'"')
CALL ShowContinueError('..contains values outside of range [0,1].')
ErrorsFound=.TRUE.
ELSE
Zone(ContaminantControlledZone(ContControlledZoneNum)%ActualZoneNum)%ZoneContamControllerSchedIndex = &
ContaminantControlledZone(ContControlledZoneNum)%AvaiSchedPtr
ENDIF
END IF
ENDIF
ContaminantControlledZone(ContControlledZoneNum)%SetPointSchedName = cAlphaArgs(4)
ContaminantControlledZone(ContControlledZoneNum)%SPSchedIndex=GetScheduleIndex(cAlphaArgs(4))
IF (ContaminantControlledZone(ContControlledZoneNum)%SPSchedIndex == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(4))//'="'//trim(cAlphaArgs(4))//'" not found.')
ErrorsFound = .TRUE.
ELSE
! Check validity of control types.
ValidScheduleType= &
CheckScheduleValueMinMax(ContaminantControlledZone(ContControlledZoneNum)%SPSchedIndex,'>=',0.0d0,'<=',2000.0d0)
IF (.not. ValidScheduleType) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid range '// &
trim(cAlphaFieldNames(4))//'="'//trim(cAlphaArgs(4))//'"')
CALL ShowContinueError('..contains values outside of range [0,2000 ppm].')
ErrorsFound=.TRUE.
ENDIF
END IF
ContaminantControlledZone(ContControlledZoneNum)%ZoneMinCO2SchedName = cAlphaArgs(5)
ContaminantControlledZone(ContControlledZoneNum)%ZoneMinCO2SchedIndex=GetScheduleIndex(cAlphaArgs(5))
IF (ContaminantControlledZone(ContControlledZoneNum)%ZoneMinCO2SchedIndex .GT. 0) THEN
! Check validity of control types.
ValidScheduleType=CheckScheduleValueMinMax(ContaminantControlledZone(ContControlledZoneNum)%ZoneMinCO2SchedIndex, &
'>=',0.0d0,'<=',2000.0d0)
IF (.not. ValidScheduleType) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid range '// &
trim(cAlphaFieldNames(5))//'="'//trim(cAlphaArgs(5))//'"')
CALL ShowContinueError('..contains values outside of range [0,2000 ppm].')
ErrorsFound=.TRUE.
ELSE
Zone(ContaminantControlledZone(ContControlledZoneNum)%ActualZoneNum)%ZoneMinCO2SchedIndex = &
ContaminantControlledZone(ContControlledZoneNum)%ZoneMinCO2SchedIndex
ENDIF
END IF
If (NumAlphas .GT. 5) Then
ContaminantControlledZone(ContControlledZoneNum)%GCAvaiSchedule = cAlphaArgs(6)
IF (lAlphaFieldBlanks(6)) THEN
ContaminantControlledZone(ContControlledZoneNum)%GCAvaiSchedPtr=ScheduleAlwaysOn
ELSE
ContaminantControlledZone(ContControlledZoneNum)%GCAvaiSchedPtr=GetScheduleIndex(cAlphaArgs(6))
IF (ContaminantControlledZone(ContControlledZoneNum)%AvaiSchedPtr == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(3))//'="'//trim(cAlphaArgs(6))//'" not found.')
ErrorsFound = .TRUE.
ELSE
! Check validity of control types.
ValidScheduleType=CheckScheduleValueMinMax(ContaminantControlledZone(ContControlledZoneNum)%GCAvaiSchedPtr, &
'>=',0.0d0,'<=',1.0d0)
IF (.not. ValidScheduleType) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid range '// &
trim(cAlphaFieldNames(3))//'="'//trim(cAlphaArgs(6))//'"')
CALL ShowContinueError('..contains values outside of range [0,1].')
ErrorsFound=.TRUE.
ENDIF
ENDIF
END IF
If (lAlphaFieldBlanks(7)) Then
CALL ShowSevereError(trim(cCurrentModuleObject)//' "'//trim(cAlphaArgs(7))//'" is required, but blank.')
ErrorsFound=.TRUE.
Else
ContaminantControlledZone(ContControlledZoneNum)%GCSetPointSchedName = cAlphaArgs(7)
ContaminantControlledZone(ContControlledZoneNum)%GCSPSchedIndex=GetScheduleIndex(cAlphaArgs(7))
IF (ContaminantControlledZone(ContControlledZoneNum)%GCSPSchedIndex == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(7))//'="'//trim(cAlphaArgs(7))//'" not found.')
ErrorsFound = .TRUE.
END IF
End If
End If
END DO ! ContControlledZoneNum
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors getting Zone Contaminant Control input data. Preceding condition(s) cause termination.')
END IF
RETURN
END SUBROUTINE GetZoneContaminanSetpoints