      SUBROUTINE QACCUM (TIMEOY, DTIME, NQS,
     +     QWALL1,QWALL2,QWALL3,QWALL4,QWGR,
     +     QFLSPB,QFLSPC,QLOSWL,QWALL6,QWINST,QINF, 
     +     QSLFL,QPART, QLOSFL,QINT,QINC,QRAD, 
     +     QNET,QDUCTZ1,SOLARL6,QVNTLS, 
     +     QSUM1,QSUM2,QSUM,QLOSRF, 
     +     QBWAG,QBWBG,QBASF,QFLBAS,QBASVN, 
     +     QFURLFE,QDUCTZ2,QLEAK,QVENTB,
     +     QWALL5,QRADRF,QCEIL1,QAVENT, QVENTA,
     +     QPLENB,QDRAFT,QINFFRN,CMPUMP,QPLEN,QJACK
     +   ,QVSLOS,QVLLOS,QEXT,EFAN,QP,QFLCRW,QCRWVN,QGRND
     +) 
C 
C ROUTINE FOR ACCUMULATING ENERGY FLOWS 
C  QACCUM IS CALLED FROM LOOP
C        HOURLY SUMS ARE WRITTEN TO TAPE9 
C        DAILY SUMS AND CUMULATIVE SUMS ARE PRINTED ON OUTPUT 
C        INSTANTANEOUS Q'S ARE WRITTEN TO TAPE8 WHEN REQUESTED
C 
C        QSUMS(1,IQS).....HOURLY SUMS 
C        QSUMS(2,IQS).....DAILY SUMS
C        QSUMS(3,IQS).....CUMULATIVE (TOTAL) SUMS 
C 
C ENTRY POINTS CONTROL THE ROUTINE PROCESSES: 
C        QACCUM...........ACCUMULATE Q'S
C        QACCUMH..........IMPLIES A END OF HOUR. WRITE HOURLY SUMS
C                         AND RESET HRLY     ACCUMULATORS 
C        QACCUMD..........IMPLIES A END OF DAY. PRINT DAILY TOTALS
C                         AND RESET HRLY&DLY ACCUMULATORS 
C        QACCUMM..........IMPLIES END OF MONTH. PRINT MONTHLY SUMMARY 
C        QACCUML..........IMPLIES END OF RUN. PRINT SEASONAL SUMMARY
C 
C-------------------------------------------------------------------- 
C 
CMDK NHBK
CMDK NHRO
CMDK NHRP
CMDK NOUTDY
      PARAMETER (NQMAX=60)
CMDK BLKQSM      
CMDK HANDBK
CMDK QACCMQ
CMDK OUTPUT      
      REAL Q(60)
      DOUBLE PRECISION TIMEOY,T
      CHARACTER*10 QNAMES(60) 
      LOGICAL FIRST,I8F,I9F,I31F,I33F,I34F,I35F,I36F
      DATA FIRST/.TRUE./, IPLC,IPLP/0,1/ 
      DATA I8F,I9F,I31F,I33F,I34F,I35F,I36F/
     + .TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE./
C---------------------------------------------------------------------- 
C-----LOAD THE QNAME ARRAY
      DATA QNAMES/'BLANK',
     +'QWALL1','QWALL2','QWALL3','QWALL4','QWGR', 
     +'QFLSPB','QFLSPC','QLOSWL','QWALL6','QWINST','QINF',
     +'QSLFL','QPART','QLOSFL ','QINT','QINC','QRAD',
     +'QNET','QDUCTZ1','SOLARL6','QVNTLS',
     +'QSUM1','QSUM2','QSUM','QLOSRF',
     +'QBWAG','QBWBG','QBASF','QFLBAS','QBASVN',
     +'QFURLFE','BLANK','QDUCTZ2','QLEAK','QVENTB','BLANK ',
     +'QWALL5','QRADRF','QCEIL1','QAVENT','QVENTA',
     +'QPLENB','QDRAFT','QINFFRN','CMPUMP','BLANK','QPLEN','QJACK' 
     +,'QVSLOS','QVLLOS','QEXT','EFAN','QP','QFLCRW','QCRWVN','QGRND' 
     +,3*'BLANK'/ 
