Skip to content

Commit 1796339

Browse files
authored
Merge pull request #14041 from mcgratta/pyro_depth
FDS Source: Fix problem with BURN_AWAY and VARIABLE_THICKNESS at boundaries
2 parents 276ab19 + 9fdef86 commit 1796339

File tree

7 files changed

+152
-121
lines changed

7 files changed

+152
-121
lines changed

Source/data.f90

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1509,6 +1509,10 @@ SUBROUTINE DEFINE_OUTPUT_QUANTITIES
15091509
OUTPUT_QUANTITY(-47)%INSIDE_SOLID = .TRUE.
15101510
OUTPUT_QUANTITY(-47)%BNDF_APPROPRIATE = .FALSE.
15111511

1512+
OUTPUT_QUANTITY(-48)%NAME= 'PYROLYSIS DEPTH'
1513+
OUTPUT_QUANTITY(-48)%UNITS= 'm'
1514+
OUTPUT_QUANTITY(-48)%SHORT_NAME= 'p-depth'
1515+
15121516
OUTPUT_QUANTITY(-51)%NAME = 'ENTHALPY FLUX WALL'
15131517
OUTPUT_QUANTITY(-51)%UNITS= 'kW/m2'
15141518
OUTPUT_QUANTITY(-51)%SHORT_NAME = 'hf'

Source/dump.f90

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8929,6 +8929,13 @@ REAL(EB) FUNCTION SOLID_PHASE_OUTPUT(INDX,Y_INDEX,Z_INDEX,PART_INDEX,OPT_WALL_IN
89298929
SOLID_PHASE_OUTPUT = 0.5_EB*( ONE_D%X(I_DEPTH-1) + ONE_D%X(I_DEPTH) )
89308930
ENDIF
89318931

8932+
CASE(48) ! PYROLYSIS DEPTH
8933+
IF (SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN
8934+
SOLID_PHASE_OUTPUT = ONE_D%PYROLYSIS_DEPTH
8935+
ELSE
8936+
SOLID_PHASE_OUTPUT = 0._EB
8937+
ENDIF
8938+
89328939
CASE(51) ! ENTHALPY FLUX WALL
89338940
ZZ_GET(1:N_TRACKED_SPECIES) = B1%ZZ_F(1:N_TRACKED_SPECIES)
89348941
CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,B1%TMP_F)
@@ -9793,7 +9800,7 @@ SUBROUTINE DUMP_PROF(T,NM)
97939800
IF (NWP==0) CYCLE PROF_LOOP
97949801
CALL GET_WALL_NODE_WEIGHTS(NWP,ONE_D%N_LAYERS,ONE_D%N_LAYER_CELLS,ONE_D%LAYER_THICKNESS,SF%GEOMETRY, &
97959802
ONE_D%X(0:NWP),SF%LAYER_DIVIDE,DX_S(1:NWP),RDX_S(0:NWP+1),RDXN_S(0:NWP),DX_WGT_S(0:NWP),DXF,DXB,LAYER_INDEX,MF_FRAC,&
9796-
SF%INNER_RADIUS)
9803+
SF%INNER_RADIUS,ONE_D%PYROLYSIS_DEPTH)
97979804
ELSE
97989805
NWP = SF%N_CELLS_INI
97999806
IF (NWP==0) CYCLE PROF_LOOP

Source/func.f90

Lines changed: 48 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -659,6 +659,7 @@ MODULE COMP_OPERATORS
659659
MODULE PROCEDURE EQUATE_INTEGERS
660660
MODULE PROCEDURE EQUATE_INTEGER_VECTORS
661661
MODULE PROCEDURE EQUATE_LOGICALS
662+
MODULE PROCEDURE EQUATE_LOGICAL_VECTORS
662663
END INTERFACE
663664

664665
CONTAINS
@@ -715,6 +716,16 @@ SUBROUTINE EQUATE_LOGICALS(A,B,SWAP)
715716
ENDIF
716717
END SUBROUTINE EQUATE_LOGICALS
717718

