Merge pull request #14816 from mcgratta/ht3d_mpi

FDS Source: Reduce size of WALL_SEND_BUFFER

Author: mcgratta

Source/func.f90

@@ -3049,6 +3049,24 @@ SUBROUTINE REALLOCATE_INTEGER_ARRAY(P,N1,N2,N3)
 END SUBROUTINE REALLOCATE_INTEGER_ARRAY
 
 
+!> \brief Change the allocation of an logical array with DIMENSION 1
+!> \param P Original array
+!> \param N1 Lower bound of old/new allocation
+!> \param N2 Upper bound of old allocation
+!> \param N3 Upper bound of new allocation
+
+SUBROUTINE REALLOCATE_LOGICAL_ARRAY(P,N1,N2,N3)
+
+LOGICAL, ALLOCATABLE, DIMENSION(:) :: P,DUMMY
+INTEGER, INTENT(IN) :: N1,N2,N3
+
+ALLOCATE(DUMMY(N1:N3))
+IF (ALLOCATED(P)) DUMMY(N1:N2) = P(N1:N2)
+CALL MOVE_ALLOC(DUMMY,P)
+
+END SUBROUTINE REALLOCATE_LOGICAL_ARRAY
+
+
 !> \brief Changes the allocation of a string array
 !> \param P Original array
 !> \param CLEN Length of string

Source/init.f90

@@ -1789,7 +1789,7 @@ SUBROUTINE INITIALIZE_HT3D_WALL_CELLS(NM)
 USE GEOMETRY_FUNCTIONS, ONLY: SEARCH_OTHER_MESHES
 INTEGER, INTENT(IN) :: NM
 INTEGER :: I,IW,IW2,ITW,ITW2,NWP,NWP2,I2,IWA,DM,IOR,NOM,II,JJ,KK,NN,IC,NL
-LOGICAL :: IOR_AVOID(-3:3)
+LOGICAL :: IOR_AVOID(-3:3),FOUND
 REAL(EB) :: X1,X2,Y1,Y2,Z1,Z2,XX1,XX2,YY1,YY2,ZZ1,ZZ2,PRIMARY_VOLUME,OVERLAP_VOLUME,DXX,DYY,DZZ,WEIGHT_FACTOR,&
             SUM_WGT(3),XX,YY,ZZ,WEIGHT,TARGET_WEIGHT
 TYPE(WALL_TYPE), POINTER :: WC
@@ -1799,6 +1799,7 @@ SUBROUTINE INITIALIZE_HT3D_WALL_CELLS(NM)
 TYPE(BOUNDARY_THR_D_TYPE), POINTER :: THR_D
 TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC,BC2
 TYPE(MESH_TYPE), POINTER :: M
+TYPE(STORAGE_TYPE), POINTER :: OS
 INTEGER, ALLOCATABLE, DIMENSION(:) :: INTEGER_DUMMY
 REAL(EB), ALLOCATABLE, DIMENSION(:) :: REAL_DUMMY
 REAL(EB), PARAMETER :: TOL=0.0001_EB
@@ -1894,13 +1895,17 @@ SUBROUTINE INITIALIZE_HT3D_WALL_CELLS(NM)
 
       OTHER_MESH_LOOP: DO NOM=1,NMESHES
          IF (NM==NOM) CYCLE
-         ALTERNATE_WALL_LOOP_2: DO NN=1,M%OMESH(NOM)%WALL_RECV_BUFFER%N_ITEMS
-            IW2 = M%OMESH(NOM)%WALL_RECV_BUFFER%ITEM_INDEX(NN)
+         OS => M%OMESH(NOM)%WALL_RECV_BUFFER
+         ALTERNATE_WALL_LOOP_2: DO NN=1,OS%N_ITEMS
+            IW2 = OS%ITEM_INDEX(NN)
             CALL SEARCH_FOR_ALTERNATE_WALL_CELLS(NOM,WALL_INDEX=IW2)
+            IF (FOUND) OS%SAVE_FLAG(NN) = .TRUE.
          ENDDO ALTERNATE_WALL_LOOP_2
