Skip to content

Commit

Permalink
Merge pull request #13872 from mcgratta/master
Browse files Browse the repository at this point in the history 
FDS Source: Discussion #13860. Warn for empty SPATIAL_STATISTIC
  • Loading branch information
@mcgratta
mcgratta authored Dec 10, 2024
2 parents be55876 + ecd6949 commit 1e063ba
Show file tree
Hide file tree
Showing 3 changed files with 79 additions and 63 deletions.
1 change: 1 addition & 0 deletions Source/devc.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,7 @@ MODULE DEVICE_VARIABLES
INTEGER :: I1=-1,I2=-1,J1=-1,J2=-1,K1=-1,K2=-1
!> !\}
INTEGER :: N_PATH=0 !< Number of grid cells along subdevice path for TRANSMISSION or PATH OBSCURATION
INTEGER :: N_VALUES=0 !< Number of values for the subdevice used for computing spatial statistics
!> !\{
!> Grid index for a grid cell along subdevice path for TRANSMISSION or PATH OBSCURATION
INTEGER, ALLOCATABLE, DIMENSION(:) :: I_PATH,J_PATH,K_PATH
Expand Down
16 changes: 15 additions & 1 deletion Source/dump.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6372,6 +6372,7 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)
IF (DV%SUBDEVICE_INDEX(NM)==0) CYCLE DEVICE_LOOP

SDV => DV%SUBDEVICE(DV%SUBDEVICE_INDEX(NM))
SDV%N_VALUES = 0 ! Count the number of values for Device N in Mesh NM

! Check to see if the device is tied to an INIT line, in which case it is tied to a specific particle. Test to see if the
! particle is in the current mesh.
Expand Down Expand Up @@ -6407,11 +6408,13 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)
IF (DV%NO_UPDATE_DEVC_INDEX>0) THEN
IF (DEVICE(DV%NO_UPDATE_DEVC_INDEX)%CURRENT_STATE) THEN
SDV%VALUE_1 = DV%SMOOTHED_VALUE
SDV%N_VALUES = SDV%N_VALUES + 1
CYCLE DEVICE_LOOP
ENDIF
ELSEIF (DV%NO_UPDATE_CTRL_INDEX>0) THEN
IF (CONTROL(DV%NO_UPDATE_CTRL_INDEX)%CURRENT_STATE) THEN
SDV%VALUE_1 = DV%SMOOTHED_VALUE
SDV%N_VALUES = SDV%N_VALUES + 1
CYCLE DEVICE_LOOP
ENDIF
ENDIF
Expand Down Expand Up @@ -6447,6 +6450,7 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)
SDV%VALUE_1 = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
OPT_CFACE_INDEX=DV%CFACE_INDEX,OPT_DEVC_INDEX=N)
ENDIF
SDV%N_VALUES = SDV%N_VALUES + 1

CASE DEFAULT SOLID_STATS_SELECT

Expand Down Expand Up @@ -6483,6 +6487,7 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)
VALUE = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
OPT_WALL_INDEX=IW,OPT_DEVC_INDEX=N,OPT_CUT_FACE_INDEX=WC%CUT_FACE_INDEX)
CALL SELECT_SPATIAL_STATISTIC(OPT_CUT_FACE_INDEX=WC%CUT_FACE_INDEX)
SDV%N_VALUES = SDV%N_VALUES + 1
ENDDO WALL_CELL_LOOP

CFACE_LOOP : DO ICF=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS
Expand All @@ -6499,6 +6504,7 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)
VALUE = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
OPT_CFACE_INDEX=ICF,OPT_DEVC_INDEX=N)
CALL SELECT_SPATIAL_STATISTIC
SDV%N_VALUES = SDV%N_VALUES + 1
ENDDO CFACE_LOOP

PARTICLE_LOOP: DO IP=1,NLP
Expand All @@ -6515,6 +6521,7 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)
VALUE = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
OPT_LP_INDEX=IP,OPT_DEVC_INDEX=N)
CALL SELECT_SPATIAL_STATISTIC(OPT_LP_INDEX=IP)
SDV%N_VALUES = SDV%N_VALUES + 1
ENDDO PARTICLE_LOOP

! If no WALL, CFACE, or PARTICLE is found, set the value of the device to 0
Expand All @@ -6534,6 +6541,7 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)
K = MIN( KBP1, MAX(0, DV%K(1)) )
SDV%VALUE_1 = GAS_PHASE_OUTPUT(T,DT,NM,I,J,K,DV%QUANTITY_INDEX(1),0,DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
DV%VELO_INDEX,DV%PIPE_INDEX,DV%PROP_INDEX,DV%REAC_INDEX,DV%MATL_INDEX)
SDV%N_VALUES = SDV%N_VALUES + 1

