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 | |||
integer, | intent(inout) | :: | SurfNum | |||
integer, | intent(in) | :: | TotRectDetachedFixed | |||
integer, | intent(in) | :: | TotRectDetachedBldg |
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 GetRectDetShdSurfaceData(ErrorsFound,SurfNum,TotRectDetachedFixed,TotRectDetachedBldg)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN January 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets the simple, rectantular detached surfaces.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE DataReportingFlags
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, GetObjectDefMaxArgs
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! Error flag indicator (true if errors found)
INTEGER, INTENT(INOUT) :: SurfNum ! Count of Current SurfaceNumber
INTEGER, INTENT(IN) :: TotRectDetachedFixed ! Number of Fixed Detached Shading Surfaces to obtain
INTEGER, INTENT(IN) :: TotRectDetachedBldg ! Number of Building Detached Shading Surfaces to obtain
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER, DIMENSION(2) :: cModuleObjects= &
(/'Shading:Site ', &
'Shading:Building'/)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: NumAlphas ! Number of material alpha names being passed
INTEGER :: NumNumbers ! Number of material properties being passed
INTEGER :: Loop
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
INTEGER :: Item
INTEGER :: ItemsToGet
INTEGER :: ClassItem
IF ((TotRectDetachedFixed+TotRectDetachedBldg) > 0 .and. SolarDistribution == MinimalShadowing) THEN
CALL ShowWarningError('Detached shading effects are ignored when Solar Distribution = MinimalShadowing')
ENDIF
IF (TotRectDetachedFixed+TotRectDetachedBldg == 0) RETURN
DO Item=1,2
cCurrentModuleObject=cModuleObjects(Item)
IF (Item == 1) THEN
ItemsToGet=TotRectDetachedFixed
ClassItem=SurfaceClass_Detached_F
ELSE !IF (Item == 2) THEN
ItemsToGet=TotRectDetachedBldg
ClassItem=SurfaceClass_Detached_B
ENDIF
CALL GetObjectDefMaxArgs(cCurrentModuleObject,Loop,NumAlphas,NumNumbers)
IF (NumAlphas /= 1) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Object Definition indicates'// &
'not = 1 Alpha Objects, Number Indicated='// &
TRIM(TrimSigDigits(NumAlphas)))
ErrorsFound=.true.
ENDIF
DO Loop=1,ItemsToGet
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNumbers,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),SurfaceTmp%Name,SurfNum,ErrorInName,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...each surface name must not duplicate other surface names (of any type)')
ErrorsFound=.true.
CYCLE
ENDIF
SurfNum=SurfNum+1
SurfaceTmp(SurfNum)%Name = cAlphaArgs(1) ! Set the Surface Name in the Derived Type
SurfaceTmp(SurfNum)%Class=ClassItem
SurfaceTmp(SurfNum)%HeatTransSurf=.false.
SurfaceTmp(SurfNum)%Azimuth=rNumericArgs(1)
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_B .and. .not. WorldCoordSystem) THEN
SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(SurfNum)%Azimuth+BuildingAzimuth
ENDIF
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_B) THEN
SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(SurfNum)%Azimuth+BuildingRotationAppendixG
ENDIF
SurfaceTmp(SurfNum)%Tilt=rNumericArgs(2)
SurfaceTmp(SurfNum)%Sides=4
ALLOCATE(SurfaceTmp(SurfNum)%Vertex(SurfaceTmp(SurfNum)%Sides))
CALL MakeRectangularVertices(SurfNum,rNumericArgs(3), &
rNumericArgs(4),rNumericArgs(5),rNumericArgs(6),rNumericArgs(7),RectSurfRefWorldCoordSystem)
IF (SurfaceTmp(SurfNum)%Area <= 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", Surface Area <= 0.0; Entered Area='// &
TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Area,2)))
ErrorsFound=.true.
ENDIF
IF (MakeMirroredDetachedShading) THEN
CALL MakeMirrorSurface(SurfNum)
ENDIF
ENDDO
ENDDO ! Item Loop
RETURN
END SUBROUTINE GetRectDetShdSurfaceData