Skip to content

Commit 98032ba

Browse files
committed
FDS Source: GLOBMAT_SOLVER change matrix building arrays to handle variable size stencils.
1 parent 311b4ed commit 98032ba

File tree

3 files changed

+191
-133
lines changed

3 files changed

+191
-133
lines changed

Source/ccib.f90

Lines changed: 84 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -19680,22 +19680,17 @@ END SUBROUTINE GET_CUTCELL_FH
1968019680

1968119681
! ---------------------------- GET_H_MATRIX_CC ------------------------------------
1968219682

19683-
SUBROUTINE GET_H_MATRIX_CC(NM,NM1,IPZ,D_MAT_HP)
19683+
SUBROUTINE GET_H_MATRIX_CC(NM,NM1,IPZ)
1968419684

1968519685
! This routine assumes the calling subroutine has called POINT_TO_MESH for NM.
1968619686

1968719687
INTEGER, INTENT(IN) :: NM,NM1,IPZ
19688-
REAL(EB), POINTER, DIMENSION(:,:) :: D_MAT_HP
1968919688

1969019689
! Local Variables:
1969119690
INTEGER :: X1AXIS,IFACE,ICF,I,J,K,IND(LOW_IND:HIGH_IND),IND_LOC(LOW_IND:HIGH_IND)
1969219691
INTEGER :: LOCROW_1,LOCROW_2,ILOC,JLOC,JCOL,IROW
1969319692
REAL(EB) :: AF,IDX,BIJ,KFACE(2,2)
1969419693

19695-
IF (.NOT. ASSOCIATED(D_MAT_HP)) THEN
19696-
WRITE(LU_ERR,*) 'GET_H_MATRIX_CC in geom.f90: Pointer D_MAT_HP not associated.'
19697-
RETURN
19698-
ENDIF
1969919694

1970019695
! X direction bounds:
1970119696
ILO_FACE = 0 ! Low mesh boundary face index.
@@ -19752,8 +19747,7 @@ SUBROUTINE GET_H_MATRIX_CC(NM,NM1,IPZ,D_MAT_HP)
1975219747
DO JLOC=LOW_IND,HIGH_IND ! Local col number in Kface, JD
1975319748
IROW=IND_LOC(ILOC) ! Process Local Unknown number.
1975419749
JCOL=RCF%JDH(ILOC,JLOC) ! Local position of coef in D_MAT_H
19755-
! Add coefficient:
19756-
D_MAT_HP(JCOL,IROW) = D_MAT_HP(JCOL,IROW) + KFACE(ILOC,JLOC)
19750+
ZONE_SOLVE(IPZ)%ROW_H(IROW)%D(JCOL) = ZONE_SOLVE(IPZ)%ROW_H(IROW)%D(JCOL) + KFACE(ILOC,JLOC)
1975719751
ENDDO
1975819752
ENDDO
1975919753
ENDDO
@@ -19801,8 +19795,7 @@ SUBROUTINE GET_H_MATRIX_CC(NM,NM1,IPZ,D_MAT_HP)
1980119795
DO JLOC=LOW_IND,HIGH_IND ! Local col number in Kface, JD
1980219796
IROW=IND_LOC(ILOC)
1980319797
JCOL=CF%JDH(ILOC,JLOC,IFACE)
19804-
! Add coefficient:
19805-
D_MAT_HP(JCOL,IROW) = D_MAT_HP(JCOL,IROW) + KFACE(ILOC,JLOC)
19798+
ZONE_SOLVE(IPZ)%ROW_H(IROW)%D(JCOL) = ZONE_SOLVE(IPZ)%ROW_H(IROW)%D(JCOL) + KFACE(ILOC,JLOC)
1980619799
ENDDO
1980719800
ENDDO
1980819801
ENDDO
@@ -19932,9 +19925,9 @@ SUBROUTINE GET_CC_MATRIXGRAPH_H(NM,NM1,IPZ,LOOP_FLAG)
1993219925
! Add to global matrix arrays:
1993319926
DO LOCROW=LOCROW_1,LOCROW_2
1993419927
DO IIND=LOW_IND,HIGH_IND
19935-
NII = ZONE_SOLVE(IPZ)%NNZ_D_MAT_H(IND_LOC(LOCROW))
19928+
NII = ZONE_SOLVE(IPZ)%ROW_H(IND_LOC(LOCROW))%NNZ
1993619929
DO ILOC=1,NII
19937-
IF ( IND(IIND) == ZONE_SOLVE(IPZ)%JD_MAT_H(ILOC,IND_LOC(LOCROW)) ) THEN
19930+
IF ( IND(IIND) == ZONE_SOLVE(IPZ)%ROW_H(IND_LOC(LOCROW))%JD(ILOC) ) THEN
1993819931
RCF%JDH(LOCROW,IIND) = ILOC
1993919932
EXIT
1994019933
ENDIF
@@ -19976,9 +19969,9 @@ SUBROUTINE GET_CC_MATRIXGRAPH_H(NM,NM1,IPZ,LOOP_FLAG)
1997619969
! Add to global matrix arrays:
1997719970
DO LOCROW=LOCROW_1,LOCROW_2
1997819971
DO IIND=LOW_IND,HIGH_IND
19979-
NII = ZONE_SOLVE(IPZ)%NNZ_D_MAT_H(IND_LOC(LOCROW))
19972+
NII = ZONE_SOLVE(IPZ)%ROW_H(IND_LOC(LOCROW))%NNZ
1998019973
DO ILOC=1,NII
19981-
IF ( IND(IIND) == ZONE_SOLVE(IPZ)%JD_MAT_H(ILOC,IND_LOC(LOCROW)) ) THEN
19974+
IF ( IND(IIND) == ZONE_SOLVE(IPZ)%ROW_H(IND_LOC(LOCROW))%JD(ILOC) ) THEN
1998219975
CF%JDH(LOCROW,IIND,IFACE) = ILOC
1998319976
EXIT
1998419977
ENDIF
@@ -19999,38 +19992,94 @@ SUBROUTINE ADD_INPLACE_NNZ_H_WHLDOM(LOCROW_1,LOCROW_2,IND,IND_LOC,IPZ)
1999919992
INTEGER, INTENT(IN) :: LOCROW_1,LOCROW_2,IND(LOW_IND:HIGH_IND),IND_LOC(LOW_IND:HIGH_IND),IPZ
2000019993