IF (DV%N_QUANTITY>1) &
SDV%VALUE_2 = GAS_PHASE_OUTPUT(T,DT,NM,DV%I(2),DV%J(2),DV%K(2),DV%QUANTITY_INDEX(2),0,DV%Y_INDEX,DV%Z_INDEX,&
Expand Down Expand Up @@ -6577,6 +6585,7 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)

VALUE = GAS_PHASE_OUTPUT(T,DT,NM,I,J,K,DV%QUANTITY_INDEX(1),0,DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
DV%VELO_INDEX,DV%PIPE_INDEX,DV%PROP_INDEX,DV%REAC_INDEX,DV%MATL_INDEX)
SDV%N_VALUES = SDV%N_VALUES + 1
STATISTICS_SELECT: SELECT CASE(DV%SPATIAL_STATISTIC)
CASE('MAX','MAXLOC X','MAXLOC Y','MAXLOC Z')
IF (VALUE>SDV%VALUE_1) THEN
Expand Down Expand Up @@ -6658,14 +6667,18 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)
CASE(300:350) OUTPUT_INDEX_SELECT ! HVAC output

SDV%VALUE_1 = HVAC_OUTPUT(DV%QUANTITY_INDEX(1),DV%Y_INDEX,DV%Z_INDEX,DV%DUCT_INDEX,DV%NODE_INDEX,DV%DUCT_CELL_INDEX)
SDV%N_VALUES = SDV%N_VALUES + 1

CASE(400:454) OUTPUT_INDEX_SELECT ! Particle-specific output

SELECT CASE(DV%SPATIAL_STATISTIC)

CASE('null')

IF (LP_INDEX>0) SDV%VALUE_1 = PARTICLE_OUTPUT(T,ABS(DV%QUANTITY_INDEX(1)),LP_INDEX)
IF (LP_INDEX>0) THEN
SDV%VALUE_1 = PARTICLE_OUTPUT(T,ABS(DV%QUANTITY_INDEX(1)),LP_INDEX)
SDV%N_VALUES = SDV%N_VALUES + 1
ENDIF

CASE DEFAULT

Expand All @@ -6682,6 +6695,7 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)
VALUE = PARTICLE_OUTPUT(T,ABS(DV%QUANTITY_INDEX(1)),IP)
B1 => BOUNDARY_PROP1(LP%B1_INDEX)
CALL SELECT_SPATIAL_STATISTIC(OPT_LP_INDEX=IP)
SDV%N_VALUES = SDV%N_VALUES + 1
ENDDO PARTICLE_LOOP2

! If no appropriate particles are found, set the value of the device to 0
Expand Down
125 changes: 63 additions & 62 deletions Source/main.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -52,9 +52,10 @@ PROGRAM FDS
INTEGER :: LO10,NM,IZERO,ANG_INC_COUNTER
REAL(EB) :: T,DT,TNOW
REAL :: CPUTIME
REAL(EB), ALLOCATABLE, DIMENSION(:) :: TC_GLB,TC_LOC,DT_NEW,TI_LOC,TI_GLB
REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: TC2_GLB,TC2_LOC
LOGICAL, ALLOCATABLE, DIMENSION(:) :: STATE_GLB,STATE_LOC
REAL(EB), ALLOCATABLE, DIMENSION(:) :: TC_ARRAY,DT_NEW
INTEGER, ALLOCATABLE, DIMENSION(:) :: N_VALUES
REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: TC2_ARRAY
LOGICAL, ALLOCATABLE, DIMENSION(:) :: STATE_ARRAY
INTEGER :: ITER
TYPE (MESH_TYPE), POINTER :: M,M4
TYPE (OMESH_TYPE), POINTER :: M2,M3
Expand Down Expand Up @@ -1114,22 +1115,10 @@ SUBROUTINE MPI_INITIALIZATION_CHORES(TASK_NUMBER)

! Set up dummy arrays to hold various arrays that must be exchanged among meshes

