Merge pull request #16282 from marcosvanella/master

FDS Source: improve mesh consistency for blocking in refinement region.

Author: marcosvanella

Source/geom.f90

@@ -1514,6 +1514,7 @@ SUBROUTINE SET_CUTCELLS_3D
 
 ! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes:
 CALL EXCHANGE_CC_NOADVANCE_INFO
+CALL APPLY_OWN_BLOCKED_TO_REPLICAS ! Mirror owner-side NOADVANCE flags onto OMESH replicas of the same mesh 
 ! Add CC%NOADVANCE(JCC) where needed:
 CALL ADD_NEIGHBOR_BLOCKED_CELLS
 
@@ -1628,13 +1629,19 @@ SUBROUTINE SET_CUTCELLS_3D
    ENDDO MAIN_MESH_LOOP_1B
 ENDIF
 CALL EXCHANGE_CC_NOADVANCE_INFO
+CALL APPLY_OWN_BLOCKED_TO_REPLICAS
 CALL ADD_NEIGHBOR_BLOCKED_CELLS
 
 ! Call tag boundary cut-cells for blocking in refinement interfaces:
 CALL TAG_CC_BLOCKING_REFINEMENT
 
 ENDDO
 
+! Propagate TAG_CC_BLOCKING_REFINEMENT effects across ranks before the final BLOCK_SMALL pass.
+CALL EXCHANGE_CC_NOADVANCE_INFO
+CALL APPLY_OWN_BLOCKED_TO_REPLICAS
+CALL ADD_NEIGHBOR_BLOCKED_CELLS
+
 MAIN_MESH_LOOP_3 : DO NM=1,NMESHES
 
    IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these.
@@ -2291,43 +2298,17 @@ SUBROUTINE PROMOTE_REFINEMENT_FOOTPRINTS_FROM_BLOCKED_FINE(NM_FINE)
       CALL TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT(NM_COARSE,II_COARSE,JJ_COARSE,KK_COARSE,BLOCKED_REFI_INTER, &
                                                     IBOD_DONOR,ITRI_DONOR,CELL_CHANGED)
       IF (CELL_CHANGED) FM_PENDING_BLOCK_SCAN(NM_COARSE) = .TRUE.
-      CALL TAG_ALL_FINE_FOOTPRINTS_FOR_COARSE_CELL(NM_COARSE,II_COARSE,JJ_COARSE,KK_COARSE,IOR_COARSE, &
-                                                   BLOCKED_REFI_INTER,IBOD_DONOR,ITRI_DONOR)
    ENDDO COARSE_WALL_LOOP
 ENDDO COARSE_MESH_LOOP
 END SUBROUTINE PROMOTE_REFINEMENT_FOOTPRINTS_FROM_BLOCKED_FINE
 
