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 / STRLP1.FOR < prev    next >
Text File  |  1992-05-08  |  10KB  |  321 lines
  1.       SUBROUTINE STRLP1(ACINFL, ACMAX, ACMIN, AVENC2, DQINT, DSOLRH,
  2.      +DTCR, DTCRW, DTIM1, DTOB, DWHM, DWINT, DWSPED, FLOWIN,
  3.      +IDAYM, IDUM, NZONG, POWA, QCONRF, QINFC, QINFS, QINT,
  4.      +QLOSRF,QRAD,QSKY, RHA, RLOADL, RLOADS, SOLRH, TDUM, TODDBR, TRO,
  5.      +TS, VBMAX,VBMIN, VENCRV, WINFC, WINFSS, WINT, WODFAC, WODHMR,
  6.      +IDBG) 
  7. C 
  8. C-----START OF OUTER TIME LOOP
  9. C 
  10. C 
  11. C-----CONSTANTS 
  12. CMDK FTR
  13. CMDK NZN
  14. CMDK NIWL
  15. CMDK NKONST
  16. CMDK NWN
  17. CMDK NWL
  18. CMDK NZW
  19. CMDK CPAIR
  20. CMDK RHOAIR
  21. CMDK SIGMA
  22. C 
  23. C-----COMMON BLOCKS 
  24. CMDK ACHBQ
  25. CMDK ACHLQ
  26. CMDK BAR
  27. CMDK BLKFMT
  28. CMDK BLKQS
  29. CMDK CNSTRK
  30. CMDK DUCTS2
  31. CMDK ENCBK1
  32. CMDK ENCBK2
  33. CMDK ENCBLK
  34. CMDK IWETHR
  35. CMDK IRDFQ
  36. CMDK IZWQ
  37. CMDK IZZQ
  38. CMDK MRTBLK
  39. CMDK MZON1
  40. CMDK OWETHR
  41. CMDK QUAYLE
  42. CMDK SOLARB
  43. CMDK STRUCA
  44. CMDK SURFAR
  45. CMDK TEMPB
  46. CMDK TIMEB
  47. CMDK BLKTM2
  48. CMDK TSTATC
  49. CMDK TSTB2
  50.       REAL ACINFL(NZN), ACMAX(NZN), ACMIN(NZN), DQINT(24), DSOLRH(24),
  51.      +     DTOB(24), DWHM(24), DWINT(24), DWSPED(24), FLOWIN(NZN),
  52.      +         QINFS(NZN), QINFC(NZN), WINFC(NZN), WINFSS(NZN) 
  53. C 
  54. C-----INITIALIZATIONS 
  55.       DATA IWATC  /1/ ,IZDAT/1/
  56.       DTIME=DTIM1
  57.       IF(IZDAT.EQ.1)THEN
  58.         WRITE(60,545)
  59.         DO 550 IJ=1,NROOMS
  60.           NRM=NRMA(IJ)
  61.           N2=NWALLA(NRM)
  62.           DO 550 K2=1,N2
  63.             IZW=NENC(NRM,K2)
  64.             NZONC=NZNC(IZW)
  65.             ID=IDEXP(IZW)
  66.             KON=KONSTA(IZW)
  67.             NLM=NLMP(KON)
  68.             WRITE(60,546)NRM,IZW,ID,NZONC,KON,NLM
  69.   550   CONTINUE
  70.         WRITE(60,547)
  71.         IZDAT=0
  72.       ENDIF
  73. C  ZERO ENERGY LOSS SUMS ON OUTSIDE SURFACES      
  74.       DO 12 JT=1,NZN
  75.       QLOSWL(JT)=0. 
  76.       QLOSFL(JT)=0.
  77.    12 CONTINUE
  78. C     WETHR BLOCK 5: INCREMENT WEATHER TO CURRENT TIME STEP 
  79.       IF (NSEQW.EQ.0 .OR. NSEQW.EQ.1 .OR. NSEQW.EQ.3) THEN
  80.          TODDB=TODDB+DTOB (IT)
  81.          WODHUM=WODHUM+DWHM (IT)
  82.          WSPED=WSPED+DWSPED (IT)
  83.          SOLRH=SOLRH+DSOLRH (IT)
  84.          IF(IGARAGT.EQ.0)TGARAG=TODDB 
  85. C 
  86.       ELSE IF (NSEQW.EQ.2) THEN 
  87. C NOTE: TGARAG GETS SET IN WETHR WITH NSEQW=2!      
  88.          CALL WETHR (5, NSEQW)
  89.          TODDB=TODDB+TOFFSET
  90.       END IF
  91.       DO 10 I=1,NIJ 
  92.    10 SOLARL(I)=SOLARL(I)+DSOLAR(IT,I)
  93.       IF (IGARAGT.GT.0) CALL GARAGA (IGARAGT,NZONG,SOLRH) 
  94. C 
  95.       HO=1.0
  96. C         WSPED UNITS:  MILES/HR  (CORRELATION FOR HO IS FROM CARRIER)
  97. C                        SEE P. VII-13 OF PH IV REPT FOR COMPARISONS.      
  98.       IF (WSPED.GT..4) HO=WSPED**.5/.6584 
  99.       TODBR4=(TODDB+FTR)**4 
  100. C 
  101. C 
  102. C  GET TEMPERATURES OF EACH --ROOF--LAYER 
  103.       CALL ROOFC(HO,TODBR4, ISKY, FAROOF, NSUBR, EATTC1,EATTC2, 
  104.      +           DTIM1,TRO, QLOSRF, QSKY, QCONRF,IDBG) 
  105. C  IZWC  CEILING
  106. C     F  FLOOR OVER BSMT W/O DUCTS BELOW
  107. C     G  FLOOR OVER BSMT W/ DUCTS BELOW 
  108. C     H  FLOOR OVER CRWSPC W/O DUCTS BELOW
  109. C     I  FLOOR OVER CRWSPC W/ DUCTS BELOW 
  110. C     J  GARAGE WALL
  111. C  SET INDICES FOR ENCLOSURES TO THAT FOR ZERO AREA 
  112.       IZWC=IZT+1
  113.       IZWF=IZT+1
  114.       IZWG=IZT+1
  115.       IZWH=IZT+1
  116.       IZWI=IZT+1
  117.       IZWJ=IZT+1
  118. C 
  119. C  NOTE: - - HRADC, HRADF, HRADFD, HRADW ARE SET IN STRDAY
  120. C 
  121. C 
  122.       DO 502 J=1,NROOMS 
  123.       TWIA=0. 
  124.       AWIA=0. 
  125.       NRM=NRMA(J) 
  126.       N2=NWALLA(NRM)
  127.       DO 500 K2=1,N2
  128.       IZW=NENC(NRM,K2)
  129.       KON=KONSTA(IZW) 
  130.       ID=IDEXP(IZW) 
  131.       NZONC=NZNC(IZW) 
  132.       IF(ID.LE.4)THEN 
  133. C  GET TEMPERATURES OF EACH --OUTSIDE WALL--LAYER 
  134.           WALLF=WALLFO(IZW) 
  135.           IF(ID.EQ.1)IZWS(1)=IZW
  136.           IF(ID.EQ.2)IZWS(2)=IZW
  137.           IF(ID.EQ.3)IZWS(3)=IZW
  138.           IF(ID.EQ.4)IZWS(4)=IZW
  139.           CALL OWALLS(NRM, IZW, ID, KON, WALLF, FAWLOD,
  140.      +                HO, TODBR4,  IDBG)
  141.           ENDIF 
  142.       IF(ID.EQ.5)THEN 
  143. C 
  144. C  GET TEMPERATURES OF EACH --CEILING--LAYER
  145. C    IZWC FOR CEILING ELEMENT BELOW ATTIC NO.1 IN ZONE 1
  146.           IF(NZONC.EQ.4.AND.NRM.EQ.1)IZWC=IZW 
  147.           CALL CEIL(NRM, IZW, KON, NZONC, IDBG)
  148.           ENDIF 
  149.       IF(ID.EQ.6)THEN 
  150.           IF(NZONC.EQ.2.OR.NZONC.EQ.7)THEN
  151. C 
  152. C---CALCULATE TEMPS OF EACH LUMP OF --FLOOR ABOVE BASEMENT----
  153. C     WITH OR WITHOUT DUCTS BELOW 
  154.               IF(NZONC.EQ.2)THEN
  155.                   IF(NRM.EQ.1)IZWF=IZW
  156.                   ENDIF 
  157.               IF(NZONC.EQ.7)THEN
  158.                   IF(NRM.EQ.1)IZWG=IZW
  159.                   ENDIF 
  160.               CALL FLOOR(NRM, IZW, ID, KON, NZONC, TBASA, 
  161.      +                   DCTFLR, IDBG)
  162.               ENDIF 
  163.           IF(NZONC.EQ.3.OR.NZONC.EQ.8)THEN
  164. C 
  165. C-----CALCULATE TEMPS OF EACH LUMP OF --FLOOR ABOVE CRAWL SPACE---
  166. C      WITH OR WITHOUT DUCTS BELOW
  167.               IF(NZONC.EQ.3)THEN
  168.                   IF(NRM.EQ.1)IZWH=IZW
  169.                   ENDIF 
  170. C  ??? CHECK WHY THERE WAS NRM.EQ.1 BELOW   SOMETIME  !!!!! 
  171.               IF(NZONC.EQ.8)IZWI=IZW
  172. C 
  173.               CALL FLOOR(NRM, IZW, ID, KON, NZONC, TCRWA, 
  174.      +                   DCTFLR, IDBG)
  175.               ENDIF 
  176.           ENDIF 
  177.       IF(ID.EQ.7.AND.NZONC.EQ.6)THEN
  178. C-----CALCULATE TEMPS OF EACH LUMP OF --GARAGE--WALL
  179. C          CANT HAVE THERMOSTAT ON LVG SPC/GARAGE WALL, 0.,0. BELW 
  180.           CALL IWALLS(NRM, IZW, KON, NZONC, 0.,0.,IDBG)
  181.           ENDIF 
  182.       IF(ID.EQ.7.AND.NZONC.GT.8)THEN
  183. C 
  184. C   ---INTERIOR PARTITION---WALL
  185.               CALL IWALLS(NRM, IZW, KON, NZONC, TWIA, AWIA,IDBG) 
  186.           ENDIF 
  187.       IF(ID.EQ.8)THEN 
  188. C             BASEMENT FLOOR
  189. C         TODAG1 IS NOT USED IN FLOOR FOR BSMT FLOOR! (OK - RDF)
  190.           CALL FLOOR(NRM,IZW,ID,KON,0,TODAG1,1.,IDBG) 
  191.           ENDIF 
  192.       IF(ID.EQ.9.OR.ID.EQ.10)THEN 
  193.           IF(ID.EQ.10)WALLF=WALLFO(IZW) 
  194.           CALL OWALLS(NRM,IZW,ID,KON,WALLF,FAWLOD,HO, 
  195.      +                TODBR4, IDBG) 
  196.           ENDIF 
  197.   500 CONTINUE
  198.       IF(AWIA.EQ.0.)THEN
  199.           WRITE(60,600)
  200.           STOP 'STRLP1:AT 500, NO PARTITION WALL FOR TSTAT TEMP!!!' 
  201.           ENDIF 
  202. C * * * * * * * * 
  203. C         TWSTAT IS AREA-WEIGHTED WALL TEMP AT TSTAT
  204.       TWSTAT(NRM)=TWIA/AWIA 
  205.   502 CONTINUE
  206. C 
  207. C* * * * * *
  208. C-----INTERNAL HEAT AND MOISTURE GAINS
  209.       QINT=QINT+DQINT (IT)
  210.       IF (IWAT.EQ.1) THEN 
  211.          WINT=WINT+DWINT (IT) 
  212.       ELSE
  213.          IF (TINDEX.LT.WT (IWATC)) THEN 
  214.             WINT=WINTL (IWATC)
  215.          ELSE 
  216.             IWATC=IWATC+1 
  217.          END IF 
  218.       END IF
  219. C 
  220. C-----MEAN RADIENT TEMPERATURE CALCULATION
  221.       CALL MRTHRI(QINT,QRAD,IDBG)
  222. C 
  223. C-----CALCULATE BASEMENT AIR CHANGE RATE IF SPECIFIED 
  224. C     OTHERWISE, USE CONSTANT INPUT AS VENBAS 
  225.       IF (NRNAVB.GT.0) THEN 
  226.          IF (MODE.EQ.2) THEN
  227.             VENBAS=ACHB2 (TODDB, TBASA, WSPED, TS)
  228.          ELSE 
  229.             VENBAS=ACHB (TODDB, TBASA, WSPED, TS) 
  230.          END IF
  231.       ELSE IF(NRNAVB.LT.0)THEN 
  232. C   NRNAVB LT 0 TO SIGNAL USE OF COEF FOR DAILY ACH 
  233.          IF(IDAYM.EQ.1)VENBAS=ACMB 
  234.          IF(IDAYM.EQ.2)VENBAS=ACWSB
  235.          IF(IDAYM.EQ.3)VENBAS=ACBB 
  236.          IF(IDAYM.EQ.4)VENBAS=ACSB 
  237.          IF(IDAYM.EQ.5)VENBAS=ACCNB
  238.          IF(IDAYM.GT.5)VENBAS=(ACMB+ACWSB+ACBB+ACSB+ACCNB)/5.
  239.       ENDIF
  240.       IF (VENBAS.GT.VBMAX) VBMAX=VENBAS 
  241.       IF (VENBAS.LT.VBMIN) VBMIN=VENBAS 
  242. C  MISCELLANEOUS FACTORS FOR INFILTRATION 
  243. C   1.329=144.*.4923/53.34
  244.       WODFAC=1.329*29.921*(1.+WODHUM)/(1.+1.608*WODHUM)*BARRAT
  245.       RAIROD=WODFAC/(TODDB+460.)
  246.       TODDBR=TODDB*RAIROD 
  247.       AVENC2=VENCRV*RAIROD
  248.       WODHMR=WODHUM*RAIROD
  249.       DTCRW=DTCR/RAIROD 
  250. C-----CALCULATE INFILTRATION (AIR CHANGES) RATE IN LIVING SPACE 
  251. C        IF STORY < 0 THEN INFILTRATION RATES IN AIR-CHANGES PER
  252. C           HOUR ARE READ FROM TAPE22 IN SUB.ACHL ENTRY.ACHLTIM 
  253. C        IF STORY = 0 THEN THE FIVE INFILTRATION CONSTANTS ARE
  254. C           DAILY INFILTRATION RATE AVERAGES (4/6/84 FEJ QUICK FIX) 
  255.       DO 532 JT=1,NROOMS
  256.       NRM=NRMA(JT)
  257.       IF(NRM.EQ.NZNBAS)THEN 
  258.           ACINFL(NRM)=VENBAS
  259.           GO TO 530 
  260.           ENDIF 
  261.       IF (STORY.GT.0.0) THEN
  262.          IF (MODE.EQ.2) THEN
  263.             CALL ACHL2(NRM,TODDB,TA,WSPED,TS,ACINFL)
  264.          ELSE 
  265.             CALL ACHL(NRM,TODDB,TA,WSPED,TS,ACINFL) 
  266.          END IF 
  267.       ELSE IF (STORY.LT.0.0) THEN 
  268.          CALL ACHLTIM(NRM,TODDB,TA,WSPED,TS,ACINFL)
  269. C  STORY = 0. HERE!         
  270.       ELSE IF (IDAYM.EQ.1) THEN 
  271.          ACINFL(NRM)=ACML(NRM)
  272.       ELSE IF (IDAYM.EQ.2) THEN 
  273.          ACINFL(NRM)=ACWSL(NRM) 
  274.       ELSE IF (IDAYM.EQ.3) THEN 
  275.          ACINFL(NRM)=ACBL(NRM)
  276.       ELSE IF (IDAYM.EQ.4) THEN 
  277.          ACINFL(NRM)=ACSL(NRM)
  278.       ELSE IF (IDAYM.EQ.5) THEN 
  279.          ACINFL(NRM)=ACCNL(NRM) 
  280.       ELSE
  281.          ACINFL(NRM)=(ACML(NRM)+ACWSL(NRM)+ACBL(NRM)+ 
  282.      +               ACSL(NRM)+ACCNL(NRM))/5. 
  283.       END IF
  284.   530 IF (ACINFL(NRM).GT.ACMAX(NRM)) ACMAX(NRM)=ACINFL(NRM) 
  285.       IF (ACINFL(NRM).LT.ACMIN(NRM)) ACMIN(NRM)=ACINFL(NRM) 
  286.   531 FLOWIN(NRM)=ACINFL(NRM)*ROMVOL(NRM) 
  287.       WINFC(NRM)=FLOWIN(NRM)*WODHUM*RAIROD
  288.       WINFSS(NRM)=RHOAIR*FLOWIN(NRM)*BARRAT 
  289.       QINFC(NRM)=FLOWIN(NRM)*CPAIR*TODDBR 
  290.       QINFS(NRM)=FLOWIN(NRM)*BARRAT*CPAIR*RHOAIR
  291.   532 CONTINUE
  292.       DO 540 I=1,NZN
  293.       QDCTBA(I)=0.
  294.   540 TA(I)=0.
  295.       TATTA(1)=0.0
  296.       TATTA(2)=0.0
  297.       TBASA=0.0 
  298.       TCRWA=0.0 
  299.       TS=0.0
  300.       RHA=0.0 
  301.       DO 542 I=1,NZW
  302.       QCSURF(I)=0.
  303.   542 CONTINUE
  304.       DO 544 I=1,2
  305.       QCEIL(I)=0. 
  306.       QROOF(I)=0. 
  307.   544 CONTINUE
  308.       IF (IMODE.EQ.1) CALL ACND1 (IDUM, TDUM, TDUM) 
  309. C     INITIALIZE COOLING SYSTEM OUTPUT QUANTITES
  310.       RLOADS=0. 
  311.       RLOADL=0. 
  312.       POWA=0. 
  313.       RETURN
  314.   545 FORMAT(/////'   ****   LIST OF FINAL ENCLOSURE ELEMENTS   ****',
  315.      +  /'    ZONE   IZW    ID  NZONC  KON   NLM')        
  316.   546 FORMAT(1X,6(I6))
  317.   547 FORMAT(/////1X)        
  318.   600 FORMAT(/1X,'STRLP1:NO PARTITIONS FOR TSTAT TEMP.  MUST HAVE', 
  319.      +' PARTITIONS, SO CHECK INPUT.') 
  320.       END 
  321.