ALLOCATE(TI_LOC(N_DEVC),STAT=IZERO)
CALL ChkMemErr('MAIN','TI_LOC',IZERO)
ALLOCATE(TI_GLB(N_DEVC),STAT=IZERO)
CALL ChkMemErr('MAIN','TI_GLB',IZERO)
ALLOCATE(STATE_GLB(2*N_DEVC),STAT=IZERO)
CALL ChkMemErr('MAIN','STATE_GLB',IZERO)
ALLOCATE(STATE_LOC(2*N_DEVC),STAT=IZERO)
CALL ChkMemErr('MAIN','STATE_LOC',IZERO)
ALLOCATE(TC_GLB(4*N_DEVC),STAT=IZERO)
CALL ChkMemErr('MAIN','TC_GLB',IZERO)
ALLOCATE(TC_LOC(4*N_DEVC),STAT=IZERO)
CALL ChkMemErr('MAIN','TC_LOC',IZERO)
ALLOCATE(TC2_GLB(2,N_DEVC),STAT=IZERO)
CALL ChkMemErr('MAIN','TC2_GLB',IZERO)
ALLOCATE(TC2_LOC(2,N_DEVC),STAT=IZERO)
CALL ChkMemErr('MAIN','TC2_LOC',IZERO)
ALLOCATE(STATE_ARRAY(2*N_DEVC),STAT=IZERO) ; CALL ChkMemErr('MAIN','STATE_ARRAY',IZERO)
ALLOCATE(TC_ARRAY(4*N_DEVC),STAT=IZERO) ; CALL ChkMemErr('MAIN','TC_ARRAY',IZERO)
ALLOCATE(TC2_ARRAY(2,N_DEVC),STAT=IZERO) ; CALL ChkMemErr('MAIN','TC2_ARRAY',IZERO)
ALLOCATE(N_VALUES(N_DEVC),STAT=IZERO) ; CALL ChkMemErr('MAIN','N_VALUES',IZERO)


CASE(3)
Expand Down Expand Up @@ -1701,7 +1690,7 @@ END SUBROUTINE STOP_CHECK

SUBROUTINE END_FDS

CHARACTER(255) :: MESSAGE
CHARACTER(MESSAGE_LENGTH) :: MESSAGE

IF (STOP_STATUS==NO_STOP .OR. STOP_STATUS==USER_STOP) CALL DUMP_TIMERS

Expand Down Expand Up @@ -3902,25 +3891,21 @@ SUBROUTINE EXCHANGE_GLOBAL_OUTPUTS

! Exchange the CURRENT_STATE and PRIOR_STATE of each DEViCe

STATE_LOC = .FALSE. ! _LOC is a temporary array that holds the STATE value for the devices on each node
STATE_ARRAY = .FALSE. ! Temporary array that holds the STATE value for the devices on each node
DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX
DO N=1,N_DEVC
DV => DEVICE(N)
IF (DV%MESH==NM) THEN
STATE_LOC(N) = DV%CURRENT_STATE
STATE_LOC(N+N_DEVC) = DV%PRIOR_STATE
STATE_ARRAY(N) = DV%CURRENT_STATE
STATE_ARRAY(N+N_DEVC) = DV%PRIOR_STATE
ENDIF
ENDDO
ENDDO
IF (N_MPI_PROCESSES>1) THEN
CALL MPI_ALLREDUCE(STATE_LOC(1),STATE_GLB(1),2*N_DEVC,MPI_LOGICAL,MPI_LXOR,MPI_COMM_WORLD,IERR)
ELSE
STATE_GLB = STATE_LOC
ENDIF
IF (N_MPI_PROCESSES>1) CALL MPI_ALLREDUCE(MPI_IN_PLACE,STATE_ARRAY,2*N_DEVC,MPI_LOGICAL,MPI_LXOR,MPI_COMM_WORLD,IERR)
DO N=1,N_DEVC
DV => DEVICE(N)
DV%CURRENT_STATE = STATE_GLB(N)
DV%PRIOR_STATE = STATE_GLB(N+N_DEVC)
DV%CURRENT_STATE = STATE_ARRAY(N)
DV%PRIOR_STATE = STATE_ARRAY(N+N_DEVC)
ENDDO

! Dry pipe sprinkler logic
Expand All @@ -3943,70 +3928,84 @@ SUBROUTINE EXCHANGE_GLOBAL_OUTPUTS
! For OP_INDEX=2 and 3, we take the MIN or MAX of all the VALUEs, along with the MINLOC or MAXLOC.

OPERATION_LOOP: DO OP_INDEX=1,3

