Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(inout) | :: | AU(IK(NetworkNumOfNodes+1)) | |||
real(kind=r64), | intent(inout) | :: | AD(NetworkNumOfNodes) | |||
real(kind=r64), | intent(inout) | :: | AL(IK(NetworkNumOfNodes+1)-1) | |||
integer, | intent(in) | :: | IK(NetworkNumOfNodes+1) | |||
integer, | intent(in) | :: | NEQ | |||
integer, | intent(in) | :: | NSYM |
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 FACSKY(AU,AD,AL,IK,NEQ,NSYM)
! 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 This subroutine is revised from FACSKY developed by George Walton, NIST
! PURPOSE OF THIS SUBROUTINE:
! This subroutine performs L-U factorization of a skyline ordered matrix, [A]
! The algorithm has been restructured for clarity.
! Note dependence on compiler for optimizing the inner do loops.
! METHODOLOGY EMPLOYED:
! L-U factorization of a skyline ordered matrix, [A], used for
! solution of simultaneous linear algebraic equations [A] * X = B.
! No pivoting! No scaling! No warnings!!!
! Related routines: SLVSKY, SETSKY, FILSKY.
! REFERENCES:
! Algorithm is described in "The Finite Element Method Displayed",
! by G. Dhatt and G. Touzot, John Wiley & Sons, New York, 1984.
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: IK(NetworkNumOfNodes+1) ! pointer to the top of column/row "K"
INTEGER, INTENT(IN) :: NEQ ! number of equations
INTEGER, INTENT(IN) :: NSYM ! symmetry: 0 = symmetric matrix, 1 = non-symmetric
! noel, GNU says the AU is indexed above its upper bound
!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
REAL(r64), INTENT(INOUT) :: AL(IK(NetworkNumOfNodes+1)-1) ! the lower triangle of [A] before and after factoring
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER JHK, JHK1, LHK, LHK1, IMIN, IMIN1
INTEGER JHJ, JHJ1, IC, I, J, K
REAL(r64) T1, T2, SDOT, SUMD
! FLOW:
AD(1) = 1.0d0/AD(1)
JHK = 1
DO K=2,NEQ
SUMD = 0.0d0
JHK1 = IK(K+1)
LHK = JHK1-JHK
IF(LHK.GT.0) THEN
LHK1 = LHK-1
IMIN = K-LHK1
IMIN1 = IMIN-1
IF(NSYM.EQ.1) AL(JHK) = AL(JHK)*AD(IMIN1)
IF(LHK1.NE.0) THEN
JHJ = IK(IMIN)
IF(NSYM.EQ.0) THEN
DO J=1,LHK1
JHJ1 = IK(IMIN+J)
IC = MIN(J,JHJ1-JHJ)
IF(IC.GT.0) THEN
SDOT = 0.0d0
DO I=0,IC-1
SDOT = SDOT+AU(JHJ1-IC+I)*AU(JHK+J-IC+I)
END DO
AU(JHK+J) = AU(JHK+J)-SDOT
END IF
JHJ = JHJ1
END DO
ELSE
DO J=1,LHK1
JHJ1 = IK(IMIN+J)
IC = MIN(J,JHJ1-JHJ)
SDOT = 0.0d0
IF(IC.GT.0) THEN
DO I=0,IC-1
SDOT = SDOT+AL(JHJ1-IC+I)*AU(JHK+J-IC+I)
END DO
AU(JHK+J) = AU(JHK+J)-SDOT
SDOT = 0.0d0
DO I=0,IC-1
SDOT = SDOT+AU(JHJ1-IC+I)*AL(JHK+J-IC+I)
END DO
END IF
AL(JHK+J) = (AL(JHK+J)-SDOT)*AD(IMIN1+J)
JHJ = JHJ1
END DO
END IF
!
END IF
IF(NSYM.EQ.0) THEN
DO I=0,LHK1
T1 = AU(JHK+I)
T2 = T1*AD(IMIN1+I)
AU(JHK+I) = T2
SUMD = SUMD+T1*T2
END DO
ELSE
DO I=0,LHK1
SUMD = SUMD+AU(JHK+I)*AL(JHK+I)
END DO
END IF
END IF
If (AD(K)-SUMD .EQ. 0.d0) Then
CALL ShowSevereError('AirflowNetworkSolver: L-U factorization in Subroutine FACSKY.')
CALL ShowContinueError('The denominator used in L-U factorizationis equal to 0.0 at node = ' &
//TRIM(AirflowNetworkNodeData(K)%Name)//'.')
CALL ShowContinueError('One possible cause is that this node may not be connected directly, or indirectly via airflow ' &
//'network connections ')
CALL ShowContinueError('(e.g., AirflowNetwork:Multizone:SurfaceCrack, AirflowNetwork:Multizone:Component:' &
// 'SimpleOpening, etc.), to an external')
CALL ShowContinueError('node (AirflowNetwork:MultiZone:Surface).')
CALL ShowContinueError('Please send your input file and weather file to EnergyPlus support/development team' &
//' for further investigation.')
CALL ShowFatalError('Preceding condition causes termination.')
End If
AD(K) = 1.0d0/(AD(K)-SUMD)
JHK = JHK1
END DO
!
RETURN
END SUBROUTINE FACSKY