719+
SUBROUTINE EQUATE_LOGICAL_VECTORS(A,B,SWAP)
720+
LOGICAL, INTENT(INOUT), DIMENSION(:) :: A,B
721+
LOGICAL, INTENT(IN) :: SWAP
722+
IF (SWAP) THEN
723+
B = A
724+
ELSE
725+
A = B
726+
ENDIF
727+
END SUBROUTINE EQUATE_LOGICAL_VECTORS
728+
718729
END MODULE COMP_OPERATORS
719730

720731

@@ -1786,56 +1797,39 @@ SUBROUTINE PACK_BOUNDARY_ONE_D(NM,IC,RC,LC,OS,OD_INDEX,UNPACK_IT,COUNT_ONLY)
17861797
IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC) , ONE_D%RAMP_IHS_INDEX(NL) , UNPACK_IT)
17871798
ENDDO
17881799

1789-
I1 = RC+1 ; RC = I1 + ONE_D%N_MATL - 1
1790-
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%M_DOT_S_PP(1:RC-I1+1) , UNPACK_IT)
1791-
1792-
I1 = RC+1 ; RC = I1 + ONE_D%N_CELLS_MAX
1793-
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%X(0:RC-I1) , UNPACK_IT)
1794-
1795-
I1 = RC+1 ; RC = I1 + ONE_D%N_CELLS_OLD - 1
1796-
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%DX_OLD(1:RC-I1+1) , UNPACK_IT)
1797-
1798-
I1 = RC+1 ; RC = I1 + ONE_D%N_CELLS_MAX + 1
1799-
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%TMP(0:RC-I1) , UNPACK_IT)
1800-
1801-
I1 = RC+1 ; RC = I1 + ONE_D%N_CELLS_MAX + 1
1802-
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%DELTA_TMP(0:RC-I1) , UNPACK_IT)
1803-
1804-
DO NL=1,ONE_D%N_LAYERS
1805-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%LAYER_THICKNESS(NL) , UNPACK_IT)
1806-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%LAYER_THICKNESS_OLD(NL) , UNPACK_IT)
1807-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%MINIMUM_LAYER_THICKNESS(NL) , UNPACK_IT)
1808-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%MIN_DIFFUSIVITY(NL) , UNPACK_IT)
1809-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%DDSUM(NL) , UNPACK_IT)
1810-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%SMALLEST_CELL_SIZE(NL) , UNPACK_IT)
1811-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%STRETCH_FACTOR(NL) , UNPACK_IT)
1812-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%HEAT_SOURCE(NL) , UNPACK_IT)
1813-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%CELL_SIZE_FACTOR(NL) , UNPACK_IT)
1814-
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) , ONE_D%CELL_SIZE(NL) , UNPACK_IT)
1815-
LC=LC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%LOGICALS(LC) , ONE_D%HT3D_LAYER(NL) , UNPACK_IT)
1800+
DO NN=1,ONE_D%N_MATL
1801+
IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC) , ONE_D%MATL_INDEX(NN) , UNPACK_IT)
18161802
ENDDO
18171803

