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.
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 UpdateWaterManager
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN August 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! The water manger is iterating and
! we need to do the timestep record keeping
! for tracking state variables.
! this routine updates variables
! that hold the value of the Last Timestep
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY:BeginEnvrnFlag, InitConvTemp, WarmUpFlag, KickOffSimulation, DoingSizing
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: TankNum
INTEGER :: RainColNum
INTEGER :: WellNum
LOGICAL,SAVE :: MyEnvrnFlag = .TRUE. ! flag for init once at start of environment
LOGICAL,SAVE :: MyWarmupFlag = .False. ! flag for init after warmup complete
LOGICAL,SAVE :: MyTankDemandCheckFlag = .TRUE.
IF (BeginEnvrnFlag .and. MyEnvrnFlag) THEN !
Do TankNum=1, NumWaterStorageTanks
WaterStorage(TankNum)%LastTimeStepVolume = WaterStorage(TankNum)%InitialVolume
WaterStorage(TankNum)%ThisTimeStepVolume = WaterStorage(TankNum)%InitialVolume
ENDDO
IF ((.NOT. DoingSizing) .and. (.NOT. KickOffSimulation) .AND. MyTankDemandCheckFlag) THEN
IF (NumWaterStorageTanks > 0) THEN
DO TankNum=1,NumWaterStorageTanks
IF (WaterStorage(TankNum)%NumWaterDemands == 0) THEN
CALL ShowWarningError('Found WaterUse:Tank that has nothing connected to draw water from it.')
CALL ShowContinueError('Occurs for WaterUse:Tank = '//TRIM(WaterStorage(TankNum)%Name) )
Call ShowContinueError('Check that input for water consuming components specifies a water supply tank.')
ENDIF
ENDDO
ENDIF
MyTankDemandCheckFlag = .FALSE.
ENDIF
MyEnvrnFlag = .FALSE.
MyWarmupFlag = .TRUE.
ENDIF ! end environmental inits
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag=.true.
ENDIF
IF (MyWarmupFlag .AND. (.NOT. WarmUpFlag) ) THEN ! do environment inits. just went out of warmup mode
Do TankNum=1, NumWaterStorageTanks
WaterStorage(TankNum)%LastTimeStepVolume = WaterStorage(TankNum)%InitialVolume
WaterStorage(TankNum)%ThisTimeStepVolume = WaterStorage(TankNum)%InitialVolume
WaterStorage(TankNum)%LastTimeStepTemp = WaterStorage(TankNum)%InitialTankTemp
ENDDO
MyWarmupFlag = .FALSE.
ENDIF
Do TankNum=1, NumWaterStorageTanks
! main location for inits for new timestep.
WaterStorage(TankNum)%LastTimeStepVolume = MAX(WaterStorage(TankNum)%ThisTimeStepVolume, 0.d0)
WaterStorage(TankNum)%MainsDrawVdot = 0.0d0
WaterStorage(TankNum)%MainsDrawVol = 0.0d0
WaterStorage(TankNum)%NetVdot = 0.0d0
WaterStorage(TankNum)%VdotFromTank = 0.0d0
WaterStorage(TankNum)%VdotToTank = 0.0d0
IF (WaterStorage(TankNum)%NumWaterDemands > 0) THEN
WaterStorage(TankNum)%VdotRequestDemand = 0.0d0
WaterStorage(TankNum)%VdotAvailDemand = 0.0d0
ENDIF
WaterStorage(TankNum)%VdotOverflow = 0.0d0
IF (WaterStorage(TankNum)%NumWaterSupplies > 0) THEN
WaterStorage(TankNum)%VdotAvailSupply = 0.0d0
ENDIF
IF ((WaterStorage(TankNum)%ControlSupplyType == WellFloatValve) &
.OR. (WaterStorage(TankNum)%ControlSupplyType == WellFloatMainsBackup)) THEN
If (allocated(GroundWaterWell)) GroundwaterWell(WaterStorage(TankNum)%GroundWellID)%VdotRequest = 0.0d0
ENDIF
ENDDO !tank loop
Do RainColNum=1, NumRainCollectors
RainCollector(RainColNum)%VdotAvail = 0.0d0
RainCollector(RainColNum)%VolCollected = 0.0d0
ENDDO
Do WellNum=1, NumGroundWaterWells
! re init calculated vars
GroundwaterWell(WellNum)%VdotRequest = 0.0d0
GroundwaterWell(WellNum)%VdotDelivered = 0.0d0
GroundwaterWell(WellNum)%VolDelivered = 0.0d0
GroundwaterWell(WellNum)%PumpPower = 0.0d0
GroundwaterWell(WellNum)%PumpEnergy = 0.0d0
ENDDO
RETURN
END SUBROUTINE UpdateWaterManager