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 / QACCUM.FOR < prev    next >
Text File  |  1992-05-08  |  9KB  |  296 lines
  1.       SUBROUTINE QACCUM (TIMEOY, DTIME, NQS,
  2.      +     QWALL1,QWALL2,QWALL3,QWALL4,QWGR,
  3.      +     QFLSPB,QFLSPC,QLOSWL,QWALL6,QWINST,QINF, 
  4.      +     QSLFL,QPART, QLOSFL,QINT,QINC,QRAD, 
  5.      +     QNET,QDUCTZ1,SOLARL6,QVNTLS, 
  6.      +     QSUM1,QSUM2,QSUM,QLOSRF, 
  7.      +     QBWAG,QBWBG,QBASF,QFLBAS,QBASVN, 
  8.      +     QFURLFE,QDUCTZ2,QLEAK,QVENTB,
  9.      +     QWALL5,QRADRF,QCEIL1,QAVENT, QVENTA,
  10.      +     QPLENB,QDRAFT,QINFFRN,CMPUMP,QPLEN,QJACK
  11.      +   ,QVSLOS,QVLLOS,QEXT,EFAN,QP,QFLCRW,QCRWVN,QGRND
  12.      +) 
  13. C 
  14. C ROUTINE FOR ACCUMULATING ENERGY FLOWS 
  15. C  QACCUM IS CALLED FROM LOOP
  16. C        HOURLY SUMS ARE WRITTEN TO TAPE9 
  17. C        DAILY SUMS AND CUMULATIVE SUMS ARE PRINTED ON OUTPUT 
  18. C        INSTANTANEOUS Q'S ARE WRITTEN TO TAPE8 WHEN REQUESTED
  19. C 
  20. C        QSUMS(1,IQS).....HOURLY SUMS 
  21. C        QSUMS(2,IQS).....DAILY SUMS
  22. C        QSUMS(3,IQS).....CUMULATIVE (TOTAL) SUMS 
  23. C 
  24. C ENTRY POINTS CONTROL THE ROUTINE PROCESSES: 
  25. C        QACCUM...........ACCUMULATE Q'S
  26. C        QACCUMH..........IMPLIES A END OF HOUR. WRITE HOURLY SUMS
  27. C                         AND RESET HRLY     ACCUMULATORS 
  28. C        QACCUMD..........IMPLIES A END OF DAY. PRINT DAILY TOTALS
  29. C                         AND RESET HRLY&DLY ACCUMULATORS 
  30. C        QACCUMM..........IMPLIES END OF MONTH. PRINT MONTHLY SUMMARY 
  31. C        QACCUML..........IMPLIES END OF RUN. PRINT SEASONAL SUMMARY
  32. C 
  33. C-------------------------------------------------------------------- 
  34. C 
  35. CMDK NHBK
  36. CMDK NHRO
  37. CMDK NHRP
  38. CMDK NOUTDY
  39.       PARAMETER (NQMAX=60)
  40. CMDK BLKQSM      
  41. CMDK HANDBK
  42. CMDK QACCMQ
  43. CMDK OUTPUT      
  44.       REAL Q(60)
  45.       DOUBLE PRECISION TIMEOY,T
  46.       CHARACTER*10 QNAMES(60) 
  47.       LOGICAL FIRST,I8F,I9F,I31F,I33F,I34F,I35F,I36F
  48.       DATA FIRST/.TRUE./, IPLC,IPLP/0,1/ 
  49.       DATA I8F,I9F,I31F,I33F,I34F,I35F,I36F/
  50.      + .TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE./
  51. C---------------------------------------------------------------------- 
  52. C-----LOAD THE QNAME ARRAY
  53.       DATA QNAMES/'BLANK',
  54.      +'QWALL1','QWALL2','QWALL3','QWALL4','QWGR', 
  55.      +'QFLSPB','QFLSPC','QLOSWL','QWALL6','QWINST','QINF',
  56.      +'QSLFL','QPART','QLOSFL ','QINT','QINC','QRAD',
  57.      +'QNET','QDUCTZ1','SOLARL6','QVNTLS',
  58.      +'QSUM1','QSUM2','QSUM','QLOSRF',
  59.      +'QBWAG','QBWBG','QBASF','QFLBAS','QBASVN',
  60.      +'QFURLFE','BLANK','QDUCTZ2','QLEAK','QVENTB','BLANK ',
  61.      +'QWALL5','QRADRF','QCEIL1','QAVENT','QVENTA',
  62.      +'QPLENB','QDRAFT','QINFFRN','CMPUMP','BLANK','QPLEN','QJACK' 
  63.      +,'QVSLOS','QVLLOS','QEXT','EFAN','QP','QFLCRW','QCRWVN','QGRND' 
  64.      +,3*'BLANK'/ 
  65. C 
  66. C--------PUT Q'S INTO ARRAY Q() 
  67. C      Q( 1) IS NEVER USED. DUMMY STORAGE LOCATION. 
  68.        Q( 2)=QWALL1 
  69.        Q( 3)=QWALL2 
  70.        Q( 4)=QWALL3 
  71.        Q( 5)=QWALL4 
  72.        Q( 6)=QWGR 
  73.        Q( 7)=QFLSPB 
  74.        Q( 8)=QFLSPC 
  75.        Q( 9)=QLOSWL 
  76.        Q(10)=QWALL6 
  77.        Q(11)=QWINST 
  78.        Q(12)=QINF 
  79.        Q(13)=QSLFL
  80.        Q(14)=QPART
  81.        Q(15)=QLOSFL
  82.        Q(16)=QINT 
  83.        Q(17)=QINC 
  84.        Q(18)=QRAD 
  85.        Q(19)=QNET 
  86.        Q(20)=QDUCTZ1
  87.        Q(21)=SOLARL6
  88.        Q(22)=QVNTLS 
  89.        Q(23)=QSUM1
  90.        Q(24)=QSUM2
  91.        Q(25)=QSUM 
  92.        Q(26)=QLOSRF 
  93.        Q(27)=QBWAG
  94.        Q(28)=QBWBG
  95.        Q(29)=QBASF
  96.        Q(30)=QFLBAS 
  97.        Q(31)=QBASVN 
  98.        Q(32)=QFURLFE
  99.        Q(33)=0.
  100.        Q(34)=QDUCTZ2
  101.        Q(35)=QLEAK
  102.        Q(36)=QVENTB 
  103.        Q(37)=0.
  104.        Q(38)=QWALL5 
  105.        Q(39)=QRADRF 
  106.        Q(40)=QCEIL1
  107.        Q(41)=QAVENT 
  108.        Q(42)=QVENTA 
  109.        Q(43)=QPLENB 
  110.        Q(44)=QDRAFT 
  111.        Q(45)=QINFFRN
  112.        Q(46)=CMPUMP 
  113. C  Q(47) IS RESERVED AND AVAILABLE ! (IT USED TO BE QPILOF, WHICH IS 
  114. C  OBSOLETE)       
  115.        Q(47)=0.
  116.        Q(48)=QPLEN
  117.        Q(49)=QJACK
  118.        Q(50)=QVSLOS 
  119.        Q(51)=QVLLOS 
  120.        Q(52)=QEXT 
  121.        Q(53)=EFAN 
  122.        Q(54)=QP 
  123.        Q(55)=QFLCRW 
  124.        Q(56)=QCRWVN 
  125.        Q(57)=QGRND
  126.        NUMQ= 57 
  127. C NOTE: CHECK DIMENSIONS ON Q()'S & QSUMS()'S IF YOU ADD QXXX'S 
  128.       IF(FIRST)THEN 
  129.          NQSP1=NQS+1
  130.          IF(NQSP1.NE.NUMQ) STOP 'CHECK NQS IN SUB.QACCUM' 
  131.          FIRST=.FALSE.
  132.       ENDIF 
  133. C 
  134. C------------------------------------------------ 
  135. C     ACCUMULATE HOURLY SUMS
  136. C 
  137.       DO 110 IQS=2,NQSP1
  138.          QSUMS(1,IQS)=QSUMS(1,IQS)+Q(IQS)*DTIME 
  139.   110 CONTINUE
  140. C 
  141.       IF(PLOADS)THEN
  142.          IF(I8F)THEN
  143.            I8F=.FALSE.
  144.            OPEN(8,FILE='TAPE8',STATUS='NEW',IOSTAT=IO8)
  145.            IF(IO8.NE.0)THEN
  146.              WRITE(60,*)' QACCUM: CANT OPEN TAPE8 '
  147.              STOP ' QACCUM: CANT OPEN TAPE8'
  148.              ENDIF
  149.            ENDIF
  150.          IPLC=IPLC+1
  151.          IF(IPL1(IPLP).LE.IPLC .AND. IPLC.LE.IPL2(IPLP))THEN
  152.             WRITE(8,8000) TIMEOY,NQSP1,(Q(IQS),IQS=2,NQSP1) 
  153.             IF(IPLC.EQ.IPL2(IPLP)) IPLP=IPLP+1
  154.          ENDIF
  155.       ENDIF 
  156. C 
  157.       T=(TIMEOY-DTIME-.5) 
  158.       RETURN
  159. C 
  160. C-------------------------------------------------------------------- 
  161. C     END OF HOUR 
  162. C 
  163.       ENTRY QACCUMH 
  164. C  CALLED FROM HOUS_II      
  165. C     WRITE OUT PREVIOUS HOUR.
  166. C     ACCUMULATE DAILY SUMS.    INITIALIZE HOURLY SUMS
  167.       IF(HBKRNL.LT.0.0) THEN
  168.          IF(I9F)THEN
  169.             I9F=.FALSE.
  170.             OPEN(9,FILE='TAPE9',STATUS='NEW',IOSTAT=IO9)
  171.             IF(IO9.NE.0)THEN
  172.               WRITE(60,*)' QACCUM: CANT OPEN TAPE8'
  173.               STOP ' QACCUM: CANT OPEN TAPE8'
  174.               ENDIF
  175.             ENDIF
  176.          WRITE(9,9000) T,NQSP1,(QSUMS(1,IQS),IQS=2,NQSP1) 
  177.          ENDIF
  178.       DO 210 IQS=2,NQSP1
  179.          QSUMS(2,IQS)=QSUMS(2,IQS)+QSUMS(1,IQS) 
  180.          QSUMS(1,IQS)=0.0 
  181.   210 CONTINUE
  182.       RETURN
  183. C 
  184. C-------------------------------------------------------------------- 
  185. C     END OF DAY
  186. C 
  187.       ENTRY QACCUMD(IDAYM)
  188. C  CALLED BY ENDLP2      
  189. C     NEW DAY HAS BEGUN. SUMMARIZE PREVIOUS DAY 
  190. C     WRITE OUT PREVIOUS HOUR, AND DAILY SUMMARY
  191. C     ACCUMULATE DAILY AND TOTAL SUMS 
  192. C     INITIALIZE HOURLY AND DAILY SUMS
  193.       IF(HBKRNL.LT.0.0) 
  194.      +   WRITE(9,9000) T,NQSP1,(QSUMS(1,IQS),IQS=2,NQSP1) 
  195.       DO 310 IQS=2,NQSP1
  196.         QSUMS(2,IQS)=QSUMS(2,IQS)+QSUMS(1,IQS)
  197.         IF(HBKRNL.LT.0.0 .OR. IDAYM.GT.1) 
  198.      +  QSUMS(3,IQS)=QSUMS(3,IQS)+QSUMS(2,IQS)
  199.   310 CONTINUE
  200.       IF(HBKRNL.LE.0.0)THEN 
  201.          WRITE(60,1000) T,(IQS,QNAMES(IQS),(QSUMS(I,IQS),I=2,3),
  202.      +        IQS=2,NQSP1) 
  203.       ELSE
  204.          IF(I31F)THEN
  205.            I31F=.FALSE.
  206.            OPEN(31,FILE='TAPE31',STATUS='NEW',IOSTAT=IO31)
  207.            IF(IO31.NE.0)THEN
  208.              WRITE(60,*)' QACCUM: CANT OPEN TAPE31'
  209.              STOP ' QACCUM: CANT OPEN TAPE31'
  210.            ENDIF
  211.          ENDIF
  212.          WRITE(31,1000)T,(IQS,QNAMES(IQS),
  213.      +                 (QSUMS(I,IQS),I=2,3),IQS=2,NQSP1)
  214.       ENDIF 
  215.       DO 320 IQS=2,NQSP1
  216.       DO 320 I=1,2
  217.   320    QSUMS(I,IQS)=0.0 
  218.       IF(HBKRNL.GE.0.0)THEN 
  219.          CALL HBKFACT(T)
  220.          IF(I33T36.EQ.0)RETURN
  221.       IF(I33F)THEN
  222.          I33F=.FALSE.
  223.          OPEN(33,FILE='TAPE33',STATUS='NEW',IOSTAT=IO33)
  224.          IF(IO33.NE.0)THEN
  225.            WRITE(60,*)' QACCUM: CANT OPEN TAPE33'
  226.            STOP ' QACCUM: CANT OPEN TAPE33'
  227.            ENDIF
  228.          ENDIF
  229.          WRITE(33,400)'HROUT',T,(I,(HROUT(I,J),J=1,24),I=1,32)
  230.       IF(I34F)THEN
  231.          I34F=.FALSE.
  232.          OPEN(34,FILE='TAPE34',STATUS='NEW',IOSTAT=IO34)
  233.          IF(IO34.NE.0)THEN
  234.            WRITE(60,*)' QACCUM: CANT OPEN TAPE34'
  235.            STOP ' QACCUM: CANT OPEN TAPE34'
  236.            ENDIF
  237.          ENDIF
  238.          WRITE(34,400)'HRPRT',T,(I,(HRPRT(I,J),J=1,24),I=1,38)
  239. 400      FORMAT(1H1,A10,16X,'TIME=',F13.7/
  240.      +          (I3, 6G20.10/3(3X, 6G20.10/)) ) 
  241.       ENDIF 
  242.       RETURN
  243. C 
  244. C------------------------------------------------------------------ 
  245. C     END OF MONTH
  246. C 
  247.       ENTRY QACCUMM 
  248. C  CALLED BY ENDMON      
  249.       IF(HBKRNL.GE.0)THEN 
  250.          IF(I33T36.EQ.0)RETURN
  251.          IF(I35F)THEN
  252.            I35F=.FALSE.
  253.            OPEN(35,FILE='TAPE35',STATUS='NEW',IOSTAT=IO35)
  254.            IF(IO35.NE.0)THEN
  255.              WRITE(60,*)' QACCUM: CANT OPEN TAPE35'
  256.              STOP ' QACCUM: CANT OPEN TAPE35'
  257.              ENDIF
  258.            ENDIF
  259.          WRITE(35,410)'OUTDY',T,(J,(OUTDY(I,J),I=1,8),J=1,44) 
  260.          ENDIF
  261. 410      FORMAT(1H1,A10,16X,'TIME=',F13.7/
  262.      +          (I3, 8G15.8)) 
  263. C 
  264.       RETURN
  265. C---------------------------------------------------------------------- 
  266. C END OF RUN
  267. C 
  268.       ENTRY QACCUML 
  269. C  CALLED BY ENDRUN      
  270.       IF(HBKRNL.GE.0.0)THEN 
  271.          IF(I33T36.EQ.0)RETURN
  272.          IF(I36F)THEN
  273.            I36F=.FALSE.
  274.            OPEN(36,FILE='TAPE36',STATUS='NEW',IOSTAT=IO36)
  275.            IF(IO36.NE.0)THEN
  276.              WRITE(60,*)' QACCUM: CANT OPEN TAPE36'
  277.              STOP ' QACCUM: CANT OPEN TAPE36'
  278.              ENDIF
  279.            ENDIF
  280.          WRITE(36,510)'SEASUM',T,(J,SEASUM(J),J=1,44) 
  281.          ENDIF
  282. 510      FORMAT(1H1,A10,16X,'TIME=',F13.7/
  283.      +          (I3, 1G20.10))
  284.       RETURN
  285. C 
  286. CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFORMAT
  287. C 
  288.  1000 FORMAT('1DAILY AND CUM. Q FLOWS ...TIME=',F13.7/
  289.      +1X,3(7HCHANNEL,12X,5HDAILY,5X,10HCUMULATIVE,' * ')/ 
  290.      +(1H0,3(I2,')',A10,F11.0,F15.0,' * ')) ) 
  291. C 
  292.  8000 FORMAT(F12.5,16X,I3/(8E10.4)) 
  293. C 
  294.  9000 FORMAT(F12.5,16X,I3/(8F10.1)) 
  295.       END 
  296.