1818-
LC=LC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%LOGICALS(LC) , ONE_D%INTERNAL_RADIATION , UNPACK_IT)
1819-
1820-
I1 = RC+1 ; RC = I1 + ONE_D%N_CELLS_MAX - 1
1821-
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%RHO_C_S(1:RC-I1+1) , UNPACK_IT)
1822-
1823-
I1 = RC+1 ; RC = I1 + ONE_D%N_CELLS_MAX + 1
1824-
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%K_S(0:RC-I1) , UNPACK_IT)
1825-
1826-
I1 = RC+1 ; RC = I1 + ONE_D%N_LPC - 1
1827-
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%PART_MASS(1:RC-I1+1) , UNPACK_IT)
1828-
1829-
I1 = RC+1 ; RC = I1 + ONE_D%N_LPC - 1
1830-
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%PART_ENTHALPY(1:RC-I1+1) , UNPACK_IT)
1804+
RC=RC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(RC) ,ONE_D%PYROLYSIS_DEPTH , UNPACK_IT)
1805+
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)
1806+
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)
1807+
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)
1808+
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)
1809+
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)
1810+
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)
1811+
I1=RC+1 ; RC=I1+ONE_D%N_CELLS_MAX+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%K_S(0:RC-I1) , UNPACK_IT)
1812+
1813+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%LAYER_THICKNESS(1:RC-I1+1) , UNPACK_IT)
1814+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%LAYER_THICKNESS_OLD(1:RC-I1+1), UNPACK_IT)
1815+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%MIN_LAYER_THICKNESS(1:RC-I1+1), UNPACK_IT)
1816+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%MIN_DIFFUSIVITY(1:RC-I1+1) , UNPACK_IT)
1817+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%DDSUM(1:RC-I1+1) , UNPACK_IT)
1818+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%SMALLEST_CELL_SIZE(1:RC-I1+1) , UNPACK_IT)
1819+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%STRETCH_FACTOR(1:RC-I1+1) , UNPACK_IT)
1820+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%HEAT_SOURCE(1:RC-I1+1) , UNPACK_IT)
1821+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%CELL_SIZE_FACTOR(1:RC-I1+1) , UNPACK_IT)
1822+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%CELL_SIZE(1:RC-I1+1) , UNPACK_IT)
1823+
I1=RC+1 ; RC=I1+ONE_D%N_LPC-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%PART_MASS(1:RC-I1+1) , UNPACK_IT)
1824+
I1=RC+1 ; RC=I1+ONE_D%N_LPC-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC),ONE_D%PART_ENTHALPY(1:RC-I1+1) , UNPACK_IT)
1825+
1826+
LC=LC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%LOGICALS(LC) , ONE_D%INTERNAL_RADIATION , UNPACK_IT)
1827+
I1=LC+1 ; LC=I1+ONE_D%N_LAYERS-1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%LOGICALS(I1:LC) , ONE_D%HT3D_LAYER(1:LC-I1+1) , UNPACK_IT)
18311828

18321829
DO NN=1,ONE_D%N_MATL
1833-
I1 = RC+1 ; RC = I1 + ONE_D%N_LAYERS - 1
1830+
I1=RC+1 ; RC=I1+ONE_D%N_LAYERS-1
18341831
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%MATL_COMP(NN)%MASS_FRACTION(1:RC-I1+1) , UNPACK_IT)
1835-
ENDDO
1836-
1837-
DO NN=1,ONE_D%N_MATL
1838-
I1 = RC+1 ; RC = I1 + (ONE_D%N_CELLS_MAX+2) - 1
1832+
I1=RC+1 ; RC=I1+ONE_D%N_CELLS_MAX+1
18391833
IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%REALS(I1:RC) , ONE_D%MATL_COMP(NN)%RHO(0:RC-I1) , UNPACK_IT)
18401834
ENDDO
18411835

