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