*=======================================================================
*     
*  Title:        BANNER
*                
*  Version:      1-002
*                
*  Abstract:     Security banner and page marking program
*                
*  Environment:  VMS
*                
*  Author:       Eric Andresen of General Research Corporation
*                
*  Date:         1-JUL-1985
*                
*                       C H A N G E   L O G 
*
*     Date     | Name | Description
*--------------+------+-------------------------------------------------
*  20-JUL-1986   ETA    Added ability to print Printronix plot files
*-----------------------------------------------------------------------

      program banner

      implicit none

      include   'banner.cmn'

      logical   forever / .true. /, there_is_room
      integer   i, icontext, len_line, line_val, lib$find_file
      character current_file*255, line*135

      call get_options
      
      if ( do_it_in_batch .and. .not. in_batch ) call submit_batch_job

      if ( use_total_pages ) call count_pages

      call open_output_file( out, first_file, output_file )

      call build_class_lines( top_line, bottom_line ) 

      call write_banner

      page_number = 1

      do i = 1, num_files ! for each file listed in p1 parameter

      icontext = 0

      do while ( lib$find_file( file(i), current_file, icontext ) )

         call open_input_file( *99, current_file )

         if ( show_file_name ) call change_bottom_header( current_file )

         call read_first_line( *99, current_file, line, len_line, 
     .                         line_val )
         call check_for_graphics( line, len_line, line_val )

         in_graphics = .false. ! FIRST LINE OF PRINTOUT CAN BE A HEADER

         do while ( forever ) ! and exit to 99 at end of file

            if ( .not. in_graphics ) then
               call write_top_header
               lines_printed = 1
               else
               lines_printed = 0
               end if

            do while ( there_is_room() )

               call write_line( out, line, len_line )
               lines_printed = lines_printed + line_val
               call read_line( *99, line, len_line, line_val )
               call check_for_graphics( line, len_line, line_val )

            end do

            if ( lines_printed .eq. lines_page - 1 ) then
               call write_bottom_header
               else if ( .not. in_graphics ) then
               call write_form_feed
               end if

            page_number = page_number + 1

         end do

99       do while ( lines_printed .lt. lines_page - 1 )
            call write_blank_line( out )
            lines_printed = lines_printed + 1
         end do

         if ( lines_printed .eq. lines_page - 1 ) then
            call write_bottom_header
            else
            call write_form_feed
            end if

         page_number = page_number + 1
         lines_printed = 0

         close( unit=in )

      end do

      call lib$find_file_end( icontext )

      end do

      call write_banner

      close( unit=out )

      if ( print_it ) call print_file

      stop ' '
      end

      logical function there_is_room()

      implicit   none

      include    'banner.cmn'      

      if ( .not. in_graphics ) then 
         there_is_room = ( lines_printed .lt. lines_page - 1 ) 
         else
         there_is_room = ( lines_printed .lt. total_lines_page ) 
         end if

      return
      end

      subroutine check_for_graphics( line, len_line, line_val )

      implicit   none

      include    'banner.cmn'      

      character  ctrle / 5 /
      logical    found_ctrle
      character  line*(*)
      integer    ii, len_line, line_val

C     IF THE LINE VALUE IS 0 THEN IT DOESN'T MATTER WHETHER GRAPHICS ON
      if ( line_val .eq. 0 ) return

C     TRY TO FIND A CTRL E CHARACTER
      found_ctrle = .false.
      ii = 1

      do while ( ii .le. len_line .and. .not. found_ctrle )
         if ( line(ii:ii) .eq. ctrle ) found_ctrle = .true.
         ii = ii + 1      
      end do

      if ( found_ctrle ) then
         graphics_lines = graphics_lines + 1 ! ONE MORE GRAPHICS LINE
         in_graphics = .true.

         if ( graphics_lines .lt. 12 ) then 
            line_val = 0
            else if ( found_ctrle .and. graphics_lines .eq. 12 ) then 
            graphics_lines = 0
            end if

         else
         graphics_lines = 0                  ! NO GRAPHICS LINES
         in_graphics = .false.
         end if

      return
      end

      subroutine count_pages

      implicit   none

      include    'banner.cmn'      

      logical    forever / .true. /, there_is_room
      integer    i, icontext, len_line, line_val, lib$find_file
      character  current_file*255, line*135

      counting_pages = .true.

      page_number = 1

      do i = 1, num_files ! for each file listed in p1 parameter

      icontext = 0

      do while ( lib$find_file( file(i), current_file, icontext ) )

         call open_input_file( *99, current_file )

         call read_first_line( *99, current_file, line, len_line, 
     .                         line_val )
         call check_for_graphics( line, len_line, line_val )

         do while ( forever ) ! and exit to 99 at end of file

            if ( .not. in_graphics ) then
               lines_printed = 1
               else
               lines_printed = 0
               end if

            do while ( there_is_room() )
               lines_printed = lines_printed + line_val
               call read_line( *99, line, len_line, line_val )
               call check_for_graphics( line, len_line, line_val )
            end do

            page_number = page_number + 1

         end do

99       do while ( lines_printed .lt. lines_page - 1 )
            lines_printed = lines_printed + 1
         end do

         page_number = page_number + 1
         lines_printed = 0

         close( unit=in )

      end do

      call lib$find_file_end( icontext )

      end do

      counting_pages = .false.

      write( total_pages, fmt='(i10)' ) page_number - 1

      i = 1
      do while ( total_pages(i:i) .eq. ' ' )
         i = i + 1
      end do

      total_pages = total_pages(i:)
      max_page_number = 10 - i + 1

      return
      end

      subroutine check_queue_name( queue )

      implicit   none

      include    '($ssdef)'

      integer*2  word(2)
      integer    istat, sys$trnlnm, len_temp_queue, item_list(4)
      integer    long_word, len_queue, len_table1, len_table2
      character  queue*255, temp_queue*255, table1*31, table2*31

      equivalence( word, long_word )

      data table1, len_table1 / 'LNM$PROCESS_TABLE', 17 /
      data table2, len_table2 / 'LNM$SYSTEM_TABLE', 16 /

      call str$upcase( queue, queue )
      call str$trim( queue, queue, len_queue )

      word(1) = 30
      word(2) = '2'x ! lnm$_string
      item_list(1) = long_word
      item_list(2) = %loc( temp_queue )
      item_list(3) = %loc( len_temp_queue )

      item_list(4) = 0

      istat = sys$trnlnm( , table1(1:len_table1), 
     .                      queue(1:len_queue),, item_list )

      if ( istat .eq. ss$_normal ) then
         queue = temp_queue

         else 
         istat = sys$trnlnm( , table2(1:len_table2), 
     .                         queue(1:len_queue),, item_list )
         if ( istat .eq. ss$_normal ) queue = temp_queue
         end if

      return
      end

      subroutine form_feed

      include    'banner.cmn'

      if ( lines_printed .eq. 0 ) then ! <FF> FIRST CHARACTER IN FILE
 
         if ( .not. counting_pages ) call write_top_header
         lines_printed = 1

         do while ( lines_printed .lt. lines_page - 1 )
            if ( .not. counting_pages ) call write_blank_line( out )
            lines_printed = lines_printed + 1
         end do
   
         if ( .not. counting_pages ) call write_bottom_header
         lines_printed = 0
   
         page_number = page_number + 1

         else ! NORMAL FORM FEED

         do while ( lines_printed .lt. lines_page - 1 )
            if ( .not. counting_pages ) call write_blank_line( out )
            lines_printed = lines_printed + 1
         end do
   
         if ( .not. counting_pages ) call write_bottom_header
   
         page_number = page_number + 1
   
         if ( .not. counting_pages ) call write_top_header
         lines_printed = 1
         end if

      return
      end

      subroutine write_form_feed

      implicit   none
      include    'banner.cmn'

      character  ff / 12 /

      if ( lines_printed .lt. total_lines_page ) then
         write( out, 100 ) ff