-SUBROUTINE TAG_ALL_FINE_FOOTPRINTS_FOR_COARSE_CELL(NM_COARSE,II_COARSE,JJ_COARSE,KK_COARSE,IOR_TRIGGER,BLOCK_TAG, &
-                                                   IBOD_DONOR,ITRI_DONOR)
-INTEGER, INTENT(IN) :: NM_COARSE,II_COARSE,JJ_COARSE,KK_COARSE,IOR_TRIGGER,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR
-INTEGER :: IW_LOC,NM_FINE
-TYPE(WALL_TYPE), POINTER :: WC_COARSE
-TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC_COARSE
-TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC_COARSE
-TYPE(MESH_TYPE), POINTER :: MC
-
-MC => MESHES(NM_COARSE); IF (.NOT.ALLOCATED(MC%WALL)) RETURN
-DO IW_LOC=1,MC%N_EXTERNAL_WALL_CELLS
-   WC_COARSE => MC%WALL(IW_LOC); IF (WC_COARSE%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE
-   BC_COARSE => MC%BOUNDARY_COORD(WC_COARSE%BC_INDEX)
-   IF (BC_COARSE%IOR/=IOR_TRIGGER) CYCLE
-   IF (BC_COARSE%IIG/=II_COARSE .OR. BC_COARSE%JJG/=JJ_COARSE .OR. BC_COARSE%KKG/=KK_COARSE) CYCLE
-   EWC_COARSE => MC%EXTERNAL_WALL(IW_LOC)
-   NM_FINE = EWC_COARSE%NOM
-   CALL TAG_FINE_CELLS_IN_COARSE_CELL_VOLUME(NM_COARSE,II_COARSE,JJ_COARSE,KK_COARSE,NM_FINE,BLOCK_TAG, &
-                                             IBOD_DONOR,ITRI_DONOR)
-ENDDO
-END SUBROUTINE TAG_ALL_FINE_FOOTPRINTS_FOR_COARSE_CELL
-
 SUBROUTINE TAG_FINE_CELLS_IN_COARSE_CELL_VOLUME(NM_COARSE,I_COARSE,J_COARSE,K_COARSE,NM_FINE,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR)
 INTEGER, INTENT(IN) :: NM_COARSE,I_COARSE,J_COARSE,K_COARSE,NM_FINE,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR
 INTEGER :: I_FINE,J_FINE,K_FINE
 REAL(EB) :: XLO,XHI,YLO,YHI,ZLO,ZHI,EPS_LOC
 LOGICAL :: CELL_CHANGED
 TYPE(MESH_TYPE), POINTER :: MC,MF
 
-IF (PROCESS(NM_FINE)/=MY_RANK) RETURN
-
 MC => MESHES(NM_COARSE)
 MF => MESHES(NM_FINE)
 XLO = MC%X(I_COARSE-1); XHI = MC%X(I_COARSE)
@@ -2625,6 +2606,40 @@ SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS
 END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS
 
 
+! ----------------------- APPLY_OWN_BLOCKED_TO_REPLICAS ----------------------------
+! Apply owner-side NOADVANCE flags from XYZ_CC_BLOCKED/JBT_CC_BLOCKED onto each replica's local CUT_CELL.
+SUBROUTINE APPLY_OWN_BLOCKED_TO_REPLICAS
+
+USE TRAN, ONLY: GET_IJK
+
+INTEGER :: NM_LOC,ICELL,JCC_LOC,I_LOC,J_LOC,K_LOC,BLOCK_TAG,ICC_LOC
+REAL(EB) :: XCO,YCO,ZCO,X1,Y1,Z1
+
+MESH_LOOP_APPLY : DO NM_LOC=1,NMESHES
+   IF (.NOT.CC_COMPUTE_MESH(NM_LOC)) CYCLE          ! Only meshes with state on this rank.
+   IF (PROCESS(NM_LOC)==MY_RANK)     CYCLE          ! Owner already wrote authoritative state.
+   IF (.NOT.ALLOCATED(MESHES(NM_LOC)%XYZ_CC_BLOCKED)) CYCLE
+   IF (MESHES(NM_LOC)%N_CC_BLOCKED<=0)                CYCLE
+   DO ICELL=1,MESHES(NM_LOC)%N_CC_BLOCKED
+      JCC_LOC   = MESHES(NM_LOC)%JBT_CC_BLOCKED(1,ICELL); IF (JCC_LOC<=0) CYCLE ! Skip CC_SOLID boundary-band entries.
+      BLOCK_TAG = MESHES(NM_LOC)%JBT_CC_BLOCKED(2,ICELL); IF (BLOCK_TAG==NOT_BLOCKED) CYCLE
+      XCO = MESHES(NM_LOC)%XYZ_CC_BLOCKED(IAXIS,ICELL)
+      YCO = MESHES(NM_LOC)%XYZ_CC_BLOCKED(JAXIS,ICELL)
+      ZCO = MESHES(NM_LOC)%XYZ_CC_BLOCKED(KAXIS,ICELL)
+      CALL GET_IJK(XCO,YCO,ZCO,NM_LOC,X1,Y1,Z1,I_LOC,J_LOC,K_LOC)
+      IF (I_LOC<1 .OR. I_LOC>MESHES(NM_LOC)%IBAR .OR. J_LOC<1 .OR. J_LOC>MESHES(NM_LOC)%JBAR .OR. &
+          K_LOC<1 .OR. K_LOC>MESHES(NM_LOC)%KBAR) CYCLE
+      ICC_LOC = MESHES(NM_LOC)%CCVAR(I_LOC,J_LOC,K_LOC,CC_IDCC)
+      IF (ICC_LOC<=0) CYCLE                            ! No matching cut-cell on this replica.
+      IF (MESHES(NM_LOC)%CUT_CELL(ICC_LOC)%NOADVANCE(JCC_LOC)==NOT_BLOCKED) THEN
+         MESHES(NM_LOC)%CUT_CELL(ICC_LOC)%NOADVANCE(JCC_LOC) = BLOCK_TAG
+         IF (MESHES(NM_LOC)%JBT_CC_BLOCKED(3,ICELL)>0 .AND. MESHES(NM_LOC)%JBT_CC_BLOCKED(4,ICELL)>0) &
+            MESHES(NM_LOC)%CUT_CELL(ICC_LOC)%BODTRI_DONOR(1:2,JCC_LOC) = MESHES(NM_LOC)%JBT_CC_BLOCKED(3:4,ICELL)
+      ENDIF
+   ENDDO
+ENDDO MESH_LOOP_APPLY
+END SUBROUTINE APPLY_OWN_BLOCKED_TO_REPLICAS
+
 SUBROUTINE DEFINE_XYZFACE_CELL(ALLOC_FLG)
 
 LOGICAL, INTENT(IN) :: ALLOC_FLG
@@ -3083,51 +3098,14 @@ SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL)
 M2=>MESHES(NOM)
 
 IF (FINE_CELL) THEN
