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
/
COLLECT.FOR
< prev
next >
Wrap
Text File
|
1992-04-07
|
3KB
|
82 lines
SUBROUTINE COLLECT(ICODE)
C
C SUBROUTINE TO PRINT OUT DATA COLLECTED AT VARIOUS
C POINTS IN THE CARRIER HOUSE FURNACE SIMULATION MODEL
C
C VARIABLE DEFINITION
C -------- ------------------------------
C ICOLL COLLECTION INDICATOR. IF.NE.0 THEN COLLECT
C CTIME THE TIME ARRAY FOR DATA COLLECTION
C 1)IMONTH, 2)KK, 3)IT, 4)TIME
C CDATA THE COLLECTED DATA ARRAY
C ND THE NUMBER OF DATA ITEMS COLLECTED
C
DIMENSION ITIME(7), TSTART(10),TSTOP(10)
LOGICAL FIRST
CMDK COLLEC
CMDK IWETHR
C
NAMELIST/INPCOLL/TSTART,TSTOP
C INPUTS IN NAMELIST INPCOLL:
C TSTART - TIME OF YEAR AT WHICH TO START COLLECTING DATA, HR
C TSTOP - TIME OF YEAR AT WHICH TO STOP COLLECTING DATA, HR
DATA ND/64/
DATA ITIME/999,999,999,0,0,999,1985/
DATA FIRST/.TRUE./, LASTHR/-999/
C
IF(FIRST) THEN
FIRST=.FALSE.
C
OPEN(14,FILE='TAPE14',STATUS='OLD',IOSTAT=IO14)
IF(IO14.NE.0)THEN
WRITE(60,*)' COLLECT: CANT OPEN TAPE14 WITH NAMELIST INPCOLL'
STOP ' COLLECT: CANT OPEN TAPE14 WITH NAMELIST INPCOLL'
END IF
READ(14,INPCOLL,END=99)
WRITE(60,INPCOLL)
CLOSE(14)
C
WRITE(60,*) 'DATA COLLECTION TIMES',
+ (TSTART(I),TSTOP(I),I=1,10)
C CHECK TO SEE IF ANY TSTOPS > TSTARTS, IF SO, OPEN FILE TAPE7
I7F=0
DO 5 I=1,10
IF(TSTART(I).EQ.0. .AND. TSTOP(I).EQ.9999.)GO TO 5
IF(TSTOP(I).GT.TSTART(I))I7F=1
5 CONTINUE
IF(I7F.EQ.1)OPEN(7,FILE='TAPE7',STATUS='NEW')
WRITE(60,*)' COLLECT: OPENING TAPE7'
ENDIF
C
C *** ICODE=1: WRITE OUT A DATA RECORD TO TAPE7
C
IF(ICODE.EQ.1) THEN
HOY= ( FLOAT(ISDAY)+(CTIME(2)-1.0) )*24. + CTIME(4)
ITIME(1)= ISDAY+IFIX(CTIME(2)-1.0)
ITIME(2)=IFIX(CTIME(3)-1.0)
ITIME(3)=IFIX( ( CTIME(4)-(CTIME(3)-1) )*60. )
ITIME(4)= IFIX(( (CTIME(4)-(CTIME(3)-1))*60. - ITIME(3) )*60.)
ITIME(6)=ND
DO 110 I=1,10
IF(TSTART(I).EQ.0.0.AND.TSTOP(I).EQ.9999.)
+ GO TO 110
IF(TSTART(I).LE.HOY.AND.HOY.LE.TSTOP(I))
+ GO TO 120
110 CONTINUE
RETURN
120 CONTINUE
IF(LASTHR.NE.ITIME(2)) THEN
LASTHR=ITIME(2)
C IBM PROFORT CANT WRITE AFTER AN ENDFILE !!!!
C ENDFILE 7
ENDIF
WRITE(7,7010) HOY,(ITIME(I),I=1,7),
+ (CDATA(I),I=2,ITIME(6))
ELSE
WRITE(60,*) 'BAD ICODE IN COLLECT....',ICODE
ENDIF
RETURN
99 STOP ' COLLECT: EOF ON TAPE14'
7010 FORMAT(F12.5,I4,5I3,I5/(8E10.4))
END