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 GetMovableInsulationData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN May 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the movable insulation data that can be associated with
! a surface.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Movable Insulation Definition
! SurfaceControl:MovableInsulation,
! \memo Exterior or Interior Insulation on opaque surfaces
! A1, \field Insulation Type
! \required-field
! \type choice
! \key Outside
! \key Inside
! A2, \field Surface Name
! \required-field
! \type object-list
! \object-list SurfaceNames
! A3, \field Material Name
! \required-field
! \object-list MaterialName
! A4; \field Schedule Name
! \required-field
! \type object-list
! \object-list ScheduleNames
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, VerifyName, SameString
USE ScheduleManager, ONLY: GetScheduleIndex
USE General, ONLY: TrimSigDigits,RoundSigDigits
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 NAlphas
INTEGER NNums
INTEGER IOSTAT
INTEGER Loop
INTEGER NMatInsul
INTEGER SurfNum
INTEGER MaterNum
INTEGER SchNum
INTEGER InslType
cCurrentModuleObject='SurfaceControl:MovableInsulation'
NMatInsul=GetNumObjectsFound(cCurrentModuleObject)
DO Loop=1,NMatInsul
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NAlphas,rNumericArgs,NNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SurfNum=FindItemInList(cAlphaArgs(2),SurfaceTmp%Name,TotSurfaces)
MaterNum=FindItemInList(cAlphaArgs(3),Material%Name,TotMaterials)
SchNum=GetScheduleIndex(cAlphaArgs(4))
IF (SameString(cAlphaArgs(1),'Outside')) THEN
InslType=1
ELSEIF (SameString(cAlphaArgs(1),'Inside')) THEN
InslType=2
ELSE
InslType=0
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", invalid data.')
CALL ShowContinueError(' invalid '//TRIM(cAlphaFieldNames(1))//'="'//TRIM(cAlphaArgs(1))// &
'", [should be Inside or Outside]')
ErrorsFound=.false.
ENDIF
IF (SurfNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", invalid data.')
CALL ShowContinueError(' invalid (not found) '//TRIM(cAlphaFieldNames(2)))
ErrorsFound=.true.
ELSE
IF (MaterNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", invalid data.')
CALL ShowContinueError(' invalid (not found) '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'"')
ErrorsFound=.true.
ELSE
IF (SchNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", invalid data.')
CALL ShowContinueError(' invalid (not found) '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'"')
ErrorsFound=.true.
ELSE
SELECT CASE (InslType)
CASE (1)
IF (SurfaceTmp(SurfNum)%MaterialMovInsulExt > 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", already assigned.')
CALL ShowContinueError('"Outside", was already assigned Material="'// &
trim(Material(SurfaceTmp(SurfNum)%MaterialMovInsulInt)%Name)//'".')
CALL ShowContinueError('attempting to assign Material="'//trim(Material(MaterNum)%Name)//'".')
ErrorsFound=.true.
ENDIF
SurfaceTmp(SurfNum)%MaterialMovInsulExt=MaterNum
SurfaceTmp(SurfNum)%SchedMovInsulExt=SchNum
IF (Material(MaterNum)%Resistance <= 0.0d0) THEN
IF (Material(MaterNum)%Conductivity <= 0.0d0 .or. Material(MaterNum)%Thickness <= 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", invalid material.')
CALL ShowContinueError('"Outside", invalid material for movable insulation.')
CALL ShowContinueError('Material="'//trim(Material(MaterNum)%Name)//'",'// &
'Resistance=['//trim(RoundSigDigits(Material(MaterNum)%Resistance,3))// &
'], must be > 0 for use in Movable Insulation.')
ErrorsFound=.true.
ELSEIF (Material(MaterNum)%Conductivity > 0.0d0) THEN
Material(MaterNum)%Resistance=Material(MaterNum)%Thickness/Material(MaterNum)%Conductivity
ENDIF
ENDIF
IF (Material(MaterNum)%Conductivity <= 0.0d0) THEN
IF (Material(MaterNum)%Resistance <= 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", invalid material.')
CALL ShowContinueError('"Outside", invalid material for movable insulation.')
CALL ShowContinueError('Material="'//trim(Material(MaterNum)%Name)//'",'// &
'Conductivity=['//trim(RoundSigDigits(Material(MaterNum)%Conductivity,3))// &
'], must be > 0 for use in Movable Insulation.')
ErrorsFound=.true.
ENDIF
ENDIF
CASE (2)
IF (SurfaceTmp(SurfNum)%MaterialMovInsulInt > 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", already assigned.')
CALL ShowContinueError('"Inside", was already assigned Material="'// &
trim(Material(SurfaceTmp(SurfNum)%MaterialMovInsulInt)%Name)//'".')
CALL ShowContinueError('attempting to assign Material="'//trim(Material(MaterNum)%Name)//'".')
ErrorsFound=.true.
ENDIF
SurfaceTmp(SurfNum)%MaterialMovInsulInt=MaterNum
SurfaceTmp(SurfNum)%SchedMovInsulInt=SchNum
IF (Material(MaterNum)%Resistance <= 0.0d0) THEN
IF (Material(MaterNum)%Conductivity <= 0.0d0 .or. Material(MaterNum)%Thickness <= 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", invalid material.')
CALL ShowContinueError('"Inside", invalid material for movable insulation.')
CALL ShowContinueError('Material="'//trim(Material(MaterNum)%Name)//'",'// &
'Resistance=['//trim(RoundSigDigits(Material(MaterNum)%Resistance,3))// &
'], must be > 0 for use in Movable Insulation.')
ErrorsFound=.true.
ELSEIF (Material(MaterNum)%Conductivity > 0.0d0) THEN
Material(MaterNum)%Resistance=Material(MaterNum)%Thickness/Material(MaterNum)%Conductivity
ENDIF
ENDIF
CASE DEFAULT
END SELECT
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Window) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))//'"')
CALL ShowContinueError('invalid use on a Window. Use WindowProperty:ShadingControl instead.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
RETURN
END SUBROUTINE GetMovableInsulationData