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 GetWindowGapAirflowControlData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN Feb 2003
! MODIFIED June 2003, FCW: add destination = return air;
! more error messages
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Reads in the window airflow control information from the input data file,
! interprets it and puts it in the SurfaceWindow derived type
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, SameString
USE ScheduleManager, ONLY: GetScheduleIndex
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! If errors found in input
! SUBROUTINE PARAMETER DEFINITIONS:na
! INTERFACE BLOCK SPECIFICATIONS:na
! DERIVED TYPE DEFINITIONS:na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: ControlNumAlpha ! Number of control alpha names being passed
INTEGER :: ControlNumProp ! Number of control properties being passed
INTEGER :: TotWinAirflowControl ! Total window airflow control statements
LOGICAL :: WrongSurfaceType ! True if associated surface is not 2- or 3-pane exterior window
INTEGER :: Loop
INTEGER :: SurfNum ! Surface number
INTEGER :: ConstrNum ! Construction number
INTEGER :: ConstrNumSh ! Shaded Construction number
INTEGER :: WSCptr ! Window shading control pointer
INTEGER :: MatGapFlow ! Material number of gas in airflow gap of window's construction
INTEGER :: MatGapFlow1,MatGapFlow2 ! Material number of gas on either side of a between-glass shade/blind
! of the shaded construction of airflow window
! Get the total number of window airflow control statements
cCurrentModuleObject='WindowProperty:AirflowControl'
TotWinAirflowControl = GetNumObjectsFound(cCurrentModuleObject)
IF(TotWinAirflowControl.EQ.0) RETURN
DO Loop = 1,TotWinAirflowControl ! Loop through all surfaces in the input...
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,ControlNumAlpha, &
rNumericArgs,ControlNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SurfNum = FindItemInList(cAlphaArgs(1),Surface%Name,TotSurfaces)
IF(SurfNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'" not found.')
ErrorsFound =.true.
END IF
! Check that associated surface is a 2- or 3-pane exterior window
WrongSurfaceType = .FALSE.
IF(SurfNum /= 0) THEN
IF(Surface(SurfNum)%Class /= SurfaceClass_Window) WrongSurfaceType = .TRUE.
IF(Surface(SurfNum)%Class == SurfaceClass_Window) THEN
ConstrNum = Surface(SurfNum)%Construction
IF(Construct(ConstrNum)%TotGlassLayers /= 2 .AND. Construct(ConstrNum)%TotGlassLayers /= 3) &
WrongSurfaceType = .TRUE.
IF(Surface(SurfNum)%ExtBoundCond /= ExternalEnvironment) WrongSurfaceType = .TRUE.
END IF
IF(WrongSurfaceType) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" is not an exterior window with 2 or 3 glass layers.')
ErrorsFound = .TRUE.
END IF
END IF
! Error if illegal airflow source
IF(cAlphaArgs(2) /= 'INDOORAIR'.AND. cAlphaArgs(2) /= 'OUTDOORAIR') THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" invalid '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))//'"')
END IF
! Error if illegal airflow destination
IF(cAlphaArgs(3) /= 'INDOORAIR'.AND. cAlphaArgs(3) /= 'OUTDOORAIR'.AND. &
cAlphaArgs(3) /= 'RETURNAIR' ) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" invalid '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'"')
END IF
! Error if source = OutsideAir and destination = ReturnAir
IF(cAlphaArgs(2) == 'OUTDOORAIR'.AND. cAlphaArgs(3) == 'RETURNAIR') THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" invalid '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))//'"')
CALL ShowContinueError('..when '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'"')
END IF
! Error if illegal airflow control type
IF(cAlphaArgs(4) /= 'ALWAYSONATMAXIMUMFLOW'.AND. cAlphaArgs(4) /= 'ALWAYSOFF'.AND. &
cAlphaArgs(4) /= 'SCHEDULEDONLY') THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" invalid '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'"')
END IF
! Error if illegal value for Airflow Has Multiplier Schedule
IF(cAlphaArgs(5) /= 'YES'.AND. cAlphaArgs(5) /= 'NO') THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" invalid '//TRIM(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5))//'"')
END IF
! Error if Airflow Control Type = ScheduledOnly and Airflow Has Multiplier Schedule = No
IF(cAlphaArgs(4) == 'SCHEDULEDONLY'.AND. cAlphaArgs(5) == 'NO') THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" invalid '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'"')
CALL ShowContinueError('..when '//TRIM(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5))//'"')
END IF
! Warning if Airflow Control Type = AlwaysOnAtMaxFlow and Airflow Has Multiplier Schedule = Yes
IF(cAlphaArgs(4) == 'ALWAYSONATMAXIMUMFLOW'.AND. cAlphaArgs(5) == 'YES') THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'has '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'"')
CALL ShowContinueError('..but '//TRIM(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5))// &
'If specified, the '//TRIM(cAlphaFieldNames(5))//' will be ignored.')
END IF
! Warning if Airflow Control Type = AlwaysOff and Airflow Has Multiplier Schedule = Yes
IF(cAlphaArgs(4) == 'ALWAYSOFF'.AND. cAlphaArgs(5) == 'YES') THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'has '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'"')
CALL ShowContinueError('..but '//TRIM(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5))// &
'". If specified, the '//TRIM(cAlphaFieldNames(5))//' will be ignored.')
END IF
IF(SurfNum > 0) THEN
AirflowWindows = .TRUE.
IF (SameString(cAlphaArgs(2),'IndoorAir')) THEN
SurfaceWindow(SurfNum)%AirflowSource = AirFlowWindow_Source_IndoorAir
ELSEIF (SameString(cAlphaArgs(2),'OutdoorAir')) THEN
SurfaceWindow(SurfNum)%AirflowSource = AirFlowWindow_Source_OutdoorAir
ENDIF
IF (SameString(cAlphaArgs(3),'IndoorAir')) THEN
SurfaceWindow(SurfNum)%AirflowDestination = AirFlowWindow_Destination_IndoorAir
ELSEIF (SameString(cAlphaArgs(3),'OutdoorAir')) THEN
SurfaceWindow(SurfNum)%AirflowDestination = AirFlowWindow_Destination_OutdoorAir
ELSEIF (SameString(cAlphaArgs(3),'ReturnAir')) THEN
SurfaceWindow(SurfNum)%AirflowDestination = AirFlowWindow_Destination_ReturnAir
ENDIF
IF (SameString(cAlphaArgs(4),'AlwaysOnAtMaximumFlow')) THEN
SurfaceWindow(SurfNum)%AirflowControlType = AirFlowWindow_ControlType_MaxFlow
ELSEIF (SameString(cAlphaArgs(4),'AlwaysOff')) THEN
SurfaceWindow(SurfNum)%AirflowControlType = AirFlowWindow_ControlType_AlwaysOff
ELSEIF (SameString(cAlphaArgs(4),'ScheduledOnly')) THEN
SurfaceWindow(SurfNum)%AirflowControlType = AirFlowWindow_ControlType_Schedule
ENDIF
SurfaceWindow(SurfNum)%MaxAirflow = rNumericArgs(1)
IF(cAlphaArgs(4) == 'SCHEDULEDONLY' .AND. cAlphaArgs(5) == 'YES') THEN
IF(lAlphaFieldBlanks(6)) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", has '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'"')
CALL ShowContinueError('..and '//TRIM(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5))// &
'", but no '//TRIM(cAlphaFieldNames(6))//' specified.')
ELSE
SurfaceWindow(SurfNum)%AirflowHasSchedule = .TRUE.
SurfaceWindow(SurfNum)%AirflowSchedulePtr = GetScheduleIndex(cAlphaArgs(6))
IF(SurfaceWindow(SurfNum)%AirflowSchedulePtr==0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", invalid '//TRIM(cAlphaFieldNames(6))//'="'//TRIM(cAlphaArgs(6))//'"')
END IF
END IF
END IF
! Warning if associated window is an interior window
IF(Surface(SurfNum)%ExtBoundCond /= ExternalEnvironment .AND. .NOT.ErrorsFound) &
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", is an Interior window; cannot be an airflow window.')
IF(.NOT.ErrorsFound) THEN
! Require that gas in airflow gap has type = air
MatGapFlow = Construct(ConstrNum)%LayerPoint(2)
IF(Construct(ConstrNum)%TotGlassLayers==3) MatGapFlow = Construct(ConstrNum)%LayerPoint(4)
IF(Material(MatGapFlow)%GasType(1) /= 1) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", Gas type not air in airflow gap of construction '//TRIM(Construct(ConstrNum)%Name))
END IF
! Require that gas be air in airflow gaps on either side of a between glass shade/blind
WSCptr = Surface(SurfNum)%WindowShadingControlPtr
IF(WSCptr > 0) THEN
IF(WindowShadingControl(WSCptr)%ShadingType==WSC_ST_BetweenGlassShade .OR. &
WindowShadingControl(WSCptr)%ShadingType==WSC_ST_BetweenGlassBlind) THEN
ConstrNumSh = WindowShadingControl(WSCptr)%ShadedConstruction
IF(Construct(ConstrNum)%TotGlassLayers==2) THEN
MatGapFlow1 = Construct(ConstrNumSh)%LayerPoint(2)
MatGapFlow2 = Construct(ConstrNumSh)%LayerPoint(4)
ELSE
MatGapFlow1 = Construct(ConstrNumSh)%LayerPoint(4)
MatGapFlow2 = Construct(ConstrNumSh)%LayerPoint(6)
END IF
IF(Material(MatGapFlow1)%GasType(1) /= 1 .OR. Material(MatGapFlow2)%GasType(1) /= 1) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", gas type must be air on either side of the shade/blind')
END IF
END IF
END IF
END IF
END IF
END DO ! End of loop over window airflow controls
RETURN
END SUBROUTINE GetWindowGapAirflowControlData