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 | ||
|---|---|---|---|---|---|---|
| integer, | intent(in) | :: | ZoneNum | |||
| 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 SetupMundtModel(ZoneNum,ErrorsFound)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Brent Griffith
          !       DATE WRITTEN   Febraury 2002
          !       RE-ENGINEERED  June 2003, EnergyPlus Implementation (CC)
          !       MODIFIED       February 2004, fix allocate-deallocate problem (CC)
          ! PURPOSE OF THIS SUBROUTINE:
          !   Subroutine must be called once before main model calculation
          !   need to pass some zone characteristics only once
          !   initializes module level variables, collect info from Air Data Manager
          ! METHODOLOGY EMPLOYED:
          ! na
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
    USE DataRoomAirModel
    USE DataHeatBalance,            ONLY : Zone
    IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
    INTEGER, INTENT(IN)                 :: ZoneNum          ! index number for the specified zone
    LOGICAL, INTENT(INOUT)              :: ErrorsFound      ! true if problems setting up model
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na
          ! DERIVED TYPE DEFINITIONS:
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
    INTEGER                             :: NodeNum          ! index for air nodes
    INTEGER                             :: SurfNum          ! index for surfaces
          ! FLOW:
    ! set up air node ID
    NumRoomNodes    = 0
    DO NodeNum = 1, TotNumOfZoneAirNodes(ZoneNum)
        SELECT CASE (LineNode(MundtZoneNum,NodeNum)%ClassType)
            CASE (InletAirNode) !inlet
                SupplyNodeID  = NodeNum
            CASE (FloorAirNode) ! floor
                MundtFootAirID = NodeNum
            CASE (ControlAirNode) ! thermostat
                TstatNodeID = NodeNum
            CASE (CeilingAirNode) ! ceiling
                MundtCeilAirID = NodeNum
            CASE (MundtRoomAirNode) ! wall
                NumRoomNodes = NumRoomNodes + 1
                RoomNodeIDS(NumRoomNodes) = NodeNum
            CASE (ReturnAirNode) ! return
                ReturnNodeID = NodeNum
            CASE DEFAULT
                CALL ShowSevereError('SetupMundtModel: Non-Standard Type of Air Node for Mundt Model')
                ErrorsFound=.true.
        END SELECT
    END DO
    !  get number of floors in the zone and setup FloorSurfSetIDs
    IF (MundtFootAirID > 0) THEN
      NumFloorSurfs = COUNT(LineNode(MundtZoneNum,MundtFootAirID)%SurfMask)
      FloorSurfSetIDs = PACK(ID1dsurf,LineNode(MundtZoneNum,MundtFootAirID)%SurfMask)
      ! initialize floor surface data (a must since NumFloorSurfs is varied among zones)
      FloorSurf%Temp = 25.0d0
      FloorSurf%Hc   = 0.0d0
      FloorSurf%Area = 0.0d0
      ! get floor surface data
      DO SurfNum = 1, NumFloorSurfs
        FloorSurf(SurfNum)%Temp = MundtAirSurf(MundtZoneNum,FloorSurfSetIDs(SurfNum))%Temp
        FloorSurf(SurfNum)%Hc   = MundtAirSurf(MundtZoneNum,FloorSurfSetIDs(SurfNum))%Hc
        FloorSurf(SurfNum)%Area = MundtAirSurf(MundtZoneNum,FloorSurfSetIDs(SurfNum))%Area
      ENDDO
    ELSE
      CALL ShowSevereError('SetupMundtModel: Mundt model has no FloorAirNode, Zone='//  &
          Trim(Zone(ZoneNum)%Name))
      ErrorsFound=.true.
    ENDIF
    RETURN
END SUBROUTINE SetupMundtModel