Merge pull request #14330 from drjfloyd/master

FDS Source: Fix allocation error Issue #14321

Author: drjfloyd

Source/func.f90

@@ -3459,7 +3459,6 @@ SUBROUTINE ALLOCATE_BOUNDARY_ONE_D_ARRAYS
 ONE_D%SURF_INDEX  = SURF_INDEX
 ONE_D%N_CELLS_MAX = SF%N_CELLS_MAX
 ONE_D%N_CELLS_INI = SF%N_CELLS_INI
-IF (SURFACE(SURF_INDEX)%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED) ONE_D%N_CELLS_OLD = SF%N_CELLS_MAX
 ONE_D%N_LAYERS    = SF%N_LAYERS
 ONE_D%N_MATL      = SF%N_MATL
 ONE_D%N_LPC       = SF%N_LPC
@@ -4001,7 +4000,7 @@ SUBROUTINE PACK_BOUNDARY_ONE_D(NM,IC,RC,LC,OS,OD_INDEX,UNPACK_IT,COUNT_ONLY,CHEC
 IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),ONE_D%SURF_INDEX,UNPACK_IT)
 IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),ONE_D%N_CELLS_MAX,UNPACK_IT)
 IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),ONE_D%N_CELLS_INI,UNPACK_IT)
-IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),ONE_D%N_CELLS_OLD,UNPACK_IT)
+IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),ONE_D%N_CELLS_MAX,UNPACK_IT) !OLD
 IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),ONE_D%N_LAYERS,UNPACK_IT)
 IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),ONE_D%N_MATL,UNPACK_IT)
 IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),ONE_D%N_LPC,UNPACK_IT)
@@ -4028,7 +4027,7 @@ SUBROUTINE PACK_BOUNDARY_ONE_D(NM,IC,RC,LC,OS,OD_INDEX,UNPACK_IT,COUNT_ONLY,CHEC
 RC=RC+1                             ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC)   ,ONE_D%LAYER_DIVIDE_DEPTH        , UNPACK_IT)
 I1=RC+1 ; RC=I1+ONE_D%N_MATL-1      ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%M_DOT_S_PP(1:RC-I1+1)  , UNPACK_IT)
 I1=RC+1 ; RC=I1+ONE_D%N_CELLS_MAX   ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%X(0:RC-I1)             , UNPACK_IT)
-I1=RC+1 ; RC=I1+ONE_D%N_CELLS_OLD-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%DX_OLD(1:RC-I1+1)      , UNPACK_IT)
+I1=RC+1 ; RC=I1+ONE_D%N_CELLS_MAX-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%DX_OLD(1:RC-I1+1)      , UNPACK_IT)
 I1=RC+1 ; RC=I1+ONE_D%N_CELLS_MAX+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%TMP(0:RC-I1)           , UNPACK_IT)
 I1=RC+1 ; RC=I1+ONE_D%N_CELLS_MAX+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%DELTA_TMP(0:RC-I1)     , UNPACK_IT)
 I1=RC+1 ; RC=I1+ONE_D%N_CELLS_MAX-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%RHO_C_S(1:RC-I1+1)     , UNPACK_IT)
@@ -4072,7 +4071,7 @@ SUBROUTINE REALLOCATE_BOUNDARY_ONE_D(ONE_D)
 IF (ALLOCATED(ONE_D%MATL_INDEX)) DEALLOCATE(ONE_D%MATL_INDEX)                 ; ALLOCATE(ONE_D%MATL_INDEX(ONE_D%N_MATL))
 IF (ALLOCATED(ONE_D%M_DOT_S_PP)) DEALLOCATE(ONE_D%M_DOT_S_PP) ; ALLOCATE(ONE_D%M_DOT_S_PP(ONE_D%N_MATL)) ; ONE_D%M_DOT_S_PP=0._EB
 IF (ALLOCATED(ONE_D%X)) DEALLOCATE(ONE_D%X)                                   ; ALLOCATE(ONE_D%X(0:ONE_D%N_CELLS_MAX))
-IF (ALLOCATED(ONE_D%DX_OLD)) DEALLOCATE(ONE_D%DX_OLD)                         ; ALLOCATE(ONE_D%DX_OLD(ONE_D%N_CELLS_OLD))
+IF (ALLOCATED(ONE_D%DX_OLD)) DEALLOCATE(ONE_D%DX_OLD)                         ; ALLOCATE(ONE_D%DX_OLD(ONE_D%N_CELLS_MAX))
 IF (ALLOCATED(ONE_D%TMP)) DEALLOCATE(ONE_D%TMP)                               ; ALLOCATE(ONE_D%TMP(0:ONE_D%N_CELLS_MAX+1))
 IF (ALLOCATED(ONE_D%DELTA_TMP)) DEALLOCATE(ONE_D%DELTA_TMP)                   ; ALLOCATE(ONE_D%DELTA_TMP(0:ONE_D%N_CELLS_MAX+1))
 IF (ALLOCATED(ONE_D%LAYER_THICKNESS)) DEALLOCATE(ONE_D%LAYER_THICKNESS)       ; ALLOCATE(ONE_D%LAYER_THICKNESS(ONE_D%N_LAYERS))
@@ -4124,7 +4123,7 @@ SUBROUTINE INITIALIZE_BOUNDARY_ONE_D(NM,OD_INDEX,SURF_INDEX)
 ONE_D%M_DOT_S_PP = 0._EB
 ONE_D%X=0._EB ; ONE_D%X(0:ONE_D%N_CELLS_INI) = SF%X_S(0:ONE_D%N_CELLS_INI)
 ONE_D%DX_OLD=0._EB
