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