Skip to content

Commit 2f597f2

Browse files
authored
Merge pull request #14393 from mcgratta/master
FDS Source: Issue #14221. Eliminate OpenMP race conditions
2 parents 921f5bd + 51ed97d commit 2f597f2

File tree

5 files changed

+23
-7
lines changed

5 files changed

+23
-7
lines changed

Source/divg.f90

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -185,6 +185,7 @@ SUBROUTINE DIVERGENCE_PART_1(T,DT,NM)
185185
WC => WALL(IW)
186186
IF (WC%BOUNDARY_TYPE==NULL_BOUNDARY) CYCLE WALL_LOOP
187187
BC => BOUNDARY_COORD(WC%BC_INDEX)
188+
IF (WC%THIN .AND. BC%IOR<0) CYCLE WALL_LOOP ! Avoid OpenMP race condition by processing on one side of thin OBST
188189
BOUNDARY_TYPE_SELECT: SELECT CASE(WC%BOUNDARY_TYPE)
189190
CASE DEFAULT
190191
SELECT CASE(BC%IOR)
@@ -322,6 +323,8 @@ SUBROUTINE DIVERGENCE_PART_1(T,DT,NM)
322323
ENDIF
323324
B1%RHO_D_DZDN_F(N) = RHO_D_DZDN
324325

326+
IF (WC%THIN .AND. BC%IOR<0) CYCLE WALL_LOOP_2 ! Avoid OpenMP race condition by processing only one side of thin OBST
327+
325328
IF (STORE_SPECIES_FLUX) THEN
326329
IF (CORRECTOR) THEN
327330
SELECT CASE(BC%IOR)
@@ -529,6 +532,9 @@ SUBROUTINE DIVERGENCE_PART_1(T,DT,NM)
529532
ELSE
530533
B1%K_G = KP(BC%IIG,BC%JJG,BC%KKG)
531534
ENDIF
535+
! Q_LEAK accounts for enthalpy moving through leakage paths
536+
DP(BC%IIG,BC%JJG,BC%KKG) = DP(BC%IIG,BC%JJG,BC%KKG) - ( B1%AREA_ADJUST*B1%Q_CON_F*B1%RDN - B1%Q_LEAK )
537+
IF (WC%THIN .AND. BC%IOR<0) CYCLE CORRECTION_LOOP ! Avoid OpenMP race condition by processing on one side of thin OBST
532538
SELECT CASE(BC%IOR)
533539
CASE( 1) ; KDTDX(BC%II ,BC%JJ ,BC%KK ) = 0._EB
534540
CASE(-1) ; KDTDX(BC%II-1,BC%JJ ,BC%KK ) = 0._EB
@@ -537,8 +543,6 @@ SUBROUTINE DIVERGENCE_PART_1(T,DT,NM)
537543
CASE( 3) ; KDTDZ(BC%II ,BC%JJ ,BC%KK ) = 0._EB
538544
CASE(-3) ; KDTDZ(BC%II ,BC%JJ ,BC%KK-1) = 0._EB
539545
END SELECT
540-
! Q_LEAK accounts for enthalpy moving through leakage paths
541-
DP(BC%IIG,BC%JJG,BC%KKG) = DP(BC%IIG,BC%JJG,BC%KKG) - ( B1%AREA_ADJUST*B1%Q_CON_F*B1%RDN - B1%Q_LEAK )
542546
ENDDO CORRECTION_LOOP
543547

544548
! Compute (q + del dot k del T) and add to the divergence

Source/func.f90

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1399,6 +1399,7 @@ SUBROUTINE GET_SCALAR_FACE_VALUE(A,U,F,I1,I2,J1,J2,K1,K2,IOR,LIMITER)
13991399
ENDDO
14001400
!$OMP END DO
14011401
CASE(5) ! MP5, Suresh and Huynh (1997)
1402+
!$OMP SINGLE
14021403
DO K=K1,K2
14031404
DO J=J1,J2
14041405
DO I=I1,I2
@@ -1414,6 +1415,7 @@ SUBROUTINE GET_SCALAR_FACE_VALUE(A,U,F,I1,I2,J1,J2,K1,K2,IOR,LIMITER)
14141415
ENDDO
14151416
ENDDO
14161417
ENDDO
1418+
!$OMP END SINGLE
14171419
END SELECT
14181420
!$OMP END PARALLEL
14191421

@@ -3803,6 +3805,8 @@ SUBROUTINE PACK_WALL(NM,OS,WC,SURF_INDEX,RC,IC,LC,UNPACK_IT,COUNT_ONLY,CHECK_BOU
38033805
IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),WC%N_INTEGERS,UNPACK_IT)
38043806
IC=IC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%INTEGERS(IC),WC%N_LOGICALS,UNPACK_IT)
38053807

3808+
LC=LC+1 ; IF (.NOT.COUNT_ONLY) CALL EQUATE(OS%LOGICALS(LC),WC%THIN,UNPACK_IT)
3809+
38063810
! Pack or unpack the appropriate derived type variables tied to this wall cell
38073811

38083812
IF (SF%INCLUDE_BOUNDARY_COORD_TYPE) CALL PACK_BOUNDARY_COORD(NM,IC,RC,OS,BC_INDEX,UNPACK_IT,COUNT_ONLY)

Source/init.f90

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3251,6 +3251,8 @@ SUBROUTINE INIT_WALL_CELL(NM,I,J,K,OBST_INDEX,IW,IOR,SURF_INDEX,IERR,TT)
32513251
WC%OBST_INDEX = OBST_INDEX
32523252
WC%BOUNDARY_TYPE = BOUNDARY_TYPE
32533253