-DO I=1,MIN(ONE_D%N_CELLS_OLD,ONE_D%N_CELLS_INI)
+DO I=1,MIN(ONE_D%N_CELLS_MAX,ONE_D%N_CELLS_INI)
    ONE_D%DX_OLD(I) = ONE_D%X(I)-ONE_D%X(I-1)
 ENDDO
 IF (ALLOCATED(ONE_D%LAYER_THICKNESS_OLD)) ONE_D%LAYER_THICKNESS_OLD(1:ONE_D%N_LAYERS) = SF%LAYER_THICKNESS(1:SF%N_LAYERS)

Source/init.f90

@@ -1671,7 +1671,6 @@ SUBROUTINE REALLOCATE_ONE_D_ARRAYS(NM,WALL_CELL,THIN_WALL_CELL)
 TYPE(MATERIAL_TYPE), POINTER :: ML
 REAL(EB), ALLOCATABLE, DIMENSION(:) :: X_S_OLD
 LOGICAL, ALLOCATABLE, DIMENSION(:) :: REMESH_LAYER
-LOGICAL :: SET_N_CELLS_OLD
 TYPE(WALL_TYPE), POINTER :: WC
 TYPE(THIN_WALL_TYPE), POINTER :: TW
 TYPE(SURFACE_TYPE), POINTER :: SF
@@ -1730,7 +1729,6 @@ SUBROUTINE REALLOCATE_ONE_D_ARRAYS(NM,WALL_CELL,THIN_WALL_CELL)
 ONE_D%N_CELLS_INI = 0
 ONE_D%N_CELLS_MAX = 0
 LAYER_DENSITY = 0._EB
-SET_N_CELLS_OLD = .FALSE.
 
 LAYER_LOOP: DO NL=1,ONE_D%N_LAYERS
 
@@ -1749,7 +1747,6 @@ SUBROUTINE REALLOCATE_ONE_D_ARRAYS(NM,WALL_CELL,THIN_WALL_CELL)
    MIN_DENSITY = LAYER_DENSITY(NL)
    MATL_REAC_LOOP: DO N=1,ONE_D%N_MATL
       IF (MATERIAL(ONE_D%MATL_INDEX(N))%N_REACTIONS > 0) THEN ! Only compute a swell ratio if there is a reacting material
-         SET_N_CELLS_OLD = .TRUE.
          DO NN=1,ONE_D%N_MATL
             IF (MATERIAL(ONE_D%MATL_INDEX(NN))%ALLOW_SWELLING) &
                MIN_DENSITY = MIN(MIN_DENSITY,MATERIAL(ONE_D%MATL_INDEX(NN))%RHO_S)
@@ -1776,7 +1773,6 @@ SUBROUTINE REALLOCATE_ONE_D_ARRAYS(NM,WALL_CELL,THIN_WALL_CELL)
 ENDDO LAYER_LOOP
 
 NWP_MAX = MAX(NWP_MAX,ONE_D%N_CELLS_MAX)
-IF (SET_N_CELLS_OLD) ONE_D%N_CELLS_OLD = ONE_D%N_CELLS_MAX
 
 ALLOCATE(LAYER_INDEX(0:ONE_D%N_CELLS_MAX+1))
 NL = 1
@@ -1809,8 +1805,8 @@ SUBROUTINE REALLOCATE_ONE_D_ARRAYS(NM,WALL_CELL,THIN_WALL_CELL)
                                ONE_D%STRETCH_FACTOR,REMESH_LAYER,ONE_D%X,X_S_OLD,ONE_D%LAYER_THICKNESS(1:ONE_D%N_LAYERS))
 DEALLOCATE(X_S_OLD)
 
-IF (ALLOCATED(ONE_D%DX_OLD)) DEALLOCATE(ONE_D%DX_OLD) ; ALLOCATE(ONE_D%DX_OLD(ONE_D%N_CELLS_OLD)) ; ONE_D%DX_OLD=0._EB
-DO II=1,MIN(ONE_D%N_CELLS_OLD,ONE_D%N_CELLS_INI)
+IF (ALLOCATED(ONE_D%DX_OLD)) DEALLOCATE(ONE_D%DX_OLD) ; ALLOCATE(ONE_D%DX_OLD(ONE_D%N_CELLS_MAX)) ; ONE_D%DX_OLD=0._EB
+DO II=1,MIN(ONE_D%N_CELLS_MAX,ONE_D%N_CELLS_INI)
    ONE_D%DX_OLD(II) = ONE_D%X(II) - ONE_D%X(II-1)
 ENDDO
 

Source/part.f90

@@ -4745,7 +4745,6 @@ SUBROUTINE ADD_TO_PARTICLE_SEND_BUFFER
    ENDIF
 
    OS%N_ITEMS = OS%N_ITEMS + 1
-
    CALL PACK_PARTICLE(NM,OS,LP,LP%CLASS_INDEX,OS%N_REALS,OS%N_INTEGERS,OS%N_LOGICALS,UNPACK_IT=.FALSE.,COUNT_ONLY=.FALSE.,&
                       CHECK_BOUNDS=.FALSE.)
 

Source/type.f90

@@ -213,7 +213,6 @@ MODULE TYPES
    INTEGER :: SURF_INDEX=-1     !< SURFACE index
    INTEGER :: N_CELLS_MAX=0     !< Maximum number of interior cells
    INTEGER :: N_CELLS_INI=0     !< Initial number of interior cells
-   INTEGER :: N_CELLS_OLD=1     !< Maximum number of interior cells for DX_OLD
    INTEGER :: N_LAYERS=0        !< Number of material layers
    INTEGER :: N_MATL=0          !< Number of materials
    INTEGER :: N_LPC=0           !< Number of Lagrangian Particle Classes