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 / STRMON.FOR < prev    next >
Text File  |  1992-05-08  |  4KB  |  120 lines
  1.       SUBROUTINE STRMON (C, HDUM, IFWL, IPASS, IPASY, IWR, IWRB,
  2.      1   NDAYTOT, ODDBM, ODHUM, RDUM, TDUM, TEMPDV, WSC, WTFCT,IDBG)
  3. C
  4. C-----PERFORMS CALCULATIONS FOR THE START OF THE MONTH
  5. C-----CONSTANTS
  6. CMDK NOUTAV
  7. CMDK NOUTDY
  8. CMDK NZN
  9. C
  10. C-----COMMON BLOCKS
  11. CMDK INDIC1
  12. CMDK HUMIDC
  13. CMDK QUAYCH
  14. CMDK QUAYLE
  15. CMDK TEMP1
  16. CMDK TIMEB
  17. CMDK TSTATC
  18. C
  19.       INTEGER IPASS (NOUTDY), IPASY (NOUTDY), NDAYTOT(12)
  20.       INTEGER IOUTAV (NOUTAV)
  21.       REAL    C (5) ,ODDBM (25), ODHUM (25)
  22. C
  23. C-----INITIALIZATIONS
  24.       DATA IOUTAV /1, 2, 3, 4, 5, 16, 18, 21, 23, 24, 39/
  25. C
  26. C-----READ NOMINAL WEATHER DATA
  27. C
  28. C          WETHR BLOCK 2A
  29.       IF (NSEQW.EQ.1 .AND. IFWL.EQ.0) THEN
  30.          DO 182 IHR=1, 24
  31. C  AVGES (1, IHR) - DRY-BULB TEMP,F
  32. C  AVGES (2, IHR) - WET-BULB TEMP,F
  33. C  AVGES (4, IHR) - WIND SPEED, MILES/HR      
  34.             READ(40, *, END=183) AVGES (1, IHR), AVGES (2, IHR),
  35.      1         AVGES (4, IHR), RDUM
  36. 182         CONTINUE
  37.          GO TO 186
  38. 183      WRITE(60, 7020) IHR
  39.          STOP
  40. C
  41.       ELSE IF (NSEQW.EQ.0) THEN
  42.          IF (IFWL.LE.0) THEN
  43.             IWR=IWRB+KM
  44. C  AVGES (1, 1-24) - DRY-BULB OUTDOOR TEMP, F
  45. C  AVGES (2, 1-24) - WET-BULB OUTDOOR TEMP, F
  46. C  AVGES (3, 1-24) - TOTAL SOLAR RADIATION ON A HORIZONTAL SURFACE,
  47. C                    BTU/HR-FT2            
  48. C  AVGES (4, 1-24) - WIND SPEED, MILES/HR
  49.             READ(20, REC=IWR) RDUM, RDUM, AVGES, RDUM, REST
  50.          END IF
  51.       END IF
  52. C
  53. 186   IF (NSEQW.EQ.0 .OR. NSEQW.EQ.1) THEN
  54. C--------(1, IHR) BELOW IS DRY BULB TEMPERATURE, F
  55. C--------(2, IHR) IS WET BULB TEMPERATURE, F
  56. C--------(4, IHR) IS WIND SPEED, MPH
  57.          IF (IFW (1).GT.0) READ(5, *) (AVGES (1, IHR), IHR=1, 24)
  58.          IF (IFW (2).GT.0) READ(5, *) (AVGES (2, IHR), IHR=1, 24)
  59.          IF (IFW (4).GT.0) READ(5, *) (AVGES (4, IHR), IHR=1, 24)
  60.          DO 190 IHR=1, 24
  61.             ODDBM (IHR)=AVGES (1, IHR)
  62.             WSPEED (IHR)=AVGES (4, IHR)
  63. C-----------SKIP SPECIFIC HUMIDITY CALCULATION IF DATA IS READ FROM
  64. C-----------TAPE 20 WEATHER FILE
  65.             IF (IMEAN.LT.0) THEN
  66.               IF(IMODE.EQ.1.OR.(IMODE.EQ.2.AND.CFMBP.GT.0.))THEN
  67.                IPSY=-1
  68.                CALL PSY (IPSY, AVGES (1, IHR), AVGES (2, IHR), TDUM,
  69.      +            RDUM, WSC, HDUM)
  70.               ELSE
  71.                WSC=.0003
  72.               ENDIF
  73.                ODHUM (IHR)=WSC
  74.                ODWB=AVGES (2, IHR)
  75.             END IF
  76. 190         CONTINUE
  77. C--------SET 24:00 = 00:00 FOR INTERPOLATION
  78.          ODDBM (25)=ODDBM (1)
  79.          ODHUM (25)=ODHUM (1)
  80.          WSPEED (25)=WSPEED (1)
  81. C
  82.       END IF
  83. C-----IPASS=0 (AVERAGE OUTDY); IPASS=1 (INTEGRATE OUTDY)
  84.       DO 193 I=1, NOUTAV
  85.          IPASS (IOUTAV (I))=0.0
  86. 193      CONTINUE
  87.       NDAY1=NDAYTOT (KM)-1
  88.       DO 195 I=1, NOUTDY
  89.          IPASY (I)=IPASS (I)*NDAY1+1
  90. 195      CONTINUE
  91. C-----
  92. C   SET IMODE FOR MONTHS WITH SPECIFIED HTG OR CLG IN TSTAT
  93. C      IMODE = 1  COOLING MODE
  94. C              2  HEATING MODE
  95. C-----
  96. C
  97. C !!!! NOTE: TI BELOW IS FOR SINGLE ZONE ONLY
  98. C
  99.       IF (MODE.EQ.4) CALL TSTATD (2, IAC, IAC1, IBURN, IEFAN,IDBG)
  100.       IF (IMEAN.GE.0) THEN
  101.          TEMPDV=REST (1)
  102.          WTFCT=REST (2)
  103.       END IF
  104. C-----FOLLOWING 4 LINES DEACTIVATED 11/5/85 KEH
  105. C-----IAIRC2=1
  106. C-----ASSIGN 665 TO IAIRC
  107. C-----IF (IMODE.EQ.2) ASSIGN 675 TO IAIRC
  108. C-----IF (IMODE.EQ.2) IAIRC2=2
  109.       DO 200 I=1, 5
  110.          J=I+3
  111.          C (I)=REST (J)
  112. 200      CONTINUE
  113.       RETURN
  114. C
  115. 7020  FORMAT ('0', 5X, ' --ERROR: EOF ON WEATHER TAPE 40 AT STMT 182',
  116.      1   /,
  117.      2   9X, 'HOUR (I)= ', I5)
  118. C
  119.       END
  120.