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 >
Wrap
Text File
|
1992-05-08
|
9KB
|
296 lines
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