3254+
IF (.NOT.M%CELL(ICG)%SOLID .AND. .NOT.M%CELL(IC)%SOLID .AND. .NOT.M%CELL(IC)%EXTERIOR) WC%THIN = .TRUE.
3255+
32543256
IF (IW<=M%N_EXTERNAL_WALL_CELLS) THEN
32553257
EWC => M%EXTERNAL_WALL(IW)
32563258
EWC%NOM = NOM_FOUND

Source/type.f90

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -442,6 +442,8 @@ MODULE TYPES
442442
INTEGER :: N_INTEGERS=0 !< Number of integers to pack into restart or send/recv buffer
443443
INTEGER :: N_LOGICALS=0 !< Number of logicals to pack into restart or send/recv buffer
444444

445+
LOGICAL :: THIN=.FALSE. !< Indicates if the underlying solid is zero cells thick
446+
445447
END TYPE WALL_TYPE
446448

447449

Source/wall.f90

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -333,9 +333,11 @@ END SUBROUTINE ASSIGN_GHOST_VALUE
333333
!> \param SF Pointer to SURFACE derived type
334334
!> \param BC Pointer to BOUNDARY_COORD derived type
335335
!> \param B1 Pointer to BOUNDARY_PROP1 derived type
336-
!> \param LP Pointer to LAGRANGIAN_PARTICLE derived type
337-
!> \param WALL_INDEX Index of wall cell
338-
!> \param PARTICLE_INDEX Index of particle
336+
!> \param LP (Optional) Pointer to LAGRANGIAN_PARTICLE derived type
337+
!> \param TW (Optional) Pointer to THIN_WALL
338+
!> \param WALL_INDEX (Optional) Index of wall cell
339+
!> \param PARTICLE_INDEX (Optional) Index of particle
340+
!> \param THIN_WALL_INDEX (Optional) Index of thin wall cell
339341

340342
SUBROUTINE NEAR_SURFACE_GAS_VARIABLES(T,SF,BC,B1,LP,TW,WALL_INDEX,PARTICLE_INDEX,THIN_WALL_INDEX)
341343

@@ -1384,6 +1386,7 @@ SUBROUTINE CALCULATE_ZZ_F(T,DT,WALL_INDEX,CFACE_INDEX,PARTICLE_INDEX)
13841386
ENDIF
13851387
ENDIF
13861388
IF (OTHER_MESH_OBST_INDEX>0) THEN
1389+
!$OMP CRITICAL
13871390
IF (OBST_INDEX>0) OBSTRUCTION(OBST_INDEX)%MASS = MESHES(EWC%NOM)%OBSTRUCTION(OTHER_MESH_OBST_INDEX)%MASS
13881391
IF (MESHES(EWC%NOM)%OBSTRUCTION(OTHER_MESH_OBST_INDEX)%CONSUMABLE) THEN
13891392
OMESH(EWC%NOM)%N_EXTERNAL_OBST = OMESH(EWC%NOM)%N_EXTERNAL_OBST + 1
@@ -1392,6 +1395,7 @@ SUBROUTINE CALCULATE_ZZ_F(T,DT,WALL_INDEX,CFACE_INDEX,PARTICLE_INDEX)
13921395
OMESH(EWC%NOM)%REAL_SEND_PKG8(LL) = &
13931396
(B1%M_DOT_PART_ACTUAL+SUM(B1%M_DOT_G_PP_ACTUAL(1:N_TRACKED_SPECIES)))*DT*B1%AREA
13941397
ENDIF
1398+
!$OMP END CRITICAL
13951399
ELSE
13961400
!$OMP CRITICAL
13971401
IF (OBST_INDEX>0) OBSTRUCTION(OBST_INDEX)%MASS = OBSTRUCTION(OBST_INDEX)%MASS - &
@@ -3482,7 +3486,7 @@ END SUBROUTINE PYROLYSIS
34823486
!> \param WALL_INDEX_IN Optional wall cell index
34833487
!> \param CFACE_INDEX_IN Optional cface index
34843488
!> \param PARTICLE_INDEX_IN Optional particle index
3485-
!> \param BACK_SIZE Optional flag indicating if the surface is on the back side of the obstruction
3489+
!> \param BACK_SIDE Optional flag indicating if the surface is on the back side of the obstruction
34863490

34873491
REAL(EB) FUNCTION HEAT_TRANSFER_COEFFICIENT(NM,T,DELTA_N_TMP,SF,WALL_INDEX_IN,CFACE_INDEX_IN,PARTICLE_INDEX_IN,BACK_SIDE)
34883492

@@ -3740,7 +3744,7 @@ SUBROUTINE HT3D_TEMPERATURE_EXCHANGE(NM)
37403744
ENDDO WALL_LOOP
37413745
!$OMP END DO
37423746

3743-
!$OMP DO SCHEDULE(GUIDED) PRIVATE(ITW,TW,SF,BC,ONE_D,NWP,THR_D,I,II,IWA,NM2,I_NODE,WC2,BC2,ONE_D2,TW2)
3747+
!$OMP DO SCHEDULE(GUIDED) PRIVATE(ITW,TW,SF,BC,ONE_D,NWP,THR_D,I,II,IWA,NM2,I_NODE,WC2,BC2,ONE_D2,TW2,TMP_1,TMP_NWP)
37443748
THIN_WALL_LOOP: DO ITW=1,M%N_THIN_WALL_CELLS
37453749

37463750
TW => M%THIN_WALL(ITW)

0 commit comments

Comments
 (0)