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) | :: | LoopNum | |||
integer, | intent(in) | :: | SchemeNum | |||
integer, | intent(in) | :: | ListNum | |||
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 LoadEquipList(LoopNum,SchemeNum,ListNum,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN July 2010
! MODIFIED B. Griffith Sept 2011, major rewrite
! allow mixing list types across plant types, store info first time
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Load delta range based input into PLANTLOOP data structure
! METHODOLOGY EMPLOYED:
! calls the Input Processor to retrieve data from input file.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, SameString
USE DataIPShortCuts
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! May be set here and passed on
INTEGER, INTENT(IN) :: LoopNum ! May be set here and passed on
INTEGER, INTENT(IN) :: SchemeNum ! May be set here and passed on
INTEGER, INTENT(IN) :: ListNum ! May be set here and passed on
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE.
LOGICAL :: FoundIntendedList
INTEGER :: Num
INTEGER :: MachineNum
INTEGER :: PELists
INTEGER :: CELists
! INTEGER :: NumLists
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: IOSTAT
LOGICAL :: IsNotOK
CHARACTER(len=MaxNameLength) :: CurrentModuleObject
INTEGER, SAVE :: TotNumLists = 0
CHARACTER(len=MaxNameLength), SAVE, DIMENSION(:), ALLOCATABLE :: EquipListsNameList
INTEGER, SAVE, DIMENSION(:), ALLOCATABLE :: EquipListsTypeList
INTEGER, SAVE, DIMENSION(:), ALLOCATABLE :: EquipListsIndexList
INTEGER :: iIndex
LOGICAL :: firstblank
IF (MyOneTimeFlag) THEN
! assemble mapping between list names and indices one time
PELists = GetNumObjectsFound('PlantEquipmentList')
CELists = GetNumObjectsFound('CondenserEquipmentList')
TotNumLists = PELists + CELists
IF (TotNumLists > 0) THEN
ALLOCATE(EquipListsNameList(TotNumLists))
ALLOCATE(EquipListsTypeList(TotNumLists))
ALLOCATE(EquipListsIndexList(TotNumLists))
!First load PlantEquipmentList info
IF (PELists > 0) THEN
CurrentModuleObject = 'PlantEquipmentList'
DO Num = 1,PELists
iIndex = Num
CALL GetObjectItem(CurrentModuleObject,Num,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
EquipListsNameList(iIndex) = cAlphaArgs(1)
EquipListsTypeList(iIndex) = LoopType_Plant
EquipListsIndexList(iIndex) = Num
MachineNum=2
DO WHILE (MachineNum <= NumAlphas)
firstblank=.false.
IF (lAlphaFieldBlanks(MachineNum) .or. lAlphaFieldBlanks(MachineNum+1)) THEN
IF (lAlphaFieldBlanks(MachineNum)) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid component specification.')
CALL ShowContinueError(trim(cAlphaFieldNames(MachineNum))//' is blank.')
firstblank=.true.
ErrorsFound=.true.
ENDIF
IF (lAlphaFieldBlanks(MachineNum+1)) THEN
IF (.not. firstblank) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid component specification.')
ENDIF
CALL ShowContinueError(trim(cAlphaFieldNames(MachineNum+1))//' is blank.')
ErrorsFound=.true.
ENDIF
ELSE
CALL ValidateComponent(cAlphaArgs(MachineNum),cAlphaArgs(MachineNum+1),IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError(TRIM(CurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", Input Error.')
ErrorsFound = .true.
ENDIF
ENDIF
MachineNum=MachineNum+2
ENDDO
ENDDO
ENDIF
IF (CELists > 0) THEN
CurrentModuleObject = 'CondenserEquipmentList'
DO Num = 1,CELists
iIndex = Num + PELists
CALL GetObjectItem(CurrentModuleObject,Num,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
EquipListsNameList(iIndex) = cAlphaArgs(1)
EquipListsTypeList(iIndex) = LoopType_Condenser
EquipListsIndexList(iIndex) = Num
MachineNum=2
DO WHILE (MachineNum <= NumAlphas)
firstblank=.false.
IF (lAlphaFieldBlanks(MachineNum) .or. lAlphaFieldBlanks(MachineNum+1)) THEN
IF (lAlphaFieldBlanks(MachineNum)) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid component specification.')
CALL ShowContinueError(trim(cAlphaFieldNames(MachineNum))//' is blank.')
firstblank=.true.
ErrorsFound=.true.
ENDIF
IF (lAlphaFieldBlanks(MachineNum+1)) THEN
IF (.not. firstblank) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid component specification.')
ENDIF
CALL ShowContinueError(trim(cAlphaFieldNames(MachineNum+1))//' is blank.')
ErrorsFound=.true.
ENDIF
ELSE
CALL ValidateComponent(cAlphaArgs(MachineNum),cAlphaArgs(MachineNum+1),IsNotOK,TRIM(CurrentModuleObject))
IF (IsNotOK) THEN
CALL ShowContinueError(TRIM(CurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", Input Error.')
ErrorsFound = .true.
ENDIF
ENDIF
MachineNum=MachineNum+2
ENDDO
ENDDO
ENDIF
ENDIF
IF (ErrorsFound) THEN
CALL ShowFatalError('LoadEquipList/GetEquipmentLists: Failed due to preceding errors.')
ENDIF
MyOneTimeFlag = .FALSE.
ENDIF
FoundIntendedList = .FALSE.
! find name in set of possible list
DO Num = 1, TotNumLists
IF(SameString(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(ListNum)%name, EquipListsNameList(Num))) THEN
FoundIntendedList = .TRUE.
! get object item for real this time
SELECT CASE (EquipListsTypeList(num))
CASE (LoopType_Plant)
CurrentModuleObject = 'PlantEquipmentList'
CASE (LoopType_Condenser)
CurrentModuleObject = 'CondenserEquipmentList'
END SELECT
CALL GetObjectItem(CurrentModuleObject,EquipListsIndexList(Num),cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(ListNum)%NumComps = (NumAlphas - 1)/2
IF (PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(ListNum)%NumComps .GT. 0) THEN
ALLOCATE (PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(ListNum)%Comp &
(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(ListNum)%NumComps))
DO MachineNum = 1, PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(ListNum)%NumComps
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(ListNum)%Comp(MachineNum)%TypeOf = cAlphaArgs(MachineNum*2)
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(ListNum)%Comp(MachineNum)%Name = cAlphaArgs(MachineNum*2+1)
END DO !MachineList
ENDIF
ENDIF
ENDDO
IF (.NOT. FoundIntendedList) THEN
CALL ShowSevereError('LoadEquipList: Failed to find PlantEquipmentList or CondenserEquipmentList object named = ' &
//TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(ListNum)%name) )
ErrorsFound = .true.
ENDIF
RETURN
END SUBROUTINE LoadEquipList