C 
C--------PUT Q'S INTO ARRAY Q() 
C      Q( 1) IS NEVER USED. DUMMY STORAGE LOCATION. 
       Q( 2)=QWALL1 
       Q( 3)=QWALL2 
       Q( 4)=QWALL3 
       Q( 5)=QWALL4 
       Q( 6)=QWGR 
       Q( 7)=QFLSPB 
       Q( 8)=QFLSPC 
       Q( 9)=QLOSWL 
       Q(10)=QWALL6 
       Q(11)=QWINST 
       Q(12)=QINF 
       Q(13)=QSLFL
       Q(14)=QPART
       Q(15)=QLOSFL
       Q(16)=QINT 
       Q(17)=QINC 
       Q(18)=QRAD 
       Q(19)=QNET 
       Q(20)=QDUCTZ1
       Q(21)=SOLARL6
       Q(22)=QVNTLS 
       Q(23)=QSUM1
       Q(24)=QSUM2
       Q(25)=QSUM 
       Q(26)=QLOSRF 
       Q(27)=QBWAG
       Q(28)=QBWBG
       Q(29)=QBASF
       Q(30)=QFLBAS 
       Q(31)=QBASVN 
       Q(32)=QFURLFE
       Q(33)=0.
       Q(34)=QDUCTZ2
       Q(35)=QLEAK
       Q(36)=QVENTB 
       Q(37)=0.
       Q(38)=QWALL5 
       Q(39)=QRADRF 
       Q(40)=QCEIL1
       Q(41)=QAVENT 
       Q(42)=QVENTA 
       Q(43)=QPLENB 
       Q(44)=QDRAFT 
       Q(45)=QINFFRN
       Q(46)=CMPUMP 
C  Q(47) IS RESERVED AND AVAILABLE ! (IT USED TO BE QPILOF, WHICH IS 
C  OBSOLETE)       
       Q(47)=0.
       Q(48)=QPLEN
       Q(49)=QJACK
       Q(50)=QVSLOS 
       Q(51)=QVLLOS 
       Q(52)=QEXT 
       Q(53)=EFAN 
       Q(54)=QP 
       Q(55)=QFLCRW 
       Q(56)=QCRWVN 
       Q(57)=QGRND
       NUMQ= 57 
C NOTE: CHECK DIMENSIONS ON Q()'S & QSUMS()'S IF YOU ADD QXXX'S 
      IF(FIRST)THEN 
         NQSP1=NQS+1
         IF(NQSP1.NE.NUMQ) STOP 'CHECK NQS IN SUB.QACCUM' 
         FIRST=.FALSE.
      ENDIF 
C 
C------------------------------------------------ 
C     ACCUMULATE HOURLY SUMS
C 
      DO 110 IQS=2,NQSP1
         QSUMS(1,IQS)=QSUMS(1,IQS)+Q(IQS)*DTIME 
  110 CONTINUE
C 
      IF(PLOADS)THEN
         IF(I8F)THEN
           I8F=.FALSE.
           OPEN(8,FILE='TAPE8',STATUS='NEW',IOSTAT=IO8)
           IF(IO8.NE.0)THEN
             WRITE(60,*)' QACCUM: CANT OPEN TAPE8 '
             STOP ' QACCUM: CANT OPEN TAPE8'
             ENDIF
           ENDIF
         IPLC=IPLC+1
         IF(IPL1(IPLP).LE.IPLC .AND. IPLC.LE.IPL2(IPLP))THEN
            WRITE(8,8000) TIMEOY,NQSP1,(Q(IQS),IQS=2,NQSP1) 
            IF(IPLC.EQ.IPL2(IPLP)) IPLP=IPLP+1
         ENDIF
      ENDIF 
C 
      T=(TIMEOY-DTIME-.5) 
      RETURN
C 
C-------------------------------------------------------------------- 
C     END OF HOUR 
C 
      ENTRY QACCUMH 
C  CALLED FROM HOUS_II      
C     WRITE OUT PREVIOUS HOUR.
C     ACCUMULATE DAILY SUMS.    INITIALIZE HOURLY SUMS
      IF(HBKRNL.LT.0.0) THEN
         IF(I9F)THEN
            I9F=.FALSE.
            OPEN(9,FILE='TAPE9',STATUS='NEW',IOSTAT=IO9)
            IF(IO9.NE.0)THEN
              WRITE(60,*)' QACCUM: CANT OPEN TAPE8'
              STOP ' QACCUM: CANT OPEN TAPE8'
              ENDIF
            ENDIF
         WRITE(9,9000) T,NQSP1,(QSUMS(1,IQS),IQS=2,NQSP1) 
         ENDIF
      DO 210 IQS=2,NQSP1
         QSUMS(2,IQS)=QSUMS(2,IQS)+QSUMS(1,IQS) 
         QSUMS(1,IQS)=0.0 
  210 CONTINUE
      RETURN
C 
C-------------------------------------------------------------------- 
C     END OF DAY
C 
      ENTRY QACCUMD(IDAYM)
