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 | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | ErrorsFound |
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 GetCrossVentData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR G. Carrilho da Graca
! DATE WRITTEN October 2004
! MODIFIED
! RE-ENGINEERED
! PURPOSE OF THIS SUBROUTINE:
! Get UCSD Cross ventilation model controls for all zones at once
! METHODOLOGY EMPLOYED:
! Use input processor to get input from idf file
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem,FindItemInList,FindItem, SameString
USE DataIPShortCuts
USE DataHeatBalance, ONLY : Zone
USE ScheduleManager
USE DataSurfaces, ONLY : TotSurfaces,Surface
USE DataAirflowNetwork
USE DataHeatBalance, ONLY : TotPeople, People
USE General, ONLY : RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! True if errors found during this get input routine
! SUBROUTINE PARAMETER DEFINITIONS
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IOStat
INTEGER :: NumAlpha
INTEGER :: NumNumber
INTEGER :: Loop
INTEGER :: Loop2
INTEGER :: ThisZone
INTEGER :: CompNum = 0
INTEGER :: TypeNum = 0
INTEGER :: NodeNum1 = 0
INTEGER :: NodeNum2 = 0
IF (.not. UCSDModelUsed) RETURN
cCurrentModuleObject = 'RoomAirSettings:CrossVentilation'
TotUCSDCV=GetNumObjectsFound(cCurrentModuleObject)
IF (TotUCSDCV <= 0) RETURN
ALLOCATE(ZoneUCSDCV(TotUCSDCV))
DO Loop=1,TotUCSDCV
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlpha,rNumericArgs,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks, AlphaFieldnames=cAlphaFieldNames, &
NumericFieldNames=cNumericFieldNames)
! First is Zone Name
ZoneUCSDCV(Loop)%ZoneName = cAlphaArgs(1)
ZoneUCSDCV(Loop)%ZonePtr = FindIteminList(cAlphaArgs(1),Zone%Name,NumOfZones)
IF (ZoneUCSDCV(Loop)%ZonePtr == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(1))//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Zone name was not found.')
ErrorsFound=.true.
ELSE
IsZoneCV(ZoneUCSDCV(Loop)%ZonePtr)=.true.
ENDIF
! Second Alpha is Schedule Name
ZoneUCSDCV(Loop)%SchedGainsName = cAlphaArgs(2)
ZoneUCSDCV(Loop)%SchedGainsPtr = GetScheduleIndex(cAlphaArgs(2))
IF (ZoneUCSDCV(Loop)%SchedGainsPtr == 0) THEN
IF (lAlphaFieldBlanks(2) ) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Schedule name field is blank.' )
ErrorsFound=.true.
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Schedule name was not found.' )
ErrorsFound=.true.
ENDIF
ENDIF
! Third Alpha is a string: JET or RECIRCULATION
IF (SameString(cAlphaArgs(3) , 'Jet')) THEN
ZoneUCSDCV(Loop)%VforComfort = VComfort_Jet
ELSEIF (SameString(cAlphaArgs(3) , 'Recirculation')) THEN
ZoneUCSDCV(Loop)%VforComfort = VComfort_Recirculation
ELSE
ZoneUCSDCV(Loop)%VforComfort = VComfort_Invalid
ENDIF
DO Loop2=1,TotPeople
IF (People(Loop2)%ZonePtr /= ZoneUCSDCV(Loop)%ZonePtr) CYCLE
IF (People(Loop2)%Fanger) THEN
IF (ZoneUCSDCV(Loop)%VforComfort == VComfort_Invalid) THEN
IF (lAlphaFieldBlanks(3) ) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Airflow region used for thermal comfort '// &
'evaluation is required for Zone='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Field is blank, please choose Jet or Recirculation.')
ErrorsFound=.true.
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Airflow region used for thermal comfort '// &
'evaluation is required for Zone='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Please choose Jet or Recirculation.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ENDDO
ThisZone=ZoneUCSDCV(Loop)%ZonePtr
IF (ThisZone == 0) CYCLE
! Following depend on valid zone
Loop2=FindItemInList(zone(ZoneUCSDCV(Loop)%ZonePtr)%name,MultiZoneZoneData%ZoneName,AirflowNetworkNumOfZones)
IF (Loop2 == 0) THEN
CALL ShowSevereError('Problem with '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('AirflowNetwork airflow model must be active in this zone')
ErrorsFound=.true.
END IF
! If a crack is used it must have an air flow coefficient = 0.5
DO Loop2=1, NumOfLinksMultizone
NodeNum1 = MultizoneSurfaceData(Loop2)%NodeNums(1)
NodeNum2 = MultizoneSurfaceData(Loop2)%NodeNums(2)
IF (Surface(MultizoneSurfaceData(Loop2)%SurfNum)%Zone == ThisZone .or. &
(AirflowNetworkNodeData(NodeNum2)%EPlusZoneNum==ThisZone .and. AirflowNetworkNodeData(NodeNum1)%EPlusZoneNum > 0) .or. &
(AirflowNetworkNodeData(NodeNum2)%EPlusZoneNum>0 .and. AirflowNetworkNodeData(NodeNum1)%EPlusZoneNum==ThisZone)) THEN
CompNum = AirflowNetworkLinkageData(Loop2)%CompNum
TypeNum = AirflowNetworkCompData(CompNum)%TypeNum
IF (AirflowNetworkCompData(CompNum)%CompTypeNum == CompTypeNum_SCR) THEN
IF (MultizoneSurfaceCrackData(TypeNum)%FlowExpo /= 0.50d0) THEN
AirModel(ThisZone)%AirModelType=RoomAirModel_Mixing
CALL ShowWarningError('Problem with '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowWarningError('Roomair model will not be applied for Zone='//TRIM(cAlphaArgs(1))//'.')
CALL ShowContinueError('AirflowNetwrok:Multizone:Surface crack object must have an air flow coefficient = 0.5, '// &
'value was='//TRIM(RoundSigDigits(MultizoneSurfaceCrackData(TypeNum)%FlowExpo,2)))
ENDIF
ENDIF
END IF
ENDDO
END DO
RETURN
END SUBROUTINE GetCrossVentData