Skip to content

FDS Source: Reduce size of WALL_SEND_BUFFER #14816

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
mcgratta merged 1 commit into from
Jul 2, 2025
Merged

FDS Source: Reduce size of WALL_SEND_BUFFER #14816

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 18 additions & 0 deletions Source/func.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
46 changes: 34 additions & 12 deletions Source/init.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
Loading