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 / TAZONE.FOR < prev    next >
Text File  |  1992-05-08  |  15KB  |  448 lines
  1.       SUBROUTINE TAZONE(AIRMAS,CMPUMP,QCEIL4,QDCTZN,QFLBAS,QFLCRW,
  2.      +                  QFRLFE,QFLSPB,QFLSPC,QINC,QINF,QINFB,QINFC,
  3.      +                  QINFFRN,QINFS,QINT,QNT,QPART,QRADCB,QSLFL,
  4.      +                  QSUM,QSUM1,QSUM2,QWALL,QWGR,QWINST,QIZONE,
  5.      +                  TBAS,TCRW,TIN,XQADNC,IDBG)
  6. C
  7. C  COMPUTE ZONE AIR TEMPERATURE
  8. C
  9. C  NRMBGW  ZONE NO. THAT HAS A BELOW-GROUND WALL
  10. C  NRMSLB  ZONE NO. THAT HAS A SLAB FLOOR
  11. C  NRMVNT  ZONE NO. THAT VENT PASSES THROUGH
  12. C  RQINT(NZN)  RATIO OF QINT FLOWING TO THIS ZONE
  13. C
  14. C - - - CONSTANTS
  15. CMDK BTUKWH
  16. CMDK CPAIR
  17. CMDK FTR
  18. CMDK NZN
  19. CMDK NIWL
  20. CMDK NKONST
  21. CMDK NWL
  22. CMDK NWN
  23. CMDK NZW
  24. CMDK RHOAIR
  25. CMDK BAR
  26. CMDK BLKFMT
  27. CMDK BLKQS
  28. CMDK BLKQGS
  29. CMDK BLKGS2
  30. CMDK BLKRAD
  31. CMDK CNSTRK
  32. CMDK DUCTS1
  33. CMDK EBALA
  34. CMDK ENCBK1
  35. CMDK ENCBK2
  36. CMDK ENCBLK
  37. CMDK INDIC1
  38. CMDK IWLS
  39. CMDK IZPART
  40. CMDK IZZQ
  41. CMDK MRTBLK
  42. CMDK MZON1
  43. CMDK OWETHR
  44. CMDK QIZNB
  45. CMDK QUAYLE
  46. CMDK SOLARB
  47. CMDK STRUCA
  48. CMDK SURFAR
  49. CMDK TEMPB
  50. CMDK TEMP1
  51. CMDK TIMEB
  52. CMDK TSTB2
  53. CMDK TSTB4
  54. CMDK TSTATC
  55. C
  56. C - - - DIMENSIONS
  57.       REAL AIRMAS(NZN), QINFC(NZN), QINFS(NZN), QWALL(6), TIN(NZN)
  58.      +     ,RTQINF(NZN)
  59.       LOGICAL FIRST,IFN,IFNB
  60.       CHARACTER*125 FRMT
  61. C
  62.       DATA FIRST/.TRUE./
  63.       IDBGSV=IDBG
  64. C     IF(TIME.GT.8.020)THEN
  65. C        IDBG=1
  66. C        IDBGSV=1
  67. C        ENDIF
  68. C     IF(TIME.GT.16.57.AND.TIME.LE.16.64)IDBG=1
  69. C     IF(TIME.GT.17.80)THEN
  70. C         IDBG=1
  71. C         IF(TIME.GT.17.95)             IDBGSV=1
  72. C         ENDIF
  73.       IF(.NOT.FIRST)GO TO 3
  74. C  CALC DISTRIBUTION OF FURNACE-INDUCED INFILTRATION IN OTHER ZONES THAN
  75. C  WHERE FURNACE IS LOCATED (BASED ON RELATIVE FLOOR AREAS IN ZONES)
  76. C  AFLRT IS SET IN CONSLD
  77.       AFSUM=0.
  78.       DO 1 JT=1,NROOMS
  79.       NRM=NRMA(JT)
  80.       RTQINF(NRM)=0.
  81. C  SKIP OUT IF FURNACE IS IN THIS ZONE !
  82.       IF(IFLOC.EQ.1.AND.NRM.EQ.1)GO TO 1
  83.       IF(IFLOC.GT.8.AND.(IFLOC-7).EQ.NRM)GO TO 1
  84.       AFSUM=AFSUM+AFLRT(NRM)
  85.     1 CONTINUE
  86.       DO 2 JT=1,NROOMS
  87.       NRM=NRMA(JT)
  88. C  SKIP OUT IF FURNACE IS IN THIS ZONE !
  89.       IF(IFLOC.EQ.1.AND.NRM.EQ.1)GO TO 2
  90.       IF(IFLOC.GT.8.AND.(IFLOC-7).EQ.NRM)GO TO 2
  91.       RTQINF(NRM)=AFLRT(NRM)/AFSUM
  92.     2 CONTINUE
  93.       RHOBT=RHOAIR*BARRAT*(70.+FTR)
  94.       FIRST=.FALSE.
  95.     3 CONTINUE
  96.       CALL ZERV(10,QCEIL4,QFLSPB,QFLSPC,QINC,QINF,QSUM1,QSUM2,QSUM,
  97.      +          QWGR,QWINST)
  98.       CALL ZERV(10,QPART,QSLFL,QWALL(1),QWALL(2),QWALL(3),QWALL(4),
  99.      +QIZONE,QNT,QFLBAS,QFLCRW)
  100.       CALL ZERV(6,QWALL(5),QWALL(6),QDCTZN,SMA,SMTA,QINFFRN,
  101.      +            DM1,DM2,DM3,DM4)
  102. C  MUST SET INTERZONE Q'S BEFORE ZONE TEMPS ARE CALC SO THAT VALUES
  103. C  GET SET PROPERLY
  104.       DO 4 JT=1,NROOMS
  105.       QIZN(JT)=0.
  106.    4  QIZONS(JT)=0.
  107.       DO 5 JT=1,NROOMS
  108.       NRM=NRMA(JT)
  109. C  SET INTERZONE FLOWS
  110.       CALL QIZSET(NRM,RHOBT,QIZN(NRM),QINF,QINFB,IDBG)
  111.     5 CONTINUE
  112.       TWIFZ=TBAS
  113.       TWIGZ=TBAS
  114.       TWIHZ=TCRW
  115.       TWIIZ=TCRW
  116. C
  117.       DO 100 JT=1,NROOMS
  118.       NRM=NRMA(JT)
  119. C  BASEMENT ZONE CALC ARE DONE IN TBZONE
  120.       IF(NRM.EQ.NZNBAS)GO TO 100
  121.       TIA=TI(NRM)
  122.       TWIF=TIA
  123.       TWIG=TIA
  124.       TWIH=TIA
  125.       TWII=TIA
  126.       IFN=.FALSE.
  127.       IF(ICTRLZ(NRM).EQ.1.AND.IEFAN.EQ.1)IFN=.TRUE.
  128.       CALL ZERV(3,QPARTN,QCEL4N,QRADPQ,DM1,DM2,DM3,DM4,DM5,
  129.      +            DM6,DM7)
  130. C  M CP OF ROOM AIR
  131.       AIRMAS(NRM)=RHOBT/(TIA+FTR)*ROMVOL(NRM)/DTIME
  132.       CPMASS=CPAIR*AIRMAS(NRM)
  133. C  SET HEAT FLOW ASSOCIATED WITH INTERZONE AIR FLOWS
  134. C    QIZN AND QIZONS ARE HEAT FLOWS INTO AND OUT OF THIS ZONE.
  135. C    NEGATIVE OUTFLOW OF HEAT(QIZONS) IS NOT A HEAT LOAD.
  136. C    INFLOW OF HEAT IS EITHER POSITIVE OR NEGATIVE
  137.       QIZONN=QIZN(NRM)-QIZONS(NRM)
  138.       QIZONE=QIZONE+QIZONN
  139.       N2=NWALLA(NRM)
  140. C  SET INDICES WHICH WILL GIVE AWALLA(IZWI)=0. IF IZWI IS NOT
  141. C       DEFINED BELOW (AWALLA(IZT+1) IS SET = 0. IN CONSLD BELOW
  142. C       LABEL 140)
  143.       IZWF=IZT+1
  144.       IZWG=IZT+1
  145.       IZWH=IZT+1
  146.       IZWI=IZT+1
  147. C
  148.       DO 10 K2=1,N2
  149.       IZW=NENC(NRM,K2)
  150.       KON=KONSTA(IZW)
  151.       NLM=NLMP(KON)
  152.       ID=IDEXP(IZW)
  153.       NZONC=NZNC(IZW)
  154.       NZON=NZONC-8
  155.       IF(ID.LE.4)THEN
  156. C - - - OUTSIDE WALL HEAT FLOWS (QSUM1)
  157.           T4=TMP(4,IZW)
  158.           HIWC=HC(NRM,IZW,3,IFN,T4,TIA)
  159.           QWALLC=AWALLA(IZW)*HIWC*(T4-TIA)
  160.           QCSURF(IZW)=QCSURF(IZW)-QWALLC
  161.           SMA=SMA+AWALLA(IZW)
  162.           SMTA=SMTA+AWALLA(IZW)*T4
  163. C  QRMRT VALUE IS SET IN OWALLS
  164.           QRADW=QRMRT(IZW)
  165.           QWALL(ID)=QWALL(ID)+QWALLC-QRADW
  166.           QSUM1=QSUM1+QWALLC
  167.           ENDIF
  168.       QGARAG=0.
  169.       IF(ID.EQ.7.AND.NZONC.EQ.6)THEN
  170.           IF(NLM.EQ.1)THEN
  171.              TWI=TMP(3,IZW)
  172.           ELSE
  173.              TWI=TMP(4,IZW)
  174.              ENDIF
  175.           HIWGC=HC(NRM,IZW,3,IFN,TWI,TIA)
  176.           QGARAG=AWALLA(IZW)*HIWGC*(TWI-TIA)
  177.           QCSURF(IZW)=QCSURF(IZW)-QGARAG
  178.           SMA=SMA+AWALLA(IZW)
  179.           SMTA=SMTA+AWALLA(IZW)*TWI
  180. C  QRMRT VALUE IS SET IN IWALLS
  181.           QRADW=QRMRT(IZW)
  182. C              IDXGAR IS SET IN STRCTL!             
  183.           QWALL(IDXGAR)=QWALL(IDXGAR)+QGARAG-QRADW
  184.           QSUM1=QSUM1+QGARAG
  185.           ENDIF
  186.       IF(ID.EQ.5)THEN
  187. C - - -CEILING HEAT FLOW
  188.           T4=TMP(4,IZW)
  189.           HICC=HC(NRM,IZW,1,IFN,T4,TIA)
  190.           QCEL4C=AWALLA(IZW)*HICC*(T4-TIA)
  191.           QCSURF(IZW)=QCSURF(IZW)-QCEL4C
  192.           QCEL4N=QCEL4N+QCEL4C
  193.           SMA=SMA+AWALLA(IZW)
  194.           SMTA=SMTA+AWALLA(IZW)*T4
  195.           QRADC=QRMRT(IZW)
  196.           QCEIL4=QCEIL4+QCEL4C
  197.           QWALL(6)=QWALL(6)+QCEL4C-QRADC
  198.           ENDIF
  199. C  GET INDICES FOR FLOOR
  200.       IF(ID.EQ.6)THEN
  201.           IF(NZONC.EQ.2)THEN
  202. C              FLOOR OVER BASEMENT W/O DUCTS BELOW
  203.              IZWF=IZW
  204.              TWIF=TMP(3,IZWF)
  205.              IF(NLM.EQ.3)TWIF=TMP(4,IZWF)
  206. C                  SET INDICE FOR BASEMENT CEILING BELOW
  207.              IZWFZ=IZSET(IZWF)
  208.              TWIFZ=TMP(1,IZWF)
  209.              ENDIF
  210.           IF(NZONC.EQ.7)THEN
  211. C              FLOOR OVER BASEMENT W/ DUCTS BELOW
  212.              IZWG=IZW
  213.              TWIG=TMP(3,IZWG)
  214.              IF(NLM.EQ.3)TWIG=TMP(4,IZWG)
  215. C               SET INDICE FOR BSMT CEILING BELOW
  216.              IZWGZ=IZSET(IZWG)
  217.              TWIGZ=TMP(1,IZWG)
  218.              ENDIF
  219.           IF(NZONC.EQ.3)THEN
  220. C              A CRAWL SPACE IS BELOW FLOOR          
  221.              IZWH=IZW
  222.              TWIH=TMP(3,IZWH)
  223.              IF(NLM.EQ.3)TWIH=TMP(4,IZWH)
  224.              TWIHZ=TMP(1,IZWH)
  225.              ENDIF
  226.           IF(NZONC.EQ.8)THEN
  227. C              A CRAWL SPACE WITH DUCTS IS BELOW FLOOR          
  228.              IZWI=IZW
  229.              TWII=TMP(3,IZWI)
  230.              IF(NLM.EQ.1)TWII=TMP(4,IZWI)
  231.              TWIIZ=TMP(1,IZWI)
  232.              ENDIF
  233.           ENDIF
  234.       IF(ID.EQ.7)THEN
  235. C - - - -PARTITION HEAT FLOW
  236. C  DOUBLE AREA IF SUBMERGED INTERIOR ENCLOSURE ELEMENT
  237.           XR=1.
  238.           IF(NZON.EQ.NRM)XR=2.
  239.           TWI=TMP(3,IZW)
  240.           IF(NLM.EQ.3)TWI=TMP(4,IZW)
  241.           HIWPC=HC(NRM,IZW,3,IFN,TWI,TIA)
  242. C  SAVE CONVECTIVE H AT PARTITION WALLS TO USE WITH FURNITURE
  243.           IF(XR.EQ.2)HIWPCS=HIWPC
  244.           QPARTC=HIWPC*XR*AWALLA(IZW)*(TWI-TIA)
  245. C  QSURF FOR SUBMERGED PARTITION WALL IS FOR ONE SIDE ONLY
  246.           QCSURF(IZW)=QCSURF(IZW)-QPARTC/XR
  247.           SMA=SMA+XR*AWALLA(IZW)
  248.           SMTA=SMTA+XR*AWALLA(IZW)*TWI
  249.           QRADP=QRMRT(IZW)*XR
  250.           QRADPQ=QRADPQ+QRADP
  251.           QPARTN=QPARTN+QPARTC
  252.           QPART=QPART+QPARTC-QRADP
  253.           IF(IDBG.NE.0)WRITE(60,505)NRM,IZW,QPARTC,TWI,HIWPC,XR
  254.           ENDIF
  255.    10 CONTINUE
  256. C  GET FURNITURE HEAT EXCHANGE
  257.       CALL FMASS(NRM,HIWPCS,TIA,TFM,QCFM)
  258.       QCFMQ(NRM)= QCFM
  259. C  QINFFRN BELOW IS FURNACE-INDUCED INFILTRATION TO LVG SPC ZONES
  260. C     XQADNC IS CALC IN LOOP
  261.       QINFRN=XQADNC*RTQINF(NRM)*(TODDB-TIA)
  262.       QINFFRN=QINFFRN+QINFRN
  263.       QINFN=QINFC(NRM)-TIA*QINFS(NRM)+QINFRN
  264.       QINF=QINF+QINFN
  265. C
  266. C - - -NET HEAT FLOW AT WINDOWS (QWINST)
  267.       QWISTN=(1.-RADSOL)*SOLARL(NRM+2)+UWIND*AWAWT(NRM)
  268.      +*(TODDB-TIA)
  269.       QWINST=QWINST+QWISTN
  270. C
  271. C - - -HEAT INPUT FROM VENT(IF PASSING THROUGH THIS ZONE)
  272.       QVNTS=0.
  273.       IF(NRMVNT.EQ.1.AND.IRMVNT(1).EQ.NRM)THEN
  274.          QVNTS=QVNTLS
  275.       ELSE IF(NRMVNT.EQ.2)THEN
  276.          DO 20 IQ=1,NRMVNT
  277.          IF(IRMVNT(IQ).EQ.NRM)QVNTS=FRCVNT(IQ)*QVNTLS
  278.    20    CONTINUE
  279.          ENDIF
  280. C
  281. C - - -HEAT FLOW FROM DUCTS PASSING THROUGH THIS ZONE
  282. C  INDICE FOR QDUCTZ MUST CORRESPOND TO INDICE FOR TZONE
  283. C   (SEE BCLSD)
  284.       NQD=1
  285.       IF(NRM.GT.1)NQD=NRM+7
  286.       QDCTZ1=QDUCTZ(NQD)
  287.       QDCTZN=QDCTZN+QDCTZ1
  288. C
  289. C - - -NET HEAT DELIVERY TO ZONE NRM FROM DUCTS
  290.       QNTN=QNET(NRM)
  291.       QNT=QNT+QNTN
  292. C
  293. C - - -SUM OF MISC HEAT FLOWS
  294. C
  295. C
  296. C - - - - SLAB FLOOR HEAT FLOW
  297.           QSLFLN=0.
  298.           IF(NRMSLB(NRM).NE.0)THEN
  299.               QSLFLN=ASLFL(NRM)*USLFL*(TIA-TODAG1)
  300.               QSLFL=QSLFL+QSLFLN
  301.               ENDIF
  302. C
  303. C - - - - HEAT FLOW AT BELOW-GROUND WALL IN LIVING SPACE
  304. C  NOTE: MODEL FOR BELOW-GROUND WALL IN LVG SPC IS NOT CHECKED OUT
  305. C        BY BATTELLE.  BETTER TO MODEL SUCH A WALL IN BASEMENT
  306. C        WHEN BASEMENT IS A HEATED ZONE.
  307. C
  308.           QWGRN=0.
  309.           IF(NRMBGW(NRM).EQ.NRM)THEN
  310.               QWGRN=AWGR(NRM)*UWGR*(TIA-TODAG2)
  311.               QWGR=QWGR+QWGRN
  312.               ENDIF
  313. C
  314. C - - - - HEAT FLOW AT FLOOR
  315. C              NOTE:IZW INDICES WERE SET ABOVE
  316.           H3FFC=HC(NRM,IZWF,6,IFN,TWIF,TIA)
  317.           H3FGC=HC(NRM,IZWG,5,IFN,TWIG,TIA)
  318.           QFLPB1=H3FFC*AWALLA(IZWF)*(TWIF-TIA)
  319.           QFLPB2=H3FGC*AWALLA(IZWG)*(TWIG-TIA)
  320.           QFLPBN=QFLPB1+QFLPB2
  321.           QCSURF(IZWF)=QCSURF(IZWF)-QFLPB1
  322.           QCSURF(IZWG)=QCSURF(IZWG)-QFLPB2
  323.           SMA=SMA+AWALLA(IZWF)+AWALLA(IZWG)
  324.           SMTA=SMTA+AWALLA(IZWF)*TMP(3,IZW)+AWALLA(IZWG)*TMP(3,IZWG)
  325.           QRADF=QRMRT(IZWF)+QRMRT(IZWG)
  326. C  QFLBAS IS HEAT FLOW FROM BSMT CEILING TO BSMT AIR
  327.           IFNB=.FALSE.
  328.           IF(ICTRLZ(NZNBAS).EQ.1.AND.IEFAN.EQ.1)IFNB=.TRUE.
  329.           H1FFZC=HC(NRM,IZWF,2,IFNB,TWIFZ,TBAS)
  330.           H1FGZC=HC(NRM,IZWG,2,IFNB,TWIGZ,TBAS)
  331.           QFLBS1=H1FFZC*AWALLA(IZWF)*(TWIFZ-TBAS)
  332.           QFLBS2=H1FGZC*AWALLA(IZWG)*(TWIGZ-TBAS)
  333.           QRADCB=QRMRT(IZWFZ)+QRMRT(IZWGZ)
  334.           QFLBAS=QFLBS1+QFLBS2
  335.           QCSURF(IZWFZ)=QCSURF(IZWFZ)-QFLBS1
  336.           QCSURF(IZWGZ)=QCSURF(IZWGZ)-QFLBS2
  337.           IF(IDBG.NE.0)WRITE(60,507)NRM,IZWFZ,QFLBS1,H1FFZC,
  338.      +                             IZWGZ,QFLBS2,H1FGZC
  339.           QFLSPB=QFLSPB+QFLPBN-QRADF
  340. C  HEAT FLOW WITH CRAWL SPACE ON OTHER SIDE
  341.           IF(IZWH.GT.IZT)THEN
  342.             H3FHC=0.
  343.             H1FHZC=0.
  344.             QFLPC1=0.
  345.           ELSE  
  346.             H3FHC=HC(NRM,IZWH,6,IFN,TWIH,TIA)
  347.             H1FHZC=HC(NRM,IZWH,2,.FALSE.,TWIHZ,TCRW)
  348.             QFLPC1=H3FHC*AWALLA(IZWH)*(TWIH-TIA)
  349.           ENDIF
  350.           IF(IZWI.GT.IZT)THEN
  351.             H3FIC=0.
  352.             H1FIZC=0.
  353.             QFLPC2=0.
  354.           ELSE
  355.             H3FIC=HC(NRM,IZWI,6,IFN,TWII,TIA)
  356.             H1FIZC=HC(NRM,IZWI,2,.FALSE.,TWIIZ,TCRW)
  357.             QFLPC2=H3FIC*AWALLA(IZWI)*(TWII-TIA)
  358.           ENDIF
  359.           QFLPCN=QFLPC1+QFLPC2
  360.           QCSURF(IZWH)=QCSURF(IZWH)-QFLPC1
  361.           QCSURF(IZWI)=QCSURF(IZWI)-QFLPC2
  362. C  QFLCRW IS CONVECTIVE HEAT FLOW FROM UNDERSIDE OF LVG SPC/CRAWL SPC
  363. C  FLOOR TO CRAWLSPACE BELOW
  364.           QFLCRW=QFLCRW+H1FHZC*AWALLA(IZWH)*(TWIHZ-TCRW)
  365.      +    +H1FIZC*AWALLA(IZWI)*(TWIIZ-TCRW)
  366. C  QCSURF EQUIVALENT FOR BOTTOM-SIDE OF LVG SPC FLOOR WITH CRAWLSPACE
  367. C  BELOW IS CALC (AND USED) IN FLOOR  (SEE QCSRF IN FLOOR)
  368.           QFLSPC=QFLSPC+QFLPCN
  369. C
  370. C - - - - CONVECTION PORTION OF INTERNAL LOADS
  371. C  NOTE: RADIATION PORTION IS ACCOUNTED FOR IN MEAN RADIANT TEMP(MRTSWF)
  372.           QINCN=QINT*(1.-RADINT)*RQINT(NRM)
  373.           QINC=QINC+QINCN
  374. C
  375.       QSUM2N=QPARTN-QSLFLN-QWGRN+QFLPBN+QFLPCN+QINCN+QCFM
  376.       QSUM2=QSUM2+QSUM2N+QIZONN
  377. C
  378. C - - -HEAT EXCHANGE WITH FURNACE IN CLOSET, IF ANY
  379.       QFRLF=0.
  380.       IF((IFLOC.EQ.1.AND.NRM.EQ.1).OR.(IFLOC.GT.8.AND.(IFLOC-7).EQ.
  381.      +NRM))THEN
  382.           QFRLF=(QPLEN+QJACK)*NCELLS+QDRAFT+QVENTB+CMPUMP* BTUKWH
  383.           ENDIF
  384.       IF(QFRLF.NE.0.)QFRLFE=QFRLF
  385. C
  386. C - - -SUM OF HEAT FLOWS
  387.       QSUMN=QSUM1+QINFN+QWISTN+QVNTS+QCEL4N+QDCTZ1+QNTN+
  388.      +      QSUM2N+QFRLF+QIZONN
  389.       QSUM=QSUM+QSUMN
  390. C
  391. C - - -AIR TEMP IN THIS ZONE
  392.       TIN(NRM)=QSUMN/CPMASS+TIA
  393.       IF(IDBG.NE.0)THEN
  394.           TIMP=TIME*60.
  395.           TENCMN=SMTA/SMA
  396.           IF(NRM.EQ.1)WRITE(60,500)TIMP,NRM,TIN(NRM),TIA
  397.      +                                   ,TMR(NRM),TENCMN
  398.           IF(NRM.EQ.2)WRITE(60,501)TIMP,NRM,TIN(NRM),TIA
  399.      +                                   ,TMR(NRM),TENCMN
  400.           IF(NRM.EQ.3)WRITE(60,502)TIMP,NRM,TIN(NRM),TIA
  401.      +                                   ,TMR(NRM),TENCMN
  402.           IF(NRM.EQ.4)WRITE(60,503)TIMP,NRM,TIN(NRM),TIA
  403.      +                                   ,TMR(NRM),TENCMN
  404.           IF(NRM.EQ.5)WRITE(60,504)TIMP,NRM,TIN(NRM),TIA
  405.      +                                   ,TMR(NRM),TENCMN
  406.           FRMT='(5X,100H  QSUM1     QINFN     QWISTN    QVNTLS    QCEL4N
  407.      +    QDCTZ1    QFRLF     QIZONN    QPARTN    QSLFLN  /5X,10F10.1)'
  408.           CALL VZOUT(10,FRMT,QSUM1 ,QINFN,QWISTN,QVNTLS,QCEL4N,QDCTZ1,
  409.      +                       QFRLF,QIZONN,QPARTN,QSLFLN)
  410.           FRMT='(5X,55H  QWGRN     QFLPBN    QFLPCN    QINCN     QNTN
  411.      +  QCFM     /5X,6F10.1/)'
  412.           CALL VZOUT(6,FRMT,QWGRN,QFLPBN,QFLPCN,QINCN,QNTN,QCFM,
  413.      +                 DM1,DM2,DM3,DM4)
  414. C  MOST H VALUES BELOW ARE LAST VALUES CALC ABOVE (SOME OF THESE H'S
  415. C  GET CALC MORE THAN ONCE ABOVE)
  416.           WRITE(60,508)HIWC,HIWGC,HICC,HIWPC,H3FFC,H3FGC,H1FFZC,H1FGZC,
  417.      +                H3FHC,H3FIC,H1FHZC,H1FIZC
  418.           ENDIF
  419.       IF(TIME.GT.TMEBLS)THEN
  420.          ETRM=QSUM1+QCEL4N+QINFN+QWISTN+QSUM2N+QNTN+QDCTZ1+QVNTS+
  421.      +        QFRLF+QIZONN
  422.          EBAL(NRM)=EBAL(NRM)+ETRM
  423.          EBALT(NRM)=EBALT(NRM)+QNTN+QDCTZ1
  424.          ENDIF
  425.   100 CONTINUE
  426.       IDBG=IDBGSV
  427.       RETURN
  428.   500 FORMAT(/1X,'TAZONE:TIME(MIN),NRM,TIN,TI,TMR,TENCMN='/
  429.      +20X,F8.1,I4,4G13.5)
  430.   501 FORMAT(/4X,'TAZONE:TIME(MIN),NRM,TIN,TI,TMR,TENCMN='/
  431.      +20X,F8.1,I4,4G13.5)
  432.   502 FORMAT(/7X,'TAZONE:TIME(MIN),NRM,TIN,TI,TMR,TENCMN='/
  433.      +20X,F8.1,I4,4G13.5)
  434.   503 FORMAT(/10X,'TAZONE:TIME(MIN),NRM,TIN,TI,TMR,TENCMN='/
  435.      +20X,F8.1,I4,4G13.5)
  436.   504 FORMAT(/13X,'TAZONE:TIME(MIN),NRM,TIN,TI,TMR,TENCMN='/
  437.      +20X,F8.1,I4,4G13.5)
  438.   505 FORMAT(1X,'TAZONE:NRM,IZW,QPARTC,TWI,H ,XR= '/
  439.      +10X,2I5,4G13.5)
  440.   507 FORMAT(1X,'TAZONE:NRM,IZWFZ,QFLBS1,H = ',2I5,2G13.5/
  441.      +           12X,'IZWGZ,QFLBS2,H = ',I5,2G13.5)
  442.   508 FORMAT(5X,'HIWC,HIWGC,HICC,HIWPC= ',4G13.5/
  443.      +5X,'H3FFC,H3FGC,H1FFZC,H1FGZC= ',4G13.5/
  444.      +5X,'H3FHC,H3FIC,H1FHZC,H1FIZC= ',4G13.5)
  445.   510 FORMAT(1X,'TAZONE:TIME,NRM,TIA,TIN(NRM),QIZONN= ',G13.5,
  446.      +I4,3G13.5)
  447.       END
  448.