c
c     Program to read a FORTRAN program and produce
c     an indented listing showing levels of nesting.
c
c     This program was originally written by Dr. Ann Copeland
c     of the Georgia Tech Research Institute.  Mark Paulk at
c     SDC Huntsville made certain modifications (DCL tables,
c     /NOLIST format, etc.).  For info on the command line
c     interface, see SET COMMAND and Utilities Manual section
c     on the DCL editor.
c
c     MODS:
c     linein extended to 132 characters to allow for long comments
c     problem was fortran variable mismatch on read with long comment
c     MCP 25 Oct 82
c     for lines longer than 72 check for comment before splitting and
c     making continuation
c     MCP 26 Oct 82
c     add check for ! type of comments - dont continue them
c     MCP 1 Nov 82
c
c     Assumption:
c     The .FOR file submitted as input has
c     compiled successfully.
c
      logical success
      logical end_flag
      character source_file*72
      integer cli$get_value,cli$present
c
c     Functions.
c
      integer dedent_word
      logical compare
      logical space
c
c     Commons.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
      common/split/line_continue,continue_length,start
      character line_continue*132
      integer continue_length,start
c
      common/listing/comment_flag,list_flag,indenter
      logical comment_flag,list_flag
      character indenter*3
c
      common/error/err_num,num_parens,quote_out
      integer err_num,num_parens
      logical quote_out
c
      common/chars/blank,zero
      integer blank,zero
c
c     Datas.
c
      character letter_c
      data letter_c/'C'/
c
c     Start of executable code.
c
c     Initialization.
c
      end_flag = .false.
      indent = 0
      next_line = 0
      stack_pointer = 0
      err_num = 0
      blank = ichar(' ')
      zero = ichar('0')
c
c     Examine command line for source file name.
c
      call cli$get_value('P1', source_file)
      i = index (source_file,'.')
      if (i .eq. 0) i = index (source_file, ' ')
      source_file = source_file(1:i-1) // '.FOR'
      open (unit=5,name=source_file,type='old',readonly)
      list_flag = cli$present('LIST')
c
c     Determine if /LIST option present.
c
      if (list_flag) then
      .  i = index (source_file, '.')
      .  source_file = source_file(1:i-1) // '.LIS'
      else
      .  indenter(1:1) = ' '
      end if
      open (unit=4,name=source_file,type='new',
     &carriagecontrol='list')
c
c     Determine if /COMMENT_INDENT option present.
c
      comment_flag = .not. cli$present('COMMENT_INDENT')
c
c     Start reading input file on unit FOR005.
c
      read(5,10,end=1000) in_length,(linein(i:i),i=1,in_length)
   10 format(q,132a1)
    1 continue
d     write(6,11) in_length
   11 format(' in main in_length = ',i3)
c
c     Check for blank line.
c
      if (in_length .gt. 0) then
c
c     .  Strip leading spaces.
c     .  Leave comment lines alone.
c
      .  if((.not. comment_flag) .or.
     &.  (comment_flag) .and.
     &.  (.not. compare(linein(1:1),letter_c))) then
      .  .  call place
c
c     .  .  Check to see if an unprinted error was encountered
c     .  .  on the last statement.
c     .  .  If so, then check to see if this is a continued line which
c     .  .  might resolve error.
c
      .  .  if (err_num .ne. 0) then
      .  .  .  if (space(linein(6:6))) then
      .  .  .  .  call error(err_num)
      .  .  .  .  err_num = 0
      .  .  .  end if
c
c     .  .  .  Check to see if this line should be dedented.
c     .  .  .  Dedentation is defined to be the inverse of indentation.
c
      .  .  else
      .  .  .  if ((in_length .ge. 7) .and.
     &.  .  .  (.not. compare(linein(1:1),letter_c))) then
      .  .  .  .  indent = indent + dedent_word(end_flag)
      .  .  .  end if
      .  .  end if
      .  end if
c
c     .  Check to see if next line should be indented one more level.
c
      .  if ((in_length .ge. 7 ) .and.
     &.  (.not. compare(linein(1:1),letter_c)))
     &.  call indent_word(next_line)
c
c     .  Write out line with proper levels of indentation on FOR004.
c
      .  if ((indent .eq. 0) .or. (in_length .le. 6) .or.
     &.  (comment_flag .and. compare(linein(1:1),letter_c))) then
      .  .  write(4,20) (linein(i:i),i=1,in_length)
      .  else