@@ -1860,8 +1854,8 @@ SUBROUTINE REALLOCATE_BOUNDARY_ONE_D(ONE_D)
18601854
IF (ALLOCATED(ONE_D%LAYER_THICKNESS)) DEALLOCATE(ONE_D%LAYER_THICKNESS) ; ALLOCATE(ONE_D%LAYER_THICKNESS(ONE_D%N_LAYERS))
18611855
IF (ALLOCATED(ONE_D%LAYER_THICKNESS_OLD)) DEALLOCATE(ONE_D%LAYER_THICKNESS_OLD)
18621856
ALLOCATE(ONE_D%LAYER_THICKNESS_OLD(ONE_D%N_LAYERS))
1863-
IF (ALLOCATED(ONE_D%MINIMUM_LAYER_THICKNESS)) DEALLOCATE(ONE_D%MINIMUM_LAYER_THICKNESS)
1864-
ALLOCATE(ONE_D%MINIMUM_LAYER_THICKNESS(ONE_D%N_LAYERS))
1857+
IF (ALLOCATED(ONE_D%MIN_LAYER_THICKNESS)) DEALLOCATE(ONE_D%MIN_LAYER_THICKNESS)
1858+
ALLOCATE(ONE_D%MIN_LAYER_THICKNESS(ONE_D%N_LAYERS))
18651859
IF (ALLOCATED(ONE_D%HT3D_LAYER)) DEALLOCATE(ONE_D%HT3D_LAYER) ; ALLOCATE(ONE_D%HT3D_LAYER(ONE_D%N_LAYERS))
18661860
IF (ALLOCATED(ONE_D%MIN_DIFFUSIVITY)) DEALLOCATE(ONE_D%MIN_DIFFUSIVITY) ; ALLOCATE(ONE_D%MIN_DIFFUSIVITY(ONE_D%N_LAYERS))
18671861
IF (ALLOCATED(ONE_D%RHO_C_S)) DEALLOCATE(ONE_D%RHO_C_S) ; ALLOCATE(ONE_D%RHO_C_S(ONE_D%N_CELLS_MAX))
@@ -1936,7 +1930,7 @@ SUBROUTINE INITIALIZE_BOUNDARY_ONE_D(NM,OD_INDEX,SURF_INDEX)
19361930
ENDIF
19371931
ONE_D%DELTA_TMP = 0._EB
19381932
ONE_D%LAYER_THICKNESS(1:ONE_D%N_LAYERS) = SF%LAYER_THICKNESS(1:SF%N_LAYERS)
1939-
ONE_D%MINIMUM_LAYER_THICKNESS(1:ONE_D%N_LAYERS) = SF%MINIMUM_LAYER_THICKNESS(1:SF%N_LAYERS)
1933+
ONE_D%MIN_LAYER_THICKNESS(1:ONE_D%N_LAYERS) = SF%MIN_LAYER_THICKNESS(1:SF%N_LAYERS)
19401934
ONE_D%HT3D_LAYER(1:ONE_D%N_LAYERS) = SF%HT3D_LAYER(1:SF%N_LAYERS)
19411935
ONE_D%MIN_DIFFUSIVITY(1:ONE_D%N_LAYERS) = SF%MIN_DIFFUSIVITY(1:SF%N_LAYERS)
19421936
ONE_D%STRETCH_FACTOR(1:ONE_D%N_LAYERS) = SF%STRETCH_FACTOR(1:SF%N_LAYERS)
@@ -2855,20 +2849,21 @@ END SUBROUTINE GET_WALL_NODE_COORDINATES
28552849
!> \param LAYER_INDEX Array of indices indicating the layer to which each interior cell belongs
28562850
!> \param MF_FRAC Array containing the fraction of each cells mass that is assigned to the front surface
28572851
!> \param INNER_RADIUS Inner radius of hollow cylinder or sphere (m)
2852+
!> \param X_DIVIDE Depth at which pyrolyzates move to back side (m)
28582853

28592854
SUBROUTINE GET_WALL_NODE_WEIGHTS(N_CELLS,N_LAYERS,N_LAYER_CELLS, &
2860-
LAYER_THICKNESS,GEOMETRY,X_S,LAYER_DIVIDE,DX,RDX,RDXN,DX_WGT,DXF,DXB,LAYER_INDEX,MF_FRAC,INNER_RADIUS)
2855+
LAYER_THICKNESS,GEOMETRY,X_S,LAYER_DIVIDE,DX,RDX,RDXN,DX_WGT,DXF,DXB,LAYER_INDEX,MF_FRAC,INNER_RADIUS,X_DIVIDE)
28612856

28622857
! Get the wall internal coordinates
28632858

28642859
INTEGER, INTENT(IN) :: N_CELLS, N_LAYERS, N_LAYER_CELLS(N_LAYERS),GEOMETRY
28652860
REAL(EB), INTENT(IN) :: X_S(0:N_CELLS),LAYER_THICKNESS(1:N_LAYERS),LAYER_DIVIDE,INNER_RADIUS
28662861
INTEGER, INTENT(OUT) :: LAYER_INDEX(0:N_CELLS+1)
28672862
REAL(EB), INTENT(OUT) :: DX(1:N_CELLS),RDX(0:N_CELLS+1),RDXN(0:N_CELLS),DX_WGT(0:N_CELLS),DXF,DXB, &
2868-
MF_FRAC(1:N_CELLS)
2863+
MF_FRAC(1:N_CELLS),X_DIVIDE
28692864

