CoilAreaFracIter Subroutine

public subroutine CoilAreaFracIter(NewSurfAreaWetFrac, SurfAreaFracCurrent, ErrorCurrent, SurfAreaFracPrevious, ErrorPrevious, SurfAreaFracLast, ErrorLast, IterNum, icvg)

Arguments

Type	Intent		Name
real(kind=r64),	intent(out)	::	NewSurfAreaWetFrac
real(kind=r64),	intent(in)	::	SurfAreaFracCurrent
real(kind=r64),	intent(in)	::	ErrorCurrent
real(kind=r64),	intent(inout)	::	SurfAreaFracPrevious
real(kind=r64),	intent(inout)	::	ErrorPrevious
real(kind=r64),	intent(inout)	::	SurfAreaFracLast
real(kind=r64),	intent(inout)	::	ErrorLast
integer,	intent(in)	::	IterNum
integer,	intent(inout)	::	icvg
Called By

Help
Source Code

CoilAreaFracIter
Source Code

Subroutine CoilAreaFracIter(NewSurfAreaWetFrac, SurfAreaFracCurrent,ErrorCurrent,SurfAreaFracPrevious, &
                                       ErrorPrevious,SurfAreaFracLast,ErrorLast,IterNum,ICvg)
          ! FUNCTION INFORMATION:
          ! AUTHOR         Rahul Chillar
          ! DATE WRITTEN   June 2004
          ! MODIFIED       na
          ! RE-ENGINEERED  na

          ! PURPOSE OF THIS FUNCTION:
          ! Iterately solves for the value of SurfAreaWetFraction for the Cooling Coil.

          ! METHODOLOGY EMPLOYED:
          ! First function generates 2 sets of guess points by perturbation and subsequently
          ! by Linear Fit and using the generated points calculates coeffecients for Quadratic
          ! fit to predict the next value of surface area wet fraction.

          ! REFERENCES:
          ! ME 423 Design of Thermal Systems Class Notes.UIUC. W.F.Stoecker

          ! USE STATEMENTS:
          ! na

          ! Enforce explicit typing of all variables in this routine
       Implicit None

          ! FUNCTION ARGUMENT DEFINITIONS:
       REAL(r64), intent(Out):: NewSurfAreaWetFrac    ! Out Value of variable
       REAL(r64), intent(in) :: SurfAreaFracCurrent   ! Driver Value
       REAL(r64), intent(in) :: ErrorCurrent          ! Objective Function
       REAL(r64), intent(inout) :: ErrorPrevious          ! First Previous value of error
       REAL(r64), intent(inout) :: ErrorLast              ! Second Previous value of error
       REAL(r64), intent(inout) :: SurfAreaFracPrevious   ! First Previous value of Surf Area Fraction
       REAL(r64), intent(inout) :: SurfAreaFracLast       ! Second Previous value of Surf Area Fraction
       Integer, intent(in) :: IterNum             ! Number of Iterations
       Integer, intent(inout)   :: icvg                ! Iteration convergence flag

          ! FUNCTION PARAMETER DEFINITIONS:
       REAL(r64), Parameter:: Tolerance =1.d-5         ! Relative error tolerance
       REAL(r64), Parameter:: PerturbSurfAreaFrac= 0.1d0 ! Perturbation applied to Surf Fraction to initialize iteration
       REAL(r64), Parameter:: SmallNum= 1.d-9          ! Small Number

          ! INTERFACE BLOCK SPECIFICATIONS
          ! na

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! FUNCTION LOCAL VARIABLE DECLARATIONS:
       REAL(r64) :: check                          ! Validity Check for moving to Quad Solution
       REAL(r64) :: QuadCoefThree                  ! Term under radical in quadratic solution
       REAL(r64) :: QuadCoefOne            ! Term under radical in quadratic solution
       REAL(r64) :: QuadCoefTwo            ! Term under radical in quadratic solution
       REAL(r64) :: Slope                  ! Slope for linear fit
       REAL(r64) :: SurfAreaFracOther      ! Intermediate Value of Surf Area
       Integer :: mode                ! Linear/ perturbation option

        ! Convergence Check  by comparing previous and current value of surf area fraction
      IF ((ABS(SurfAreaFracCurrent-SurfAreaFracPrevious) .LT. Tolerance*MAX(ABS(SurfAreaFracCurrent),SmallNum) .AND.               &
          IterNum .NE. 1) .OR. ErrorCurrent .EQ. 0.0d0) THEN
        ! Setting value for surface area fraction for coil
        NewSurfAreaWetFrac = SurfAreaFracCurrent
        ICvg=1  ! Convergance Flag
        RETURN
      ENDIF

        ! If Icvg = 0 , it has not converged.By perturbation for getting second set of
        ! data (mode=1), Getting Third set of data by performing a  linear fit(Mode=2).
        ! Now using the above 3 points generated by perturbation and Linear Fit to perform
        ! a quadratic fit.This will happen after second iteration only.
      ICvg=0 ! Convergance flag = false
        ! For First Iteration Start with perturbation, For second iteration start with linear fit
        ! from the previous two values
      mode=IterNum

