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(inout) | :: | IK(NetworkNumOfNodes+1) | |||
real(kind=r64), | intent(inout) | :: | AD(NetworkNumOfNodes) | |||
real(kind=r64), | intent(inout) | :: | AU(IK(NetworkNumOfNodes+1)) | |||
integer, | intent(inout) | :: | ITER |
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 SOLVZP(IK,AD,AU,ITER)
! SUBROUTINE INFORMATION:
! AUTHOR George Walton
! DATE WRITTEN Extracted from AIRNET
! MODIFIED Lixing Gu, 2/1/04
! Revised the subroutine to meet E+ needs
! MODIFIED Lixing Gu, 6/8/05
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine solves zone pressures by modified Newton-Raphson iteration
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(INOUT) :: IK(NetworkNumOfNodes+1) ! pointer to the top of column/row "K"
INTEGER, INTENT(INOUT) :: ITER ! number of iterations
!noel GNU says AU is being indexed beyound bounds
!REAL(r64), INTENT(INOUT) :: AU(IK(NetworkNumOfNodes+1)-1) ! the upper triangle of [A] before and after factoring
REAL(r64), INTENT(INOUT) :: AU(IK(NetworkNumOfNodes+1)) ! the upper triangle of [A] before and after factoring
REAL(r64), INTENT(INOUT) :: AD(NetworkNumOfNodes) ! the main diagonal of [A] before and after factoring
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! NNZE - number of nonzero entries in the "AU" array.
! LFLAG - if = 1, use laminar relationship (initialization).
! I - element number.
! N - number of node/zone 1.
! M - number of node/zone 2.
! F - flows through the element (kg/s).
! DF - partial derivatives: DF/DP.
! NF - number of flows, 1 or 2.
! SUMF - sum of flows into node/zone.
! CCF - current pressure correction (Pa).
! PCF - previous pressure correction (Pa).
! CEF - convergence enhancement factor.
!
INTEGER N, NNZE, NSYM, LFLAG, CONVG, ACCEL
REAL(r64) PCF(NetworkNumOfNodes), CEF(NetworkNumOfNodes)
REAL(r64) C, SSUMF, SSUMAF, ACC0, ACC1
REAL(r64) CCF(NetworkNumOfNodes)
! FLOW:
ACC1 = 0.0d0
ACCEL = 0
NSYM = 0
NNZE = IK(NetworkNumOfNodes+1)-1
IF(LIST.GE.2) WRITE(Unit21,*) 'Initialization',NetworkNumOfNodes,NetworkNumOfLinks,NNZE
ITER = 0
DO N=1,NetworkNumOfNodes
PCF(N) = 0.0d0
CEF(N) = 0.0d0
END DO
IF(AirflowNetworkSimu%InitFlag.NE.1) THEN
! Initialize node/zone pressure values by assuming only linear relationship between
! airflows and pressure drops.
LFLAG = 1
CALL FILJAC(NNZE,LFLAG)
DO N=1,NetworkNumOfNodes
IF(AirflowNetworkNodeData(N)%NodeTypeNum.EQ.0) PZ(N) = SUMF(N)
END DO
! Data dump.
IF(LIST.GE.3) THEN
CALL DUMPVD('AD:',AD,NetworkNumOfNodes,Unit21)
CALL DUMPVD('AU:',AU,NNZE,Unit21)
CALL DUMPVR('AF:',SUMF,NetworkNumOfNodes,Unit21)
END IF
! Solve linear system for approximate PZ.
#ifdef SKYLINE_MATRIX_REMOVE_ZERO_COLUMNS
CALL FACSKY(newAU,AD,newAU,newIK,NetworkNumOfNodes,NSYM) !noel
CALL SLVSKY(newAU,AD,newAU,PZ,newIK,NetworkNumOfNodes,NSYM) !noel
#else
CALL FACSKY(AU,AD,AU,IK,NetworkNumOfNodes,NSYM)
CALL SLVSKY(AU,AD,AU,PZ,IK,NetworkNumOfNodes,NSYM)
#endif
IF(LIST.GE.2) CALL DUMPVD('PZ:',PZ,NetworkNumOfNodes,Unit21)
END IF
! Solve nonlinear airflow network equations by modified Newton's method.
DO WHILE (ITER .LT. AirflowNetworkSimu%MaxIteration)
LFLAG = 0
ITER = ITER+1
IF(LIST.GE.2) WRITE(Unit21,*) 'Begin iteration ',ITER
! Set up the Jacobian matrix.
CALL FILJAC(NNZE,LFLAG)
! Data dump.
IF(LIST.GE.3) THEN
CALL DUMPVR('SUMF:',SUMF,NetworkNumOfNodes,Unit21)
CALL DUMPVR('SUMAF:',SUMAF,NetworkNumOfNodes,Unit21)
END IF
! Check convergence.
CONVG = 1
SSUMF = 0.0d0
SSUMAF = 0.0d0
DO N=1,NetworkNumOfNodes
SSUMF = SSUMF + ABS(SUMF(N))
SSUMAF = SSUMAF + SUMAF(N)
IF(CONVG.EQ.1) THEN
IF(ABS(SUMF(N)).LE.AirflowNetworkSimu%AbsTol) CYCLE
IF(ABS(SUMF(N)/SUMAF(N)).GT.AirflowNetworkSimu%RelTol) CONVG = 0
END IF
END DO
ACC0 = ACC1
IF(SSUMAF.GT.0.0d0) ACC1 = SSUMF / SSUMAF
IF(CONVG.EQ.1 .AND. ITER.GT.1) RETURN
IF(ITER.GE.AirflowNetworkSimu%MaxIteration) EXIT
! Data dump.
IF(LIST.GE.3) THEN
CALL DUMPVD('AD:',AD,NetworkNumOfNodes,Unit21)
CALL DUMPVD('AU:',AU,NNZE,Unit21)
END IF
! Solve AA * CCF = SUMF.
DO N=1,NetworkNumOfNodes
CCF(N) = SUMF(N)
END DO
#ifdef SKYLINE_MATRIX_REMOVE_ZERO_COLUMNS
CALL FACSKY(newAU,AD,newAU,newIK,NetworkNumOfNodes,NSYM) !noel
CALL SLVSKY(newAU,AD,newAU,CCF,newIK,NetworkNumOfNodes,NSYM) !noel
#else
CALL FACSKY(AU,AD,AU,IK,NetworkNumOfNodes,NSYM)
CALL SLVSKY(AU,AD,AU,CCF,IK,NetworkNumOfNodes,NSYM)
#endif
! Revise PZ (Steffensen iteration on the N-R correction factors to handle oscillating corrections).
IF(ACCEL.EQ.1) THEN
ACCEL = 0
ELSE
IF(ITER.GT.2 .AND. ACC1.GT.0.5d0*ACC0) ACCEL = 1
END IF
DO N=1,NetworkNumOfNodes
IF(AirflowNetworkNodeData(N)%NodeTypeNum.EQ.1) CYCLE
CEF(N) = 1.0d0
IF(ACCEL.EQ.1) THEN
C = CCF(N)/PCF(N)
IF(C.LT.AirflowNetworkSimu%ConvLimit) CEF(N) = 1.0/(1.0-C)
C = CCF(N) * CEF(N)
ELSE
! IF (CCF(N) .EQ. 0.0) CCF(N)=TINY(CCF(N)) ! 1.0E-40
IF (CCF(N) .EQ. 0.0d0) CCF(N)=rTinyValue ! 1.0E-40 (Epsilon)
PCF(N) = CCF(N)
C = CCF(N)
END IF
IF(ABS(C).GT.AirflowNetworkSimu%MaxPressure) THEN
CEF(N) = CEF(N)*AirflowNetworkSimu%MaxPressure/ABS(C)
PZ(N) = PZ(N)-CCF(N)*CEF(N)
ELSE
PZ(N) = PZ(N)-C
END IF
END DO
! Data revision dump.
IF(LIST.GE.2) THEN
DO N=1,NetworkNumOfNodes
IF(AirflowNetworkNodeData(N)%NodeTypeNum.EQ.0) &
WRITE(Unit21,901) ' Rev:',N,SUMF(N),CCF(N),CEF(N),PZ(N)
END DO
ENDIF
END DO
! Error termination.
CALL ShowSevereError('Too many iterations (SOLVZP) in Airflow Network simulation')
AirflowNetworkSimu%ExtLargeOpeningErrCount = AirflowNetworkSimu%ExtLargeOpeningErrCount + 1
if (AirflowNetworkSimu%ExtLargeOpeningErrCount < 2) then
CALL ShowWarningError('AirflowNetwork: SOLVER, Changing values for initialization flag, Relative airflow convergence, ' &
//'Absolute airflow convergence, Convergence acceleration limit or Maximum Iteration Number may solve the problem.')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('..Iterations='//TRIM(RoundSigDigits(ITER))//', Max allowed='// &
TRIM(RoundSigDigits(AirflowNetworkSimu%MaxIteration)))
CALL ShowFatalError('AirflowNetwork: SOLVER, The previous error causes termination.')
else
CALL ShowRecurringWarningErrorAtEnd('AirFlowNetwork: Too many iterations (SOLVZP) in AirflowNetwork ' &
//' simulation continues.',AirflowNetworkSimu%ExtLargeOpeningErrIndex)
end if
901 FORMAT(A5,I3,2E14.6,0PF8.4,F24.14)
RETURN
END SUBROUTINE SOLVZP