2000119994
! Local Variables:
20002-
INTEGER LOCROW, IIND, NII, ILOC, JLOC
19995+
INTEGER LOCROW, IIND, ILOC
2000319996
LOGICAL INLIST
2000419997

2000519998
LOCROW_LOOP : DO LOCROW=LOCROW_1,LOCROW_2
2000619999
DO IIND=LOW_IND,HIGH_IND
20007-
NII = ZONE_SOLVE(IPZ)%NNZ_D_MAT_H(IND_LOC(LOCROW))
20008-
! Check that column index hasn't been already counted:
20009-
INLIST = .FALSE.
20010-
DO ILOC=1,NII
20011-
IF ( IND(IIND) == ZONE_SOLVE(IPZ)%JD_MAT_H(ILOC,IND_LOC(LOCROW)) ) THEN
20012-
INLIST = .TRUE.
20013-
EXIT
20000+
! Populate variable per-row storage ROW_H only:
20001+
ILOC = IND_LOC(LOCROW)
20002+
IF (ILOC>=1 .AND. ILOC<=SIZE(ZONE_SOLVE(IPZ)%ROW_H)) THEN
20003+
IF (.NOT. ALLOCATED(ZONE_SOLVE(IPZ)%ROW_H(ILOC)%JD)) THEN
20004+
ALLOCATE(ZONE_SOLVE(IPZ)%ROW_H(ILOC)%JD(7))
20005+
ALLOCATE(ZONE_SOLVE(IPZ)%ROW_H(ILOC)%D(7))
20006+
ZONE_SOLVE(IPZ)%ROW_H(ILOC)%JD(1) = IND(IIND)
20007+
ZONE_SOLVE(IPZ)%ROW_H(ILOC)%D(1) = 0._EB
20008+
ZONE_SOLVE(IPZ)%ROW_H(ILOC)%NNZ = 1
20009+
ELSE
20010+
INLIST = ANY(ZONE_SOLVE(IPZ)%ROW_H(ILOC)%JD(1:ZONE_SOLVE(IPZ)%ROW_H(ILOC)%NNZ) == IND(IIND))
20011+
IF (.NOT. INLIST) THEN
20012+
CALL INSERT_SORTED_INT_REAL( &
20013+
ZONE_SOLVE(IPZ)%ROW_H(ILOC)%JD, &
20014+
ZONE_SOLVE(IPZ)%ROW_H(ILOC)%D, &
20015+
ZONE_SOLVE(IPZ)%ROW_H(ILOC)%NNZ, &
20016+
IND(IIND))
20017+
ENDIF
2001420018
ENDIF
20015-
ENDDO
20016-
IF ( INLIST ) CYCLE
20017-
20018-
! Now add in place:
20019-
NII = NII + 1
20020-
DO ILOC=1,NII
20021-
IF ( ZONE_SOLVE(IPZ)%JD_MAT_H(ILOC,IND_LOC(LOCROW)) > IND(IIND) ) EXIT
20022-
ENDDO
20023-
DO JLOC=NII,ILOC+1,-1
20024-
ZONE_SOLVE(IPZ)%JD_MAT_H(JLOC,IND_LOC(LOCROW)) = ZONE_SOLVE(IPZ)%JD_MAT_H(JLOC-1,IND_LOC(LOCROW))
20025-
ENDDO
20026-
ZONE_SOLVE(IPZ)%NNZ_D_MAT_H(IND_LOC(LOCROW)) = NII
20027-
ZONE_SOLVE(IPZ)%JD_MAT_H(ILOC,IND_LOC(LOCROW)) = IND(IIND)
20019+
ENDIF
2002820020
ENDDO
2002920021
ENDDO LOCROW_LOOP
2003020022

