PROGRAM ANADIC C Author: T. R. Wyant C Date: 06-Dec-1990 C Remarks: C This program reads the desired input file and breaks C it up into a number of fixed-length-record sequential C files named ANA%%.TMP, with the %% representing the C record size. The input file is DELETED when done. C Work files of the form AN%%%%.TMP are created, where C the first two digits of %%%% are the lower record C length limit (ie - all records are at least this long) C and the second is the upper limit (no records are this C long or longer). The scratch files are also deleted. C C +---------------------------------------------------------+ C | +-----------------------------------------------------+ | C | | | | C | | Note well! | | C | | The value of the parameter STKSIZ must be at | | C | | least [LOG(WRDSIZ)/LOG(NUMOUT)]*(NUMOUT-1)+1 | | C | | where the square brackets denote rounding UP | | C | | to the next integer. | | C | | | | C | +-----------------------------------------------------+ | C +---------------------------------------------------------+ C PARAMETER NUMOUT = 2 ! Number of output files. PARAMETER WRDSIZ = 64 ! Largest word handled, + 1. PARAMETER STKSIZ = 8 ! Size of stack. PARAMETER LUNTI = 5 ! LUN for terminal input. PARAMETER LUNTO = 6 ! LUN for terminal output. PARAMETER LUNIN = 4 ! LUN for file input. INTEGER*2 LIMSTK (2, STKSIZ) ! Word length stack. INTEGER*2 SPNT ! Limit stack pointer. INTEGER*2 LUNTBL (NUMOUT) ! Output LUN table. INTEGER*2 LUNOUT ! Output LUN. INTEGER*2 LIMTBL (2, NUMOUT) ! Limits for current pass. INTEGER*2 FILOPN (NUMOUT) ! .TRUE. if file opened. INTEGER*2 LIMWID ! Limit width for this pass. CHARACTER*80 FILNAM ! File name. INTEGER*2 FILLEN ! Length of file name. INTEGER*2 PASNUM ! Pass number. CHARACTER*(WRDSIZ) RECORD ! File record. INTEGER*2 RECLEN ! Record length. INTEGER*4 RECNUM (NUMOUT) ! Record number to write. C Compute output LUN table. DO 1010 LUNOUT = 1, NUMOUT IF (LUNOUT .LT. LUNIN) THEN LUNTBL (LUNOUT) = LUNOUT ELSE LUNTBL (LUNOUT) = LUNOUT + 3 END IF 1010 CONTINUE C Get the file name. WRITE (LUNTO, 1020) ' ' 1020 FORMAT (8A) WRITE (LUNTO, 1020) '$Enter input file name: ' READ (LUNTI, 1020, END=9900) FILNAM C Init the stack. SPNT = 1 LIMSTK (1, SPNT) = 0 LIMSTK (2, SPNT) = WRDSIZ PASNUM = 0 C Main_loop: C If the stack is empty, we're done. 2000 CONTINUE C Build the input file name. IF (PASNUM .GT. 0) THEN WRITE (FILNAM, 2010) LIMSTK (1, SPNT), LIMSTK (2, SPNT) 2010 FORMAT ('AN', 2I2.2, '.TMP') END IF PASNUM = PASNUM + 1 C Signal start of pass. FILLEN = INDEX (FILNAM, ' ') WRITE (LUNTO, 2020) PASNUM, FILNAM (:FILLEN) 2020 FORMAT (' ... Starting pass', I3, ', reading file ', A) C Build the limit and file open tables. LIMWID = MAX ((LIMSTK (2, SPNT) - LIMSTK (1, SPNT))/NUMOUT, 1) DO 2060 LUNOUT = 1, NUMOUT LIMTBL (1, LUNOUT) = LIMSTK (1, SPNT) LIMSTK (1, SPNT) = MIN (LIMTBL (1, LUNOUT) + LIMWID, 1 LIMSTK (2, SPNT)) LIMTBL (2, LUNOUT) = LIMSTK (1, SPNT) FILOPN (LUNOUT) = .FALSE. RECNUM (LUNOUT) = 0 2060 CONTINUE C Drop the curent set of limits from the stack. SPNT = SPNT - 1 C Open the input file. OPEN (UNIT=LUNIN, FILE=FILNAM, TYPE='OLD') C File_loop: C Read the next input record. 3000 CONTINUE READ (LUNIN, 3020, END=3900) RECLEN, RECORD 3020 FORMAT (Q, A) C Find out what output file this record goes in. DO 3040 LUNOUT = 1, NUMOUT - 1 IF (RECLEN .LT. LIMTBL (2, LUNOUT)) GO TO 3060 3040 CONTINUE LUNOUT = NUMOUT IF (RECLEN .GE. LIMTBL (2, LUNOUT)) THEN WRITE (LUNOUT, 1020) ' >>> Error - Record "', RECORD, 1 '" too long. Rejected.' GO TO 3000 END IF 3060 CONTINUE C If the file hasn't been opened yet C If the length range is greater than one C Shove the range on the stack C Form the file name accordingly C Open the file with variable length records. C else C Form the final output file name. C Open the file with fixed length records. C endif C and mark it open. C endif IF (.NOT. FILOPN (LUNOUT)) THEN IF (LIMTBL (2, LUNOUT) - 1 .GT. LIMTBL (1, LUNOUT)) THEN SPNT = SPNT + 1 LIMSTK (1, SPNT) = LIMTBL (1, LUNOUT) LIMSTK (2, SPNT) = LIMTBL (2, LUNOUT) WRITE (FILNAM, 2010) LIMSTK (1, SPNT), LIMSTK (2, SPNT) OPEN (UNIT=LUNTBL(LUNOUT), NAME=FILNAM, TYPE='NEW', 1 CARRIAGECONTROL='LIST') ELSE WRITE (FILNAM, 3070) LIMTBL (1, LUNOUT) 3070 FORMAT ('ANA', I2.2, '.TMP') OPEN (UNIT=LUNTBL(LUNOUT), NAME=FILNAM, TYPE='NEW', 1 FORM='FORMATTED', ACCESS='DIRECT', 2 RECL=LIMTBL(1, LUNOUT), CARRIAGECONTROL='LIST') RECNUM (LUNOUT) = 1 END IF FILLEN = INDEX (FILNAM, ' ') WRITE (LUNTO, 1020) ' Opened output file ', 1 FILNAM (:FILLEN) FILOPN (LUNOUT) = .TRUE. END IF C Write the record into the output file. IF (RECNUM (LUNOUT) .GT. 0) THEN WRITE (LUNTBL (LUNOUT)'RECNUM(LUNOUT), 1020) RECORD (:RECLEN) RECNUM (LUNOUT) = RECNUM (LUNOUT) + 1 ELSE WRITE (LUNTBL(LUNOUT), 1020) RECORD (:RECLEN) END IF C End of File_loop GO TO 3000 3900 CONTINUE C Close the output files DO 3920 LUNOUT = 1, NUMOUT IF (FILOPN (LUNOUT)) CLOSE (UNIT=LUNTBL(LUNOUT)) 3920 CONTINUE C Close and delete the input file. CLOSE (UNIT=LUNIN, DISPOSE='DELETE') C End of Main_loop IF (SPNT .GT. 0) GO TO 2000 9900 CONTINUE CALL EXIT END