#-h- asplit.r        1781 asc 19-may-80 10:09:24
#-h- asplits.q        928 asc 19-may-80 10:06:02
 subroutine main

 character header(5), tag(FILENAMESIZE), buf(MAXLINE), clower,
	   file(FILENAMESIZE)
 integer getlin, i, getarg, nmatch, out, open, verbos, scline

 data header/SHARP, MINUS, LETH, MINUS, EOS/
 data tag(1)/EOS/

# call initr4
 verbos = NO
 for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1)
    if (buf(1) == MINUS & clower(buf(2)) == LETT)
	call scopy(buf, 3, tag, 1)
    else if (buf(1) == QMARK & buf(2) == EOS)
	call error("usage:  asplit [-tstring] [-v].")
    else if (buf(1) == MINUS & clower(buf(2)) == LETV)
	verbos = YES
    else
	call remark("Ignoring invalid argument.")
 out = STDOUT
 while (getlin(buf, STDIN) != EOF)
    if (nmatch(buf, 1, header) > 0)
	{
	call close(out)
	if (scline(buf, tag, file) == ERR)
	    call cant(buf)
	out = open(file, WRITE)
	if (out == ERR)
	    call cant(file)
	if (verbos == YES)
	    call remark(file)
	}
    else
	call putlin(buf, out)
# call endr4
 return
 end
#-h- scline.q         459 asc 19-may-80 10:06:04
 integer function scline(buf, tag, file)

 character buf(ARB), tag(ARB), file(ARB), type, c
 integer i, j

 for (i=1; buf(i) != BLANK; i=i+1) ;	# skip over header
 call skipbl(buf, i)			# skip over blanks
 c = type(buf(i))
 for (j=1; c == LETTER | c == DIGIT | c == PERIOD; j=j+1)
    {
    file(j) = buf(i)
    i = i + 1
    c = type(buf(i))
    }
 if (j == 1)
    scline = ERR
 else
    {
    call scopy(tag, 1, file, j)
    scline = OK
    }

 return
 end
#-h- nmatch.q         247 asc 19-may-80 10:06:05
 integer function nmatch(lin, from, pat)

 character lin(MAXLINE), pat(ARB)
 integer from, i, j

 i = from
 for (j=1; pat(j) != EOS; j = j + 1)
    {
    if (lin(i) != pat(j))
	{
	nmatch = 0
	return
	}
    i = i + 1
    }
 nmatch = i
 return
 end