-         ALTERNATE_WALL_LOOP_2D: DO NN=1,M%OMESH(NOM)%THIN_WALL_RECV_BUFFER%N_ITEMS  !  THIN_WALL cells, neighboring meshes
-            ITW2 = M%OMESH(NOM)%THIN_WALL_RECV_BUFFER%ITEM_INDEX(NN)
+         OS => M%OMESH(NOM)%THIN_WALL_RECV_BUFFER
+         ALTERNATE_WALL_LOOP_2D: DO NN=1,OS%N_ITEMS  !  THIN_WALL cells, neighboring meshes
+            ITW2 = OS%ITEM_INDEX(NN)
             CALL SEARCH_FOR_ALTERNATE_WALL_CELLS(NOM,THIN_WALL_INDEX=ITW2)
+            IF (FOUND) OS%SAVE_FLAG(NN) = .TRUE.
          ENDDO ALTERNATE_WALL_LOOP_2D
       ENDDO OTHER_MESH_LOOP
 
@@ -1999,13 +2004,17 @@ SUBROUTINE INITIALIZE_HT3D_WALL_CELLS(NM)
 
       OTHER_MESH_LOOP_B: DO NOM=1,NMESHES
          IF (NM==NOM) CYCLE
-         ALTERNATE_WALL_LOOP_2B: DO NN=1,M%OMESH(NOM)%WALL_RECV_BUFFER%N_ITEMS  ! WALL cells, neighboring meshes
-            IW2 = M%OMESH(NOM)%WALL_RECV_BUFFER%ITEM_INDEX(NN)
+         OS => M%OMESH(NOM)%WALL_RECV_BUFFER
+         ALTERNATE_WALL_LOOP_2B: DO NN=1,OS%N_ITEMS  ! WALL cells, neighboring meshes
+            IW2 = OS%ITEM_INDEX(NN)
             CALL SEARCH_FOR_ALTERNATE_WALL_CELLS(NOM,WALL_INDEX=IW2)
+            IF (FOUND) OS%SAVE_FLAG(NN) = .TRUE.
          ENDDO ALTERNATE_WALL_LOOP_2B
-         ALTERNATE_WALL_LOOP_2C: DO NN=1,M%OMESH(NOM)%THIN_WALL_RECV_BUFFER%N_ITEMS  !  THIN_WALL cells, neighboring meshes
-            ITW2 = M%OMESH(NOM)%THIN_WALL_RECV_BUFFER%ITEM_INDEX(NN)
+         OS => M%OMESH(NOM)%THIN_WALL_RECV_BUFFER
+         ALTERNATE_WALL_LOOP_2C: DO NN=1,OS%N_ITEMS  !  THIN_WALL cells, neighboring meshes
+            ITW2 = OS%ITEM_INDEX(NN)
             CALL SEARCH_FOR_ALTERNATE_WALL_CELLS(NOM,THIN_WALL_INDEX=ITW2)
+            IF (FOUND) OS%SAVE_FLAG(NN) = .TRUE.
          ENDDO ALTERNATE_WALL_LOOP_2C
       ENDDO OTHER_MESH_LOOP_B
 
@@ -2069,6 +2078,7 @@ SUBROUTINE SEARCH_FOR_ALTERNATE_WALL_CELLS(NOM,WALL_INDEX,THIN_WALL_INDEX)
 TYPE(THIN_WALL_TYPE), POINTER :: TW2
 
 M2  => MESHES(NOM)
+FOUND = .FALSE.
 
 IF (PRESENT(WALL_INDEX)) THEN
    CELL = WALL_INDEX
@@ -2116,6 +2126,7 @@ SUBROUTINE SEARCH_FOR_ALTERNATE_WALL_CELLS(NOM,WALL_INDEX,THIN_WALL_INDEX)
    OVERLAP_VOLUME = DXX*DYY*DZZ
    WEIGHT_FACTOR = OVERLAP_VOLUME/PRIMARY_VOLUME
    IF (WEIGHT_FACTOR<TOL) CYCLE ALTERNATE_NODE_LOOP
