diff --git a/Source/func.f90 b/Source/func.f90 index ce576aca3a6..24c3ce8545e 100644 --- a/Source/func.f90 +++ b/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 diff --git a/Source/init.f90 b/Source/init.f90 index a7852efcd96..45c7295465d 100644 --- a/Source/init.f90 +++ b/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_FACTORDM) 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) diff --git a/Source/main.f90 b/Source/main.f90 index 694d390ca7b..465a8a07ee6 100644 --- a/Source/main.f90 +++ b/Source/main.f90 @@ -271,9 +271,12 @@ PROGRAM FDS IF (MY_RANK==0 .AND. VERBOSE) CALL VERBOSE_PRINTOUT('Completed INITIALIZE_MESH_VARIABLES_2') -! Create arrays and communicators to exchange back wall information across mesh boundaries +! Create arrays and communicators to exchange back WALL and THIN_WALL arrays across mesh boundaries. +! In the first call to the subroutine, all the WALL cells that are HT3D need to be exchanged, but once the 3-D noding is +! done, there is no need to exchange all HT3D cells. The second call reduces the size of the exchange arrays. -CALL INITIALIZE_BACK_WALL_EXCHANGE +CALL INITIALIZE_BACK_WALL_EXCHANGE(1) +CALL INITIALIZE_BACK_WALL_EXCHANGE(2) IF (MY_RANK==0 .AND. VERBOSE) CALL VERBOSE_PRINTOUT('Completed INITIALIZE_BACK_WALL_EXCHANGE') @@ -2103,27 +2106,35 @@ END SUBROUTINE INITIALIZE_RADIATION_EXCHANGE !> \brief Bordering meshes tell their neighbors how many exposed back wall cells they expect information for. +!> \param PASS_INDEX An integer with value 1 or 2 indicating whether this is the first or second call -SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE +SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE(PASS_INDEX) -INTEGER :: NOM,IW,ITW +INTEGER, INTENT(IN) :: PASS_INDEX +INTEGER :: NOM,IW,ITW,TRUE_COUNT,II TYPE(WALL_TYPE), POINTER :: WC TYPE(THIN_WALL_TYPE), POINTER :: TW TYPE(STORAGE_TYPE), POINTER :: OS +TYPE(STORAGE_TYPE), ALLOCATABLE :: DUMMY -! Locate the back indices for WALL cells and THIN_WALL cells +IF (PASS_INDEX==1) THEN -DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL FIND_WALL_BACK_INDICES(NM) -ENDDO + ! Create a list of WALL and THIN_WALL indices needed by each mesh and store then in + ! MESHES(NM)%OMESH(NOM)%[THIN_]WALL_RECV_BUFFER%ITEM_INDEX(1:N_ITEMS) -CALL STOP_CHECK(1) + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL FIND_WALL_BACK_INDICES(NM) + ENDDO + + CALL STOP_CHECK(1) -! Adjust the thickness and internal noding of HT3D surfaces + ! Adjust the thickness and internal noding of HT3D surfaces -DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL ADJUST_HT3D_WALL_CELLS(NM) -ENDDO + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL ADJUST_HT3D_WALL_CELLS(NM) + ENDDO + +ENDIF ! Current mesh sends to neighboring meshes the number of WALL and THIN_WALL cells that it expects to be SENT @@ -2137,9 +2148,13 @@ SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE DO NOM=1,NMESHES IF (NM==NOM) CYCLE OS => MESHES(NM)%OMESH(NOM)%WALL_SEND_BUFFER + IF (ALLOCATED(OS%ITEM_INDEX)) DEALLOCATE(OS%ITEM_INDEX) + IF (ALLOCATED(OS%SURF_INDEX)) DEALLOCATE(OS%SURF_INDEX) IF (OS%N_ITEMS>0) ALLOCATE(OS%ITEM_INDEX(OS%N_ITEMS_DIM)) IF (OS%N_ITEMS>0) ALLOCATE(OS%SURF_INDEX(OS%N_ITEMS_DIM)) OS => MESHES(NM)%OMESH(NOM)%THIN_WALL_SEND_BUFFER + IF (ALLOCATED(OS%ITEM_INDEX)) DEALLOCATE(OS%ITEM_INDEX) + IF (ALLOCATED(OS%SURF_INDEX)) DEALLOCATE(OS%SURF_INDEX) IF (OS%N_ITEMS>0) ALLOCATE(OS%ITEM_INDEX(OS%N_ITEMS_DIM)) IF (OS%N_ITEMS>0) ALLOCATE(OS%SURF_INDEX(OS%N_ITEMS_DIM)) ENDDO @@ -2151,27 +2166,31 @@ SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE CALL POST_RECEIVES(9) CALL MESH_EXCHANGE(9) -! Set up storage arrays for packing WALL and THIN_WALL variables during a RESTART. +IF (PASS_INDEX==1) THEN -DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - M => MESHES(NM) - OS => M%WALL_STORAGE - DO IW=1,M%N_WALL_CELLS - WC => M%WALL(IW) - OS%N_REALS_DIM = MAX(OS%N_REALS_DIM,WC%N_REALS) - OS%N_INTEGERS_DIM = MAX(OS%N_INTEGERS_DIM,WC%N_INTEGERS) - OS%N_LOGICALS_DIM = MAX(OS%N_LOGICALS_DIM,WC%N_LOGICALS) - ENDDO - DO ITW=1,M%N_THIN_WALL_CELLS - TW => M%THIN_WALL(ITW) - OS%N_REALS_DIM = MAX(OS%N_REALS_DIM,TW%N_REALS) - OS%N_INTEGERS_DIM = MAX(OS%N_INTEGERS_DIM,TW%N_INTEGERS) - OS%N_LOGICALS_DIM = MAX(OS%N_LOGICALS_DIM,TW%N_LOGICALS) + ! Set up storage arrays for packing WALL and THIN_WALL variables during a RESTART. + + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + M => MESHES(NM) + OS => M%WALL_STORAGE + DO IW=1,M%N_WALL_CELLS + WC => M%WALL(IW) + OS%N_REALS_DIM = MAX(OS%N_REALS_DIM,WC%N_REALS) + OS%N_INTEGERS_DIM = MAX(OS%N_INTEGERS_DIM,WC%N_INTEGERS) + OS%N_LOGICALS_DIM = MAX(OS%N_LOGICALS_DIM,WC%N_LOGICALS) + ENDDO + DO ITW=1,M%N_THIN_WALL_CELLS + TW => M%THIN_WALL(ITW) + OS%N_REALS_DIM = MAX(OS%N_REALS_DIM,TW%N_REALS) + OS%N_INTEGERS_DIM = MAX(OS%N_INTEGERS_DIM,TW%N_INTEGERS) + OS%N_LOGICALS_DIM = MAX(OS%N_LOGICALS_DIM,TW%N_LOGICALS) + ENDDO + ALLOCATE(OS%REALS(OS%N_REALS_DIM)) + ALLOCATE(OS%INTEGERS(OS%N_INTEGERS_DIM)) + ALLOCATE(OS%LOGICALS(OS%N_LOGICALS_DIM)) ENDDO - ALLOCATE(OS%REALS(OS%N_REALS_DIM)) - ALLOCATE(OS%INTEGERS(OS%N_INTEGERS_DIM)) - ALLOCATE(OS%LOGICALS(OS%N_LOGICALS_DIM)) -ENDDO + +ENDIF ! Allocate arrays to hold real, integer and logical variables for the WALL_SEND_BUFFER @@ -2188,6 +2207,9 @@ SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE OS%N_INTEGERS_DIM = OS%N_INTEGERS_DIM + WC%N_INTEGERS OS%N_LOGICALS_DIM = OS%N_LOGICALS_DIM + WC%N_LOGICALS ENDDO + IF (ALLOCATED(OS%REALS)) DEALLOCATE(OS%REALS) + IF (ALLOCATED(OS%INTEGERS)) DEALLOCATE(OS%INTEGERS) + IF (ALLOCATED(OS%LOGICALS)) DEALLOCATE(OS%LOGICALS) ALLOCATE(OS%REALS(OS%N_REALS_DIM)) ALLOCATE(OS%INTEGERS(OS%N_INTEGERS_DIM)) ALLOCATE(OS%LOGICALS(OS%N_LOGICALS_DIM)) @@ -2209,6 +2231,9 @@ SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE OS%N_INTEGERS_DIM = OS%N_INTEGERS_DIM + TW%N_INTEGERS OS%N_LOGICALS_DIM = OS%N_LOGICALS_DIM + TW%N_LOGICALS ENDDO + IF (ALLOCATED(OS%REALS)) DEALLOCATE(OS%REALS) + IF (ALLOCATED(OS%INTEGERS)) DEALLOCATE(OS%INTEGERS) + IF (ALLOCATED(OS%LOGICALS)) DEALLOCATE(OS%LOGICALS) ALLOCATE(OS%REALS(OS%N_REALS_DIM)) ALLOCATE(OS%INTEGERS(OS%N_INTEGERS_DIM)) ALLOCATE(OS%LOGICALS(OS%N_LOGICALS_DIM)) @@ -2239,6 +2264,9 @@ SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE OS => M%OMESH(NOM)%WALL_RECV_BUFFER IF (OS%N_ITEMS==0) CYCLE MESH_LOOP_2B IF (.NOT.ALLOCATED(MESHES(NOM)%WALL)) ALLOCATE(MESHES(NOM)%WALL(0:MESHES(NOM)%N_WALL_CELLS_DIM)) + IF (ALLOCATED(OS%REALS)) DEALLOCATE(OS%REALS) + IF (ALLOCATED(OS%INTEGERS)) DEALLOCATE(OS%INTEGERS) + IF (ALLOCATED(OS%LOGICALS)) DEALLOCATE(OS%LOGICALS) ALLOCATE(OS%REALS(OS%N_REALS_DIM)) ALLOCATE(OS%INTEGERS(OS%N_INTEGERS_DIM)) ALLOCATE(OS%LOGICALS(OS%N_LOGICALS_DIM)) @@ -2267,6 +2295,9 @@ SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE OS => M%OMESH(NOM)%THIN_WALL_RECV_BUFFER IF (OS%N_ITEMS==0) CYCLE MESH_LOOP_4B IF (.NOT.ALLOCATED(MESHES(NOM)%THIN_WALL)) ALLOCATE(MESHES(NOM)%THIN_WALL(0:MESHES(NOM)%N_THIN_WALL_CELLS_DIM)) + IF (ALLOCATED(OS%REALS)) DEALLOCATE(OS%REALS) + IF (ALLOCATED(OS%INTEGERS)) DEALLOCATE(OS%INTEGERS) + IF (ALLOCATED(OS%LOGICALS)) DEALLOCATE(OS%LOGICALS) ALLOCATE(OS%REALS(OS%N_REALS_DIM)) ALLOCATE(OS%INTEGERS(OS%N_INTEGERS_DIM)) ALLOCATE(OS%LOGICALS(OS%N_LOGICALS_DIM)) @@ -2282,18 +2313,59 @@ SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE ! Set up persistent SEND and RECV calls for MPI communication of WALL and THIN_WALL buffer arrays +IF (PASS_INDEX==2) THEN ! Free the previously set permanent send/receive + DO I=1,N_REQ6 ; CALL MPI_REQUEST_FREE(REQ6(I) ,IERR) ; ENDDO + N_REQ6 = 0 +ENDIF + CALL POST_RECEIVES(10) CALL MESH_EXCHANGE(10) -! Exchange WALL and THIN_WALL cells +IF (PASS_INDEX==1) THEN -CALL MESH_EXCHANGE(6) + ! Exchange WALL and THIN_WALL cells -! Initialize 3-D solid interpolation arrays + CALL MESH_EXCHANGE(6) -DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL INITIALIZE_HT3D_WALL_CELLS(NM) -ENDDO + ! Initialize 3-D solid interpolation arrays + + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL INITIALIZE_HT3D_WALL_CELLS(NM) + ENDDO + + ! Reduce the size of the send and receive buffer by including only those wall cells needed by other meshes. + ! The key parameter is M%OM%WALL_RECV_BUFFER%SAVE_FLAG(1:N_ITEMS). If T, include the wall cell on the short list. + + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + M => MESHES(NM) + DO NOM=1,NMESHES + IF (NM==NOM) CYCLE + OS => M%OMESH(NOM)%WALL_RECV_BUFFER + IF (OS%N_ITEMS==0) CYCLE + IF (ALLOCATED(DUMMY)) DEALLOCATE(DUMMY) ; ALLOCATE(DUMMY) + DUMMY%N_ITEMS = OS%N_ITEMS + ALLOCATE(DUMMY%ITEM_INDEX(OS%N_ITEMS)) ; DUMMY%ITEM_INDEX(1:OS%N_ITEMS) = OS%ITEM_INDEX(1:OS%N_ITEMS) + ALLOCATE(DUMMY%SURF_INDEX(OS%N_ITEMS)) ; DUMMY%SURF_INDEX(1:OS%N_ITEMS) = OS%SURF_INDEX(1:OS%N_ITEMS) + ALLOCATE(DUMMY%SAVE_FLAG(OS%N_ITEMS)) ; DUMMY%SAVE_FLAG(1:OS%N_ITEMS) = OS%SAVE_FLAG(1:OS%N_ITEMS) + TRUE_COUNT = COUNT(OS%SAVE_FLAG(1:OS%N_ITEMS)) + DEALLOCATE(OS%ITEM_INDEX) ; ALLOCATE(OS%ITEM_INDEX(TRUE_COUNT)) + DEALLOCATE(OS%SURF_INDEX) ; ALLOCATE(OS%SURF_INDEX(TRUE_COUNT)) + DEALLOCATE(OS%SAVE_FLAG) ; ALLOCATE(OS%SAVE_FLAG(TRUE_COUNT)) + OS%N_ITEMS = TRUE_COUNT + OS%N_ITEMS_DIM = TRUE_COUNT + II = 0 + DO I=1,DUMMY%N_ITEMS + IF (DUMMY%SAVE_FLAG(I)) THEN + II = II + 1 + OS%ITEM_INDEX(II) = DUMMY%ITEM_INDEX(I) + OS%SURF_INDEX(II) = DUMMY%SURF_INDEX(I) + OS%SAVE_FLAG(II) = DUMMY%SAVE_FLAG(I) + ENDIF + ENDDO + ENDDO + ENDDO + +ENDIF END SUBROUTINE INITIALIZE_BACK_WALL_EXCHANGE diff --git a/Source/type.f90 b/Source/type.f90 index 3a973ec5c80..e2148bd8ab9 100644 --- a/Source/type.f90 +++ b/Source/type.f90 @@ -28,6 +28,7 @@ MODULE TYPES INTEGER :: N_ITEMS_DIM=0 !< Dimension of 1-D arrays ITEM_INDEX and SURF_INDEX INTEGER, ALLOCATABLE, DIMENSION(:) :: ITEM_INDEX !< Array of indices of the WALL cells, CFACEs, or PARTICLEs INTEGER, ALLOCATABLE, DIMENSION(:) :: SURF_INDEX !< Array of SURF indices of the WALL cells, CFACEs, or PARTICLEs + LOGICAL, ALLOCATABLE, DIMENSION(:) :: SAVE_FLAG !< Array of logical parameters to indicate whether the entry is needed INTEGER :: N_REALS_DIM=0 !< Dimension of the array REALS INTEGER :: N_INTEGERS_DIM=0 !< Dimension of the array INTEGERS INTEGER :: N_LOGICALS_DIM=0 !< Dimension of the array LOGICALS