c
c     .  .  Move line over for indentation before writing.
c     .  .  Don't try to continue comments.
c
   12 .  .  call nest(indent)
      .  .  if ((out_length .gt. 72) .and. (.not. list_flag)
     &.  .  .and. (lineout(1:1) .ne. 'C') .and.
     &.  .  (lineout(1:1) .ne. 'c') ) then
      .  .  .  write(6,15) (lineout(i:i),i=1,out_length)
   15 .  .  .  format(' %length>72 ->',132a1)
      .  .  .  call split(success)
      .  .  .  if (success) then
      .  .  .  .  write(4,20) (lineout(i:i),i=1,out_length)
   20 .  .  .  .  format(132a1)
      .  .  .  .  do i = 1,continue_length
      .  .  .  .  .  linein(i:i) = line_continue(i:i)
      .  .  .  .  end do
      .  .  .  .  in_length = continue_length
      .  .  .  .  goto 12
      .  .  .  else
      .  .  .  .  write(4,20) (linein(i:i),i=1,in_length)
      .  .  .  end if
      .  .  else
      .  .  .  write(4,20) (lineout(i:i),i=1,out_length)
      .  .  end if
      .  end if
c
c     .  Update count of indentation level based on last line read.
c
      .  indent = indent + next_line
      .  next_line = 0
      .  if (indent .lt. 0) then
      .  .  call error(1)
      .  .  indent = 0
      .  end if
      .  if (indent .gt. 17) call error(6)
      else
      .  write(4,20)
      end if