+   FOUND = .TRUE.  ! Save the index of the alternate wall
    DM = SIZE(THR_D%NODE(I)%ALTERNATE_WALL_INDEX)
    IF (THR_D%NODE(I)%ALTERNATE_WALL_COUNT+1>DM) CALL REALLOCATE_ALTERNATE
    THR_D%NODE(I)%ALTERNATE_WALL_COUNT = THR_D%NODE(I)%ALTERNATE_WALL_COUNT + 1
@@ -3713,7 +3724,7 @@ END SUBROUTINE SET_DENSITY_AND_MASS_FRACTIONS_AT_WALL
 
 SUBROUTINE FIND_WALL_BACK_INDICES(NM)
 
-USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_INTEGER_ARRAY
+USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_INTEGER_ARRAY,REALLOCATE_LOGICAL_ARRAY
 INTEGER, INTENT(IN) :: NM
 INTEGER :: IW,ITW,N,NOM,IC,IOR,IEC
 TYPE(MESH_TYPE), POINTER :: M,M4
@@ -3745,16 +3756,19 @@ SUBROUTINE FIND_WALL_BACK_INDICES(NM)
             OS%N_ITEMS_DIM = 50
             ALLOCATE(OS%ITEM_INDEX(1:OS%N_ITEMS_DIM))
             ALLOCATE(OS%SURF_INDEX(1:OS%N_ITEMS_DIM))
