@@ -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
1968719687INTEGER, INTENT(IN) :: NM,NM1,IPZ
19688- REAL(EB), POINTER, DIMENSION(:,:) :: D_MAT_HP
1968919688
1969019689! Local Variables:
1969119690INTEGER :: X1AXIS,IFACE,ICF,I,J,K,IND(LOW_IND:HIGH_IND),IND_LOC(LOW_IND:HIGH_IND)
1969219691INTEGER :: LOCROW_1,LOCROW_2,ILOC,JLOC,JCOL,IROW
1969319692REAL(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:
1970119696ILO_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
1975919753ENDDO
@@ -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)
1999919992INTEGER, 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
2000319996LOGICAL INLIST
2000419997
2000519998LOCROW_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
2002920021ENDDO LOCROW_LOOP
2003020022
2003120023RETURN
2003220024END 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