home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / h / house_ii.zip / FOR / DUCTS.FOR < prev    next >
Text File  |  1992-05-08  |  27KB  |  757 lines
  1.       SUBROUTINE DUCTIN(IDBG)
  2. C
  3. C SP43 DUCT MODEL ROUTINE. JULY84-FEJ
  4. C     ORIGINAL CARRIER CODE HAS BEEN EXTRACTED FROM THE MAIN
  5. C     ROUTINE AND PLACED IN THIS SUBMODEL. MOST OF THE SUBROUTINE
  6. C     PARAMETERS RELATE TO THE ORIGINAL MODEL (IE INPUT IS TRANSFERRED
  7. C     FROM THE MAIN ROUTINE TO THIS ONE). THE BATTELLE DUCT MODEL
  8. C     READS ITS OWN DATA FROM THE INPUT FILE.
  9. C
  10. C THIS SUBMODEL CONSISTS OF THE FOLLOWING ROUTINES
  11. C     1) DUCTIN.....PROCESS INPUT DATA. LOAD COMMON BLOCKS
  12. C     2) RETDUCT....RETURN DUCT MODEL. CONDITIONED SPACE TO FURNACE.
  13. C     3) SUPDUCT....SUPPLY DUCT MODEL. FURNACE TO CONDITIONED SPACE.
  14. C
  15. C
  16. C COMMON BLOCK :
  17. C     /CARDUCT/...TRANSFERS INPUT DATA FOR THE ORIGINAL (CARRIER)
  18. C                 DUCT MODEL TO THE DUCT SUBROUTINES
  19. C     /DUCTS/.....TRANSFERS TEMPERATURE,HEAT FLOW, AND MASS FLOW
  20. C                 INFORMATION BETWEEN THE DUCT SUBROUTINES AND THE
  21. C                 MAIN PROGRAM
  22. C                 ZONE ASSIGNMENTS: 1)ZONE 1, 2)BASEMENT,
  23. C                      3)CRAWLSPACE, 4)ATTIC 1, 5)FURNACE ENCLOSURE,
  24. C                      6)GARAGE, 7)OUTDOORS, 8)ATTIC 2, 9- Z-2,3...
  25. C------------------------------------------------------------------
  26. C *** DUCTIN: DUCT INPUT DATA PROCESSOR
  27. C
  28. CMDK BTUKWH
  29. CMDK CPAIR
  30. CMDK NZN
  31. CMDK NZN7
  32.       LOGICAL FIRST
  33.       REAL TADAVE(NZN)
  34. CMDK BAR
  35. CMDK BLKGS2
  36. CMDK CPDUCTM      
  37. CMDK CARDUCT
  38. CMDK DUCTSC
  39. CMDK DUCTS1
  40. CMDK DUCTS2
  41. CMDK DUCTS4
  42. CMDK FANBLK
  43. CMDK HUMIDC
  44. CMDK TIMEB
  45. C
  46.       DATA FIRST/.TRUE./
  47.       IF(FIRST)THEN
  48.           DO 10 J=1,NZN7
  49.           IF(J.LE.NZN)QDCTBA(J)=0.
  50.           WDUCTZ(J)=0.
  51.    10     QDUCTZ(J)=0.
  52. C     SET CONSTANTS
  53.           C1=U45*BARRAT*REDC
  54.           C2=U45*BARRAT*REDH
  55. C  INITIAL CALL TO BCLSD AND DCTFLW
  56.           IF(SUPDTYP.EQ.'BATTELLE')CALL BCLSD(DTIME,TOTFLOW,TPL,TADAVE,
  57.      +                             QSUP,QSUPB,IDBG)
  58.           ECFMC4=ECFMC2*U45*BARRAT
  59.           FEAFOF=ECFMC2/ECFMC1
  60.           CONS10(1)=ECFMC4
  61.           CONS14(1)=ECFMC4
  62.           C3=BTUKWH/(U45*BARRAT*REDC*CPAIR)
  63.           C4=BTUKWH/(U45*BARRAT*REDH*CPAIR)
  64.           R1=EFSC/ECFC1S
  65.           R2=EFSH/ECFH1S
  66.           ENDIF
  67. C
  68. C  ENTRY FROM DCTFLW
  69.       ENTRY DUCTN(IDBG)
  70. C
  71. C  FLOW CONSTANTS
  72.       EFANC=R1*REDC*ECFMC1
  73.       EFANH=R2*REDH*ECFMH1
  74.       EFANCC(1)=0.
  75.       EFANCC(2)=EFANC*C3/ECFMC1
  76.       EFANCC(3)=EFANH*C4/ECFMH1
  77.       EFANCC(4)=EFANCC(2)
  78.       CFM(1)=ECFMH1*REDH
  79.       CFM(2)=ECFMC1*REDC
  80. C
  81. C *** CALCULATE CONSTANTS FOR DUCT MODELS
  82. C
  83. C        FURNACE AIR FLOW CONSTANTS
  84. C
  85.       CONS9C= (ECFMC1-CFMBP)*C1
  86.       CONS9H= (ECFMH1-CFMBP)*C2
  87.       CONS9S= ECFMC1*C1
  88.       CONS9T= ECFMH1*C2
  89.       CONS10(2)= CONS9C
  90.       CONS10(3)= CONS9H
  91.       CONS10(4)= CONS9C
  92.       DO 110 I=1,4
  93.   110 CONS11(I)=CONS10(I)*CPAIR
  94.       CONS14(2)= CONS9S
  95.       CONS14(3)= CONS9T
  96.       CONS14(4)= CONS9S
  97. C
  98. C           SUPPLY DUCTS
  99. C
  100.       IF(SUPDTYP.EQ.'CARRIER')THEN
  101.           IF(FIRST)THEN
  102.          CONS1=HAD*ASUP*(1.-FSDIB)
  103.          CONS2=HOD*ASUP*(1.-FSDIB)
  104.          CONS3=WSUP*CPDUCTM*(1.-FSDIB)
  105.          CONS4 = 0.
  106.          IF (ABS(CONS3) .GT. 0.) CONS4 = DTIME/CONS3
  107.          CONS1B=HAD*ASUP*FSDIB
  108.          CONS2B=HOD*ASUP*FSDIB
  109.          CONS3B=WSUP*CPDUCTM*FSDIB
  110.          CONS4B = 0.
  111.          IF (ABS(CONS3B) .GT. 0.) CONS4B = DTIME/CONS3B
  112.           ENDIF
  113.          DO 210 I=1,4
  114.             FHADFO=1.0
  115.             IF(I.EQ.1)FHADFO=FEAFOF
  116.             C11=CONS11(I)*(1.0-PSUPL)
  117.             SUPCN(I)= 1.-EXP(-CONS1*FHADFO/C11)
  118.             SUPCNB(I)= 1.-EXP(-CONS1B*FHADFO/C11)
  119.   210    CONTINUE
  120.       ELSE IF(SUPDTYP.EQ.'BATTELLE')THEN
  121. C  THIS IS TO CHECK SUPDTYP INPUT
  122.       ELSE
  123.          WRITE(60,*) 'BAD SUPTYP VALUE IN SUB.DUCTIN...',SUPDTYP
  124.          STOP 'IN SUB.DUCTIN'
  125.       ENDIF
  126. C
  127. C           RETURN DUCTS
  128. C
  129.       IF(RETDTYP.EQ.'CARRIER')THEN
  130.           IF(FIRST)THEN
  131.          CONS5=HAD*ARET*(1.-FRDIB)
  132.          CONS6=HOD*ARET*(1.-FRDIB)
  133.          CONS7=WRET*CPDUCTM*(1.-FRDIB)
  134.          CONS8 = 0.
  135.          IF (ABS(CONS7) .GT. 0.) CONS8 = DTIME/CONS7
  136.          CONS5B=HAD*ARET*FRDIB
  137.          CONS6B=HOD*ARET*FRDIB
  138.          CONS7B=WRET*CPDUCTM*FRDIB
  139.          CONS8B = 0.
  140.          IF (ABS(CONS7B) .GT. 0.) CONS8B = DTIME/CONS7B
  141.           ENDIF
  142.          DO 410 I=1,4
  143.             FHADFO=1.0
  144.             IF(I.EQ.1)FHADFO=FEAFOF
  145.             C11=CONS11(I)*(1.0-PRETL)
  146.             RETCN(I)= 1.-EXP(-CONS5*FHADFO/C11)
  147.             RETCNB(I)= 1.-EXP(-CONS5B*FHADFO/C11)
  148.   410    CONTINUE
  149.       ELSE IF(RETDTYP.EQ.'BATTELLE')THEN
  150.       WRITE(60,*) 'BATTELLE VERSION OF RETURN DUCT MODEL NOT'
  151.      +           ,' IMPLEMENTED'
  152.          WRITE(60,*)  'CARRIER MODEL IS SUFFICIENT'
  153.          STOP 'IN SUB.DUCTIN USE CARRIER RETURN DUCT MODEL'
  154.       ELSE
  155.          WRITE(60,*) 'BAD RETDTYP VALUE IN SUB.DUCTIN...',RETDTYP
  156.          STOP 'IN SUB.DUCTIN'
  157.       ENDIF
  158.       FIRST=.FALSE.
  159.       RETURN
  160.       END
  161.       SUBROUTINE RETDUCT(        I10, TI, IZLVG, TWRT,TWRTB,
  162.      +   TRET,TRETB,QRET,QRETB, FLOW10,FLOW11,FLOW14)
  163. C
  164. C *** RETDUCT:  RETURN DUCT MODEL
  165. C        TI  MEAN AIR TEMP OF ZONES BEING SUPPLIED (SET IN LOOP)
  166. C        IZLVG  LIVING SPACE ZONE WHERE MOST OF RETURN DUCTS ARE
  167. C
  168. CMDK NZN
  169. CMDK NZN7
  170. CMDK CARDUCT
  171. CMDK DUCTSC
  172. CMDK DUCTS1
  173. CMDK DUCTS4
  174. CMDK IZZQ
  175. C
  176. C *** NOTE THAT THE CALLING SEQUENCE FOR THE DUCT MODEL IS
  177. C     RETURN DUCTS, (FURNACE), SUPPLY DUCTS. THE QDUCTZ AND WDUCTZ
  178. C     ARRAYS ARE INITIALIZED IN THIS ROUTINE AND ADDED TO IN SUPDUCT
  179. C
  180. C-----------------------------------------------------------------
  181. C        FLOWS NEEDED BY MAIN PROGRAM ARE DEFINED HERE
  182.       FLOW10=CONS10(I10)
  183.       FLOW11=CONS11(I10)
  184.       FLOW14=CONS14(I10)
  185. C-----------------------------------------------------------------
  186. C        ORIGINAL SP43 RETURN DUCT ROUTINE
  187.       IF(RETDTYP.EQ.'CARRIER')THEN
  188.          TDUCTEB=TZONE(IFLOC)
  189.          TRET=TI+(TWRT-TI)*RETCN(I10)
  190.          C11=CONS11(I10)*(1.0-PRETL)
  191.          TWRTN=CONS8*(C11*(TI-TRET)-CONS6*(TWRT-TI))+TWRT
  192.          TRETB = (TRET+(TWRTB-TRET)*RETCNB(I10))*(1-IBRP)+TDUCTEB*IBRP
  193.          TRETB=((1.0-PRETL)*TRETB+PRETL*TDUCTEB)
  194.          TWRTBN=CONS8B*(C11*(TRET-TRETB)-CONS6B*(TWRTB-TDUCTEB))+TWRTB
  195.          QRET=CONS6*(TWRT-TI)
  196.          QRETB=CONS6B*(TWRTB-TDUCTEB)*(1-IBRP)+
  197.      +               CONS11(I10)*(TI-TDUCTEB)*IBRP
  198. C
  199. C  INITIALIZE DUCT LEAKAGE ENERGY
  200. C
  201.       DO 10 J=1,NZN7
  202.       WDUCTZ(J)=0.
  203.    10 QDUCTZ(J)=0.
  204. C
  205. C   IZLVG IS LVG SPC ZONE WITH THE MAJORITY OF RETURN DUCTS.
  206. C    IT IS SET IN LOOP.
  207.          QDUCTZ(IZLVG)=QRET
  208.          QDUCTZ(IFLOC)=QRETB
  209.          TWRT=TWRTN
  210.          TWRTB=TWRTBN
  211.          RETURN
  212.       ENDIF
  213. C
  214. C-----------------------------------------------------------------
  215. C        BATTELLE RETURN DUCT MODEL
  216. C
  217.       IF(RETDTYP.EQ.'BATTELLE')THEN
  218.       WRITE(60,*) 'BATTELLE VERSION OF RETURN DUCTS WERE NEVER CODED.'
  219.          WRITE(60,*) 'THE CARRIER MODEL IS SUFFICIENT FOR THESE LOW'
  220.          WRITE(60,*) 'TEMPERATURE SIMPLE DUCTS'
  221.          STOP 'SUB.RETDUCT USE CARRIER RETURN DUCT MODEL'
  222.       ENDIF
  223.       STOP 'BAD RETDTYP IN SUB.RETDUCT'
  224.       END
  225. C
  226.       SUBROUTINE SUPDUCT(        I10, TI, IZLVG, TPL, TWSP,TWSPB,
  227.      +    TSUP, TSUPB, QSUP,QSUPB,IDBG)
  228. C
  229. C *** SUPDUCT: SUPPLY DUCT MODEL
  230. C       TI   MEAN AIR TEMP OF ZONES BEING SUPPLIED (SET IN LOOP)
  231. C       IZLVG  LIVING SPACE ZONE WHERE MOST OF RETURN DUCTS ARE
  232. CMDK NZN
  233. CMDK CARDUCT
  234. CMDK DUCTSC
  235. CMDK DUCTS1
  236. CMDK DUCTS4
  237. CMDK IZZQ
  238. CMDK TIMEB
  239.       DIMENSION TSUP(NZN)
  240. C
  241. C------------------------------------------------------------------
  242. C        ORIGINAL SP43 SUPPLY DUCT MODEL
  243. C           (THIS MODEL IS SET FOR SINGLE-ZONE USE)
  244. C
  245.       IF(SUPDTYP.EQ.'CARRIER')THEN
  246.          TODDB=TZONE(7)
  247.          TDUCTEB=TZONE(IFLOC)
  248.          TSUPB=TPL+(TWSPB-TPL)*SUPCNB(I10)
  249.          C11=CONS11(I10)*(1.0-PSUPL)
  250.          TWSPBN=CONS4B*(C11*(TPL-TSUPB)-CONS2B*(TWSPB-TDUCTEB))+TWSPB
  251.          TSUP(1)=TSUPB+(TWSP-TSUPB)*SUPCN(I10)
  252.          TWSPN=CONS4*(C11*(TSUPB-TSUP(1))-CONS2*(TWSP-TI))+TWSP
  253. C
  254. C        EVALUATE EFFECTIVE TEMPERATURES FOR DUCT LEAKAGE
  255.          IF(PSUPL.LT.PRETL) THEN
  256. C           VACUUM ON BASEMENT, PRESSURIZING UPSTAIRS
  257.             TEFFN=TI
  258.             TEFFL=PEDLO*TODDB+(1.0-PEDLO)*TI
  259.          ELSE IF(PSUPL.GT.PRETL) THEN
  260. C           PRESSURIZING BASEMENT, VACUUM UPSTAIRS
  261.             TEFFN=PEDLO*TODDB + (1.0-PEDLO)*TDUCTEB
  262.             TEFFL=TDUCTEB
  263.          ELSE
  264. C           BALANCED LEAKAGE
  265.             TEFFN=0.
  266.             TEFFL=0.
  267.          ENDIF
  268.          QNET(1)=CONS11(I10)*( (1.0-PSUPL)*TSUP(1)- (1.0-PRETL)*TI +
  269.      +                      (PSUPL-PRETL)*TEFFN )
  270.          QLEAK=CONS11(I10)*(PSUPL*TPL-PRETL*TDUCTEB-(PSUPL-PRETL)*TEFFL)
  271.          QSUP=CONS2*(TWSP-TI)
  272.          QSUPB=CONS2B*(TWSPB-TDUCTEB)
  273.          QDUCTZ(IZLVG)= QDUCTZ(IZLVG)+ QSUP
  274.          QDUCTZ(IFLOC)= QDUCTZ(IFLOC)+ QLEAK+QSUPB
  275.          TWSP=TWSPN
  276.          TWSPB=TWSPBN
  277.          RETURN
  278.       ENDIF
  279. C
  280. C------------------------------------------------------------------
  281. C        BATTELLE SUPPLY DUCT MODEL
  282. C
  283.       IF(SUPDTYP.EQ.'BATTELLE')THEN
  284.          TOTFLOW=CONS10(I10)
  285.           QSUP=0.
  286.           QSUPB=0.
  287.          CALL BCLSD(DTIME,TOTFLOW,TPL,TSUP,QSUP,QSUPB,IDBG)
  288.          RETURN
  289.       ENDIF
  290.       STOP 'BAD SUPDTYP IN SUB.SUPDTYP'
  291.       END
  292.       SUBROUTINE BCLSD(DT,TOTFLOW,TPL,TADAVE,QSUP,QSUPB,IDBG)
  293. C
  294. C BCLSD= (B)ATTELLE (C)OLUMBUS (L)ABS (S)UPPLY (D)UCT SUBMODEL
  295. C
  296. C SUPPLY DUCT MODEL SUBROUTINE
  297. C        BHF ORIGINAL MODIFIED BY FEJ (AUG83, JUL84, SEPT84)
  298. C                     MODIFIED BY MTL (SEPT86)
  299. C                     DEBUGGED BY KEH (OCT 86)
  300. C                     MODIFIED FOR MULTIZONE BY RDF (APR 87)
  301. C
  302. C  TZONE(I) DEFINITION (SET IN LOOP AT LINE LOOP117)
  303. C  I= 1  ZONE NO. 1 AIR TEMP
  304. C     2  BASEMENT AIR TEMP
  305. C     3  CRWLSPC AIR TEMP
  306. C     4  ATTIC NO. 1 AIR TEMP
  307. C     5  FURNACE ENCLOSURE AIR TEMP
  308. C     6  GARAGE AIR TEMP
  309. C     7  OUTDOOR AIR TEMP
  310. C     8  ATTIC NO. 2 AIR TEMP
  311. C     9-12  ZONES 2-5 AIR TEMPS
  312. C
  313. CMDK CPAIR
  314. CMDK MAXNODE
  315. CMDK MAXSECT
  316. CMDK NWL
  317. CMDK NZN
  318. CMDK NZW
  319. CMDK RHOAIR
  320. CMDK ZERO
  321.       PARAMETER (EXP1=0.8,EXP2=0.2,SMALL=0.01)
  322. C
  323. CMDK BLKICL
  324. CMDK DUCTS1
  325. CMDK DUCTS2
  326. CMDK DUCTS3
  327. CMDK ENCBK1
  328. CMDK TIMEB
  329.       REAL  A(MAXSECT), D(MAXSECT), DLLAST(MAXSECT), FP1(MAXSECT),
  330.      +      FP2(MAXSECT), HE1(MAXSECT), HE2(MAXSECT),
  331.      +      MCPD(MAXSECT), PCTDZ(16), PCTL1(MAXSECT),
  332.      +      PCTL2(MAXSECT), PE(MAXSECT), PI(MAXSECT), RE(MAXSECT),
  333.      +      RI(MAXSECT), TAD(MAXSECT,MAXNODE), TADAVE(NZN),
  334.      +      TDM1(MAXSECT,MAXNODE), TDM2(MAXSECT,MAXNODE),
  335.      +      XLS(MAXSECT)
  336.       CHARACTER*3 IEND
  337.       INTEGER I2S(MAXSECT), I2SI(MAXSECT), ITYPIN(MAXSECT),
  338.      +      IZNFLR(MAXSECT), NFEED(MAXSECT),
  339.      +      NODES(MAXSECT), NZONE1(MAXSECT), NZONE2(MAXSECT)
  340.       DIMENSION FLWW(5)
  341.       LOGICAL LPRINT,FIRST,IREAD
  342. C
  343.       DATA FIRST/.TRUE./, LPRINT/.FALSE./ ,IREAD/.TRUE./
  344.       DATA PCTDZ/16*1./
  345.       DATA I2S/MAXSECT*0/
  346. C-------------------------------------------------------------
  347. C     FIRST TIME THROUGH (CALLED FROM SUB.DUCTIN)
  348. C     READ DATA, CONVERT PERCENT TO DECIMALS, DETERMINE NO. OF NODES
  349. C     AND LENGTH OF LAST NODE, INITIALIZE TEMPERATURES
  350. C
  351.       IF(.NOT.FIRST)GO TO 55
  352.          FIRST=.FALSE.
  353.          DTIME=DT
  354.          OPEN(2,FILE='TAPE2',STATUS='OLD',IOSTAT=IO2)
  355.          IF(IO2.NE.0)THEN
  356.            WRITE(60,*)' BCLSD: CANT OPEN TAPE2 WITH DUCT DATA'
  357.            STOP ' BCLSD: CANT OPEN TAPE2 WITH DUCT DATA!'
  358.            ENDIF
  359. C
  360. C  NSECT  - TOTAL NO. OF DUCT SECTIONS IN THE SUPPLY DUCTS
  361. C  DL     - LENGTH OF EACH NODE IN EACH DUCT SECTION, FT
  362. C  NSCT2S - TOTAL NO. OF DUCT SECTIONS WITH TWO SURFACES HAVING
  363. C           HEAT LOSS TO SEPARATE ZONES
  364. C  HIFAC  - MULTIPLIER ON CONVECTIVE COEF INSIDE DUCT
  365. C           (IF INPUT AS NEG. VALUE, ORIG H AS IN SINGLE-ZONE MODEL
  366. C            WILL BE USED)
  367. C  ILEAK  - >0 TO READ PCTDZ VALUES (PERCENTAGE MULTIPLIERS ON
  368. C           LEAKAGE FLOWS SPECIFIED BY PCTL1 AND PCTL2.  PCTDZ VALUES
  369. C           ARE FOR EACH OF THE POSSIBLE ZONE DAMPER CONFIGURATIONS,
  370. C           WHICH IS = ILEAK--WHICH IS THE SAME AS NSUM IN DCTFLW)
  371.          READ(2,*,END=900) NSECT,DL,NSCT2S,HIFAC,ILEAK
  372.          IOLDH=0
  373.          IF(HIFAC.LT.0.)THEN
  374.             IOLDH=1
  375.             HIFAC=ABS(HIFAC)
  376.             WRITE(60,500)
  377.          ELSE
  378.             WRITE(60,501)
  379.             ENDIF
  380.          IF(ILEAK.GT.0)THEN
  381. C  PCTDZ - SEE ILEAK ABOVE         
  382.             READ(2,*)(PCTDZ(I),I=1,ILEAK)
  383.             DO 2 I=1,ILEAK
  384.    2        PCTDZ(I)=PCTDZ(I)*.01
  385.             WRITE(60,1040)(PCTDZ(I),I=1,ILEAK)
  386.             ENDIF
  387.          WRITE(60,1000) NSECT,DL,NSCT2S,HIFAC
  388. C
  389.          IF(NSECT.GT.MAXSECT) GO TO 900
  390. C
  391. C !!REQD ORDER OF DUCT SECTIONS READ ON TAPE2::!!!!!
  392. C  ENTER DATA FOR A DUCT SET FOLLOWED BY THAT FOR ANOTHER SET, IF ANY.
  393. C  A DUCT SET CONSISTS OF TRUNK DUCTS FOLLOWED BY BRANCH DUCTS THAT
  394. C  CONNECT TO THESE TRUNK DUCTS.  ENTER TRUNK DUCTS IN ORDER OF
  395. C  CONNECTION, WITH TRUNK DUCT THAT IS CONNECTED TO PLENUM ENTERED
  396. C  FIRST.  NUMBER ISECT = SAME AS ORDER OF READING ON TAPE2, FOR
  397. C  CONVENIENCE.  IF YOU DONT OBSERVE THIS ORDER, CALCULATION OF A
  398. C  DOWNSTREAM SEGMENT WILL USE UPSTREAM AIR TEMPS FROM THE PREVIOUS
  399. C  TIMESTEP RATHER THAN FROM THE PRESENT TIMESTEP.
  400. C    I FROM 1 TO NSECT!!
  401. C  ISECT(I)  - DUCT SECTION OR INDEX NO.(SEE ABOVE)
  402. C  NFEED(I)  - NUMBER OR INDEX OF DUCT SECTION FEEDING THIS DUCT SECTION
  403. C  NZONE1(I) - ZONE IN WHICH DUCT IS LOCATED(SEE DEF. OF I FOR TZONE ABOVE)
  404. C              USUALLY WILL BE 2 BUT COULD BE 1 TO 12!
  405. C  IZNSUP(I) - INDICATOR WHERE AIR FROM THIS DUCT SECTION GOES
  406. C              =0 INTO ANOTHER DUCT SECTION;
  407. C              =I INTO LVG SPC ZONE I (I=1 TO 5)
  408. C  IZNFLR(I) - INDICATOR WHERE HEAT LOSS FROM THIS DUCT SECTION GOES:
  409. C              =0  NOT UP THROUGH FLOOR ELEMENT
  410. C              =I  UP THROUGH FLOOR ELEMENT INTO ZONE I (I=1 TO 5)
  411. C  ITYPIN(I) - =0, NO X/D CORRECTION IN TURBULENT FLOW
  412. C              =1, SQ EDGED ORIFICE AT INLET TO DUCT SECTION
  413. C              =2, 90 DEG ELBOW AT INLET (BOTH 1 AND 2 ARE FOR TURB FLOW)
  414. C  PCTL1(I) - NOTE...PCTL1 IS LEAKAGE FLOW IN PCT OF FLOW
  415. C           IN DUCT RATHER THAN PCT OF TOTAL FURNACE FLOW!!!!!!! ASSIGN
  416. C           PCTL1 TO SECTION OF DUCT RUN CONNECTING TO REGISTER
  417. C           AND NOT TO ANY UPSTREAM DUCT RUNNER SECTIONS. LEAKAGE WILL
  418. C           BE CALCULATED AT FIRST NODE OF THIS ASSIGNED DUCT RUN.
  419. C  XLS(I) - LENGTH OF DUCT SECTION I,FT
  420. C  D(I)   - INTERNAL DIAMETER OF DUCT SECTION I, FT
  421. C  A(I)   - FLOW AREA OF DUCT SECTION I, FT2
  422. C  PI(I)  - INTERIOR PERIMETER OF DUCT SECTION I, FT
  423. C  PE(I)  - EXTERIOR PERIMETER OF DUCT SECTION I, FT
  424. C  RI(I)  - THERMAL RESISTANCE OF INSULATION ON INSIDE OF DUCT SECTION I,
  425. C           FT2-F-HR/BTU
  426. C  RE(I)  - THERMAL RESISTANCE OF INSULATION ON OUTSIDE OF DUCT SECTION I,
  427. C           FT2-F-HR/BTU
  428. C  HE1(I) - EXTERIOR CONVECTIVE HEAT TRANSFER COEF FOR DUCT SECTION I,
  429. C           BTU/HR-FT2-F
  430. C  MCPD(I)- PRODUCT OF MASS AND CP OF DUCT SECTION I, BTU/F
  431. C  
  432.          DO 30 I=1,NSECT
  433.             IF(NSCT2S.EQ.0) THEN
  434.                READ(2,*,END=900) ISECT(I),NFEED(I),NZONE1(I),
  435.      +            IZNSUP(I), IZNFLR(I), ITYPIN(I), PCTL1(I), XLS(I),
  436.      +            D(I),A(I),PI(I),PE(I),RI(I),RE(I),HE1(I),MCPD(I)
  437.                FP1(I)=1.
  438.                FP2(I)=0.
  439.                HE2(I)=HE1(I)
  440.                PCTL2(I)=0.
  441.                NZONE2(I)=NZONE1(I)
  442.             ELSE
  443. C
  444. C    INDENTIFY SECTIONS WITH 2 DUCT WALL SURFACES
  445.                IF(IREAD) THEN
  446.                   IREAD=.FALSE.
  447.                   IF(NSCT2S.NE.0)THEN
  448. C I2SI IS DUCT SECT NO. OF DUCTS EXPOSED TO TWO ENVIRONMENTS
  449.                     READ(2,*,END=900) (I2SI(K), K=1, NSCT2S)
  450.                     DO 10 K=1,NSCT2S
  451.                     I2SQ=I2SI(K)
  452.    10               I2S(I2SQ)=1
  453.                     ENDIF
  454.                ENDIF
  455. C
  456.                   IF(I2S(I).NE.0) THEN
  457. C   FP1, FP2 ARE FRACTION OF PERIMETER EXPOSED TO TZONE(NZONE1)
  458. C            AND TZONE2(NZONE2), RESPECTIVELY
  459. C   PCTL2(I) - SEE PCTL1(I) ABOVE BUT FOR LEAKAGE TO 2ND ENVIRONMENT
  460. C   HE2(I)  - SEE HE1(I) ABOVE BUT FOR HEAT TRANSFER COUPLING WITH
  461. C             2ND ENVIRONMENT
  462.                      READ(2,*,END=900) ISECT(I), NFEED(I), NZONE1(I),
  463.      +                  NZONE2(I), IZNSUP(I), IZNFLR(I), ITYPIN(I),
  464.      +                  PCTL1(I), PCTL2(I), XLS(I), D(I),
  465.      +                  A(I), PI(I), PE(I), FP1(I), FP2(I),
  466.      +                  RI(I), RE(I), HE1(I), HE2(I), MCPD(I)
  467.                   ELSE
  468.                      READ(2,*,END=900) ISECT(I),NFEED(I),NZONE1(I),
  469.      +                  IZNSUP(I), IZNFLR(I), ITYPIN(I), PCTL1(I),
  470.      +                  XLS(I),D(I),A(I), PI(I),PE(I),RI(I),RE(I),
  471.      +                  HE1(I),MCPD(I)
  472.                      FP1(I)=1.
  473.                      FP2(I)=0.
  474.                      HE2(I)=HE1(I)
  475.                      PCTL2(I)=0.
  476.                      NZONE2(I)=NZONE1(I)
  477.                   ENDIF
  478.             ENDIF
  479.             WRITE(60,1010)ISECT(I), NFEED(I), NZONE1(I), NZONE2(I),
  480.      +         IZNSUP(I), IZNFLR(I),ITYPIN(I), PCTL1(I), PCTL2(I),
  481.      +         XLS(I),D(I), A(I), PI(I), PE(I), FP1(I), FP2(I),
  482.      +         RI(I), RE(I), HE1(I), HE2(I), MCPD(I)
  483.             PCTL1(I)=PCTL1(I)*0.01
  484.             PCTL2(I)=PCTL2(I)*0.01
  485. C  NODES(I) IS NO. OF DL-LENGTH NODES PER DUCT SECTION
  486.             NODES(I)=INT(XLS(I)/DL)
  487. C  DLLAST(I) IS LENGTH OF LAST NODE IN DUCT SECTION I
  488.             DLLAST(I)= XLS(I) - NODES(I)*DL
  489.             IF(DLLAST(I).LT. SMALL ) THEN
  490.                DLLAST(I)=DL
  491.             ELSE
  492.                NODES(I)=NODES(I)+1
  493.             ENDIF
  494.             IF(NODES(I).GT.MAXNODE) THEN
  495.                NODES(I)=MAXNODE
  496.                DLLAST(I)= XLS(I) - NODES(I)*DL
  497.                WRITE(60,*) ' BCLSD: WARNING! SECTION ',I,' IS TOO LONG.'
  498.               WRITE(60,*) ' THE LAST SECTION IS ',DLLAST(I),' FT LONG!!'
  499.                WRITE(60,*) ' SO, INCREASE VALUE OF PARAMETER MAXNODE'
  500.             ENDIF
  501.             DO 20 J=1,NODES(I)
  502.             NZ1=NZONE1(I)
  503.             TDM1(I,J)=TZONE(NZ1)
  504.             IF(I2S(I).NE.0)THEN
  505.                NZ2=NZONE2(I)
  506.                TDM2(I,J)=TZONE(NZ2)
  507.                TAD(I,J)=0.5*(TZONE(NZ1)+TZONE(NZ2))
  508.             ELSE
  509.                TAD(I,J)=TZONE(NZ1)
  510.                ENDIF
  511.    20       CONTINUE
  512.             HE1(I)=1./(RE(I)+1./HE1(I))
  513.             HE2(I)=1./(RE(I)+1./HE2(I))
  514.    30    CONTINUE
  515.           TPLS=TPL
  516. C  READ LINES UNTIL ENCOUNTER  END  IN 1ST THREE COLUMNS
  517.    32 READ(2,502)IEND
  518.       IF(IEND.NE.'END')GO TO 32          
  519. C  INITIAL CALL TO DCTFLW
  520.           CALL DCTFLW(IDBG)
  521.          GO TO 200
  522. C
  523. C-------------------------------------------------------------
  524. C     FOR EACH TIMESTEP, RUN THROUGH EACH SECTION (CALLED FROM MAIN PGM
  525. C
  526.    55  CONTINUE
  527.           DO 60 I=1,NZN
  528.           TADAVE(I)=0.
  529.           FLWW(I)=0.
  530.    60     QNET(I)=0.
  531.       QLEAK=0.0
  532. C  ICOL IS SET IN DCTFLW
  533.           PCTD=PCTDZ(ICOL)
  534.       DO 120 I=1,NSECT
  535.           IZN=IZNSUP(I)
  536.           NZ1=NZONE1(I)
  537.           NZ2=NZONE2(I)
  538.           NFD=NFEED(I)
  539.           NDS=NODES(I)
  540.           ISCT=ISECT(I)
  541.           DI=D(I)
  542.           ITYPD=ITYPIN(I)
  543.           FLOW=TOTFLOW*PCTF(I)
  544.           IF(FLOW.LT.0.)THEN
  545.              WRITE(60,1050)ISCT,PCTF(I)
  546.              STOP 'BCLSD:FLOW NEGATIVE'
  547.              ENDIF
  548.           IF(NFD.EQ.0)THEN
  549.               NDSP=1
  550.           ELSE
  551.               NDSP=NODES(NFD)
  552.               ENDIF
  553. C
  554.          SUMQD=0.
  555.          XLSUM=0.
  556.          DO 110 J=1,NDS
  557.             QLEAKI=ZERO
  558.             WLEAKI=ZERO
  559.             QLEAK1=ZERO
  560.             WLEAK2=ZERO
  561. C
  562. C           FOR EACH NODE@D SET INLET TEMP = OUTLET OF PREVIOUS NODE
  563.             IF(J.EQ.1) THEN
  564.                IF(NFD.EQ.0) THEN
  565.                   TAD(I,J)=TPL
  566.                ELSE
  567.                   TAD(I,J)=TAD(NFD,NDSP)
  568.                ENDIF
  569. C
  570. C     CALCULATE ENERGY LOSS DUE TO AIR LEAKAGE FROM DUCT TO ZONE
  571. C        (FIRST NODE OF SECTION ONLY)
  572. C
  573.                IF(PCTL1(I).GT.ZERO.OR.PCTL2(I).GT.ZERO) THEN
  574.                   CTD1= TAD(I,J)-TZONE(NZ1)
  575.                   WLEAK1= FLOW*PCTL1(I)*PCTD
  576.                   QLEAK1= WLEAK1*CPAIR*CTD1
  577.                   WLEAK2=0.
  578.                   QLEAK2=0.
  579.                   CTD2=CTD1
  580.                   IF(I2S(I).NE.0) THEN
  581.                      CTD2=TAD(I,J)-TZONE(NZ2)
  582.                      WLEAK2= FLOW*PCTL2(I)*PCTD
  583.                      QLEAK2= WLEAK2*CPAIR*CTD2
  584.                      ENDIF
  585.                   WLEAKI=WLEAK1+WLEAK2
  586.                   FLOW=FLOW-WLEAKI
  587.                   QLEAKI=QLEAK1+QLEAK2
  588.                   QLEAK=QLEAK+QLEAKI
  589.                ELSE
  590.                   QLEAK2=0.
  591.                   WLEAK1=0.
  592.                ENDIF
  593.             ELSE
  594.                TAD(I,J)=TAD(I,J-1)
  595.             ENDIF
  596. C
  597. C     DETERMINE HEAT FLOWS (Q IN BTUH)
  598. C        FOR DUCT SECTIONS WITH 2 HEAT TRANSFER SURFACES, ASSUME
  599. C        HI AND RI ARE THE SAME FOR BOTH SURFACES
  600. C  GET CONVECTIVE HEAT TRANSFER COEFFICIENT FOR INSIDE DUCT SECTION
  601.             TA=TAD(I,J)
  602.                DLEN=DL
  603.                IF(J.EQ.NDS)DLEN=DLLAST(I)
  604.             IF(TOTFLOW.LT.10.)THEN
  605.                HI=0.
  606.             ELSE
  607.                XLSUM=XLSUM+DLEN
  608.                XOD=XLSUM/DI
  609. C        DETERMINE MASS VELOCITY IN DUCT AND CONVECTIVE H
  610.                G=FLOW/A(I)
  611.                CALL HDUCT(ISCT,TA,G,DI,XOD,ITYPD,IOLDH,HI,IDBG)
  612.                HI=HIFAC/(RI(I)+1./HI)
  613.                ENDIF
  614.             TM1=TDM1(I,J)
  615.             QDTA1=HI    *PI(I)*DLEN*FP1(I)*(TM1-TA)
  616.             QDTZ1=HE1(I)*PE(I)*DLEN*FP1(I)*(TM1-TZONE(NZ1))
  617.             IF(I2S(I).EQ.0) THEN
  618. C              SECTIONS WITH A SINGLE DUCT WALL
  619.                QDTA2=0.
  620.                QDTZ2=0.
  621.             ELSE
  622. C              SECTIONS WITH TWO DUCT WALL SURFACES
  623.                TM2=TDM2(I,J)
  624.                QDTA2=HI    *PI(I)*DLEN*FP2(I)*(TM2-TA)
  625.                QDTZ2=HE2(I)*PE(I)*DLEN*FP2(I)*(TM2-TZONE(NZ2))
  626.                ENDIF
  627.             TDM1(I,J)=TM1-(QDTZ1+QDTA1)*DTIME/
  628.      +                (FP1(I)*MCPD(I)*DLEN/XLS(I))
  629.             IF(TDM1(I,J).LT.TZONE(NZ1))THEN
  630.                QDTZ1=0.
  631.                TDM1(I,J)=TZONE(NZ1)
  632.                TM1=TDM1(I,J)
  633.                ENDIF
  634.             IF(FP2(I).NE.0.) THEN
  635.                TDM2(I,J)=TM2-(QDTZ2+QDTA2)*DTIME/
  636.      +                (FP2(I)*MCPD(I)*DLEN/XLS(I))
  637.                IF(TDM2(I,J).LT.TZONE(NZ2))THEN
  638.                   QDTZ2=0.
  639.                   TDM2(I,J)=TZONE(NZ2)
  640.                   TM2=TDM2(I,J)
  641.                   ENDIF
  642.             ELSE
  643.                TDM2(I,J)=TDM1(I,J)
  644.                ENDIF
  645. C
  646. C           DETERMINE THE NEW TEMPERATURES (FOR NEXT TIME STEP)
  647.             IF(HI.EQ.0.)THEN
  648.                TAD(I,J)=TA
  649.             ELSE
  650.                TAD(I,J)=TA+(QDTA1+QDTA2)/(FLOW*CPAIR)
  651. C              IF(FP2(I).EQ.0.)THEN
  652. C                IF(TAD(I,J).LT.TDM1(I,J))THEN
  653. C                   TAD(I,J)=TDM1(I,J)
  654. C                   QDTA1=0.
  655. C                   GO TO 90
  656. C                   ENDIF
  657. C             ELSE
  658. C                IF(TDM1(I,J).LT.TDM2(I,J))THEN
  659. C                   IF(TAD(I,J).LT.TDM1(I,J))THEN
  660. C                      TAD(I,J)=TDM1(I,J)
  661. C                      QDTA1=0.
  662. C                      GO TO 90
  663. C                      ENDIF
  664. C                ELSE
  665. C                   IF(TAD(I,J).LT.TDM2(I,J))THEN
  666. C                      TAD(I,J)=TDM2(I,J)
  667. C                      QDTA2=0.
  668. C                      GO TO 90
  669. C                      ENDIF
  670. C                   ENDIF
  671. C                ENDIF
  672.               ENDIF
  673. C  90      CONTINUE
  674. C
  675. C      SUM HEAT&MASS FLOWS FOR SUPPLY AIR AND EXTERNAL ZONES
  676. C         BTU/HR AND LBM/HR RESPECTIVELY
  677.           SUMQD=SUMQD+QDTZ1+QLEAK1
  678.             QDUCTZ(NZ1)=QDUCTZ(NZ1)+QDTZ1 + QLEAK1
  679.             QDUCTZ(NZ2)=QDUCTZ(NZ2)+QDTZ2 + QLEAK2
  680.             WDUCTZ(NZ1)=WDUCTZ(NZ1)+WLEAK1
  681.             WDUCTZ(NZ2)=WDUCTZ(NZ2)+WLEAK2
  682. C  SUM DUCT HEAT LOSS TO LVG SPC (QSUB) AND TO BSMT(QSUPB)
  683.           IF(NZONE1(I).EQ.1.OR.NZONE1(I).GT.8)QSUP=QSUP+QDTZ1
  684.           IF(NZONE1(I).EQ.2)QSUPB=QSUPB+QDTZ1
  685.   110    CONTINUE
  686.       IF(IZNFLR(I).GT.0)THEN
  687.           IZNF=IZNFLR(I)
  688.           QDCTBA(IZNF)=QDCTBA(IZNF)+SUMQD
  689.           ENDIF
  690.       IF(IZN.NE.0)THEN
  691.           IQZ=1
  692.           IF(IZN.GT.1)IQZ=IZN+7
  693.           DQNET=FLOW*CPAIR*(TAD(I,NDS)-TZONE(IQZ))
  694.           QNET(IZN)=QNET(IZN)+ DQNET
  695.           FLWW(IZN)=FLWW(IZN)+FLOW
  696.           RAT=PCTF(I)/RWSDCT(IZN)
  697.           DTAV=TAD(I,NDS)*RAT
  698.           TADAVE(IZN)=TADAVE(IZN)+DTAV
  699.           ENDIF
  700.   120 CONTINUE
  701. C      WRITE(20,567)TIME*60.,TOTFLOW/20.,TPL,FLWW(1)/20.,QNET(1),
  702. C     +FLWW(2)/20.,QNET(2),FLWW(3)/20.,QNET(3)
  703. C  567 FORMAT(1X,F8.3,2X,F7.2,2X,F6.1,2X,3(F7.2,2X,F8.1,4X))
  704. C-------------------------------------------------------------
  705. C     PRINT OUT RESULTS WHEN LPRINT=TRUE
  706. C
  707.       IF(LPRINT)THEN
  708.          DO 190 I=1,NSECT
  709.           NDS=NODES(I)
  710.               WRITE(60,1030)ISECT(I),TAD(I,1),TDM1(I,2),TDM2(I,2),
  711.      +                     TAD(I,NDS), TDM1(I,NDS), TDM2(I,NDS)
  712.   190    CONTINUE
  713.          TIN=TPL*0.505+TPLS*0.495
  714. C  NOTE::DEFF BELOW ONLY VALID FOR ZONE NO. 1
  715.          DEFF=(TADAVE(1)-TZONE(1))/(TIN-TZONE(1))
  716.          WRITE(60,3000) TADAVE
  717.           WRITE(60,3010)DEFF
  718.       ENDIF
  719.       TPLS=TPL
  720. C     STOP 'BCLSD: STOPPED AT FIRST RETURN'
  721.   200 CONTINUE
  722.       RETURN
  723. C
  724. C-------------------------------------------------------------
  725. C        ERROR EXIT
  726. C
  727.   900 CONTINUE
  728.       WRITE(60,*) 'BCLSD: ??? IN READING DUCT DATA ON TAPE2'
  729.       STOP 'TROUBLE IN SUB.DUCT'
  730. C
  731.   500 FORMAT(1H0,'ORIGINAL TURB CONVECT COEF USED WITHIN DUCTS')
  732.   501 FORMAT(1H0,'LAM AND TURB CONVECT COEF USED WITHIN DUCTS'/
  733.      +'  WITH ENTRANCE LENGTH CORRECTION IF ITYPIN > 0 FOR SECTION')
  734.   502 FORMAT(A3)
  735.  1000 FORMAT('0BATTELLE SUPPLY DUCT MODEL.',I5,' SECTIONS. ',
  736.      +'DIFFERENTIAL LENGTH=',F5.2,' FT.',/,
  737.      +'0NO. OF SECTIONS WITH TWO SURFACES=',I3,/,
  738.      +'0 HIFAC = ',G13.5,' MULTIPLIER ON ALL DUCT INTERIOR H VALUES'//
  739.      +'0ISECT NFED  NZ1  NZ2  SUP  FLR ITYP PCTL1 PCTL2  XLS  D   ',
  740.      +'A   PI    PE    FP1    FP2    RI    RE   HE1   HE2   MCP',
  741.      +'   HIFAC')
  742.  1010 FORMAT(2I6,5I4,F6.1,2F6.2,F6.1,F5.2,F6.3,2F6.2,2F7.4,4F6.3,F7.1,
  743.      +       F7.1)
  744.  1020 FORMAT('0FOR ZONE ',I3,' FLOW FRACTION SUPPLIED IS=',G13.5)
  745.  1030 FORMAT(1X,'ISECT= ',I4,' INLET TEMPS(DEG F)--AIR,METAL(1),',
  746.      +          'METAL(2)=',3G13.5/
  747.      +12X,'OUTLET TEMPS(DEG F)--AIR,METAL(1),METAL(2)=',3G13.5)
  748.  1040 FORMAT(1X,'MULTIPLIERS ON LEAKAGE FLOWS FOR EACH SETTING OF '
  749.      +,'ZONE DAMPERS= '/5X,16F6.3)
  750.  1050 FORMAT(1X,'BCLSD: FLOW FOR DUCT NO. ',I5,' NEG. PCTF(I)= ',
  751.      +G13.5)
  752.  3000 FORMAT(1X,'PREDICTED DUCT EXIT T(AVE FOR EA ZONE)= ',5F6.1)
  753.  3010 FORMAT(1X,'PREDICTED DUCT EFFICIENCY  =   ',F6.3)
  754.  3020 FORMAT(1H0,'SEE SUGGESTED ORDER OF DUCT-SECTION DATA IN ',
  755.      +'LISTING FOR SUBPROGRAM BCLSD')
  756.       END
  757.