| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=r64), | EXTERNAL | :: | F | |||
| integer, | intent(in) | :: | F_Opt | |||
| real(kind=r64), | intent(in) | :: | F_P(hipDIM) | 
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.
REAL(r64) FUNCTION HEMINT(F, F_Opt, F_P)
          !
          !       AUTHOR         ASHRAE 1311-RP
          !       DATE WRITTEN   unknown
          !       MODIFIED       na
          !
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS FUNCTION:
          ! Romberg Integration of Property function over hemispeherical dome
          !
          !
          ! METHODOLOGY EMPLOYED:
          !  Romberg Integration.
          !
          !
          ! REFERENCES:
          !  na
          !
          !
          ! USE STATEMENTS:
          ! na
    IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
          ! FUNCTION ARGUMENT DEFINITIONS:
    REAL(r64),    EXTERNAL :: F                ! property integrand function
    INTEGER,   INTENT( IN) :: F_Opt            ! options passed to F() (hipRHO, hipTAU)
    REAL(r64), INTENT( IN) :: F_P(hipDIM)      ! parameters passed to F()
          ! FUNCTION PARAMETER DEFINITIONS:
    INTEGER,   PARAMETER :: KMAX = 8           ! max steps
    INTEGER,   PARAMETER :: NPANMAX = 2**KMAX
    REAL(r64), PARAMETER :: TOL = 0.0005d0     ! convergence tolerance
          !
          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na
          ! DERIVED TYPE DEFINITIONS:
          ! na
          ! FUNCTION LOCAL VARIABLE DECLARATIONS:
    REAL(r64) :: T( KMAX, KMAX), FX
    REAL(r64) :: X1, X2, X, DX, SUM, DIFF
    INTEGER   :: nPan, I, K, L, iPX
          ! Flow
    X1 = 0.0d0            ! integration limits
    X2 = PiOvr2
    nPan=1
    SUM = 0.0d0
    DO K = 1, KMAX
        DX = (X2-X1)/nPan
        iPX = NPANMAX / nPan
        DO I = 0, nPan
            IF (K == 1 .OR. MOD( I*iPX, iPX*2) /= 0) THEN
                !   evaluate integrand function for new X values
                !   2 * sin( x) * cos( x) covers hemisphere with single integral
                X = X1 + I*DX
                FX  = 2.0d0 * SIN( X) * COS( X) * F( X, F_Opt, F_P)
                IF (K == 1) FX = FX / 2.0d0
                SUM = SUM + FX
            END IF
        END DO
        T(1,K) = DX * SUM
        ! trapezoid result - i.e., first column Romberg entry
        ! Now complete the row
        IF (K > 1) THEN
            DO L=2,K
                T(L,K) = ((4.0d0**(L-1))*T(L-1,K) - T(L-1,K-1)) / (4.0d0**(L-1)-1.0d0)
            END DO
            !    check for convergence
            !    do 8 panels minimum, else can miss F() features
            IF (nPan >= 8) THEN
                DIFF = ABS( T(K,K) - T(K-1, K-1))
                IF (DIFF < TOL) EXIT
            END IF
        END IF
        nPan = 2 * nPan
    END DO
    IF (K > KMAX) THEN
        K = KMAX
    END IF
    HEMINT = P01(T(K, K), "HEMINT")
    RETURN
END FUNCTION HEMINT