-
    ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC); ICC = 0
    IF ( ICC2 > 0 .OR. M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN ! There are cut-cells in omesh cartesian cell.
       CALL GET_REFINEMENT_CELL_DONOR(NOM,IIO1,JJO1,KKO1,IBOD_LOC,ITRI_LOC)
       IF(M%CCVAR(II1,JJ1,KK1,CC_CGSC)==CC_GASPHASE) THEN
-      ! Insert cut-cell is this location:
-      CT = 6;
-      NCFACE_CUTCELL = CT + 1
-      NCELL          = 1
-      NFACE_CELL     = CT
-      ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL));           CCELEM    = CC_UNDEFINED
-      ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED
-      ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II1)*M%DY(JJ1)*M%DZ(KK1)
-      ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II1),M%YC(JJ1),M%ZC(KK1) /)
-      ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED
-      IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) NOADVANCE(1) = BLOCKED_REFI_INTER
-      ! Add one by one regular and gas cut faces:
-      CT = 1; CCELEM(1,1) = 0
-      DO AX=IAXIS,KAXIS
-         DO SIDE=LOW_IND,HIGH_IND
-            ICFC=M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_IDCF,AX);
-            IF(ICFC>0) THEN
-               FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /)
-               CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1
-            ELSEIF(M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_FGSC,AX) == &
-               CC_GASPHASE) THEN
-               FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX,   0, 0, CC_UNDEFINED /)
-               CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1
-            ENDIF
-         ENDDO
-      ENDDO
-      ! Insert cut_cell:
-      CALL INSERT_CUT_CELL(NM,II1,JJ1,KK1,ICC); M => MESHES(NM)
-      CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL)
-      M%CUT_CELL(ICC)%NCELL      = NCELL
-      M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL
-      CALL MOVE_ALLOC(FROM=CCELEM   ,TO=M%CUT_CELL(ICC)%CCELEM)
-      CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST)
-      CALL MOVE_ALLOC(FROM=VOLUME   ,TO=M%CUT_CELL(ICC)%VOLUME)
-      CALL MOVE_ALLOC(FROM=XYZCEN   ,TO=M%CUT_CELL(ICC)%XYZCEN)
-      CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE)
-      IF (M%CUT_CELL(ICC)%NOADVANCE(1)>0) &
-         CALL SET_REFINEMENT_CUTCELL_DONOR(NM,ICC,1,IBOD_LOC,ITRI_LOC)
+         ! Skip rank-asymmetric cut-cell insertion (owner-only); keep CC_GASPHASE on all ranks.
+         ICC = 0
       ELSEIF(M%CCVAR(II1,JJ1,KK1,CC_IDCC)>0) THEN