2003120023
RETURN
2003220024
END SUBROUTINE ADD_INPLACE_NNZ_H_WHLDOM
2003320025

20026+
! Helper: insert NEWCOL into sorted integer array JD and mirror REAL array D, grow allocs
20027+
SUBROUTINE INSERT_SORTED_INT_REAL(JD, D, NNZ, NEWCOL)
20028+
USE PRECISION_PARAMETERS
20029+
IMPLICIT NONE (TYPE,EXTERNAL)
20030+
INTEGER, ALLOCATABLE, INTENT(INOUT) :: JD(:)
20031+
REAL(EB), ALLOCATABLE, INTENT(INOUT) :: D(:)
20032+
INTEGER, INTENT(INOUT) :: NNZ
20033+
INTEGER, INTENT(IN) :: NEWCOL
20034+
20035+
INTEGER :: POS, CAP
20036+
INTEGER :: I
20037+
INTEGER, ALLOCATABLE :: JD_TMP(:)
20038+
REAL(EB), ALLOCATABLE :: D_TMP(:)
20039+
20040+
! Determine current capacity from allocated size
20041+
CAP = SIZE(JD)
20042+
20043+
! Grow capacity geometrically if needed
20044+
IF (NNZ+1 > CAP) THEN
20045+
CAP = MAX(2*MAX(CAP,1), NNZ+1)
20046+
ALLOCATE(JD_TMP(CAP))
20047+
ALLOCATE(D_TMP(CAP))
20048+
IF (NNZ > 0) THEN
20049+
JD_TMP(1:NNZ) = JD(1:NNZ)
20050+
D_TMP(1:NNZ) = D(1:NNZ)
20051+
ENDIF
20052+
IF (ALLOCATED(JD)) DEALLOCATE(JD)
20053+
IF (ALLOCATED(D)) DEALLOCATE(D)
20054+
CALL MOVE_ALLOC(JD_TMP, JD)
20055+
CALL MOVE_ALLOC(D_TMP, D)
20056+
ENDIF
20057+
20058+
! Find insertion position (ascending order)
20059+
POS = 1
20060+
DO WHILE (POS <= NNZ)
20061+
IF(JD(POS) < NEWCOL) THEN
20062+
POS = POS + 1
20063+
ELSE
20064+
EXIT
20065+
ENDIF
20066+
ENDDO
20067+
20068+
! Shift in-place to make room
20069+
IF (NNZ >= POS) THEN
20070+
DO I = NNZ, POS, -1
20071+
JD(I+1) = JD(I)
20072+
D(I+1) = D(I)
20073+
ENDDO
20074+
ENDIF
20075+
20076+
! Insert new entry
20077+
JD(POS) = NEWCOL
20078+
D(POS) = 0._EB
20079+
NNZ = NNZ + 1
20080+
20081+
END SUBROUTINE INSERT_SORTED_INT_REAL
20082+
2003420083

2003520084
! --------------------------- GET_MMATRIX_SCALAR_3D -------------------------------
2003620085

0 commit comments

Comments
 (0)