Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(CFSLAYER), | intent(in) | :: | L | |||
type(CFSSWP), | intent(inout) | :: | SWP |
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 FillDefaultsSWP(L, SWP)
!
! SUBROUTINE INFORMATION:
! AUTHOR The University of WaterLoo
! DATE WRITTEN unknown
! MODIFIED Bereket Nigusse/FSEC, June 2013
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Fills in defaulted short wave optical properties for equivalent window
! layers
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE
TYPE( CFSLAYER), INTENT( IN) :: L ! CFSLayer (input properties must be set)
TYPE( CFSSWP), INTENT( INOUT) :: SWP ! properties to fill
! may be within L
CHARACTER (len=*), PARAMETER :: RoutineName = 'FillDefaultsSWP: '
LOGICAL :: OK
LOGICAL :: ErrorsFound
! Flow
! default back taus to front (often equal)
IF (SWP%TAUSBBB < 0.0d0) SWP%TAUSBBB = SWP%TAUSFBB
IF( SWP%TAUSBBD < 0.0d0) SWP%TAUSBBD = SWP%TAUSFBD
IF (L%LTYPE == ltyGLAZE) THEN
! estimate diffuse properties if any < 0 or autocalculate
IF (MIN( SWP%RHOSBDD, SWP%RHOSFDD, SWP%TAUS_DD) < 0.0d0) THEN
CALL Specular_EstimateDiffuseProps( SWP)
END IF
ELSE IF (L%LTYPE == ltyVBHOR .OR. L%LTYPE == ltyVBVER) THEN
ELSE IF (L%LTYPE == ltyDRAPE) THEN
! estimate diffuse properties if any < 0
IF (MIN( SWP%RHOSBDD, SWP%RHOSFDD, SWP%TAUS_DD) < 0.0d0) THEN
CALL Fabric_EstimateDiffuseProps( SWP)
END IF
ELSE IF (L%LTYPE == ltyROLLB) THEN
! estimate diffuse properties if any < 0
IF (MIN( SWP%RHOSBDD, SWP%RHOSFDD, SWP%TAUS_DD) < 0.0d0) THEN
OK = RB_SWP( L, SWP) ! TODO RB
END IF
ELSE IF (L%LTYPE == ltyINSCRN) THEN
IF (SWP%TAUSFBB < 0.0d0) THEN
SWP%TAUSFBB = IS_OPENNESS( L%S, L%W)
IF (SWP%TAUSBBB < 0.0d0) SWP%TAUSBBB = SWP%TAUSFBB
END IF
IF (MIN( SWP%RHOSBDD, SWP%RHOSFDD, SWP%TAUS_DD) < 0.0d0) THEN
OK = IS_SWP( L, SWP) ! TODO IS
END IF
ELSE IF (L%LTYPE == ltyNONE .OR. L%LTYPE == ltyROOM) THEN
! none or room: do nothing
ELSE
CALL ShowSevereError( RoutineName//trim(L%Name)//'.')
CALL ShowContinueError('...invalid layer type specified.')
END IF
RETURN
END SUBROUTINE FillDefaultsSWP