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 GetWindowGlassSpectralData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN May 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets spectral data (transmittance, front reflectance, and back
! reflectance at normal incidence vs. wavelength) for glass
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! set to true if errors found in input
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetWindowGlassSpectralData: '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IOStat ! IO Status when calling get input subroutine
CHARACTER(len=MaxNameLength),DIMENSION(1) &
:: SpecDataNames ! Spectral data alpha names
INTEGER :: SpecDataNumAlpha ! Number of spectral data alpha names being passed
INTEGER :: SpecDataNumProp ! Number of spectral data properties being passed
REAL(r64), ALLOCATABLE, DIMENSION(:) :: SpecDataProps !Temporary array to transfer spectal data properties
INTEGER :: Loop
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
INTEGER :: LamNum ! Wavelength number
INTEGER :: TotLam ! Total wavelengths
REAL(r64) :: Lam ! Wavelength (microns)
REAL(r64) :: Tau,RhoF,RhoB ! Transmittance, front reflectance, back reflectance
CurrentModuleObject='MaterialProperty:GlazingSpectralData'
TotSpectralData=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE (SpectralData(TotSpectralData))
IF (TotSpectralData > 0) ALLOCATE(SpecDataProps(MaxSpectralDataElements*4))
DO Loop=1,TotSpectralData
! Call Input Get routine to retrieve spectral data
! Name is followed by up to 450 sets of normal-incidence measured values of
! [wavelength (microns), transmittance, front reflectance, back reflectance] for
! wavelengths covering the short-wave solar spectrum (from about 0.25 to 2.5 microns)
CALL GetObjectItem(CurrentModuleObject,Loop,SpecDataNames,SpecDataNumAlpha,SpecDataProps,SpecDataNumProp,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(SpecDataNames(1),SpectralData%Name,Loop,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
ErrorsFound=.true.
CYCLE
ENDIF
!Load the spectral data derived type from the input data.
SpectralData(Loop)%Name = SpecDataNames(1)
TotLam = SpecDataNumProp/4
IF (MOD(SpecDataNumProp,4) /= 0) THEN
CALL ShowWarningError(RoutineName//trim(CurrentModuleObject)//'="'//trim(SpecDataNames(1))//'" invalid set.')
CALL ShowContinueError('... set not even multiple of 4 items (Wavelength,Trans,ReflFront,ReflBack),'// &
'number of items in dataset = '//trim(TrimSigDigits(SpecDataNumProp)))
CALL ShowContinueError('... remainder after div by 4 = '//trim(TrimSigDigits(MOD(SpecDataNumProp,4)))// &
', remainder items will be set to 0.0')
SpecDataProps(SpecDataNumProp+1:MIN(SpecDataNumProp+4,MaxSpectralDataElements*4))=0.0d0
ENDIF
IF(TotLam > MaxSpectralDataElements) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//trim(CurrentModuleObject)//'="'//trim(SpecDataNames(1))//'" invalid set.')
CALL ShowContinueError('... More than max ['//trim(TrimSigDigits(MaxSpectralDataElements))// &
'] (Wavelength,Trans,ReflFront,ReflBack) entries in set.')
CYCLE
END IF
SpectralData(Loop)%NumOfWavelengths = TotLam
ALLOCATE(SpectralData(Loop)%WaveLength(TotLam)) ! Wavelength (microns)
ALLOCATE(SpectralData(Loop)%Trans(TotLam)) ! Transmittance at normal incidence
ALLOCATE(SpectralData(Loop)%ReflFront(TotLam)) ! Front reflectance at normal incidence
ALLOCATE(SpectralData(Loop)%ReflBack(TotLam)) ! Back reflectance at normal incidence
DO LamNum = 1,TotLam
SpectralData(Loop)%WaveLength(LamNum) = SpecDataProps(4*LamNum-3)
SpectralData(Loop)%Trans(LamNum) = SpecDataProps(4*LamNum-2)
! Following is needed since angular calculation in subr TransAndReflAtPhi
! fails for Trans = 0.0
IF(SpectralData(Loop)%Trans(LamNum) < 0.001d0) SpectralData(Loop)%Trans(LamNum) = 0.001d0
SpectralData(Loop)%ReflFront(LamNum) = SpecDataProps(4*LamNum-1)
SpectralData(Loop)%ReflBack(LamNum) = SpecDataProps(4*LamNum)
END DO
! Check integrity of the spectral data
DO LamNum = 1,TotLam
Lam = SpectralData(Loop)%WaveLength(LamNum)
Tau = SpectralData(Loop)%Trans(LamNum)
RhoF = SpectralData(Loop)%ReflFront(LamNum)
RhoB = SpectralData(Loop)%ReflBack(LamNum)
IF(LamNum < TotLam) THEN
IF (SpectralData(Loop)%WaveLength(LamNum+1) <= Lam) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//trim(CurrentModuleObject)//'="'//trim(SpecDataNames(1))//'" invalid set.')
CALL ShowContinueError('... Wavelengths not in increasing order. '// &
'at wavelength#='//trim(TrimSigDigits(LamNum))//', value=['//trim(TrimSigDigits(Lam,4))// &
'], next is ['//trim(TrimSigDigits(SpectralData(Loop)%WaveLength(LamNum+1),4))//'].')
END IF
END IF
IF(Lam < 0.1d0 .OR. Lam > 4.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//trim(CurrentModuleObject)//'="'//trim(SpecDataNames(1))//'" invalid value.')
CALL ShowContinueError('... A wavelength is not in the range 0.1 to 4.0 microns; '// &
'at wavelength#='//trim(TrimSigDigits(LamNum))//', value=['//trim(TrimSigDigits(Lam,4))// &
'].')
END IF
! TH 2/15/2011. CR 8343
! IGDB (International Glazing Database) does not meet the above strict restrictions.
! Relax rules to allow directly use of spectral data from IGDB
IF(Tau > 1.01d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//trim(CurrentModuleObject)//'="'//trim(SpecDataNames(1))//'" invalid value.')
CALL ShowContinueError('... A transmittance is > 1.0; '// &
'at wavelength#='//trim(TrimSigDigits(LamNum))//', value=['//trim(TrimSigDigits(Tau,4))//'].')
END IF
IF(RhoF < 0.0d0 .OR. RhoF > 1.02d0 .OR. RhoB < 0.0d0 .OR. RhoB > 1.02d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//trim(CurrentModuleObject)//'="'//trim(SpecDataNames(1))//'" invalid value.')
CALL ShowContinueError('... A reflectance is < 0.0 or > 1.0; '// &
'at wavelength#='//trim(TrimSigDigits(LamNum))//', RhoF value=['//trim(TrimSigDigits(RhoF,4))//'].')
CALL ShowContinueError('... A reflectance is < 0.0 or > 1.0; '// &
'at wavelength#='//trim(TrimSigDigits(LamNum))//', RhoB value=['//trim(TrimSigDigits(RhoB,4))//'].')
END IF
IF((Tau + RhoF) > 1.03d0 .OR. (Tau + RhoB) > 1.03d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//trim(CurrentModuleObject)//'="'//trim(SpecDataNames(1))//'" invalid value.')
CALL ShowContinueError('... Transmittance + reflectance) > 1.0 for an entry; '// &
'at wavelength#='//trim(TrimSigDigits(LamNum))//', value(Tau+RhoF)=['//trim(TrimSigDigits((Tau + RhoF),4))// &
'], value(Tau+RhoB)=['//trim(TrimSigDigits((Tau + RhoB),4))//'].')
END IF
END DO
END DO
IF (TotSpectralData > 0) DEALLOCATE(SpecDataProps)
RETURN
END SUBROUTINE GetWindowGlassSpectralData