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 / LOOP.FOR < prev    next >
Text File  |  1992-05-11  |  21KB  |  622 lines
  1.       SUBROUTINE LOOP(ACINFL,  ATOUT, AVENC2, DTIM2, DTCRW, FLOC,
  2.      +FLOWIN, HDUM, HUMON, ICL1, ICYC1, ICYC6, ICYCCP, IDAYM, ILINES, 
  3.      +INC, ISUM, MPRINT, NROUT,POWA, QBASVN, QCONRF, QCRAD,
  4.      +QHUMT, QINFC, QINFS, QINT, QLOSRF, QRAD, QSKY, QSPT,
  5.      +QWAS, RDUM, RELHMI,RHA,RLOADL, RLOADS, TBAS, TDUM, TISUM, TMRSUM,
  6.      +TODDBR, TONMAX, TRO, TS, WATER, WINFC, WINFSS, WINT, WODFAC,
  7.      +WODHMR, IDBG) 
  8. C 
  9. C-----PERFORMS GASASHR TIME LOOP
  10. C 
  11. C-----CONSTANTS 
  12. CMDK BTUKWH
  13. CMDK CPAIR
  14. CMDK FTR
  15. CMDK NHBK
  16. CMDK NHRO
  17. CMDK NHRP
  18. CMDK NZN
  19. CMDK NIWL
  20. CMDK NOUTDY
  21. CMDK NWL
  22. CMDK NWN
  23. CMDK NZN7
  24. CMDK NZW
  25. CMDK RHOAIR
  26. CMDK LPSTRB
  27. CMDK DUCTS5
  28. CMDK FANBLK
  29. CMDK ACND
  30. CMDK BAR
  31. CMDK BLK10
  32. CMDK BLK85
  33. CMDK BLKCM2
  34. CMDK BLKGS2
  35. CMDK BLKQGS
  36. CMDK BLKQS
  37. CMDK COLLEC
  38. CMDK DTRQ
  39. CMDK DUCTS1
  40. CMDK DUCTS2
  41. CMDK DUCTS4
  42. CMDK ENCBK1
  43. CMDK ENCBK2
  44. CMDK ENCBLK
  45. CMDK FUEL1
  46. CMDK HANDBK
  47. CMDK HUMIDC
  48. CMDK IELCB
  49. CMDK INDIC1
  50. CMDK IWETHR
  51. CMDK IZWQ
  52. CMDK IZZQ
  53. CMDK MRTBLK
  54. CMDK MZON1
  55. CMDK OUTPUT
  56. CMDK OWETHR
  57. CMDK QUAYCH
  58. CMDK QUAYLE
  59. CMDK PRT1
  60. CMDK SOLARB
  61. CMDK STRUCA
  62. CMDK SURFAR
  63. CMDK TEMP1
  64. CMDK TEMPB
  65. CMDK TIMEB
  66. CMDK BLKTM2
  67. CMDK TSTATC
  68. CMDK TSTB2
  69. CMDK TSTB3
  70. CMDK TSTB4
  71. CMDK WIBLK
  72. CMDK ITM
  73.       REAL    UNDEF , RMVOL(NZN), RMVL(NZN)
  74. C     "UNDEF" SET TO 9.999999E36, AND IS USED TO TRAP UNDEF REF
  75. C 
  76. C-----ARGUMENTS 
  77.       INTEGER FLOC (NZN7), NROUT(24), IBLPF(4)
  78.       REAL    ACINFL(NZN), AIRMAS(NZN), ATOUT(12,24), 
  79.      +      FLOWIN(NZN), QINFC(NZN), QINFS(NZN),  QWALL(6), 
  80.      +        TATTCN(2), TIN(NZN), TISUM(NZN), TMRSUM(NZN), TSUP(NZN),
  81.      +        WINFSS(NZN), WINFC(NZN), WIN(NZN) 
  82. C 
  83. C-----INITIALIZATIONS 
  84.       DATA UNDEF/9.99999E36/
  85.       DATA IBLPF  /0, 0, 1, 0/
  86.       DATA IFIRST /1/ 
  87.       DATA QP     /0.0/ 
  88.       DATA WIZLS/9999./
  89.       IF(ITIM.EQ.0)THEN 
  90.          ITIM=1 
  91. C  NOTE:   ITIM GETS RESET TO 0 IN TSTATD  FOR 121486 RUN WHICH CHANGES 
  92. C          FROM ICTRLZ(1-3) = 1 AT START TO CHANGE CONTROLLED ZONES TO 
  93. C          ICTRLZ(2) = 1 ONLY AT NOON OF FIRST DAY         
  94. C  IS FURNACE IN CONDITIONED SPACE????   IF SO, IFLC1 = 1 !!!!
  95.          IFLC1=0
  96.          IF(IFLOC.EQ.1.OR.IFLOC.GT.8)IFLC1=1
  97.          IF(IFLOC.EQ.2.AND.ICTRLZ(NZNBAS).GT.0)IFLC1=1
  98.          DO 3 IJ=1,NROOMS
  99.          NRM=NRMA(IJ)
  100. C  RMVOL VALUES ARE VOLUMES OF CONTROLLED ZONES OTHER THAN W/ FURNACE         
  101.          RMVOL(NRM)=0.
  102.          IF(ICTRLZ(NRM).GT.0.AND.NRM.NE.NZNBAS)RMVOL(NRM)=ROMVOL(NRM)
  103. C  RMVL VALUES ARE VOLUMES OF CONTROLLED ZONES         
  104.          RMVL(NRM) = 0.
  105.          IF(ICTRLZ(NRM).GT.0)RMVL(NRM)=ROMVOL(NRM)
  106.     3    CONTINUE         
  107.          ENDIF
  108. C 
  109.       DTIME=DTIM2
  110.       DO 50 L=1, NSUBDV 
  111. C 
  112.          IF (TENCLO (IDAYM).GE.999.0) TENCLO (IDAYM)=TODDB
  113. C  MEAN TEMPERATURE AND SPECIFIC HUMIDITY IN ALL ZONES
  114. C    AVERAGED BY SUPPLY-AIR FRACTIONS (RWSDCT)
  115.       TIM=AVGWV(TI,NROOMS,RWSDCT) 
  116.       WIM=AVGWV(WI,NROOMS,RWSDCT) 
  117. C MEAN INDOOR TEMPERATURE WEIGHTED BY CONDITIONED ZONE VOLUMES
  118.       TIMN=AVGWV(TI,NROOMS,RMVL)
  119. C MEAN INDOOR TEMP IN ZONES OTHER THAN THE BASEMENT IN CONDITIONED ZONEZ      
  120.       TIMNB=AVGWV(TI,NROOMS,RMVOL)
  121. C !!!!!TZONE VALUES ARE SET FOR USE IN DUCT ROUTINES
  122.          TZONE (1)=TI(1)
  123.          TZONE (2)=TBAS 
  124.          TZONE (3)=TCRW 
  125.          TZONE (4)=TATTC(1) 
  126.          TZONE (5)=TENCLO (IDAYM) 
  127.          TZONE (6)=TGARAG 
  128.          TZONE (7)=TODDB
  129.          TZONE (8)=TATTC(2) 
  130.          DO 4 JT=2,NZN
  131.          IF(NROOMS.GE.JT)THEN 
  132.            TZONE(JT+7)=TI(JT) 
  133.          ELSE 
  134.            TZONE(JT+7)=UNDEF
  135.            ENDIF
  136.    4     CONTINUE 
  137. C--------CALCULATE ATTIC AIR TEMPERATURE
  138.          CALL TAATTC(ATCDT,QAVENT,QCEIL1,QWALL(5),RAIRAT,TATTCN,
  139.      +               TODDBR,         WODFAC, IDBG)
  140. C 
  141.          TAIN=TZONE (IFLOC) 
  142.          TCOMB=TAIN*IDIRCT1+TODDB*IDIRCT
  143.          IF(IFLOC.EQ.2)THEN
  144.            WIZ=WI(NZNBAS)
  145.          ELSE IF(IFLOC.GT.8)THEN
  146.            WIZ=WI(IFLOC-7)
  147.          ENDIF
  148.          IF(WIZ.NE.WIZLS)THEN
  149.            IPSY= -4
  150.            CALL PSY(IPSY,TAIN,TWBI,TDUM,RHDUM,WIZ,HDUM)
  151.            WIZLS=WIZ
  152.          ENDIF
  153. C--------IS THE INDOOR FAN ON?
  154.          I10=1+IAC+2*IEFAN
  155. C 
  156. C--------RETURN DUCTS 
  157. C  SET LVG SPC ENVIRONMENT FOR DUCTS
  158.       IZLVG=1 
  159.       IF(NROOMS.GT.1)THEN 
  160. C                        FIND MAX VALUE OF RWSDCT 
  161.           RWSMX=0.
  162.           DO 5 I=1,NROOMS 
  163.           NRM=NRMA(I)
  164.           IF(RWSDCT(I).GT.RWSMX)THEN
  165.               RWSMX=RWSDCT(I) 
  166.               IZLVG=NRM 
  167.               IF(NRM.GT.1)IZLVG=NRM+7
  168.               ENDIF 
  169.    5      CONTINUE
  170.           ENDIF 
  171.           CALL RETDUCT (         I10, TIM, IZLVG, TWRT, TWRTB, TRET,
  172.      +      TRETB, QRET, QRETB, FLOW10, FLOW11, FLOW14) 
  173. C--------CALCULATE BASEMENT MOISTURE INFILTRATION, BALANCE
  174.          VMIX=FLOW10
  175.          IF (IBRP.GT.0) THEN
  176. C   AIR IS RETURNED TO FURNACE THOUGH BASEMENT WITH NO RETURN DUCTS 
  177.             TMIX=TBAS 
  178.             WMIX=WBAS 
  179.             WROOM=FLOW10*(WIM-WBAS) 
  180.             AVENVB=ACINFL(NZNBAS)*ROMVOL(NZNBAS)
  181.             WINFB=AVENVB*(WODHMR-WBAS*RHOAIR)+FINFB*(1-FLOC (1))* 
  182.      +         (WODHUM-WBAS)+WAIRB*(WIM-WBAS)*FLOC (1)*(1-FLOC (7)) 
  183.             WSUMB=(WROOM+WINFB)*DTIME 
  184.             WBASN=(WSUMB/AIRMSB)+WBAS 
  185.          ELSE 
  186.             TMIX=TRETB
  187.             WMIX=WIM
  188.          END IF 
  189. C--------CALCULATE MIXTURE AFTER HUMIDIFIER BYPASS MIXING 
  190.          WMIXS=WMIX 
  191.          IF (CFMBP.NE.0.0) THEN 
  192.             IF (IEFAN.NE.0) THEN
  193.                VMXX=WA1+VMIX
  194.                WMIX=(WA1*WBULK+VMIX*WMIX)/VMXX
  195.                TMIX=(TBULK*WA1+TMIX*VMIX)/VMXX
  196.             END IF
  197.          END IF 
  198. C   AIR TEMPERATURE TO FURNACE HEAT EXCHANGER(INCLUDES BLOWER DELTA T)
  199.          TRETP=TMIX+EFANCC (I10)
  200.          DTBLR=EFANCC (I10) 
  201.          IF(IMODE.EQ.1.OR.(IMODE.EQ.2.AND.CFMBP.GT.0.))THEN
  202.            IPSY=-4
  203.            CALL PSY (IPSY, TRETP, TRETWB, TDUM, RDUM, WMIX, HDUM) 
  204.          ELSE
  205. C            DEACTIVATE MOISTURE BAL IN HEATING MODE (TO SAVE TIME)
  206.            TRETWB=TRETP-5.
  207.          ENDIF
  208.          IF (TRETWB.GT.TRETP) TRETWB=TRETP-.01
  209. C 
  210.          IF (IMODE.EQ.1) THEN 
  211.             CMPUMP=0. 
  212.             IRGSF=1 
  213.             IF (IFIRST.EQ.1) CALL PLENUM
  214.             IFIRST=0
  215.          ELSE 
  216.             IHON=H2ON (IT)-TIME 
  217. C 
  218. C-----------CALL THE FURNACE SUBROUTINES
  219.             CALL GASF 
  220.             IF (IELC.EQ.0) THEN 
  221.                QP=QPILOT*(1-IBURN)
  222.             ELSE
  223.                QP=QPILOP
  224.             END IF
  225.             NRDF1=1 
  226. C 
  227.            CMPUMP=((CMFANP+PUMPWP)*IBURN+CMFANP*ICL1*(1-IBURN))*REDH
  228.            QEXT=QEXT*REDH 
  229.            QPLEN=QPLEN*REDH 
  230.            QVENTB=QVENTB*REDH 
  231.            QVNTLS=QVNTLS*REDH 
  232.            QVENTA=QVENTA*REDH 
  233.            QDRAFT=QDRAFT*REDH 
  234.            QJACK=QJACK*REDH 
  235.            WAIRB=WAIRB*REDH 
  236.            TB=TPL 
  237.          END IF 
  238. C 
  239. C--------HUMIDIFIER PERFORMANCE 
  240.          IF (IMODE.EQ.2) CALL HUMDF3 (TIM)
  241. C 
  242. C--------A/C AND PLENUM PERFORMANCE FOR COOLING MODE
  243.          IF (IMODE.EQ.1) THEN 
  244.             TAIN=TBAS 
  245.             WAIRB=0.
  246.             CPWAIR=CPAIR*ECFMC1*IAC*U45*BARRAT
  247.             CALL ACND2 (IEFAN, TRETWB, TRETB) 
  248.          END IF 
  249. C 
  250. C--------SUPPLY DUCTS 
  251.          CALL SUPDUCT (         I10, TIM, IZLVG, TPL, TWSP, TWSPB,
  252.      +      TSUP, TSUPB, QSUP, QSUPB,IDBG)
  253. C--------CALCULATE BASEMENT AND CRAWL SPACE TEMPERATUTES
  254. C 
  255. C--------CALCULATE THE FURNACE/PLENUM HEAT LOSS, AND ADDED INFILTRATION 
  256.          QPLENB=(QPLEN+QJACK)*NCELLS
  257.          IF (IDIRCT.EQ.1) THEN
  258.             XQADNC=0.
  259.             QIZFRNB=0.0
  260.             QIFRNB=0.0
  261.          ELSE IF (IFLOC.EQ.2) THEN
  262. C  NOTE: INFILTRATION IN LVG SPC ZONE CAUSED BY FURNACE OPERATION IN
  263. C        BASEMENT IS SPLIT BY RATIO OF FLOOR AREAS IN TAZONE.  XQADNC 
  264. C        BELOW IS USED IN THAT CALCULATION
  265.             XQADNC=CPAIR*WAIRB*PHI*PHIINF*SRCEAB
  266. C     QIFRNB - INFLITRATION DIRECTLY INTO BASEMENT DUE TO FURN OPERATION
  267. C     QIZFRNB - INTERZONE HEAT FLOW FROM LIVING SPACES TO BASEMENT DUE TO
  268. C               FURNACE OPERATION.             
  269. C   NOTE: TIMNB HERE SHOULD BE FOR ALL OTHER ZONES
  270.             QIZFRNB=XQADNC*(TIMNB-TI(NZNBAS))
  271.             QIFRNB=CPAIR*WAIRB*PHI*PHIINF*(1.0-SRCEAB)*
  272.      +             (TODDB-TI(NZNBAS))
  273.          ELSE 
  274. C   FURNACE IS NOT IN BASEMENT!         
  275.             XQADNC=CPAIR*WAIRB*PHI*PHIINF
  276.             QIZFRNB=0.
  277.             QIFRNB=0.
  278.          END IF 
  279.          IF (IDEBUG.EQ.1) WRITE(60, 500) QIFRNB,XQADNC, PHI,
  280.      +      PHIINF,WAIRB, CPAIR, SRCEAB, TIMN, TCOMB, TODDB 
  281.          QFRLFE=(QPLENB+QDRAFT+QVENTB+CMPUMP*BTUKWH)
  282.          TATTCN(NATVNT)=TATTCN(NATVNT)+(QFRLFE+XQADNC*
  283.      +           (TODDB-TATTC(NATVNT))*FLOC (4)+QDUCTZ (4))*ATCDT/RAIRAT
  284. C 
  285. C        AIR COND CAPACITIES NOW CALCULATED IN ACOND 11/5/85 KEH
  286. C 
  287.          WAC=WMIX-WMOIST/FLOW14 
  288.          WHUM=VMIX*(WAC-WIM)
  289. C - -- - - - - - - - - -- - 
  290. C  GET ZONE AIR TEMPERATURES
  291.          CALL TAZONE(AIRMAS,CMPUMP,QCEIL4,QDCTZN,QFLBAS,QFLCRW,
  292.      +               QFRLFE,QFLSPB,QFLSPC,QINC,QINF,QINFB,QINFC,
  293.      +               QINFFRN,QINFS,QINT,QNT,QPART,QRADCB,QSLFL,
  294.      +               QSUM,QSUM1,QSUM2,QWALL,QWGR,QWINST,QIZONE,
  295.      +               TBAS,TCRW,TIN,XQADNC,IDBG) 
  296.       IF(IBAS.GT.0)THEN 
  297.           QINFB=QINFB+QIFRNB
  298.           QINFFRN=QINFFRN+QIFRNB
  299.           CALL TBZONE(AIRMAS,FLOC,FLOW11,QBASFT,QBWAG,QBWBGT, 
  300.      +    QDCTZF,QFLBAS,QFRLFE,QINCB,QINFB,QINFC,QINFS,QINT,QIZFRNB,
  301.      +    QNT,QPARTB,QRADCB,QRETB,QSUMB,QSUMB1,QSUMB2,QIZONB,TBAS,
  302.      +    TBASN,TIMNB,TIN,IDBG) 
  303.           IF(ICTRLZ(NZNBAS).GT.0)THEN 
  304. C               CEILING Q IN BSMT IS ADDED INTO QSUMB2 IN TBZONE IF 
  305. C               BSMT IS A CONTROLLED ZONE.  IT IS NOT ADDED INTO
  306. C               QCEIL4, BECAUSE QCEIL4 IS RESERVED FOR CEILING-TO-
  307. C               ATTIC HEAT FLOW 
  308.              QSUM1=QSUM1+QSUMB1 
  309.              QINF=QINF+QINFB
  310.              QINC=QINC+QINCB
  311.              QPART=QPART+QPARTB 
  312.              QSUM2=QSUM2+QSUMB2 
  313.              QIZONE=QIZONE+QIZONB 
  314.              QDCTZN=QDCTZN+QDUCTZ(2)
  315.              ENDIF
  316.           ENDIF 
  317. C--------CRAWL SPACE
  318.          IF (ICRW.GT.0) THEN
  319.             AFLCR1=AWALLA(IZWH)*H1F 
  320.             QCRWVN=AVENC2*(TCRW-TODDB)
  321.             QGRND=AFLCR1*(TCRW-TODAG1)
  322.             TCRWN=(QFLCRW-QCRWVN-QGRND+ 
  323.      +         QFRLFE*FLOC (3)+QDUCTZ (3))*DTCRW+TCRW 
  324.          END IF 
  325. C  SAVE INDOOR AIR TEMPS USED TO DETERMINE MEAN DAILY VALUE IN GASASHR
  326.          DO 18 JT=1,NROOMS
  327.          TMRSUM(JT)=TMRSUM(JT)+TMR(JT)
  328.    18    TISUM(JT)=TISUM(JT)+TI(JT) 
  329.          ISUM=ISUM+1
  330. C - - - - - - - - - - - - - - - - - - - - 
  331. C--------MOISTURE BALANCE ON ROOM 
  332. C              DEACTIVATE IN HEATING MODE TO SAVE TIME.
  333. C              IN HEATING MODE, CALC MOISTURE WITH HUMIDIFIER OPERATION
  334.          
  335.          IF(IMODE.EQ.1.OR.(IMODE.EQ.2.AND.CFMBP.GT.0.))THEN
  336.            CALL WIZONE(AIRMAS,FINFB,FLOC,FLOW10,FLOW14,WIN,
  337.      +               WIM,WINF,WINFC,WINFS,WINFSS,WINT,IDBG) 
  338. C              FIND REL HUMIDITY TO EVAP COIL,  RHIN     
  339.            IPSY=-4
  340.            WIMN=AVGWV(WI,NROOMS,ROMVOL) 
  341.            CALL PSY (IPSY, TIMN, TDUM, TDUM, RHIN, WIMN, HDUM)
  342.          ELSE
  343.            DO 19 JT=1,NROOMS
  344.    19      WIN(JT)=WI(JT)
  345.            RHIN = RELHMI
  346.          ENDIF
  347.          IF (IWATER.GT.0 .AND. IWATER.LT.120) THEN
  348.             IWATER=IWATER+1 
  349.             WRITE(60, 501) RHIN, WIMN, WINF, WINT, WHUM, WINFS 
  350.          END IF 
  351. C 
  352. C--------FIND NEW SET POINTS FOR ALL THERMOSTATS
  353. C  ALSO PRINT EVENT FILES: AND IF IBPRT, PRINT TI AND ALL EVENTS
  354.          CALL TSTATD (5, IAC, IAC1, IBURN, IEFAN, IDBG) 
  355.          IF (MODE.LE.1) THEN
  356.             RHSN=TCRH*(RHI-RHS)+RHS 
  357.             IHUMN=(1.-.0001*(RHSN-(SETHS+DIFFHS*IHUM)))*IBLPF (I10) 
  358.          END IF 
  359. C 
  360. C========WRITE PROGRAM GENERATED EVENT FILE(MOVED TO TSTATD 3/7/88) 
  361. C  MEAN SUPPLY AIR TEMP TO ACTIVELY CONDITIONED ZONES 
  362.       TSUPM=AVGWV(TSUP,NROOMS,RWSDCT) 
  363. C 
  364. C========ILINES USAGE:  
  365. C        = 1, DEBUG PRINT 
  366. C        = 2, STORE HOURLY TOTALS 
  367. C        = 3, SKIP DEBUG AND HOURLY STORAGE 
  368.          IF (ILINES.EQ.3) GO TO 30
  369.          IF (ILINES.EQ.1) THEN
  370.             WRITE(60, 503) TIME, TODDB, TI(1), RHI, TPL, TSUPM,
  371.      +         TRETB, TBAS, TATTC(1), TFLUE, IAC, IBURN, IEFAN, IHON, 
  372.      +         EXCESS 
  373.             WRITE(60, 504) QVENTB, QSUPB, QRETB, QPLENB, QDRAFT, 
  374.      +         QINFFRN, QBASFT, I10
  375.             WRITE(60, *) 'QDUCTZ, WDUCTZ...', QDUCTZ, WDUCTZ 
  376.             LINES=LINES+1 
  377.             IF (LINES.GT.IDEBUG .AND. NSEQW.EQ.0) ILINES=3
  378.             IF (NDPRE.NE.0) GO TO 30
  379.          END IF 
  380. C--------END OF SPACE CALCULATIONS
  381. C--------CALCULATE HOURLY TOTALS
  382.          HROUT (1, IT)=HROUT (1, IT)+TODDB
  383.          HROUT (2, IT)=HROUT (2, IT)+TIMN 
  384.          HROUT (3, IT)=HROUT (3, IT)+RHI
  385.          HROUT (4, IT)=HROUT (4, IT)+IAC
  386.          HROUT (5, IT)=HROUT (5, IT)+IBURN
  387.          HROUT (6, IT)=HROUT (6, IT)+IEFAN-IAC
  388.          HROUT (7, IT)=HROUT (7, IT)+QEXT+QP
  389.          HROUT (8, IT)=HROUT (8, IT)+EFANPH*(IEFAN-IAC) 
  390.          HROUT (9, IT)=HROUT (9, IT)+CMPUMP 
  391.          HROUT (10, IT)=HROUT (10, IT)+QSUM1
  392.          HROUT (11, IT)=HROUT (11, IT)+QCEIL4 
  393.          HROUT (12, IT)=HROUT (12, IT)+QINF 
  394.          HROUT (13, IT)=HROUT (13, IT)+QWINST 
  395. C        SUM THE DUCT LOSSES NOT IN THE CONDITIONED SPACE 
  396.          SQDZ=0.0 
  397.           IQDZS=2 
  398.           IF(ICTRLZ(NZNBAS).NE.0)IQDZS=3
  399.          DO 20 IQDZ=IQDZS,8 
  400.             SQDZ=SQDZ+QDUCTZ (IQDZ) 
  401.    20       CONTINUE
  402.          HROUT (14, IT)=HROUT (14, IT)+QSUM2-SQDZ-QDCTZF
  403.          HROUT (15, IT)=HROUT (15, IT)+ 
  404.      +      (WINF+WINT+VMIX*(WMIXS-WIM)+WINFS)*1061.
  405.          HROUT (16, IT)=HROUT (16, IT)-TCR
  406.          HROUT (17, IT)=HROUT (17, IT)-SHCR 
  407.          HROUT (18, IT)=HROUT (18, IT)+POW*IAC
  408.          HROUT (19, IT)=HROUT (19, IT)+EFANC*IAC
  409.          HROUT (20, IT)=HROUT (20, IT)+CFANPC*IAC 
  410.          HROUT (21, IT)=HROUT (21, IT)+FLOW11*(TPL-TRETB) 
  411.          HROUT (22, IT)=HROUT (22, IT)+QFRLFE*IFLC1+QVNTLS
  412.          HROUT (23, IT)=HROUT (23, IT)+TMIX 
  413.          HROUT (24, IT)=HROUT (24, IT)+TBAS 
  414.          HROUT (25, IT)=HROUT (25, IT)+QFRLFE*(1-IFLC1) 
  415.          HROUT (26, IT)=HROUT (26, IT)+WSPED
  416.          HROUT (27, IT)=HROUT (27, IT)+WAIRB
  417. C        HROUT (28, IT) IS COLLECTED AT THE END OF EACH HOUR IN HOUS_II
  418.          ACINV=AVGWV(ACINFL,NROOMS,ROMVOL)
  419.          HROUT (29, IT)=HROUT (29, IT)+ACINV
  420.          TOTVOL=TOTV(ROMVOL,NROOMS) 
  421.          HROUT (30, IT)=HROUT (30, IT)+ 
  422.      +      WAIRB*PHI*SRCEAB/(RHOAIR*TOTVOL)
  423.          HROUT (31, IT)=HROUT (31, IT)+TSUPM
  424.          TATCM=AVGWV(TATTC,NATC,ATCVOL) 
  425.          HROUT (32, IT)=HROUT (32, IT)+TATCM
  426.          HROT(1,IT)=HROT(1,IT)+SQDZ 
  427.          HROT(2,IT)=HROT(2,IT)+QNT
  428.          HROT(3,IT)=HROT(3,IT)+QDCTZN 
  429. C 
  430.          IF (IAPRT.EQ.1) THEN 
  431. C  NOTE----VALUES BELOW ARE FOR ATTIC 1 ONLY
  432.             ATOUT (1, IT)=ATOUT (1, IT)+TRO 
  433.             ATOUT (2, IT)=ATOUT (2, IT)+TMP(1,IZT+1)
  434.             ATOUT (3, IT)=ATOUT (3, IT)+TMP(4,IZT+1)
  435.             ATOUT (4, IT)=ATOUT (4, IT)+TMP(1,IZWC) 
  436.             ATOUT (5, IT)=ATOUT (5, IT)+TMP(4,IZWC) 
  437. C           ATOUT (6, IT)=NOT USED CURRENTLY
  438.             ATOUT (7, IT)=ATOUT (7, IT)+0.
  439.             ATOUT (8, IT)=ATOUT (8, IT)+QLOSRF
  440.             ATOUT (9, IT)=ATOUT (9, IT)+QCONRF
  441.             ATOUT (10, IT)=ATOUT (10, IT)+QSKY
  442.             ATOUT (11, IT)=ATOUT (11, IT)+QCRAD 
  443.          END IF 
  444. C 
  445.          IF (WHUM.LT.0.0) WHUM=0.0
  446.          WATER=WATER+WHUM 
  447.          QSPT=QSPT+QSP
  448.          QWAS=QWAS+QWA
  449.          QHUMT=QHUMT+QHUM 
  450.          HUMON=HUMON+IHUM 
  451.          INC=INC+1
  452.          NROUT (IT)=NROUT (IT)+1
  453. C 
  454. C--------KEEP TRACK OF HANDBOOK FACTORS 
  455. C 
  456.          IF (HBKRNL.GE.0.0) THEN
  457.             HBKPEI=QEXT+QP
  458.             HBKAEI=BTUKWH*(CMPUMP+EFANPH*(IEFAN-IAC)+EFANPC*IAC)
  459. C  SUM OF DUCT LOSSES IN CONDITIONED SPACE
  460.             SQDZCS=QDUCTZ(1)
  461.             IF(ICTRLZ(NZNBAS).NE.0)SQDZCS=SQDZCS+QDUCTZ(2)
  462.             IF(NROOMS.GT.1)THEN 
  463.                IQ=8 
  464.                DO 22 IR=2,NROOMS
  465.                IQ=IQ+1
  466.                SQDZCS=SQDZCS+QDUCTZ(IQ) 
  467.    22          CONTINUE 
  468.                ENDIF
  469.             HBK (1)=HBK (1)+FLOW11*(TA2-TMIX) 
  470.             HBK (2)=HBK (2)+(HBKPEI+HBKAEI)-(QVLLOS+QVSLOS)
  471.             HBK (3)=HBK (3)+QPLEN*NCELLS+(SQDZ+SQDZCS)+QNT
  472.             HBK (4)=HBK (4)+HBKPEI
  473.             HBK (5)=HBK (5)+HBKAEI
  474.             HBK (6)=HBK (6)+QNT 
  475.             HBK (7)=HBK (7)+QNT+QVNTLS+SQDZCS+(QFRLFE)*IFLC1
  476.          END IF 
  477. C 
  478. C--------COLLECT DATA FOR WRITING 
  479.          IF (ICOLL.NE.0) THEN 
  480.             CTIME (1)=KM
  481.             CTIME (2)=IDAYM 
  482.             CTIME (3)=IT
  483.             CTIME (4)=TIME
  484. C 
  485. C           CDATA (5 TO 16) IS SET IN GASF
  486. C 
  487.             CDATA (17)=TRETB
  488.             CDATA (18)=TSUPM
  489.             CDATA (19)=HROUT (7, IT)
  490.             CDATA (20)=HROUT (8, IT)
  491.             CDATA (21)=TIMN 
  492.             CDATA (22)=TMR(1) 
  493.             CDATA (23)=QIZONE 
  494.             IF(NROOMS.GT.1)CDATA(23)=TMR(2) 
  495.             CDATA (24)=TBAS 
  496.             CDATA (25)=TATCM
  497.             CDATA (26)=TMP(1,IZWJ)
  498.             CDATA (27)=TMP(3,IZWJ)
  499.             CDATA (28)=WSPED
  500.             CDATA (29)=ACINV
  501.             CDATA (30)=VENBAS 
  502. C 
  503.             CDATA (32)=TGARAG 
  504.             CDATA (33)=TODDB
  505.             FLWINT=TOTV(FLOWIN,NROOMS)
  506.             CDATA (34)=FLWINT 
  507.             CDATA (35)=TMP(1,IZWF)
  508. C  ABOVE GROUND BASEMENT WALL (IZWD)
  509.             CDATA (36)=TMP(3,IZWK)
  510.             CDATA (37)=TMP(4,IZWS(2)) 
  511.             CDATA (38)=TMP(4,IZT+1) 
  512.             CDATA (39)=TMP(4,IZWC)
  513.             CDATA (40)=TMP(4,IZWS(1)) 
  514.             CDATA (41)=TMP(4,IZWS(3)) 
  515.             CDATA (42)=TMP(4,IZWS(4)) 
  516.             CDATA (43)=TMP(3,IZWF)
  517.             CDATA (44)=TMP(1,IZWK)
  518.             CDATA (45)=TMP(1,IZWS(2)) 
  519.             CDATA (46)=TMP(1,IZT+1) 
  520.             CDATA (47)=TMP(1,IZWC)
  521.             CDATA (48)=TMP(3,IZWG)
  522.             CDATA (49)=TODAG1 
  523.             CDATA (50)=TODAG2 
  524.             DO 24 IR=1,NROOMS 
  525.             NRM=NRMA(IR)
  526.             CDATA(50+NRM)=TI(NRM) 
  527.             CDATA(55+NRM)=TMR(NRM)
  528.    24       CONTINUE
  529. C           CDATA (64)      IS SET IN TSTAT 
  530. C 
  531.             CALL COLLECT (1)
  532.          ENDIF
  533. C 
  534.          IF (INC.EQ.MPRINT) THEN
  535.             MPRINT=MPRINT+NINC
  536.             WRITE(60, 505) TIME, TODDB, TI(1), RHI, TPL, TSUPM,
  537.      +         TRETB, TBAS, TATTC(1), TFLUE, IAC, IBURN, IEFAN, IHON, 
  538.      +         EXCESS 
  539.          END IF 
  540. C 
  541. C--------CHECK FOR CYCLING OF A/C 
  542.          IF (IACN.NE.IAC) ICYCCP=ICYCCP+1 
  543. C         
  544. C--------CHECK FOR CYCLING OF THE BURNER AND COLLECT TIME AND TEMP
  545.          IF ((IBURNN*(1-2*IBURN)+IBURN).GE.1) THEN
  546.             ICYC1=ICYC1+1 
  547.             IF (IBURNN.EQ.0 .AND. ICYC1.GT.1) THEN
  548.                TON=TIME-TIMCYL
  549.                IF (TON.GT.TONMAX) TONMAX=TON
  550.                END IF 
  551.             TIMCYL=TIME 
  552.             END IF
  553.          IF (IHUMN.NE.IHUM) ICYC6=ICYC6+1 
  554. C--------RESET VALUES 
  555.    30 CONTINUE
  556.          DO 32 JT=1,NROOMS
  557.          TI(JT)=TIN(JT) 
  558.    32    WI(JT)=WIN(JT) 
  559.          RHI=RHIN 
  560. C--------RESET VALUES IN THERMOSTAT MODEL 
  561.          CALL TSTATD (6, IAC, IAC1, IBURN, IEFAN,IDBG)
  562.          RHS=RHSN 
  563.          TBAS=TBASN 
  564.          WBAS=WBASN 
  565.          TCRW=TCRWN 
  566.          IAC=IACN 
  567.          RHA=RHA+RHI
  568.          QLSWL=0. 
  569.          QLSFL=0.
  570.          SOLRQ=0. 
  571.          DO 34 JT=1,NROOMS
  572.          NRM=NRMA(JT) 
  573.          QLSWL=QLSWL+QLOSWL(NRM)
  574.          QLSFL=QLSFL+QLOSFL(NRM)
  575.          SOLRQ=SOLRQ+SOLARL(NRM+2)
  576.    34    TA(NRM)=TA(NRM)+TI(NRM)
  577.          DO 36 IA=1,NATC
  578.          TATTC(IA)=TATTCN(IA) 
  579.    36    TATTA(IA)=TATTA(IA)+TATTC(IA)
  580.          TCRWA=TCRWA+TCRW 
  581.          TS=TS+TVENTI 
  582.          IHUM=IHUMN 
  583. C--------RESET THE EVAP FAN FLOW RATE VALUE 
  584.          IBL=1+IAC
  585.          TBASA=TBASA+TBAS 
  586. C 
  587.          EFAN=EFANPH*(IEFAN-IAC)
  588.          CALL QACCUM (TINDEX, DTIME, 56, QWALL (1), QWALL (2),
  589.      +      QWALL (3), QWALL (4), QWGR, QFLSPB, QFLSPC, QLSWL,
  590.      +      QWALL(6), QWINST, QINF, QSLFL, QPART, QLSFL, QINT, QINC, 
  591.      +      QRAD, QNT, QDUCTZ (1), SOLRQ,      QVNTLS, QSUM1, QSUM2,
  592.      +      QSUM, QLOSRF, QBWAG, QBWBGT, QBASFT, QFLBAS, QBASVN, QFRLFE,
  593.      +      QDUCTZ (2), QLEAK, QVENTB,  QWALL(5), 
  594.      +      QRADRF,    QCEIL1, QAVENT, QVENTA, QPLENB, QDRAFT, QINFFRN,
  595.      +      CMPUMP, QPLEN, QJACK, QVSLOS, QVLLOS, QEXT, EFAN, 
  596.      +      QP, QFLCRW, QCRWVN, QGRND)
  597. C--------STEP TIME
  598.          TIME=TIME+DTIME
  599.          TINDEX=TINDEX+DTIME
  600.          TIMEOY=TINDEX-24.0 
  601.          RLOADS=RLOADS+SHCR*IAC 
  602.          RLOADL=RLOADL+(TCR-SHCR)*IAC 
  603.          POWA=POWA+POW*IAC
  604. C         IF(ITMQQ.GE.24)GO TO 52
  605.    50    CONTINUE 
  606. C 
  607.       IF(IDBG.NE.0)THEN 
  608.           DO 60 IZU=1,IZT 
  609.    60     WRITE(60,506)IZU,(TMP(I,IZU),I=1,4)
  610.           ENDIF 
  611.       RETURN
  612. C 
  613.   500 FORMAT (' LOOP:QIFRNB,XQADNC,PHI,PHIINF,WAIRB,CPAIR,SRCEAB,', 
  614.      +'TI(1),TCOMB,TODDB= '/2X,5G13.5/4X,5G13.5)
  615.   501 FORMAT (' WATER BAL INFO ', 6E12.4) 
  616.   503 FORMAT (1X, F8.3, 9F10.2, 4I5, F8.3, ' *')
  617.   504 FORMAT (7E13.4, I5) 
  618.   505 FORMAT (1X, F8.3, 9F10.2, 4I5, F8.3)
  619.   506 FORMAT(1X,'IZW,(TMP(I,IZW),I=1,4)=',I5,4G13.5)
  620.  7081 FORMAT(32X,'HOUR= ',I3,'    DAY= ',I4)
  621.       END 
  622.