#
#
#
#      *******************************************************
#      *                                                     *
#      *      THIS SOFTWARE WAS DEVELOPED WITH SUPPORT       *
#      *      FROM THE NATIONAL INSTITUTES OF HEALTH:        *
#      *         NIH CA06927                                 *
#      *         NIH CA22780                                 *
#      *                                                     *
#      *      DIRECT INQUIRIES TO:                           *
#      *            COMPUTER CENTER                          *
#      *            THE INSTITUTE FOR CANCER RESEARCH        *
#      *            7701 BURHOLME AVENUE                     *
#      *            PHILADELPHIA, PENNSYLVANIA   19111       *
#      *                                                     *
#      *      NO WARRANTY OR REPRESENTATION, EXPRESS OR      *
#      *      IMPLIED, IS MADE WITH RESPECT TO THE           *
#      *      CORRECTNESS, COMPLETENESS, OR USEFULNESS       *
#      *      OF THIS SOFTWARE, NOR THAT USE OF THIS         *
#      *      SOFTWARE MIGHT NOT INFRINGE PRIVATELY          *
#      *      OWNED RIGHTS.                                  *
#      *                                                     *
#      *      NO LIABILITY IS ASSUMED WITH RESPECT TO        *
#      *      THE USE OF, OR FOR DAMAGES RESULTING FROM      *
#      *      THE USE OF THIS SOFTWARE                       *
#      *                                                     *
#      *******************************************************
#      *                                                     *
#      *      THIS SOFTWARE WAS DESIGNED FOR USE ON A        *
#      *      PDP-11/70 OPERATING UNDER IAS V3.0 USING       *
#      *      THE FORTRAN-IV PLUS COMPILER.                  *
#      *                                                     *
#      *******************************************************
#
#
#
define(LF,10)
define(CR,13)
define(FF,12)
define(EOS,0)
# tru - truncate files
program tru
byte cmdlin(80), prompt(7)
integer nc
data prompt /CR, LF, 'T', 'R', 'U', '>', ' '/

repeat {
  call gtlin(cmdlin, nc, 1, prompt, 7, .true., .false.)
  if (nc <= 0)
    break
  cmdlin(nc+1) = EOS
  call trufil(2, cmdlin)
  }
end

#
#   THIS ROUTINE CALLS RUNSYS, WHICH SUBTASKS PIP TO CREATE
#   A FILE, @remclak.166, WITH THE FILES SELECTED BY PIP IN IT.
#   IF THE FILE FORMAT PRODUCED BY YOUR PIP IS DIFFERENT, THIS
#   ROUTINE WILL HAVE TO BE MODIFIED.
#
define(MAXLINE,134)
define(PARENLOC,1)
subroutine trufil(lun, pipfil)
byte pipfil(MAXLINE), pip(MAXLINE), tmp(MAXLINE), filenm(19)
integer lun, nc, l, ier, dig, sl, dot
integer concat, index, bkscan
real secnds
logical eq
 
encode(18,('LB:[12,1]'f9.3),filenm) secnds(0.0)	#refer to REMCLAK.DOC
filenm(19) = EOS
call scopy('PIP ', 1, pip, 1)
l = concat(pip, filenm, MAXLINE)
l = concat(pip, '=', MAXLINE)
l = concat(pip, pipfil, MAXLINE)
l = concat(pip, '/DI/FU', MAXLINE)
call runsys(pip, l, ier)
pipfil(index(pipfil,':')+1) = EOS
if (ier ~= 0)
  goto 10
close(unit = lun)
call waitsy
open(unit=lun, name=filenm, dispose='delete', type='old', err=10)
l = 0
repeat {
  repeat {
    call get(lun, tmp, MAXLINE-1, nc)
    if (nc <= 0)
      break
    if (tmp(PARENLOC) == '(')
      break
    }
  if (nc >= 3) {
    tmp(nc+1) = EOS
    nc = index(tmp,')')
    dig = bkscan(tmp, '0123456789', nc)
    sl = bkscan(tmp, '/', dig)
    dot = bkscan(tmp, '.', sl)
    tmp(sl-1) = EOS
    tmp(dot) = EOS
    if (!eq(tmp(dig),tmp(sl+1))) {
      if (l == 0) {
	call scopy('PIP ', 1, pip, 1)
	l = concat(pip,pipfil,MAXLINE)
	l = concat(pip,'/TR',MAXLINE)
	}
      else
	l = concat(pip, ',', MAXLINE)
      l = concat(pip, '/FI:', MAXLINE)
      tmp(index(tmp,',')) = ':'
      tmp(nc) = EOS
      l = concat(pip, tmp(PARENLOC+1), MAXLINE)
      if (l > 63) {
#	write(5,(1x,<l>a1)) (pip(j),j=1,l)
	call runsys(pip, l, ier)
	l = 0
	}
      }
    }
  else if (nc < 0)
    break
  }
if (l != 0)
  call runsys(pip,l,ier)
#	write(5,(1x,<l>a1)) (pip(j),j=1,l)
call waitsy
return
10 continue
n = -1
return
end

define(ARB,1)
define(EOS,0)
define(character,byte)
# index - find character  c  in string  str
   integer function index(str, c)
   character c, str(ARB)
   for (index = 1; str(index) ~= EOS; index = index + 1)
      if (str(index) == c)
         return
   index = 0
   return
   end
# scopy - copy string at from(i) to to(j)
   subroutine scopy(from, i, to, j)
   character from(ARB), to(ARB)
   integer i, j, k1, k2
   k2 = j
   for (k1 = i; from(k1) ~= EOS; k1 = k1 + 1) {
      to(k2) = from(k1)
      k2 = k2 + 1
      }
   to(k2) = EOS
   return
   end
# concat - concatenate two strings
   integer function concat(s1,s2,lim)
   character s1(ARB),s2(ARB)
   integer lim, i, length, l
   l = length(s1)
   for (i=l+1; i<lim & s2(i-l) ~= EOS; i=i+1) s1(i) = s2(i-l)
   s1(i) = EOS
   concat = i-1
   return
   end
# bkscan - return index of first break char in str
  integer function bkscan(str, brk, i)
  character str(ARB), brk(ARB)
  integer index, i
  for (bkscan = i; str(bkscan) ~= EOS; bkscan = bkscan+1)
    if (index(brk, str(bkscan)) ~= 0) break
  return
  end
# eq - compare str1 to str2; return .true. if equal, .false. if not
   logical function eq(str1, str2)
   character str1(ARB), str2(ARB)
   integer i
   for (i = 1; str1(i) == str2(i); i = i + 1)
      if (str1(i) == EOS)
         return(.true.)
   return(.false.)
   end
# length - compute length of string
   integer function length(str)
   character str(ARB)
   for (length = 0; str(length+1) ~= EOS; length = length + 1)
      ;
   return
   end