-      ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC)
+         ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC)
       ENDIF
       ! Here Test if cut-cells in II,KK,KK are blocked or not in IIO,JJO,KKO:
       IF(ICC>0) THEN
@@ -3141,60 +3119,22 @@ SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL)
          ENDIF
       ENDIF
    ENDIF
-
 ELSE
-
    IF (PROCESS(NOM)/=MY_RANK) RETURN
    ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC); ICC2 = 0
    IF(ICC>0) THEN
       ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking.
       IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_GASPHASE) THEN
-      ! Insert cut-cell in this location, set to Block.
-      CT = 6;
-      NCFACE_CUTCELL = CT + 1
-      NCELL          = 1
-      NFACE_CELL     = CT
-      ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL));           CCELEM    = CC_UNDEFINED
-      ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED
-      ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IIO1)*M2%DY(JJO1)*M2%DZ(KKO1)
-      ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IIO1),M2%YC(JJO1),M2%ZC(KKO1) /)
-      ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED
-      ! Add one by one regular and gas cut faces:
-      CT = 1; CCELEM(1,1) = 0
-      DO AX=IAXIS,KAXIS
-         DO SIDE=LOW_IND,HIGH_IND; ICFC=&
-            M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_IDCF,AX);
-         IF(ICFC>0) THEN
-            FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /)
-            CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1
-            ELSEIF( &
-            M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_FGSC,AX)&
-            == CC_GASPHASE) THEN
-            FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX,   0, 0, CC_UNDEFINED /)
-            CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1
-         ENDIF
-         ENDDO
-      ENDDO
-      ! Insert cut_cell:
-      CALL INSERT_CUT_CELL(NOM,IIO1,JJO1,KKO1,ICC2); M2 => MESHES(NOM)
-      CALL NEW_CELL_ALLOC(NOM,ICC2,NCELL,NFACE_CELL,NCFACE_CUTCELL)
-      M2%CUT_CELL(ICC2)%NCELL      = NCELL
-      M2%CUT_CELL(ICC2)%NFACE_CELL = NFACE_CELL
-      CALL MOVE_ALLOC(FROM=CCELEM   ,TO=M2%CUT_CELL(ICC2)%CCELEM)
-      CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC2)%FACE_LIST)
-      CALL MOVE_ALLOC(FROM=VOLUME   ,TO=M2%CUT_CELL(ICC2)%VOLUME)
-      CALL MOVE_ALLOC(FROM=XYZCEN   ,TO=M2%CUT_CELL(ICC2)%XYZCEN)
-      CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC2)%NOADVANCE)
+         ! Skip rank-asymmetric cut-cell insertion (owner-only); keep CC_GASPHASE on all ranks of NOM.
+         ICC2 = 0
       ELSEIF(M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)>0) THEN
-      ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)
+         ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)
       ENDIF
       ! Here Test if cut-cells in IIO,JJO,KKO are blocked or not in II,JJ,KK:
       IF(ICC2>0) CALL TEST_CC_FOR_BLOCKING(NOM,ICC2,NM,II1,JJ1,KK1,ICC)
    ENDIF
-
 ENDIF
 
-
 END SUBROUTINE TAG_BLOCK_CELL
 
 SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2)