C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
	SUBROUTINE TBLCLR(TABLE,NWORDS,NHITS)
C
C	CLEARS A TABLE OF HITS AND MISSES
C---------------------------------------------------------------------------
C
	INTEGER*4 TABLE(*)		!  table to store bit map
	integer NWORDS			!  number of words
	integer NHITS			!  number of selected cards (set bits)

C	MISS=0, HIT=1, EACH ENTRY HAS ONE BIT ASSOCIATED WITH IT
C
	DO N=1,NWORDS
	  TABLE(N) = 0
	ENDDO
	NHITS = 0
	RETURN
	END
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
	SUBROUTINE TBLSET(TABLE,NCARDS,NHITS)
C
C	SETS ALL BITS IN A TABLE OF HITS AND MISSES
C---------------------------------------------------------------------------
C
	INTEGER*4 TABLE(*)		!  table to store bit map
	integer NCARDS			!  number of expected cards
	integer NHITS			!  number of selected cards (set bits)

	NHITS = 0
	k = NCARDS/32
	DO N=1,K
	  TABLE(N) = -1
	  NHITS = NHITS + 32
	ENDDO
	N = MOD(NCARDS,32)
	TABLE(K+1) = 0
	DO J=0,n-1
	  TABLE(K+1) = IBSET(TABLE(K+1),J)
	  NHITS = NHITS + 1
	ENDDO
	RETURN
	END
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
	SUBROUTINE TBLCOUNT(TABLE,NWORDS,NHITS)
C
C	Counts the number of set bits in a table
C---------------------------------------------------------------------------
C
	INTEGER*4 TABLE(*)		!  table to store bit map
	integer NWORDS			!  number of cards
	integer NHITS			!  number of selected cards (set bits)
	INTEGER*4 NTABLE

	NHITS = 0
	DO 10 N=1,NWORDS
	  NTABLE = TABLE(N)
	  IF (NTABLE.EQ.0) GO TO 10
	  IF (NTABLE.EQ.-1) then
	        NHITS = NHITS + 32
		GO TO 10
	  ENDIF
	  DO J=0,31
	    IF (IBITS(NTABLE,J,1).EQ.1) NHITS = NHITS + 1
	  ENDDO
10	CONTINUE
	RETURN
	END
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
	SUBROUTINE TBLMOVE(TABLEi,TABLEo,NWORDS)
C
C	COPIES A TABLE OF HITS AND MISSES
C---------------------------------------------------------------------------
C
	INTEGER*4 TABLEi(*)		!  input bitmap table 
	INTEGER*4 TABLEo(*)		!  output bitmap table 
	integer NWORDS			!  number of words

	DO N=1,NWORDS
	  TABLEo(N) = TABLEi(N)
	ENDDO
	RETURN
	END
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
	SUBROUTINE TBLor(TABLE1,TABLE2,TABLEo,NWORDS)
C
C	Sets TABLEo = (TABLE1 .or. TABLE2)
C---------------------------------------------------------------------------
C
	INTEGER*4 TABLE1(*)		!  input bitmap table 
	INTEGER*4 TABLE2(*)		!  input bitmap table 
	INTEGER*4 TABLEo(*)		!  output bitmap table (may be same as
					!  either TABLE1 or TABLE2)
	integer NWORDS			!  number of words

	DO N=1,NWORDS
	  TABLEo(N) = Ior(TABLE1(N),TABLE2(N))
	ENDDO
	RETURN
	END
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
	SUBROUTINE TBLand(TABLE1,TABLE2,TABLEo,NWORDS)
C
C	Sets TABLEo = (TABLE1 .and. TABLE2)
C---------------------------------------------------------------------------
C
	INTEGER*4 TABLE1(*)		!  input bitmap table 
	INTEGER*4 TABLE2(*)		!  input bitmap table 
	INTEGER*4 TABLEo(*)		!  output bitmap table (may be same as
					!  either TABLE1 or TABLE2)
	integer NWORDS			!  number of words

	DO N=1,NWORDS
	  TABLEo(N) = Iand(TABLE1(N),TABLE2(N))
	ENDDO
	RETURN
	END
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
	SUBROUTINE TBLnot(TABLEi,TABLEo,NCARDS)
