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 GetPipingSystemsInput
! SUBROUTINE INFORMATION:
! AUTHOR Edwin Lee
! DATE WRITTEN Summer 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY : GetNumObjectsFound, FindItemInList, SameString
USE DataGlobals, ONLY : MaxNameLength
USE DataInterfaces, ONLY : SetupOutputVariable
USE General, ONLY : TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetPipingSystemsInput'
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
INTEGER :: NumGeneralizedDomains
INTEGER :: PipeCtr
INTEGER :: CircuitCtr
INTEGER :: CircuitIndex
INTEGER :: ThisSegmentIndex
INTEGER :: NumPipeCircuits
INTEGER :: NumPipeSegmentsInInput
INTEGER :: NumCircuitsInThisDomain
INTEGER :: NumHorizontalTrenches
INTEGER :: NumSegmentsInHorizontalTrenches
INTEGER :: DomainNum
INTEGER :: TotalNumDomains
INTEGER :: TotalNumCircuits
INTEGER :: TotalNumSegments
INTEGER :: ThisCircuitPipeSegmentCounter
CHARACTER(len=MaxNameLength) :: ThisSegmentName
INTEGER :: InputPipeSegmentCounter
!Read number of objects and allocate main data structures - first domains
NumGeneralizedDomains=GetNumObjectsFound(ObjName_ug_GeneralDomain)
NumHorizontalTrenches=GetNumObjectsFound(objName_HorizTrench)
TotalNumDomains = NumGeneralizedDomains + NumHorizontalTrenches
ALLOCATE(PipingSystemDomains(TotalNumDomains))
! then circuits
NumPipeCircuits=GetNumObjectsFound(ObjName_Circuit)
TotalNumCircuits = NumPipeCircuits + NumHorizontalTrenches
ALLOCATE(PipingSystemCircuits(TotalNumCircuits))
! then segments
NumPipeSegmentsInInput = GetNumObjectsFound(objName_Segment)
NumSegmentsInHorizontalTrenches = GetNumSegmentsForHorizontalTrenches(NumHorizontalTrenches)
TotalNumSegments = NumPipeSegmentsInInput + NumSegmentsInHorizontalTrenches
ALLOCATE(PipingSystemSegments(TotalNumSegments))
!Read in raw inputs, don't try to interpret dependencies yet
CALL ReadGeneralDomainInputs(1, NumGeneralizedDomains, ErrorsFound)
CALL ReadPipeCircuitInputs(NumPipeCircuits, ErrorsFound)
CALL ReadPipeSegmentInputs(NumPipeSegmentsInInput, ErrorsFound)
CALL ReadHorizontalTrenchInputs(NumGeneralizedDomains+1, NumPipeCircuits+1, NumPipeSegmentsInInput+1, &
NumHorizontalTrenches, ErrorsFound)
!Report errors that are purely input problems
IF (ErrorsFound) CALL ShowFatalError(RoutineName//': Preceding input errors cause program termination.')
!Setup output variables
CALL SetupAllOutputVariables(TotalNumSegments, TotalNumCircuits)
!Validate CIRCUIT-SEGMENT cross references
DO CircuitCtr = LBOUND(PipingSystemCircuits, 1), UBOUND(PipingSystemCircuits, 1)
!validate circuit-segment name-to-index references
DO ThisCircuitPipeSegmentCounter = LBOUND(PipingSystemCircuits(CircuitCtr)%PipeSegmentNames, 1), &
UBOUND(PipingSystemCircuits(CircuitCtr)%PipeSegmentNames, 1)
ThisSegmentName = PipingSystemCircuits(CircuitCtr)%PipeSegmentNames(ThisCircuitPipeSegmentCounter)
ThisSegmentIndex = FindItemInList(ThisSegmentName,PipingSystemSegments%Name,TotalNumSegments)
IF (ThisSegmentIndex > 0) THEN
PipingSystemCircuits(CircuitCtr)%PipeSegmentIndeces(ThisCircuitPipeSegmentCounter) = ThisSegmentIndex
PipingSystemSegments(ThisSegmentIndex)%ParentCircuitIndex = CircuitCtr
ELSE
CALL ShowSevereError(RoutineName//': Could not match a pipe segment for: '// &
TRIM(ObjName_Circuit)//'='//TRIM(PipingSystemCircuits(CircuitCtr)%Name))
CALL ShowContinueError(RoutineName//': Looking for: '//TRIM(objName_Segment)//'='//TRIM(ThisSegmentName))
ErrorsFound = .TRUE.
END IF
END DO !Segment loop
END DO !Circuit loop
!Validate DOMAIN-CIRCUIT cross references
DO DomainNum = 1, TotalNumDomains
!Convenience
NumCircuitsInThisDomain = SIZE(PipingSystemDomains(DomainNum)%CircuitNames)
!validate pipe domain-circuit name-to-index references
DO CircuitCtr = 1, NumCircuitsInThisDomain
CircuitIndex = FindItemInList(PipingSystemDomains(DomainNum)%CircuitNames(CircuitCtr), &
PipingSystemCircuits%Name,SIZE(PipingSystemCircuits))
PipingSystemDomains(DomainNum)%CircuitIndeces(CircuitCtr) = CircuitIndex
PipingSystemCircuits(CircuitIndex)%ParentDomainIndex = DomainNum
END DO
!correct segment locations for: INTERNAL DATA STRUCTURE Y VALUE MEASURED FROM BOTTOM OF DOMAIN,
! INPUT WAS MEASURED FROM GROUND SURFACE
DO CircuitCtr = 1, NumCircuitsInThisDomain
CircuitIndex = PipingSystemDomains(DomainNum)%CircuitIndeces(CircuitCtr)
DO PipeCtr = LBOUND(PipingSystemCircuits(CircuitIndex)%PipeSegmentIndeces, 1), &
UBOUND(PipingSystemCircuits(CircuitIndex)%PipeSegmentIndeces, 1)
ThisSegmentIndex = PipingSystemCircuits(CircuitCtr)%PipeSegmentIndeces(PipeCtr)
PipingSystemSegments(ThisSegmentIndex)%PipeLocation%Y = &
PipingSystemDomains(DomainNum)%Extents%Ymax - PipingSystemSegments(ThisSegmentIndex)%PipeLocation%Y
END DO !segment loop
END DO !circuit loop
!correct segment locations for: BASEMENT X SHIFT
IF (PipingSystemDomains(DomainNum)%HasBasement .AND. PipingSystemDomains(DomainNum)%BasementZone%ShiftPipesByWidth) THEN
DO CircuitCtr = 1, NumCircuitsInThisDomain
CircuitIndex = PipingSystemDomains(DomainNum)%CircuitIndeces(CircuitCtr)
DO PipeCtr = LBOUND(PipingSystemCircuits(CircuitIndex)%PipeSegmentIndeces, 1), &
UBOUND(PipingSystemCircuits(CircuitIndex)%PipeSegmentIndeces, 1)
ThisSegmentIndex = PipingSystemCircuits(CircuitCtr)%PipeSegmentIndeces(PipeCtr)
PipingSystemSegments(ThisSegmentIndex)%PipeLocation%X = &
PipingSystemDomains(DomainNum)%BasementZone%Width + PipingSystemSegments(ThisSegmentIndex)%PipeLocation%X
END DO !segment loop
END DO !circuit loop
END IF
!now we will have good values of pipe segment locations, we can validate them
DO CircuitCtr = 1, NumCircuitsInThisDomain
!retrieve the index
CircuitIndex = PipingSystemDomains(DomainNum)%CircuitIndeces(CircuitCtr)
!check to make sure it isn't outside the domain
DO PipeCtr = LBOUND(PipingSystemCircuits(CircuitIndex)%PipeSegmentIndeces, 1), &
UBOUND(PipingSystemCircuits(CircuitIndex)%PipeSegmentIndeces, 1)
ThisSegmentIndex = PipingSystemCircuits(CircuitCtr)%PipeSegmentIndeces(PipeCtr)
IF ((PipingSystemSegments(ThisSegmentIndex)%PipeLocation%X > PipingSystemDomains(DomainNum)%Extents%Xmax) .OR. &
(PipingSystemSegments(ThisSegmentIndex)%PipeLocation%X < 0.0d0) .OR. &
(PipingSystemSegments(ThisSegmentIndex)%PipeLocation%Y > PipingSystemDomains(DomainNum)%Extents%Ymax) .OR. &
(PipingSystemSegments(ThisSegmentIndex)%PipeLocation%Y < 0.0d0)) THEN
CALL ShowSevereError('PipingSystems::'//RoutineName//':A pipe was found to be outside of the domain extents'//&
' after performing any corrections for basement or burial depth.')
CALL ShowContinueError('Pipe segment name:'//TRIM(PipingSystemSegments(ThisSegmentIndex)%Name))
CALL ShowContinueError('Corrected pipe location: (x,y)=('// &
TrimSigDigits(PipingSystemSegments(ThisSegmentIndex)%PipeLocation%X,2)//','// &
TrimSigDigits(PipingSystemSegments(ThisSegmentIndex)%PipeLocation%Y,2)//')')
END IF
END DO !segment loop
END DO !circuit loop
END DO !domain loop
!If we encountered any other errors that we couldn't handle separately than stop now
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//':'//ObjName_ug_GeneralDomain//': Errors found in input.')
ENDIF
RETURN
END SUBROUTINE GetPipingSystemsInput