C  CALLED BY ENDLP2      
C     NEW DAY HAS BEGUN. SUMMARIZE PREVIOUS DAY 
C     WRITE OUT PREVIOUS HOUR, AND DAILY SUMMARY
C     ACCUMULATE DAILY AND TOTAL SUMS 
C     INITIALIZE HOURLY AND DAILY SUMS
      IF(HBKRNL.LT.0.0) 
     +   WRITE(9,9000) T,NQSP1,(QSUMS(1,IQS),IQS=2,NQSP1) 
      DO 310 IQS=2,NQSP1
        QSUMS(2,IQS)=QSUMS(2,IQS)+QSUMS(1,IQS)
        IF(HBKRNL.LT.0.0 .OR. IDAYM.GT.1) 
     +  QSUMS(3,IQS)=QSUMS(3,IQS)+QSUMS(2,IQS)
  310 CONTINUE
      IF(HBKRNL.LE.0.0)THEN 
         WRITE(60,1000) T,(IQS,QNAMES(IQS),(QSUMS(I,IQS),I=2,3),
     +        IQS=2,NQSP1) 
      ELSE
         IF(I31F)THEN
           I31F=.FALSE.
           OPEN(31,FILE='TAPE31',STATUS='NEW',IOSTAT=IO31)
           IF(IO31.NE.0)THEN
             WRITE(60,*)' QACCUM: CANT OPEN TAPE31'
             STOP ' QACCUM: CANT OPEN TAPE31'
           ENDIF
         ENDIF
         WRITE(31,1000)T,(IQS,QNAMES(IQS),
     +                 (QSUMS(I,IQS),I=2,3),IQS=2,NQSP1)
      ENDIF 
      DO 320 IQS=2,NQSP1
      DO 320 I=1,2
  320    QSUMS(I,IQS)=0.0 
      IF(HBKRNL.GE.0.0)THEN 
         CALL HBKFACT(T)
         IF(I33T36.EQ.0)RETURN
      IF(I33F)THEN
         I33F=.FALSE.
         OPEN(33,FILE='TAPE33',STATUS='NEW',IOSTAT=IO33)
         IF(IO33.NE.0)THEN
           WRITE(60,*)' QACCUM: CANT OPEN TAPE33'
           STOP ' QACCUM: CANT OPEN TAPE33'
           ENDIF
         ENDIF
         WRITE(33,400)'HROUT',T,(I,(HROUT(I,J),J=1,24),I=1,32)
      IF(I34F)THEN
         I34F=.FALSE.
         OPEN(34,FILE='TAPE34',STATUS='NEW',IOSTAT=IO34)
         IF(IO34.NE.0)THEN
           WRITE(60,*)' QACCUM: CANT OPEN TAPE34'
           STOP ' QACCUM: CANT OPEN TAPE34'
           ENDIF
         ENDIF
         WRITE(34,400)'HRPRT',T,(I,(HRPRT(I,J),J=1,24),I=1,38)
400      FORMAT(1H1,A10,16X,'TIME=',F13.7/
     +          (I3, 6G20.10/3(3X, 6G20.10/)) ) 
      ENDIF 
      RETURN
C 
C------------------------------------------------------------------ 
C     END OF MONTH
C 
      ENTRY QACCUMM 
C  CALLED BY ENDMON      
      IF(HBKRNL.GE.0)THEN 
         IF(I33T36.EQ.0)RETURN
         IF(I35F)THEN
           I35F=.FALSE.
           OPEN(35,FILE='TAPE35',STATUS='NEW',IOSTAT=IO35)
           IF(IO35.NE.0)THEN
             WRITE(60,*)' QACCUM: CANT OPEN TAPE35'
             STOP ' QACCUM: CANT OPEN TAPE35'
             ENDIF
           ENDIF
         WRITE(35,410)'OUTDY',T,(J,(OUTDY(I,J),I=1,8),J=1,44) 
         ENDIF
410      FORMAT(1H1,A10,16X,'TIME=',F13.7/
     +          (I3, 8G15.8)) 
C 
      RETURN
C---------------------------------------------------------------------- 
C END OF RUN
C 
      ENTRY QACCUML 
C  CALLED BY ENDRUN      
      IF(HBKRNL.GE.0.0)THEN 
         IF(I33T36.EQ.0)RETURN
         IF(I36F)THEN
           I36F=.FALSE.
           OPEN(36,FILE='TAPE36',STATUS='NEW',IOSTAT=IO36)
           IF(IO36.NE.0)THEN
             WRITE(60,*)' QACCUM: CANT OPEN TAPE36'
             STOP ' QACCUM: CANT OPEN TAPE36'
             ENDIF
           ENDIF
         WRITE(36,510)'SEASUM',T,(J,SEASUM(J),J=1,44) 
         ENDIF
510      FORMAT(1H1,A10,16X,'TIME=',F13.7/
     +          (I3, 1G20.10))
      RETURN
C 
CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFORMAT
C 
 1000 FORMAT('1DAILY AND CUM. Q FLOWS ...TIME=',F13.7/
     +1X,3(7HCHANNEL,12X,5HDAILY,5X,10HCUMULATIVE,' * ')/ 
     +(1H0,3(I2,')',A10,F11.0,F15.0,' * ')) ) 
C 
 8000 FORMAT(F12.5,16X,I3/(8E10.4)) 
C 
 9000 FORMAT(F12.5,16X,I3/(8F10.1)) 
      END 
