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 >
Text File  |  1992-04-07  |  3KB  |  82 lines
  1.       SUBROUTINE COLLECT(ICODE)
  2. C
  3. C SUBROUTINE TO PRINT OUT DATA COLLECTED AT VARIOUS
  4. C POINTS  IN THE CARRIER HOUSE FURNACE SIMULATION MODEL
  5. C
  6. C        VARIABLE  DEFINITION
  7. C        --------  ------------------------------
  8. C        ICOLL    COLLECTION INDICATOR. IF.NE.0 THEN COLLECT
  9. C        CTIME    THE TIME ARRAY FOR DATA COLLECTION
  10. C                 1)IMONTH, 2)KK, 3)IT, 4)TIME
  11. C        CDATA    THE COLLECTED DATA ARRAY
  12. C        ND       THE NUMBER OF DATA ITEMS COLLECTED
  13. C
  14.       DIMENSION ITIME(7), TSTART(10),TSTOP(10)
  15.       LOGICAL FIRST
  16. CMDK COLLEC
  17. CMDK IWETHR
  18. C
  19.       NAMELIST/INPCOLL/TSTART,TSTOP
  20. C INPUTS IN NAMELIST INPCOLL:
  21. C  TSTART - TIME OF YEAR AT WHICH TO START COLLECTING DATA, HR
  22. C  TSTOP  - TIME OF YEAR AT WHICH TO STOP COLLECTING DATA, HR
  23.       DATA ND/64/
  24.       DATA ITIME/999,999,999,0,0,999,1985/
  25.       DATA FIRST/.TRUE./, LASTHR/-999/
  26. C
  27.       IF(FIRST) THEN
  28.           FIRST=.FALSE.
  29. C
  30.       OPEN(14,FILE='TAPE14',STATUS='OLD',IOSTAT=IO14)
  31.       IF(IO14.NE.0)THEN
  32.         WRITE(60,*)' COLLECT: CANT OPEN TAPE14 WITH NAMELIST INPCOLL'
  33.         STOP ' COLLECT: CANT OPEN TAPE14 WITH NAMELIST INPCOLL'
  34.         END IF
  35.       READ(14,INPCOLL,END=99)
  36.       WRITE(60,INPCOLL)
  37.       CLOSE(14)
  38. C
  39.           WRITE(60,*) 'DATA COLLECTION TIMES',
  40.      +           (TSTART(I),TSTOP(I),I=1,10)
  41. C  CHECK TO SEE IF ANY TSTOPS > TSTARTS, IF SO, OPEN FILE TAPE7
  42.           I7F=0
  43.       DO 5 I=1,10
  44.       IF(TSTART(I).EQ.0. .AND. TSTOP(I).EQ.9999.)GO TO 5
  45.       IF(TSTOP(I).GT.TSTART(I))I7F=1
  46.     5     CONTINUE
  47.           IF(I7F.EQ.1)OPEN(7,FILE='TAPE7',STATUS='NEW')
  48.           WRITE(60,*)' COLLECT: OPENING TAPE7'
  49.       ENDIF
  50. C
  51. C *** ICODE=1: WRITE OUT A DATA RECORD TO TAPE7
  52. C
  53.       IF(ICODE.EQ.1) THEN
  54.           HOY= ( FLOAT(ISDAY)+(CTIME(2)-1.0) )*24. + CTIME(4)
  55.           ITIME(1)= ISDAY+IFIX(CTIME(2)-1.0)
  56.           ITIME(2)=IFIX(CTIME(3)-1.0)
  57.           ITIME(3)=IFIX( ( CTIME(4)-(CTIME(3)-1) )*60. )
  58.           ITIME(4)= IFIX(( (CTIME(4)-(CTIME(3)-1))*60. - ITIME(3) )*60.)
  59.           ITIME(6)=ND
  60.           DO 110 I=1,10
  61.                  IF(TSTART(I).EQ.0.0.AND.TSTOP(I).EQ.9999.)
  62.      +              GO TO 110
  63.                  IF(TSTART(I).LE.HOY.AND.HOY.LE.TSTOP(I))
  64.      +              GO TO 120
  65.   110     CONTINUE
  66.           RETURN
  67.   120     CONTINUE
  68.           IF(LASTHR.NE.ITIME(2)) THEN
  69.                  LASTHR=ITIME(2)
  70. C  IBM PROFORT CANT WRITE AFTER AN ENDFILE !!!!
  71. C                 ENDFILE 7
  72.           ENDIF
  73.           WRITE(7,7010) HOY,(ITIME(I),I=1,7),
  74.      +             (CDATA(I),I=2,ITIME(6))
  75.       ELSE
  76.          WRITE(60,*) 'BAD ICODE IN COLLECT....',ICODE
  77.       ENDIF
  78.       RETURN
  79.    99 STOP ' COLLECT: EOF ON TAPE14'
  80.  7010 FORMAT(F12.5,I4,5I3,I5/(8E10.4))
  81.       END
  82.