100      format( a )      
         end if

      return
      end 

      subroutine submit_batch_job

      implicit   none

      include    'banner.cmn'

      include    '($ssdef)'
      include    '($sjcdef)'

      integer*2  i2(2)
      integer    len_location, len_command_line, i, mark, cli$get_value
      integer    length_and_code, len_message, sys$sndjbcw
      integer    function, nullarg, item_list(16), iosb(2), istat
      character  message*255, location*255
      character  command_line*1000

      equivalence( length_and_code, i2 )

c     CREATE BATCH FILE

      output_file = 'banner.ban'

      open( unit=out, name=output_file, status='new',
     .      carriagecontrol='list', err=99 )

      call get_location( location, len_location )
      call cli$get_value( '$line', command_line, len_command_line )

c     GET ALL THE NECESSARY QUALIFIERS AND PARAM 1

      istat = cli$get_value( 'class_note', class_note, 
     .                       len_class_note )

      istat = cli$get_value( 'handle', handle, len_handle )

      istat = cli$get_value( 'fill_char', fill_char )

      istat = cli$get_value( 'work_order', work_order, len_work_order )

      istat = cli$get_value( 'doc_number', doc_number, len_doc_number )

      istat = cli$get_value( 'username', username, len_username )

      istat = cli$get_value( 'file_name', file_name, len_file_name )

      istat = cli$get_value( 'file_class', file_class, len_file_class )

c     IF THE STRINGS EXIST IN THE COMMAND THEN REPLACE THEM WITH QUOTES

      call add_quotes( classification(1:len_classification), 
     .                 command_line, len_command_line, 0 )

      call add_quotes( fill_char, command_line, len_command_line, 1 )

      call add_quotes( handle(1:len_handle), 
     .                 command_line, len_command_line, 1 )

      call add_quotes( class_note(1:len_class_note),
     .                 command_line, len_command_line, 1 )

      call add_quotes( work_order(1:len_work_order),
     .                 command_line, len_command_line, 1 )

      call add_quotes( doc_number(1:len_doc_number),
     .                 command_line, len_command_line, 1 )

      call add_quotes( username(1:len_username),
     .                 command_line, len_command_line, 1 )

      call add_quotes( file_name(1:len_file_name),
     .                 command_line, len_command_line, 1 )

      call add_quotes( file_class(1:len_file_class),
     .                 command_line, len_command_line, 1 )

      write( out, 100, err=99 ) location(1:len_location)
100   format( '$ SET DEFAULT ', a )

      command_line = '$ '//command_line
      len_command_line = len_command_line + 2

      mark = 1
      do i = 1, len_command_line
         if ( command_line(i:i) .eq. '/' )then
            write( out, 110, err=99 ) command_line(mark:i-1)//'-'
            mark = i
            end if
      end do

      write( out, 110, err=99 ) command_line(mark:len_command_line)

      write( out, 110, err=99 ) '$ EXIT'
110   format( a )
      
      close( unit=out )

      function = sjc$_enter_file

c     31                             0
c     --------------------------------
c     |     ITEM      | BUFF. LENGTH |
c     --------------------------------
c     |        BUFFER ADDRESS        |
c     --------------------------------
c     |    RETURN LENGTH ADDRESS     |
c     --------------------------------

      i2(1) =         31
      i2(2) =         sjc$_queue
      item_list(1)  = length_and_code
      item_list(2)  = %loc( batch )
      item_list(3)  = 0

      i2(1) =         255
      i2(2) =         sjc$_file_specification
      item_list(4)  = length_and_code
      item_list(5)  = %loc( output_file )
      item_list(6)  = 0

      i2(1) =         255
      i2(2) =         sjc$_job_status_output
      item_list(7)  = length_and_code
      item_list(8)  = %loc( message )
      item_list(9)  = %loc( len_message )

      i2(1) =         0
      i2(2) =         sjc$_delete_file
      item_list(10) = length_and_code
      item_list(11) = 0
      item_list(12) = 0

      i2(1) =         0
      i2(2) =         sjc$_no_log_spool
      item_list(13) = length_and_code
      item_list(14) = 0
      item_list(15) = 0

      item_list(16) = 0

      istat = sys$sndjbcw( ,%val(function), %val(0), item_list, iosb,, )
      if ( .not. iosb(1) ) call error( 'Error submitting file', iosb(1))

      print *, message(1:len_message)
      
      stop ' '

