C	MERGTAB -- PROGRAM TO MERGE ONE TABLE INTO ANOTHER
C	THE TABLES MUST AGREE IN RECORD LENGTHS, # OF COLUMNS, AND
C	LENGTH OF EACH COLUMN.
C
C  Submitted by:
C  
C  	R. N. Stillwell
C  	Institute for Lipid Research
C  	Baylor College of Medicine
C  	Houston, Texas 77030
C  	
C  (who would be glad to receive comments, suggestions, bug fixes, etc., but
C  who promises no support whatever).
C  
C  Literature reference:
C  
C  	R. N. Stillwell.  A low-overhead laboratory data management system
C  	for the PDP11.  Comput. Biomed. Res., 15, 29-38(1982).
C  
C  Acknowledgement:
C
C  	This software was developed under National Institutes of Health grants
C  	GM-13901 and GM-26611.
C 
C  General permission is hereby granted to copy, modify, or distribute this
C  program, but not for profit.  Copyright to this software is and shall
C  remain in the public domain.
C
C
	INTEGER OFFSET,OFFSE2
	BYTE PREF(6)		!TABLE PREFIX CONTAINING '-' AND NULLS
	BYTE ZERO1(10),ZERO2(10)!ZERO-TH COLUMN HEADERS
	INTEGER LEN(40)		!LENGTH OF COLUMN (I)
	INTEGER IPTRD(41)	!POINTER TO START OF DATA FOR COL(I)
	INTEGER IPTRD2(41)
C
	COMMON/IVAR/ IVAR
C
	LOGICAL*1 IERR,DELETR
	BYTE FILNAM(20)
	BYTE DATA(1000)
	INTEGER NCOLS
	DATA MAXREC /32767/
C
	GET-TABLE-NAMES
	GET-RECORD-NUMBERS
	COMPARE-TABLE-CHARACTERISTICS
	IF (N1.GT.NREC) REPORT-RECORD-NUMBER-ERROR
	UPDATE-TAB-FILE
	CALL-EXIT
	STOP	!!
C
	TO GET-TABLE-NAMES
	WRITE (5,1)