IF (OP_INDEX==2 .AND. .NOT.MIN_DEVICES_EXIST) CYCLE OPERATION_LOOP
IF (OP_INDEX==3 .AND. .NOT.MAX_DEVICES_EXIST) CYCLE OPERATION_LOOP
N_VALUES = 0
SELECT CASE(OP_INDEX)
CASE(1) ; TC_LOC = 0._EB ; MPI_OP_INDEX = MPI_SUM ; DIM_FAC = 4
CASE(2) ; TC2_LOC = 1.E10_EB ; MPI_OP_INDEX = MPI_MINLOC ; DIM_FAC = 1
CASE(3) ; TC2_LOC = -1.E10_EB ; MPI_OP_INDEX = MPI_MAXLOC ; DIM_FAC = 1
CASE(1) ; TC_ARRAY = 0._EB ; MPI_OP_INDEX = MPI_SUM ; DIM_FAC = 4
CASE(2) ; TC2_ARRAY = 1.E10_EB ; MPI_OP_INDEX = MPI_MINLOC ; DIM_FAC = 1
CASE(3) ; TC2_ARRAY = -1.E10_EB ; MPI_OP_INDEX = MPI_MAXLOC ; DIM_FAC = 1
END SELECT

DEVICE_LOOP_1: DO N=1,N_DEVC
DV => DEVICE(N)
IF (OP_INDEX==1 .AND. (DV%SPATIAL_STATISTIC(1:3)=='MIN' .OR. DV%SPATIAL_STATISTIC(1:3)=='MAX')) CYCLE
IF (OP_INDEX==2 .AND. DV%SPATIAL_STATISTIC(1:3)/='MIN') CYCLE
IF (OP_INDEX==3 .AND. DV%SPATIAL_STATISTIC(1:3)/='MAX') CYCLE
IF (OP_INDEX==1 .AND. (DV%SPATIAL_STATISTIC(1:3)=='MIN' .OR. DV%SPATIAL_STATISTIC(1:3)=='MAX')) CYCLE DEVICE_LOOP_1
IF (OP_INDEX==2 .AND. DV%SPATIAL_STATISTIC(1:3)/='MIN') CYCLE DEVICE_LOOP_1
IF (OP_INDEX==3 .AND. DV%SPATIAL_STATISTIC(1:3)/='MAX') CYCLE DEVICE_LOOP_1
DO NN=1,DV%N_SUBDEVICES
SDV => DV%SUBDEVICE(NN)
N_VALUES(N) = N_VALUES(N) + SDV%N_VALUES
SELECT CASE(OP_INDEX)
CASE(1)
TC_LOC(N) = TC_LOC(N) + SDV%VALUE_1
TC_LOC(N+N_DEVC) = TC_LOC(N+N_DEVC) + SDV%VALUE_2
TC_LOC(N+2*N_DEVC) = TC_LOC(N+2*N_DEVC) + SDV%VALUE_3
TC_LOC(N+3*N_DEVC) = TC_LOC(N+3*N_DEVC) + SDV%VALUE_4
TC_ARRAY(N) = TC_ARRAY(N) + SDV%VALUE_1
TC_ARRAY(N+N_DEVC) = TC_ARRAY(N+N_DEVC) + SDV%VALUE_2
TC_ARRAY(N+2*N_DEVC) = TC_ARRAY(N+2*N_DEVC) + SDV%VALUE_3
TC_ARRAY(N+3*N_DEVC) = TC_ARRAY(N+3*N_DEVC) + SDV%VALUE_4
CASE(2)
IF (SDV%VALUE_1<TC2_LOC(1,N)) THEN
TC2_LOC(1,N) = SDV%VALUE_1
TC2_LOC(2,N) = SDV%VALUE_2
IF (SDV%VALUE_1<TC2_ARRAY(1,N)) THEN
TC2_ARRAY(1,N) = SDV%VALUE_1
TC2_ARRAY(2,N) = SDV%VALUE_2
ENDIF
CASE(3)
IF (SDV%VALUE_1>TC2_LOC(1,N)) THEN
TC2_LOC(1,N) = SDV%VALUE_1
TC2_LOC(2,N) = SDV%VALUE_2
IF (SDV%VALUE_1>TC2_ARRAY(1,N)) THEN
TC2_ARRAY(1,N) = SDV%VALUE_1
TC2_ARRAY(2,N) = SDV%VALUE_2
ENDIF
END SELECT
ENDDO
ENDDO DEVICE_LOOP_1

! Perform MPI exchanges to sum or take max/min of device values collected on meshes controlled by different processes

