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 GetShadingSurfReflectanceData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN Sept 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets data for a Shading Surface Reflectance object. This is only called when the
! Solar Distribution is to be calculated for reflectances.
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList
USE General, ONLY: 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:
CHARACTER(len=*), PARAMETER :: fmtA='(A)'
! INTERFACE BLOCK SPECIFICATIONS:na
! DERIVED TYPE DEFINITIONS:na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: NumAlpha ! Number of alpha names being passed
INTEGER :: NumProp ! Number of properties being passed
INTEGER :: TotShadingSurfaceReflectance ! Total Shading Surface Refleftance statements
INTEGER :: Loop ! DO loop index
INTEGER :: SurfNum ! Surface number
INTEGER :: GlConstrNum ! Glazing construction number
LOGICAL :: WrongSurfaceType
! For shading surfaces, initialize value of reflectance values to default values. These values
! may be overridden below for shading surfaces with an associated Shading Surface Reflectance object.
DO SurfNum = 1, TotSurfaces
IF (.not. (SurfaceTmp(SurfNum)%Class == SurfaceClass_Shading .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_F .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_B .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Overhang .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Fin) ) CYCLE
SurfaceTmp(SurfNum)%ShadowSurfDiffuseSolRefl = 0.2d0
SurfaceTmp(SurfNum)%ShadowSurfDiffuseVisRefl = 0.2d0
SurfaceTmp(SurfNum)%ShadowSurfGlazingFrac = 0.0d0
SurfaceTmp(SurfNum)%ShadowSurfGlazingConstruct = 0
END DO
! Get the total number of Shading Surface Reflectance objects
cCurrentModuleObject='ShadingProperty:Reflectance'
TotShadingSurfaceReflectance = GetNumObjectsFound(cCurrentModuleObject)
! IF(TotShadingSurfaceReflectance.EQ.0) RETURN
DO Loop = 1, TotShadingSurfaceReflectance
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlpha,rNumericArgs,NumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SurfNum = FindItemInList(cAlphaArgs(1),SurfaceTmp%Name,TotSurfaces)
IF(SurfNum == 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", invalid specification')
CALL ShowContinueError('.. not found '//TRIM(cAlphaFieldNames(1))//'="'//trim(cAlphaArgs(1))//'".')
! ErrorsFound =.true.
CYCLE
END IF
! Check that associated surface is a shading surface
WrongSurfaceType = .FALSE.
IF(SurfNum /= 0) THEN
IF (.not. (SurfaceTmp(SurfNum)%Class == SurfaceClass_Shading .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_F .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_B .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Overhang .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Fin) ) WrongSurfaceType = .TRUE.
IF(WrongSurfaceType) THEN
CALL ShowSevereError('GetShadingSurfReflectanceData: '//TRIM(cCurrentModuleObject)//'="'// &
TRIM(SurfaceTmp(SurfNum)%Name)// &
'", surface is not a shading surface.')
ErrorsFound = .TRUE.
CYCLE
END IF
END IF
! If associated surface is a shading surface, set reflectance values
SurfaceTmp(SurfNum)%ShadowSurfGlazingFrac = rNumericArgs(3)
SurfaceTmp(SurfNum)%ShadowSurfDiffuseSolRefl = (1.d0-rNumericArgs(3)) * rNumericArgs(1)
SurfaceTmp(SurfNum)%ShadowSurfDiffuseVisRefl = (1.d0-rNumericArgs(3)) * rNumericArgs(2)
IF(rNumericArgs(3) > 0.0d0) THEN
GlConstrNum = FindItemInList(cAlphaArgs(2),Construct%Name,TotConstructs)
IF(GlConstrNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cAlphaFieldNames(2))//' not found='//TRIM(cAlphaArgs(2)))
ErrorsFound =.true.
ELSE
Construct(GlConstrNum)%IsUsed=.true.
END IF
SurfaceTmp(SurfNum)%ShadowSurfGlazingConstruct = GlConstrNum
END IF
SurfNum = FindItemInList('Mir-'//cAlphaArgs(1),SurfaceTmp%Name,TotSurfaces)
IF (SurfNum == 0) CYCLE
SurfaceTmp(SurfNum)%ShadowSurfGlazingFrac = rNumericArgs(3)
SurfaceTmp(SurfNum)%ShadowSurfDiffuseSolRefl = (1.d0-rNumericArgs(3)) * rNumericArgs(1)
SurfaceTmp(SurfNum)%ShadowSurfDiffuseVisRefl = (1.d0-rNumericArgs(3)) * rNumericArgs(2)
IF(rNumericArgs(3) > 0.0d0) THEN
GlConstrNum = FindItemInList(cAlphaArgs(2),Construct%Name,TotConstructs)
IF(GlConstrNum /= 0) THEN
Construct(GlConstrNum)%IsUsed=.true.
END IF
SurfaceTmp(SurfNum)%ShadowSurfGlazingConstruct = GlConstrNum
END IF
END DO ! End of loop over Shading Surface Reflectance objects
! Write reflectance values to .eio file.
Write(OutputFileInits,fmtA) '! <ShadingProperty Reflectance>,Shading Surface Name,Shading Type,Diffuse Solar Reflectance, '// &
'Diffuse Visible Reflectance,Surface Glazing Fraction,Surface Glazing Contruction'
DO SurfNum = 1, TotSurfaces
IF (.not. (SurfaceTmp(SurfNum)%Class == SurfaceClass_Shading .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_F .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_B .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Overhang .or. &
SurfaceTmp(SurfNum)%Class == SurfaceClass_Fin) ) CYCLE
IF (SurfaceTmp(SurfNum)%ShadowSurfGlazingConstruct /= 0) THEN
Write(OutputFileInits,'(A)') 'ShadingProperty Reflectance,'//trim(SurfaceTmp(SurfNum)%Name)//','// &
trim(cSurfaceClass(SurfaceTmp(SurfNum)%class))//','// &
trim(RoundSigDigits(SurfaceTmp(SurfNum)%ShadowSurfDiffuseSolRefl,2))//','// &
trim(RoundSigDigits(SurfaceTmp(SurfNum)%ShadowSurfDiffuseVisRefl,2))//','// &
trim(RoundSigDigits(SurfaceTmp(SurfNum)%ShadowSurfGlazingFrac,2))//','// &
trim(Construct(SurfaceTmp(SurfNum)%ShadowSurfGlazingConstruct)%Name)
ELSE
Write(OutputFileInits,'(A)') 'ShadingProperty Reflectance,'//trim(SurfaceTmp(SurfNum)%Name)//','// &
trim(cSurfaceClass(SurfaceTmp(SurfNum)%class))//','// &
trim(RoundSigDigits(SurfaceTmp(SurfNum)%ShadowSurfDiffuseSolRefl,2))//','// &
trim(RoundSigDigits(SurfaceTmp(SurfNum)%ShadowSurfDiffuseVisRefl,2))//','// &
trim(RoundSigDigits(SurfaceTmp(SurfNum)%ShadowSurfGlazingFrac,2))//', N/A'
ENDIF
END DO
RETURN
END SUBROUTINE GetShadingSurfReflectanceData