+            ALLOCATE(OS%SAVE_FLAG(1:OS%N_ITEMS_DIM))
          ENDIF
          IF (COUNT(OS%ITEM_INDEX(1:OS%N_ITEMS)==M4%CELL(IC)%WALL_INDEX(IOR))>0) CYCLE
          IF (OS%N_ITEMS>=OS%N_ITEMS_DIM) THEN
             CALL REALLOCATE_INTEGER_ARRAY(OS%ITEM_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
             CALL REALLOCATE_INTEGER_ARRAY(OS%SURF_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
+            CALL REALLOCATE_LOGICAL_ARRAY(OS%SAVE_FLAG ,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
             OS%N_ITEMS_DIM = OS%N_ITEMS_DIM + 50
          ENDIF
          OS%N_ITEMS = OS%N_ITEMS + 1
          OS%ITEM_INDEX(OS%N_ITEMS) = M4%CELL(IC)%WALL_INDEX(IOR)
          OS%SURF_INDEX(OS%N_ITEMS) = M4%CELL(IC)%SURF_INDEX(IOR)
+         OS%SAVE_FLAG(OS%N_ITEMS)  = .FALSE.
       ENDDO
    ENDDO
 ENDDO
@@ -3783,11 +3797,13 @@ SUBROUTINE FIND_WALL_BACK_INDICES(NM)
                IF (OS%N_ITEMS>=OS%N_ITEMS_DIM) THEN
                   CALL REALLOCATE_INTEGER_ARRAY(OS%ITEM_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
                   CALL REALLOCATE_INTEGER_ARRAY(OS%SURF_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
+                  CALL REALLOCATE_LOGICAL_ARRAY(OS%SAVE_FLAG ,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
                   OS%N_ITEMS_DIM = OS%N_ITEMS_DIM + 50
                ENDIF
                OS%N_ITEMS = OS%N_ITEMS + 1
                OS%ITEM_INDEX(OS%N_ITEMS) = M4%CELL(IC)%THIN_WALL_INDEX(IOR,IEC)
                OS%SURF_INDEX(OS%N_ITEMS) = M4%CELL(IC)%THIN_SURF_INDEX(IOR,IEC)
+               OS%SAVE_FLAG(OS%N_ITEMS)  = .FALSE.
             ENDIF
          ENDDO
       ENDDO
@@ -3805,7 +3821,7 @@ END SUBROUTINE FIND_WALL_BACK_INDICES
 SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
 
 USE GEOMETRY_FUNCTIONS, ONLY: SEARCH_OTHER_MESHES
-USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_INTEGER_ARRAY
+USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_INTEGER_ARRAY,REALLOCATE_LOGICAL_ARRAY
 USE MISC_FUNCTIONS, ONLY: PROCESS_MESH_NEIGHBORHOOD
 USE COMP_FUNCTIONS, ONLY: SHUTDOWN
 INTEGER, INTENT(IN) :: NM,IW
@@ -4027,16 +4043,19 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
             OS%N_ITEMS_DIM = 50
             ALLOCATE(OS%ITEM_INDEX(1:OS%N_ITEMS_DIM))
             ALLOCATE(OS%SURF_INDEX(1:OS%N_ITEMS_DIM))
+            ALLOCATE(OS%SAVE_FLAG(1:OS%N_ITEMS_DIM))
          ENDIF
          IF (COUNT(OS%ITEM_INDEX(1:OS%N_ITEMS)==ONE_D%BACK_INDEX)==0) THEN
             IF (OS%N_ITEMS>=OS%N_ITEMS_DIM) THEN
                CALL REALLOCATE_INTEGER_ARRAY(OS%ITEM_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
                CALL REALLOCATE_INTEGER_ARRAY(OS%SURF_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
+               CALL REALLOCATE_LOGICAL_ARRAY(OS%SAVE_FLAG ,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
                OS%N_ITEMS_DIM = OS%N_ITEMS_DIM + 50
             ENDIF
             OS%N_ITEMS = OS%N_ITEMS + 1
             OS%ITEM_INDEX(OS%N_ITEMS) = ONE_D%BACK_INDEX
             OS%SURF_INDEX(OS%N_ITEMS) = ONE_D%BACK_SURF
+            OS%SAVE_FLAG(OS%N_ITEMS)  = .TRUE.
          ENDIF
       ENDIF
       EXIT FIND_BACK_WALL_CELL
@@ -4215,7 +4234,7 @@ END SUBROUTINE FIND_WALL_BACK_INDEX
 SUBROUTINE FIND_THIN_WALL_BACK_INDEX(NM,ITW)
 
 USE GEOMETRY_FUNCTIONS, ONLY: SEARCH_OTHER_MESHES
-USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_INTEGER_ARRAY
+USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_INTEGER_ARRAY,REALLOCATE_LOGICAL_ARRAY
 INTEGER, INTENT(IN) :: NM,ITW
 INTEGER :: II,JJ,KK,IC,IOR,IEC,ITW2,NOM,NN,NNN,NL,N_MATLS,IIGM,IIGP,JJGM,JJGP,KKGM,KKGP,ICM,ICP
 INTEGER, DIMENSION(MAX_MATERIALS) :: MATL_INDEX
@@ -4334,16 +4353,19 @@ SUBROUTINE FIND_THIN_WALL_BACK_INDEX(NM,ITW)
          OS%N_ITEMS_DIM = 50
          ALLOCATE(OS%ITEM_INDEX(1:OS%N_ITEMS_DIM))
          ALLOCATE(OS%SURF_INDEX(1:OS%N_ITEMS_DIM))
+         ALLOCATE(OS%SAVE_FLAG(1:OS%N_ITEMS_DIM))
       ENDIF
       IF (COUNT(OS%ITEM_INDEX(1:OS%N_ITEMS)==ONE_D%BACK_INDEX)==0) THEN
          IF (OS%N_ITEMS>=OS%N_ITEMS_DIM) THEN
             CALL REALLOCATE_INTEGER_ARRAY(OS%ITEM_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
             CALL REALLOCATE_INTEGER_ARRAY(OS%SURF_INDEX,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
+            CALL REALLOCATE_LOGICAL_ARRAY(OS%SAVE_FLAG ,1,OS%N_ITEMS_DIM,OS%N_ITEMS_DIM+50)
             OS%N_ITEMS_DIM = OS%N_ITEMS_DIM + 50
          ENDIF
          OS%N_ITEMS = OS%N_ITEMS + 1
          OS%ITEM_INDEX(OS%N_ITEMS) = ONE_D%BACK_INDEX
          OS%SURF_INDEX(OS%N_ITEMS) = ONE_D%BACK_SURF
+         OS%SAVE_FLAG(OS%N_ITEMS)  = .TRUE.
       ENDIF
       SELECT CASE(ABS(IOR))
          CASE(1) ; ONE_D%LAYER_THICKNESS(1) = OB%UNDIVIDED_INPUT_LENGTH(1)