10    IF (mode .EQ. 1) THEN

        ! FirstGuess Set of Points provided by perturbation
        IF (ABS(SurfAreaFracCurrent) .GT. SmallNum) THEN
          NewSurfAreaWetFrac = SurfAreaFracCurrent*(1.d0+PerturbSurfAreaFrac)
        ELSE
          NewSurfAreaWetFrac = PerturbSurfAreaFrac
        ENDIF

        ! Second set of values being calculated from the first set of values (incoming & perturb)
      ELSEIF (mode .EQ. 2) THEN

        ! Calculating Slope for interpolating to the New Point (Simple Linear Extrapolation)
        Slope=(ErrorPrevious-ErrorCurrent)/(SurfAreaFracPrevious-SurfAreaFracCurrent)
        ! Error Check for value or Slope
           IF(Slope.EQ.0.0d0) THEN
              mode=1 ! Go back to Perturbation
              GO TO 10
           ENDIF
        ! Guessing New Value for Surface Area Fraction
        NewSurfAreaWetFrac=SurfAreaFracCurrent-ErrorCurrent/Slope
      ELSE

        ! Check for Quadratic Fit possible here ,Previous value of surf area fraction
        ! equals current value then Try linear fit for another point.
        IF (SurfAreaFracCurrent .EQ. SurfAreaFracPrevious) THEN
        ! Assign Value of previous point to Last Variable for storing
        ! Go back and calculate new value for Previous.
          SurfAreaFracPrevious=SurfAreaFracLast
          ErrorPrevious=ErrorLast
          mode=2
          GO TO 10
        ELSEIF (SurfAreaFracCurrent .EQ. SurfAreaFracLast) THEN
        ! Calculate another value using Linear Fit.
          mode=2
          GO TO 10
        ENDIF

        ! Now We have enough previous points to calculate coefficients and
        ! perform a quadratic fit for new guess value of surface area fraction

        ! Calculating First Coefficients for Quadratic Curve Fit
        QuadCoefThree=((ErrorLast-ErrorCurrent)/(SurfAreaFracLast-SurfAreaFracCurrent)- &
                     (ErrorPrevious-ErrorCurrent)/(SurfAreaFracPrevious-SurfAreaFracCurrent))/ &
                                                            (SurfAreaFracLast-SurfAreaFracPrevious)
        ! Calculating Second Coefficients for Quadratic Curve Fit
        QuadCoefTwo=(ErrorPrevious-ErrorCurrent)/   &
                                    (SurfAreaFracPrevious-SurfAreaFracCurrent)-  &
                                      (SurfAreaFracPrevious+SurfAreaFracCurrent)*QuadCoefThree

        ! Calculating Third Coefficients for Quadratic Curve Fit
        QuadCoefOne=ErrorCurrent-(QuadCoefTwo+QuadCoefThree*SurfAreaFracCurrent)*SurfAreaFracCurrent

        ! Check for validity of coefficients , if not REAL(r64) ,Then fit is linear
        IF (ABS(QuadCoefThree) .LT. 1.D-10) THEN
          mode=2  ! going to Linear mode, due to colinear points.
          GO TO 10
        ENDIF

        ! If value of Quadratic coefficients not suitable enought due to round off errors
        ! to predict new point go to linear fit and acertain new values for the coefficients.
        IF (ABS((QuadCoefOne+(QuadCoefTwo+QuadCoefThree*SurfAreaFracPrevious)* &
                  SurfAreaFracPrevious-ErrorPrevious)/ErrorPrevious) .GT. 1.D-4) THEN
           mode=2 ! go to linear mode
           GO TO 10
        ENDIF

        ! Validity Check for Imaginary roots, In this case go back to linear fit.
        check=QuadCoefTwo**2-4.0d0*QuadCoefOne*QuadCoefThree
        ! Imaginary Root Exist
        IF (check .LT. 0) THEN
           mode=2
           GO TO 10
        ELSEIF (check .GT. 0) THEN
          ! real unequal roots exist, Determine the roots nearest to most recent guess
          NewSurfAreaWetFrac=(-QuadCoefTwo+SQRT(check))/QuadCoefThree/2.0d0
          SurfAreaFracOther=-NewSurfAreaWetFrac-QuadCoefTwo/QuadCoefThree
          ! Assigning value to Surface Area Fraction with recent
          IF (ABS(NewSurfAreaWetFrac-SurfAreaFracCurrent) .GT. &
                                   ABS(SurfAreaFracOther-SurfAreaFracCurrent)) NewSurfAreaWetFrac=SurfAreaFracOther
        ELSE
          ! The roots are real, one solution exists.
          NewSurfAreaWetFrac=-QuadCoefTwo/QuadCoefThree/2
        ENDIF

      ENDIF

      IF (mode .LT. 3) THEN
        ! No valid previous points to eliminate, since it just has 2 points.
        ! Loading previous values into last
        SurfAreaFracLast=SurfAreaFracPrevious
        ErrorLast=ErrorPrevious
        ! Loading Current Values into previous
        SurfAreaFracPrevious=SurfAreaFracCurrent
        ErrorPrevious=ErrorCurrent
      ELSE

        ! Elimination the most distance previous point from the answer based on sign and
        ! magnitute of the error. Keeping Current Point
        IF (ErrorPrevious*ErrorCurrent .GT. 0 .AND. ErrorLast*ErrorCurrent .GT. 0) THEN
            ! If sign are same , simply eliminate the one with biggest error value.
          IF (ABS(ErrorLast) .GT. ABS(ErrorPrevious)) THEN
            ! Eliminating Last Value
            SurfAreaFracLast=SurfAreaFracPrevious
            ErrorLast=ErrorPrevious
          ENDIF
        ELSE
            ! If signs are different eliminate previous error with same sign as current error
          IF (ErrorLast*ErrorCurrent .GT. 0)  THEN
            ! Previous Loaded to Last
            SurfAreaFracLast=SurfAreaFracPrevious
            ErrorLast=ErrorPrevious
          ENDIF
        ENDIF
        ! Current Loaded into previous.
        SurfAreaFracPrevious=SurfAreaFracCurrent
        ErrorPrevious=ErrorCurrent
      ENDIF
      RETURN

END SUBROUTINE CoilAreaFracIter
All Procedures
