%%s 0/0/0
%%d D 1.1 25-Mar-82 12:13:28 v1.1 1 0
%%c Version 1.1 is the Spring 1982 Distribution of the LBL/Hughes release
%%c of the Software Tools Virtual Operating System software and documentation.
%%T
%%I 1
#-h- sepfor.r        3879  asc  25-mar-82 08:40:07  v1.1 (sw-tools v1.1)
#-h- sepfor          1244  asc  25-mar-82 08:39:35  v1.1 (sw-tools v1.1)
### SepFor	Seperate FORTRAN programs into seperate files.
#		The main routine is assumed to come first.

DRIVER(sepfor)

character	c, lin(MAXLINE)
character	ifile(FILENAMESIZE), ofile(MAXLINE)
character	clower # function(s)
filedes		ifd, ofd
filedes		create, open # function(s)
integer		arg, junk, verbos
integer		getarg, getlin, isend, issubr # function(s)

verbos = NO
call query( "usage:  sepfor [-v] file ...")
for( arg = 1 ; getarg( arg, ifile, FILENAMESIZE) != EOF ; arg = arg + 1 )
{
  if( ifile(1) == '-' )
  {
    c = clower(ifile(2))
    if( c == 'v' )
      verbos = YES
    call delarg(arg)
    arg = arg - 1
    next
  }

  call domain( ifile, arg)	# Handle main program separately.

  ifd = open( ifile, READ)
  if( ifd == ERR )
    call cant(ifile)

  while( getlin( lin, ifd) != EOF )
  {
    if( issubr( lin, ofile) == YES )
    {
      ofd = create( ofile, WRITE)
      if( ofd == ERR )
        call cant(ofile)

      if( verbos == YES )
      {
        call putlin( ofile, STDOUT)
        call putch( '@n', STDOUT)
      }

      call putlin( lin, ofd)
      repeat
      {
        junk = getlin( lin, ifd)
        call putlin( lin, ofd)
      }
      until( isend(lin) == YES )
    }
    call close(ofd)
  }
}

DRETURN
end
#-h- domain           655  asc  25-mar-82 08:39:38  v1.1 (sw-tools v1.1)
### DoMain	Output the main routine into file MAINnn.

subroutine	domain( ifile, n)

character	lin(MAXLINE), num(MAXCHARS)
character	ifile(ARB), nam(MAXLINE), ofile(FILENAMESIZE)
filedes		ifd, ofd
filedes		create, open # function(s)
integer		junk, n
integer		getlin, issubr, itoc # function(s)
string		main "main"

junk = itoc( n, num, MAXCHARS)
call concat( main, num, ofile)

ofd = create( ofile, WRITE)
if( ofd == ERR )
  call cant(ofile)

ifd = open( ifile, READ)
if( ifd == ERR )
  call cant(ifile)

while( getlin( lin, ifd) != EOF )
{
  if( issubr( lin, nam) == YES )
    break

  call putlin( lin, ofd)
}
call close(ifd)
call close(ofd)

return
end
#-h- isend            534  asc  25-mar-82 08:39:39  v1.1 (sw-tools v1.1)
### IsEnd	Determine whether line marks the end of a routine.

integer		function isend(lin)

character	buf(MAXLINE), lin(ARB), wrd(MAXLINE)
integer		i, len
integer		equal, getwrd # function(s)
string		dostr  "do"
string		endstr "end"
string		ifstr  "if"

isend = NO
call strcpy( lin, buf)
call fold(buf)
i = 1
len = getwrd( buf, i, wrd)
if( len > 0 )
{
  if( equal( endstr, wrd) == YES )
    isend = YES
  if( getwrd( buf, i, wrd) > 0 )
    andif( equal( ifstr, wrd) == YES | equal( dostr, wrd) == YES )
      isend = NO
}

return
end
#-h- issubr          1154  asc  25-mar-82 08:39:42  v1.1 (sw-tools v1.1)
### IsSubr	Determine whether line starts subroutine or function.
#		Return name after removing any `$' or `_' characters.

integer		function issubr( lin, nam)

define(MAX_FILENAME_SIZE,10)	# Including EOS

character	buf(MAXLINE), lin(ARB), nam(ARB)
integer		i, j, len
integer		equal, getwrd, index # function(s)
string		func "function"
string		subr "subroutine"

nam(1) = EOS
call strcpy( lin, buf)
call fold(buf)
issubr = NO
i = 1
if( getwrd( buf, i, nam) > 0 )
{
  if( equal( nam, subr) == YES )
  {
    len = getwrd( buf, i, nam)
    issubr = YES
  }
  else if( getwrd( buf, i, nam) > 0 )
  {
    if( equal( nam, func) == YES )
    {
      len = getwrd( buf, i, nam)
      issubr = YES
    }
    else if( getwrd( buf, i, nam) > 0 )
      if( equal( nam, func) == YES )
      {
        len = getwrd( buf, i, nam)
        issubr = YES
      }
  }
}

if( issubr == YES )
{
  call strcpy( nam, buf)
  i = index( buf, '(')
  if( i > 0 )
    buf(i) = EOS

  j = 1
  for( i = 1 ; buf(i) != EOS ; i = i + 1 )
    if( buf(i) != '$' & buf(i) != '_' )
    {
      nam(j) = buf(i)
      j = j + 1
    }
  nam(j) = EOS
  nam(MAX_FILENAME_SIZE) = EOS
}

return
end
#-h- sepfor.fmt      1321  asc  25-mar-82 08:40:12  v1.1 (sw-tools v1.1)
.so ~bin/manhdr
.hd Sepfor (1) 22-Dec-81
Split FORTRAN programs into multiple files
.sy
sepfor [-v] file ...
.ds
Sepfor is useful for cracking large FORTRAN programs into separate files.
Each subroutine or function is placed in a file of the same name.
Names are stripped of any ``$'' and ``_'' characters they may contain.
The main program (which is assumed to precede the subroutines in the
source file) is named ``main<n>'' where <n> is the number of the file
argument.  In most cases there is only one file specified and the main
program is thus named ``main1''.

If the ``-v'' (verbose) option is specifed, Sepfor echoes the name of
each routine on STDOUT as it is processed.
.ex
sepfor -v spice.for
.fl
none
.im
Sepfor decides it has found a subroutine when it finds the keyword
``subroutine'' as the first word on a line.  It decides it has found
a function when it finds the keyword ``function'' as the the second
OR third word on a line.
The name is taken to be the first word following the keyword.
Sepfor decides it has found the end of a module when it discovers the
keyword ``end'' at the beginning of a line and it does NOT find the
keyword ``do'' or ``if'' immediately thereafter.
.au
Dave Martin (Hughes Aircraft)
.bu
Sepfor does not recognize ENDDO or ENDIF; you must separate the keywords
with a blank.
%%E 1