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 GetOutsideAirSysInputs
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN Oct 1998
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE
! Input the Outside Air System data and store it in the OutsideAirSys array.
! METHODOLOGY EMPLOYED:
! Use the Get routines from the InputProcessor module.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor
USE BranchNodeConnections, ONLY: TestCompSet, SetUpCompSets
USE HVACDXSystem, ONLY: CheckDXCoolingCoilInOASysExists
IMPLICIT NONE
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetOutsideAirSysInputs: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumNums ! Number of real numbers returned by GetObjectItem
INTEGER :: NumAlphas ! Number of alphanumerics returned by GetObjectItem
INTEGER :: IOSTAT
REAL(r64), ALLOCATABLE, DIMENSION(:) :: NumArray
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: AlphArray
INTEGER :: OASysNum
INTEGER :: CompNum
INTEGER :: Item
!unused0909INTEGER :: NumComponents
INTEGER :: AlphaNum
CHARACTER(len=MaxNameLength) :: ComponentListName
CHARACTER(len=MaxNameLength) :: ControllerListName
CHARACTER(len=MaxNameLength) :: AvailManagerListName
INTEGER :: NumInList
INTEGER :: InListNum
INTEGER :: ListNum
INTEGER :: NumSimpControllers ! number of Controller:Simple objects in an OA System
LOGICAL :: ErrorsFound=.false.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! Object type for getting and messages
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
INTEGER :: MaxNums=0 ! Maximum number of numeric input fields
INTEGER :: MaxAlphas=0 ! Maximum number of alpha input fields
INTEGER :: TotalArgs=0 ! Total number of alpha and numeric arguments (max) for a
! certain object in the input file
IF (.not. GetOASysInputFlag) RETURN
CALL GetObjectDefMaxArgs(CurrentModuleObjects(CMO_OASystem),TotalArgs,NumAlphas,NumNums)
MaxNums=MAX(MaxNums,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs(CurrentModuleObjects(CMO_AirLoopEqList),TotalArgs,NumAlphas,NumNums)
MaxNums=MAX(MaxNums,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs(CurrentModuleObjects(CMO_ControllerList),TotalArgs,NumAlphas,NumNums)
MaxNums=MAX(MaxNums,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
ALLOCATE(AlphArray(MaxAlphas))
AlphArray=' '
ALLOCATE(cAlphaFields(MaxAlphas))
cAlphaFields=' '
ALLOCATE(NumArray(MaxNums))
NumArray=0.0d0
ALLOCATE(cNumericFields(MaxNums))
cNumericFields=' '
ALLOCATE(lAlphaBlanks(MaxAlphas))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.true.
CurrentModuleObject = CurrentModuleObjects(CMO_ControllerList)
NumControllerLists = GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(ControllerLists(NumControllerLists))
DO Item=1,NumControllerLists
CALL GetObjectItem(CurrentModuleObject,Item,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),ControllerLists%Name,Item-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
ControllerLists(Item)%Name = AlphArray(1)
IsNotOK=.false.
IsBlank=.false.
ControllerLists(Item)%NumControllers=(NumAlphas-1)/2
ALLOCATE(ControllerLists(Item)%ControllerType(ControllerLists(Item)%NumControllers))
ControllerLists(Item)%ControllerType=' '
ALLOCATE(ControllerLists(Item)%ControllerName(ControllerLists(Item)%NumControllers))
ControllerLists(Item)%ControllerName=' '
AlphaNum=2
DO CompNum=1,ControllerLists(Item)%NumControllers
IF (SameString(AlphArray(AlphaNum),'Controller:WaterCoil') .or. &
SameString(AlphArray(AlphaNum),'Controller:OutdoorAir') ) THEN
ControllerLists(Item)%ControllerType(CompNum)=AlphArray(AlphaNum)
ControllerLists(Item)%ControllerName(CompNum)=AlphArray(AlphaNum+1)
ELSE
CALL ShowSevereError('For '//trim(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
trim(cAlphaFields(AlphaNum)))
CALL ShowContinueError('...entered="'//trim(AlphArray(AlphaNum))//'", should be Controller:WaterCoil '// &
' or Controller:OutdoorAir.')
ErrorsFound=.true.
ENDIF
AlphaNum=AlphaNum+2
ENDDO
ENDDO
CurrentModuleObject = CurrentModuleObjects(CMO_OASystem)
NumOASystems = GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(OutsideAirSys(NumOASystems))
ALLOCATE(OASysEqSizing(NumOASystems))
ALLOCATE(MyOneTimeErrorFlag(NumOASystems))
ALLOCATE(MyOneTimeCheckUnitarySysFlag(NumOASystems))
MyOneTimeErrorFlag = .TRUE.
MyOneTimeCheckUnitarySysFlag = .TRUE.
DO OASysNum=1,NumOASystems
CALL GetObjectItem(CurrentModuleObject,OASysNum,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),OutsideAirSys%Name,OASysNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
OutsideAirSys(OASysNum)%Name = AlphArray(1)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(2),OutsideAirSys%ControllerListName,OASysNum-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' '//TRIM(cAlphaFields(2))//' Name')
IF (IsNotOK .and. AlphArray(1) /= 'xxxxx') THEN
CALL ShowContinueError('Occurs in '//TRIM(CurrentModuleObject)//' = "'//trim(AlphArray(1))//'".')
ErrorsFound=.true.
IF (IsBlank) AlphArray(2)='xxxxx'
ENDIF
ControllerListName = AlphArray(2)
OutsideAirSys(OASysNum)%ControllerListName = AlphArray(2)
ComponentListName = AlphArray(3)
OutsideAirSys(OASysNum)%ComponentListName = AlphArray(3)
AvailManagerListName = AlphArray(4)
CALL TestCompSet(TRIM(CurrentModuleObject),AlphArray(1),'UNDEFINED','UNDEFINED','Air Nodes')
IF (.NOT. lAlphaBlanks(3)) THEN
ListNum = GetObjectItemNum(CurrentModuleObjects(CMO_AirLoopEqList),ComponentListName)
IF (ListNum > 0) THEN
CALL GetObjectItem(CurrentModuleObjects(CMO_AirLoopEqList),ListNum,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT)
NumInList = (NumAlphas-1)/2
OutsideAirSys(OASysNum)%NumComponents = NumInList
ALLOCATE(OutsideAirSys(OASysNum)%ComponentName(NumInList))
ALLOCATE(OutsideAirSys(OASysNum)%ComponentType(NumInList))
ALLOCATE(OutsideAirSys(OASysNum)%ComponentType_Num(NumInList))
OutsideAirSys(OASysNum)%ComponentType_Num=0
ALLOCATE(OutsideAirSys(OASysNum)%ComponentIndex(NumInList))
OutsideAirSys(OASysNum)%ComponentIndex=0
DO InListNum=1,NumInList
OutsideAirSys(OASysNum)%ComponentName(InListNum) = AlphArray(InListNum*2+1)
OutsideAirSys(OASysNum)%ComponentType(InListNum) = AlphArray(InListNum*2)
! Add equipment to component sets array
CALL SetUpCompSets(TRIM(CurrentModuleObject),OutsideAirSys(OASysNum)%Name, &
OutsideAirSys(OASysNum)%ComponentType(InListNum), &
OutsideAirSys(OASysNum)%ComponentName(InListNum), &
'UNDEFINED','UNDEFINED')
END DO
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(3))//'="'//TRIM(AlphArray(3))//'" not found.')
ErrorsFound=.true.
END IF
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(3))//' is blank and must be entered.')
ErrorsFound=.true.
ENDIF
ListNum = 0
NumSimpControllers = 0
IF (.NOT. lAlphaBlanks(2)) THEN
ListNum = GetObjectItemNum(CurrentModuleObjects(CMO_ControllerList),ControllerListName)
IF (ListNum > 0) THEN
CALL GetObjectItem(CurrentModuleObjects(CMO_ControllerList),ListNum,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT)
NumInList = (NumAlphas-1)/2
OutsideAirSys(OASysNum)%NumControllers = NumInList
ALLOCATE(OutsideAirSys(OASysNum)%ControllerName(NumInList))
ALLOCATE(OutsideAirSys(OASysNum)%ControllerType(NumInList))
ALLOCATE(OutsideAirSys(OASysNum)%ControllerIndex(NumInList))
OutsideAirSys(OASysNum)%ControllerIndex=0
DO InListNum=1,NumInList
OutsideAirSys(OASysNum)%ControllerName(InListNum) = AlphArray(InListNum*2+1)
OutsideAirSys(OASysNum)%ControllerType(InListNum) = AlphArray(InListNum*2)
IF (.not. SameString(OutsideAirSys(OASysNum)%ControllerType(InListNum),CurrentModuleObjects(CMO_OAController))) THEN
NumSimpControllers = NumSimpControllers +1
ENDIF
END DO
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(2))//'="'//TRIM(AlphArray(2))//'" not found.')
ErrorsFound=.true.
END IF
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(2))//' is blank and must be entered.')
ErrorsFound=.true.
ENDIF
OutsideAirSys(OASysNum)%ControllerListNum = ListNum
OutsideAirSys(OASysNum)%NumSimpleControllers = NumSimpControllers
IF (.NOT. lAlphaBlanks(4)) THEN
ListNum=GetObjectItemNum(CurrentModuleObjects(CMO_SysAvailMgrList),AvailManagerListName)
IF (ListNum <= 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(4))//'="'//TRIM(AlphArray(4))//'" not found.')
ErrorsFound=.true.
ENDIF
ENDIF
END DO
DO OASysNum=1,NumOASystems
DO CompNum=1,OutsideAirSys(OASysNum)%NumComponents
SELECT CASE(MakeUPPERCase(OutsideAirSys(OASysNum)%ComponentType(CompNum)))
CASE ('OUTDOORAIR:MIXER')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= OAMixer_Num
! Fan Types
CASE('FAN:CONSTANTVOLUME')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= Fan_Simple_CV
CASE('FAN:VARIABLEVOLUME')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= Fan_Simple_VAV
!cpw22Aug2010 Add Fan:ComponentModel (new)
CASE('FAN:COMPONENTMODEL')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= Fan_ComponentModel
! Coil Types
CASE('COIL:COOLING:WATER')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= WaterCoil_Cooling
CASE('COIL:HEATING:WATER')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= WaterCoil_SimpleHeat
CASE('COIL:HEATING:STEAM')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= SteamCoil_AirHeat
CASE('COIL:COOLING:WATER:DETAILEDGEOMETRY')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= WaterCoil_DetailedCool
CASE('COIL:HEATING:ELECTRIC')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= Coil_ElectricHeat
CASE('COIL:HEATING:GAS')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= Coil_GasHeat
CASE('COILSYSTEM:COOLING:WATER:HEATEXCHANGERASSISTED')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= WaterCoil_CoolingHXAsst
CASE('COILSYSTEM:COOLING:DX')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= DXSystem
! set the data for 100% DOAS DX cooling coil
CALL CheckDXCoolingCoilInOASysExists(OutsideAirSys(OASysNum)%ComponentName(CompNum))
CASE('COILSYSTEM:HEATING:DX')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= DXHeatPumpSystem
CASE('AIRLOOPHVAC:UNITARYSYSTEM')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= UnitarySystem
CASE('COIL:USERDEFINED')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= Coil_UserDefined
! Heat recovery
CASE('HEATEXCHANGER:AIRTOAIR:FLATPLATE')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= HeatXchngr
CASE('HEATEXCHANGER:AIRTOAIR:SENSIBLEANDLATENT')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= HeatXchngr
CASE('HEATEXCHANGER:DESICCANT:BALANCEDFLOW')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= HeatXchngr
! Desiccant Dehumidifier
CASE('DEHUMIDIFIER:DESICCANT:NOFANS')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= Desiccant
CASE('DEHUMIDIFIER:DESICCANT:SYSTEM')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= Desiccant
! Unglazed Transpired Solar Collector
CASE('SOLARCOLLECTOR:UNGLAZEDTRANSPIRED')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= Unglazed_SolarCollector
! PVT air heater
CASE('SOLARCOLLECTOR:FLATPLATE:PHOTOVOLTAICTHERMAL')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= PVT_AirBased
! Evaporative Cooler Types
CASE('EVAPORATIVECOOLER:DIRECT:CELDEKPAD')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= EvapCooler
CASE('EVAPORATIVECOOLER:INDIRECT:CELDEKPAD')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= EvapCooler
CASE('EVAPORATIVECOOLER:INDIRECT:WETCOIL')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= EvapCooler
CASE('EVAPORATIVECOOLER:INDIRECT:RESEARCHSPECIAL')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= EvapCooler
CASE('EVAPORATIVECOOLER:DIRECT:RESEARCHSPECIAL')
OutsideAirSys(OASysNum)%ComponentType_Num(CompNum)= EvapCooler
CASE DEFAULT
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(AlphArray(1))//'" invalid '// &
'Outside Air Component="'//TRIM(OutsideAirSys(OASysNum)%ComponentType(CompNum))//'".')
ErrorsFound=.true.
END SELECT
ENDDO
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//'.')
ENDIF
DEALLOCATE(AlphArray)
DEALLOCATE(cAlphaFields)
DEALLOCATE(NumArray)
DEALLOCATE(cNumericFields)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
GetOASysInputFlag = .FALSE.
RETURN
END SUBROUTINE GetOutsideAirSysInputs