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
/
PLENUM.FOR
< prev
next >
Wrap
Text File
|
1992-05-11
|
4KB
|
113 lines
SUBROUTINE PLENUM
C PLENUM MODEL FOR OUTLET FROM FURNACE OR AIR HANDLER TO ENTRY TO DUCTS
C EXTRACTED FROM SUBPROGRAM GASF SO THAT GASF ISNT CALLED
C IN COOLING MODE
CMDK BLK83
CMDK BLK85
CMDK BLK87
CMDK BLK89
CMDK BLKCM2
CMDK BLKGS1
CMDK BLKGS2
CMDK BLKQGS
CMDK BLKSK
CMDK COLCT
CMDK COLLEC
CMDK DTRQ
CMDK FANBLK
CMDK INDIC1
CMDK PRT1
CMDK TIMEB
DIMENSION BCON(6),HIPLE(2),TFILM(3)
NAMELIST /INPGSF/ BCON, CPMACL, DTRJC, DTRPL, EFFHXV,
+ EMISJC, EMISPL, FANTOF, FANTON, HAACL,
+ HIPL2, HOJ, IDV, IELC, IVFA,
+ LINWFL, NACL, NFLT, NHXITR, NINTGF,
+ NTBB, NTHX, NTJJ, PCLOSE, PCTJAC,
+ POPEN, RCLOSE, RNSLS1, ROPEN, TCMOF1,
+ TCMOF2, TCYCOF, TCYCON, TDESH, TDESL,
+ TFILM, TFLT, TFLUE, THLOFF,THLON,
+ TIME1,TIME3,TIMOVD, TJSV, TMACSV,
+ TMFLT, TMPLSV, TMSV, TMV, TSHLIM,
+ TVENTI, TWFMAX, UAHXOF, UAHXON, UAHXV,
+ VOUTSD, WFL1, WFLMIN, WGTHX, ZAJ,
+ ZKBND2, ZRELFI, ZRELFO
C
C DTRPL IS TEMP ELEVATION OF PLEN SURF ABOVE TAIN
C EMISPL IS EMISSIVITY OF PLEN SURFACE
C THE ENTIRE NAMELIST INPGSF FROM GASF IS INCLUDED TO ENABLE
C READ OF THIS NAMELIST FOR COOLING
DATA DTMTOL/.01/
DATA DTMPL/0./
DATA NTBB/100/
C IRGSF SHOULD BE 1 FOR COOLING(SET IN LOOP)
IF(IRGSF.EQ.1)THEN
C
OPEN(12,FILE='TAPE12',STATUS='OLD',IOSTAT=IO12)
IF(IO12.NE.0)THEN
WRITE(60,*)' GASF: CANT OPEN TAPE12 WITH NAMELIST INPGSF'
STOP ' GASF: CANT OPEN TAPE12 WITH NAMELIST INPGSF '
END IF
READ(12,INPGSF,END=999)
CLOSE(12)
WRITE(60,INPGSF)
ENDIF
C1=U45*BARPSI/(NCELLS*14.7)
WAIRF(1)=CFM(1)*C1
WAIRF(2)=CFM(2)*C1
C - - - - - - - SINGLE-SPEED BLOWER SET BELOW
IBL=1
INC=1
CONS12= DTIME/(RHOMPL*CPMPL*APLEN)*NCELLS
HOPL= HOPL1+EMISPL*.171E-8*4.*(TAIN+DTRPL*.5+459.7)**3
HIPL1A=HIPL1*APLEN/(.24*WAIRF(1)*NCELLS)
IF(HIPL1A.GT.173.)HIPL1A=173.
HIPLE(1)=1./EXP(HIPL1A)
HIPL2A=HIPL2*APLEN/(.24*WAIRF(2)*NCELLS)
HIPLE(2)=HIPL2A*.5
HOPLE= HOPL*APLEN/NCELLS
RETURN
C * * * * * PLENUM EQNS
C Q=H*A*LOG MEAN TEMP DIF (BLWR ON)
C Q=H*A*AVG DELTA T (BLWR OFF)
C
ENTRY PLENM1
WAIRF(1)=CFM(1)*C1
WAIRF(2)=CFM(2)*C1
IEFAN1=1-IEFAN
NTB=0
HIPL=HIPLE(1)*IEFAN+HIPLE(2)*IEFAN1
317 TMPL=TMPLSV+0.5*DTMPL
IF(IEFAN.EQ.1)TPL=TMPL+HIPL*(TA2-TMPL)
IF(IEFAN1.EQ.1)THEN
TPL=(TA2+HIPL*(2.*TMPL-TA2))/(1.+HIPL)
IF(TA2.GT.TMPL.AND.TPL.LT.TMPL)TPL=TA2-HIPL*(TA2-TMPL)
IF(TA2.LT.TMPL.AND.TPL.GT.TMPL)TPL=TA2-HIPL*(TA2-TMPL)
END IF
QIPL=CPWAIR*(TA2-TPL)
QPLEN=HOPLE*(TMPL-TAIN)
QMPL=QIPL-QPLEN
DTMPLQ=QMPL*CONS12
NTB=NTB+1
IF(NTBB.LT.50)THEN
WRITE(60,516)TIME*60.,TMPL,DTMPLQ,DTMPL,TPL
NTBB=NTBB+1
ENDIF
516 FORMAT(1X,' TIME,TMPL,DTMPLQ,DTMPL,TPL= ',F8.3,4(2X,F6.1))
IF(ABS(DTMPLQ-DTMPL).LE.DTMTOL)GO TO 318
IF(NTB.GT.15)GO TO 318
DTMPL=DTMPLQ
GO TO 317
318 TMPLSV=TMPLSV+DTMPL
C - - - - DTRA IS AIR TEMP RISE INCL BLOWER RISE
DTRA=TPL-TRETP+DTBLR*IEFAN
C COLLECT THE PLENUM TEMPERATURE
IF(ICOLL.NE.0) CDATA(12)=TPL
IF(INC.GT.IDEBUG)RETURN
WRITE(60,500) DTRA,TA2,TPL,TMPL,QIPL,QPLEN,QMPL
INC = INC +1
RETURN
999 STOP ' PLENUM: EOF ON TAPE12 WITH NAMELIST INPGSF'
500 FORMAT(1X,'PLENUM:DTRA,TA2,TPL,TMPL,QIPL,QPLEN,QMPL= ',7G13.5)
END