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 / GASF.FOR < prev    next >
Text File  |  1992-05-11  |  44KB  |  1,346 lines
  1.        SUBROUTINE GASF 
  2. C *** GAS FURNACE MODEL--SIMPLIFIED 
  3. C * * * REVISED BY REMOVING PLENUM EQNS TO SEPARATE PROGRAM (RDF 10/31/8
  4. C - - - CONSTANTS 
  5. CMDK CPAIR
  6. CMDK NZN
  7. C - - - COMMON BLOCKS 
  8. CMDK AFUE
  9. CMDK BLK10
  10. CMDK BLK81
  11. CMDK BLK83
  12. CMDK BLK85
  13. CMDK BLK87
  14. CMDK BLKCM1
  15. CMDK BLKCM2
  16. CMDK BLKGS1
  17. CMDK BLKGS2
  18. CMDK BLKHX
  19. CMDK BLKOIL
  20. CMDK BLKQGS
  21. CMDK BLKQHX
  22. CMDK BLKSK
  23. CMDK BLKTVD
  24. CMDK COLCT
  25. CMDK COLLEC
  26. CMDK DTRQ
  27. CMDK FANBLK
  28. CMDK FUEL1
  29. CMDK GASFC
  30. CMDK HUMIDC
  31. CMDK IELCB
  32. CMDK INDIC1
  33. CMDK IZZQ
  34. CMDK MZON1
  35. CMDK OILB
  36. CMDK OWETHR
  37. CMDK PRT1
  38. CMDK TEMP1
  39. CMDK TIMEB
  40.       DIMENSION AHXC(4),BCON(6),C10XS(6),DWAIR(2),DTM(3),EMISP(6),
  41.      +          EXC(3),HACW(4),HAG(4),HAOFF(3),HAON(3,2),HAS(5),
  42.      +          HGOFF(3),HGON(3,2),HXVP(6),QEXTT(3),RHOGOF(2),
  43.      +          TFILM(3),TGO(3),TM(4),TMFU(6),TMFUH(6),TMFUL(6),WAOT(2),
  44.      +          WGTO(2),XLDC(4),XLDCH(4,2),XLL(4),XV5(5),XVD(5),
  45.      +          XVP(5),ZA2D(4),ZHX1D(4),ZHX2D(4,2)
  46. C       CHANGED ALL BONNET(B) MNENOMICS TO PLENUM(PL) ON 11/11/83 
  47. C  *  *  *
  48. C       CHANGED ALL STACK(S) MNENOMICS TO VENT(V) ON 11/11/83 
  49. C   NOTE:  DEFAULT VALUES FOR MANY OF THESE VARIABLES ARE SET IN
  50. C          BLOCK DATA IN SUBPROGRAM BLKDAT.FOR
  51. C  BCON - SEE WFLMIN ( UP TO SIX VALUES)
  52. C  CPMACL VALUES ARE COMPOSITE MASS X CP FOR A-COIL MATERIALS,BTU/F
  53. C  DTRJC,DTRPL - TEMP ELEVATION OF JACK AND PLEN SURF ABOVE TAIN, F
  54. C                (USED FOR CALCULATING RADIATION HEAT LOSS)
  55. C  EFFHXV - TEMPERATURE EFFECTIVENESS OF HEAT EXCH BETWEEN VENT AND
  56. C           COMBUSTION AIR(SEE IDV), FRACTION
  57. C  EMISJC AND EMISPL ARE EMISSIVITY OF JACK AND PLEN SURFACES 
  58. C  FANTOF IS PLENUM-OUTLET TEMP AT BLOWER TURN OFF,F
  59. C  FANTON IS PLENUM-OUTLET TEMP AT BLOWER TURN ON,F 
  60. C  HAACL - H * TOTAL HT AREA IN A-COIL FOR BLOWER ON AND OFF,BTU/HR-F
  61. C  HIPL2 - CONVECTIVE HEAT TRANSFER COEF AT INSIDE WALL OF PLENUM W/
  62. C          BLOWER OFF, BTU/HR-FT2-F
  63. C  HOJ   - NATURAL CONVECTION HEAT TRANSFER COEF AT OUTSIDE WALL OF 
  64. C          PLENUM, BTU/HR-FT2-F
  65. C    NOTE: INPUT HOJ ONLY WHEN JACK HAS DIFF CONV H OUTSIDE THAN PLEN 
  66. C  IDV   - =1, COUNTER FLOW HEAT EXCHANGER BETWEEN COMB AIR AND VENT
  67. C          OF A DIRECT-VENT FURNACE; =0 OTHERWISE
  68. C  IELC=1  FOR ELECTRIC FURNACE; =0 OTHERWISE
  69. C  IVFA - CALC PART LOAD FACTOR USING TDESL AND TDESH (NOT USED BY BCL)
  70. C  LINWFL - =1 FOR LINEAR CHANGE IN OFF-CYCLE FLUE FLOW(SEE WFLMIN)
  71. C  NACL  - < 50 TO GET (50 - NACL) DEBUG PRINTS FROM A-COIL MODEL
  72. C  NFLT  - NO. OF TIME(TMFLT)-FLUE TEMP(TFLT) VALUES FOR CONDENSING
  73. C          FURNACE
  74. C  NHXITR - =1 FOR ITERATION ON HEAT EXCH METAL TEMPS;=0 OTHERWISE
  75. C  NINTGF - NO. OF INTEGRATON STEPS WITHIN ONE TIME STEP FOR 
  76. C           INTEGRATING ENERGY INPUT TO METAL OF CONDENSING HEAT
  77. C           EXCHANGER
  78. C  NTBB   - <50 TO PRINT (50-NTBB) DEBUG PRINTS OF MASS FLOWS; =0 
  79. C           OTHERWISE
  80. C  NTHX   - <50 TO PRINT (50-NTHX) DEBUG PRINTS FROM HEAT EXCHANGER 
  81. C           MODEL
  82. C  NTJJ   - < 50 TO PRINT (50-NTJJ) DEBUG PRINTS FROM JACKET MODEL
  83. C  PCTJAC - HEAT LOSS FROM JACKET FOR CONDENSING OR ELECTRIC FURNACE,
  84. C           PERCENT OF FIRING RATE
  85. C  PCLOSE - CLOSING TIME PERIOD FOR THERMAL VENT DAMPER, SEC
  86. C  POPEN  - OPENING TIME PERIOD FOR THERMAL VENT DAMPER, SEC
  87. C    SET POPEN,PCLOSE=100.,120. FOR A THERM VENT DAMP 
  88. C  RCLOSE - VEL HEAD LOSS WITH THERMAL VENT DAMPER CLOSED
  89. C  RNSLS1 - R-FACTOR FOR INSULATION OF 1ST VERTICAL VENT SECTION
  90. C           FOR AFUE TEST( NOTE XV(3) MUST BE < .16 FT TO USE RNSLS1)
  91. C  ROPEN  - VEL HEAD LOSS WITH THERMAL VENT DAMPER OPEN
  92. C  TCYCOF - TIME CONSTANT FOR GAS-SIDE FLOW DURING OFF CYCLE,HR
  93. C  TCYCON - TIME CONSTANT FOR GAS-SIDE FLOW DURING ON CYCLE,HR
  94. C    NOTE: BOTH TCYCOF AND TCYCON WERE NEVER USED AFTER DEVELOPMENT
  95. C  TDESH  - DESIGN OUTDOOR TEMP DURING HEATING FOR THE BUILDING, F
  96. C  TDESL  - DESIGN INDOOR TEMP DURING HEATING FOR THE BUILDING, F
  97. C  TFILM  - FILM TEMP FOR CALC GAS PROPERTIES IN EACH OF THREE
  98. C           HEAT EXCH SECTIONS, F  
  99. C  TFLT   - FLUE TEMP VALUES AT TMFLT TIME FOR CONDENSING FURN, F
  100. C  TFLUE  - INITIAL VALUE OF FLUE TEMP, F
  101. C  THLOFF - HIGH LIMIT SENSOR SWITCH WILL OPEN WHEN SENSOR TEMP EXCEEDS
  102. C           THIS VALUE (SEE HILIM.FOR LISTING), F
  103. C  THLON  - HIGH LIMIT SWITCH WILL REMAIN OPEN UNTIL SENSOR TEMP FALLS 
  104. C           BELOW THIS VALUE, F
  105. C  TIME1  - BLOWER ON DELAY,SEC
  106. C  TIME3  - BLOWER OFF DELAY,SEC 
  107. C  TIMOVD IS TIME FOR VENT DAMPER TO CLOSE AFTER BURNER OFF,SEC 
  108. C  TJSV   - INITIAL VALUE OF JACKET METAL TEMP, F
  109. C  TMACSV - INITAL VALUE OF A-COIL METAL TEMP, F
  110. C  TMFLT  - TIME AT TFLT FOR CONDENSING FURNACE FLUE TEMPS, HR
  111. C  TMSV   - INITIAL VALUE OF METAL TEMPS IN 3 HEAT EXCH SECTIONS,F
  112. C  TMV    - INITAL VALUE OF MATERIAL TEMPS IN 5 VENT SECTIONS,F
  113. C  TSHLIM - > 0. HIGH-LIMIT SENSOR TIME CONSTANT, HR; =0. NO HILIMIT OP.
  114. C  TVENTI - INITIAL GAS TEMP AT INLET TO 1ST VENT SECTION, F
  115. C  TWFMAX - SEE WFLMIN
  116. C  UAHXON,UAHXOF - UA FOR COND FURN WITH BLOWER ON OR OFF, BTU/HR-F
  117. C  UAHXV  - UA FOR COUNTERFLOW HEAT EXCHANGER(SEE IDV), BTU/HR-F
  118. C  VOUTSD IS FRACTION OF VENT EXPOSED TO OUTSIDE. 
  119. C      =.5 FOR HOUSE A    = 0.0 FOR HOUSE B 
  120. C  WFL1 -  FLUE FLOW AT 20 SEC AFTER BURNER OFF,FRACT OF "ON"CYCLE WGT
  121. C  WFLMIN - MINIMUM FLUE FLOW W/ BURNER OFF:
  122. C           >=0., IF LINWFL=1, THEN FLUE FLOW DECAYS LINEARLY FROM
  123. C                 BURNER ON TO WFLMIN AT TIME TWFMAX BY INTERNALLY 
  124. C                 SETTING VALUES FOR BCON.
  125. C           IF LINWFL NOT = 1, FLUE FLOW DECAYS WITH A 2ND ORDER
  126. C           POLYNOMIAL FROM A FLOW OF WFL1*WGT ON FIRST 20 SEC TO 
  127. C           WFLMIN AT TWFMAX BY INTERNALLY SETTING VALUES FOR BCON.
  128. C   NOTE: IF CYCLE TIME (TCYCLE) < TWFMAX, CALC FLUE FLOW FROM 
  129. C         A POLYNOMIAL USING COEFFICIENTS BCON.
  130. C         IF CYCLE TIME (TCYCLE) >= TWFMAX, FLUE FLOW = WFLMIN.
  131. C  WGTHX  - MASS OF HEAT EXCHANGER METAL IN CONDENSING FURNACE, LBM
  132. C  ZAJ    - THREE VALUES FOR MULTIPLIER ON CONVECTIVE HEAT TR COEF
  133. C           AT INNER WALL OF JACKET FOR BLOWER SPEEDS OF HIGH,LOW,& OFF
  134. C  ZKBND2 - NO. VEL HEAD LOST IN ELBOWS,ETC IN THE VENT WITH BURNER OFF 
  135. C  ZRELFI - NO. OF VEL HDS LOST WITH FLOW INTO RELIEF OPENING 
  136. C  ZRELFO - NO. OF VEL HDS LOST WITH FLOW OUT RELIEF OPENING(SPILLAGE)
  137. C   MUST ADD 1.0 VEL HDS TO THESE VALUES FOR CONVERSION TO STATIC PRESS 
  138. C  NOTE: ZRELFI=3,USED ORIG, WAS RED TO 2 (12/12/83) TO INCR RELIEF FLOW
  139. C MISCELLANEOUS INFO:
  140. C  TAIN   - FURNACE-ENVIRON TEMP 
  141. C  TCOMB  - COMBUSTION-AIR TEMP
  142. C  TRAREF - REF. TAIN USED FOR INITIAL CALCULATIONS 
  143. C  TWBI IS WET BULB TEMP AT FURNACE ENVIRONMENT 
  144.       NAMELIST /INPGSF/  BCON, CPMACL, DTRJC, DTRPL, EFFHXV,
  145.      + EMISJC, EMISPL, FANTOF, FANTON, HAACL,
  146.      + HIPL2, HOJ, IDV, IELC, IVFA,
  147.      + LINWFL, NACL, NFLT, NHXITR, NINTGF,
  148.      + NTBB, NTHX, NTJJ, PCLOSE, PCTJAC,    
  149.      + POPEN, RCLOSE, RNSLS1, ROPEN, TCMOF1, 
  150.      + TCMOF2, TCYCOF, TCYCON, TDESH, TDESL,
  151.      + TFILM, TFLT, TFLUE, THLOFF,THLON,
  152.      + TIME1,TIME3,TIMOVD, TJSV, TMACSV, 
  153.      + TMFLT, TMPLSV, TMSV, TMV, TSHLIM,
  154.      + TVENTI, TWFMAX, UAHXOF, UAHXON, UAHXV,
  155.      + VOUTSD, WFL1, WFLMIN, WGTHX, ZAJ,
  156.      + ZKBND2, ZRELFI, ZRELFO
  157. C     
  158.       ZKF(Z)=1.18E-4*(Z+FTR)**.774
  159.       ZUF(ZZ)=6.948E-4*(ZZ+FTR)**.664 
  160. C  *  *  *
  161.       DATA BCON/6*0./
  162.       DATA DTM/3*0./
  163.       DATA DTMTOL/.01/
  164. C  DTMTOL IS TOLERANCE ON CONVERGENCE OF CHANGE IN METAL TEMP 
  165.       DATA DTRJC/10./
  166.       DATA EMISJC/.87/
  167.       DATA FANTON/0./
  168.       DATA GC,FTR/32.174,459.7/ 
  169.       DATA HOJ/0./
  170.       DATA IDV/0./
  171.       DATA IVFA/0/
  172.       DATA LINWFL/0/
  173.       DATA NTFAN/0/ 
  174.       DATA NTHX,NHXITR,NACL,NTJJ,NTBB/100,1,100,100,100/
  175.       DATA PCTJAC/0./
  176.       DATA PCTPLN/0./ 
  177.       DATA TCYCOF/0./
  178.       DATA TFILM/1280.,780.,430./
  179.       DATA TFLUSV/470./ 
  180.       DATA TIMOVD/0./
  181.       DATA TMHXC/70./ 
  182.       DATA WFLMIN,TWFMAX/48.,.44444/
  183.       DATA ZRELFI,ZRELFO/2.,2./
  184.       DATA WH2O,WVH,THMIX,CPH,TH2O,RHOW,QHAIR,HVOUT 
  185.      +/0.,0.,0.,0.,0.,39.75,0.,0./
  186. C     
  187.       IF(IVFA.EQ.1)PRTLD=1.-0.6*(TODDB-TDESL)/(TDESH-TDESL) 
  188.       IF(PRTLD.LT.0.4)PRTLD=0.4 
  189.       IF(PRTLD.GT.1.0)PRTLD=1.0 
  190. C      
  191.       IF(ISKIP.EQ.1)GO TO 160
  192.       IF(NRDF1.GT.0)GO TO 2 
  193.       GCTRM=2.*GC*5.2*3600.*3600. 
  194. C      
  195.        OPEN(12,FILE='TAPE12',STATUS='OLD',IOSTAT=IO12)
  196.        IF(IO12.NE.0)THEN
  197.          WRITE(60,*)' GASF: CANT OPEN TAPE12 WITH NAMELIST INPGSF'
  198.          STOP ' GASF: CANT OPEN TAPE12 WITH NAMELIST INPGSF '
  199.          END IF
  200.        READ(12,INPGSF,END=999,IOSTAT=IO12)
  201.        IF(IO12.NE.0)THEN
  202.          WRITE(60,*)' GASF: TROUBLE ON NAMELIST INPGSF,IO12= ',IO12
  203.          STOP ' GASF: TROUBLE ON NAMELIST INPGSF'
  204.          ENDIF
  205. C       WRITE(60,INPGSF)
  206.        CLOSE(12)
  207.     2 IF ((IDEBUG .GT. 0) .AND. ((IH2O .EQ.1) .OR. (IOIL .EQ. 0)))
  208.      +  WRITE(60,3006) 
  209. C  SET TIME BOUNDS FOR RETRIEVING AFUE TEMPS
  210.       DTHAF=DTIME*.5
  211.       DO 3 I=1,6
  212.       TMFU(I)=TMAFU(I)/60.
  213.       TMFUL(I)=TMFU(I)-DTHAF
  214.     3 TMFUH(I)=TMFU(I)+DTHAF
  215.       DTIMQ=DTIME 
  216.       EHXC=0. 
  217.       PI= 3.14159 
  218. C *** INITIALIZE VALUES 
  219.       IF (IOIL .EQ. 0) IFAN=0 
  220.       IF ( IFAN .EQ. 1) IDAMP=0 
  221.       IF (IFAN .EQ. 1) AFCL=0.
  222.       IF (IFAN .EQ. 1) WD=WDPOW 
  223.       AST = PI/4.*DVENT**2
  224.       DATA NTIMRZ/0/
  225.       IF(NTIMRZ.GT.0)GO TO 5
  226.       IF(TIME1.EQ.0.)THEN 
  227.       TIME1=0.00001 
  228.       ELSE
  229.           TIME1=TIME1/3600.-.000001 
  230.           ENDIF 
  231.       TIME3= TIME3/3600.-.00001 
  232.       TIMOV=TIMOVD/3600.-.00001 
  233.       XV1=XV(1) 
  234.       EXCESV=EXCESS 
  235.       IF(HOJ.EQ.0.)HOJ=HOPL1
  236.       NTIMRZ=1
  237.       AFCL=AFCL/144.
  238.       AFCL2=(AFCL*.56)**2 
  239.     5 AFDL=1. 
  240.       XV(1)=XV1 
  241.       EXCESS=EXCESV 
  242.       ADIL2=ADIL**2 
  243.       IF ((IDAMP .EQ.1).AND.(AFCL.LE. 0.)) AFDL=0.
  244.       IF(AFCL.NE.0..AND.ADIL.NE.0.)AFDL=(AFCL*.56/ADIL)**2
  245.       IF(TRAREF.GT.0.)THEN
  246.           TCOMB=TRAREF
  247.           TAIN=TRAREF 
  248.           TWBI=TRAREF-3. 
  249.       END IF
  250.       THM=TCOMB 
  251.       IBURN=1 
  252.       IEFAN= 0
  253.       IF(TIME1.LT.0.0001)IEFAN=1
  254.       IF(FANTON.GT.0.)IEFAN=0 
  255.       IEFNHX=IEFAN
  256.       IFN=0 
  257.       IFANCL= IFAN*ICL
  258.       IB=1
  259.       IH2O1=1-IH2O
  260.       IDAMP1=1-IDAMP
  261.       IDIL=1
  262.       IDPON=0 
  263.       IF (IFAN .EQ. 0) GO TO 6
  264.       IDPON=3 
  265.       IF (IH2O .EQ.0) IDPON=4 
  266. 6     IDPOFF=0
  267.       IF ((IDAMP .EQ. 0) .AND. (IFAN .EQ. 0)) GO TO 8 
  268.       IDPOFF=3
  269.       IF (AFCL .GT. 0.) GO TO 7 
  270.       IF (IH2O .EQ. 0) IDPOFF=4 
  271.       GO TO 8 
  272. 7     IDPOFF=2
  273.       IF (IH2O .EQ. 1) IDPOFF=1 
  274. 8     IF ((IFAN .EQ. 1).OR. (ADIL .GT. 0.)) GO TO 9 
  275.       AFCL=0. 
  276.       IDPON= 4
  277.       IF(IFAN.EQ.1)WD=0.
  278.       IDIL=0
  279.       IF(IH2O .EQ. 1) IDPON=3 
  280.       IDPOFF=IDPON
  281. 9     IDP=IDPON 
  282.       INC=1 
  283.       TAINR= TAIN+FTR 
  284.       ZKAA=ZKF(TAIN)
  285.       UAA=ZUF(TAIN) 
  286.       RHOA= .075*530./TAINR 
  287.       ZKGOF=ZKF(290.) 
  288.       ZKG=ZKF(1040.)
  289.       ZKA=ZKF(200.) 
  290.       ZKGS=ZKF(140.)
  291. C  VISCOSITY IN LBM/FT-HR 
  292.       UG=ZUF(TFILM(2))
  293.       UA=ZUF(200.)
  294.       UGS=ZUF(140.) 
  295.       IQEXT=0 
  296.       ISAVE=0 
  297.       EXCEST= EXCESS
  298.       EXCESS=0. 
  299.       CALL FUEL 
  300.       IQEXT=1 
  301.       ISAVE=1 
  302.       EXCESS= EXCEST
  303. C  WSA IS NO. OF MOLES OF STOICH AIR
  304. C  WNF IS NO. OF MOLES OF FUEL
  305.       HGO= ENINF+ENAIR*WSA
  306.       QEXTT(1)= (HGO-HFACT-HFACTA*WSA+FB)*WNF 
  307.       QEXTT(2)= PRTLD*QEXTT(1)
  308.       WRITE(60,*) 'LINE 1680'
  309.       WRITE(60,*) 'QEXTT(1)= ',QEXTT(1)
  310.       QIN=QEXTT(1)*(1.-(PCTJAC+PCTPLN)*.01) 
  311.       CALL FUEL 
  312.       ISAVE=0 
  313.       WAO=WSTO*(1.+EXCESS)
  314.       WAOT(1)=WAO 
  315.       WGQ=WAO+WFUEL 
  316.       WRITE(60,3012)EXCESS,WSTO,WAO,WFUEL,WGQ
  317.       IF (IDEBUG.GT.0)WRITE(60,3003)
  318.       WNF=WNF/NCELLS
  319.       WSTO= WSTO/NCELLS 
  320.       WFUEL= WFUEL/NCELLS 
  321.       WAO= WSTO*(1.+EXCESS) 
  322.       WAOFF=WAO 
  323.       WAOFT=WAOFF*NCELLS
  324.       RHOGOF(1)= (.079+.075*EXCESS)/(1.105+EXCESS)*530. 
  325.       WGO(1)= WAO+WFUEL 
  326.       WGTO(1)= WGO(1)*NCELLS
  327.       WGTOF= WAOFF*NCELLS 
  328.       WNFWG=WNF/WGO(1)
  329.       WMSA= WSA*(1.+EXCESS) 
  330.       HGO= ENINF+ENAIR*WMSA 
  331.       ASP= AS+WMSA*AAIR 
  332.       BSP= BS+WMSA*BAIR 
  333.       CSP= CS+WMSA*CAIR 
  334.       DSP= DS+WMSA*DAIR 
  335.       THGL= THG-200.
  336.       WHG=QHINPT/QEXTT(1)*WGTO(1) 
  337.       CPHG= (((ASP*THG+BSP)*THG+CSP)*THG-((ASP*THGL+BSP)*THGL+CSP)* 
  338.      + THGL)/200.*WNFWG 
  339.       WHGCP= WHG*CPHG 
  340.       WVH= WFUEL*NCELLS*QHINPT/QEXTT(1) 
  341.       TGO(1)= 2500. 
  342.       IG=1
  343.       IPR=0 
  344. 10     LGO=0
  345. 20    IGO=1 
  346. C  SOLVE FOR TGO FROM KNOWN VALUE OF HGO
  347. 30    HGO1= ((ASP*TGO(IG)+BSP)*TGO(IG)+CSP)*TGO(IG)+DSP 
  348.       DHGO= HGO1-HGO
  349.       IF ( ABS(DHGO) .GE. TOLDH) THEN
  350.         IF(IGO.EQ.1)THEN
  351.           DHG1= DHGO
  352.           TGO(IG)= TGO(IG)+1. 
  353.           IGO=2 
  354.           GO TO 30
  355.         ELSE IF(IGO.EQ.2)THEN
  356.           SLOPT=(-1.)*1. /(DHGO-DHG1) 
  357.           TGO(IG)= TGO(IG)+SLOPT*DHGO 
  358.           LGO= LGO+1
  359.           IF ( LGO .LT. 7) GO TO 20 
  360.           WRITE(60,3000)
  361.           STOP ' GASF: NO CONVG IN TGO'
  362.         ENDIF
  363.       ENDIF
  364.       TGO(IG)=TGO(IG)+SLOPT*DHGO
  365.       TGMID=(TGO(IG)+500.)*.5 
  366.       CPG(IG)= (((ASP*TGMID+BSP)*TGMID+CSP)*TGMID-((ASP*500.+BSP)*
  367.      + 500.+CSP)*500.)/(TGMID-500.) 
  368.       TGO(IG)=500.+(HGO-(((ASP*500.+BSP)*500.+CSP)*500.+DSP))/CPG(IG) 
  369.      + -TCOMB 
  370.       CPG(IG)= CPG(IG)*WNFWG
  371.       CPFLU=(((ASP*TFLUE+BSP)*TFLUE+CSP)*TFLUE- 
  372.      +((ASP*TVENTI+BSP)*TVENTI+CSP)*TVENTI)/(TFLUE-TVENTI+.000001)
  373.      +*WNFWG
  374.       IF(IPR.EQ.0)WRITE(60,3014)TGO(1),CPG(1),HGO,CPFLU
  375.       IF ( IPR .EQ. 1) GO TO 70 
  376.       IPR=1 
  377.       EXC(1)= EXCESS
  378.       FUELCS=FUELCM 
  379. C *** PART LOAD CALCULATIONS
  380.       EXC(2)= (1.+EXC(1))/PRTLD-1.
  381.       EXCESS= EXC(2)
  382.       FUELCM= FUELCM*PRTLD
  383.       CALL FUEL 
  384.       WNF= WNF/NCELLS 
  385.       WSTO= WSTO/NCELLS 
  386.       WFUEL= WFUEL/NCELLS 
  387.       WAO= WSTO*(1.+EXC(2)) 
  388.       RHOGOF(2)= (.079+.075*EXC(2))/(1.105+EXC(2))*530. 
  389.       WGO(2)= WAO+WFUEL 
  390.       WAOT(2)=WAO*NCELLS
  391.       WGTO(2)= WGO(2)*NCELLS
  392.       WNFWG= WNF/WGO(2) 
  393.       WMSA= WSA*(1.+EXC(2)) 
  394.       HGO= ENINF+ENAIR*WMSA 
  395.       ASP= AS+WMSA*AAIR 
  396.       BSP= BS+WMSA*BAIR 
  397.       CSP= CS+WMSA*CAIR 
  398.       DSP= DS+WMSA*DAIR 
  399.       TGO(2)= 1000. 
  400.       IG= 2 
  401.       GO TO 10
  402. 70    TGO(3)= 0.
  403.       FUELCM=FUELCS 
  404.       QEXTT(3)= 0.
  405.       EXC(3)= 0.
  406.       PR=.7 
  407.       PR2= SQRT(PR) 
  408.       PR3= .7**.333 
  409.       PR4=(.861+.7)**.25
  410.       PRD4= PR**.4
  411.       C1=U45*BARPSI/(NCELLS*14.7) 
  412.       WAIRF(1)=CFM(1)*C1
  413.       WAON=WAIRF(1)*NCELLS
  414.       WAIRN= ECFMC2*C1
  415.       WAOF=WAIRN*NCELLS 
  416.       DWAIR(1)= WAIRF(1)-WAIRN
  417.       WAIRF(2)=CFM(2)*C1
  418.       DWAIR(2)=WAIRF(2)-WAIRN 
  419. C - - - - - - -  SINGLE-SPEED BLOWER SET BELOW
  420.       IBL=1 
  421.       XLT=0.
  422.       DO 80 I=1,3 
  423.       XLT= XLT+XL(I)
  424.    80 DCELLA(I)=DCELL-D(I)
  425.       TODR=TODDB+FTR
  426.       TODRS=TODR
  427.       WSPEDS=9. 
  428.       RHOD=.075*530./TODR 
  429.       UAOD=ZUF(TODDB) 
  430.       ZKAOD=ZKF(TODDB)
  431.       REOD=DVENT*WSPEDS*5280.*RHOD/UAOD 
  432.       HASOD=.26*PR**.3*REOD**.6*ZKAOD/DVENT 
  433.       HIGH=XLT-XL(1)
  434.       HIGH=HIGH+XV1 
  435.       DO 90  I=3,5
  436. 90    HIGH= HIGH+XV(I)
  437.       PAMBC=(-1.)*39.75*(XLT-XL(1))/5.2 
  438.       IF (IDIRCT .EQ. 1) PHI=0. 
  439.       IF (IFLOC.EQ.7) PHI=0.
  440.       TCYCLE=DTIME
  441.       TCYCQ=TCYCLE
  442.       DTJ=0.
  443.       DVENTP= DVENT*PI
  444.       ZHX1= ZHX34*8.23*.5*SOOT
  445.       ZHX2= ZHX*1.4*PR3*SOOT
  446.       ZHX3= .023*PRD4/DVENT 
  447.       ZA1= ZA*.05 
  448.   102 ZA2=ZA14*.5*8.23*ZKA
  449.   103 CONST1=DTIME/(CPM*RHOMT)
  450.       CONST4=ADIL*SQRT(GCTRM*RHOA/ZRELFI) 
  451.       IF(IDIL .EQ. 1) CONST4= 1./CONST4**2
  452.       CONSV4=CONST4 
  453.       CONST5= 1./(AST*AST*3600.*1203002.) 
  454.       CONST6= GC*3600.**2/TAINR*(RHOA/UAA)**2/4.**.25 
  455.       CONST7= .676*PR2/PR4*ZKAA 
  456.       CONST8= CONST6*(4.*PR)**.25*DVENT**3
  457.       CONST9= .47*ZKAA/DVENT
  458.       CONS10= DTIME/DVENTP
  459.       CONS20=1.E37
  460.       CONS21= 1.
  461.       IF(HAACL(1).EQ.0.)GO TO 104 
  462. C  SET A-COIL TIME CONSTANTS
  463.       HACL1=HAACL(1)/(CPAIR*WAIRF(1)*NCELLS)
  464.       IF(HACL1.GT.173.)HACL1=173. 
  465.       HACLON=1./EXP(HACL1)
  466.       HACL2=HAACL(2)/(CPAIR*WAIRF(2)*NCELLS)
  467.       HACLOF=HACL2*.5 
  468.       DTMAC=0.
  469. C   - - -  SET INITIAL RELIEF FLOW FOR CALC OF VENT HT TR COEF
  470.   104 IF (IFAN .EQ. 0) WD= WGO(1)*NCELLS*IDIL 
  471.       WV=WD+WGO(1)*NCELLS 
  472.       AF11=1./GCTRM 
  473.       IF ( IH2O .EQ. 0) GO TO 110 
  474. C  WATER HEATER CONSTANTS 
  475.       WH2O= WGO(1)*NCELLS 
  476.       IF(IDIL .EQ. 1) WH2O= WD*PI*DH2O**2/(4.*ADIL) 
  477.       FH2O= .3164*XLH2O/DH2O/(4.*WH2O/(PI*UAA*DH2O))**.25 
  478.       IF (IDIL .EQ. 0) GO TO 105
  479.       WH2O= WD*(PI*DH2O**2)/(4.*ADIL)*SQRT(ZRELFI/(ZRELFO+FH2O))
  480.       FH2O= .3164*XLH2O/DH2O/(4.*WH2O/(PI*UAA*DH2O))**.25 
  481. 105   AH2O= XLH2O*PI*DH2O 
  482.       CPH= CPAIR*WH2O 
  483.       HH2O= (ZKAA*ZHX3*DVENT/DH2O*(4.*WH2O/(PI*UAA*DH2O))**.8)
  484.       HAG(4)=1./EXP(AH2O*HH2O/CPH)
  485.       EMISP(6)= EMIS(6)*.171D-8*.5*AH2O 
  486.       HXVP(6)= AH2O*ZAVB*.47*ZKAA/DH2O*(CONST6*(4.*PR)**.25*DH2O**3 
  487.      + *110.)**.25
  488.       C10XS(6)= DTIME/(AH2O*CPMV(6)*RHOMV(6)) 
  489.       CONS20=(ZRELFO+FH2O)*(4./(PI*DH2O**2))**2/(GCTRM*RHOA)
  490.       CONS21= 1.+SQRT(CONST4/CONS20)
  491.       CONS20=CONS20*.5/TAINR
  492.       IF (AFCL .LE. 0.) GO TO 110 
  493.       AH= PI*DH2O**2/4. 
  494.       AH2= AH*AH
  495.       FH2O2= FH2O+ZRELFO
  496.       AF1= AH2/(AFCL2*FH2O2)
  497.       AF2= ZRELFO*AH2/(ADIL2*FH2O2) 
  498.       AF3= AH2/FH2O2*(1./AFCL2-ZRELFO/ADIL2)
  499.       AF4= (1./AFCL2-ZRELFO/ADIL2)/GCTRM
  500.       AF6= ZRELFO/(GCTRM*ADIL2) 
  501.       AF7= -AF2 
  502.       AF8= -AF6 
  503.       AF10=AH2/FH2O2
  504.       AF12= ZRELFI*AH2*TAINR/(FH2O2*ADIL2)
  505.       AF13= ZRELFI*AF11/(RHOA*ADIL2)
  506.       AF17= AH2/(FH2O2*AFCL2) 
  507.   110 CONS23= (CONS21-1.)*SQRT(2.*TAINR)
  508.       IF (IOIL .EQ. 0) WH2O=WH2O*.001 
  509.       IF ((IH2O .EQ. 1) .OR. (AFCL .LE. 0.)) GO TO 115
  510.       AF1= (1./AFCL2-ZRELFO/ADIL2)/GCTRM
  511.       AF2= ZRELFO/(GCTRM*ADIL2) 
  512.  115  CONTINUE
  513.       AJP= AJ/NCELLS
  514.       CONS13= DTIME/(CJ*RHOJ*AJP) 
  515.       HJOA= AJP*(HOJ+EMISJC*.171E-8*4.*(TAIN+DTRJC*.5+459.7)**3)
  516.       CALL PLENUM 
  517.       XLS= XM 
  518.       HIJON(1)= 0.
  519.       HIJON(2)=0. 
  520.       HIJOF=0.
  521.       AJHX=0. 
  522. C      WRITE(60,3020) (TFILM(I),I=1,3) 
  523.       DO 120 I=1,3
  524.       HGOFF(I)=ZHX1/D(I)*ZKGOF*AHX(I) 
  525.       ZKG=ZKF(TFILM(I)) 
  526.       UG=ZUF(TFILM(I))
  527.       RE3=(WGO(1)/(BHX*UG))**.333 
  528.       RE32=(WGO(2)/(BHX*UG))**.333
  529.       HGON(I,1)=(ZHX2/D(I)*RE3*ZKG+HRAD(I))*AHX(I)
  530.       HGON(I,2)=(ZHX2/D(I)*RE32*ZKG+HRAD(I))*AHX(I) 
  531. C  NOTE ZHX1D VALUES CALC FOR EACH TIMESTEP LATER 
  532. C    BY CHANGE ON 11/11/83
  533.       ZHX1D(I)= HGOFF(I)/(CPAIR*(WAOFF+.000001))
  534.       ZHX2D(I,1)=HGON(I,1)/(CPG(1)*WGO(1))
  535.       ZHX2D(I,2)=HGON(I,2)/(CPG(2)*WGO(2))
  536.       XLL(I)= XLS+XL(I) 
  537.       XLS= XLL(I) 
  538.       XLDC(I)= XLL(I)/DCELLA(I) 
  539.       REA= (XLDC(I)*WAIRF(1)/(BHX*UA))**.8
  540.       HAON(I,1)=ZA1*ZKA*REA*AHX(I)/XLL(I) 
  541.   116 HAOFF(I)=ZA2*AHX(I)/DCELLA(I) 
  542.   117 XLDCH(I,1)=HAON(I,1)/(CPAIR*WAIRF(1)) 
  543.       ZA2D(I)= HAOFF(I)/(CPAIR*WAIRN) 
  544.       AHXC(I)= CONST1/AHX(I)
  545.       HIJON(1)=HIJON(1)+HAON(I,1) 
  546.       REA= (XLDC(I)*WAIRF(2)/(BHX*UA))**.8
  547.       HAON(I,2)=ZA1*ZKA*REA*AHX(I)/XLL(I) 
  548.       XLDCH(I,2)= HAON(I,2)/(CPAIR*WAIRF(2))
  549.       HIJON(2)=HIJON(2)+HAON(I,2) 
  550.       HIJOF=HIJOF+HAOFF(I)
  551. 120   AJHX= AJHX+AHX(I) 
  552. C *** LAST LUMP HAS ARBITARY GAP FOR HEAT TRANSFER
  553.       ZHX1D(3)= ZHX1D(3)*D(3)/DGAPHT
  554.       ZHX2D(3,1)= ZHX2D(3,1)*D(3)/DGAPHT
  555.       ZHX2D(3,2)= ZHX2D(3,2)*D(3)/DGAPHT
  556.       DO 130 I=1,3
  557.       IF (ZHX2D(I,2) .GT. 173.) ZHX2D(I,2)=173. 
  558.       ZHX2D(I,2)=1./EXP(ZHX2D(I,2)) 
  559.       IF (ZHX1D(I) .GT. 173.) ZHX1D(I)=173. 
  560.       ZHX1D(I)=1./EXP(ZHX1D(I)) 
  561.       IF (ZHX2D(I,1) .GT. 173.) ZHX2D(I,1)=173. 
  562.       ZHX2D(I,1)=1./EXP(ZHX2D(I,1)) 
  563.       IF ( XLDCH(I,1) .GT. 173. ) XLDCH(I,1) =173.
  564.       XLDCH(I,1)=1./EXP(XLDCH(I,1)) 
  565.       IF ( XLDCH(I,2) .GT. 173.) XLDCH(I,2)= 173. 
  566.       XLDCH(I,2)=1./EXP(XLDCH(I,2)) 
  567.       IF (ZA2D(I) .GT. 173.) ZA2D(I)=173. 
  568.   130 ZA2D(I)=1./EXP(ZA2D(I)) 
  569. C CONVECTIVE HT COEF ON OUTSIDE OF VENT SECTIONS
  570.       HAS(1)= ZAVB*CONST7*(CONST6*130./XV(1))**.25
  571. C   FOR AFUE TEST, ADD INSULATION TO FIRST SECTION OF VENT
  572.       IF(XV(3).LT..16)HAS(1)=1./(RNSLS1+1./HAS(1))
  573.       HAS(2)= ZAVB*CONST9*(CONST8*110.)**.25
  574.       HAS(3)= ZAVH*CONST7*(CONST6*90./XV(3))**.25 
  575.       HAS(4)= ZAVA*CONST7*(CONST6*110./XV(4))**.25
  576.       DATA NHAS/0/
  577.       NHAS=NHAS+1 
  578.       HAS(5)= HASOD 
  579. C      IF(NHAS.LT.10)WRITE(60,3016)HAS
  580. C  NOTE 2 X WGT FOW ASSUMED FOR VENT FLOW HERE
  581.       RES= WV*4./UGS/DVENTP 
  582.       HF= RES**.8*ZHX3*ZKGS*DVENTP*.5 
  583.       F= .3164/RES**.25 
  584.       DO 140 I=1,5
  585.       XVD(I)= XV(I)*F/DVENT 
  586.       C10XS(I)= CONS10/(XV(I)*CPMV(I)*RHOMV(I)) 
  587.       XVP(I)= DVENTP*XV(I)
  588.       EMISP(I)= EMIS(I)*.171E-8*.5*XVP(I) 
  589.       HXVP(I)= XVP(I)*HAS(I)
  590. 140   XV5(I)= XV(I)/5.20
  591.       XV5(2)=0. 
  592. C     COMBINE HOR. WITH 1ST VERTICAL OF VENT
  593.       HXVP(1)= HXVP(1)+HXVP(2)
  594.       XVP(1)= XVP(1)+XVP(2) 
  595.       XVD(1)= XVD(1)+XVD(2) 
  596.       XV1SV=XV(1) 
  597.       XV(1)= XV1+XV(2)
  598. C  ASSUMES CP*RHO OF SECTIONS 1 AND 2 ARE THE SAME
  599.       C10XS(1)= CONS10/(XV(1)*CPMV(1)*RHOMV(1)) 
  600.       IEFAN1=1-IEFAN
  601.       IBURN1= 1-IBURN 
  602.       PUMPWP= PUMPW*QEXTT(1)/140000.
  603.       RON= AOUT**(60.*DTIME)
  604.       ROFF= AIN**(60.*DTIME)
  605.       HACON(1)=0. 
  606.       HACON(2)=0. 
  607.       HACOFF=0. 
  608.       FOIL=0. 
  609.       FOILS=0.
  610.       IMODE=1 
  611.       IF(IOIL.NE.1)THEN
  612.         IBGO=1
  613.         CALL OILBR(ADIL,IBGO,IDIL,ZRELFI)
  614.       ENDIF
  615. C  -  -  -  -   -   -   -   -   -   -   -   -   - 
  616.       HIJON(1)= HIJON(1)/AJHX*ZAJ(1)
  617.       HIJON(2)=HIJON(2)/AJHX*ZAJ(2) 
  618.       HIJOF=HIJOF/AJHX*ZAJ(3) 
  619. C  EFFECT OF JACKET INSULATION
  620.       HIJON(1)= AJP/(1./HIJON(1)+XJ/ZKJ)
  621.       HIJON(2)= AJP/(1./HIJON(2)+XJ/ZKJ)
  622.       HIJOF= AJP /(1./HIJOF+XJ/ZKJ) 
  623. C * * * * * 
  624. C  BEGIN CALCULATIONS AT EACH TIMESTEP
  625.   160 CONTINUE
  626.       WAIRF(1)=CFM(1)*C1
  627.       WAON=WAIRF(1)*NCELLS
  628.       DWAIR(1)=WAIRF(1)-WAIRN 
  629.       WAIRF(2)=CFM(2)*C1
  630.       DWAIR(2)=WAIRF(2)-WAIRN 
  631.       IBURN1= 1-IBURN 
  632.       IEFAN1= 1-IEFAN 
  633.       IB=2-IAC1 
  634.       IF(ISKIP.EQ.0)GO TO 170 
  635.       IMODE= IBURN+2*IBURNO 
  636. C  IMODE=1  --  BURNER JUST CAME ON 
  637. C       =2  --  BURNER JUST WENT OFF
  638.       IF(IMODE.EQ.1)GO TO 170
  639.       IF(IMODE.EQ.2)GO TO 200
  640.       IB= IB*IBURN+3*IBURN1 
  641. C  SECOND STAGE BURNER CAME ON WHEN IB NE IBO 
  642.       IF ( IB .NE. IBO) GO TO 180 
  643.       ISWITH= (IEFAN-IEFANO)**2+1 
  644.       IF(ISWITH.EQ.1)GO TO 260
  645.       IF(ISWITH.EQ.2)GO TO 240
  646. C     BURNER JUST CAME ON 
  647. 170   IDP=IDPON 
  648.       IDPP=1
  649.       IFN=0 
  650. C  ITFL IS INDEX PAR FOR CONDENSING FURNACE 
  651.       ITFL=0
  652.       TCYCLE=DTIME
  653.       TCYCQ=TCYCLE
  654. 180   CP=CPG(IB)
  655.       WG=WGO(IB)
  656.       WGT= WGTO(IB) 
  657.       WAOQ=WAOT(IB) 
  658.       WGTSV=WAOQ
  659. C      QEXXT=QEXTT(IB)/NCELLS
  660. C  SET FLUE FLOW CONSTANTS FOR OFF CYCLE
  661.       IF(WFLMIN.GE.0..AND.LINWFL.NE.1.AND.BCON(1).EQ.0.)THEN
  662.           WFL1A=WFL1
  663.           IF(WFL1.LE.1.)WFL1A=WFL1*WGT
  664.           BCON(3)=(WFL1A-WFLMIN)/(TWFMAX-DTIME)**2
  665.           BCON(1)=WFLMIN+BCON(3)*TWFMAX**2
  666.           BCON(2)=(-2.)*BCON(3)*TWFMAX
  667.           ENDIF 
  668.       IBQ=1 
  669.       IBS=IB
  670.       ZKBND=ZKBEND
  671.       IF ((IFAN .EQ. 0).AND.(IOIL.EQ.0)) WD=WGT*IDIL
  672.       QPILOP=0. 
  673.       RHOG5=RHOGOF(IB)
  674.       DO 190 I=1,3
  675. 190   HAG(I)= ZHX2D(I,IB) 
  676.       GO TO 240 
  677. C     BURNER JUST WENT OFF
  678. 200   IDP=IDPOFF
  679.       IFN= IFANCL 
  680.       IDPP=IDAMP1 
  681.       IBQ=2 
  682.       IB=3
  683.       ZKBND=ZKBND2
  684. C  NEXT THREE PARAMETER GET RESET BELOW (11/11/83)
  685.       WG= WAOFF 
  686.       WGT=WGTOF 
  687.       WAOQ=WAOFT
  688.       IF (IDAMP.EQ.1.AND.TIMOVD.EQ.0.)WD=WGT*(AFDL-1.)
  689.       CP=CPAIR
  690.       QPILOP=QPILOT
  691. C      QEXXT=QPILOT/NCELLS 
  692.       RHOG5= 39.75
  693.       DO 210 I=1,3
  694. 210   HAG(I)= ZHX1D(I)
  695.       TCYCLE=DTIME
  696.       TCYCQ=TCYCLE
  697. C *** DETERMINE ENTERING FLOWS TO HX
  698.   240 WAIR=WAIRN+IEFAN*DWAIR(IBL) 
  699.       CPWAIR= CPAIR*WAIR
  700.       DO 250 I=1,3
  701. 250   HACW(I)= XLDCH(I,IBL)*IEFAN+ZA2D(I)*IEFAN1
  702.       HACWO= (HACON(IBL)*IEFAN+HACOFF*IEFAN1) 
  703.   260 TODR=TODDB+FTR
  704.       POD=(-1.)*.075*530./TODR*(HIGH/5.2+0.5/GCTRM*(WSPED*5280.)**2)
  705.       CPAIN=CPAIR*TCOMB 
  706.       TCOMBR=TCOMB+FTR
  707.       PAMB= PAMBC/TCOMBR
  708.       PODPMB= POD-PAMB
  709. C  SET FLUE FLOW WITH BURNER OFF
  710.       IF(IBURN.EQ.0)THEN
  711.           IF(WFLMIN.LT.0.)THEN
  712.               DTFLU=TFLUE-TCOMB 
  713. C  EQNS SET FOR QPILOT = 674 BTU/HR (AFUE VALUE FOR HOUSE A FURNACE)
  714.               WGT=.00001
  715.               IF(DTFLU.GT.39.2)WGT=EXP(3.616+.18*ALOG(DTFLU)) 
  716.               IF(DTFLU.LT.39.2.AND.DTFLU.GT.0.) 
  717.      +        WGT=EXP(5.68*ALOG(DTFLU)-16.57) 
  718.               IF(WGT.GT.WGTSV)WGT=WGTSV 
  719.               ENDIF 
  720.           IF(WFLMIN.GE.0.)THEN
  721.              IF(LINWFL.EQ.1)THEN
  722.                  BCON(1)=WGTO(1)
  723.                  BCON(2)=(WFLMIN-BCON(1))/TWFMAX
  724.                  BCON(3)=0. 
  725.                  ENDIF
  726.           IF(TCYCLE.LE.TWFMAX)THEN
  727.                  WGT=BCON(1)+TCYCLE*(BCON(2)+TCYCLE*(BCON(3)+ 
  728.      +           TCYCLE*(BCON(4)+TCYCLE*(BCON(5)+TCYCLE*BCON(6))))) 
  729.           ELSE
  730.                  WGT=WFLMIN 
  731.                  ENDIF
  732.              ENDIF
  733.           WG=WGT/NCELLS 
  734.           WAOQ=WGT
  735.           ENDIF 
  736. C  -  - -  --    ---    ----
  737. C   WITH TIME CONSTANT ON GAS-SIDE FLOW BELOW 
  738.       IF(TCYCON.EQ.0..AND.TCYCOF.EQ.0.)GO TO 270
  739. C  NOTE WAOQ (COMB AIR) SHOULD BE CORRECTED FOR DELAY, IF TCYCON USED 
  740. C       WAOQ IS USED IN CALC MAKEUP AIR FOR INFILTRATION CALC 
  741.       TCYC=TCYCLE+DTIME 
  742.       DWGQ=WGO(IBS)-WAOFF 
  743.       IF(IBQ.EQ.2)GO TO 266 
  744.       IF(TCYCON.EQ.0.)GO TO 270 
  745. C  BURNER ON
  746.       RAT=TCYC/TCYCON 
  747.       ETRM=1. 
  748.       IF(RAT.LT.7.0) ETRM=1.-1./EXP(RAT)
  749.       WG=WAOFF+ETRM*DWGQ
  750.       WGT=WG*NCELLS 
  751.       RAT=WGO(IBS)/WG 
  752.       DO 262 I=1,3
  753.       ZHXQ=ALOG(1./ZHX2D(I,IBS))
  754.   262 HAG(I)=1./(EXP(ZHXQ*RAT)) 
  755.       IF(IFAN.EQ.0.AND.IOIL.EQ.0)WD=WGT*IDIL
  756.       GO TO 270 
  757. C  DONT PERMIT TCYCOF OPERATION  11/11/83 
  758. C   LEAVE CODE FOR NOW
  759.   266 CONTINUE
  760.       IF(TCYCOF.EQ.0.)GO TO 270 
  761. C  BURNER OFF 
  762.       RAT=TCYC/TCYCOF 
  763.       ETRM=1.0
  764.       IF(RAT.LT.7.0) ETRM=1.-1./EXP(RAT)
  765.       WG=WGO(IBS)-DWGQ*ETRM 
  766.       WGT=WG*NCELLS 
  767.       RAT=WAOFF/WG
  768.       DO 268 I=1,3
  769.       ZHXQ=ALOG(1./ZHX1D(I))
  770.       ZHXQ=ZHXQ*RAT 
  771.       HAG(I)=0. 
  772.       IF(ZHXQ.LT.7.0) HAG(I)=1./EXP(ZHXQ) 
  773.   268 CONTINUE
  774.       IF(IDAMP.EQ.1.AND.IMODE.EQ.2.AND.TIMOVD.EQ.0.)WD=WGT*(AFDL-1.)
  775. C  END OF TIME CONSTANT CALC
  776. C  -   -   -   -   -   -   -   -   -   -   -
  777.   270 WV=WD+WGT 
  778.       CPWG=CP*WG
  779.       CPWGT=CP*WGT
  780.       TCOMBO=TCOMB
  781.       ITIMHX=0
  782.   271 CONTINUE
  783.       TG1=TCOMB+TGO(IB)+QPILOP/(CPWGT+.00001) 
  784.       TG2=TG1 
  785.       TA1= TRETP
  786. C 
  787.       IF(IELC.EQ.1)THEN 
  788. C  ELECTRIC FURNACE - - - 
  789.           CALL ELCFUR(IBURN,TCYCLE,WAON,TA1,PCTJAC,TA2,QINQ)
  790.           QVSLOS=0. 
  791.           QVLLOS=0. 
  792.           QJACK=PCTJAC*QINQ*0.01/NCELLS 
  793.           WV=0.00000001 
  794.           WGT=0.00000001
  795.           WD=0.00000001 
  796.           TJ=TAIN 
  797.           TM(1)=TAIN
  798.           TM(2)=TAIN
  799.           TM(3)=TAIN
  800.           TG2=TG1 
  801.           TAHX=TA2
  802.           GO TO 319 
  803.           ENDIF 
  804. C  END OF ELECTRIC FURNACE - - - - -
  805.       IF(WGTHX.GT.0.)THEN 
  806. C  - - - - - - -
  807. C  CONDENSING PWR-VENT FURNACE
  808.       IF(IBURN.EQ.1)THEN
  809. C  * * * * * * *  BURNER ON 
  810. C GET FLUE TEMP 
  811.           CALL TFLC 
  812.           TFLUSV=TFLUE
  813. C   GET ENERGY INPUT TO HX AND FLUE LOSSES FOR THIS TIMESTEP
  814.           CALL QINHX(EHXC)
  815. C  GET PLENUM TEMP WITH THERMAL LAG DUE TO HX METAL 
  816.           CALL HXMTL(EHXC,TMHXC,TRETP,TA2)
  817. C  SET VALUES FOR MISCELLANEOUS PARAMETERS
  818.           TFLUE=TFLUSV
  819.           QJACK=PCTJAC*QEXTT(1)*.01/NCELLS
  820.       ELSE
  821. C * * * * * * *  BURNER OFF 
  822.           EHXC=0. 
  823.           CALL HXMTL(EHXC,TMHXC,TRETP,TA2)
  824.           TFLUE=88. 
  825.           IF(TMHXC.LT.88.)TFLUE=TMHXC 
  826.           QVSLOS=0. 
  827.           QVLLOS=0. 
  828.           QJACK=0.
  829.           WV=0. 
  830.           ENDIF 
  831.       TJ=TAIN 
  832.       TM(2)=TMHXC 
  833.       TM(3)=TMHXC 
  834.       TM(1)=TMHXC 
  835.       TG2=TFLUE 
  836.       TG1=TG2 
  837.       TAHX=TA2
  838.       GO TO 319 
  839.       ENDIF 
  840. C  * * * * * * * * * * *  END OF CONDENSING FURNACE 
  841.       IF(IOIL.NE.1)THEN
  842.         IBGO=2
  843.         CALL OILBR(ADIL,IBGO,IDIL,ZRELFI)
  844.       ENDIF
  845. C  * * * HEAT EXCHANGER EQUATIONS 
  846. C  TMSV IS MEAN METAL TEMP FOR LUMP AT LAST TIMESTEP
  847. C  TM IS MEAN METAL TEMP FOR LUMP 
  848.       DO 310 L=1,3
  849.       NBQ=0 
  850.       IF(NHXITR.EQ.0)DTM(L)=0.
  851.   282 TM(L)=TMSV(L)+0.5*DTM(L)
  852.       IF(IFN.NE.1)THEN
  853. C *** FIND PROPER GAS TEMP LVG LUMP & HEAT TRANSFER 
  854.         IF(IBURN.EQ.0)THEN
  855.           TFILMG=.5*(TM(L)+.5*(TG2+TG1))
  856.           ZKGOF=ZKF(TFILMG) 
  857.           HGOFF(L)=ZHX1/D(L)*ZKGOF*AHX(L) 
  858.           ZHX1D(L)=HGOFF(L)/(CPAIR*(WG+1E-6)) 
  859.           IF(L.EQ.3)ZHX1D(3)=ZHX1D(3)*D(3)/DGAPHT 
  860.           IF(ZHX1D(L).GT.173.)ZHX1D(L)=173. 
  861.           HAG(L)=1./EXP(ZHX1D(L)) 
  862.         ENDIF 
  863.         TG2=(TG1-TM(L))*HAG(L)+TM(L)
  864.         QG= CPWG*(TG1-TG2)
  865.         GO TO 300 
  866.       ENDIF
  867. C *** POWER COMBUSTION WITH FAN OFF. SKIP GAS SIDE HT 
  868.       TG2= TG1
  869.       QG=0. 
  870. C *** CALCULATE AIR SIDE HEAT TRANSFER
  871. C *** FAN IS OFF-- NATURAL CONVECTION 
  872.   300 TA2=TM(L)-(TM(L)-TA1)*HACW(L) 
  873.       QA= CPWAIR*(TA2-TA1)
  874.       QM= QG-QA 
  875.       DTMQ=QM*AHXC(L) 
  876.       IF(NTHX.LT.50)THEN
  877.         WRITE(60,512)L,DTMQ,DTM(L),TMSV(L),TM(L) 
  878.      +              ,TG1,TG2,TA1,TA2,HAG(L),HACW(L) 
  879.         NTHX=NTHX+1
  880.         ENDIF
  881.   512 FORMAT(1X,'L,DTMQ,DTM(L),TMSV(L),TM(L)= ',I5,4G13.5,
  882.      +/1X,'TG1,TG2,TA1,TA2,HAG(L),HACW(L)= ',6G13.5)
  883.       IF(NHXITR.EQ.0)GO TO 306
  884.       IF(ABS(DTMQ-DTM(L)).LE.DTMTOL)GO TO 306 
  885.       DTM(L)=DTMQ 
  886.       NBQ=NBQ+1 
  887.       IF(NBQ.EQ.11)GO TO 306
  888.       GO TO 282 
  889. C *** END OF HX LUMP CAL.; RESET FOR NEXT LUMP
  890.   306 TMSV(L)=TMSV(L)+DTM(L)
  891.       IF(NHXITR.EQ.0)TM(L)=TMSV(L)
  892.       IF(IBURN.EQ.1)TFILM(L)=.5*(TM(L)+.5*(TG1+TG2))
  893.       QMHX(L)=QM
  894.       TG1= TG2
  895.       TA1=TA2 
  896.   310 CONTINUE
  897. C  * * * END OF HEAT EXCH CALC
  898.       TFLUE=(TFLUSV+TG2)*0.5
  899.       IF(IBURN.EQ.1)THEN
  900. C  - - - - -
  901. C  CALC SENSIBLE(QVSLOS) AND LATENT(QVLLOS) FLUE LOSSES 
  902. C  NOT CODED FOR PART LOAD BURNER OPERATION 
  903. C    (SEE COMMON BLOCK FUEL1) 
  904.       CALL FUELA
  905.       ELSE
  906.           QVLLOS=0. 
  907.           QVSLOS=CPAIR*WGT*(TFLUE-TCOMB)
  908.       ENDIF 
  909.       TFLUE=TG2 
  910.       TFLUSV=TFLUE
  911. C  *  *  *  JACKET LOSSES 
  912.       HIJ= HIJOF*IEFAN1+HIJON(IBL)*IEFAN
  913.       TAHX=TA2
  914.       TAJAC=TA2 
  915.       TAJ=0.5*(TRETP+TA2) 
  916.       NTJQ=0
  917.   311 TJ=TJSV+0.5*DTJ 
  918.       QJACK=HJOA*(TJ-TAIN)
  919.       QJACK1=HIJ*(TAJ-TJ) 
  920.       TA2N=TA2-QJACK1/CPWAIR
  921.       IF(TA2N.LT.TJ)THEN
  922.           TA2N=TJ 
  923.           QJACK1=CPWAIR*(TA2-TA2N)
  924.       END IF
  925.       QMJ=QJACK1-QJACK
  926.       DTJQ=QMJ*CONS13 
  927.       NTJQ=NTJQ+1 
  928.       IF(NTJJ.LT.50)THEN
  929.         WRITE(60,514)NTJQ,TJ,DTJQ,DTJ,TA2,TA2N 
  930.         NTJJ=NTJJ+1
  931.         ENDIF
  932.   514 FORMAT(1X,' NTJQ,TJ,DTJQ,DTJ,TA2,TA2N= ',I5,5G13.5) 
  933.       IF(ABS(DTJQ-DTJ).LE.DTMTOL)GO TO 312
  934.       IF(NTJQ.GT.15)GO TO 312 
  935.       DTJ=DTJQ
  936.       TAJAC=TA2N
  937.       GO TO 311 
  938.   312 TJSV=TJSV+DTJ 
  939.       TA2=TA2N
  940.   319 CONTINUE
  941.       TAJAC=TA2 
  942.       IF(HAACL(1).EQ.0.)GO TO 316 
  943. C  *  *  *  *  A-COIL IN PLENUM 
  944.       HACL=HACLON*IEFAN+HACLOF*IEFAN1 
  945.       TAAC=TA2
  946. C HEAT EXCHANGE WITH A-COIL (Q=H*A*LOG MEAN DELTA TEMP W/ BLWR ON)
  947. C                           (Q=H*A*AVG DELTAT W/ BLWR OFF)
  948.       NBQ=0 
  949.   313 TMAC=TMACSV+0.5*DTMAC 
  950.       IF(IEFAN.EQ.1)TA2N=HACL*(TA2-TMAC)+TMAC 
  951.       IF(IEFAN1.EQ.1)THEN 
  952.            TA2N=(TA2+HACL*(2.*TMAC-TA2))/(1.+HACL)
  953.            IF(TA2.GT.TMAC)THEN
  954.                 IF(TA2N.LT.TMAC)TA2N=TA2-HACL*(TA2-TMAC)
  955.                 IF(TA2N.LT.TMAC)TA2N=TMAC 
  956.                  ENDIF
  957.            IF(TA2.LT.TMAC)THEN
  958.                 IF(TA2N.GT.TMAC)TA2N=TA2-HACL*(TA2-TMAC)
  959.                 IF(TA2N.GT.TMAC)TA2N=TMAC 
  960.                  ENDIF
  961.       END IF
  962.       QACL=CPWAIR*NCELLS*(TA2-TA2N) 
  963.       DTMAQ=QACL*DTIME/CPMACL 
  964.       IF(NACL.LT.50)THEN
  965.         WRITE(60,586)NBQ,DTMAQ,DTMAC,TMACSV,TMAC,
  966.      +              TA2,TA2N,HACL 
  967.         NACL=NACL+1
  968.         ENDIF
  969.   586 FORMAT(1X,'NBQ,DTMAQ,DTMAC,TMACSV,TMAC,TA2,TA2N,HACL= '/
  970.      +1X,I5,7G13.5) 
  971.       IF(ABS(DTMAQ-DTMAC).LE.DTMTOL)GO TO 314 
  972.       DTMAC=(DTMAQ+DTMAC)*0.5 
  973.       TAAC=TA2N 
  974.       NBQ=NBQ+1 
  975.       IF(NBQ.LT.11)GO TO 313
  976.   314 TMACSV=TMACSV+DTMAC 
  977.       TA2=TA2N
  978.       TAAC=TA2
  979. C  *  *  *  *  *  PLENUM EQNS 
  980. C 
  981.   316 CALL PLENM1 
  982. C  *  *  *  *  WATERHEATER VENT EQNS
  983.   320 IF(IH2O1.NE.1)THEN
  984. C  *  *  *  * 
  985. C   ASSUMES WATERHEATER IS LOCATED BY FURNACE AND RECEIVES
  986. C     FURNACE COMBUSTION AIR
  987.         THGP=THG+TCOMB
  988.         CPH= (WHGCP-CPAIR*WHG)*IHON+WH2O*CPAIR
  989.         THMIX= ((WHGCP*THGP-WHG*CPAIN)*IHON+WH2O*CPAIN)/CPH 
  990.         TH2O=(THMIX-THM)*HAG(4)+THM 
  991.         QH2O= CPH*(THMIX-TH2O)
  992.         QHAIR= (HXVP(6)+EMISP(6)*(THM+TCOMB+920.)**3)*(THM-TCOMB) 
  993.         THM= C10XS(6)*(QH2O-QHAIR)+ THM 
  994.         RHOW= 39.75*(1-IHON)+ RHOGOF(1)*IHON
  995.       ENDIF
  996. C     DILUTION AIR
  997.       WV=WD+WGT+WH2O
  998.       IF (WV .LE. 0.) GO TO 330 
  999.       IF(WD.LT.0.)THEN
  1000.            CPWD=CP*WD 
  1001.            CPWDT=CPWD*TG1 
  1002.       ELSE
  1003.            CPWD=CPAIR*WD
  1004. C            **  ** 
  1005. C            ASSUMES RELIEF INLET IS CONNECTED TO COMBUSTION AIR
  1006.            CPWDT=CPWD*TCOMB 
  1007.       END IF
  1008.       CPF=CPWGT+CPWD+CPH
  1009.       TV1= (CPWGT*TG1+CPWDT+CPH*TH2O)/CPF 
  1010.       TVOR= TV1+FTR 
  1011.       RHOTRM=39.75
  1012.       IF(WD.LT.0.)RHOTRM=RHOG5
  1013.       RHOFT= WV/ (WGT/RHOG5+WD/RHOTRM+WH2O/RHOW)
  1014.       HFASF= HF/CPF 
  1015.       IF(IDV.EQ.0)GO TO 330 
  1016.       IF(ITIMHX.EQ.1)GO TO 330
  1017. C  *** COUNTERFLOW HEAT EXCHANGE BETWEEN COMBUSTION AIR AND VENT
  1018.       CMIN=CPAIR*WAO
  1019.       CRAT=CMIN/CPWG
  1020.       IF(CRAT.GT.1.0)CRAT=1.0 
  1021.       IF(EFFHXV.GE.0.1)GO TO 329
  1022.       EXPO=1.0/EXP(UAHXV*(1.0-CRAT)/CMIN) 
  1023.       EFFHXV=(1.-EXPO)/(1.-EXPO*CRAT) 
  1024.   329 TCOMB=EFFHXV*(TV1-TCOMBO)+TCOMBO
  1025.       TV1=TV1-EFFHXV*CRAT*(TV1-TCOMBO)
  1026.       ITIMHX=1
  1027.       GO TO 271
  1028.   330 CONTINUE
  1029. C 
  1030. C *** COLLECT DATA FOR WRITING
  1031.       IF(ICOLL.NE.0) THEN 
  1032.           CDATA(2)=TM(2)
  1033.           CDATA(3)=TJ 
  1034.           CDATA(4)=TFLUE
  1035.           CDATA(5)=TV1
  1036. C          CDATA 6  7  8  ... SEE BELOW 
  1037.           CDATA(9)=TM(1)
  1038.           CDATA(10)=TM(3) 
  1039.           CDATA(11)=WV
  1040. C                12...SEE PLENUM 
  1041.           CDATA(13)=TMPL
  1042.           CDATA(14)=WGT 
  1043.       ENDIF 
  1044. C 
  1045. C     L LUMPS AND NVER VERTICAL LUMPS WITH 90 BENDS IN BETWEEN
  1046. C *** FIRST VERTICAL LUMP 
  1047. C *** VENT LOSS ENTRANCE IS 1 VEL HEAD
  1048. C  VEL HD LOSSES ARE BASED ON 1 LB/HR IN BELOW EQNS 
  1049.       HVIN= CONST5/RHOFT*TVOR 
  1050. 340   TAIR= TAIN
  1051.       TVENTI=TV1
  1052.       QS=0. 
  1053.       TV2=TODDB 
  1054.       DPB=0.
  1055.       DPF=0.
  1056.       L=1 
  1057. 350   IF (WV .LE. 0.) GO TO 360 
  1058. C *** FIND LVG LUMP VENT TEMP 
  1059.       HFAS= HFASF*XV(L) 
  1060.       TV2=(TV1+HFAS*(2.*TMV(L)-TV1))/(1.+HFAS)
  1061. C 
  1062. C *** COLLECT CHIMNEY TEMPERATURES
  1063.       IF(ICOLL.NE.0) THEN 
  1064.           IF(3.LE.L.AND.L.LE.5) CDATA(L+3)=TV2
  1065.       ENDIF 
  1066. C 
  1067.       QS= CPF*(TV1-TV2) 
  1068.       TVA= (TV1+TV2)*.5 
  1069. C *** PRESS DROP
  1070.       RHOF= RHOFT/(TVA+FTR) 
  1071.       HV= CONST5/RHOF 
  1072. C  FRICTION PRESSURE DROP(DPF)
  1073.       DPF= DPF+HV*XVD(L)
  1074. C  ELEVATION PRESS DROP(DPB)
  1075.       DPB= RHOF*XV5(L)+DPB
  1076. C *** AIR SIDE HEAT TRANSFER--IF ANY
  1077. C *** NATURAL CONVECTION ALONG VERTICAL VENT
  1078. C *** FORCED CONVECTION OVER OUTDOOR VERTICAL VENT WHEN WSPED GT 0.;
  1079. C ***   OTHERWISE, NATURAL CONVECTION AT OUTDOOR SECTION
  1080.   360 HRAT=1. 
  1081.       HAVXP=HXVP(L) 
  1082.       IF(L.EQ.5)THEN
  1083.           IF(WSPED.EQ.0.)THEN 
  1084. C             USE NATURAL CONVECTION CORRELATION (RATIO TO HAS(1))
  1085.               DTMV=TMV(5)-TODDB 
  1086.               IF(DTMV.LE.0.)THEN
  1087.                   HRAT=0. 
  1088.               ELSE
  1089.                   HRAT=(TAINR/TODR)**.308/ZAVB*(DTMV*XV1SV/ 
  1090.      +                 (130.*XV(5)))**.25 
  1091.                   ENDIF 
  1092.               HAVXP=XVP(5)*HAS(1)*HRAT
  1093.           ELSE
  1094.               HRAT=(WSPED/WSPEDS)**.6*(TODRS/TODR)**.49 
  1095.               HAVXP=HRAT*HXVP(5)
  1096.               ENDIF 
  1097.           ENDIF 
  1098.       
  1099.       QAV= (HAVXP+EMISP(L)*(TMV(L)+TAIR+920.)**3)*(TMV(L)-TAIR) 
  1100.       IF(L.EQ.3)THEN
  1101.           QAVS=QAV*(1.-VOUTSD)
  1102.           QAV=QAVS+VOUTSD*(HXVP(L)+EMISP(L)*(TMV(L)+TODDB+920.)**3) 
  1103.      +    *(TMV(L)-TODDB) 
  1104.           ENDIF 
  1105.       QMS= QS-QAV 
  1106.       QMSV(L)=QMS 
  1107.       TMV(L)= QMS*C10XS(L)+TMV(L) 
  1108. C *** RESET FOR NEXT LUMP 
  1109.       TV1= TV2
  1110. C *** SECTION DONE: SET UP VALUES FOR NEXT SECTION
  1111.       GO TO (370,370,380,390,410),L 
  1112. C     1ST VERTICAL &HORIZONTAL DONE, FIND DP FOR 90 BENDS 
  1113.   370 IF(POPEN.NE.0.)THEN 
  1114. C  THERMAL VENT DAMPER IN VENT
  1115.           TCYCVD=TCYCLE 
  1116.           IBRNVD=IBURN
  1117.           CALL TVD
  1118.           ENDIF 
  1119.       DPF=DPF+(ZKBND+VHLTVD)*HV 
  1120.       L=3 
  1121.       QVENTB= QAV+QHAIR 
  1122.       IF(NRMVNT.EQ.1)THEN 
  1123.          IRMVT1=IRMVNT(1) 
  1124.          TAIR=TI(IRMVT1)
  1125.       ELSE IF (NRMVNT.EQ.2)THEN 
  1126.          IRMVT1=IRMVNT(1) 
  1127.          IRMVT2=IRMVNT(2) 
  1128.          TAIR=FRCVNT(1)*TI(IRMVT1)+FRCVNT(2)*TI(IRMVT2) 
  1129.          ENDIF
  1130.       GO TO 350 
  1131. C *** VERTICAL ATTIC SECTION
  1132.   380 TVH=TV2 
  1133.       QVNTLS=QAVS 
  1134.       TAIR= TATTC(NATVNT) 
  1135.       L=4 
  1136.       GO TO 350 
  1137. C *** VERTICAL OUTDOOR SECTION
  1138. 390   L=5 
  1139.       TAIR= TODDB 
  1140.       QVENTA=QAV
  1141.       GO TO 350 
  1142. C *** END OF VENT CAL.
  1143. C *** TOP OF VENT LOSS=1 VEL HEAD+ 1 VEL FOR STATIC PRESS 
  1144. 410   HVOUT= ZVT*HV 
  1145. C     NEW RELIEF FLOW 
  1146.       DPT= DPF+HVOUT+HVIN 
  1147. C ***  ***  SELECT VENT-CONFIGURATION OPTION
  1148.       IF(IDAMP.GT.0)THEN
  1149.           IF(IBURN.EQ.1)GO TO 414 
  1150.           IF(AFCL.GT.0.)GO TO 412 
  1151.           WV=0. 
  1152.           IF(TCYCLE.GT.TIMOV)GO TO 440
  1153.           GO TO 414 
  1154.           ENDIF 
  1155.       GO TO (412,412,430,440),IDP 
  1156.       GO TO 414 
  1157.   412 IF(TCYCLE.GT.TIMOV)GO TO (420,425)IDP 
  1158.   414 CON23P=CONS23/SQRT(TH2O+THMIX+920.) 
  1159.       GO TO (419),IOIL
  1160.       IBGO=3
  1161.       CALL OILBR(ADIL,IBGO,IDIL,ZRELFI)
  1162. C  IDP=0  OR  = GT 4
  1163. C  WITH OR WITHOUT WATER HEATER,  NO VENT DAMPER
  1164. 419   CON21P= 1.+CON23P 
  1165.       CON22P=CON21P**2
  1166.       DPTA= DPT*CON22P+CONST4 
  1167.       DPTB= WGT*DPT*CON21P/DPTA 
  1168.       DPTC= (DPT*WGT**2+DPB+PODPMB)/DPTA
  1169.       SQTRM=DPTB**2-DPTC
  1170.       IF(SQTRM.GT.0.)GO TO 409
  1171.       GO TO 424 
  1172.   409 WD=(-1.)*DPTB+SQRT(SQTRM) 
  1173. 424   WH2O= WD*CON23P 
  1174.       WV=WD+WGT 
  1175.       GO TO 440 
  1176. C  IDP=1
  1177. C  WATER HEATER EQNS NOT CHECKED YET(9/13/83) 
  1178. 420   TH2OA= (TH2O+THMIX+920.)*.5 
  1179.       TG2R= TG2+FTR 
  1180.       RHOGP= 39.75/TG2R 
  1181.       DPTA= 1.+AF3*TG2R/TH2OA+AF4/(DPT*RHOGP) 
  1182.       DPTB= (WH2O+AF2*WGT*TG2R/TH2OA+AF6*WGT/(DPT*RHOGP))/DPTA
  1183.       DPTC= (WGT**2*TG2R/TH2OA*AF7+(PODPMB+DPB+AF8*WGT**2/RHOGP)/DPT)/
  1184.      + DPTA 
  1185. C     NEW WATERHEATER FLOW WITH VENT DAMPER INCOMPLETELY CLOSED 
  1186.       WV= -DPTB+SQRT(DPTB**2-DPTC)
  1187.       WH2O= SQRT((AF1*WV**2-AF2*(WGT -WV)**2)*TG2R/TH2OA) 
  1188.       IF (WV .LT. WGT) GO TO 440
  1189. C     FLOW COMES IN RELIEF OPENING TOO
  1190.       RHOP=39.75/TH2OA
  1191.       RHOD= WV/(WGT/RHOGP+(WV-WGT)/RHOA)
  1192.       ARHO= ZRELFI/(RHOA*ADIL2)+1./(RHOD*AFCL2) 
  1193.       DPTA= 1.+(AF10*RHOP+AF11/DPT)*ARHO
  1194.       DPTB= (WH2O-(AF12/TH2OA+AF13/DPT)*WGT)/DPTA 
  1195.       DPTC= ((AF12/TH2OA+AF13/DPT)*WGT**2+(PODPMB+DPB)/DPT)/DPTA
  1196.       DPTBC= DPTB**2-DPTC 
  1197.       IF (DPTBC .GE. 0.) GO TO 423
  1198.       WV=WGT
  1199.       GO TO 432 
  1200. 423   WV= -DPTB+SQRT(DPTBC) 
  1201. 432   WH2O= SQRT((AF12*(WV-WGT)**2+WV**2*AF17*TG2R)/TH2OA)
  1202.       GO TO 440 
  1203. C     NO WATERHEATER BUT VENT DAMPER INCOMPLETELY CLOSED
  1204. C  IDP=2
  1205.  425  RHOGP=39.75/(TG1+FTR )
  1206.       DPTA= DPT+AF1/RHOGP 
  1207.       DPTB=AF2*WGT/(RHOGP*DPTA) 
  1208.       DPTC= (DPB+PODPMB-AF2*WGT**2/RHOGP)/DPTA
  1209.       WV= -DPTB+SQRT(DPTB**2-DPTC)
  1210.       IF (WV .LT. WGT) GO TO 440
  1211. C     FLOW COMES IN RELIEF OPENING TOO
  1212.       RHOD=WV/(WGT/RHOGP+(WV-WGT)/RHOA) 
  1213.       DPTA= DPT+AF11*(1./(RHOD*AFCL2)+ZRELFI/(RHOA*ADIL2))
  1214.       DPTB= -WGT*AF2*1.5/(RHOA*DPTA)
  1215. C  WGT*DPTB DIVIDED BY DPTA ON 9/13/83 BELOW
  1216.       DPTC=(DPB+PODPMB-WGT*DPTB)/DPTA 
  1217.       DPTBC=DPTB**2-DPTC
  1218.       IF (DPTBC .GE. 0.) GO TO 433
  1219.       WV=WGT
  1220.       GO TO 440 
  1221. 433   WV= -DPTB+SQRT(DPTBC) 
  1222.       GO TO 440 
  1223. C  IDP=3
  1224. 430   WH2O= SQRT((-PODPMB-DPB)/(DPT+CONS20*(TH2O +THMIX+920.))) 
  1225.   440 CONTINUE
  1226.       IF(NTBB.LT.50)THEN
  1227.         WRITE(60,537)WD,WAOQ,WH2O,WVH,WV 
  1228.         NTBB=NTBB+1
  1229.         ENDIF
  1230.   537 FORMAT(1X,' WD,WAO,WH2O,WVH,WV= ',5G13.5) 
  1231. C  WAIRB IS USED IN INFILTRATION LOSS IN BASEMENT 
  1232.       WAIRB= WD+WAOQ+WH2O-WVH*IHON
  1233. C  SET WD FOR NEXT TIMESTEP 
  1234.       WD=WV-WGT 
  1235.       QDRAFT=0. 
  1236. C  QDRAFT IS SPILLAGE HEAT FLOW 
  1237. C   ASSUMES RELIEF INLET IS CONNECTED TO COMBUSTION AIR 
  1238.       IF(WD .LT. 0.)THEN
  1239.           QDRAFT=(-1.)*CP*WD*(TFLUE-TCOMB)*IDIRCT1
  1240.           ENDIF 
  1241.       IF(IDPP.NE.1)THEN
  1242. C  WG DECAYS TO WGMIN AFTER BURNER SHUTS OFF WITH VENT DAMPER 
  1243. C  *  *  *
  1244.         RR= (ROFF*IEFAN1+RON*IEFAN) 
  1245.         IF ( WG .LT. WGMIN) RR=1. 
  1246.         WG= WG*RR 
  1247.         WGT= WGT*RR 
  1248.         IF (AFDL .LE. 0.) WD=(-1.)*WGT
  1249.         CPWG= CPWG*RR 
  1250.         CPWGT= CPWGT*RR 
  1251.       ENDIF
  1252.       IBURNO=IBURN
  1253.       IEFANO=IEFAN
  1254.       IBO=IB
  1255.       IF(INC.LT.500)INC=INC+1 
  1256.       QEXT=QEXTT(IB)
  1257.       EXCESS=EXC(IB)
  1258.       QUSEFL=CPAIR*DTRA*(WAON*IEFAN+WAOF*(1.-IEFAN))
  1259.      ++(QJACK+QPLEN)*NCELLS 
  1260.       IF(IELC.EQ.1)THEN 
  1261.           QEXT=QINQ 
  1262.           QPILOP=0. 
  1263.           IF(IBURN.EQ.0)THEN
  1264.               QEXT=0. 
  1265.               QPILOP=QINQ 
  1266.               ENDIF 
  1267.           ENDIF 
  1268.       QINPUT=QEXT*IBURN+QPILOP+WAON*CPAIR*DTBLR*IEFAN
  1269.       IF(IBURN.NE.1)GO TO 470 
  1270.       IF(TCYCLE.GT.TMFUL(1).AND.TCYCLE.LT.TMFUH(1))TFON1C=TG2 
  1271.       IF(TCYCLE.GT.TMFUL(2).AND.TCYCLE.LT.TMFUH(2))TFON2C=TG2 
  1272.       EFFSSA=0. 
  1273.       IF(TCYCLE.GT.TMFUL(3))THEN
  1274.            DTRA2C=DTRA
  1275.            TFSSC=TG2
  1276.            EFFSSA=100.*QUSEFL/QINPUT
  1277.            ENDIF
  1278.       GO TO 480 
  1279.   470 IF(TCYCLE.GT.TMFUL(4).AND.TCYCLE.LT.TMFUH(4))TFFF3C=TG2 
  1280.       IF(TCYCLE.GT.TMFUL(5).AND.TCYCLE.LT.TMFUH(5))TFFF4C=TG2 
  1281.       IF(TCYCLE.GT.TMFUL(6).AND.TCYCLE.LT.TMFUH(6))DTRA4C=DTRA
  1282.   480 TFFF5C=TG2
  1283.       DTRA3C=DTRA 
  1284.       TCYP=TCYCLE*60. 
  1285.       TCYCLE=TCYCLE+DTIME 
  1286.       TCYCQ=TCYCLE
  1287. C         SET THE STATE OF THE BLOWER FOR THE NEXT TIMESTEP      
  1288.       IF(IBURN.EQ.1)THEN
  1289.           IF(TIME1.GT.0.)THEN 
  1290.                  IF(TCYCLE.GT.TIME1)IEFAN=1 
  1291.                  ENDIF
  1292.           IF(FANTON.GT.0.)THEN
  1293.                  IF(TPL.GT.FANTON)IEFAN=1 
  1294.                  ENDIF
  1295.       ELSE
  1296.           IF(TIME3.GT.0.)THEN 
  1297.                  IF(TCYCLE.GT.TIME3)IEFAN=0 
  1298.                  ENDIF
  1299.           IF(FANTOF.GT.0.)THEN
  1300.                  IF(IEFANO.EQ.1.AND.TPL.LT.FANTOF)THEN
  1301.                              NTFAN=NTFAN+1
  1302.                              IF(NTFAN.LT.5)WRITE(60,3015)TCYCLE,TPL
  1303.                              IEFAN=0
  1304.                              ENDIF
  1305.                  ENDIF
  1306.       ENDIF 
  1307.       IEFNHX=IEFAN
  1308. C      
  1309. C         SET THE STATE OF THE HI-LIMIT SWITCH, IF ANY
  1310.       IF(TSHLIM.GT.0.)THEN
  1311.         CALL HILIM(THLOFF,THLON,TSHLIM,TPL)
  1312.       ENDIF        
  1313.       ISKIP=1 
  1314.       IF ( INC .GT. IDEBUG)GO TO 481
  1315.       WRITE(60,3002) TCYP,TG2,DTRA,WGT,WD,WV,TM(2),TVENTI,TVH,
  1316.      +TAHX,TAJAC,TAAC,TPL,TJ,TMAC,TMPL,IBURN,IEFANO 
  1317. C     WRITE(60,3021) (TM(I),I=1,3)
  1318.       IF((IH2O.EQ.1).OR.(IOIL.EQ.0))WRITE(60,3005) THMIX,TH2O,THM,QHAIR,
  1319.      +               QH2O
  1320.      + ,WVH,WHG,CPH,THETA,FOIL,FOILS,IHON 
  1321.   481 CONTINUE
  1322.       RETURN
  1323.   999 STOP ' GASF: EOF ON TAPE12 WITH NAMELIST INPGSF'
  1324. 3000  FORMAT (/' NO CONV IN TGO') 
  1325.  3002 FORMAT(1X,F7.2,F7.0,F6.1,3F7.1,F7.0,9F7.1,2I4)
  1326.  3003 FORMAT(1H1,'TIME,MN   TG2   DTA   WGT    WD     WV',
  1327.      +'     TM(2) TVENTI   TVH   TAHX   TAJAC  TAAC', 
  1328.      +'   TAPL    TJ    TMAC   TMPL  BURN BLWR')
  1329. 3004  FORMAT (//'  TOTAL HEAT INPUT=',F10.0,' BTU/HR'/) 
  1330. 3005  FORMAT (F7.2,2F10.2,2F10.1,2F10.3,4F10.4,I5)
  1331. 3006  FORMAT ('  THMIX      TH2O      THM      QHAIR      QH2O' 
  1332.      + ,'      WVH       WHG       CPH     THETA     FOIL      FOILS
  1333.      +    IHON'/) 
  1334. 3010  FORMAT ('  WD,WDP,DWD,WGT,FOILS,TCYCLE',6F10.3/)
  1335.  3012 FORMAT(1X,'EXCESS AIR= ',F7.4,' STOIC AIR FLOW= ',
  1336.      +F7.1,' LB/HR   TOTAL AIR FLOW= ',F7.1,' LB/HR'/ 
  1337.      +'  FUEL FLOW= ',F7.1,' LB/HR',' FLUE FLOW= ',F7.1,' LB/HR') 
  1338.  3014 FORMAT(1H0,'TGO(1),CPG(1),HGO,CPFLU= ',4G13.5)
  1339.  3015 FORMAT(1H0,'BLOWER OFF AT TIME,PLEN TEMP= ',2G13.5) 
  1340.  3016 FORMAT(1H0,'HAS= ',6G13.5)
  1341.  3017 FORMAT(1H0,'TCYCLE,TG1= ',2G13.5) 
  1342.  3019 FORMAT(1X,'TFILM IN GAS SIDE OF HX= ',3F8.0)
  1343.  3020 FORMAT(1X,'TFILM USED FOR PROP CALC= ',3F8.0) 
  1344.  3021 FORMAT(1X,'TM= ',3F8.0) 
  1345.       END 
  1346.