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 / ROOFC.FOR < prev    next >
Text File  |  1992-04-16  |  6KB  |  183 lines
  1.       SUBROUTINE ROOFC(HO, TODBR4, ISKY, FAROOF, NSUBR, EATTC1, 
  2.      +                 EATTC2, DTIM1, TR0, QLSRF, QSKYS, QCONRF,IDBG) 
  3. C 
  4. C  COMPUTE ROOF TEMPERATURES FOR EACH ATTIC 
  5. C 
  6. C - - - PARAMETER CONSTANTS 
  7. C 
  8. CMDK FTR
  9. CMDK NZN
  10. CMDK NIWL
  11. CMDK NKONST
  12. CMDK NWL
  13. CMDK NWN
  14. CMDK NZW
  15. CMDK SIGMA
  16. C 
  17. C - - - COMMON BLOCKS 
  18. C 
  19. CMDK BLKQS
  20. CMDK ENCBK1
  21. CMDK IRDFQ
  22. CMDK IZZQ
  23. CMDK OWETHR
  24. CMDK SOLARB
  25. CMDK SURFAR
  26. CMDK TCNBLK
  27. CMDK TEMPB
  28.       REAL QLOSRF(2),QSKY(2), SMA(2), SMT(2)
  29.       DATA PATM/1./
  30. C 
  31. C  TCON VALUES WERE CALC WITH DTIM1 AND DTIM1/NSUBR IS NEEDED BELOW, SO 
  32. C               TCON VALUES MUST BE MULTIPLIED BY DTR 
  33.       DTR=1./NSUBR
  34.       FASGE1=(1.-EATTC1)/EATTC1 
  35.       FASGE2=(1.-EATTC2)/EATTC2 
  36. C 
  37. C  FIND ALL CEILINGS CONNECTED TO EACH ATTIC AND WEIGHT UPPER SURFACE 
  38. C  TEMPERATURES BY CEILING AREA 
  39.       SMT(1)=0. 
  40.       SMT(2)=0. 
  41.       SMA(1)=0. 
  42.       SMA(2)=0. 
  43.       DO 502 J=1,NROOMS 
  44.       NRM=NRMA(J) 
  45.       N2=NWALLA(NRM)
  46.       DO 502 K2=1,N2
  47.       IZW=NENC(NRM,K2)
  48.       ID=IDEXP(IZW) 
  49.       IF(ID.EQ.5)THEN 
  50.           IF(NZNC(IZW).EQ.4)THEN
  51.               SMT(1)=SMT(1)+TMP(1,IZW)*AWALLA(IZW)
  52.               SMA(1)=SMA(1)+AWALLA(IZW) 
  53.               ENDIF 
  54.           IF(NZNC(IZW).EQ.5)THEN
  55.               SMT(2)=SMT(2)+TMP(1,IZW)*AWALLA(IZW)
  56.               SMA(2)=SMA(2)+AWALLA(IZW) 
  57.               ENDIF 
  58.           ENDIF 
  59.   502 CONTINUE
  60. C 
  61. C  STORE WEIGHTED UPPER SURFACE TEMPS IN SMT ARRAY
  62.       IF(SMA(1).NE.0.)SMT(1)=SMT(1)/SMA(1)
  63.       IF(SMA(2).NE.0.)SMT(2)=SMT(2)/SMA(2)
  64. C 
  65. C  BEGIN ROOF CALCULATIONS
  66. C 
  67.       RRAD=FASGE1+1.+FASGE2 
  68.       CON1=SIGMA/RRAD 
  69.       QRADRF=0. 
  70.       QLSRF=0.
  71.       QSKYS=0.
  72.       ACEIL(2)=0. 
  73.       QRFSUM(2)=0.
  74. C 
  75.       DO 510 IA=1,NATC
  76.       QRFSUM(IA)=0.
  77. C  ACEIL(IA) IS CEILING AREA IN CONTACT WITH ATTICS IA
  78.       ACEIL(IA)=SMA(IA) 
  79.       SMT4=(SMT(IA)+FTR)**4 
  80.       IQZ=IZT+IA
  81.       T1=TMP(1,IQZ) 
  82.       T14=(T1+FTR)**4 
  83.       QLOSRF(IA)=FAROOF*ROFOM(IA)*SIGMA*(T14-TODBR4)*RAREA(IA)
  84. C 
  85. C     SKY RADIATION CORRELATION 
  86.       PW=(PATM*WODHUM/(.62198+WODHUM))*29.92
  87.       TDP=((ALOG(PW)*1.8893)+30.5790)*ALOG(PW)+79.047
  88.       TDPC=(TDP-32.)*0.5555 
  89. C     CHECK NIGHT OR DAY
  90.       IF (SOLARL(1).EQ.0.) THEN 
  91.          ESKY=0.741+0.0062*TDPC 
  92.       ELSE
  93.          ESKY=0.727+0.006*TDPC
  94.          END IF 
  95.       QSKY(IA)=ISKY*SIGMA*(1.-FAROOF)*(ROFOM(IA)*T14-ESKY*TODBR4) 
  96.      +         *RAREA(IA) 
  97.       RRAREA=1./RAREA(IA) 
  98.       RARAT=SMA(IA)*RRAREA
  99. C    -----CALCULATE TEMPERATURES OF EACH ROOF LUMP
  100.       TR0=(SOLARL(IA)-(QLOSRF(IA)+QSKY(IA)*ISKY)*RRAREA)/HO+TODDB 
  101.       QCONRF=QCONRF+(TMP(1,IQZ)-TODDB)*HO*RAREA(IA)
  102.       K=KONRF(IA) 
  103.       TR1=TMP(1,IQZ)
  104.       TR2=TMP(2,IQZ)
  105.       TR3=TMP(3,IQZ)
  106.       TR4=TMP(4,IQZ)
  107.       IF(IDBG.NE.0)THEN 
  108.           TR1S=TR1
  109.           TR2S=TR2
  110.           TR3S=TR3
  111.           TR4S=TR4
  112.           ENDIF 
  113.       TC1=TCON(1,K) 
  114.       TC2=TCON(2,K) 
  115.       TC3=TCON(3,K) 
  116.       TC4=TCON(4,K) 
  117.       TC5=TCON(5,K) 
  118.       TC6=TCON(6,K) 
  119.       TC7=TCON(7,K) 
  120.       TC8=TCON(8,K) 
  121.       DO 504 I=1, NSUBR 
  122.          TR1N=(TC1*(TR2-TR1)+HO*TC2*(TR0-TR1))*DTR+TR1
  123.          TR2N=(TC3*(TR1-TR2)+TC4*(TR3-TR2))*DTR+TR2 
  124.          TR3N=(TC5*(TR2-TR3)+TC6*(TR4-TR3))*DTR+TR3 
  125.          QRFATC=CON1*(SMT4-(TR4+FTR)**4)
  126.          QRFSUM(IA)=QRFSUM(IA)+QRFATC
  127.          TR4N=(TC7*(TR3-TR4)+TC8*(QROOF(IA)/RAREA(IA) 
  128.      1             +QRFATC*RARAT))*DTR+TR4
  129.          TR1=TR1N 
  130.          TR2=TR2N 
  131.          TR3=TR3N 
  132.          TR4=TR4N 
  133. 504      CONTINUE 
  134.       TMPN(1,IQZ)=TR1 
  135.       TMPN(2,IQZ)=TR2 
  136.       TMPN(3,IQZ)=TR3 
  137.       TMPN(4,IQZ)=TR4 
  138.       QRFSUM(IA)=QRFSUM(IA)/NSUBR 
  139.       QRADRF=QRADRF+QRFSUM(IA)*SMA(IA)
  140.       QLSRF=QLSRF+QLOSRF(IA)
  141.       QSKYS=QSKYS+QSKY(IA)
  142.       IF(IDBG.NE.0)THEN 
  143.           WRITE(60,600)IA,HO, TODBR4, TODDB, ISKY, FAROOF, 
  144.      +                NSUBR, EATTC1, EATTC2, DTIM1, TR0, QRFSUM,
  145.      +                QRADRF, QLOSRF(IA), QSKY(IA), QROOF(IA) 
  146.           WRITE(60,601)DTR,   FASGE1,FASGE2,SMT(IA),SMA(IA), 
  147.      +    IQZ,TR4,         T1,T14,TDP,TDPC,SOLARL(IA),ESKY, 
  148.      +    ISKY,SIGMA,FAROOF,ROFOM(IA),RAREA(IA),
  149.      +    TR0,SOLARL(IA),K,TATTA(IA), 
  150.      +    TR1S,TR1,TR2S,TR2,TR3S,TR3,TR4S,TR4,
  151.      +    RRAD,QRFATC,    DTIM1,ACEIL(IA),
  152.      +    TC1,TC2,TC3,TC4,TC5,TC6,TC7,TC8 
  153.           ENDIF 
  154.   510 CONTINUE
  155.       RETURN
  156.   600 FORMAT(10X,'ROOFC:IA,HO,TODBR4,TODDB= ',I3,3G13.5/
  157.      +10X,'            ISKY,FAROOF,NSUBR= ',       I5,G13.5,I5/ 
  158.      +10X,'EATTC1,EATTC2,DTIM1    = ',3G13.5/ 
  159.      +10X,'TR0,QRFSUM(1),QRFSUM(2),QRADRF,QLOSRF= ',5G13.5/ 
  160.      +10X,'QSKY,QROOF(IA)= ',2G13.5)
  161.   601 FORMAT(10X,'DTR,   FASGE1,FASGE2,SMT(1),SMA(1)= ',5G13.5/ 
  162.      +10X,'IQZ,T4,        T1,T14= ',I5,3G13.5/
  163.      +10X,'TDP,TDPC,SOLARL(1),ESKY= ',4G13.5/ 
  164.      +10X,'ISKY,SIGMA,FAROOF,ROFOM(1),RAREA(1)= ',I5,4G13.5/
  165.      +10X,'TR0,SOLARL(1),K,TATTA(1)= ',2G13.5,I5,G13.5/ 
  166.      +10X,'TR1,TR1N= ',2G13.5/
  167.      +10X,'TR2,TR2N= ',2G13.5/
  168.      +10X,'TR3,TR3N= ',2G13.5/
  169.      +10X,'TR4,TR4N= ',2G13.5/
  170.      +10X,'RRAD,QRFATC,    DTIM1,ACEIL(1)= ',4G13.5/
  171.      +10X,'TC1= ',G13.5,'  TC2= ',G13.5/
  172.      +10X,'TC3= ',G13.5,'  TC4= ',G13.5/
  173.      +10X,'TC5= ',G13.5,'  TC6= ',G13.5/
  174.      +10X,'TC7= ',G13.5,'  TC8= ',G13.5)
  175.   602 FORMAT(1X,'ROOFC:TC1,TC2,TC3,TC4= ',4G13.5/ 
  176.      +1X,'TC5,TC6,TC7,TC8= ',4G13.5/
  177.      +1X,'HO,DTR,RRAD,    SIGMA= ',4G13.5/
  178.      +1X,'SMT(IA),FTR,SMT4,CON1= ',4G13.5/
  179.      +1X,'DT,HIR,DTRC8,SMA(IA),RRAREA,RARAT= ',6G13.5)
  180.   603 FORMAT(1X,'TR0,TR1,TR2,TR3,TR4,TATTA(IA)= ',6G13.5) 
  181.   604 FORMAT(1X,'TR1N,TR2N,TR3N,TR4N,QRFATC,QRFSUM(IA)= ',6G13.5) 
  182.       END 
  183.