@@ -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
662663END INTERFACE
663664
664665CONTAINS
@@ -715,6 +716,16 @@ SUBROUTINE EQUATE_LOGICALS(A,B,SWAP)
715716ENDIF
716717END 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+
718729END 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)
17871798ENDDO
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)
18161802ENDDO
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
18321829DO 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)
18401834ENDDO
18411835
@@ -1860,8 +1854,8 @@ SUBROUTINE REALLOCATE_BOUNDARY_ONE_D(ONE_D)
18601854IF (ALLOCATED (ONE_D% LAYER_THICKNESS)) DEALLOCATE (ONE_D% LAYER_THICKNESS) ; ALLOCATE (ONE_D% LAYER_THICKNESS(ONE_D% N_LAYERS))
18611855IF (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))
18651859IF (ALLOCATED (ONE_D% HT3D_LAYER)) DEALLOCATE (ONE_D% HT3D_LAYER) ; ALLOCATE (ONE_D% HT3D_LAYER(ONE_D% N_LAYERS))
18661860IF (ALLOCATED (ONE_D% MIN_DIFFUSIVITY)) DEALLOCATE (ONE_D% MIN_DIFFUSIVITY) ; ALLOCATE (ONE_D% MIN_DIFFUSIVITY(ONE_D% N_LAYERS))
18671861IF (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)
19361930ENDIF
19371931ONE_D% DELTA_TMP = 0._EB
19381932ONE_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)
19401934ONE_D% HT3D_LAYER(1 :ONE_D% N_LAYERS) = SF% HT3D_LAYER(1 :SF% N_LAYERS)
19411935ONE_D% MIN_DIFFUSIVITY(1 :ONE_D% N_LAYERS) = SF% MIN_DIFFUSIVITY(1 :SF% N_LAYERS)
19421936ONE_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
28592854SUBROUTINE 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
28642859INTEGER , INTENT (IN ) :: N_CELLS, N_LAYERS, N_LAYER_CELLS(N_LAYERS),GEOMETRY
28652860REAL (EB), INTENT (IN ) :: X_S(0 :N_CELLS),LAYER_THICKNESS(1 :N_LAYERS),LAYER_DIVIDE,INNER_RADIUS
28662861INTEGER , INTENT (OUT ) :: LAYER_INDEX(0 :N_CELLS+1 )
28672862REAL (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
28702865INTEGER :: 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
61726168END SUBROUTINE ACCUMULATE_STRING
61736169
61746170END MODULE MISC_FUNCTIONS
6175-
6171+
0 commit comments