C
C	Sets TABLEo = (.not. TABLEi)
C---------------------------------------------------------------------------
C
	INTEGER*4 TABLEi(*)		!  input bitmap table 
	INTEGER*4 TABLEo(*)		!  output bitmap table (may be same as
					!  TABLEi)
	integer NCARDS			!  number of cards

	DO N=1,NWORDS
	  TABLEo(N) = NOT(TABLEi(N))
	ENDDO

	k = NCARDS/32
	DO N=1,K+1
	  TABLEo(N) = NOT(TABLEi(N))
	ENDDO
	N = MOD(NCARDS,32)
	DO J=n,31
	  TABLEo(K+1) = IBCLR(TABLEo(K+1),J)
	ENDDO

	RETURN
	END
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
	SUBROUTINE BITSET(TABLE,ISEQ,NCARDS,SETCLR)
C
C	Sets or clears the bit corresponding to a particular card
C---------------------------------------------------------------------------
C
	INTEGER*4 TABLE(*)		!  table to store bit map
	integer ISEQ 			!  Sequence number of card
	integer NCARDS			!  number of expected cards
	integer SETCLR			!  value to set (0 or 1)

	k = (iseq-1)/32
	N = MOD((iseq-1),32)
	If (ISEQ .gt. NCARDS) STOP 'BITSET ERROR -- illegal ISEQ value'
	IF (SETCLR .eq. 0) then 
	  TABLE(K+1) = IBCLR(TABLE(K+1),N)
	ELSE
	  TABLE(K+1) = IBSET(TABLE(K+1),N)
	ENDIF
	RETURN
	END
C---------------------------------------------------------------------------
C---------------------------------------------------------------------------
c	Function LENCH
c
c This function takes a character string and finds out how long the
c "actual" string is (i.e. not including padded blanks on the right).
c
C---------------------------------------------------------------------------
	integer function lench(string)
	character*(*) string
	character*1 nul
	data nul/0/
	lench=0
	if (string.eq.' '.or.string(1:1).eq.nul) return
	do lench=len(string),1,-1
	  if (string(lench:lench).ne.' '.and.string(lench:lench).ne.nul)
	1	return
	enddo
	lench=0
	return
	end
c----------------------------------------------------------------------------
	character*80 function brline(line,tlen,alen)
c----------------------------------------------------------------------------
C breaks a line at or before tlen; actual length is alen
	character*(*) line
	integer*4 tlen,alen

	alen = lench(line)
	brline = line
	if (alen .le. tlen) then 
	  line = ' '
	  return
	endif

	j = max(1,tlen/8)
	DO k=0,TLEN,J
	  Do i=max(1,tlen-k),MAX(1,tlen-j-k),-1
	    if (line(i:i) .eq. '/') then
	      alen = i-1
	      brline = line(1:i-1)
	      line = line(i:)
	      return
	    endif
	  enddo
	  Do i=max(1,tlen-k-1),MAX(1,tlen-j-k),-1
	    if (line(i:i) .eq. ',' .or. line(i:i) .eq. ')') then
	      alen = i
	      brline = line(1:i)
	      line = line(i+1:)
	      return
	    endif
	  enddo

	  Do i=max(1,tlen-k-1),MAX(1,tlen-j-k),-1
	    if (line(i:i) .eq. ' ') then
	      alen = i-1
	      brline = line(1:i-1)
	      line = line(i+1:)
	      return
	    endif
	  enddo
	ENDDO

C unable to breakup the line
	line = ' '
	return

	end
C!--------------------------------------------------------------
	Subroutine ps_Wait(W_time,prompt)
C Wait for W_TIME seconds, if PROMPT is .true.
C---------------------------------------------------------------
	LOGICAL PROMPT
	integer*4 LIB$WAIT
	integer*4 status
	real*4 W_time
	IF (PROMPT) status = LIB$WAIT(W_time)
	return
	end
C!--------------------------------------------------------------
	Subroutine PS_PAUSE(prompt)
C Pause for user to press RETURN, if PROMPT is .true.
C---------------------------------------------------------------
	LOGICAL PROMPT
	IF (PROMPT) THEN
	  WRITE(*,'(A)') '$Press RETURN to continue '
	  READ(*,'(A)',err=100)
	ENDIF
100	return
	end
C!--------------------------------------------------------------
      SUBROUTINE UPCASE(CHAR,NCHAR)
C Convert lowercase characters to uppercase (in byte array)
C!--------------------------------------------------------------
      BYTE CHAR(*)
      INTEGER NCHAR
      DO i=1,NCHAR
	if (char(i) .ge. "141 .and. char(i) .le. "172) 
	1	char(i) = char(i) - "40
      ENDDO
      RETURN
      END
