@@ -1840,7 +1840,7 @@ REAL(EB) FUNCTION GET_PARTICLE_ENTHALPY(I_LPC,TMP_S)
18401840USE MATH_FUNCTIONS, ONLY: INTERPOLATE1D_UNIFORM
18411841REAL (EB), INTENT (IN ) :: TMP_S
18421842REAL (EB) :: RHO,RHO_H,VOL,DTMP,H_S,THICKNESS
1843- INTEGER :: I,N,ITMP,I_GRAD
1843+ INTEGER :: I,N,ITMP
18441844INTEGER , INTENT (IN ) :: I_LPC
18451845TYPE (LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC
18461846TYPE (SURFACE_TYPE), POINTER :: SF
@@ -1852,21 +1852,16 @@ REAL(EB) FUNCTION GET_PARTICLE_ENTHALPY(I_LPC,TMP_S)
18521852 CALL INTERPOLATE1D_UNIFORM(LBOUND (SPECIES(LPC% Y_INDEX)% H_L,1 ),SPECIES(LPC% Y_INDEX)% H_L,TMP_S,GET_PARTICLE_ENTHALPY)
18531853ELSE
18541854 SF= >SURFACE(LPC% SURF_INDEX)
1855- SELECT CASE (SF% GEOMETRY)
1856- CASE (SURF_CARTESIAN) ; I_GRAD = 1
1857- CASE (SURF_CYLINDRICAL,SURF_INNER_CYLINDRICAL) ; I_GRAD = 2
1858- CASE (SURF_SPHERICAL) ; I_GRAD = 3
1859- END SELECT
18601855 RHO_H = 0._EB
18611856 RHO = 0._EB
18621857 ITMP = MIN (I_MAX_TEMP-1 ,INT (TMP_S))
18631858 DTMP = TMP_S- REAL (ITMP,EB)
18641859 THICKNESS = SUM (SF% LAYER_THICKNESS)
18651860 DO I= 1 ,SUM (SF% N_LAYER_CELLS)
18661861 IF (SF% GEOMETRY== SURF_INNER_CYLINDRICAL) THEN
1867- VOL = (SF% INNER_RADIUS+ SF% X_S(I))** I_GRAD - (SF% INNER_RADIUS+ SF% X_S(I-1 ))** I_GRAD
1862+ VOL = (SF% INNER_RADIUS+ SF% X_S(I))** SF % I_GRAD - (SF% INNER_RADIUS+ SF% X_S(I-1 ))** SF % I_GRAD
18681863 ELSE
1869- VOL = (THICKNESS+ SF% INNER_RADIUS- SF% X_S(I-1 ))** I_GRAD - (THICKNESS+ SF% INNER_RADIUS- SF% X_S(I))** I_GRAD
1864+ VOL = (THICKNESS+ SF% INNER_RADIUS- SF% X_S(I-1 ))** SF % I_GRAD - (THICKNESS+ SF% INNER_RADIUS- SF% X_S(I))** SF % I_GRAD
18701865 ENDIF
18711866 MATL_REMESH: DO N= 1 ,SF% N_MATL
18721867 IF (SF% RHO_0(I,N)<= TWO_EPSILON_EB) CYCLE MATL_REMESH
@@ -2112,7 +2107,7 @@ REAL(EB) FUNCTION SURFACE_DENSITY(MODE,SF,ONE_D,MATL_INDEX)
21122107
21132108INTEGER , INTENT (IN ) :: MODE
21142109INTEGER , INTENT (IN ), OPTIONAL :: MATL_INDEX
2115- INTEGER :: I_GRAD, NWP,II2,N,ITMP
2110+ INTEGER :: NWP,II2,N,ITMP
21162111REAL (EB) :: WGT,R_S(0 :NWP_MAX),EPUM,DTMP
21172112TYPE (BOUNDARY_ONE_D_TYPE), INTENT (IN ), POINTER :: ONE_D
21182113TYPE (SURFACE_TYPE), INTENT (IN ), POINTER :: SF
@@ -2124,12 +2119,6 @@ REAL(EB) FUNCTION SURFACE_DENSITY(MODE,SF,ONE_D,MATL_INDEX)
21242119
21252120ELSE THERMALLY_THICK_IF
21262121
2127- SELECT CASE (SF% GEOMETRY)
2128- CASE (SURF_CARTESIAN) ; I_GRAD = 1
2129- CASE (SURF_CYLINDRICAL,SURF_INNER_CYLINDRICAL) ; I_GRAD = 2
2130- CASE (SURF_SPHERICAL) ; I_GRAD = 3
2131- END SELECT
2132-
21332122 NWP = SUM (ONE_D% N_LAYER_CELLS)
21342123 IF (SF% GEOMETRY== SURF_INNER_CYLINDRICAL) THEN
21352124 R_S(0 :NWP) = SF% INNER_RADIUS + ONE_D% X(0 :NWP)
@@ -2140,8 +2129,9 @@ REAL(EB) FUNCTION SURFACE_DENSITY(MODE,SF,ONE_D,MATL_INDEX)
21402129 SURFACE_DENSITY = 0._EB
21412130 NUMBER_WALL_POINTS_LOOP: DO II2= 1 ,NWP
21422131 AREA_VOLUME_SELECT: SELECT CASE (MODE)
2143- CASE (0 ,2 ); WGT = ABS (R_S(II2-1 )** I_GRAD- R_S(II2)** I_GRAD)/ (REAL (I_GRAD,EB)* (SF% INNER_RADIUS+ SF% THICKNESS)** (I_GRAD-1 ))
2144- CASE (1 ,3 ); WGT = ABS (R_S(II2-1 )** I_GRAD- R_S(II2)** I_GRAD)/ (SF% INNER_RADIUS+ SF% THICKNESS)** I_GRAD
2132+ CASE (0 ,2 ); WGT = ABS (R_S(II2-1 )** SF% I_GRAD- R_S(II2)** SF% I_GRAD)/ &
2133+ (REAL (SF% I_GRAD,EB)* (SF% INNER_RADIUS+ SF% THICKNESS)** (SF% I_GRAD-1 ))
2134+ CASE (1 ,3 ); WGT = ABS (R_S(II2-1 )** SF% I_GRAD- R_S(II2)** SF% I_GRAD)/ (SF% INNER_RADIUS+ SF% THICKNESS)** SF% I_GRAD
21452135 END SELECT AREA_VOLUME_SELECT
21462136
21472137 EPUM = 1._EB ! energy per unit mass
@@ -4063,6 +4053,7 @@ SUBROUTINE PACK_BOUNDARY_ONE_D(NM,IC,RC,LC,OS,OD_INDEX,UNPACK_IT,COUNT_ONLY,CHEC
40634053I1= 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)
40644054I1= 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)
40654055I1= 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)
4056+ I1= RC+1 ; RC= I1+ ONE_D% N_LAYERS-1 ; IF (.NOT. COUNT_ONLY) CALL EQUATE(OS% REALS(I1:RC),ONE_D% MIN_LAYER_MASS(1 :RC- I1+1 ), UNPACK_IT)
40664057I1= 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)
40674058I1= 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)
40684059I1= 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)
@@ -4106,6 +4097,7 @@ SUBROUTINE REALLOCATE_BOUNDARY_ONE_D(ONE_D)
41064097 ALLOCATE (ONE_D% LAYER_THICKNESS_OLD(ONE_D% N_LAYERS))
41074098IF (ALLOCATED (ONE_D% MIN_LAYER_THICKNESS)) DEALLOCATE (ONE_D% MIN_LAYER_THICKNESS)
41084099 ALLOCATE (ONE_D% MIN_LAYER_THICKNESS(ONE_D% N_LAYERS))
4100+ IF (ALLOCATED (ONE_D% MIN_LAYER_MASS)) DEALLOCATE (ONE_D% MIN_LAYER_MASS) ; ALLOCATE (ONE_D% MIN_LAYER_MASS(ONE_D% N_LAYERS))
41094101IF (ALLOCATED (ONE_D% HT3D_LAYER)) DEALLOCATE (ONE_D% HT3D_LAYER) ; ALLOCATE (ONE_D% HT3D_LAYER(ONE_D% N_LAYERS))
41104102IF (ALLOCATED (ONE_D% MIN_DIFFUSIVITY)) DEALLOCATE (ONE_D% MIN_DIFFUSIVITY) ; ALLOCATE (ONE_D% MIN_DIFFUSIVITY(ONE_D% N_LAYERS))
41114103IF (ALLOCATED (ONE_D% RHO_C_S)) DEALLOCATE (ONE_D% RHO_C_S) ; ALLOCATE (ONE_D% RHO_C_S(ONE_D% N_CELLS_MAX))
@@ -4132,12 +4124,12 @@ END SUBROUTINE REALLOCATE_BOUNDARY_ONE_D
41324124
41334125SUBROUTINE INITIALIZE_BOUNDARY_ONE_D (NM ,OD_INDEX ,SURF_INDEX )
41344126
4135- USE GLOBAL_CONSTANTS, ONLY: RADIATION
4127+ USE GLOBAL_CONSTANTS, ONLY: RADIATION,NWP_MAX
41364128INTEGER , INTENT (IN ) :: NM,OD_INDEX,SURF_INDEX
41374129TYPE (BOUNDARY_ONE_D_TYPE), POINTER :: ONE_D
41384130TYPE (SURFACE_TYPE), POINTER :: SF
41394131INTEGER :: NN,I,II
4140- REAL (EB) :: RAMP_POSITION,TF,TB
4132+ REAL (EB) :: RAMP_POSITION,TF,TB,R( 0 :NWP_MAX)
41414133
41424134ONE_D = > MESHES(NM)% BOUNDARY_ONE_D(OD_INDEX)
41434135SF = > SURFACE(SURF_INDEX)
@@ -4153,6 +4145,12 @@ SUBROUTINE INITIALIZE_BOUNDARY_ONE_D(NM,OD_INDEX,SURF_INDEX)
41534145DO I= 1 ,MIN (ONE_D% N_CELLS_MAX,ONE_D% N_CELLS_INI)
41544146 ONE_D% DX_OLD(I) = ONE_D% X(I)- ONE_D% X(I-1 )
41554147ENDDO
4148+ R(0 :ONE_D% N_CELLS_INI) = SF% THICKNESS + SF% INNER_RADIUS - ONE_D% X(0 :ONE_D% N_CELLS_INI)
4149+ I = 0
4150+ DO NN = 1 ,ONE_D% N_LAYERS
4151+ ONE_D% MIN_LAYER_MASS(NN) = SF% MIN_LAYER_MASS(NN)* (R(I)** SF% I_GRAD - R(I+ ONE_D% N_LAYER_CELLS(NN))** SF% I_GRAD)
4152+ I = I + ONE_D% N_LAYER_CELLS(NN)
4153+ ENDDO
41564154IF (ALLOCATED (ONE_D% LAYER_THICKNESS_OLD)) ONE_D% LAYER_THICKNESS_OLD(1 :ONE_D% N_LAYERS) = SF% LAYER_THICKNESS(1 :SF% N_LAYERS)
41574155IF (SF% RAMP_T_I_INDEX > 0 ) THEN
41584156 ! NOTE: Replicating EVALUATE_RAMP since MODULE MATH_FUNCTIONS uses the MODULE which contains this routine
@@ -4310,6 +4308,7 @@ SUBROUTINE PACK_BOUNDARY_PROP1(NM,IC,RC,LC,OS,B1_INDEX,UNPACK_IT,COUNT_ONLY,SURF
43104308RC= RC+1 ; IF (.NOT. COUNT_ONLY) CALL EQUATE(OS% REALS(RC),B1% RHO_G,UNPACK_IT)
43114309RC= RC+1 ; IF (.NOT. COUNT_ONLY) CALL EQUATE(OS% REALS(RC),B1% RDN,UNPACK_IT)
43124310RC= RC+1 ; IF (.NOT. COUNT_ONLY) CALL EQUATE(OS% REALS(RC),B1% K_G,UNPACK_IT)
4311+ RC= RC+1 ; IF (.NOT. COUNT_ONLY) CALL EQUATE(OS% REALS(RC),B1% M_DOT_LAYER_PP,UNPACK_IT)
43134312RC= RC+1 ; IF (.NOT. COUNT_ONLY) CALL EQUATE(OS% REALS(RC),B1% Q_DOT_G_PP,UNPACK_IT)
43144313RC= RC+1 ; IF (.NOT. COUNT_ONLY) CALL EQUATE(OS% REALS(RC),B1% Q_DOT_O2_PP,UNPACK_IT)
43154314RC= RC+1 ; IF (.NOT. COUNT_ONLY) CALL EQUATE(OS% REALS(RC),B1% Q_CONDENSE,UNPACK_IT)
@@ -5254,24 +5253,14 @@ END SUBROUTINE GET_WALL_NODE_WEIGHTS
52545253! > \param X_S_NEW Array of interior cell edge positions after shrinkage or swelling (m)
52555254! > \param INT_WGT Array of weighting factors for new arrangement of interior cells
52565255
5257- SUBROUTINE GET_INTERPOLATION_WEIGHTS (GEOMETRY ,NWP ,NWP_NEW ,INNER_RADIUS ,X_S ,X_S_NEW ,INT_WGT )
5256+ SUBROUTINE GET_INTERPOLATION_WEIGHTS (GEOMETRY ,I_GRAD , NWP ,NWP_NEW ,INNER_RADIUS ,X_S ,X_S_NEW ,INT_WGT )
52585257
5259- INTEGER , INTENT (IN ) :: GEOMETRY,NWP,NWP_NEW
5258+ INTEGER , INTENT (IN ) :: GEOMETRY,I_GRAD, NWP,NWP_NEW
52605259REAL (EB), INTENT (IN ) :: X_S(0 :NWP), X_S_NEW(0 :NWP_NEW), INNER_RADIUS
52615260REAL (EB), INTENT (OUT ) :: INT_WGT(NWP_NEW,NWP)
52625261
52635262REAL (EB) XUP,XLOW,XUP_NEW,XLOW_NEW,VOL_NEW,VOL,THICKNESS
5264- INTEGER I_NEW, I_OLD, I_GRAD
5265-
5266-
5267- SELECT CASE (GEOMETRY)
5268- CASE (SURF_CARTESIAN)
5269- I_GRAD = 1
5270- CASE (SURF_CYLINDRICAL,SURF_INNER_CYLINDRICAL)
5271- I_GRAD = 2
5272- CASE (SURF_SPHERICAL)
5273- I_GRAD = 3
5274- END SELECT
5263+ INTEGER I_NEW, I_OLD
52755264
52765265I_OLD = 1
52775266INT_WGT = 0._EB
0 commit comments