!! Check array of DP. DpL is used for multizone air flow calculation only !! and is not for forced air calculation
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | NNZE | |||
integer, | intent(in) | :: | LFLAG |
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 FILJAC(NNZE,LFLAG)
! 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 creates matrices for solution of flows
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: NNZE ! number of nonzero entries in the "AU" array.
INTEGER, INTENT(IN) :: LFLAG ! if = 1, use laminar relationship (initialization).
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! I - component 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.
!
INTEGER I, J, M, N, FLAG, NF
#ifdef SKYLINE_MATRIX_REMOVE_ZERO_COLUMNS
INTEGER LHK,JHK,JHK1, newsum,newh,Nzeros, ispan, thisIK !noel
LOGICAL allZero ! noel
LOGICAL, save :: firsttime=.true. ! noel
#endif
REAL(r64) X(4)
REAL(r64) DP, F(2), DF(2)
! FLOW:
DO N=1,NetworkNumOfNodes
SUMF(N) = 0.0d0
SUMAF(N) = 0.0d0
IF(AirflowNetworkNodeData(N)%NodeTypeNum.EQ.1) THEN
AD(N) = 1.0d0
ELSE
AD(N) = 0.0d0
END IF
END DO
DO N=1,NNZE
AU(N) = 0.0d0
END DO
! Set up the Jacobian matrix.
DO I=1,NetworkNumOfLinks
N = AirflowNetworkLinkageData(I)%NodeNums(1)
M = AirflowNetworkLinkageData(I)%NodeNums(2)
!!!! Check array of DP. DpL is used for multizone air flow calculation only
!!!! and is not for forced air calculation
if (I .GT. NumOfLinksMultiZone) then
DP = PZ(N)-PZ(M)+PS(I)+PW(I)
else
DP = PZ(N)-PZ(M)+DpL(1,I)+PW(I)
end if
IF(LIST.GE.4) WRITE(Unit21,901) 'PS:',I,N,M,PS(I),PW(I),AirflowNetworkLinkSimu(I)%DP
J = AirflowNetworkLinkageData(I)%CompNum
Select Case (AirflowNetworkCompData(J)%CompTypeNum)
Case (CompTypeNum_PLR) ! Distribution system crack component
CALL AFEPLR(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_DWC) ! Distribution system duct component
CALL AFEDWC(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_CVF) ! Distribution system constant volume fan component
CALL AFECFR(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_FAN) ! Distribution system detailed fan component
CALL AFEFAN(J,LFLAG,DP,I,N,M,F,DF,NF)
! Case (CompTypeNum_CPF) ! not currently used in EnergyPlus code -- left for compatibility with AirNet
! CALL AFECPF(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_DMP) ! Distribution system damper component
CALL AFEDMP(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_ELR) ! Distribution system effective leakage ratio component
CALL AFEELR(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_CPD) ! Distribution system constant pressure drop component
CALL AFECPD(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_DOP) ! Detailed opening
CALL AFEDOP(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_SOP) ! Simple opening
CALL AFESOP(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_SCR) ! Surface crack component
CALL AFESCR(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_SEL) ! Surface effective leakage ratio component
CALL AFESEL(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_COI) ! Distribution system coil component
CALL AFECOI(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_TMU) ! Distribution system terminal unit component
CALL AFETMU(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_EXF) ! Exhaust fan component
CALL AFEEXF(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_HEX) ! Distribution system heat exchanger component
CALL AFEHEX(J,LFLAG,DP,I,N,M,F,DF,NF)
Case (CompTypeNum_HOP) ! Horizontal opening
CALL AFEHOP(J,LFLAG,DP,I,N,M,F,DF,NF)
Case Default
CYCLE
End Select
AirflowNetworkLinkSimu(I)%DP = DP
AFLOW(I) = F(1)
AFLOW2(I) = 0.0d0
if (AirflowNetworkCompData(J)%CompTypeNum .EQ. CompTypeNum_DOP) then
AFLOW2(I) = F(2)
end if
if (AirflowNetworkCompData(J)%CompTypeNum .EQ. CompTypeNum_HOP) then
AFLOW2(I) = F(2)
end if
IF(LIST.GE.3) WRITE(Unit21,901) ' NRi:',I,N,M,AirflowNetworkLinkSimu(I)%DP,F(1),DF(1)
FLAG = 1
IF(AirflowNetworkNodeData(N)%NodeTypeNum.EQ.0) THEN
FLAG = FLAG+1
X(1) = DF(1)
X(2) = -DF(1)
SUMF(N) = SUMF(N)+F(1)
SUMAF(N) = SUMAF(N)+ABS(F(1))
END IF
IF(AirflowNetworkNodeData(M)%NodeTypeNum.EQ.0) THEN
FLAG = FLAG+2
X(4) = DF(1)
X(3) = -DF(1)
SUMF(M) = SUMF(M)-F(1)
SUMAF(M) = SUMAF(M)+ABS(F(1))
END IF
IF(FLAG.NE.1) CALL FILSKY(X,AirflowNetworkLinkageData(I)%NodeNums,IK,AU,AD,FLAG)
IF(NF.EQ.1) CYCLE
AFLOW2(I) = F(2)
IF(LIST.GE.3) WRITE(Unit21,901) ' NRj:',I,N,M,AirflowNetworkLinkSimu(I)%DP,F(2),DF(2)
FLAG = 1
IF(AirflowNetworkNodeData(N)%NodeTypeNum.EQ.0) THEN
FLAG = FLAG+1
X(1) = DF(2)
X(2) = -DF(2)
SUMF(N) = SUMF(N)+F(2)
SUMAF(N) = SUMAF(N)+ABS(F(2))
END IF
IF(AirflowNetworkNodeData(M)%NodeTypeNum.EQ.0) THEN
FLAG = FLAG+2
X(4) = DF(2)
X(3) = -DF(2)
SUMF(M) = SUMF(M)-F(2)
SUMAF(M) = SUMAF(M)+ABS(F(2))
END IF
IF(FLAG.NE.1) CALL FILSKY(X,AirflowNetworkLinkageData(I)%NodeNums,IK,AU,AD,FLAG)
END DO
901 FORMAT(A5,3I3,4E16.7)
#ifdef SKYLINE_MATRIX_REMOVE_ZERO_COLUMNS
! After the matrix values have been set, we can look at them and see if any columns are filled with zeros.
! If they are, let's remove them from the matrix -- but only for the purposes of doing the solve.
! They way I do this is building a separate IK array (newIK) that simply changes the column heights.
! So the affected SOLVEs would use this newIK and nothing else changes.
DO n=1,NetworkNumOfNodes+1
newIK(n)=IK(n)
!print*, " NetworkNumOfNodes n=", n, " IK(n)=", IK(n)
enddo
newsum=IK(2)-IK(1) ! always 0?
JHK=1
DO n=2,NetworkNumOfNodes
JHK1 = IK(n+1) ! starts at IK(3)-IK(2)
LHK = JHK1-JHK
IF(LHK.LE.0) then
newIK(n+1) = newIK(n)
CYCLE
endif
!write(*,'(4(a,i8))') "n=", n, " ik=", ik(n), " JHK=", JHK, " LHK=", LHK
! is the entire column zero? noel
allZero=.True.
DO i=0,LHK-1
if (AU(JHK+i) .ne. 0.0d0) then
allZero=.False.
exit
endif
enddo
newh=LHK
if (allZero .eqv. .True.) then
!print*, "allzero n=", n
newh=0
else
!DO i=0,LHK-1
! write(*, '(2(a,i8),a, f15.3)') " n=", n, " i=", i, " AU(JHK+i)=", AU(JHK+i)
!enddo
endif
newIK(n+1) = newIK(n) + newh
newsum = newsum + newh
!do i = LHK-1,0, -1
! write(*, '(2(a,i8),a, f15.3)') " n=", n, " i=", i, " AU(JHK+i)=", AU(JHK+i)
!enddo
JHK = JHK1
enddo
! this is just a print to screen, is not necessary
! if (firsttime) then
! write(*, '(2(a,i8))') " After SKYLINE_MATRIX_REMOVE_ZERO_COLUMNS: newsum=", newsum, " oldsum=", IK(NetworkNumOfNodes+1)
! firsttime=.false.
! endif
! Now fill newAU from AU, using newIK
thisIK=1
DO n=2,NetworkNumOfNodes
thisIK = newIK(n)
ispan = newIK(n+1) - thisIK
IF(ispan.LE.0) CYCLE
DO i=0,ispan-1
newAU(thisIK+i) = AU(IK(n)+i)
enddo
enddo
#endif
RETURN
END SUBROUTINE FILJAC