From 9ddda15325025c7cf59332efec50e88ecb8076ea Mon Sep 17 00:00:00 2001 From: marcosvanella Date: Fri, 22 May 2026 12:59:11 -0400 Subject: [PATCH] FDS Source: address dropped fine cut-cells in refinement interface. --- Source/geom.f90 | 179 ++++++++++++++++++++++++++++++++++++++++-------- Source/mesh.f90 | 3 + 2 files changed, 152 insertions(+), 30 deletions(-) diff --git a/Source/geom.f90 b/Source/geom.f90 index cdd2b273bb..931ff5b2ef 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -1511,6 +1511,7 @@ SUBROUTINE SET_CUTCELLS_3D DO IDIM=1,MAX_DIM FM_PENDING_BLOCK_SCAN = .FALSE. +DO NM=1,NMESHES; MESHES(NM)%N_CC_ELIMINATED = 0; ENDDO ! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: CALL EXCHANGE_CC_NOADVANCE_INFO @@ -1603,6 +1604,17 @@ SUBROUTINE SET_CUTCELLS_3D CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) ENDDO MAIN_MESH_LOOP_1 +! Propagate DROP_CUTCELL eliminations (fine interior, NCELL==1) to coarse ghost band; +! ghost solidifies in MAIN_MESH_LOOP_1B, then TAG_CC_BLOCKING_REFINEMENT closes fine footprint. +! Do not PROMOTE_ELIMINATED to coarse interior here — that over-blocks 5mm. +CALL EXCHANGE_CC_ELIMINATED_INFO +CALL APPLY_OWN_BLOCKED_TO_REPLICAS +CALL ADD_NEIGHBOR_BLOCKED_CELLS +DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + IF (MESHES(NM)%N_CC_ELIMINATED>0) FM_PENDING_BLOCK_SCAN(NM) = .TRUE. +ENDDO +DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX; MESHES(NM)%N_CC_ELIMINATED = 0; ENDDO + IF (ANY(FM_PENDING_BLOCK_SCAN)) THEN DO WHILE (ANY(FM_PENDING_BLOCK_SCAN)) DO NM=1,NMESHES @@ -1611,6 +1623,7 @@ SUBROUTINE SET_CUTCELLS_3D CALL PROMOTE_REFINEMENT_FOOTPRINTS_FROM_BLOCKED_FINE(NM) ENDDO ENDDO + FM_PENDING_BLOCK_SCAN = .FALSE. MAIN_MESH_LOOP_1B : DO NM=1,NMESHES IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 @@ -1775,8 +1788,11 @@ SUBROUTINE SET_CUTCELLS_3D DO NM=1,NMESHES MESHES(NM)%N_CC_BLOCKED = 0 + MESHES(NM)%N_CC_ELIMINATED = 0 IF(ALLOCATED(MESHES(NM)%XYZ_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED) IF(ALLOCATED(MESHES(NM)%JBT_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%JBT_CC_BLOCKED) + IF(ALLOCATED(MESHES(NM)%XYZ_CC_ELIMINATED)) DEALLOCATE(MESHES(NM)%XYZ_CC_ELIMINATED) + IF(ALLOCATED(MESHES(NM)%JBT_CC_ELIMINATED)) DEALLOCATE(MESHES(NM)%JBT_CC_ELIMINATED) ! BODTRI_DONOR is consumed only during the setup blocking / refinement-interface passes ! above. Free it here so it doesn't sit allocated for the lifetime of the run. IF (ALLOCATED(MESHES(NM)%CUT_CELL)) THEN @@ -2520,10 +2536,12 @@ END FUNCTION FACE_INDEX_IN_BOUNDS SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS USE TRAN, ONLY: GET_IJK -INTEGER :: NM2,ICELL,I2,J2,K2,BLOCK_TAG -REAL(EB):: XCO,YCO,ZCO,VOL_NM,VOL_NOM,X1,Y1,Z1 +INTEGER :: NM2,ICELL,I2,J2,K2,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR +REAL(EB):: XCO,YCO,ZCO,VOL_NM,VOL_NOM,X1,Y1,Z1,XMAP,YMAP,ZMAP +LOGICAL :: FINE_AT_REFI,CELL_CHANGED TYPE(MESH_TYPE), POINTER :: M2 +CELL_CHANGED = .FALSE. MESH_LOOP : DO NM=1,NMESHES IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. @@ -2550,31 +2568,43 @@ SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS VOL_NOM = M2%DX(I2)*M2%DY(J2)*M2%DZ(K2) IF (VOL_NM > 1.5_EB * VOL_NOM) THEN ! NM is COARSE, NOM is FINE IF(XCO < M2%XS .OR. XCO > M2%XF .OR. YCO < M2%YS .OR. YCO > M2%YF .OR. ZCO < M2%ZS .OR. ZCO > M2%ZF) CYCLE ICELL_DO - IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & - YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & - ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) CYCLE ICELL_DO + FINE_AT_REFI = (I2==1 .OR. I2==M2%IBAR .OR. J2==1 .OR. J2==M2%JBAR .OR. K2==1 .OR. K2==M2%KBAR) + IF (.NOT.FINE_AT_REFI) THEN + IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & + YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & + ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) CYCLE ICELL_DO + ENDIF + IF (FINE_AT_REFI) THEN + XMAP = M2%XC(I2); YMAP = M2%YC(J2); ZMAP = M2%ZC(K2) + ELSE + XMAP = XCO; YMAP = YCO; ZMAP = ZCO + ENDIF - ! Find I,J,K in NM where (XCO,YCO,ZCO) falls within cell bounds (ghost band only). - I = MINLOC(ABS(XCELL(ILO_CELL-1:IHI_CELL+1)-XCO),DIM=1) + ILO_CELL - 2 - J = MINLOC(ABS(YCELL(JLO_CELL-1:JHI_CELL+1)-YCO),DIM=1) + JLO_CELL - 2 - K = MINLOC(ABS(ZCELL(KLO_CELL-1:KHI_CELL+1)-ZCO),DIM=1) + KLO_CELL - 2 - IF (XCO < XFACE(I-1)-GEOMEPS .OR. XCO > XFACE(I)+GEOMEPS .OR. & - YCO < YFACE(J-1)-GEOMEPS .OR. YCO > YFACE(J)+GEOMEPS .OR. & - ZCO < ZFACE(K-1)-GEOMEPS .OR. ZCO > ZFACE(K)+GEOMEPS) CYCLE ICELL_DO + ! Find I,J,K in NM where blocked fine cell maps (ghost band only). + I = MINLOC(ABS(XCELL(ILO_CELL-1:IHI_CELL+1)-XMAP),DIM=1) + ILO_CELL - 2 + J = MINLOC(ABS(YCELL(JLO_CELL-1:JHI_CELL+1)-YMAP),DIM=1) + JLO_CELL - 2 + K = MINLOC(ABS(ZCELL(KLO_CELL-1:KHI_CELL+1)-ZMAP),DIM=1) + KLO_CELL - 2 + IF (XMAP < XFACE(I-1)-GEOMEPS .OR. XMAP > XFACE(I)+GEOMEPS .OR. & + YMAP < YFACE(J-1)-GEOMEPS .OR. YMAP > YFACE(J)+GEOMEPS .OR. & + ZMAP < ZFACE(K-1)-GEOMEPS .OR. ZMAP > ZFACE(K)+GEOMEPS) CYCLE ICELL_DO IF (I>ILO_CELL-1 .AND. IJLO_CELL-1 .AND. JKLO_CELL-1 .AND. K 0) THEN DO JCC = 1, M%CUT_CELL(ICC)%NCELL IF (M%CUT_CELL(ICC)%NOADVANCE(JCC) == NOT_BLOCKED) THEN M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCK_TAG - IF (M2%JBT_CC_BLOCKED(3,ICELL)>0 .AND. M2%JBT_CC_BLOCKED(4,ICELL)>0) & - M%CUT_CELL(ICC)%BODTRI_DONOR(1:2,JCC) = M2%JBT_CC_BLOCKED(3:4,ICELL) + IF (IBOD_DONOR>0 .AND. ITRI_DONOR>0) M%CUT_CELL(ICC)%BODTRI_DONOR(1:2,JCC) = (/IBOD_DONOR,ITRI_DONOR/) + FM_PENDING_BLOCK_SCAN(NM) = .TRUE. ENDIF ENDDO + ELSEIF (M%CCVAR(I,J,K,CC_CGSC)==CC_GASPHASE) THEN + CALL TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT(NM,I,J,K,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR,CELL_CHANGED) + IF (CELL_CHANGED) FM_PENDING_BLOCK_SCAN(NM) = .TRUE. ENDIF ELSEIF (VOL_NOM > 1.5_EB * VOL_NM) THEN ! NM is FINE, NOM is COARSE CALL TAG_FINE_CELLS_IN_COARSE_CELL_VOLUME(NOM,I2,J2,K2,NM,BLOCK_TAG, & @@ -5478,25 +5508,19 @@ END SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO - USE MPI_F08 - - ! Local Variables: - INTEGER :: NM,NOM,N,IERR,I,J,K,ICC,JCC,IBOD_DONOR,ITRI_DONOR + INTEGER :: NM,I,J,K,ICC,JCC,IBOD_DONOR,ITRI_DONOR,NPACK,ICELL TYPE(MESH_TYPE), POINTER :: M - TYPE (MPI_REQUEST), ALLOCATABLE, DIMENSION(:) :: REQ0,REQ0DUM - INTEGER :: N_REQ0 - LOGICAL :: PROCESS_SENDREC ! Define cut-cells to be blocked for exchange: DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX CALL POINT_TO_MESH(NM) M => MESHES(NM) ! Count cut-cells for blocking in mesh: - M%N_CC_BLOCKED = 0 + NPACK = M%N_CC_ELIMINATED DO ICC=1,MESHES(NM)%N_CUTCELL_MESH CC => M%CUT_CELL(ICC) DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)>0) M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 + IF(CC%NOADVANCE(JCC)>0) NPACK = NPACK + 1 ENDDO ENDDO ! Also count CC_SOLID interior cells in the outer 1-cell boundary band, so they get @@ -5506,15 +5530,16 @@ SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO DO I=1,M%IBAR IF (M%CCVAR(I,J,K,CC_CGSC)/=CC_SOLID) CYCLE IF (I>1 .AND. I1 .AND. J1 .AND. K0) THEN + M%N_CC_BLOCKED = NPACK + IF (NPACK>0) THEN IF(ALLOCATED(M%XYZ_CC_BLOCKED)) DEALLOCATE(M%XYZ_CC_BLOCKED) IF(ALLOCATED(M%JBT_CC_BLOCKED)) DEALLOCATE(M%JBT_CC_BLOCKED) - ALLOCATE(M%XYZ_CC_BLOCKED(3,M%N_CC_BLOCKED)) - ALLOCATE(M%JBT_CC_BLOCKED(4,M%N_CC_BLOCKED)) + ALLOCATE(M%XYZ_CC_BLOCKED(3,NPACK)) + ALLOCATE(M%JBT_CC_BLOCKED(4,NPACK)) ! Fill in blocked cut-cell info: M%N_CC_BLOCKED = 0 DO ICC=1,MESHES(NM)%N_CUTCELL_MESH @@ -5540,10 +5565,59 @@ SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO ENDDO ENDDO ENDDO + ! Blocked cut-cells eliminated by BLOCK_SMALL (queued before DROP_CUTCELL). + DO ICELL=1,M%N_CC_ELIMINATED + M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 + M%XYZ_CC_BLOCKED(1:3,M%N_CC_BLOCKED) = M%XYZ_CC_ELIMINATED(1:3,ICELL) + M%JBT_CC_BLOCKED(1:4,M%N_CC_BLOCKED) = M%JBT_CC_ELIMINATED(1:4,ICELL) + ENDDO + ELSE + M%N_CC_BLOCKED = 0 ENDIF ENDDO - ! MPI Exchange: + CALL EXCHANGE_CC_BLOCKED_LISTS + +END SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO + +! ----------------------- EXCHANGE_CC_ELIMINATED_INFO --------------------------- + +SUBROUTINE EXCHANGE_CC_ELIMINATED_INFO + + USE MPI_F08 + INTEGER :: NM,ICELL,NPACK + TYPE(MESH_TYPE), POINTER :: M + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + NPACK = M%N_CC_ELIMINATED + M%N_CC_BLOCKED = NPACK + IF (NPACK>0) THEN + IF(ALLOCATED(M%XYZ_CC_BLOCKED)) DEALLOCATE(M%XYZ_CC_BLOCKED) + IF(ALLOCATED(M%JBT_CC_BLOCKED)) DEALLOCATE(M%JBT_CC_BLOCKED) + ALLOCATE(M%XYZ_CC_BLOCKED(3,NPACK)) + ALLOCATE(M%JBT_CC_BLOCKED(4,NPACK)) + DO ICELL=1,NPACK + M%XYZ_CC_BLOCKED(1:3,ICELL) = M%XYZ_CC_ELIMINATED(1:3,ICELL) + M%JBT_CC_BLOCKED(1:4,ICELL) = M%JBT_CC_ELIMINATED(1:4,ICELL) + ENDDO + ELSE + M%N_CC_BLOCKED = 0 + ENDIF + ENDDO + CALL EXCHANGE_CC_BLOCKED_LISTS +END SUBROUTINE EXCHANGE_CC_ELIMINATED_INFO + +! ----------------------- EXCHANGE_CC_BLOCKED_LISTS ----------------------------- + +SUBROUTINE EXCHANGE_CC_BLOCKED_LISTS + + USE MPI_F08 + INTEGER :: NM,NOM,N,IERR + TYPE (MPI_REQUEST), ALLOCATABLE, DIMENSION(:) :: REQ0,REQ0DUM + INTEGER :: N_REQ0 + LOGICAL :: PROCESS_SENDREC + IF (N_MPI_PROCESSES>1) THEN ALLOCATE(REQ0(NMESHES)); N_REQ0 = 0 ! Exchange number of cut-cells information to be exchanged between MESH and OMESHES: @@ -5636,8 +5710,52 @@ SUBROUTINE CHECK_REQ0_SIZE CALL MOVE_ALLOC(REQ0DUM,REQ0) ENDIF END SUBROUTINE CHECK_REQ0_SIZE +END SUBROUTINE EXCHANGE_CC_BLOCKED_LISTS + +! ----------------------- REGISTER_ELIMINATED_CUTCELL --------------------------- + +SUBROUTINE REGISTER_ELIMINATED_CUTCELL(NM,ICC,JCC) + +INTEGER, INTENT(IN) :: NM,ICC,JCC +INTEGER :: NNEW,NCAP,IBOD_DONOR,ITRI_DONOR +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: JBT_TMP +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZ_TMP +TYPE(MESH_TYPE), POINTER :: M - END SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO +IF (PROCESS(NM)/=MY_RANK) RETURN + +M => MESHES(NM) +IF (M%CUT_CELL(ICC)%NOADVANCE(JCC)<=0) RETURN +IF (.NOT.ELIMINATED_AT_REFI_INTERFACE()) RETURN +NNEW = M%N_CC_ELIMINATED + 1 +IF (.NOT.ALLOCATED(M%XYZ_CC_ELIMINATED)) THEN + NCAP = MAX(16,2*NNEW) + ALLOCATE(M%XYZ_CC_ELIMINATED(3,NCAP),M%JBT_CC_ELIMINATED(4,NCAP)) +ELSEIF (NNEW>SIZE(M%XYZ_CC_ELIMINATED,DIM=2)) THEN + NCAP = MAX(16,2*NNEW) + ALLOCATE(XYZ_TMP(3,NCAP),JBT_TMP(4,NCAP)) + IF (M%N_CC_ELIMINATED>0) THEN + XYZ_TMP(:,1:M%N_CC_ELIMINATED) = M%XYZ_CC_ELIMINATED(:,1:M%N_CC_ELIMINATED) + JBT_TMP(:,1:M%N_CC_ELIMINATED) = M%JBT_CC_ELIMINATED(:,1:M%N_CC_ELIMINATED) + ENDIF + CALL MOVE_ALLOC(FROM=XYZ_TMP,TO=M%XYZ_CC_ELIMINATED) + CALL MOVE_ALLOC(FROM=JBT_TMP,TO=M%JBT_CC_ELIMINATED) +ENDIF +M%N_CC_ELIMINATED = NNEW; M%XYZ_CC_ELIMINATED(1:3,NNEW) = M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) +CALL GET_BLOCKING_CUTCELL_DONOR(NM,ICC,JCC,IBOD_DONOR,ITRI_DONOR) +M%JBT_CC_ELIMINATED(1:4,NNEW) = (/JCC,M%CUT_CELL(ICC)%NOADVANCE(JCC),IBOD_DONOR,ITRI_DONOR/) + +CONTAINS +LOGICAL FUNCTION ELIMINATED_AT_REFI_INTERFACE() +INTEGER :: I,J,K +ELIMINATED_AT_REFI_INTERFACE = .FALSE. +IF (M%N_NEIGHBORING_MESHES<1) RETURN +I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) +IF (I<0 .OR. I>M%IBP1 .OR. J<0 .OR. J>M%JBP1 .OR. K<0 .OR. K>M%KBP1) RETURN +! First interior layer only (exclude ghost indices 0/IBP1). +ELIMINATED_AT_REFI_INTERFACE = ((I==1) .OR. (I==M%IBAR) .OR. (J==1) .OR. (J==M%JBAR) .OR. (K==1) .OR. (K==M%KBAR)) +END FUNCTION ELIMINATED_AT_REFI_INTERFACE +END SUBROUTINE REGISTER_ELIMINATED_CUTCELL ! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- @@ -8581,6 +8699,7 @@ SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) ! Check if JCC is the only cut-cell in CUT_CELL(ICC): IF (M%CUT_CELL(ICC)%NCELL==1) THEN + CALL REGISTER_ELIMINATED_CUTCELL(NM,ICC,JCC) ! Set cut-cell to solid M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED diff --git a/Source/mesh.f90 b/Source/mesh.f90 index f964cd3a81..886c40ddc8 100644 --- a/Source/mesh.f90 +++ b/Source/mesh.f90 @@ -275,8 +275,11 @@ MODULE MESH_VARIABLES ! Arrays for cut-cell blocking: INTEGER :: N_CC_BLOCKED=0 + INTEGER :: N_CC_ELIMINATED=0 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: JBT_CC_BLOCKED REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZ_CC_BLOCKED + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: JBT_CC_ELIMINATED + REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZ_CC_ELIMINATED ! ...