SUBROUTINE PACK(EIGHT,INEXT,SIX,NC,TERM)
C	Version 01.13

C  Routine to convert data packed in 8-bit format
C  from RDLIN, into 6-bit packed ascii
C  The array EIGHT contains the 8-bit data, which
C  is to be repacked, left justified,
C  into the array SIX. NC is the number of
C  characters to pack up. Receipt of a terminator
C  character (TERM(3)-TERM(N)) stops scanning of
C  characters out of the input buffer.
C  The array SIX will be packed up with spaces
C  to an even word boundary. The array TERM contains
C  the number of terminator characters, which follow TERM(2),
C  as the first element (TERM(1)),
C  a hole for a pointer to the actual value of the
C  terminator character recieved (TERM(2)), followed by
C  the list of characters, in ADE format, which are
C  to be used as terminator characters(TERM(3)-TERM(n)).
C  The absolute value of INEXT is stored as a pointer to the
C  next character to be fetched from IN, if INEXT is not 0.
C  The old value is used when INEXT is 0. INEXT is returned
C  returned bumped up to reflect the number of characters processed
C  whenever INEXT is positive, and not 0.


	COMMON /STRFUN/ IPTR
	INTEGER EIGHT(1),SIX(1),TERM(1)

	IF(INEXT.LT.0)IPTR=-INEXT
	IF(INEXT.GT.0)IPTR=INEXT

	ASSIGN 410 TO NEXT
	NWDS=((NC-1)/6+1)*3		!Number of 12-bit words
	NCHAR=1
	L1=0

 400 	ICHAR=GETWRD(EIGHT,IPTR,127)	!Load a character
	IPTR=IPTR+1			!Bump character count
	IF(ICHAR.EQ.32)GOTO 400		!Ignore leading spaces
	GOTO 412			!Skip fetching first character

 410 	ICHAR=GETWRD(EIGHT,IPTR,127)	!Loop here to get every other char.
	IPTR=IPTR+1			!Bump pointer
 412 	IF(ICHAR.GE.96)ICHAR=ICHAR-32	!Fold lower case

	DO 420 L2=3,TERM(1)+2		!Scan terminator list
	IF(ICHAR.EQ.ABS(TERM(L2)))GOTO 460	!Match ends input
 420 	CONTINUE			!Keep looking

	IF(ICHAR.GE.64)ICHAR=ICHAR-64	!Make 6-bit
	IF(NCHAR.EQ.NC)GOTO 462		!If equal, acts like terminator
	ITEMP=ICHAR*64			!Account for upper byteness
	NCHAR=NCHAR+1			!Bump character count

	ICHAR=GETWRD(EIGHT,IPTR,127)	!Get low order byte
	IPTR=IPTR+1
	IF(ICHAR.GE.96)ICHAR=ICHAR-32	!Fold lower case

	DO 425 L2=3,TERM(1)+2		!Look for terminator
	IF(ICHAR.EQ.ABS(TERM(L2)))GOTO 470	!Found one means stop
 425 	CONTINUE			!Keep looking

	IF(ICHAR.GE.64)ITEMP=ITEMP-64	!Make ICHAR 6-bit
	ITEMP=ICHAR+ITEMP		!Add together upper & lower bytes
	IF(NCHAR.EQ.NC)GOTO 471
	NCHAR=NCHAR+1
 440 	L1=L1+1				!Bump index into SIX
	CALL PUTWRD(SIX,L1,ITEMP)	!Store a 6-bit packed word
	IF(NWDS.GT.L1)GOTO NEXT

 450 	DO 451 L2=3,TERM(1)+2		!Used up NC characters
	IF(ICHAR.EQ.ABS(TERM(L2)))GOTO 452	!Now look for terminator
 451 	CONTINUE			!Fall out bottom if no match

	ICHAR=GETWRD(EIGHT,IPTR,127)	!Next character
	IPTR=IPTR+1
	GOTO 450			!Loop till terminator found

 452 	TERM(2)=L2			!Return value of terminator
	IF(INEXT.GT.0)INEXT=IPTR	!Return pointer if INEXT +
	RETURN				!Back to calling routine

 460 	IF(TERM(L2).LT.0)GOTO 462	!We must move the terminator
 461 	ITEMP=2080			!Set all characters to spaces
	ASSIGN 440 TO NEXT		!Set end flag
	GOTO 440			!Go stuff word

 462 	ITEMP=ICHAR*64+32
	GOTO 471

 470 	ITEMP=ITEMP+32			!Make low byte a space
	IF(TERM(L2).LT.0)ITEMP=ITEMP-TERM(L2)-32
 471 	ASSIGN 461 TO NEXT		!Mark all spaces from now on
	GOTO 440			!Go stuff character+space