IF (N_MPI_PROCESSES>1) THEN
CALL MPI_ALLREDUCE(MPI_IN_PLACE,N_VALUES,N_DEVC,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR)
SELECT CASE(OP_INDEX)
CASE(1) ; CALL MPI_ALLREDUCE(TC_LOC(1),TC_GLB(1),DIM_FAC*N_DEVC,MPI_DOUBLE_PRECISION,MPI_OP_INDEX,MPI_COMM_WORLD,IERR)
CASE(2:3) ; CALL MPI_ALLREDUCE(TC2_LOC(1,1),TC2_GLB(1,1),N_DEVC,MPI_2DOUBLE_PRECISION,MPI_OP_INDEX,MPI_COMM_WORLD,IERR)
END SELECT
ELSE
SELECT CASE(OP_INDEX)
CASE(1) ; TC_GLB = TC_LOC
CASE(2:3) ; TC2_GLB = TC2_LOC
CASE(1)
CALL MPI_ALLREDUCE(MPI_IN_PLACE,TC_ARRAY,DIM_FAC*N_DEVC,MPI_DOUBLE_PRECISION,MPI_OP_INDEX,MPI_COMM_WORLD,IERR)
CASE(2:3)
CALL MPI_ALLREDUCE(MPI_IN_PLACE,TC2_ARRAY,N_DEVC,MPI_2DOUBLE_PRECISION,MPI_OP_INDEX,MPI_COMM_WORLD,IERR)
END SELECT
ENDIF

! Put summed values from the subdevices (SDV) back into the controlling device (DV)

DEVICE_LOOP_2: DO N=1,N_DEVC

DV => DEVICE(N)
IF (OP_INDEX==1 .AND. (DV%SPATIAL_STATISTIC(1:3)=='MIN' .OR. DV%SPATIAL_STATISTIC(1:3)=='MAX')) CYCLE
IF (OP_INDEX==2 .AND. DV%SPATIAL_STATISTIC(1:3)/='MIN') CYCLE
IF (OP_INDEX==3 .AND. DV%SPATIAL_STATISTIC(1:3)/='MAX') CYCLE
IF (OP_INDEX==1 .AND. (DV%SPATIAL_STATISTIC(1:3)=='MIN' .OR. DV%SPATIAL_STATISTIC(1:3)=='MAX')) CYCLE DEVICE_LOOP_2
IF (OP_INDEX==2 .AND. DV%SPATIAL_STATISTIC(1:3)/='MIN') CYCLE DEVICE_LOOP_2
IF (OP_INDEX==3 .AND. DV%SPATIAL_STATISTIC(1:3)/='MAX') CYCLE DEVICE_LOOP_2
IF (MY_RANK==0 .AND. N_VALUES(N)==0 .AND. DV%SPATIAL_STATISTIC/='null') &
WRITE(LU_ERR,'(3A)') 'WARNING: DEVC ',TRIM(DV%ID),' has no values.'
IF (OP_INDEX==1) THEN
DV%VALUE_1 = TC_GLB(N)
DV%VALUE_2 = TC_GLB( N_DEVC+N)
DV%VALUE_3 = TC_GLB(2*N_DEVC+N)
DV%VALUE_4 = TC_GLB(3*N_DEVC+N)
DV%VALUE_1 = TC_ARRAY(N)
DV%VALUE_2 = TC_ARRAY( N_DEVC+N)
DV%VALUE_3 = TC_ARRAY(2*N_DEVC+N)
DV%VALUE_4 = TC_ARRAY(3*N_DEVC+N)
ENDIF
IF (OP_INDEX>1 .AND. (DV%SPATIAL_STATISTIC=='MIN'.OR.DV%SPATIAL_STATISTIC=='MAX')) THEN
DV%VALUE_1 = TC2_GLB(1,N)
DV%VALUE_1 = TC2_ARRAY(1,N)
ENDIF

! Special case for MINLOC or MAXLOC

IF (OP_INDEX>1 .AND. (DV%SPATIAL_STATISTIC(1:6)=='MINLOC'.OR.DV%SPATIAL_STATISTIC(1:6)=='MAXLOC')) THEN
NO_NEED_TO_RECV = .FALSE.
DO NN=1,DV%N_SUBDEVICES
SDV => DV%SUBDEVICE(NN)
IF (PROCESS(SDV%MESH)==MY_RANK) THEN
IF (SDV%MESH==NINT(TC2_GLB(2,N))) THEN
IF (SDV%MESH==NINT(TC2_ARRAY(2,N))) THEN
DV%VALUE_1 = SDV%VALUE_3
IF (MY_RANK>0) THEN
CALL MPI_SEND(DV%VALUE_1,1,MPI_DOUBLE_PRECISION,0,999,MPI_COMM_WORLD,IERR)
Expand All @@ -4021,7 +4020,9 @@ SUBROUTINE EXCHANGE_GLOBAL_OUTPUTS
CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)
CALL MPI_BCAST(DV%VALUE_1,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,IERR)
ENDIF

ENDDO DEVICE_LOOP_2

ENDDO OPERATION_LOOP

ENDIF EXCHANGE_DEVICE
Expand Down

0 comments on commit 1e063ba

Please sign in to comment.