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 GetSolarCollectorInput
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Peter Graham Ellis
          !       DATE WRITTEN   December 2003
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! Gets the solar collector input from the input file and sets up the parameters and collector objects.
          ! METHODOLOGY EMPLOYED:
          ! Standard EnergyPlus methodology.
          ! USE STATEMENTS:
  USE DataGlobals, ONLY: DegToRadians, InitConvTemp
  USE DataHeatBalance
  USE InputProcessor, ONLY: GetNumObjectsFound, FindItemInList, GetObjectItem, VerifyName, GetObjectDefMaxArgs, &
                            SameString
  USE DataIPShortCuts  ! Data for field names, blank numerics
  USE NodeInputManager, ONLY: GetOnlySingleNode
  USE BranchNodeConnections, ONLY: TestCompSet
  USE Psychrometrics, ONLY: RhoH2O
  USE DataLoopNode
  USE DataPlant   !DSU
  USE General, ONLY: RoundSigDigits
  USE DataSurfaces,     ONLY: Surface, OSCM, TotOSCM, TotSurfaces, OtherSideCondModeledExt
  IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  LOGICAL                        :: ErrorsFound = .FALSE. ! Set to true if errors in input, fatal at end of routine
  INTEGER                        :: IOStatus              ! Used in GetObjectItem
  LOGICAL                        :: IsBlank               ! TRUE if the name is blank
  LOGICAL                        :: IsNotOk               ! TRUE if there was a problem with a list name
  INTEGER                        :: NumAlphas             ! Number of Alphas for each GetObjectItem call
  INTEGER                        :: NumNumbers            ! Number of Numbers for each GetObjectItem call
  INTEGER                        :: CollectorNum          ! Solar collector object number
  INTEGER                        :: CollectorNum2         ! Second solar collector object number for looping
  INTEGER                        :: ParametersNum         ! Solar collector parameters object number
  INTEGER                        :: SurfNum               ! Collector surface object number
  CHARACTER(len=MaxNameLength)   :: CurrentModuleObject   ! for ease in renaming.
  CHARACTER(len=MaxNameLength)   :: CurrentModuleParamObject   ! for ease in renaming.
  INTEGER :: NumFields                  ! Total number of fields in object
  INTEGER :: MaxAlphas                  ! Maximum number of alpha fields in all objects
  INTEGER :: MaxNumbers                 ! Maximum number of numeric fields in all objects
  INTEGER :: NumOfICSParam=0            ! number of parameter objects for ICS colectors
  INTEGER :: NumOfICSUnits=0            ! number of ICS colector units
  INTEGER :: NumOfFlatPlateParam=0      ! number of parameter objects for flat plate colectors
  INTEGER :: NumFlatPlateUnits=0        ! number of plat plate solar colector units
  INTEGER :: FlatPlateParamNum          ! plat plate solar colector parameters counter
  INTEGER :: ICSParamNum                ! ICS collector parameters counter
  INTEGER :: FlatPlateUnitsNum          ! plat plate solar colector parameters counter
  INTEGER :: ICSUnitsNum                ! ICS collector parameters counter
  INTEGER :: Found                      ! index
  INTEGER :: VentCavIndex               ! vent cavity index
  REAL(r64)         :: Perimeter        ! perimeter of the absorber or collector
  REAL(r64), ALLOCATABLE, DIMENSION(:)                    :: Numbers        ! Numeric data
  CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: Alphas         ! Alpha data
  CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields   ! Alpha field names
  CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
  LOGICAL, ALLOCATABLE, DIMENSION(:)   :: lAlphaBlanks      ! Logical array, alpha field input BLANK = .TRUE.
  LOGICAL, ALLOCATABLE, DIMENSION(:)   :: lNumericBlanks    ! Logical array, numeric field input BLANK = .TRUE.
          ! FLOW:
  MaxNumbers=0
  MaxAlphas=0
  CurrentModuleParamObject = 'SolarCollectorPerformance:FlatPlate'
  NumOfFlatPlateParam = GetNumObjectsFound(CurrentModuleParamObject)
  CALL GetObjectDefMaxArgs(TRIM(CurrentModuleParamObject),NumFields,NumAlphas,NumNumbers)
  MaxNumbers=MAX(MaxNumbers,NumNumbers)
  MaxAlphas=MAX(MaxAlphas,NumAlphas)
  CurrentModuleObject = 'SolarCollector:FlatPlate:Water'
  NumFlatPlateUnits = GetNumObjectsFound(CurrentModuleObject)
  CALL GetObjectDefMaxArgs(CurrentModuleObject,NumFields,NumAlphas,NumNumbers)
  MaxNumbers=MAX(MaxNumbers,NumNumbers)
  MaxAlphas=MAX(MaxAlphas,NumAlphas)
  CurrentModuleParamObject = 'SolarCollectorPerformance:IntegralCollectorStorage'
  NumOfICSParam = GetNumObjectsFound(CurrentModuleParamObject)
  CALL GetObjectDefMaxArgs(TRIM(CurrentModuleParamObject),NumFields,NumAlphas,NumNumbers)
  MaxNumbers=MAX(MaxNumbers,NumNumbers)
  MaxAlphas=MAX(MaxAlphas,NumAlphas)
  CurrentModuleObject = 'SolarCollector:IntegralCollectorStorage'
  NumOfICSUnits = GetNumObjectsFound(CurrentModuleObject)
  CALL GetObjectDefMaxArgs(CurrentModuleObject,NumFields,NumAlphas,NumNumbers)
  MaxNumbers=MAX(MaxNumbers,NumNumbers)
  MaxAlphas=MAX(MaxAlphas,NumAlphas)
  ALLOCATE(Alphas(MaxAlphas))
  Alphas=' '
  ALLOCATE(Numbers(MaxNumbers))
  Numbers=0.0d0
  ALLOCATE(cAlphaFields(MaxAlphas))
  cAlphaFields=' '
  ALLOCATE(cNumericFields(MaxNumbers))
  cNumericFields=' '
  ALLOCATE(lAlphaBlanks(MaxAlphas))
  lAlphaBlanks=.TRUE.
  ALLOCATE(lNumericBlanks(MaxNumbers))
  lNumericBlanks=.TRUE.
  NumOfCollectors = NumFlatPlateUnits + NumOfICSUnits
  NumOfParameters = NumOfFlatPlateParam + NumOfICSParam
  IF (NumOfParameters > 0) THEN
    ALLOCATE(Parameters(NumOfParameters))
    CurrentModuleParamObject = 'SolarCollectorPerformance:FlatPlate'
    DO FlatPlateParamNum = 1, NumOfFlatPlateParam
      ParametersNum = FlatPlateParamNum
      CALL GetObjectItem(CurrentModuleParamObject, &
        ParametersNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus,     &
        NumBlank=lNumericFieldBlanks,AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
      ! Collector module parameters name
      IsNotOK = .FALSE.
      IsBlank = .FALSE.
      CALL VerifyName(cAlphaArgs(1),Parameters%Name,ParametersNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleParamObject))
      IF (IsNotOK) THEN
        ErrorsFound = .TRUE.
        IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
      END IF
      Parameters(ParametersNum)%Name = cAlphaArgs(1)
      ! NOTE:  This values serves mainly as a reference.  The area of the associated surface object is used in all calculations.
      Parameters(ParametersNum)%Area = rNumericArgs(1)
      SELECT CASE(TRIM(cAlphaArgs(2)))
        CASE('WATER')
          Parameters(ParametersNum)%TestFluid = WATER
        !CASE('AIR')
        !  Parameters(ParametersNum)%TestFluid = AIR
        CASE DEFAULT
          CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1))// &
            ':  '//TRIM(cAlphaArgs(2))//' is an unsupported Test Fluid for '//TRIM(cAlphaFieldNames(2)))
          ErrorsFound = .TRUE.
      END SELECT
      IF (rNumericArgs(2) > 0.0d0) THEN
        Parameters(ParametersNum)%TestMassFlowRate = rNumericArgs(2) * RhoH2O(InitConvTemp)
      ELSE
        CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1))// &
          ':  flow rate must be greater than zero for ' //TRIM(cNumericFieldNames(2)) )
        ErrorsFound = .TRUE.
      END IF
      SELECT CASE(TRIM(cAlphaArgs(3)))
        CASE('INLET')
          Parameters(ParametersNum)%TestType = INLET
        CASE('AVERAGE')
          Parameters(ParametersNum)%TestType = AVERAGE
        CASE('OUTLET')
          Parameters(ParametersNum)%TestType = OUTLET
        CASE DEFAULT
          CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1))// &
            ':  '//TRIM(cAlphaArgs(3))//' is  not supported for '//TRIM(cAlphaFieldNames(3)))
          ErrorsFound = .TRUE.
      END SELECT
      ! Efficiency equation coefficients
      Parameters(ParametersNum)%eff0 = rNumericArgs(3)
      Parameters(ParametersNum)%eff1 = rNumericArgs(4)
      IF (NumNumbers > 4) THEN
        Parameters(ParametersNum)%eff2 = rNumericArgs(5)
      ELSE
        Parameters(ParametersNum)%eff2 = 0.0d0
      END IF
      ! Incident angle modifier coefficients
      IF (NumNumbers > 5) THEN
        Parameters(ParametersNum)%iam1 = rNumericArgs(6)
      ELSE
        Parameters(ParametersNum)%iam1 = 0.0d0
      END IF
      IF (NumNumbers > 6) THEN
        Parameters(FlatPlateParamNum)%iam2 = rNumericArgs(7)
      ELSE
        Parameters(ParametersNum)%iam2 = 0.0d0
      END IF
    END DO ! ParametersNum
    IF (ErrorsFound) CALL ShowFatalError('Errors in '//TRIM(CurrentModuleParamObject)//' input.')
  END IF
  IF (NumOfCollectors > 0) THEN
    ALLOCATE(Collector(NumOfCollectors))
    CurrentModuleObject = 'SolarCollector:FlatPlate:Water'
    DO FlatPlateUnitsNum = 1, NumFlatPlateUnits
      CollectorNum = FlatPlateUnitsNum
      CALL GetObjectItem(CurrentModuleObject,CollectorNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus)
      ! Collector name
      IsNotOK = .FALSE.
      IsBlank = .FALSE.
      CALL VerifyName(cAlphaArgs(1),Collector%Name,CollectorNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject))
      IF (IsNotOK) THEN
        ErrorsFound = .TRUE.
        IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
      END IF
      Collector(CollectorNum)%Name = cAlphaArgs(1)
      Collector(CollectorNum)%TypeNum = TypeOf_SolarCollectorFlatPlate ! parameter assigned in DataPlant !DSU
      ! Get parameters object
      ParametersNum = FindItemInList(cAlphaArgs(2),Parameters%Name,NumOfParameters)
      IF (ParametersNum == 0) THEN
        CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
          ': '//Trim(CurrentModuleParamObject)//' object called '//TRIM(cAlphaArgs(2))//' not found.')
        ErrorsFound = .TRUE.
      ELSE
        Collector(CollectorNum)%Parameters = ParametersNum
      END IF
      ! Get surface object
      SurfNum = FindItemInList(cAlphaArgs(3),Surface%Name,TotSurfaces)
      IF (SurfNum == 0) THEN
        CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
          ':  Surface '//TRIM(cAlphaArgs(3))//' not found.')
        ErrorsFound = .TRUE.
        CYCLE ! avoid hard crash
      ELSE
        IF (.NOT. Surface(SurfNum)%ExtSolar) THEN
          CALL ShowWarningError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
            ':  Surface '//TRIM(cAlphaArgs(3))//' is not exposed to exterior radiation.')
        END IF
        ! check surface orientation, warn if upside down
        IF (( Surface(SurfNum)%Tilt < -95.0D0 ) .OR. (Surface(SurfNum)%Tilt > 95.0D0)) THEN
          CALL ShowWarningError('Suspected input problem with '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
          CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
          CALL ShowContinueError( 'Surface used for solar collector faces down')
          CALL ShowContinueError('Surface tilt angle (degrees from ground outward normal) = ' &
                                   //TRIM(RoundSigDigits(Surface(SurfNum)%Tilt,2) ) )
        ENDIF
        ! Check to make sure other solar collectors are not using the same surface
        ! NOTE:  Must search over all solar collector types
        DO CollectorNum2 = 1, NumFlatPlateUnits
          IF (Collector(CollectorNum2)%Surface == SurfNum) THEN
            CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
              ':  Surface '//TRIM(cAlphaArgs(3))//' is referenced by more than one '//TRIM(CurrentModuleObject))
            ErrorsFound = .TRUE.
            EXIT
          END IF
        END DO ! CollectorNum2
        Collector(CollectorNum)%Surface = SurfNum
      END IF
      ! Give warning if surface area and gross area do not match within tolerance
      IF (SurfNum > 0 .AND. ParametersNum > 0 .AND. Parameters(ParametersNum)%Area > 0.0d0 &
        .AND. ABS(Parameters(ParametersNum)%Area - Surface(SurfNum)%Area)/Surface(SurfNum)%Area > 0.01d0) THEN
        CALL ShowWarningError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
          ':  Gross Area of solar collector parameters and surface object differ by more than 1%.')
        CALL ShowContinueError('Area of surface object will be used in all calculations.')
      END IF
      Collector(CollectorNum)%InletNode = GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(CurrentModuleObject),cAlphaArgs(1), &
               NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
      Collector(CollectorNum)%OutletNode = GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(CurrentModuleObject),cAlphaArgs(1), &
               NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
      IF (NumNumbers > 0) THEN
        Collector(CollectorNum)%VolFlowRateMax = rNumericArgs(1)  ! Max volumetric flow rate used for plant sizing calculation
      ELSE
        Collector(CollectorNum)%VolFlowRateMax = 0.0d0  ! Max vol flow rate is not specified; no flow for plant sizing calculation
        Collector(CollectorNum)%MassFlowRateMax = 999999.9d0  ! But...set a very high value so that it demands as much as possible
      END IF
      ! Setup report variables
      CALL SetupOutputVariable('Solar Collector Incident Angle Modifier []', Collector(CollectorNum)%IncidentAngleModifier, &
                               'System','Average',Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Efficiency []', Collector(CollectorNum)%Efficiency, &
                               'System','Average',Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Heat Transfer Rate [W]', Collector(CollectorNum)%Power, &
                               'System','Average',Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Heat Gain Rate [W]', Collector(CollectorNum)%HeatGain, &
                               'System','Average',Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Heat Loss Rate [W]', Collector(CollectorNum)%HeatLoss, &
                               'System','Average',Collector(FlatPlateUnitsNum)%Name)
      CALL SetupOutputVariable('Solar Collector Heat Transfer Energy [J]', Collector(CollectorNum)%Energy, &
                               'System','Sum',Collector(FlatPlateUnitsNum)%Name, &
                               ResourceTypeKey='SolarWater',EndUseKey='HeatProduced',GroupKey='Plant')
      CALL TestCompSet(TRIM(CurrentModuleObject),cAlphaArgs(1),cAlphaArgs(4),cAlphaArgs(5),'Water Nodes')
    END DO ! FlatPlateUnitsNum
    ! Get data for ICS collector
    CurrentModuleParamObject = 'SolarCollectorPerformance:IntegralCollectorStorage'
    DO ICSParamNum = 1, NumOfICSParam
      ParametersNum = ICSParamNum + NumOfFlatPlateParam
      CALL GetObjectItem(CurrentModuleParamObject, &
        ICSParamNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus,     &
        NumBlank=lNumericFieldBlanks,AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
      ! Collector module parameters name
      IsNotOK = .FALSE.
      IsBlank = .FALSE.
      CALL VerifyName(cAlphaArgs(1),Parameters%Name,ParametersNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleParamObject))
      IF (IsNotOK) THEN
        ErrorsFound = .TRUE.
        IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
      END IF
      Parameters(ParametersNum)%Name = cAlphaArgs(1)
      ! NOTE:  currently the only available choice is RectangularTank.  In the future progressive tube type will be
      !        added
      IF (SameString(cAlphaArgs(2), 'RectangularTank')) THEN
         Parameters(ParametersNum)%ICSType_Num = ICSRectangularTank
      ELSE
         CALL ShowSevereError(TRIM(cAlphaFieldNames(2))//' not found='//TRIM(cAlphaArgs(2))// &
              ' in '//TRIM(CurrentModuleParamObject)//' ='//TRIM(Parameters(ParametersNum)%Name))
         ErrorsFound=.true.
      ENDIF
      ! NOTE:  This collector gross area is used in all the calculations.
      Parameters(ParametersNum)%Area = rNumericArgs(1)
      IF ( rNumericArgs(1) <= 0.0d0 ) THEN
          CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1)))
          CALL ShowContinueError('Illegal '//TRIM(cNumericFieldNames(1))//' = '//TRIM(RoundSigDigits(rNumericArgs(1),2)))
          CALL ShowContinueError(' Collector gross area must be always gretaer than zero.')
          ErrorsFound=.TRUE.
      ENDIF
      Parameters(ParametersNum)%Volume = rNumericArgs(2)
      IF ( rNumericArgs(2) <= 0.0d0 ) THEN
          CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1)))
          CALL ShowContinueError('Illegal '//TRIM(cNumericFieldNames(2))//' = '//TRIM(RoundSigDigits(rNumericArgs(2),2)))
          CALL ShowContinueError(' Collector water volume must be always gretaer than zero.')
          ErrorsFound=.TRUE.
      ENDIF
      !
      ! Note: this value is used to calculate the heat loss through the bottom and side of the collector
      !Parameters(ParametersNum)%ULoss = rNumericArgs(3)
      Parameters(ParametersNum)%ULossBottom = rNumericArgs(3)
      Parameters(ParametersNum)%ULossSide = rNumericArgs(4)
      Parameters(ParametersNum)%AspectRatio = rNumericArgs(5)
      Parameters(ParametersNum)%SideHeight = rNumericArgs(6)
      Parameters(ParametersNum)%ThermalMass = rNumericArgs(7)
      Parameters(ParametersNum)%NumOfCovers = rNumericArgs(8)
      Parameters(ParametersNum)%CoverSpacing = rNumericArgs(9)
      IF (Parameters(ParametersNum)%NumOfCovers == 2)THEN
          ! Outer cover refractive index
          Parameters(ParametersNum)%RefractiveIndex(1) = rNumericArgs(10)
          ! Outer cover extinction coefficient times thickness of the cover
          Parameters(ParametersNum)%ExtCoefTimesThickness(1) = rNumericArgs(11)
          ! Outer cover Emissivity
          Parameters(ParametersNum)%EmissOfCover(1) = rNumericArgs(12)
         IF (.NOT. lNumericFieldBlanks(13) .OR. .NOT. lNumericFieldBlanks(14) .OR. .NOT. lNumericFieldBlanks(15))THEN
            Parameters(ParametersNum)%RefractiveIndex(2) = rNumericArgs(13)
            Parameters(ParametersNum)%ExtCoefTimesThickness(2) = rNumericArgs(14)
            Parameters(ParametersNum)%EmissOfCover(2) = rNumericArgs(15)
         ELSE
          CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1)))
          CALL ShowContinueError('Illegal input for one of the three inputs of the inner cover optical properties')
          ErrorsFound=.TRUE.
         ENDIF
      ELSEIF (Parameters(ParametersNum)%NumOfCovers == 1)THEN
          ! Outer cover refractive index
          Parameters(ParametersNum)%RefractiveIndex(1) = rNumericArgs(10)
          ! Outer cover extinction coefficient times thickness of the cover
          Parameters(ParametersNum)%ExtCoefTimesThickness(1) = rNumericArgs(11)
          ! Outer cover emissivity
          Parameters(ParametersNum)%EmissOfCover(1) = rNumericArgs(12)
      ELSE
          CALL ShowSevereError(TRIM(CurrentModuleParamObject)//' = '//TRIM(cAlphaArgs(1)))
          CALL ShowContinueError('Illegal '//TRIM(cNumericFieldNames(8))//' = '//TRIM(RoundSigDigits(rNumericArgs(8),2)))
          ErrorsFound=.TRUE.
      ENDIF
      !
      ! Solar absorptance of the absorber plate
      Parameters(ParametersNum)%AbsorOfAbsPlate = rNumericArgs(16)
      !
      ! thermal emmissivity of the absorber plate
      Parameters(ParametersNum)%EmissOfAbsPlate = rNumericArgs(17)
    END DO ! end of ParametersNum
    IF (ErrorsFound) CALL ShowFatalError('Errors in '//TRIM(CurrentModuleParamObject)//' input.')
    CurrentModuleObject = 'SolarCollector:IntegralCollectorStorage'
    DO ICSUnitsNum = 1, NumOfICSUnits
      CollectorNum = ICSUnitsNum + NumFlatPlateUnits
      CALL GetObjectItem(CurrentModuleObject, &
                         ICSUnitsNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus,  &
                         NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaBlanks, &
                         AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
      ! Collector name
      IsNotOK = .FALSE.
      IsBlank = .FALSE.
      CALL VerifyName(cAlphaArgs(1),Collector%Name,CollectorNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject))
      IF (IsNotOK) THEN
        ErrorsFound = .TRUE.
        IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
      END IF
      Collector(CollectorNum)%Name = cAlphaArgs(1)
      Collector(CollectorNum)%TypeNum = TypeOf_SolarCollectorICS ! parameter assigned in DataPlant
      Collector(CollectorNum)%InitICS = .TRUE.
      ! Get parameters object
      ParametersNum = FindItemInList(cAlphaArgs(2),Parameters%Name,NumOfParameters)
      IF (ParametersNum == 0) THEN
        CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
          ': '//Trim(CurrentModuleParamObject)//' object called '//TRIM(cAlphaArgs(2))//' not found.')
        ErrorsFound = .TRUE.
      ELSE
        Collector(CollectorNum)%Parameters = ParametersNum
      END IF
      IF (ParametersNum > 0) THEN
         ! Calculate constant collector parameters only once
          Perimeter = 2.0d0 * SQRT(Parameters(ParametersNum)%Area) &
                    * (SQRT(Parameters(ParametersNum)%AspectRatio) + 1.d0/SQRT(Parameters(ParametersNum)%AspectRatio))
          Collector(CollectorNum)%Length = SQRT(Parameters(ParametersNum)%Area/Parameters(ParametersNum)%AspectRatio)
         ! calculate the collector side heat transfer area and loss coefficient
          Collector(CollectorNum)%ICSType_Num = Parameters(ParametersNum)%ICSType_Num
          Collector(CollectorNum)%Area = Parameters(ParametersNum)%Area
          Collector(CollectorNum)%Volume = Parameters(ParametersNum)%Volume
          Collector(CollectorNum)%SideArea = Perimeter * Parameters(ParametersNum)%SideHeight
          Collector(CollectorNum)%AreaRatio = Collector(CollectorNum)%SideArea / Collector(CollectorNum)%Area
      ENDIF
      ! Get surface object
      SurfNum = FindItemInList(cAlphaArgs(3),Surface%Name,TotSurfaces)
      IF (SurfNum == 0) THEN
        CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
          ':  Surface '//TRIM(cAlphaArgs(3))//' not found.')
        ErrorsFound = .TRUE.
        CYCLE ! avoid hard crash
      ELSE
        IF (.NOT. Surface(SurfNum)%ExtSolar) THEN
          CALL ShowWarningError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
            ':  Surface '//TRIM(cAlphaArgs(3))//' is not exposed to exterior radiation.')
        END IF
        ! check surface orientation, warn if upside down
        IF (( Surface(SurfNum)%Tilt < -95.0D0 ) .OR. (Surface(SurfNum)%Tilt > 95.0D0)) THEN
          CALL ShowWarningError('Suspected input problem with '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
          CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
          CALL ShowContinueError( 'Surface used for solar collector faces down')
          CALL ShowContinueError('Surface tilt angle (degrees from ground outward normal) = ' &
                                   //TRIM(RoundSigDigits(Surface(SurfNum)%Tilt,2) ) )
        ENDIF
        ! Check to make sure other solar collectors are not using the same surface
        ! NOTE:  Must search over all solar collector types
        DO CollectorNum2 = 1, NumOfCollectors
          IF (Collector(CollectorNum2)%Surface == SurfNum) THEN
            CALL ShowSevereError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
              ':  Surface '//TRIM(cAlphaArgs(3))//' is referenced by more than one '//TRIM(CurrentModuleObject))
            ErrorsFound = .TRUE.
            EXIT
          END IF
        END DO ! ICSNum2
        Collector(CollectorNum)%Surface = SurfNum
      END IF
      ! Give warning if surface area and gross area do not match within tolerance
      IF (SurfNum > 0 .AND. ParametersNum > 0 .AND. Parameters(ParametersNum)%Area > 0.0d0 &
        .AND. ABS(Parameters(ParametersNum)%Area - Surface(SurfNum)%Area)/Surface(SurfNum)%Area > 0.01d0) THEN
        CALL ShowWarningError(TRIM(CurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))//': ')
        CALL ShowContinueError('Gross area of solar collector parameters and surface object differ by more than 1%.')
        CALL ShowContinueError('Gross collector area is always used in the calculation.  Modify the surface ')
        CALL ShowContinueError('coordinates to match its area with collector gross area. Otherwise, the underlying ')
        CALL ShowContinueError('surface is assumed to be fully shaded when it is not.')
      END IF
      Collector(CollectorNum)%BCType = cAlphaArgs(4)
      IF (SameString(cAlphaArgs(4), 'AmbientAir')) THEN
         Collector(CollectorNum)%OSCMName = ' '
      ELSEIF (SameString(cAlphaArgs(4), 'OtherSideConditionsModel')) THEN
         Collector(CollectorNum)%OSCMName = cAlphaArgs(5)
         Collector(CollectorNum)%OSCM_ON = .TRUE.
         Found = FindItemInList(Collector(CollectorNum)%OSCMName,OSCM%Name,TotOSCM)
         IF (Found == 0) THEN
             CALL ShowSevereError(TRIM(cAlphaFieldNames(5))//' not found='//TRIM(Collector(CollectorNum)%OSCMName)// &
                  ' in '//TRIM(CurrentModuleObject)//' ='//TRIM(Collector(CollectorNum)%Name))
             ErrorsFound=.true.
         ENDIF
         !Collector(CollectorNum)%OSCMPtr = Found
         !Surface(SurfNum)%IsICS = .true.
      ELSE
         CALL ShowSevereError(TRIM(cAlphaFieldNames(5))//' not found='//TRIM(Collector(CollectorNum)%BCType)// &
              ' in '//TRIM(CurrentModuleObject)//' ='//TRIM(Collector(CollectorNum)%Name))
         ErrorsFound=.true.
      ENDIF
      IF ( Collector(CollectorNum)%OSCM_ON ) THEN
         ! get index of ventilated cavity object
         CALL GetExtVentedCavityIndex(SurfNum, VentCavIndex)
         Collector(CollectorNum)%VentCavIndex = VentCavIndex
      ENDIF
      Collector(CollectorNum)%InletNode = GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(CurrentModuleObject),cAlphaArgs(1), &
               NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
      Collector(CollectorNum)%OutletNode = GetOnlySingleNode(cAlphaArgs(7),ErrorsFound,TRIM(CurrentModuleObject),cAlphaArgs(1), &
               NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
      IF (NumNumbers > 0) THEN
        Collector(CollectorNum)%VolFlowRateMax = rNumericArgs(1)  ! Max volumetric flow rate used for plant sizing calculation
      ELSE
        Collector(CollectorNum)%VolFlowRateMax = 0.0d0  ! Max vol flow rate is not specified; no flow for plant sizing calculation
        Collector(CollectorNum)%MassFlowRateMax = 999999.9d0  ! But...set a very high value so that it demands as much as possible
      END IF
      ! Setup report variables
      CALL SetupOutputVariable('Solar Collector Transmittance Absorptance Product []', &
                                Collector(CollectorNum)%TauAlpha, 'System','Average', &
                                Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Overall Top Heat Loss Coefficient [W/m2-C]', &
                                Collector(CollectorNum)%UTopLoss,'System','Average', &
                                Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Absorber Plate Temperature [C]', &
                                Collector(CollectorNum)%TempOfAbsPlate, 'System','Average', &
                                Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Storage Water Temperature [C]', &
                                Collector(CollectorNum)%TempOfWater, 'System','Average', &
                                Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Thermal Efficiency []', &
                                Collector(CollectorNum)%Efficiency, 'System','Average', &
                                Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Storage Heat Transfer Rate [W]', &
                                Collector(CollectorNum)%StoredHeatRate, 'System','Average', &
                                Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Storage Heat Transfer Energy [J]', &
                                Collector(CollectorNum)%StoredHeatEnergy, 'System','Sum', &
                                Collector(CollectorNum)%Name,ResourceTypeKey='SolarWater', &
                                EndUseKey='HeatProduced',GroupKey='Plant')
      CALL SetupOutputVariable('Solar Collector Skin Heat Transfer Rate [W]', &
                                Collector(CollectorNum)%SkinHeatLossRate, &
                               'System','Average',Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Skin Heat Transfer Energy [J]', &
                                Collector(CollectorNum)%CollHeatLossEnergy,'System','Sum', &
                                Collector(CollectorNum)%Name,ResourceTypeKey='SolarWater', &
                                EndUseKey='HeatProduced',GroupKey='Plant')
      CALL SetupOutputVariable('Solar Collector Heat Transfer Rate [W]', &
                                Collector(CollectorNum)%HeatRate, 'System','Average', &
                                Collector(CollectorNum)%Name)
      CALL SetupOutputVariable('Solar Collector Heat Transfer Energy [J]', &
                                Collector(CollectorNum)%HeatEnergy,'System','Sum', &
                                Collector(CollectorNum)%Name, ResourceTypeKey='SolarWater', &
                                EndUseKey='HeatProduced',GroupKey='Plant')
     CALL TestCompSet(TRIM(CurrentModuleObject),cAlphaArgs(1),cAlphaArgs(6),cAlphaArgs(7),'Water Nodes')
    END DO ! ICSNum
    IF (ErrorsFound) CALL ShowFatalError('Errors in '//TRIM(CurrentModuleObject)//' input.')
    IF (NumOfCollectors > 0) THEN
      ALLOCATE(CheckEquipName(NumOfCollectors))
      CheckEquipName = .TRUE.
    ENDIF
  END IF
  RETURN
END SUBROUTINE GetSolarCollectorInput