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 GetOutAirNodesInput
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN September 1998
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE
! Read in the list of outside air nodes & store in array OutAirInletNodeList
! METHODOLOGY EMPLOYED:
! Use the Get routines from the InputProcessor module.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor
USE NodeInputManager
IMPLICIT NONE
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName = 'GetOutAirNodesInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumOutAirInletNodeLists
INTEGER :: NumOutsideAirNodeSingles
INTEGER :: NumNums ! Number of REAL(r64) numbers returned by GetObjectItem
INTEGER :: NumAlphas ! Number of alphanumerics returned by GetObjectItem
INTEGER :: NumParams
INTEGER, ALLOCATABLE, DIMENSION(:) :: NodeNums
INTEGER :: NumNodes
INTEGER :: IOStat ! Status flag from GetObjectItem
INTEGER :: NodeNum ! index into NodeNums
! INTEGER :: OutAirNodeNum ! index into OutAirInletNodeList
INTEGER :: OutAirInletNodeListNum ! OUTSIDE AIR INLET NODE LIST index
INTEGER :: OutsideAirNodeSingleNum ! OUTSIDE AIR NODE index
INTEGER :: AlphaNum ! index into Alphas
INTEGER :: ListSize ! size of OutAirInletNodeList
! LOGICAL :: AlreadyInList ! flag used for checking for duplicate input
LOGICAL :: ErrorsFound
LOGICAL :: ErrInList
INTEGER :: CurSize
INTEGER :: NextFluidStreamNum ! Fluid stream index (all outside air inlet nodes need a unique fluid stream number)
INTEGER, ALLOCATABLE, DIMENSION(:) :: TmpNums
INTEGER, ALLOCATABLE, DIMENSION(:) :: TmpNums1
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! Object type for getting and error messages
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: Alphas ! Alpha input items for object
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
REAL(r64), ALLOCATABLE, DIMENSION(:) :: Numbers ! Numeric input items for object
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
NumOutAirInletNodeLists = GetNumObjectsFound('OutdoorAir:NodeList')
NumOutsideAirNodeSingles = GetNumObjectsFound('OutdoorAir:Node')
NumOutsideAirNodes = 0
ErrorsFound = .FALSE.
NextFluidStreamNum = 1
ListSize = 0
CurSize = 100
ALLOCATE(TmpNums(CurSize))
TmpNums = 0
CALL GetObjectDefMaxArgs('NodeList',NumParams,NumAlphas,NumNums)
ALLOCATE(NodeNums(NumParams))
NodeNums=0
CALL GetObjectDefMaxArgs('OutdoorAir:NodeList',TotalArgs,NumAlphas,NumNums)
MaxNums=MAX(MaxNums,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('OutdoorAir:Node',TotalArgs,NumAlphas,NumNums)
MaxNums=MAX(MaxNums,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
ALLOCATE(Alphas(MaxAlphas))
Alphas=' '
ALLOCATE(cAlphaFields(MaxAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(MaxNums))
cNumericFields=' '
ALLOCATE(Numbers(MaxNums))
Numbers=0.0d0
ALLOCATE(lAlphaBlanks(MaxAlphas))
lAlphaBlanks=.TRUE.
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.TRUE.
IF (NumOutAirInletNodeLists > 0) THEN
! Loop over all outside air inlet nodes in the input and count them
CurrentModuleObject = 'OutdoorAir:NodeList'
DO OutAirInletNodeListNum = 1, NumOutAirInletNodeLists
CALL GetObjectItem(CurrentModuleObject,OutAirInletNodeListNum,Alphas,NumAlphas,Numbers,NumNums,IOStat, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
DO AlphaNum = 1, NumAlphas
ErrInList = .FALSE.
! To support HVAC diagram, every outside inlet node must have a unique fluid stream number
! GetNodeNums will increment the value across a node list, the starting value must be incremented
! here across lists and across objects
CALL GetNodeNums(Alphas(AlphaNum),NumNodes,NodeNums,ErrInList,NodeType_Air, &
TRIM(CurrentModuleObject),TRIM(CurrentModuleObject),NodeConnectionType_OutsideAir, &
NextFluidStreamNum,ObjectIsNotParent, IncrementFluidStreamYes,InputFieldName=cAlphaFields(AlphaNum))
NextFluidStreamNum = NextFluidStreamNum + NumNodes
IF (ErrInList) THEN
CALL ShowContinueError('Occurred in '//TRIM(CurrentModuleObject)//', '// &
TRIM(cAlphaFields(AlphaNum))//' = '//TRIM(Alphas(AlphaNum)))
ErrorsFound = .TRUE.
END IF
DO NodeNum = 1, NumNodes
! Duplicates here are not a problem, just ignore
IF (.not. ANY(TmpNums == NodeNums(NodeNum))) THEN
ListSize = ListSize + 1
IF (ListSize > CurSize) THEN
ALLOCATE(TmpNums1(CurSize+100))
TmpNums1(1:CurSize) = TmpNums(1:CurSize)
TmpNums1(CurSize+1:CurSize+100) = 0
DEALLOCATE(TmpNums)
CurSize = CurSize + 100
ALLOCATE(TmpNums(CurSize))
TmpNums = TmpNums1
DEALLOCATE(TmpNums1)
ENDIF
TmpNums(ListSize) = NodeNums(NodeNum)
END IF
END DO
END DO
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//' input.')
END IF
END IF
IF (NumOutsideAirNodeSingles > 0) THEN
! Loop over all single outside air nodes in the input
CurrentModuleObject = 'OutdoorAir:Node'
DO OutsideAirNodeSingleNum = 1, NumOutsideAirNodeSingles
CALL GetObjectItem(CurrentModuleObject,OutsideAirNodeSingleNum,Alphas,NumAlphas,Numbers,NumNums,IOStat, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
ErrInList = .FALSE.
! To support HVAC diagram, every outside inlet node must have a unique fluid stream number
! GetNodeNums will increment the value across a node list, the starting value must be incremented
! here across lists and across objects
CALL GetNodeNums(Alphas(1),NumNodes,NodeNums,ErrInList,NodeType_Air, &
TRIM(CurrentModuleObject),TRIM(CurrentModuleObject),NodeConnectionType_OutsideAir, &
NextFluidStreamNum,ObjectIsNotParent,IncrementFluidStreamYes,InputFieldName=cAlphaFields(1))
NextFluidStreamNum = NextFluidStreamNum + NumNodes
IF (ErrInList) THEN
CALL ShowContinueError('Occurred in '//TRIM(CurrentModuleObject)//', '//TRIM(cAlphaFields(1))//' = '//TRIM(Alphas(1)))
ErrorsFound = .TRUE.
END IF
IF (NumNodes > 1) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//', '//TRIM(cAlphaFields(1))//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('...appears to point to a node list, not a single node.')
ErrorsFound=.true.
CYCLE
ENDIF
IF (.not. ANY(TmpNums == NodeNums(1))) THEN
ListSize = ListSize + 1
IF (ListSize > CurSize) THEN
ALLOCATE(TmpNums1(CurSize+100))
TmpNums1(1:CurSize) = TmpNums(1:CurSize)
TmpNums1(CurSize+1:CurSize+100) = 0
DEALLOCATE(TmpNums)
CurSize = CurSize + 100
ALLOCATE(TmpNums(CurSize))
TmpNums = TmpNums1
DEALLOCATE(TmpNums1)
ENDIF
TmpNums(ListSize) = NodeNums(1)
ELSE ! Duplicates are a problem
CALL ShowSevereError(TRIM(CurrentModuleObject)//', duplicate '//TRIM(cAlphaFields(1))//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('Duplicate '//TRIM(cAlphaFields(1))//' might be found in an OutdoorAir:NodeList.')
ErrorsFound = .TRUE.
CYCLE
END IF
! Set additional node properties
IF (NumNums > 0) Node(NodeNums(1))%Height = Numbers(1)
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//' input.')
END IF
END IF
IF (ListSize > 0) THEN
NumOutsideAirNodes = ListSize
ALLOCATE(OutsideAirNodeList(ListSize))
OutsideAirNodeList = TmpNums(1:ListSize)
END IF
DEALLOCATE(TmpNums)
DEALLOCATE(Alphas)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(Numbers)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
RETURN
END SUBROUTINE GetOutAirNodesInput