99    call error( 'Error writing output file BANNER.BAN', 0 )
      end

      subroutine add_quotes( substring, string, len_string, equals )

      implicit   none

      integer    len_substring, len_string, start_pos, end_pos
      integer    str$position
      integer    equals
      character  substring*(*), string*(*), equal_sign

      data       equal_sign / '=' /

      len_substring = len( substring )

      start_pos = str$position( string, 
     .                          equal_sign(1:equals)//substring, 1 )

      if ( start_pos .ne. 0 .and. len_substring .ne. 0 ) then
         end_pos = start_pos + len_substring - (1 - equals)
         call str$replace( string, string, start_pos, end_pos,
     .                     equal_sign(1:equals)//
     .                     '"'//substring(1:len_substring)//'"' )
         len_string = len_string + 2
         end if

      return
      end

      subroutine get_location( loc, len_loc )

      implicit   none
      
      integer*4  len_loc, len_disk, istat
      integer*4  sys$setddir
      character  loc*255, disk*255

      call lib$sys_trnlog( 'SYS$DISK', len_disk, disk )
      istat = sys$setddir( 0, len_loc, loc )

      loc = disk(1:len_disk)//loc(1:len_loc)
      len_loc = len_disk + len_loc
      
      return
      end

      subroutine print_file
 
      implicit   none

      include    'banner.cmn'

      include    '($ssdef)'
      include    '($sjcdef)'

      integer*2  i2(2)
      integer    length_and_code, len_message, sys$sndjbcw
      integer    function, nullarg, item_list(34), iosb(2), istat
      character  message*255

      equivalence( length_and_code, i2 )

      function = sjc$_enter_file

c     31                             0
c     --------------------------------
c     |     ITEM      | BUFF. LENGTH |
c     --------------------------------
c     |        BUFFER ADDRESS        |
c     --------------------------------
c     |    RETURN LENGTH ADDRESS     |
c     --------------------------------

      i2(1) =         31
      i2(2) =         sjc$_queue
      item_list(1)  = length_and_code
      item_list(2)  = %loc( queue )
      item_list(3)  = 0

      i2(1) =         255
      i2(2) =         sjc$_file_specification
      item_list(4)  = length_and_code
      item_list(5)  = %loc( output_file )
      item_list(6)  = 0

      i2(1) =         255
      i2(2) =         sjc$_job_status_output
      item_list(7)  = length_and_code
      item_list(8)  = %loc( message )
      item_list(9)  = %loc( len_message )

      i2(1) =         0
      i2(2) =         sjc$_no_file_burst
      item_list(10) = length_and_code
      item_list(11) = 0
      item_list(12) = 0

      i2(1) =         0
      i2(2) =         sjc$_no_file_flag
      item_list(13) = length_and_code
      item_list(14) = 0
      item_list(15) = 0

      i2(1) =         0
      i2(2) =         sjc$_no_double_space
      item_list(16) = length_and_code
      item_list(17) = 0
      item_list(18) = 0

      i2(1) =         0
      i2(2) =         sjc$_no_file_trailer
      item_list(19) = length_and_code
      item_list(20) = 0
      item_list(21) = 0
      i2(1) =         0

      i2(1) =         0
      i2(2) =         sjc$_no_page_header
      item_list(22) = length_and_code
      item_list(23) = 0
      item_list(24) = 0

      if ( notify ) then
         i2(1) =      0
         i2(2) =      sjc$_notify
         else
         i2(1) =      0
         i2(2) =      sjc$_no_notify
         end if

      item_list(25) = length_and_code
      item_list(26) = 0
      item_list(27) = 0

      if ( save ) then
         i2(1) =      0
         i2(2) =      sjc$_no_delete_file
         else
         i2(1) =      0
         i2(2) =      sjc$_delete_file
         end if

      item_list(28) = length_and_code
      item_list(29) = 0
      item_list(30) = 0

      i2(1) =      0
      i2(2) =      sjc$_no_paginate
      item_list(31) = length_and_code
      item_list(32) = 0
      item_list(33) = 0

      item_list(34) = 0

      istat = sys$sndjbcw( ,%val(function), %val(0), item_list, iosb,, )
      if ( .not. iosb(1) ) call error( 'Error printing file', iosb(1) )

      print *, message(1:len_message)
      
      return
      end

      subroutine open_input_file( *, current_file )

      include    'banner.cmn'

      character  current_file*255

      open( unit=in, name=current_file, status='old',
     .      carriagecontrol='list', readonly, err=99 )

      if ( .not. force_type ) inquire( unit=in, carriagecontrol=type )

      if ( type .ne. 'FORTRAN' .and.
     .     type .ne. 'LIST' .and.
     .     type .ne. 'NONE' ) call error( 'Unknown file type', 1 )

      in_graphics = .false.
      graphics_lines = 0

      return

99    call str$trim( current_file, current_file, len_current )

      if ( .not. counting_pages ) call write_top_header
      lines_printed = 1

      if ( .not. counting_pages ) call write_message( out,
     .   'Unable to open file '//current_file(1:len_current) )
      lines_printed = lines_printed + 1

      return 1
      end

      subroutine write_blank_line( out )

      implicit   none

      integer    out
      character  cr, lf 
      data       cr, lf / 13, 10 /

      write( out, 100 ) cr, lf
100   format( a, a )

      return
      end 

      subroutine write_line( out, line, len_line )

      implicit   none

      integer    out, len_line
      character  line*135

      write( out, 100 ) line(1:len_line)
100   format( a )

      return
      end 

      subroutine write_message( out, message )
  
      implicit   none
  
      integer    out, len_message
      character  message*(*), cr, lf

      data       cr, lf / 13, 10 /

      len_message = len( message )
 
      write( out, 100 ) message(1:len_message), cr, lf
100   format( a, a, a )

      return
      end

      subroutine write_top_header

      implicit   none

      include    'banner.cmn'

      character  cr, lf, underline*132
      data       cr, lf / 13, 10 /
      data       underline / '__________________________________________
     .__________________________________________________________________
     .________________________' /

      if ( use_page_number ) then

         if ( use_underline ) then
            write( out, 100 ) top_line(1:end_header), page_number, 
     .                        top_line(start_header:132), cr, 
     .                        underline, cr, lf
100         format( a, i<max_page_number>.<max_page_number>, 
     .              a / a, a , a , a )

            else if ( use_overstrike ) then
            write( out, 110 ) top_line(1:end_header), page_number, 
     .                        top_line(start_header:132), cr
            write( out, 110 ) top_line(1:end_header), page_number, 
     .                        top_line(start_header:132), cr
            write( out, 110 ) top_line(1:end_header), page_number, 
     .                        top_line(start_header:132), cr
            write( out, 110 ) top_line(1:end_header), page_number, 
     .                        top_line(start_header:132), cr
            write( out, 110 ) top_line(1:end_header), page_number, 
     .                        top_line(start_header:132), cr, lf
110         format( a, i<max_page_number>.<max_page_number>, a, a, a )

            else
            write( out, 120 ) top_line(1:end_header), page_number, 
     .                        top_line(start_header:132), cr, lf
120         format( a, i<max_page_number>.<max_page_number>, a, a, a )
            end if

         else

         if ( use_underline ) then
            write( out, 130 ) top_line(1:132), cr, underline, cr, lf
130         format( a / a, a, a, a )

            else if ( use_overstrike ) then
            write( out, 140 ) top_line(1:132), cr
            write( out, 140 ) top_line(1:132), cr
            write( out, 140 ) top_line(1:132), cr
            write( out, 140 ) top_line(1:132), cr
            write( out, 140 ) top_line(1:132), cr, lf
140         format( a, a, a )

            else
            write( out, 150 ) top_line(1:132), cr, lf
150         format( a, a, a )
            end if

         end if

      return
      end

      subroutine write_bottom_header

      implicit   none

      include    'banner.cmn'

      character  cr, lf, ff, underline*132
      data       cr, lf, ff/ 13, 10, 12 /
      data       underline / '__________________________________________
     .__________________________________________________________________
     .________________________' /

      if ( use_underline ) then
         write( out, 100 ) bottom_line(1:132), cr, underline, cr, ff
100      format( a / a, a, a, a )

         else if ( use_overstrike ) then
         write( out, 110 ) bottom_line(1:132), cr
         write( out, 110 ) bottom_line(1:132), cr
         write( out, 110 ) bottom_line(1:132), cr
         write( out, 110 ) bottom_line(1:132), cr
         write( out, 110 ) bottom_line(1:132), cr, ff
110      format( a, a, a )

         else
         write( out, 120 ) bottom_line(1:132), cr, ff
120      format( a, a, a )
         end if

      return
      end

      subroutine read_first_line( *, current, line, len_line, line_val )

      implicit   none

      include    'banner.cmn'

      character  line*135, current*(*)
      integer    len_line, line_val, len_current

      if ( type .eq. 'FORTRAN' ) then
         call read_fortran_line( *99, in, line, len_line, line_val)
         
         else if ( type .eq. 'LIST' ) then
         call read_list_line( *99, in, line, len_line, line_val )

         else if ( type .eq. 'NONE' ) then
         call read_none_line( *99, in, line, len_line, line_val )
         end if

      return

99    call str$trim( current, current, len_current )

      if ( .not. counting_pages ) call write_top_header
      lines_printed = 1

      if ( .not. counting_pages ) call write_message( out,
     .   'File '//current(1:len_current)//' has no text in it' )
      lines_printed = lines_printed + 1

      return 1
      end

      subroutine read_line( *, line, len_line, line_val )

      implicit   none

      include    'banner.cmn'

      character  line*135
      integer    len_line, line_val

      if ( type .eq. 'FORTRAN' ) then
         call read_fortran_line( *99, in, line, len_line, line_val)
         
         else if ( type .eq. 'LIST' ) then
         call read_list_line( *99, in, line, len_line, line_val )

         else if ( type .eq. 'NONE' ) then
         call read_none_line( *99, in, line, len_line, line_val )
         end if

      return
99    return 1
      end

      subroutine read_fortran_line( *, in, line, len_line, line_val )

      implicit   none

      integer    len_line, line_val, saved_len_line, in, i
      integer    num_added, saved_line_val, saved_num_added
      logical    line_saved, do_form_feed
      character  line*135, saved_line*135, carriage_character*1

      character  cr, lf, ff 
      data       cr, lf, ff / 13, 10, 12 /

      if ( do_form_feed ) then
         call form_feed
         do_form_feed = .false.
         end if

10    if ( line_saved ) then
         line = saved_line
         len_line = saved_len_line
         line_saved = .false.         
         line_val = saved_line_val
         num_added = saved_num_added

         else
         read( in, 100, end=99 ) carriage_character, len_line, line
100      format( a1, q, a132 )

         if ( len_line .gt. 132 ) len_line = 132

         if ( carriage_character .eq. '+' ) then
            line(len_line+1:) = cr
            len_line = len_line + 1
            num_added = 1

            else if ( carriage_character .eq. ' ' ) then
            line(len_line+1:) = cr//lf
            len_line = len_line + 2
            num_added = 2

            else if ( carriage_character .eq. '0' ) then
            line(len_line+1:) = cr//lf//lf
            len_line = len_line + 3
            num_added = 3

            else if ( carriage_character .eq. '1' ) then
            line = ff//line(1:len_line)//cr//lf
            len_line = len_line + 3
            num_added = 2

            else
            line(len_line+1:) = cr//lf
            len_line = len_line + 2
            num_added = 2
            end if

         end if

      do i = 1, len_line

         if ( line(i:i) .eq. lf ) then

            if ( len_line .ne. i ) then 
               line_saved = .true.
               saved_line = line(i+1:)
               saved_len_line = len_line - i
               saved_line_val = line_val
               saved_num_added = num_added
               end if

            line = line(1:i)
            len_line = i
            line_val = 1

            goto 20 ! RETURN

            end if

         if ( line(i:i) .eq. ff ) then

            if ( i .lt. len_line - num_added ) then 
               line_saved = .true.
               saved_line = line(i+1:)
               saved_len_line = len_line - i
               saved_line_val = line_val
               saved_num_added = num_added
               end if

            if ( i .eq. 1 ) then
               call form_feed
               goto 10
               end if

            do_form_feed = .true.

            line = line(1:i-1)//cr//lf
            len_line = i + 1
            line_val = 1

            goto 20 ! RETURN

            end if

      end do

20    return
99    return 1

      end

      subroutine read_list_line( *, in, line, len_line, line_val )

      implicit   none

      integer    len_line, line_val, saved_len_line, in, i
      integer    num_added, saved_line_val, saved_num_added
      logical    line_saved, do_form_feed
      character  line*135, saved_line*135

      character  cr, lf, ff
      data       cr, lf, ff / 13, 10, 12 /

      if ( do_form_feed ) then
         call form_feed
         do_form_feed = .false.
         end if

10    if ( line_saved ) then
         line = saved_line
         len_line = saved_len_line
         line_saved = .false.         
         line_val = saved_line_val
         num_added = saved_num_added

         else
         read( in, 100, end=99 ) len_line, line
100      format( q, a132 )

         if ( len_line .gt. 132 ) len_line = 132

         line(len_line+1:) = cr//lf
         num_added = 2
         len_line = len_line + 2
         line_val = 1
       
         end if

      do i = 1, len_line

         if ( line(i:i) .eq. lf ) then

            if ( len_line .ne. i ) then 
               line_saved = .true.
               saved_line = line(i+1:)
               saved_len_line = len_line - i
               saved_line_val = line_val
               saved_num_added = num_added
               end if

            line = line(1:i)
            len_line = i
            line_val = 1

            goto 20 ! RETURN

            end if

         if ( line(i:i) .eq. ff ) then

            if ( i .lt. len_line - num_added ) then 
               line_saved = .true.
               saved_line = line(i+1:)
               saved_len_line = len_line - i
               saved_line_val = line_val
               saved_num_added = num_added
               end if

            if ( i .eq. 1 ) then
               call form_feed
               goto 10
               end if

            do_form_feed = .true.

            line = line(1:i-1)//cr//lf
            len_line = i + 1
            line_val = 1

            goto 20 ! RETURN

            end if

      end do

20    return
99    return 1

      end

      subroutine read_none_line( *, in, line, len_line, line_val )

      implicit   none

      integer    len_line, line_val, saved_len_line, in, i
      integer    num_added, saved_line_val, saved_num_added
      logical    line_saved, do_form_feed
      character  line*135, saved_line*135

      character  cr, lf, ff
      data       cr, lf, ff / 13, 10, 12 /

      if ( do_form_feed ) then
         call form_feed
         do_form_feed = .false.
         end if

10    if ( line_saved ) then
         line = saved_line
         len_line = saved_len_line
         line_saved = .false.         
         line_val = saved_line_val
         num_added = saved_num_added

         else
         read( in, 100, end=99 ) len_line, line
100      format( q, a135 )

         if ( len_line .gt. 135 ) len_line = 135
         line_val = 0
         end if

      do i = 1, len_line

         if ( line(i:i) .eq. lf ) then

            if ( len_line .ne. i ) then 
               line_saved = .true.
               saved_line = line(i+1:)
               saved_len_line = len_line - i
               saved_line_val = line_val
               saved_num_added = num_added
               end if

            line = line(1:i)
            len_line = i
            line_val = 1

            goto 20 ! RETURN

            end if

         if ( line(i:i) .eq. ff ) then

            if ( i .lt. len_line - num_added ) then 
               line_saved = .true.
               saved_line = line(i+1:)
               saved_len_line = len_line - i
               saved_line_val = line_val
               saved_num_added = num_added
               end if

            if ( i .eq. 1 ) then
               call form_feed
               goto 10
               end if

            do_form_feed = .true.

            line = line(1:i-1)//cr//lf
            len_line = i + 1
            line_val = 1

            goto 20 ! RETURN

            end if

      end do

20    return
99    return 1

      end

      subroutine change_bottom_header( current_file )

      implicit   none

      include    'banner.cmn'

      integer    i, len_new_handle
      character  new_handle*60, current_file*255

      call lib$trim_filespec( current_file, new_handle, 60, 
     .                        len_new_handle )

      do i = 1, 132
         bottom_line(i:i) = fill_char
      end do
      
      bottom_line(1:len_class_note+1) = class_note//' '
      i = 133 - ( len_new_handle + 1 )
      bottom_line(i:132) = ' '//new_handle

      return
      end

      subroutine build_class_lines

      implicit   none

      include    'banner.cmn'

      integer    i, j, len_last_part
      character  last_part*20

c     THESE ARE THE FIVE POSSIBILITIES

c     class_note ***...**** doc_number ***** Page nnn of nnn
c     class_note ***...********************* Page nnn of nnn
c     class_note ***...************************** Page nnnnn
c     class_note ***...************************** doc_number
c     class_note ***...*************************************

      do i = 1, 132
         top_line(i:i) = fill_char
         bottom_line(i:i) = fill_char
      end do
      
      top_line(1:len_class_note+1) = class_note//' '

      if ( use_total_pages ) then
         last_part = ' of '//total_pages(1:max_page_number)
         len_last_part = 4 + max_page_number
         end_header = 133 - ( len_last_part + max_page_number + 1 )
         start_header = 133 - len_last_part

         else
         len_last_part = 0
         max_page_number = 5
         end_header = 133 - ( max_page_number + 1 )
         start_header = 133
         end if

      if ( use_page_number .and. doc_number_defined ) then
         j = 133 - ( len_last_part + 6 + max_page_number + 5 )
         i = j - ( len_doc_number + 2 ) + 1
         top_line(i:j) = ' '//doc_number(1:len_doc_number)//' '
         i = 133 - ( len_last_part + max_page_number + 6 )
         top_line(i:) = ' Page '

         else if ( doc_number_defined ) then
         i = 133 - ( len_doc_number + 1 )
         top_line(i:132) = ' '//doc_number
   
         else if ( use_page_number ) then
         i = 133 - ( len_last_part + max_page_number + 6 )
         top_line(i:) = ' Page '
         end if

      i = 133 - len_last_part
      top_line(i:132) = last_part

      bottom_line(1:len_class_note+1) = class_note//' '
      i = 133 - ( len_handle + 1 )
      bottom_line(i:132) = ' '//handle

      return
      end

      subroutine open_output_file( unit, file, output_file )

      implicit   none

      character  file*255, output_file*255
      integer    unit, len_file, len_o_file, i

      call str$trim( file, file, i )

      do while ( file(i:i) .ne. '.' )
         i = i - 1
         if ( i .lt. 1 ) goto 99
      end do

      output_file = file(1:i)//'BAN'
      len_o_file = i + 3

      open( unit=unit, name=output_file, status='new', 
     .      carriagecontrol='none', err=99, recl=135 )

      return

99    call error( 'Error opening output file '//
     .             file(1:len_file), 0 )
      end

      subroutine get_options

      implicit   none

      parameter  max_classification = 19
      parameter  max_username = 19
      parameter  max_file_name = 19
      parameter  max_class_note = 70
      parameter  max_handle = 60
      parameter  max_work_order = 27
      parameter  max_file_class = 12
      parameter  max_doc_number = 20
      parameter  max_fill_char = 1
      parameter  max_lines_page = 88
      parameter  min_lines_page = 56

      include    '($clidef)'

      include    'banner.cmn'

      integer    cli$get_value, cli$present, istat, len_a_lines
      integer    icontext, lib$find_file
      integer    len_x_username, len_x_work_order, i

      character  a_num*1, a_lines*3, doc_type*1
      character  x_username*12, x_work_order*8

c     GET FILE NAME(S)

      num_files = 1

      do while ( cli$get_value( 'file', file(num_files), 
     .                                  len_file(num_files) ) )
         num_files = num_files + 1
      end do

      num_files = num_files - 1

c     MAKE SURE FIRST FILE EXISTS

      icontext = 0
      istat = lib$find_file( file(1), first_file, icontext )
      call str$trim( file(1), file(1), len_file(1) )
      if ( .not. istat ) call error( 'Error opening '//
     .                   file(1)(1:len_file(1))//' as input', 0 )
      call lib$find_file_end( icontext )

c     GET CLASSIFICATION

      istat = cli$get_value( 'classification', classification,
     .                       len_classification )

      if ( len_classification .gt. max_classification ) 
     .   call error( 'Classification is too long', 0 )

      if ( len_classification .eq. 0 .or. classification .eq. ' ' ) 
     .   call error( 'Classification must be specified', 0 )

      if ( classification .eq. 'T' ) then
         classification = 'TOP SECRET'
         len_classification = 10

         else if ( classification .eq. 'S' ) then
         classification = 'SECRET'
         len_classification = 6

         else if ( classification .eq. 'R' ) then
         classification = 'SECRET/RESTRICTED'
         len_classification = 17

         else if ( classification .eq. 'C' ) then
         classification = 'CONFIDENTIAL'
         len_classification = 12

         else if ( classification .eq. 'U' ) then
         classification = 'UNCLASSIFIED'
         len_classification = 12

         end if

c     GET QUEUE SPECIFICATION

      if ( cli$present( 'queue' ) ) then
         print_it = .true.
         istat = cli$get_value( 'queue', queue, len_queue )
         call check_queue_name( queue )
         end if

c     GET BATCH SPECIFICATION

      if ( cli$present( 'batch' ) ) then
         do_it_in_batch = .true.
         istat = cli$get_value( 'batch', batch, len_queue )
         call check_queue_name( batch )
         end if

c     GET VARIOUS OPTIONS
 
      if ( cli$present( 'notify' ) ) notify = .true.

      if ( cli$present( 'save' ) ) save = .true.

      if ( cli$present( 'page_number' ) ) use_page_number = .true.

      if ( cli$present( 'total_pages' ) ) use_total_pages = .true.

      if ( cli$present( 'header' ) ) use_header = .true.

      if ( cli$present( 'sign' ) ) use_sign = .true.
      
      if ( cli$present( 'date' ) ) use_date = .true.

      if ( cli$present( 'address' ) ) use_address = .true.

      if ( cli$present( 'underline' ) ) use_underline = .true.

      if ( cli$present( 'overstrike' ) ) use_overstrike = .true.

c     GET THE CORRECT CLASSBY TEXT AND NUMBER

      if ( cli$present( 'classby' ) ) then

         use_classby = .true.

         istat = cli$get_value( 'classby', a_num, )

         if ( a_num .eq. '1' ) then
            classby_number = 1

            else if ( a_num .eq. '2' ) then
            classby_number = 2

            else
            classby_number = 1
            end if

         end if

c     GET FILE TYPE ( FORCE FILE TYPE )

      if ( cli$present( 'carriage_control' ) ) then
         istat = cli$get_value( 'carriage_control', type, )
         force_type = .true.
         end if

c     GET NUMBER OF LINES PER PAGE

      if ( cli$present( 'lines_page' ) ) then
         istat = cli$get_value( 'lines_page', a_lines, len_a_lines )
         read( a_lines, fmt='(i<len_a_lines>)' ) lines_page

         else
         lines_page = 62
         end if

      if ( lines_page .gt. max_lines_page .or.
     .     lines_page .lt. min_lines_page ) 
     .   call error( 'Lines per page is invalid', 0 )

C     IF THE LINES PER PAGE IS OVER 88 THEN THE PAGE MUST HAVE 88 LINES 
      if ( lines_page .le. 66 ) then
         total_lines_page = 66
         else
         total_lines_page = 88
         end if

c     GET THE CLASSIFICATION NOTE

      istat = cli$get_value( 'class_note', class_note, 
     .                       len_class_note )

      if ( len_class_note .gt. max_class_note ) 
     .   call error( 'Class_note is too long', 0 )

      if ( len_class_note .eq. 0 ) then
         class_note = classification
         len_class_note = len_classification
         end if

c     GET HANDLE

      istat = cli$get_value( 'handle', handle, len_handle )

      if ( len_handle .gt. max_handle )  
     .   call error( 'Handle is too long', 0 )

      if ( handle .eq. '$FILE' ) then
         show_file_name = .true.
         handle = ' '
         len_handle = 0
         end if 

      if ( len_handle .eq. 0 ) then
         handle = classification
         len_handle = len_classification
         end if

c     GET THE FILL CHARACTER FOR THE HEADER

      if ( cli$present( 'fill_char' ) ) then
         istat = cli$get_value( 'fill_char', fill_char, i )
         if ( i .gt. max_fill_char ) 
     .      call error( 'Fill character must be one character only', 0 )

         else
         fill_char = ' '
         end if

c     GET THE WORK ORDER

      if ( cli$present( 'work_order' ) ) then
         use_work_order = .true.
         istat = cli$get_value( 'work_order', work_order, 
     .                          len_work_order )

         else
         use_work_order = .false.
         end if

      if ( len_work_order .gt. max_work_order )  
     .   call error( 'Work_order is too long', 0 )

c     GET THE DOC NUMBER

      if ( cli$present( 'doc_number' ) ) then
         use_log = .true.
         call cli$get_value( 'doc_number', doc_number, len_doc_number )
         doc_number_defined = .true.

         if ( len_doc_number .eq. 0 ) then
            doc_number = '____________________'
            len_doc_number = 20
            end if

         if ( len_doc_number .gt. max_doc_number )  
     .      call error( 'Doc_number is too long', 0 )

         doc_number = 'Doc. No. '//doc_number
         len_doc_number = 9 + len_doc_number

         else if ( cli$present( 'log_number' ) ) then
            use_log = .true.
            call cli$get_value( 'log_number',doc_number,len_doc_number )

            if ( len_doc_number .eq. 0 ) then
               doc_number_defined = .false.
               doc_number = '____________________'
               len_doc_number = 20
               else
               doc_number_defined = .true.
               end if

            if ( len_doc_number .gt. max_doc_number )  
     .         call error( 'Doc_number is too long', 0 )

            doc_number = 'Log No. '//doc_number
            len_doc_number = 8 + len_doc_number
            
            else
               use_log = .false.
               len_doc_number = 0
               end if

c     GET THE USERNAME

      if ( cli$present( 'username' ) ) then
         use_username = .true.
         istat = cli$get_value( 'username', username,
     .                          len_username )

         else
         use_username = .false.
         end if

      if ( len_username .gt. max_username )  
     .   call error( 'Username is too long', 0 )

c     GET THE FILE NAME

      if ( cli$present( 'file_name' ) ) then
         use_file_name = .true.
         istat = cli$get_value( 'file_name', file_name,
     .                          len_file_name )

         else
         use_file_name = .false.
         end if

      if ( len_file_name .gt. max_file_name )  
     .   call error( 'File_name is too long', 0 )

c     GET THE FILE CLASSIFICATION

      if ( cli$present( 'file_class' ) ) then
         use_file_class = .true.
         istat = cli$get_value( 'file_class', file_class,
     .                          len_file_class )

         file_class = '('//file_class(1:len_file_class)//')'
         len_file_class = len_file_class + 2

         else
         use_file_class = .false.
         end if

      if ( len_file_class .gt. max_file_class )  
     .   call error( 'File_class is too long', 0 )

      if ( len_file_class + len_file_name .gt. max_file_name )
     .   call error( 'File_class and file_name must be less than 19'//
     .               ' characters total', 0 )

c     GET FILE_NAME IF WASN'T SPECIFIED

      if ( len_file_name .eq. 0 ) then
         i = 19 - len_file_class
         
         call lib$trim_filespec( first_file, file_name, i, 
     .                           len_file_name )

         file_name = file_name(1:len_file_name)//file_class
         len_file_name = len_file_name + len_file_class

         else
         file_name = file_name(1:len_file_name)//file_class
         len_file_name = len_file_name + len_file_class

         end if

c     GET THE CURRENT USER SPECIFIC INFORMATION

      call get_process_info( x_username, len_x_username,
     .                       x_work_order, len_x_work_order,
     .                       in_batch )

c     USE ACTUAL WORK ORDER IF WASN'T SPECIFIED

      if ( use_work_order ) then
         
         if ( len_work_order .eq. 0 ) then
            work_order = 'Work Order No. '//x_work_order
            len_work_order = 15 + len_x_work_order

            else
            work_order = 'Work Order No. '//work_order
            len_work_order = 15 + len_work_order
            end if

         end if

c     USE ACTUAL USERNAME IF WASN'T SPECIFIED

      if ( use_username .and. len_username .eq. 0 ) then

         username = x_username
         len_username = len_x_username

         end if

c     DEFINE FILE UNIT NUMBERS

      out = 1
      in = 2

      return
      end

      subroutine error( message1, istat )

      implicit   none

      character  message1*(*), message2*255

      integer*4  istat, sys$getmsg, msg_stat, length

      print *, 'BANNER: ', message1

      if ( istat .ne. 0 .and. istat .ne. 1 ) then
         msg_stat = sys$getmsg(%val(istat), length, message2, %val(15),)
         print *, message2(1:length)
         end if

      if ( istat .ne. 0 ) 
     .   print *, 'There may be an extra .BAN file in your directory'

      stop ' '
      end

      subroutine write_banner

      implicit   none

      include    'letters.cmn'

      include    'banner.cmn'

      character  top_section(4,3)*42, bottom_section(3,3)*42
      character  page(88)*132, class_banner(7)*132
      character  username_banner(7)*132, file_name_banner(7)*132
      character  file_section(40)*128

      character  address(4)*42, sign(3)*42, classby(3,2)*42
      character  date*42, a_page_number*5, copy_of*30

      integer    len_date, start_column, stop_column, ascii_value
      integer    first_top_line, first_file_line, num_file_lines
      integer    last_file_line, first_bottom_line, last_bottom_line
      integer    last_top_line, len_copy_of

      integer    i, j, k, istart

      logical    been_through_once

      character  cr, lf, ff
      data       cr, lf, ff / 13, 10, 12 /

      data class_banner(1) / ' ' /
      data class_banner(2) / ' ' /
      data class_banner(3) / '******************************************
     .******************************************************************
     .************************' /
      data class_banner(4) / '******************************************
     .******************************************************************
     .************************' /
      data class_banner(5) / '******************************************
     .******************************************************************
     .************************' /
      data class_banner(6) / ' ' /
      data class_banner(7) / ' ' /

      data username_banner / 7*' ' /
      data file_name_banner/ 7*' ' /

      data page           / 88*' ' /
      data top_section    / 12*' ' /
      data bottom_section /  9*' ' /
      data file_section   / 40*' ' /

c     HERE IS WHERE YOU WOULD PUT YOUR COMPANY ADDRESS
c     USE LINES 1 TO 4 AND DON'T USE ANY MORE THAN 42 CHARACTERS IN
c     EACH LINE - YOU MAY WANT TO CENTER THE ADDRESS WITHIN THE 42
c     CHARACTER LINE SO THAT THE ADDRESS WILL BE CENTERED ON THE FLAG
c     PAGE.  THE EXAMPLE BELOW SHOWS A CENTERED ADDRESS THAT ONLY USES
c     THREE OF THE LINES.

c     data address / '           The Software House             ',  !LINE 1
c    .               '           700 Haight Street              ',  !LINE 2
c    .               '           San Francisco, CA              ',  !LINE 3
c    .               '                                          ' / !LINE 4

      data address / '                                          ',  !LINE 1
     .               '                                          ',  !LINE 2
     .               '                                          ',  !LINE 3
     .               '                                          ' / !LINE 4

      data sign    / 'Operator ______________________ Date______',
     .               'Recipient _____________________ Date______',
     .               ' ' /

      data classby / 'Classified by: ___________________________',
     .               '               ___________________________',
     .               'Declassify on: ___________________________',
     .               'Classified by: ___________________________',
     .               'Declassify on: ___________________________',
     .               'Derived from: ____________________________' /

      data copy_of / 'Copy No. _________of__________' /
      data len_copy_of / 30 /

c     THIS IS WHAT THE STANDARD PAGE LOOKS LIKE

c   ...........................................................
c 1       special classification                 doc number
c 1                                              copy___of____
c 1
c 7 ************* C L A S S I F I C A T I O N *****************
c 2 
c 7                     U S E R N A M E
c 2 
c 7                    F I L E   N A M E 
c 1 
c 1 +---------------------------------------------------------+
c   |  1,1                 1,2              1,3               |
c 6 |  2,1                 2,2              2,3               |top
c   |  3,1                 3,2              3,3               |section
c   |  4,1                 4,2              4,3               |
c 1 +---------------------------------------------------------+
c 1 |                                                         |
c   |                                                         |
c   |                                                         |
c   |                                                         |
c   |           lines_page - 56 to play with for              |
c   |                 VMS file information                    |
c   |                                                         |
c   |                                                         |
c   |                                                         |
c 1 |                                                         |
c 1 +---------------------------------------------------------+
c   |  1,1                 1,2              1,3               |
c 5 |  2,1                 2,2              2,3               |bottom
c   |  3,1                 3,2              3,3               |section
c 1 +----------------------------------------------------------
c 1
c 7 ************* C L A S S I F I C A T I O N *****************
c 1
c 1       special classification           handle
c
c   ...........................................................

c     IF THIS IS THE SECOND TIME THROUGH THEN CREATE THE TRAILER PAGE

      if ( been_through_once ) goto 10

c     SET UP THE FRAME ON THE FRONT PAGE

      first_top_line = 32
      last_top_line = 35
      first_file_line = 39
      num_file_lines = lines_page - 56
      last_file_line = first_file_line + num_file_lines - 1
      first_bottom_line = last_file_line + 4
      last_bottom_line = first_bottom_line + 2

      page(30) = '+-----------------------------------------------------
     .------------------------------------------------------------------
     .-----------+'

      do i = first_top_line - 1, last_top_line + 1
         page(i)(1:1) = '|'
         page(i)(132:132) = '|'
      end do

      page(i) =  '+-----------------------------------------------------
     .------------------------------------------------------------------
     .-----------+'

      do i = first_file_line - 1, last_file_line + 1
         page(i)(1:1) = '|'
         page(i)(132:132) = '|'
      end do
      
      page(i) =  '+-----------------------------------------------------
     .------------------------------------------------------------------
     .-----------+'

      do i = first_bottom_line - 1, last_bottom_line + 1
         page(i)(1:1) = '|'
         page(i)(132:132) = '|'
      end do

      page(i) =  '+-----------------------------------------------------
     .------------------------------------------------------------------
     .-----------+'

c     GET SPECIALIZED DATE STRING

      call get_date( date, len_date )

c     CREATE THE CLASSIFICATION BANNER FOR THE TOP AND BOTTOM OF THE 

      call str$upcase( classification, classification )

      start_column = ( 133 - (len_classification * 7) ) / 2 + 1
      stop_column = start_column + (len_classification * 7) - 6

      do i = 1, 7

         k = 1
         do j = start_column, stop_column, 7

            ascii_value = ichar( classification(k:k) )
            if ( ascii_value .gt. 97 .or. ascii_value .lt. 32 ) 
     .                                                 ascii_value = 32
            class_banner(i)(j:j+6) = ' '//letters( i,ascii_value )//' '
            k = k + 1

         end do

      end do

c     CREATE THE USERNAME BANNER

      if ( use_username ) then

         call str$upcase( username, username )

         start_column = ( 133 - (len_username * 7) ) / 2 + 1
         stop_column = start_column + (len_username * 7) - 6

         do i = 1, 7
   
            k = 1
            do j = start_column, stop_column, 7

               ascii_value = ichar( username(k:k) )
               if ( ascii_value .gt. 97 .or. ascii_value .lt. 32 ) 
     .                                                 ascii_value = 32
               username_banner(i)(j:) = ' '//letters( i,ascii_value )
     .                                     //' '
               k = k + 1

            end do

         end do

         end if

c     CREATE THE FILE NAME BANNER

      if ( use_file_name ) then

         call str$upcase( file_name, file_name ) 

         start_column = ( 133 - (len_file_name * 7) ) / 2 + 1
         stop_column = start_column + (len_file_name * 7) - 6

         do i = 1, 7

            k = 1
            do j = start_column, stop_column, 7

               ascii_value = ichar( file_name(k:k) )
               if ( ascii_value .gt. 97 .or. ascii_value .lt. 32 ) 
     .                                                 ascii_value = 32
               file_name_banner(i)(j:) = ' '//letters( i,ascii_value )
     .                                      //' '
               k = k + 1

            end do

         end do

         end if

C     CREATE THE TOP SECTION 

      if ( use_date ) top_section(2,1) = date
      istart = 43 - len_work_order
      if ( use_work_order ) top_section(2,3)(istart:) = work_order

      if ( use_address ) then
         top_section(1,2) = address(1)
         top_section(2,2) = address(2)
         top_section(3,2) = address(3)
         top_section(4,2) = address(4)
         end if

c     CREATE THE FILE SECTION

      file_section(1) = first_file

c     CREATE THE BOTTOM SECTION

      if ( use_classby ) then
         bottom_section(1,3) = classby(1,classby_number)
         bottom_section(2,3) = classby(2,classby_number)
         bottom_section(3,3) = classby(3,classby_number)
         end if

      if ( use_sign ) then
         bottom_section(1,1) = sign(1)
         bottom_section(2,1) = sign(2)
         bottom_section(3,1) = sign(3)
         end if

c     CREATE THE IMAGE ON THE PAGE

      page(1) = class_note(1:len_class_note)

      if ( use_log ) then
         istart = 133 - max( len_doc_number, len_copy_of )
         page(1)(istart:) = doc_number
         page(2)(istart:) = copy_of
         end if

      j = 1
      do i = 4, 10
         page(i) = class_banner(j)
         j = j + 1
      end do

      j = 1
      do i = 13, 19
         page(i) = username_banner(j)
         j = j + 1
      end do

      j = 1
      do i = 22, 28
         page(i) = file_name_banner(j)
         j = j + 1
      end do

      j = 1
      do i = first_top_line, last_top_line
         page(i)(3:130) = top_section(j,1)//' '//top_section(j,2)//
     .                    ' '//top_section(j,3)
         j = j + 1
      end do

      j = 1
      do i = first_file_line, last_file_line
         page(i)(3:130) = file_section(j)
         j = j + 1
      end do

      j = 1
      do i = first_bottom_line, last_bottom_line
         page(i)(3:130) = bottom_section(j,1)//' '//
     .                    bottom_section(j,2)//' '//
     .                    bottom_section(j,3)
         j = j + 1
      end do

      j = 1
      do i = last_bottom_line + 4, last_bottom_line + 10
         page(i) = class_banner(j)
         j = j + 1
      end do         

      i = i + 1
      page(i) = class_note(1:len_class_note)
      istart = 133 - len_handle
      page(i)(istart:) = handle

c     SEND TO FILE

      if ( use_overstrike ) then
         do j = 1, 2
            do i = 1, 10
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr, lf
100            format( a, a, a )
            end do
            do i = 11, lines_page - 10
               write(out, 100) page(i), cr, lf
            end do
            do i = lines_page - 9, lines_page - 1
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr, lf
            end do
            write(out, 100) page(i), cr
            write(out, 100) page(i), cr
            write(out, 100) page(i), cr
            write(out, 100) page(i), cr
            write(out, 100) page(i), cr, ff
         end do

         else 
         do j = 1, 2
            do i = 1, lines_page - 1
               write(out, 100) page(i), cr, lf
            end do
            write(out, 100) page(i), cr, ff
         end do
         end if

      been_through_once = .true.

      return

10    continue ! create the trailer page

      write( a_page_number,fmt='(i<max_page_number>.<max_page_number>)')
     .       page_number - 1

      bottom_section(1,1) = ' '
      bottom_section(2,1) = ' '
      bottom_section(3,1) = ' '

      if ( use_page_number ) then
         bottom_section(1,2) = '     End of a continuous form document'
         bottom_section(2,2) = '     '//a_page_number(1:max_page_number)
     .                                //' pages printed'
  
         else
         bottom_section(1,2) = ' '
         bottom_section(2,2) = ' '
         end if

      bottom_section(3,2) = ' '
      bottom_section(1,3) = ' '
      bottom_section(2,3) = ' '
      bottom_section(3,3) = ' '

      j = 1
      do i = first_top_line, last_top_line
         page(i)(89:130) = top_section(j,3)
         j = j + 1
      end do

      j = 1
      do i = first_bottom_line, last_bottom_line
         page(i)(3:130) = bottom_section(j,1)//' '//
     .                    bottom_section(j,2)//' '//
     .                    bottom_section(j,3)
         j = j + 1
      end do

      if ( use_overstrike ) then
         do j = 1, 2
            do i = 1, 10
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr, lf
            end do
            do i = 11, lines_page - 10
               write(out, 100) page(i), cr, lf
            end do
            do i = lines_page - 9, lines_page - 1
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr
               write(out, 100) page(i), cr, lf
            end do
            write(out, 100) page(i), cr
            write(out, 100) page(i), cr
            write(out, 100) page(i), cr
            write(out, 100) page(i), cr
            if ( j .eq. 1 ) then
               write(out, 100) page(i), cr, ff
               else
               write(out, 100) page(i), cr, lf
               end if
         end do

         else 
         do j = 1, 2
            do i = 1, lines_page - 1
               write(out, 100) page(i), cr, lf
            end do
            if ( j .eq. 1 ) then
               write(out, 100) page(i), cr, ff
               else
               write(out, 100) page(i), cr, lf
               end if
         end do
         end if

      return
      end

      subroutine get_date( date, len_date )

      integer   len_date, len_days(7), len_months(12), num_day
      integer   hours, minutes, month, day, year
      character date*42, days(7)*9, months(12)*9, time*23
      character ampm*2, ahours*2, aminutes*2, ayear*2

      data days / 'Monday', 'Tuesday',  'Wednesday',  'Thursday', 
     .            'Friday', 'Saturday', 'Sunday' /
      data len_days / 6, 7, 9, 8, 6, 8, 6 /

      data months / 'January', 'February', 'March', 'April', 'May',
     .              'June', 'July', 'August', 'September', 'October',
     .              'November', 'December' /
      data len_months / 7, 8, 5, 5, 3, 4, 4, 6, 9, 8, 8, 8 /

      call lib$date_time( time )
      call idate( month, day, year )
      call lib$day_of_week( %val(0), num_day )

      write( ayear, fmt='(i2)' ) year

      read( time(13:14), fmt='(i2)' ) hours
      read( time(16:17), fmt='(i2)' ) minutes

      if ( hours .ge. 12 ) then
         ampm = 'PM'
         else
         ampm = 'AM'
         end if

      if ( hours .eq.  0 ) hours = 12
      if ( hours .gt. 12 ) hours = hours - 12

      write( ahours, fmt='(i2)' ) hours
      aminutes = time(16:17)

      time(5:5) = char( ichar(time(5:5)) + 32 )
      time(6:6) = char( ichar(time(6:6)) + 32 )

      date = days(num_day)(1:len_days(num_day))//', '//
     .       months(month)(1:len_months(month))//' '//
     .       time(1:2)//', 19'//ayear//'  '//
     .       ahours//':'//aminutes//' '//ampm

      len_date = len( date )

      return
      end

      subroutine get_process_info( username, len_username,
     .                             work_order, len_work_order,
     .                             in_batch )

c     INCLUDE GETJPI CODES AS PARAMETERS

      include     '($jpidef)'

      byte        b_username(12), b_work_order(8)

      integer*2   b2(20)
      integer*4   b4(10), sys$getjpiw, jpi_stat, len_mode
      integer*4   len_username, len_work_order, mode
      logical     in_batch

      character   username*12, work_order*8

      equivalence ( b2(1), b4(1) )

c     PACK THE DATA FOR GETJPI...

      b2 (1) = 12
      b2 (2) = jpi$_username
      b4 (2) = %loc( b_username )
      b4 (3) = %loc( len_username )

      b2 (7) = 8
      b2 (8) = jpi$_account
      b4 (5) = %loc( b_work_order )
      b4 (6) = %loc( len_work_order )

      b2(13) = 4
      b2(14) = jpi$_mode
      b4 (8) = %loc( mode )
      b4 (9) = %loc( len_mode )

      b4 (10) = 0

      jpi_stat = sys$getjpiw( ,,, b4 ,,, )

      work_order = ' '

      do i = 1, len_work_order
         work_order(i:i) = char( b_work_order(i) )
      end do

      call str$trim( work_order, work_order, len_work_order )

      username = ' '

      do j = 1, 12
         username(j:j) = char( b_username(j) )
      end do

      call str$trim( username, username, len_username )

      if ( mode .eq. jpi$k_batch ) then
         in_batch = .true.
         else
         in_batch = .false.
         end if

      return
      end
