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 / OILBR.FOR < prev    next >
Text File  |  1992-04-10  |  5KB  |  173 lines
  1.       SUBROUTINE OILBR(ADIL,IBGO,IDIL,ZRELFI)
  2. C 
  3. C  OIL BURNER MODEL 
  4.       PARAMETER (GC=32.174)
  5. CMDK FTR
  6. CMDK BLKCM2
  7. CMDK BLKGS2
  8. CMDK BLKOIL
  9. CMDK OILB
  10. CMDK OWETHR
  11. CMDK TIMEB
  12.       DATA PI/3.141596/ 
  13.       IF(IBGO.EQ.3)GO TO 2000 
  14.       IF(IBGO.EQ.2)GO TO 1000 
  15.       IOILR=0 
  16.       SLOPTT=0.6
  17.       SLOPW=0.5 
  18.       TC=0. 
  19.       TMO=0.
  20.       RHOA= .075*530./(TAIN+FTR)
  21.       GCTRM=2.*GC*5.2*3600.*3600.
  22.       CONST4=ADIL*SQRT(GCTRM*RHOA/ZRELFI)
  23.       IF(IDIL .EQ. 1) CONST4= 1./CONST4**2
  24.       CONSV4=CONST4
  25.       SIGEC= .171D-8*(1.+EMISC)*.5
  26.       SIGF= .171D-8*.5*AC/(1./EMISC+AC/AM*(1./EMISM-1.))
  27.       CVT= DTIME/(CC*RHOC*AC) 
  28.       AMO= CONST1/AM
  29.       HCO= .26*(350./DC)**.25*SOOT
  30.       HCOAC=HCO*AC
  31.       HM= (.73*.29+.27*.12)*(350./(1.2*DC))**.25*SOOT 
  32.       HAHA= HCO*AC/(HM*AM)
  33.       HAHA1=1./(1.+HAHA)
  34.       HACON(1)= ZA1*ZKA*AM/XM*.5*(XM*WAIRF(1)/(UA*DCELLA(1)))**.8 
  35.       HACON(2)= ZA1*ZKA*AM/XM*.5*(XM*WAIRF(2)/(UA*DCELLA(1)))**.8 
  36.       HACOFF=ZA2*AM/DCELLA(1)*.5
  37.       HIJON(1)=HIJON(1)+HACON(1)
  38.       HIJON(2)= HIJON(2)+HACON(2) 
  39.       HIJOF=HIJOF+HACOFF
  40.       AJHX=AJHX+AM
  41.       HACON(1)= HACON(1)/(.24*WAIRF(1)) 
  42.       HACON(2)=HACON(2)/(.24*WAIRF(2))
  43.       HACOFF= HACOFF/(.24*WAIRN)
  44.       HIP=HI*SOOT 
  45.       ACH= AC*HIP+CPG(1)*WGO(1) 
  46.       ACHIP= AC*HIP/ACH 
  47.       ACSEG=AC*SIGEC*EMISSG/ACH 
  48.       ACSAG=AC*SIGEC*ALPHG/ACH
  49.       CPWGP=CPG(1)*WGO(1)/ACH 
  50.       TMO=860.
  51.       TC=1600.
  52.       THETA=THETA*PI/180. 
  53.       THET1=THET1*PI/180. 
  54.       RETURN
  55.  1000 CONTINUE
  56.       QC=0. 
  57. C     OIL FURNACE CAL COMBUSTION CHAMBER
  58.       GO TO (270),IBURN1
  59. C     BURNER ON 
  60.       TG2= ACHIP*(TC-460.)-ACSEG*(TG1+160.)**4+ACSAG*TC**4+CPWGP*TG1
  61.       QC= CPWG*(TG1-TG2)
  62.       TG1=TG2 
  63. 270   QCO= SIGF*(TC+TMO)**3*(TC-TMO)+HCOAC*(TC-(TC*HAHA+TMO)*HAHA1) 
  64.       TC= (QC-QCO)*CVT+TC 
  65.       TA2= (TA1+HACWO*(2.*TMO-TA1-920.))/(1.+HACWO) 
  66.       QAO= CPWAIR*(TA2-TA1) 
  67.       TMO= (QCO-QAO)*AMO+TMO
  68.       TA1= TA2
  69.       RETURN
  70.  2000 CONTINUE
  71.       IPOIL=0 
  72.       LWD=0 
  73.       IWD=0 
  74. 411   PT= -PODPMB-DPT*WFLUE**2-DPB-WD**2*CONSV4 
  75.       IF (PT .LT. .00001) PT=-PODPMB-DPT*WGT**2-DPB 
  76.       GO TO (416),IOILR 
  77.       IOILR=1 
  78.       FOIL= SIN(THETA+THET1)/(PT*COS(THETA)**2) 
  79.       FOILC= PT*(1.-COS(THETA))**2/(WD**2*CONSV4*3.)
  80. 416   LOIL=1
  81.       NOIL=0
  82. 417   TESTT=SQRT(SIN(THETA+THET1)/(FOIL*PT))
  83.       IF ( TESTT .LT. 1.) GO TO 412 
  84.       TESTT=1.
  85.       THETA=ASIN(FOIL*PT)-THET1 
  86.       NOIL=0
  87. 412   THETAP= ACOS(TESTT) 
  88.       DTHETA= THETAP-THETA
  89.       IF (IPOIL .EQ. 1) WRITE(60,3009) THETA,THETAP,DTHETA,TESTT,PT,
  90.      +    WD,WFLUE
  91.       IF (ABS(DTHETA) .LT. .0008) GO TO 418 
  92.       GO TO (415),NOIL
  93.       DTHET1=DTHETA 
  94.       PERT=DTHETA*SLOPTT
  95.       THETA=THETA+PERT
  96.       NOIL=1
  97.       GO TO 417 
  98. 415   SLOPTT=-PERT/(DTHETA-DTHET1)
  99.       THETA=THETA+SLOPTT*DTHETA 
  100.       NOIL=0
  101.       LOIL=LOIL+1 
  102.       IF (LOIL .LT. 12) GO TO 417 
  103.       IPOIL=1 
  104.       IF (LOIL .LT. 20) GO TO 417 
  105.       WRITE(60,3007)
  106.       STOP 9
  107. 418   THETA=THETAP
  108.       IF(TESTT .EQ. 1.0) TESTT = 1.001
  109.       FOILS= 1.+FOILC/(1.-TESTT)**2 
  110.       CON23P= CON23P*SQRT(FOILS)
  111.       CONST4=CONSV4*FOILS 
  112.       CON21P= 1.+CON23P 
  113.       CON22P= CON21P**2 
  114.       DPTA= DPT*CON22P+CONST4 
  115.       DPTB= WGT*DPT*CON21P/DPTA 
  116.       DPTC= (DPT*WGT**2+DPB+PODPMB)/DPTA
  117.       WDP= -DPTB+SQRT(DPTB**2-DPTC) 
  118.       DWD= WDP-WD 
  119.       IF (IPOIL .EQ. 1) WRITE(60,3010) WD,WDP,DWD,WGT,FOILS,TCYCLE
  120.       IF (( ABS(DWD/WD).LT. .01).OR.(ABS(DWD).LT. .05)) GO TO 424 
  121. C *** USE PARABOLIC NEWTON RAPHSON ON WD
  122. 429   GO TO (421,422),IWD 
  123. C *** PERTURBATION
  124.       IWD=1 
  125.       YWD1=DWD
  126.       XWD1=WD 
  127.       CWD=SLOPW*DWD 
  128.       WD=WD+CWD 
  129. 431   WFLUE=WGT+WD*CON21P 
  130.       GO TO 411 
  131. C *** FIRST CORRECTION (LINEAR) 
  132. 421   SLOPW=-CWD/(DWD-YWD1) 
  133.       WRITE(60,*) 'LINE 7300  SLOPW= ',SLOPW,'  WD= ',WD 
  134.       IWD=2 
  135.       YWD2=DWD
  136.       XWD2=WD 
  137.       WD=WD+SLOPW*DWD 
  138.       WRITE(60,*) 'LINE 7350  WD= ',WD,'  LWD= ',LWD 
  139.       LWD= LWD+1
  140.       IF ( LWD .LT. 12) GO TO 431 
  141.       IPOIL=1 
  142.       IF ( LWD .LT. 20) GO TO 431 
  143.       WRITE(60,3008)
  144.       STOP 9
  145. C *** SECOND CORRECTION (PARABOLIC) 
  146. 422   IWD=0 
  147.       AA= ((DWD-YWD1)/(WD-XWD1)-(YWD2-YWD1)/(XWD2-XWD1))/(WD-XWD2)
  148.       BB=(YWD2-YWD1)/(XWD2-XWD1)-AA*(XWD2+XWD1) 
  149.       CC= YWD1-AA*XWD1**2-BB*XWD1 
  150.       CHECK= BB*BB-4.*AA*CC 
  151.       IF (CHECK) 426,427,428
  152. C *** IMAGINARY ROOTS; DON'T USE PARABOLIC CORRECTION 
  153. 426   GO TO 429 
  154. C *** ROOTS REAL  AND EQUAL 
  155. 427   WD= -BB*.5/AA 
  156.       GO TO 431 
  157. C *** ROOTS REAL AND UNEQUAL
  158. 428   WD1= (-BB+SQRT(CHECK))*.5/AA
  159.       WD2= (-BB-SQRT(CHECK))*.5/AA
  160.       DIFF1= ABS(WD-WD1)
  161.       DIFF2= ABS(WD-WD2)
  162.       WD=WD1
  163.       IF (DIFF2 .LT. DIFF1) WD=WD2
  164.       GO TO 431 
  165.   424 CONTINUE
  166.       RETURN
  167. 3007  FORMAT (/' NO CONV IN OIL DAMPER OPENING ANGLE- STOP ') 
  168. 3008  FORMAT (/' NO CONV IN OIL DAMPER FLOW WD- STOP')
  169. 3009  FORMAT ('  THETA,THETAP,DTHETA,TESTT,PT,WD,WF',3F10.4,F10.5,
  170.      *  F10.5,2F10.3) 
  171. 3010  FORMAT ('  WD,WDP,DWD,WGT,FOILS,TCYCLE',6F10.3/)
  172.       END 
  173.