Skip to content

Commit 5387c59

Browse files
authored
Merge pull request #15918 from drjfloyd/master
FDS Source: Simplify allocations.
2 parents f37870d + f0f4df6 commit 5387c59

1 file changed

Lines changed: 21 additions & 22 deletions

File tree

Source/hvac.f90

Lines changed: 21 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -738,7 +738,7 @@ SUBROUTINE READ_HVAC
738738
N_NODE_QUANTITY = N_NODE_QUANTITY + 1
739739
ENDDO
740740
ALLOCATE (NODE_QUANTITY_ARRAY(N_NODE_QUANTITY))
741-
NODE_QUANTITY_ARRAY(1:N_NODE_QUANTITY)%DRY = DRY(1:N_NODE_QUANTITY)
741+
NODE_QUANTITY_ARRAY(1:N_NODE_QUANTITY)%DRY = DRY(1:N_NODE_QUANTITY)
742742
DO N=1, N_NODE_QUANTITY
743743
HQT => NODE_QUANTITY_ARRAY(N)
744744
CALL GET_QUANTITY_INDEX(HQT%SMOKEVIEW_LABEL,HQT%SMOKEVIEW_BAR_LABEL,HQT%OUTPUT_INDEX,HQT%Y_INDEX,HQT%Z_INDEX,&
@@ -1027,7 +1027,7 @@ SUBROUTINE PROC_HVAC
10271027
' used for localized leakage has a DEVC_ID or CTRL_ID.'
10281028
CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.)
10291029
ENDIF
1030-
ENDIF
1030+
ENDIF
10311031
IF (MESHES(NM)%VENTS(NV)%BOUNDARY_TYPE/=HVAC_BOUNDARY) THEN
10321032
SF => SURFACE(MESHES(NM)%VENTS(NV)%SURF_INDEX)
10331033
IF (ABS(SF%VEL)>TWENTY_EPSILON_EB .OR. ABS(SF%VOLUME_FLOW)>TWENTY_EPSILON_EB .OR. &
@@ -1051,10 +1051,10 @@ SUBROUTINE PROC_HVAC
10511051
EXIT NODE_VENT_LOOP
10521052
ENDIF
10531053
ENDDO NODE_VENT_LOOP
1054-
1054+
10551055
IF (.NOT. FOUND) DN%XYZ = -1.E11_EB
10561056
ENDDO MESH_LOOP
1057-
1057+
10581058
! Check if any MPI process has FOUND the VENT
10591059

10601060
IF (N_MPI_PROCESSES>1) CALL MPI_ALLREDUCE(MPI_IN_PLACE,STOP_STATUS,INTEGER_ONE,MPI_INTEGER,MPI_MAX,MPI_COMM_WORLD,IERR)
@@ -1099,7 +1099,7 @@ SUBROUTINE PROC_HVAC
10991099
CF_Y(SF%NODE_INDEX) = CF_Y(SF%NODE_INDEX) + Y*AREA
11001100
CF_Z(SF%NODE_INDEX) = CF_Z(SF%NODE_INDEX) + Z*AREA
11011101
ENDDO FACES_LOOP
1102-
ENDDO NODE_GEOM_LOOP
1102+
ENDDO NODE_GEOM_LOOP
11031103
ENDIF GEOM_IF
11041104

11051105
NODE_LOOP_2: DO NN=1,N_DUCTNODES
@@ -1120,7 +1120,7 @@ SUBROUTINE PROC_HVAC
11201120
', Ductnode ID:',TRIM(DN%ID)
11211121
CALL SHUTDOWN(MESSAGE); RETURN
11221122
ENDIF
1123-
1123+
11241124
IF (DN%GEOM) THEN
11251125
IF (CF_AREA(NN) < TWENTY_EPSILON_EB) THEN
11261126
WRITE(MESSAGE,'(A,I5,A,A,A)') 'ERROR(573): Ductnode:',NN,', Ductnode ID:',TRIM(DN%ID),&
@@ -1131,7 +1131,7 @@ SUBROUTINE PROC_HVAC
11311131
DN%XYZ(2) = CF_Y(NN)/CF_AREA(NN)
11321132
DN%XYZ(3) = CF_Z(NN)/CF_AREA(NN)
11331133
ENDIF
1134-
1134+
11351135
ALLOCATE(DN%DUCT_INDEX(DN%N_DUCTS))
11361136
ALLOCATE(DN%DIR(DN%N_DUCTS))
11371137
DN%DUCT_INDEX = -1
@@ -1347,7 +1347,7 @@ SUBROUTINE INIT_DUCT_NODE
13471347
ELSEIF (IN%MASS_FRACTIONS_SPECIFIED) THEN
13481348
DN%ZZ0(2:N_TRACKED_SPECIES) = IN%MASS_FRACTION(2:N_TRACKED_SPECIES)
13491349
DN%ZZ0(1) = 1._EB - SUM(DN%ZZ0(2:N_TRACKED_SPECIES))
1350-
ENDIF
1350+
ENDIF
13511351
IF (IN%TEMPERATURE > 0._EB) THEN
13521352
DN%TMP0 = IN%TEMPERATURE
13531353
ENDIF
@@ -1378,6 +1378,9 @@ SUBROUTINE HVAC_CALC(T,DT,FIRST_PASS)
13781378

13791379
TNOW = CURRENT_TIME()
13801380

1381+
IF (.NOT. ALLOCATED(LHS)) ALLOCATE(LHS(N_DUCTS+N_DUCTNODES,N_DUCTS+N_DUCTNODES))
1382+
IF (.NOT. ALLOCATED(RHS)) ALLOCATE(RHS(N_DUCTS+N_DUCTNODES))
1383+
13811384
DT_HV = DT
13821385
DT_MT = DT
13831386

@@ -1465,8 +1468,8 @@ SUBROUTINE HVAC_CALC(T,DT,FIRST_PASS)
14651468
ITER = 0
14661469
! Reset mass transport for a new iteration
14671470
DUCTNODE%HMT_FILTER = .FALSE.
1468-
ALLOCATE(LHS(NE%N_MATRIX,NE%N_MATRIX))
1469-
ALLOCATE(RHS(NE%N_MATRIX))
1471+
LHS = 0._EB
1472+
RHS = 0._EB
14701473
DO WHILE (ITER < ITER_MAX)
14711474
IF(ALLOCATED(DUCTRUN)) DUCTRUN%DT_CFL = DT
14721475
IF (HVAC_MASS_TRANSPORT) THEN
@@ -1493,8 +1496,6 @@ SUBROUTINE HVAC_CALC(T,DT,FIRST_PASS)
14931496
CALL CONVERGENCE_CHECK(NNE)
14941497
ITER = ITER + 1
14951498
ENDDO
1496-
DEALLOCATE(LHS)
1497-
DEALLOCATE(RHS)
14981499
ELSE MATRIX_SIZE
14991500
! Reset mass transport for a new iteration
15001501
IF (HVAC_MASS_TRANSPORT) THEN
@@ -1536,7 +1537,7 @@ SUBROUTINE MATRIX_SOLVE(NNE)
15361537
TYPE(DUCTNODE_TYPE), POINTER :: DN
15371538

15381539
NE =>NETWORK(NNE)
1539-
CALL GAUSSJ(LHS,NE%N_MATRIX,NE%N_MATRIX,RHS,1,1,IERR)
1540+
CALL GAUSSJ(LHS(1:NE%N_MATRIX,1:NE%N_MATRIX),NE%N_MATRIX,NE%N_MATRIX,RHS(1:NE%N_MATRIX),1,1,IERR)
15401541
DO ND = 1,NE%N_DUCTS
15411542
DU=>DUCT(NE%DUCT_INDEX(ND))
15421543
IF (DU%FIXED .OR. DU%AREA < TWENTY_EPSILON_EB) CYCLE
@@ -2361,7 +2362,7 @@ SUBROUTINE INITIALIZE_HVAC
23612362
NODE_INDEX = CFA%NODE_INDEX
23622363
IF (NODE_INDEX<=0) RETURN
23632364
ENDIF
2364-
2365+
23652366
IOR = BC%IOR
23662367
II = BC%IIG
23672368
JJ = BC%JJG
@@ -2652,9 +2653,9 @@ SUBROUTINE FIND_NETWORKS(CHANGE,T)
26522653
ENDDO
26532654
IF (N_ZONE > 0) THEN
26542655
DO NZ = 1, N_ZONE
2655-
IF (ALLOCATED(P_ZONE(NZ)%NODE_INDEX)) DEALLOCATE(P_ZONE(NZ)%NODE_INDEX)
2656-
ALLOCATE(P_ZONE(NZ)%NODE_INDEX(ZONE_COUNTER(NZ)))
26572656
P_ZONE(NZ)%N_DUCTNODES = ZONE_COUNTER(NZ)
2657+
IF (.NOT. ALLOCATED(P_ZONE(NZ)%NODE_INDEX)) ALLOCATE(P_ZONE(NZ)%NODE_INDEX(N_DUCTNODES))
2658+
P_ZONE(NZ)%NODE_INDEX = 0
26582659
COUNTER = 1
26592660
DO NN = 1,N_DUCTNODES
26602661
IF (DUCTNODE(NN)%ZONE_INDEX == NZ) THEN
@@ -3681,7 +3682,7 @@ SUBROUTINE UPDATE_HVAC_MASS_TRANSPORT(DT,NR)
36813682
DEALLOCATE(CPT_F)
36823683
DEALLOCATE(CPT_C)
36833684
DEALLOCATE(RHOCPT_C)
3684-
3685+
36853686
ENDDO DUCT_LOOP
36863687

36873688

@@ -4029,8 +4030,6 @@ SUBROUTINE HVAC_QFAN_CALC(T)
40294030
CALL SET_DONOR_QFAN(NR,NF)
40304031
ENDDO
40314032
ELSE
4032-
ALLOCATE(LHS(DR%N_M_DUCTS+DR%N_M_DUCTNODES,DR%N_M_DUCTS+DR%N_M_DUCTNODES))
4033-
ALLOCATE(RHS(DR%N_M_DUCTS+DR%N_M_DUCTNODES))
40344033
DO NF=0,DR%N_QFANS
40354034
IF (NF/=0) THEN
40364035
IF (.NOT. DR%FAN_OPERATING(NF)) CYCLE
@@ -4057,8 +4056,6 @@ SUBROUTINE HVAC_QFAN_CALC(T)
40574056
DUCTRUN(NR)%VEL(:,NF,OLD) = DUCTRUN(NR)%VEL(:,NF,NEW)
40584057
DUCTRUN(NR)%P(:,NF,OLD) = DUCTRUN(NR)%P(:,NF,NEW)
40594058
ENDDO
4060-
DEALLOCATE(LHS)
4061-
DEALLOCATE(RHS)
40624059
ENDIF
40634060
! Deallocate matrices used for solving steady state system curve
40644061
ENDIF FAN_OP_IF
@@ -4384,7 +4381,9 @@ SUBROUTINE MATRIX_SOLVE_QFAN(DUCTRUN_INDEX,NF)
43844381

43854382
DR =>DUCTRUN(DUCTRUN_INDEX)
43864383

4387-
CALL GAUSSJ(LHS,DR%N_M_DUCTS+DR%N_M_DUCTNODES,DR%N_M_DUCTS+DR%N_M_DUCTNODES,RHS,1,1,IERR)
4384+
CALL GAUSSJ(LHS(1:DR%N_M_DUCTS+DR%N_M_DUCTNODES,1:DR%N_M_DUCTS+DR%N_M_DUCTNODES),&
4385+
DR%N_M_DUCTS+DR%N_M_DUCTNODES,DR%N_M_DUCTS+DR%N_M_DUCTNODES,&
4386+
RHS(1:DR%N_M_DUCTS+DR%N_M_DUCTNODES),1,1,IERR)
43884387

43894388
DR%VEL(1:DR%N_M_DUCTS,NF,NEW) =RHS(1:DR%N_M_DUCTS)
43904389
DR%P(1:DR%N_M_DUCTNODES,NF,NEW) = RHS(DR%N_M_DUCTS+1:DR%N_M_DUCTS+DR%N_M_DUCTNODES)

0 commit comments

Comments
 (0)