From f0f4df6ee59e9b4ac2761ff643aea02810c109d0 Mon Sep 17 00:00:00 2001 From: Jason Floyd Date: Wed, 4 Feb 2026 12:06:10 -0500 Subject: [PATCH] FDS Source: Simplify allocations. --- Source/hvac.f90 | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/Source/hvac.f90 b/Source/hvac.f90 index 8d5a8ae9cd..c57fe64db9 100644 --- a/Source/hvac.f90 +++ b/Source/hvac.f90 @@ -738,7 +738,7 @@ SUBROUTINE READ_HVAC N_NODE_QUANTITY = N_NODE_QUANTITY + 1 ENDDO ALLOCATE (NODE_QUANTITY_ARRAY(N_NODE_QUANTITY)) - NODE_QUANTITY_ARRAY(1:N_NODE_QUANTITY)%DRY = DRY(1:N_NODE_QUANTITY) + NODE_QUANTITY_ARRAY(1:N_NODE_QUANTITY)%DRY = DRY(1:N_NODE_QUANTITY) DO N=1, N_NODE_QUANTITY HQT => NODE_QUANTITY_ARRAY(N) 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 ' used for localized leakage has a DEVC_ID or CTRL_ID.' CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ENDIF - ENDIF + ENDIF IF (MESHES(NM)%VENTS(NV)%BOUNDARY_TYPE/=HVAC_BOUNDARY) THEN SF => SURFACE(MESHES(NM)%VENTS(NV)%SURF_INDEX) IF (ABS(SF%VEL)>TWENTY_EPSILON_EB .OR. ABS(SF%VOLUME_FLOW)>TWENTY_EPSILON_EB .OR. & @@ -1051,10 +1051,10 @@ SUBROUTINE PROC_HVAC EXIT NODE_VENT_LOOP ENDIF ENDDO NODE_VENT_LOOP - + IF (.NOT. FOUND) DN%XYZ = -1.E11_EB ENDDO MESH_LOOP - + ! Check if any MPI process has FOUND the VENT 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 CF_Y(SF%NODE_INDEX) = CF_Y(SF%NODE_INDEX) + Y*AREA CF_Z(SF%NODE_INDEX) = CF_Z(SF%NODE_INDEX) + Z*AREA ENDDO FACES_LOOP - ENDDO NODE_GEOM_LOOP + ENDDO NODE_GEOM_LOOP ENDIF GEOM_IF NODE_LOOP_2: DO NN=1,N_DUCTNODES @@ -1120,7 +1120,7 @@ SUBROUTINE PROC_HVAC ', Ductnode ID:',TRIM(DN%ID) CALL SHUTDOWN(MESSAGE); RETURN ENDIF - + IF (DN%GEOM) THEN IF (CF_AREA(NN) < TWENTY_EPSILON_EB) THEN WRITE(MESSAGE,'(A,I5,A,A,A)') 'ERROR(573): Ductnode:',NN,', Ductnode ID:',TRIM(DN%ID),& @@ -1131,7 +1131,7 @@ SUBROUTINE PROC_HVAC DN%XYZ(2) = CF_Y(NN)/CF_AREA(NN) DN%XYZ(3) = CF_Z(NN)/CF_AREA(NN) ENDIF - + ALLOCATE(DN%DUCT_INDEX(DN%N_DUCTS)) ALLOCATE(DN%DIR(DN%N_DUCTS)) DN%DUCT_INDEX = -1 @@ -1347,7 +1347,7 @@ SUBROUTINE INIT_DUCT_NODE ELSEIF (IN%MASS_FRACTIONS_SPECIFIED) THEN DN%ZZ0(2:N_TRACKED_SPECIES) = IN%MASS_FRACTION(2:N_TRACKED_SPECIES) DN%ZZ0(1) = 1._EB - SUM(DN%ZZ0(2:N_TRACKED_SPECIES)) - ENDIF + ENDIF IF (IN%TEMPERATURE > 0._EB) THEN DN%TMP0 = IN%TEMPERATURE ENDIF @@ -1378,6 +1378,9 @@ SUBROUTINE HVAC_CALC(T,DT,FIRST_PASS) TNOW = CURRENT_TIME() +IF (.NOT. ALLOCATED(LHS)) ALLOCATE(LHS(N_DUCTS+N_DUCTNODES,N_DUCTS+N_DUCTNODES)) +IF (.NOT. ALLOCATED(RHS)) ALLOCATE(RHS(N_DUCTS+N_DUCTNODES)) + DT_HV = DT DT_MT = DT @@ -1465,8 +1468,8 @@ SUBROUTINE HVAC_CALC(T,DT,FIRST_PASS) ITER = 0 ! Reset mass transport for a new iteration DUCTNODE%HMT_FILTER = .FALSE. - ALLOCATE(LHS(NE%N_MATRIX,NE%N_MATRIX)) - ALLOCATE(RHS(NE%N_MATRIX)) + LHS = 0._EB + RHS = 0._EB DO WHILE (ITER < ITER_MAX) IF(ALLOCATED(DUCTRUN)) DUCTRUN%DT_CFL = DT IF (HVAC_MASS_TRANSPORT) THEN @@ -1493,8 +1496,6 @@ SUBROUTINE HVAC_CALC(T,DT,FIRST_PASS) CALL CONVERGENCE_CHECK(NNE) ITER = ITER + 1 ENDDO - DEALLOCATE(LHS) - DEALLOCATE(RHS) ELSE MATRIX_SIZE ! Reset mass transport for a new iteration IF (HVAC_MASS_TRANSPORT) THEN @@ -1536,7 +1537,7 @@ SUBROUTINE MATRIX_SOLVE(NNE) TYPE(DUCTNODE_TYPE), POINTER :: DN NE =>NETWORK(NNE) -CALL GAUSSJ(LHS,NE%N_MATRIX,NE%N_MATRIX,RHS,1,1,IERR) +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) DO ND = 1,NE%N_DUCTS DU=>DUCT(NE%DUCT_INDEX(ND)) IF (DU%FIXED .OR. DU%AREA < TWENTY_EPSILON_EB) CYCLE @@ -2361,7 +2362,7 @@ SUBROUTINE INITIALIZE_HVAC NODE_INDEX = CFA%NODE_INDEX IF (NODE_INDEX<=0) RETURN ENDIF - + IOR = BC%IOR II = BC%IIG JJ = BC%JJG @@ -2652,9 +2653,9 @@ SUBROUTINE FIND_NETWORKS(CHANGE,T) ENDDO IF (N_ZONE > 0) THEN DO NZ = 1, N_ZONE - IF (ALLOCATED(P_ZONE(NZ)%NODE_INDEX)) DEALLOCATE(P_ZONE(NZ)%NODE_INDEX) - ALLOCATE(P_ZONE(NZ)%NODE_INDEX(ZONE_COUNTER(NZ))) P_ZONE(NZ)%N_DUCTNODES = ZONE_COUNTER(NZ) + IF (.NOT. ALLOCATED(P_ZONE(NZ)%NODE_INDEX)) ALLOCATE(P_ZONE(NZ)%NODE_INDEX(N_DUCTNODES)) + P_ZONE(NZ)%NODE_INDEX = 0 COUNTER = 1 DO NN = 1,N_DUCTNODES IF (DUCTNODE(NN)%ZONE_INDEX == NZ) THEN @@ -3681,7 +3682,7 @@ SUBROUTINE UPDATE_HVAC_MASS_TRANSPORT(DT,NR) DEALLOCATE(CPT_F) DEALLOCATE(CPT_C) DEALLOCATE(RHOCPT_C) - + ENDDO DUCT_LOOP @@ -4029,8 +4030,6 @@ SUBROUTINE HVAC_QFAN_CALC(T) CALL SET_DONOR_QFAN(NR,NF) ENDDO ELSE - ALLOCATE(LHS(DR%N_M_DUCTS+DR%N_M_DUCTNODES,DR%N_M_DUCTS+DR%N_M_DUCTNODES)) - ALLOCATE(RHS(DR%N_M_DUCTS+DR%N_M_DUCTNODES)) DO NF=0,DR%N_QFANS IF (NF/=0) THEN IF (.NOT. DR%FAN_OPERATING(NF)) CYCLE @@ -4057,8 +4056,6 @@ SUBROUTINE HVAC_QFAN_CALC(T) DUCTRUN(NR)%VEL(:,NF,OLD) = DUCTRUN(NR)%VEL(:,NF,NEW) DUCTRUN(NR)%P(:,NF,OLD) = DUCTRUN(NR)%P(:,NF,NEW) ENDDO - DEALLOCATE(LHS) - DEALLOCATE(RHS) ENDIF ! Deallocate matrices used for solving steady state system curve ENDIF FAN_OP_IF @@ -4384,7 +4381,9 @@ SUBROUTINE MATRIX_SOLVE_QFAN(DUCTRUN_INDEX,NF) DR =>DUCTRUN(DUCTRUN_INDEX) -CALL GAUSSJ(LHS,DR%N_M_DUCTS+DR%N_M_DUCTNODES,DR%N_M_DUCTS+DR%N_M_DUCTNODES,RHS,1,1,IERR) +CALL GAUSSJ(LHS(1:DR%N_M_DUCTS+DR%N_M_DUCTNODES,1:DR%N_M_DUCTS+DR%N_M_DUCTNODES),& + DR%N_M_DUCTS+DR%N_M_DUCTNODES,DR%N_M_DUCTS+DR%N_M_DUCTNODES,& + RHS(1:DR%N_M_DUCTS+DR%N_M_DUCTNODES),1,1,IERR) DR%VEL(1:DR%N_M_DUCTS,NF,NEW) =RHS(1:DR%N_M_DUCTS) DR%P(1:DR%N_M_DUCTNODES,NF,NEW) = RHS(DR%N_M_DUCTS+1:DR%N_M_DUCTS+DR%N_M_DUCTNODES)