C............................................................................. C C Walter L. Battaglia C YOLO EXPERT SOFTWARE C 1111 Kennedy Place, Suite 4 C Davis, CA 95616 C C (916) 758-8940 C C............................................................................. C C LICENSE & DISCLAIMER C C The programs and procedures described herein were designed and written by C Walter L. Battaglia (hereafter, the writer). The writer reserves the right C to make use of this material in other applications, and all rights of sale C and distribution. C C The writer herewith grants the right to use this program to the Digital C Equipment Computer User's Society (DECUS), its affiliates, and members. C C These programs and materials are distributed without warranty. The writer C assumes no liability whatever for their use in any application. C C............................................................................. C C ACKNOWLEDGEMENTS C C "DEC", "RT-11", "RSX-11/M", "VAX", "VMS", "VT52", "VT100", "VT220", "LA100", C "LA120", "PDP-11", and "LSI-11/23" are trademarks and/or products of the C DIGITAL EQUIPMENT CORP., MAYNARD, MASS. C C "TSX-PLUS" and "COBOL-PLUS" are trademarks and/or products of S&H COMPUTERS, C NASHVILLE, TENN. C C............................................................................. PROGRAM COLATE C C program to read input files and combine them into 1 output file C LOGICAL*1 OPEN1,OPEN2 C BYTE FILNAM(16) C INTEGER*2 IQ,BUFFER(256) C REAL*8 PROMPT C 1 CONTINUE TYPE 2 2 FORMAT (//////'1COLLATE FILES'/'0This program will read the & files you specify and combine them into ONE file'//' The & collation is block by block: you used DECOLLATE to make the & input files.'/) 10 CONTINUE C C get the output file name C OPEN1 = .FALSE. PROMPT = ' output ' CALL GETNAM (FILNAM,PROMPT,IQ) C C If no entry - program done C IF (IQ .LT. 1) GO TO 900 C C Open file with max space allocation C PAUSE 'Press when the output device is ready ...' C OPEN (UNIT=1,NAME=FILNAM,TYPE='NEW',ERR=300, &RECORDSIZE=128,CARRIAGECONTROL='NONE',FORM='UNFORMATTED', &ACCESS='DIRECT',ASSOCIATEVARIABLE=IBLK1,INITIALSIZE=-1) OPEN1 = .TRUE. IBLK1 = 1 ! Starting write block 30 CONTINUE OPEN2 = .FALSE. C PROMPT = ' input ' CALL GETNAM (FILNAM,PROMPT,IQ) ! Next input file C C If no entry - program done C IF (IQ .LT. 1) GO TO 900 C C See if file exists C OPEN (UNIT=2,NAME=FILNAM,TYPE='OLD',ERR=200,READONLY, &RECORDSIZE=128,CARRIAGECONTROL='NONE',FORM='UNFORMATTED', &ACCESS='DIRECT',ASSOCIATEVARIABLE=IBLK2,DISP='KEEP') OPEN2 = .TRUE. IBLK2 = 1 50 CONTINUE C C Read a block and transfer it to the output until none left C READ (2'IBLK2,ERR=100) (BUFFER(I),I=1,256) WRITE (1'IBLK1,ERR=800) (BUFFER(I),I=1,256) GO TO 50 C 100 CONTINUE TYPE 101 101 FORMAT (/' Input file ended. Waiting for next file.'/) 110 CONTINUE IF (OPEN2) CLOSE (UNIT=2) GO TO 30 C 200 CONTINUE TYPE 201 201 FORMAT (/' ? Unable to locate input file. Try another.'/) GO TO 110 C 300 CONTINUE TYPE 301 301 FORMAT (/' ? Unable to start new output file. Try another.') GO TO 10 C 800 CONTINUE TYPE 801 801 FORMAT (/' Error writing output file - deleted.'/) CLOSE (UNIT=1,DISP='DELETE') GO TO 960 C 900 CONTINUE TYPE 901 901 FORMAT (/' Program ends at your request.'/) 950 CONTINUE IF (OPEN1) CLOSE (UNIT=1) 960 CONTINUE IF (OPEN2) CLOSE (UNIT=2) PAUSE 'Press to continue ...' CALL EXIT END SUBROUTINE GETNAM (FILNAM,LINE,IQ) C C Subroutine to read terminal and get next file name C BYTE FILNAM(16),LINE(8) C INTEGER*2 IQ C 1 CONTINUE TYPE 2,(LINE(I),I=1,8) 2 FORMAT (/' Enter the device and file name of an ',8A1, &' file. Default: none'/' * ',$) READ (5,3,ERR=10) IQ,(FILNAM(I),I=1,14) 3 FORMAT (Q,16A1) IF (IQ .LT. 1) RETURN ! No file IF (IQ .LT. 3) GO TO 5 ! Name too short IF (IQ .GT. 14) GO TO 5 ! Name too long FILNAM (IQ+1) = "0 RETURN 5 CONTINUE TYPE 6 6 FORMAT (/' ? File name error. Too long or short.') 10 CONTINUE CALL TTERR GO TO 1 END SUBROUTINE TTERR C C Sends error message to terminal C TYPE 2 2 FORMAT (/' Terminal or entry error - re-specify.') RETURN END