c
c     Read next line and see if it begins a new program unit.
c
      read(5,10,end=1000) in_length,(linein(i:i),i=1,in_length)
      if (end_flag) then
      .  write(4,30)
   30 .  format(/////)
      .  end_flag = .false.
      .  indent = 0
      .  next_line = 0
      .  stack_pointer = 0
      .  err_num = 0
      end if
      goto 1
 1000 stop
      end






c
c     Convert statement label in columns 1-5 into integer value.
c     Return 0 (zero) if all spaces.
c
      integer function label()
c
      integer save(5)
c
c     Function.
c
      logical space
c
c     Commons.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
      common/chars/blank,zero
      integer blank,zero
c
c     Executable code.
c
d     write(6,1)
    1 format(' in label')
c
      label = 0
c
c     Strip spaces.
c
      j = 0
      do i = 1,5
      .  if (.not. space(linein(i:i))) then
      .  .  j = j + 1
      .  .  save(j) = ichar(linein(i:i)) - zero
d     .  .  write(6,11) j,save(j)
   11 .  .  format(' save(',i1,') = ',i10)
      .  end if
      end do
c
c     If all spaces, then return 0 (zero).
c
      if (j .eq. 0) then
      .  return
      else
c
c     .  Convert to integer.
c
      .  do i = 1,j
      .  .  label = label * 10 + save(i)
      .  end do
      .  return
      end if
      end






c
c     Surtoutine to determine if the next line should be
c     indented one more level.
c
      subroutine indent_word(next_line)
c
      logical flag
      integer last
      integer num_spaces
c
c     Functions.
c
      logical match
      integer do_label
      logical space
c
c     Commons.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
      common/stack/do_stack,stack_pointer
      integer do_stack(20),stack_pointer
c
      common/error/err_num,num_parens,quote_out
      integer err_num,num_parens
      logical quote_out
c
c     Datas.
c
c     List of possible words after which indentation occurs.
c     IF (THEN)
c     ELSE
c     DO (includes DO WHILE)
c
      character if*2,then*4,else*4,do*2
      data if/'IF'/
      data then/'THEN'/
      data else/'ELSE'/
      data do/'DO'/
c
c     Executable code.
c
d     write(6,1)
    1 format(' in indent')
      next_line = 0
c
c     Check for IF of continued IF.
c
      if ((err_num .ne. 0) .or. match(7,if,2)) then
c
c     .  Last word on executable part of statement must be THEN.
c
      .  call log_expr(last)
      .  if (((last + 3) .gt. in_length) .or. (err_num .ne. 0)) return
      .  if (match(last,then,4)) then
      .  .  next_line = 1
      .  .  return
      .  else
      .  .  return
      .  end if
      end if
c
c     Check for ELSE.
c
      if (match(7,else,4)) then
      .  next_line = 1
      .  return
      end if
c
c     Check for DO.
c
      if ((match(7,do,2)) .and. (space(linein(9:9)))) then
      .  next_line = 1
c
c     .  One entry on stack for each DO.
c     .  Entry is statement label for DO-loops with labels.
c     .  Entry is 0 (zero) for DO-loops without labels and
c     .  DO-WHILEs.
c
c     .  Stack statement label.
c
      .  stack_pointer = stack_pointer + 1
      .  do_stack(stack_pointer) = do_label()
      .  return
      end if
      return
      end






c
c     Function to compare two strings for match.
c
      logical function match(start,word,word_length)
      integer start
      character word*(*)
      integer word_length
c
      integer col
c
c     Function.
c
      logical compare
c
c     Common.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
c     Executable code.
c
d     write(6,1)
    1 format(' in match')
      match = .false.
      col = start
      do i = 1,word_length
      .  if (.not. compare(linein(col:col),word(i:i))) return
      .  col = col + 1
      end do
      match = .true.
      return
      end






c
c     Function to compare two characters for match.
c
      logical function compare(letter,upper_case_value)
      character letter,upper_case_value
c
      character lower_case_value
c
c     Common.
c
      common/chars/blank,zero
      integer blank,zero
c
c     Executable code.
c
d     write(6,1)
    1 format(' in compare')
      lower_case_value = char(ichar(upper_case_value) + blank)
      compare = ((letter .eq. upper_case_value) .or.
     &(letter .eq. lower_case_value))
      return
      end






c
c     Function to determine if the current line should be
c     dedented a level (i.e., indented one less level).
c
      integer function dedent_word(end_flag)
      logical end_flag
c
c     Functions.
c
      logical match
      integer label
      logical space
c
c     Commons.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
      common/stack/do_stack,stack_pointer
      integer do_stack(20),stack_pointer
c
c     Datas.
c
c     List of possible words after which dedentation occurs.
c     label for end of DO-loop
c     END (IF or DO)
c     ELSE (includes ELSE IF THEN)
c
      character end*3,if*2,do*2,else*4
      data end/'END'/
      data if/'IF'/
      data do/'DO'/
      data else/'ELSE'/
c
c     Executable code.
c
d     write(6,1)
    1 format(' in dedent')
      dedent_word = 0
c
c     Check for end of DO-loop.
c
      line_number = label()
      if (line_number .ne. 0) then
c
c     .  Check for matching stack statement label.
c
      .  if (stack_pointer .gt. 0) then
  100 .  .  if (line_number .eq. do_stack(stack_pointer)) then
      .  .  .  dedent_word = dedent_word - 1
      .  .  .  stack_pointer = stack_pointer - 1
      .  .  .  if (stack_pointer .gt. 0) goto 100
      .  .  .  return
      .  .  end if
      .  end if
      end if
c
c     Check for END.
c
      if (match(7,end,3)) then
c
c     .  Check for IF or DO as next word.
c
      .  if (in_length .ge. 10) then
      .  .  do i = 10,in_length
      .  .  .  if (.not. space(linein(i:i))) then
      .  .  .  .  if (match(i,if,2)) then
      .  .  .  .  .  dedent_word = -1
      .  .  .  .  else
      .  .  .  .  .  if (match(i,do,2)) then
      .  .  .  .  .  .  if (do_stack(stack_pointer) .eq. 0) then
      .  .  .  .  .  .  .  stack_pointer = stack_pointer - 1
      .  .  .  .  .  .  .  dedent_word = -1
      .  .  .  .  .  .  else
      .  .  .  .  .  .  .  if (do_stack(stack_pointer) .ne.
     &.  .  .  .  .  .  .  label()) then
      .  .  .  .  .  .  .  .  call error(2)
      .  .  .  .  .  .  .  else
      .  .  .  .  .  .  .  .  stack_pointer = stack_pointer - 1
      .  .  .  .  .  .  .  .  dedent_word = -1
      .  .  .  .  .  .  .  end if
      .  .  .  .  .  .  end if
      .  .  .  .  .  end if
      .  .  .  .  end if
      .  .  .  .  return
      .  .  .  end if
      .  .  end do
      .  else
      .  .  if (in_length .eq. 9) then
      .  .  .  if (stack_pointer .ne. 0) then
      .  .  .  .  call error(3)
      .  .  .  .  stack_pointer = 0
      .  .  .  end if
      .  .  .  end_flag = .true.
      .  .  end if
      .  end if
      .  return
      end if
c
c     Check for ELSE.
c
      if (match(7,else,4)) then
      .  dedent_word = -1
      .  return
      end if
      return
      end






c
c     Subroutine to change first tab in columns 1-6 to blanks and
c     to left-justify columns of line past column 6 in column 7.
c
      subroutine place
c
      integer copy_pointer
      integer loop_end,add_columns
c
c     Functions.
c
      logical space
      logical compare
c
c     Common.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
c     Datas.
c
      character letter_c
      data letter_c/'C'/
      character tab
      data tab /'	'/
c
c     Executable code.
c
d     write(6,1)
    1 format(' in place')
c
c     Check to see if a comment line.
c
      if (compare(linein(1:1),letter_c)) then
      .  if (in_length .le. 1) return
      .  do i = 2,in_length
      .  .  if (.not. space(linein(i:i))) goto 50
      .  end do
      .  return
   50 .  if (i .gt. 7) then
      .  .  in_length = in_length - i + 7
      .  .  do j = 7,in_length
      .  .  .  k = j + i - 7
      .  .  .  linein(j:j) = linein(k:k)
      .  .  end do
      .  else
      .  .  if (i .lt. 7) then
      .  .  .  in_length = in_length - i + 7
      .  .  .  do j = in_length,7,-1
      .  .  .  .  k = j + i - 7
      .  .  .  .  linein(j:j) = linein(k:k)
      .  .  .  end do
      .  .  end if
      .  end if
      .  do j = 2,6
      .  .  linein(j:j) = ' '
      .  end do
      .  return
      end if
      loop_end = min(in_length,6)
      do i = 1,loop_end
      .  if (linein(i:i) .eq. tab) then
      .  .  add_columns = 8 - i
      .  .  do j = in_length,i+1,-1
      .  .  .  k = j + add_columns
      .  .  .  linein(k:k) = linein(j:j)
      .  .  end do
      .  .  in_length = in_length + add_columns
      .  .  do j = i,i+add_columns
      .  .  .  linein(j:j) = ' '
      .  .  end do
      .  .  goto 100
      .  end if
      end do
  100 if (in_length .lt. 7) return
c
c     If column 7 nonblank, do nothing.
c
      if (.not. space(linein(7:7))) return
c
c     Find first nonspace character past column 7.
c
      do i = 8,in_length
      .  if (.not. space(linein(i:i))) goto 200
      end do
c
c     Blank line.
c
      return
c
c     Left-justify line.
c
  200 copy_pointer = 6
      do j = i,in_length
      .  copy_pointer = copy_pointer + 1
      .  linein(copy_pointer:copy_pointer) = linein(j:j)
      end do
      in_length = copy_pointer
      return
      end






c
c     Subroutine to indent output line.
c
      subroutine nest(indent)
      integer indent
c
c     Commons.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
      common/listing/comment_flag,list_flag,indenter
      logical comment_flag,list_flag
      character indenter*3
      data indenter/'.  '/
c
c     Data.
c
      character letter_c
      data letter_c/'C'/
c
c     Executable code.
c
d     write(6,1) indent
    1 format(' in nest, indent = ',i3)
c
c     First 6 columns are unaffected.
c
      if (in_length .ge. 6) then
      .  out_length = 6
      else
      .  out_length = in_length
      end if
      do i = 1,out_length
      .  lineout(i:i) = linein(i:i)
      end do
      if (in_length .le. 6) return
c
c     Insert proper levels of indentation.
c
      if (indent .gt. 0) then
      .  out_length = 6
      .  do i = 1,indent
      .  .  do j = 1,3
      .  .  .  out_length = out_length + 1
      .  .  .  if (out_length .gt. 132) return
      .  .  .  lineout(out_length:out_length) = indenter(j:j)
      .  .  end do
      .  end do
      end if
c
c     Copy rest of line.
c
      if (in_length .gt. 6) then
      .  do i = 7,in_length
      .  .  out_length = out_length + 1
      .  .  if (out_length .gt. 132) return
      .  .  lineout(out_length:out_length) = linein(i:i)
      .  end do
      end if
      return
      end






c
c     Subroutine to print error messages and
c     to stop execution when fatal error encountered.
c
      subroutine error(number)
      integer number
d     write(6,1)
    1 format(' in error')
c
c     Error 1 - indent<0 following dedent
c     END or ELSE encountered.
c
      if (number .eq. 1) then
      .  write(4,100)
  100 .  format('%error(1) - END or ELSE encountered with no prior ',
     &.  'DO or IF.')
      .  return
      end if
c
c     Error 2 - label stored at top of stack .ne. current line label
c
      if (number .eq. 2) then
      .  write(4,200)
  200 .  format('%error(2) - DO and end-of-loop statement labels '
     &.  'don''t match.')
      .  return
      end if
c
c     Error 3 - unresolved labels on stack at END of program module.
c
      if (number .eq. 3) then
      .  write(4,300)
  300 .  format('%error(3) - extra labels unresolved at END')
      .  return
      end if
c
c     Error 4 - no room on if-line for then or executable statement
c
      if (number .eq. 4) then
      .  write(4,400)
  400 .  format('%error(4) - nothing following IF')
      .  return
      end if
c
c     Error 5 - missing or mismatched parentheses following IF.
c
      if (number .eq. 5) then
      .  write(4,500)
  500 .  format('%error(5)- missing or mismatched parentheses',
     &.  ' in logical expression following IF')
      .  return
      end if
c
c     Error 6 - indent more than 17 levels
c     Record will "spill" off end of line.
c
      if (number .eq. 6) then
      .  write(4,600)
  600 .  format('%error(6)- levels of indentation limited to 17'
     &.  /1x,'Extra characters at end of line will be ignored.')
      .  return
      end if
c
c     Invalid number sent to this subroutine from calling program module
c
      write(4,1000)
 1000 format('%error(10) - Invalid error number sent from call to '
     &' to error_writer.'
     &/1x,'User should not see this error.')
      stop
      end






c
c     Convert DO-loop label into integer value.
c     Return 0 (zero) if no label.
c
      integer function do_label()
c
      integer save(5)
c
c     Functions.
c
      logical space
      logical number
c
c     Commons.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
      common/chars/blank,zero
      integer blank,zero
c
c     Executable code.
c
d     write(6,1)
    1 format(' in do_label')
c
      do_label = 0
c
c     Start looking for label in column 10.
c     (Assume 'D' in 7; 'O' in 8; and space in 9.)
c
      do i = 10,in_length
      .  if (.not. space(linein(i:i))) goto 10
      end do
      return
c
c     Check to see if it's a number.
c
   10 if (.not. number(linein(i:i))) return
c
c     Assume number continues until next space up to
c     a maximum of five digits.
c
      do j = 1,5
      .  save(j) = ichar(linein(i:i)) - zero
d     .  write(6,11) j,save(j)
   11 .  format(' save(',i1,') = ',i10)
      .  i = i + 1
      .  if ((.not. number(linein(i:i))) .or. (i .gt. in_length)) goto
     &.  20
      end do
c
c     Convert to integer.
c
   20 do i = 1,j
      .  do_label = do_label * 10 + save(i)
      end do
      return
      end






c
c     Function to determine if a character is a number.
c
      logical function number(char)
      character char
c
c     Executable code.
c
d     write(6,1)
    1 format(' in number')
      number = (('0' .le. char) .and. (char .le. '9'))
      return
      end






c
c     Subroutine to find next nonblank character past a starting point.
c
      subroutine scan(start,last)
      integer start,last
c
c     Function.
c
      logical space
c
c     Common.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
c     Executable code.
c
d     write(6,1)
    1 format(' in scan')
      last = in_length
      if ((start + 1) .gt. in_length) return
      do i = start+1,in_length
      .  if (.not. space(linein(i:i))) then
      .  .  last = i
      .  .  return
      .  end if
      end do
c
c     Blank line.
c
      return
      end






c
c     Function to determine if a character is a space.
c     Either a blank or a tab is considered to be a space.
c
      logical function space(char)
      character char
c
c     Executable code.
c
d     write(6,1)
    1 format(' in space')
      space = ((char .eq. ' ') .or.
     &(char .eq. '	'))
      return
      end






c
c     Subroutine to find the end of the logical
c     expression following an IF.
c
      subroutine log_expr(last)
      integer last
c
      integer start
c
c     Function.
c
      logical space
c
c     Commons.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
      common/error/err_num,num_parens,quote_out
      integer err_num,num_parens
      logical quote_out
c
c     Executable code.
c
d     write(6,1)
    1 format(' in log_expr')
      if (err_num .eq. 0) then
      .  quote_out = .true.
      .  num_parens = 0
      .  start = 9
      else
      .  if (err_num .eq. 4) then
      .  .  last = 7
      .  .  err_num = 0
      .  .  return
      .  else
      .  .  start = 7
      .  end if
      end if
      last = in_length
      if (start .gt. in_length) return
      do i = start,in_length
      .  if (.not. space(linein(i:i))) then
      .  .  if (linein(i:i) .eq. '''') quote_out = .not. quote_out
      .  .  if (quote_out) then
      .  .  .  if (linein(i:i) .eq. '(') num_parens = num_parens + 1
      .  .  .  if (linein(i:i) .eq. ')') num_parens = num_parens - 1
      .  .  .  if (num_parens .eq. 0) then
      .  .  .  .  if ((i + 4) .gt. in_length) then
      .  .  .  .  .  err_num = 4
      .  .  .  .  .  return
      .  .  .  .  else
      .  .  .  .  .  call scan(i,last)
      .  .  .  .  .  err_num = 0
      .  .  .  .  .  return
      .  .  .  .  end if
      .  .  .  end if
      .  .  end if
      .  end if
      end do
      err_num = 5
      return
      end






c
c     Subroutine to determine where to split a line of
c     FORTRAN code which extends beyond column 72.
c     The second line will have an ampersand placed
c     in column 6 as a continuation character.
c
      subroutine split(success)
c
      integer sum,end
      logical success
c
c     Functions.
c
      logical divider
      logical outside_quotes
c
c     Commons.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
      common/split/line_continue,continue_length,start
      character line_continue*132
      integer continue_length,start
c
c     Executable code.
c
d     write(6,1)
    1 format(' in split')
      success = .false.
c
c     never split lines with embedded comments that begin before col 72
c     if comment after nesting starts after col 72 then we can split
c     there is a "gap" here.  comment starts after col 72, valid
c     code ends before will lead to an error.  will let ann fix
c     this to work better (if she cares to bother).
c     MCP
c
      jj = index(lineout,'!')
      if (jj .ne. 0 .and. jj .le. 72) return
c
c     Find beginning of line (first nonblank past column 6).
c
      do i = 7,out_length
      .  if (lineout(i:i).ne.' ') goto 5
      end do
      write(6,3)
    3 format(' blank line - unresolved in split')
      return
    5 start = i
      end = min(out_length,72)
      if (start.gt.end) then
      .  write(6,7)
    7 .  format(' indentation past 72 - unresolved in split')
      .  return
      end if
      do i = end,start,-1
      .  if (divider(lineout(i:i)) .and. (outside_quotes(i))) goto 30
      end do
      write(6,10)
   10 format(' no place to split - unresolved in split')
      return
   30 do k = 1,5
      .  line_continue(k:k) = ' '
      end do
      line_continue(6:6) = '&'
      continue_length = 6
      do k = i+1,out_length
      .  continue_length = continue_length+1
      .  line_continue(continue_length:continue_length) = lineout(k:k)
      end do
      out_length = i
      success = .true.
d     write(6,35)(lineout(i:i),i=1,out_length)
   35 format(' >',<out_length>a1,'<')
d     write(6,40)(line_continue(j:j),j=1,continue_length)
   40 format(' >',<continue_length>a1,'<')
      return
      end






c
c     Function to determine if a character is a valid "divider"
c     for splitting a line of FORTRAN code.
c
      logical function divider(char)
      character char
c
c     Function.
c
      logical oper
c
c     Executable code.
c
d     write(6,1)
    1 format(' in divider')
      if ((char.eq.' ') .or. oper(char)) then
      .  divider = .true.
      else
      .  divider = .false.
      end if
      return
      end






c
c     Function to determine whether a "point"ed to
c     character is inside or outside quotes.
c     A line of FORTRAN code should not be split
c     inside quotes.
c
c     NOTE:  This function will not perform properly
c     if  the user has split quotes across lines.
c
      logical function outside_quotes(point)
      integer point
c
      integer quote_count
c
c     Commons.
c
      common/line/linein,lineout,in_length,out_length
      character linein*132,lineout*132
      integer in_length,out_length
c
      common/split/line_continue,continue_length,start
      character line_continue*132
      integer continue_length,start
c
c     Data.
c
      character quote
      data quote/''''/
c
c     Executable code.
c
d     write(6,1)
    1 format(' in outside_quotes')
      quote_count = 0
      do i = start,point
      .  if (lineout(i:i) .eq. quote) quote_count = mod(quote_count+1,2)
      end do
      outside_quotes = .not. quote_count
      return
      end






c
c     function to determine if a character is one of
c     the following operators:	+ - * /
c
      logical function oper(char)
      character char
c
c     Data.
c
      character operator*4
      data operator/'+-*/'/
c
c     Executable code.
c
d     write(6,1)
    1 format(' in oper')
      oper = .true.
      do i = 1,4
      .  if (char .eq. operator(i:i)) return
      end do
      oper = .false.
      return
      end