28702865
INTEGER :: I, II, NL, I_GRAD
2871-
REAL(EB) :: R, THICKNESS, X_DIVIDE
2866+
REAL(EB) :: R, THICKNESS
28722867

28732868
THICKNESS = SUM(LAYER_THICKNESS)
28742869

@@ -2955,6 +2950,7 @@ SUBROUTINE GET_WALL_NODE_WEIGHTS(N_CELLS,N_LAYERS,N_LAYER_CELLS, &
29552950
IF (LAYER_DIVIDE >= REAL(N_LAYERS,EB)) THEN
29562951

29572952
MF_FRAC = 1._EB
2953+
X_DIVIDE = THICKNESS
29582954

29592955
ELSE
29602956

@@ -6172,4 +6168,4 @@ SUBROUTINE ACCUMULATE_STRING(STRING_SIZE,MYSTR,ACCSTR,ACCSTR_T_LEN,ACCSTR_USE_LE
61726168
END SUBROUTINE ACCUMULATE_STRING
61736169

61746170
END MODULE MISC_FUNCTIONS
6175-
6171+

Source/init.f90

Lines changed: 47 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1652,7 +1652,7 @@ END SUBROUTINE ADJUST_HT3D_WALL_CELLS
16521652

16531653
SUBROUTINE REALLOCATE_ONE_D_ARRAYS(NM,WALL_CELL,THIN_WALL_CELL)
16541654

1655-
USE GEOMETRY_FUNCTIONS, ONLY: GET_N_LAYER_CELLS,GET_WALL_NODE_COORDINATES,GET_WALL_NODE_WEIGHTS
1655+
USE GEOMETRY_FUNCTIONS, ONLY: GET_N_LAYER_CELLS,GET_WALL_NODE_COORDINATES
16561656
USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_REAL_ARRAY,REALLOCATE_INTEGER_ARRAY,PACK_WALL,PACK_THIN_WALL
16571657
INTEGER, INTENT(IN) :: NM
16581658
INTEGER, INTENT(IN), OPTIONAL :: WALL_CELL,THIN_WALL_CELL
@@ -3804,7 +3804,7 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
38043804
N_MATL_OBST,N_LAYERS,N_MATLS,IIF,JJF,KKF
38053805
INTEGER, DIMENSION(MAX_MATERIALS) :: MATL_INDEX_OBST,MATL_INDEX
38063806
REAL(EB), DIMENSION(MAX_LAYERS,MAX_MATERIALS) :: MATL_MASS_FRACTION_OBST,MATL_MASS_FRACTION
3807-
REAL(EB), DIMENSION(0:MAX_LAYERS) :: LAYER_THICKNESS,MINIMUM_LAYER_THICKNESS
3807+
REAL(EB), DIMENSION(0:MAX_LAYERS) :: LAYER_THICKNESS,MIN_LAYER_THICKNESS
38083808
REAL(EB), DIMENSION(MAX_LAYERS) :: LAYER_THICKNESS_OBST,HEAT_SOURCE,HEAT_SOURCE_OBST,&
38093809
STRETCH_FACTOR,STRETCH_FACTOR_OBST,CELL_SIZE,CELL_SIZE_OBST,&
38103810
CELL_SIZE_FACTOR,CELL_SIZE_FACTOR_OBST
@@ -4044,7 +4044,7 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
40444044
MATL_INDEX(1:N_MATLS) = MATL_INDEX_OBST(1:N_MATLS) ! MATL_INDEX_OBST is taken from the OBSTs that make up the solid
40454045
MATL_MASS_FRACTION = 0._EB
40464046
LAYER_THICKNESS = 0._EB
4047-
MINIMUM_LAYER_THICKNESS = 0._EB
4047+
MIN_LAYER_THICKNESS = 0._EB
40484048
HT3D_LAYER = .FALSE.
40494049
FRONT_LINING_THICKNESS = 0._EB
40504050
BACK_LINING_THICKNESS = 0._EB
@@ -4077,7 +4077,7 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
40774077
IF (.NOT.SF%LINING) EXIT
40784078
N_LAYERS = N_LAYERS + 1
40794079
LAYER_THICKNESS(N_LAYERS) = SF%LAYER_THICKNESS(N_LAYERS)
4080-
MINIMUM_LAYER_THICKNESS(N_LAYERS) = SF%MINIMUM_LAYER_THICKNESS(N_LAYERS)
4080+
MIN_LAYER_THICKNESS(N_LAYERS) = SF%MIN_LAYER_THICKNESS(N_LAYERS)
40814081
HT3D_LAYER(N_LAYERS) = .FALSE.
40824082
HEAT_SOURCE(N_LAYERS) = SF%HEAT_SOURCE(N_LAYERS)
40834083
RAMP_IHS_INDEX(N_LAYERS) = SF%RAMP_IHS_INDEX(N_LAYERS)
@@ -4103,7 +4103,7 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
41034103
DO NL=1,N_LAYERS_OBST
41044104
N_LAYERS = N_LAYERS + 1
41054105
LAYER_THICKNESS(N_LAYERS) = LAYER_THICKNESS_OBST(NL)
4106-
MINIMUM_LAYER_THICKNESS(N_LAYERS) = SF%MINIMUM_LAYER_THICKNESS(1)
4106+
MIN_LAYER_THICKNESS(N_LAYERS) = SF%MIN_LAYER_THICKNESS(1)
41074107
HT3D_LAYER(N_LAYERS) = .TRUE.
41084108
HEAT_SOURCE(N_LAYERS) = HEAT_SOURCE_OBST(NL)
41094109
RAMP_IHS_INDEX(N_LAYERS) = RAMP_IHS_INDEX_OBST(NL)
@@ -4124,7 +4124,7 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
41244124
IF (.NOT.SF_BACK%LINING) EXIT
41254125
N_LAYERS = N_LAYERS + 1
41264126
LAYER_THICKNESS(N_LAYERS) = SF_BACK%LAYER_THICKNESS(SF_BACK%N_LAYERS-NL+1)
4127-
MINIMUM_LAYER_THICKNESS(N_LAYERS) = SF_BACK%MINIMUM_LAYER_THICKNESS(SF_BACK%N_LAYERS-NL+1)
4127+
MIN_LAYER_THICKNESS(N_LAYERS) = SF_BACK%MIN_LAYER_THICKNESS(SF_BACK%N_LAYERS-NL+1)
41284128
HT3D_LAYER(N_LAYERS) = .FALSE.
41294129
HEAT_SOURCE(N_LAYERS) = SF_BACK%HEAT_SOURCE(SF_BACK%N_LAYERS-NL+1)
41304130
RAMP_IHS_INDEX(N_LAYERS) = SF_BACK%RAMP_IHS_INDEX(SF_BACK%N_LAYERS-NL+1)
@@ -4147,10 +4147,10 @@ SUBROUTINE FIND_WALL_BACK_INDEX(NM,IW)
41474147
DEALLOCATE(ONE_D%MATL_COMP) ; ALLOCATE(ONE_D%MATL_COMP(ONE_D%N_MATL))
41484148
DEALLOCATE(ONE_D%MATL_INDEX) ; ALLOCATE(ONE_D%MATL_INDEX(ONE_D%N_MATL))
41494149
DEALLOCATE(ONE_D%LAYER_THICKNESS) ; ALLOCATE(ONE_D%LAYER_THICKNESS(ONE_D%N_LAYERS))
4150-
DEALLOCATE(ONE_D%MINIMUM_LAYER_THICKNESS) ; ALLOCATE(ONE_D%MINIMUM_LAYER_THICKNESS(ONE_D%N_LAYERS))
4150+
DEALLOCATE(ONE_D%MIN_LAYER_THICKNESS) ; ALLOCATE(ONE_D%MIN_LAYER_THICKNESS(ONE_D%N_LAYERS))
41514151
DEALLOCATE(ONE_D%HT3D_LAYER) ; ALLOCATE(ONE_D%HT3D_LAYER(ONE_D%N_LAYERS))
41524152
ONE_D%LAYER_THICKNESS(1:ONE_D%N_LAYERS) = LAYER_THICKNESS(1:ONE_D%N_LAYERS)
4153-
ONE_D%MINIMUM_LAYER_THICKNESS(1:ONE_D%N_LAYERS) = MINIMUM_LAYER_THICKNESS(1:ONE_D%N_LAYERS)
4153+
ONE_D%MIN_LAYER_THICKNESS(1:ONE_D%N_LAYERS) = MIN_LAYER_THICKNESS(1:ONE_D%N_LAYERS)
41544154
ONE_D%HT3D_LAYER(1:ONE_D%N_LAYERS) = HT3D_LAYER(1:ONE_D%N_LAYERS)
41554155
DO NN=1,ONE_D%N_MATL
41564156
ALLOCATE(ONE_D%MATL_COMP(NN)%MASS_FRACTION(ONE_D%N_LAYERS))
@@ -4960,7 +4960,7 @@ SUBROUTINE REASSIGN_WALL_CELLS(T,NM)
49604960

49614961
SUBROUTINE GET_BOUNDARY_TYPE
49624962

4963-
INTEGER :: IOR,IIG,JJG,KKG,IW_OLD,IERR,PRESSURE_BC_TYPE,ICG_OLD,II
4963+
INTEGER :: IOR,IIG,JJG,KKG,ICO,IW_OLD,IERR,PRESSURE_BC_TYPE,ICG_OLD,II
49644964
TYPE (BOUNDARY_PROP1_TYPE), POINTER :: B1,B1_OLD
49654965
TYPE (BOUNDARY_ONE_D_TYPE), POINTER :: ONE_D_OLD
49664966
TYPE (WALL_TYPE), POINTER :: WC_OLD
@@ -5036,42 +5036,66 @@ SUBROUTINE GET_BOUNDARY_TYPE
50365036
! Special cases 2: HT3D solid shifts the position of the burned away surface to the exposed surface position.
50375037

50385038
SF => SURFACE(WC%SURF_INDEX)
5039+
50395040
IF (REMOVE .AND. ( (SF%THERMAL_BC_INDEX==THERMALLY_THICK.AND.(SF%VARIABLE_THICKNESS.OR.SF%HT_DIM>1)) &
50405041
.OR. SF%PYROLYSIS_MODEL==PYROLYSIS_SPECIFIED ) ) THEN
5042+
50415043
BC => MESHES(NM)%BOUNDARY_COORD(WC%BC_INDEX)
50425044
IIG = BC%IIG
50435045
JJG = BC%JJG
50445046
KKG = BC%KKG
50455047
IOR = BC%IOR
50465048
ICG_OLD = 0
50475049
SELECT CASE(IOR)
5048-
CASE(-1) ; IF (IIG>1) ICG_OLD = CELL_INDEX(IIG-1,JJG,KKG)
5049-
CASE( 1) ; IF (IIG<IBAR) ICG_OLD = CELL_INDEX(IIG+1,JJG,KKG)
5050-
CASE(-2) ; IF (JJG>1) ICG_OLD = CELL_INDEX(IIG,JJG-1,KKG)
5051-
CASE( 2) ; IF (JJG<JBAR) ICG_OLD = CELL_INDEX(IIG,JJG+1,KKG)
5052-
CASE(-3) ; IF (KKG>1) ICG_OLD = CELL_INDEX(IIG,JJG,KKG-1)
5053-
CASE( 3) ; IF (KKG<KBAR) ICG_OLD = CELL_INDEX(IIG,JJG,KKG+1)
5050+
CASE(-1) ; ICG_OLD = CELL_INDEX(IIG-1,JJG,KKG)
5051+
CASE( 1) ; ICG_OLD = CELL_INDEX(IIG+1,JJG,KKG)
5052+
CASE(-2) ; ICG_OLD = CELL_INDEX(IIG,JJG-1,KKG)
5053+
CASE( 2) ; ICG_OLD = CELL_INDEX(IIG,JJG+1,KKG)
5054+
CASE(-3) ; ICG_OLD = CELL_INDEX(IIG,JJG,KKG-1)
5055+
CASE( 3) ; ICG_OLD = CELL_INDEX(IIG,JJG,KKG+1)
50545056
END SELECT
5055-
IW_OLD = CELL(ICG_OLD)%WALL_INDEX(-IOR)
5056-
IF (IW_OLD>0) THEN
5057-
WC_OLD => MESHES(NM)%WALL(IW_OLD)
5057+
5058+
IF (MESHES(NM)%CELL(ICG_OLD)%EXTERIOR) THEN
5059+
EWC => MESHES(NM)%EXTERNAL_WALL(CELL(ICG)%WALL_INDEX(IOR))
5060+
NOM = EWC%NOM
5061+
IF (NOM>0) THEN
5062+
IIO = EWC%IIO_MIN
5063+
JJO = EWC%JJO_MIN
5064+
KKO = EWC%KKO_MIN
5065+
ICG_OLD = MESHES(NOM)%CELL_INDEX(IIO,JJO,KKO)
5066+
IW_OLD = MESHES(NOM)%CELL(ICG_OLD)%WALL_INDEX(-IOR)
5067+
ELSE
5068+
IW_OLD = 0
5069+
ENDIF
5070+
ELSE
5071+
NOM = NM
5072+
IW_OLD = CELL(ICG_OLD)%WALL_INDEX(-IOR)
5073+
ENDIF
5074+
5075+
SWAP: IF (IW_OLD>0) THEN
5076+
WC_OLD => MESHES(NOM)%WALL(IW_OLD)
5077+
IF (WC_OLD%OD_INDEX==0) EXIT SWAP
50585078
IF (SF%PYROLYSIS_MODEL==PYROLYSIS_SPECIFIED) THEN
50595079
B1 => MESHES(NM)%BOUNDARY_PROP1(WC%B1_INDEX)
5060-
B1_OLD => MESHES(NM)%BOUNDARY_PROP1(WC_OLD%B1_INDEX)
5080+
B1_OLD => MESHES(NOM)%BOUNDARY_PROP1(WC_OLD%B1_INDEX)
50615081
IF (WC_OLD%SURF_INDEX==WC%SURF_INDEX) B1%T_IGN = B1_OLD%T_IGN
5062-
ELSEIF (.NOT.CELL(ICG_OLD)%SOLID .AND. .NOT.CELL(ICG)%SOLID .AND. CELL(IC)%SOLID .AND. &
5082+
ELSEIF (.NOT.MESHES(NOM)%CELL(ICG_OLD)%SOLID .AND. .NOT.MESHES(NM)%CELL(ICG)%SOLID .AND. MESHES(NM)%CELL(IC)%SOLID .AND. &
50635083
SUM(BOUNDARY_ONE_D(WC_OLD%OD_INDEX)%N_LAYER_CELLS(:))>0) THEN
5064-
WC%OD_INDEX = WC_OLD%OD_INDEX
5084+
IF (NOM/=NM) THEN
5085+
MESHES(NM)%BOUNDARY_ONE_D(WC%OD_INDEX) = MESHES(NOM)%BOUNDARY_ONE_D(WC_OLD%OD_INDEX)
5086+
ELSE
5087+
WC%OD_INDEX = WC_OLD%OD_INDEX
5088+
ENDIF
50655089
WC%BOUNDARY_TYPE = SOLID_BOUNDARY
5066-
ONE_D_OLD => MESHES(NM)%BOUNDARY_ONE_D(WC_OLD%OD_INDEX)
5090+
ONE_D_OLD => MESHES(NOM)%BOUNDARY_ONE_D(WC_OLD%OD_INDEX)
50675091
IF (ONE_D_OLD%BACK_MESH>0 .AND. ONE_D_OLD%BACK_MESH/=NM) THEN
50685092
OS => OMESH(ONE_D_OLD%BACK_MESH)%WALL_SEND_BUFFER
50695093
DO II=1,OS%N_ITEMS
50705094
IF (OS%ITEM_INDEX(II)==IW_OLD) OS%ITEM_INDEX(II) = IW
50715095
ENDDO
50725096
ENDIF
50735097
ENDIF
5074-
ENDIF
5098+
ENDIF SWAP
50755099
ENDIF
50765100

50775101
END SUBROUTINE GET_BOUNDARY_TYPE

0 commit comments

Comments
 (0)