1	FORMAT (' Merging a subtable into an old table.'//'$Old table: ')
	READ (5,2) LTNAM,FILNAM
2	FORMAT (Q,20A1)
	LTNAM = LTNAM+1
	FILNAM(LTNAM) = 0
	OPEN-OLD-TABLE
	IF (IERR) STOP
	WRITE (5,3)
3	FORMAT ('$Subtable: ')
	READ (5,2) LTNAM,FILNAM
	LTNAM = LTNAM+1
	FILNAM(LTNAM) = 0
	OPEN-SUBTABLE
	FIN
C
	TO GET-RECORD-NUMBERS
	REPEAT UNTIL (LTNUM.NE.0.AND.N1.GE.-1)
	WRITE (5,4)
4	FORMAT (' Insert records from subtable after record #:'/
	1 ' (-1 for insert at beginning of table, 0 for insert'/
	1 '$at end of table): ')
	READ (5,5) LTNUM,N1
5	FORMAT (Q,I8)
	FIN
	WRITE (5,6)
6	FORMAT ('$Delete subtable after merging? ')
	READ (5,7) DELETR
7	FORMAT (A1)
	DELETR = DELETR.EQ.'Y'.OR.DELETR.EQ.'y'
	FIN
C
	TO OPEN-OLD-TABLE
C	SET UP FILENAME OF DESCRIPTOR FILE
	IF (LTNAM.GT.10.OR.LTNAM.LE.1)
	WRITE (5,105)
105	FORMAT (' INVALID TABLE NAME')
	IERR = .TRUE.
	CALL EXIT
	FIN
	CALL MVSTR(FILNAM(LTNAM),'.TAI;1')
	OPEN (UNIT=1,ACCESS='SEQUENTIAL',DISP='KEEP',
	1 ERR=150,FORM='UNFORMATTED',NAME=FILNAM,TYPE='OLD')
	READ (1) LENREC,NCOLS
	LENWDS = (LENREC+1)/2
	CALL MVSTR(FILNAM(LTNAM),'.TAB;1')
	OPEN (UNIT=2,ACCESS='DIRECT',DISP='KEEP',
	1 ERR=150,FORM='UNFORMATTED',NAME=FILNAM,TYPE='OLD')
	IF (.FALSE.)
150	WRITE (5,151) (FILNAM(I),I=1,LENGTH(FILNAM)-1)
151	FORMAT (' Cannot open file ',40A1)
	CALL EXIT
	FIN
	FIN
	TO OPEN-SUBTABLE
C	SET UP FILENAME OF DESCRIPTOR FILE
	IF (LTNAM.GT.10.OR.LTNAM.LE.1)
	WRITE (5,105)
	CALL EXIT
	FIN
	CALL MVSTR(FILNAM(LTNAM),'.TAI;1')
	OPEN (UNIT=3,ACCESS='SEQUENTIAL',DISP='KEEP',
	1 ERR=150,FORM='UNFORMATTED',NAME=FILNAM,TYPE='OLD')
	READ (3) LENRE2,NCOLS2
	CALL MVSTR(FILNAM(LTNAM),'.TAB;1')
	OPEN (UNIT=4,ACCESS='DIRECT',DISP='KEEP',
	1 ERR=150,FORM='UNFORMATTED',NAME=FILNAM,TYPE='OLD')
	FIN
	TO COMPARE-TABLE-CHARACTERISTICS
	IF (LENRE2.NE.LENREC) REPORT-INCOMPATIBILITY
	IF (NCOLS2.NE.NCOLS) REPORT-INCOMPATIBILITY
	READ (1)	! IPTRH1,IPTRH2
	READ (3)	! IPTRH1,IPTRH2
	READ (1)	! L,(DATA(I),I=1,L)	!HEAD1
	READ (3)	! L,(DATA(I),I=1,L)
	READ (1)	! L,(DATA(I),I=1,L)	!HEAD2
	READ (3)	! L,(DATA(I),I=1,L)
	READ (1)	! L,(DATA(I),I=1,L)	!TITLE
	READ (3)	! L,(DATA(I),I=1,L)
	READ (1)	! L,(DATA(I),I=1,L)	!SUBTL
	READ (3)	! L,(DATA(I),I=1,L)
	READ (1) LEN,IPTRD
	READ (3) LEN,IPTRD2
	DO (I=1,NCOLS+1)
	IF (IPTRD(I).NE.IPTRD2(I)) REPORT-INCOMPATIBILITY
	FIN
	READ (1) OFFSET,PREF
	READ (3)	! OFFSE2,PREF
	READ (1) ZERO1,ZERO2
	READ (3)	! ZERO1,ZERO2
	READ (1) NREC
	READ (3) NREC2
D	WRITE (5,9901) NREC,NREC2
D9901	FORMAT (' NREC, NREC2:',2I8)
	BACKSPACE 1
	FIN
	TO UPDATE-TAB-FILE
	NINS = NREC2
	SELECT (N1)
	(-1)
C	INSERT RECORDS AT BEGINNING OF TABLE
	NN = 0
	MOVE-OLD-RECORDS-UP
	DO (IREC = 1,NINS)
	READ (4'IREC) (DATA(I),I=1,LENREC)
	WRITE (2'IREC) (DATA(I),I=1,LENREC)
	FIN
	OFFSET = OFFSET-NINS
	IF (OFFSET.LT.0) OFFSET = 0
	BACKSPACE 1
	BACKSPACE 1
D	WRITE (5,9903) OFFSET
D9903	FORMAT (' NEW OFFSET:',I6)
	WRITE (1) OFFSET,PREF
	WRITE (1) ZERO1,ZERO2
	NREC = NREC+NINS
D	WRITE (5,9904) NREC
D9904	FORMAT (' NEW NREC:',I6)
	WRITE (1) NREC
	FIN
	(0)
C	INSERT RECORDS AT END OF TABLE
C	TRY A READ FIRST
	READ (2'NREC) (DATA(I),I=1,LENREC)
	DO (IREC = 1,NINS)
	READ (4'IREC) (DATA(I),I=1,LENREC)
	WRITE (2'NREC+IREC) (DATA(I),I=1,LENREC)
	FIN
	NREC = NREC + NINS
D	WRITE (5,9904) NREC
	WRITE (1) NREC
	FIN
	(OTHERWISE)
C	INSERT IN MIDDLE
	NN = N1-OFFSET
	MOVE-OLD-RECORDS-UP
	DO (IREC = 1,NINS)
D	WRITE (5,9905) IREC,NN+IREC
D9905	FORMAT (' COPYING RECORD',I6,' TO',I6)
	READ (4'IREC) (DATA(I),I=1,LENREC)
	WRITE (2'NN+IREC) (DATA(I),I=1,LENREC)
	FIN
	NREC = NREC + NINS
D	WRITE (5,9904) NREC
	WRITE (1) NREC
	FIN
	FIN
	FIN
	TO MOVE-OLD-RECORDS-UP
	IF (NN.LT.NREC)
	DO (IREC = NREC,NN+1,-1)
D	WRITE (5,9902) IREC,IREC+NINS
D9902	FORMAT (' MOVING RECORD',I5,' TO',I5)
	READ (2'IREC) (DATA(I),I=1,LENREC)
	WRITE (2'IREC+NINS) (DATA(I),I=1,LENREC)
	FIN
	FIN
	FIN
	TO REPORT-RECORD-NUMBER-ERROR
	WRITE (5,101) N1,OFFSET+1,OFFSET+NREC
101	FORMAT (' Illegal record number: ',I6/
	1 ' Table has records,',I6,' to',I6,' only.')
	CALL EXIT
	FIN
	TO REPORT-INCOMPATIBILITY
	WRITE (5,103)
103	FORMAT (' The two tables differ in the number or lengths of their'/
	1 ' columns.  They cannot be merged.')
	CALL EXIT
	FIN
	TO CALL-EXIT
	CLOSE (UNIT=1)
	CLOSE (UNIT=2)
	WHEN (DELETR)
	CLOSE (UNIT=3,DISP='DELETE')
	CLOSE (UNIT=4,DISP='DELETE')
	FIN
	ELSE
	CLOSE (UNIT=3,DISP='KEEP')
	CLOSE (UNIT=4,DISP='KEEP')
	FIN
	WRITE (5,102)
102	FORMAT (' Tables have been merged.')
	CALL EXIT
	FIN
	END