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) | :: | TotRectExtWalls | |||
| integer, | intent(in) | :: | TotRectIntWalls | |||
| integer, | intent(in) | :: | TotRectIZWalls | |||
| integer, | intent(in) | :: | TotRectUGWalls | |||
| integer, | intent(in) | :: | TotRectRoofs | |||
| integer, | intent(in) | :: | TotRectCeilings | |||
| integer, | intent(in) | :: | TotRectIZCeilings | |||
| integer, | intent(in) | :: | TotRectGCFloors | |||
| integer, | intent(in) | :: | TotRectIntFloors | |||
| integer, | intent(in) | :: | TotRectIZFloors | |||
| integer, | intent(in), | DIMENSION(:) | :: | BaseSurfIDs | ||
| integer, | intent(inout) | :: | NeedToAddSurfaces | 
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 GetRectSurfaces(ErrorsFound,SurfNum,TotRectExtWalls,TotRectIntWalls,TotRectIZWalls,TotRectUGWalls,  &
      TotRectRoofs,TotRectCeilings,TotRectIZCeilings,TotRectGCFloors,TotRectIntFloors,TotRectIZFloors,     &
      BaseSurfIDs,NeedToAddSurfaces)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Linda Lawrie
          !       DATE WRITTEN   December 2008
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! Get simple (rectangular, LLC corner specified) walls
          ! METHODOLOGY EMPLOYED:
          ! na
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE DataIPShortCuts
  USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, VerifyName, GetObjectDefMaxArgs
  USE General, ONLY: TrimSigDigits,RoundSigDigits
  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)            :: TotRectExtWalls   ! Number of Exterior Walls to obtain
  INTEGER, INTENT(IN)            :: TotRectIntWalls   ! Number of Adiabatic Walls to obtain
  INTEGER, INTENT(IN)            :: TotRectIZWalls    ! Number of Interzone Walls to obtain
  INTEGER, INTENT(IN)            :: TotRectUGWalls    ! Number of Underground to obtain
  INTEGER, INTENT(IN)            :: TotRectRoofs      ! Number of Roofs to obtain
  INTEGER, INTENT(IN)            :: TotRectCeilings   ! Number of Adiabatic Ceilings to obtain
  INTEGER, INTENT(IN)            :: TotRectIZCeilings ! Number of Interzone Ceilings to obtain
  INTEGER, INTENT(IN)            :: TotRectGCFloors   ! Number of Floors with Ground Contact to obtain
  INTEGER, INTENT(IN)            :: TotRectIntFloors  ! Number of Adiabatic Walls to obtain
  INTEGER, INTENT(IN)            :: TotRectIZFloors   ! Number of Interzone Floors to obtain
  INTEGER, DIMENSION(:), INTENT(IN) :: BaseSurfIDs    ! ID Assignments for valid surface classes
  INTEGER, INTENT(INOUT)         :: NeedToAddSurfaces ! Number of surfaces to add, based on unentered IZ surfaces
          ! SUBROUTINE PARAMETER DEFINITIONS:
  CHARACTER(len=*), PARAMETER, DIMENSION(10) :: cModuleObjects=  &
    (/'Wall:Exterior      ',  &
      'Wall:Adiabatic     ',  &
      'Wall:Interzone     ',  &
      'Wall:Underground   ',  &
      'Roof               ',  &
      'Ceiling:Adiabatic  ',  &
      'Ceiling:Interzone  ',  &
      'Floor:GroundContact',  &
      'Floor:Adiabatic    ',  &
      'Floor:Interzone    '/)
          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na
          ! DERIVED TYPE DEFINITIONS:
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
          ! na
  INTEGER :: Item
  INTEGER :: ItemsToGet
  INTEGER :: Loop
  INTEGER :: NumAlphas
  INTEGER :: NumNumbers
  INTEGER :: IOStat            ! IO Status when calling get input subroutine
  INTEGER :: Found             ! For matching base surfaces
  LOGICAL :: ErrorInName
  LOGICAL :: IsBlank
  LOGICAL :: GettingIZSurfaces
  INTEGER :: OtherSurfaceField
  INTEGER :: ExtBoundCondition
  INTEGER :: ClassItem
  INTEGER :: ZoneNum
  DO Item=1,10
    cCurrentModuleObject=cModuleObjects(Item)
    IF (Item == 1) THEN
      ItemsToGet=TotRectExtWalls
      GettingIZSurfaces=.false.
      OtherSurfaceField=0
      ExtBoundCondition=ExternalEnvironment
      ClassItem=1
    ELSEIF (Item == 2) THEN
      ItemsToGet=TotRectIntWalls
      GettingIZSurfaces=.false.
      OtherSurfaceField=0
      ExtBoundCondition=UnreconciledZoneSurface
      ClassItem=1
    ELSEIF (Item == 3) THEN
      ItemsToGet=TotRectIZWalls
      GettingIZSurfaces=.true.
      OtherSurfaceField=4
      ExtBoundCondition=UnreconciledZoneSurface
      ClassItem=1
    ELSEIF (Item == 4) THEN
      ItemsToGet=TotRectUGWalls
      GettingIZSurfaces=.false.
      OtherSurfaceField=0
      ExtBoundCondition=Ground
      ClassItem=1
    ELSEIF (Item == 5) THEN
      ItemsToGet=TotRectRoofs
      GettingIZSurfaces=.false.
      OtherSurfaceField=0
      ExtBoundCondition=ExternalEnvironment
      ClassItem=3
    ELSEIF (Item == 6) THEN
      ItemsToGet=TotRectCeilings
      GettingIZSurfaces=.false.
      OtherSurfaceField=0
      ExtBoundCondition=UnreconciledZoneSurface
      ClassItem=3
    ELSEIF (Item == 7) THEN
      ItemsToGet=TotRectIZCeilings
      GettingIZSurfaces=.false.
      OtherSurfaceField=4
      ExtBoundCondition=UnreconciledZoneSurface
      ClassItem=3
    ELSEIF (Item == 8) THEN
      ItemsToGet=TotRectGCFloors
      GettingIZSurfaces=.false.
      OtherSurfaceField=0
      ExtBoundCondition=Ground
      ClassItem=2
    ELSEIF (Item == 9) THEN
      ItemsToGet=TotRectIntFloors
      GettingIZSurfaces=.false.
      OtherSurfaceField=0
      ExtBoundCondition=UnreconciledZoneSurface
      ClassItem=2
    ELSE  !IF (Item == 10) THEN
      ItemsToGet=TotRectIZFloors
      GettingIZSurfaces=.true.
      OtherSurfaceField=4
      ExtBoundCondition=UnreconciledZoneSurface
      ClassItem=2
    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
      IF (NumNumbers < 7) THEN
        CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//  &
                        '", Too few number of numeric args=['//TRIM(TrimSigDigits(NumNumbers))//'].')
        ErrorsFound=.true.
      ENDIF
      SurfNum=SurfNum+1
      SurfaceTmp(SurfNum)%Name = cAlphaArgs(1)  ! Set the Surface Name in the Derived Type
      SurfaceTmp(SurfNum)%Class = BaseSurfIDs(ClassItem) ! Set class number
      SurfaceTmp(SurfNum)%Construction=FindIteminList(cAlphaArgs(2),Construct%Name,TotConstructs)
      IF(SurfaceTmp(SurfNum)%Construction == 0) THEN
        ErrorsFound = .true.
        CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)//  &
                               '", invalid '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))//'".')
      ELSEIF (Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsWindow) THEN
        ErrorsFound = .true.
        CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)//  &
                               '", invalid '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(2))//  &
                               '" - has Window materials.')
        CALL ShowContinueError('...because '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
      ELSE
        Construct(SurfaceTmp(SurfNum)%Construction)%IsUsed=.true.
        SurfaceTmp(SurfNum)%ConstructionStoredInputValue  = SurfaceTmp(SurfNum)%Construction
      END IF
      SurfaceTmp(SurfNum)%HeatTransSurf=.true.
      SurfaceTmp(SurfNum)%BaseSurf = SurfNum
      SurfaceTmp(SurfNum)%BaseSurfName=SurfaceTmp(SurfNum)%Name
      SurfaceTmp(SurfNum)%ZoneName=cAlphaArgs(3)
      ZoneNum=FindItemInList(SurfaceTmp(SurfNum)%ZoneName,Zone%Name,NumOfZones)
      IF (ZoneNum /= 0) THEN
        SurfaceTmp(SurfNum)%Zone = ZoneNum
      ELSE
        CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)//  &
                               '", invalid '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'".')
        SurfaceTmp(SurfNum)%Class=SurfaceTmp(SurfNum)%Class+100
        SurfaceTmp(SurfNum)%ZoneName='Unknown Zone'
        ErrorsFound=.true.
      ENDIF
      SurfaceTmp(SurfNum)%ExtBoundCond = ExtBoundCondition
      IF (SurfaceTmp(SurfNum)%Construction > 0) THEN
        IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Wall .and.   &
            Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsCfactorWall .and. &
            SurfaceTmp(SurfNum)%ExtBoundCond == Ground) THEN
              SurfaceTmp(SurfNum)%ExtBoundCond = GroundFCfactorMethod
        ELSEIF (Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsCfactorWall) THEN
          ErrorsFound = .true.
          CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)//  &
            '", Construction type is "Construction:CfactorUndergroundWall" but invalid for this object.')
        ENDIF
        IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Floor .and.   &
            Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsFfactorFloor .and. &
            SurfaceTmp(SurfNum)%ExtBoundCond == Ground) THEN
              SurfaceTmp(SurfNum)%ExtBoundCond = GroundFCfactorMethod
        ELSEIF (Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsFfactorFloor) THEN
          ErrorsFound = .true.
          CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)//  &
            '", Construction type is "Construction:FfactorGroundFloor" but invalid for this object.')
        ENDIF
      ENDIF
      SurfaceTmp(SurfNum)%ExtSolar=.false.
      SurfaceTmp(SurfNum)%ExtWind=.false.
      SurfaceTmp(SurfNum)%ViewFactorGround = AutoCalculate
      IF (SurfaceTmp(SurfNum)%ExtBoundCond == ExternalEnvironment) THEN
        SurfaceTmp(SurfNum)%ExtSolar=.true.
        SurfaceTmp(SurfNum)%ExtWind=.true.
        !Set the logical flag for the EcoRoof presented, this is only based on the flag in the construction type
        IF (SurfaceTmp(SurfNum)%Construction > 0) &
          SurfaceTmp(SurfNum)%ExtEcoRoof=Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsEcoRoof
      Else If (SurfaceTmp(SurfNum)%ExtBoundCond == UnreconciledZoneSurface) THEN
        IF (GettingIZSurfaces) THEN
          SurfaceTmp(SurfNum)%ExtBoundCondName=cAlphaArgs(OtherSurfaceField)
          Found=FindItemInList(SurfaceTmp(SurfNum)%ExtBoundCondName,Zone%Name,NumOfZones)
          ! see if match to zone, then it's an unentered other surface, else reconciled later
          IF (Found > 0) THEN
            NeedToAddSurfaces=NeedToAddSurfaces+1
            SurfaceTmp(SurfNum)%ExtBoundCond = UnenteredAdjacentZoneSurface
          ENDIF
        ELSE
          SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(SurfNum)%Name
        ENDIF
      Else If (SurfaceTmp(SurfNum)%ExtBoundCond == Ground) THEN
        IF (NoGroundTempObjWarning) THEN
          IF (.not. GroundTempObjInput) THEN
            CALL ShowWarningError('GetRectSurfaces: Surfaces with interface to Ground found '//  &
                 'but no "Ground Temperatures" were input.')
            CALL ShowContinueError('Found first in surface='//TRIM(cAlphaArgs(1)))
            CALL ShowContinueError('Defaults, constant throughout the year of ('//TRIM(RoundSigDigits(GroundTemp,1))// &
                               ') will be used.')
          ENDIF
          NoGroundTempObjWarning=.false.
        ENDIF
      Else If (SurfaceTmp(SurfNum)%ExtBoundCond == GroundFCfactorMethod) THEN
        IF (NoFCGroundTempObjWarning) THEN
          IF (.not. FCGroundTemps) THEN
            CALL ShowSevereError('GetRectSurfaces: Surfaces with interface to GroundFCfactorMethod found '//  &
                'but no "FC Ground Temperatures" were input.')
            CALL ShowContinueError('Found first in surface='//TRIM(cAlphaArgs(1)))
            CALL ShowContinueError('Either add a "Site:GroundTemperature:FCfactorMethod" object or '//  &
                ' use a weather file with Ground Temperatures.')
            ErrorsFound=.true.
            NoFCGroundTempObjWarning=.false.
          ENDIF
        End IF
      End If  ! ... End of the ExtBoundCond logical IF Block
      SurfaceTmp(SurfNum)%Azimuth=rNumericArgs(1)
      SurfaceTmp(SurfNum)%Tilt=rNumericArgs(2)
      IF (.not. WorldCoordSystem) THEN
        IF (ZoneNum /= 0) THEN
          SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(SurfNum)%Azimuth+BuildingAzimuth+Zone(ZoneNum)%RelNorth
        ENDIF
      ENDIF
      IF (ZoneNum /= 0) THEN
        SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(SurfNum)%Azimuth+BuildingRotationAppendixG
      ENDIF
      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
      !Check wall height for the CFactor walls
      IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Wall .and. SurfaceTmp(SurfNum)%ExtBoundCond == GroundFCfactorMethod) THEN
        IF (ABS(SurfaceTmp(SurfNum)%Height - Construct(SurfaceTmp(SurfNum)%Construction)%Height)>0.05d0) THEN
          CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)//  &
                     '", underground Wall Height = '//TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Height,2)))
          CALL ShowContinueError('..which deos not match its construction height.')
        ENDIF
      ENDIF
      !Check area and perimeter for the FFactor floors
      IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Floor .and. SurfaceTmp(SurfNum)%ExtBoundCond == GroundFCfactorMethod) THEN
        IF (ABS(SurfaceTmp(SurfNum)%Area - Construct(SurfaceTmp(SurfNum)%Construction)%Area)>0.1d0) THEN
          CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)//  &
                     '", underground Floor Area = '//TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Area,2)))
          CALL ShowContinueError('..which does not match its construction area.')
        ENDIF
        IF (SurfaceTmp(SurfNum)%Perimeter < Construct(SurfaceTmp(SurfNum)%Construction)%PerimeterExposed - 0.1d0) THEN
          CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)//  &
                     '", underground Floor Perimeter = '//TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Perimeter,2)))
          CALL ShowContinueError('..which is less than its construction exposed perimeter.')
        ENDIF
      ENDIF
    ENDDO  ! Getting Items
  ENDDO
  RETURN
END SUBROUTINE GetRectSurfaces