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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ZoneNum | |||
character(len=*), | intent(in) | :: | cComponentObject | |||
character(len=*), | intent(in) | :: | cComponentName | |||
integer, | intent(in) | :: | IntGainComp_TypeOfNum | |||
real(kind=r64), | intent(in), | optional | TARGET | :: | ConvectionGainRate | |
real(kind=r64), | intent(in), | optional | TARGET | :: | ReturnAirConvectionGainRate | |
real(kind=r64), | intent(in), | optional | TARGET | :: | ThermalRadiationGainRate | |
real(kind=r64), | intent(in), | optional | TARGET | :: | LatentGainRate | |
real(kind=r64), | intent(in), | optional | TARGET | :: | ReturnAirLatentGainRate | |
real(kind=r64), | intent(in), | optional | TARGET | :: | CarbonDioxideGainRate | |
real(kind=r64), | intent(in), | optional | TARGET | :: | GenericContamGainRate |
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 SetupZoneInternalGain(ZoneNum, cComponentObject , cComponentName, IntGainComp_TypeOfNum, ConvectionGainRate , &
ReturnAirConvectionGainRate, ThermalRadiationGainRate, LatentGainRate, ReturnAirLatentGainRate, &
CarbonDioxideGainRate, GenericContamGainRate)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN November 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! provide a general interface for setting up devices with internal gains
! METHODOLOGY EMPLOYED:
! use pointers to access gain rates in device models
! devices are internal gains like people, lights, electric equipment
! and HVAC components with skin loss models like thermal tanks, and power conditioning.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE DataHeatBalance
USE InputProcessor, ONLY: MakeUpperCase, SameString
USE DataInterfaces, ONLY: ShowSevereError, ShowContinueError
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ZoneNum
CHARACTER(len=*), INTENT(IN) :: cComponentObject ! object class name for device contributing internal gain
CHARACTER(len=*), INTENT(IN) :: cComponentName ! user unique name for device
INTEGER , INTENT(IN) :: IntGainComp_TypeOfNum
REAL(r64), TARGET, OPTIONAL, INTENT(IN) :: ConvectionGainRate ! pointer target for remote convection gain value to be accessed
REAL(r64), TARGET, OPTIONAL, INTENT(IN) :: ReturnAirConvectionGainRate
REAL(r64), TARGET, OPTIONAL, INTENT(IN) :: ThermalRadiationGainRate ! pointer target for remote IR radiation gain value to be accessed
REAL(r64), TARGET, OPTIONAL, INTENT(IN) :: LatentGainRate
REAL(r64), TARGET, OPTIONAL, INTENT(IN) :: ReturnAirLatentGainRate
REAL(r64), TARGET, OPTIONAL, INTENT(IN) :: CarbonDioxideGainRate
REAL(r64), TARGET, OPTIONAL, INTENT(IN) :: GenericContamGainRate
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: DeviceAllocInc = 100
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IntGainsNum
LOGICAL :: FoundIntGainsType
LOGICAL :: FoundDuplicate
CHARACTER(len=MaxNameLength) :: UpperCaseObjectType
CHARACTER(len=MaxNameLength) :: UpperCaseObjectName
TYPE(GenericComponentZoneIntGainStruct), DIMENSION(:), ALLOCATABLE :: TempGenDeviceIntGainsArr
FoundIntGainsType = .FALSE.
FoundDuplicate = .FALSE.
UpperCaseObjectType = MakeUpperCase(cComponentObject)
UpperCaseObjectName = MakeUpperCase(cComponentName)
! Check if IntGainComp_TypeOfNum and cComponentObject are consistent
If (.NOT. SameString(UpperCaseObjectType, ZoneIntGainDeviceTypes(IntGainComp_TypeOfNum)) ) THEN
CALL ShowSevereError('SetupZoneInternalGain: developer error, trapped inconsistent internal gains object types' &
// ' sent to SetupZoneInternalGain')
CALL ShowContinueError('Object type character = '//Trim(cComponentObject) )
CALL ShowContinueError('Type of Num object name = '//TRIM(ZoneIntGainDeviceTypes(IntGainComp_TypeOfNum)) )
RETURN
ENDIF
DO IntGainsNum = 1, ZoneIntGain(ZoneNum)%NumberOfDevices
IF ((ZoneIntGain(ZoneNum)%Device(IntGainsNum)%CompObjectType == UpperCaseObjectType) &
.AND. (ZoneIntGain(ZoneNum)%Device(IntGainsNum)%CompTypeOfNum == IntGainComp_TypeOfNum)) THEN
FoundIntGainsType = .TRUE.
IF (ZoneIntGain(ZoneNum)%Device(IntGainsNum)%CompObjectName == UpperCaseObjectName) THEN
FoundDuplicate = .TRUE.
EXIT
ENDIF
ENDIF
ENDDO
IF (FoundDuplicate) THEN
CALL ShowSevereError('SetupZoneInternalGain: developer error, trapped duplicate internal gains sent to SetupZoneInternalGain')
CALL ShowContinueError('The duplicate object user name ='//TRIM(cComponentName) )
CALL ShowContinueError('The duplicate object type = '//TRIM(cComponentObject) )
CALL ShowContinueError('This internal gain will not be modeled, and the simulation continues')
RETURN
ENDIF
IF (ZoneIntGain(ZoneNum)%NumberOfDevices == 0) THEN
ALLOCATE( ZoneIntGain(ZoneNum)%Device(DeviceAllocInc) )
ZoneIntGain(ZoneNum)%NumberOfDevices = 1
ZoneIntGain(ZoneNum)%MaxNumberOfDevices = DeviceAllocInc
ELSE
IF (ZoneIntGain(ZoneNum)%NumberOfDevices +1 > ZoneIntGain(ZoneNum)%MaxNumberOfDevices) THEN
ALLOCATE(TempGenDeviceIntGainsArr(ZoneIntGain(ZoneNum)%MaxNumberOfDevices + DeviceAllocInc) )
TempGenDeviceIntGainsArr(1:ZoneIntGain(ZoneNum)%NumberOfDevices) &
= ZoneIntGain(ZoneNum)%Device(1:ZoneIntGain(ZoneNum)%NumberOfDevices)
DEALLOCATE(ZoneIntGain(ZoneNum)%Device)
ALLOCATE(ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%MaxNumberOfDevices + DeviceAllocInc) )
ZoneIntGain(ZoneNum)%MaxNumberOfDevices = ZoneIntGain(ZoneNum)%MaxNumberOfDevices + DeviceAllocInc
ZoneIntGain(ZoneNum)%Device(1:ZoneIntGain(ZoneNum)%NumberOfDevices) &
= TempGenDeviceIntGainsArr(1:ZoneIntGain(ZoneNum)%NumberOfDevices)
DEALLOCATE(TempGenDeviceIntGainsArr)
ENDIF
ZoneIntGain(ZoneNum)%NumberOfDevices = ZoneIntGain(ZoneNum)%NumberOfDevices + 1
ENDIF
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%CompObjectType = UpperCaseObjectType
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%CompObjectName = UpperCaseObjectName
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%CompTypeOfNum = IntGainComp_TypeOfNum
! note pointer assignments in code below!
IF (PRESENT(ConvectionGainRate)) THEN
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrConvectGainRate => ConvectionGainRate
ELSE
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrConvectGainRate => ZeroPointerVal
ENDIF
IF (PRESENT(ReturnAirConvectionGainRate)) THEN
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrReturnAirConvGainRate => ReturnAirConvectionGainRate
ELSE
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrReturnAirConvGainRate => ZeroPointerVal
ENDIF
IF (PRESENT(ThermalRadiationGainRate)) THEN
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrRadiantGainRate => ThermalRadiationGainRate
ELSE
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrRadiantGainRate => ZeroPointerVal
ENDIF
IF (PRESENT(LatentGainRate)) THEN
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrLatentGainRate => LatentGainRate
ELSE
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrLatentGainRate => ZeroPointerVal
ENDIF
IF (PRESENT(ReturnAirLatentGainRate)) THEN
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrReturnAirLatentGainRate => ReturnAirLatentGainRate
ELSE
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrReturnAirLatentGainRate => ZeroPointerVal
ENDIF
IF (PRESENT(CarbonDioxideGainRate)) THEN
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrCarbonDioxideGainRate => CarbonDioxideGainRate
ELSE
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrCarbonDioxideGainRate => ZeroPointerVal
ENDIF
IF (PRESENT(GenericContamGainRate)) THEN
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrGenericContamGainRate => GenericContamGainRate
ELSE
ZoneIntGain(ZoneNum)%Device(ZoneIntGain(ZoneNum)%NumberOfDevices)%PtrGenericContamGainRate => ZeroPointerVal
ENDIF
RETURN
END SUBROUTINE SetupZoneInternalGain