APPENDIX D - WRITING AND READING A TEXTUAL HEADER IN UNFORMATTED FILES
 **********************************************************************


c     Write a text header of an unformatted file.
c     -------------------------------------------
      program writeh
      integer     inlun, outlun
      character   str*50
      write(*,*)    'Enter name of text file that contain the header: '
      read(*,'(A)') str
      call allocate_lun(inlun)
      call mix_open_text(str,inlun)
      write(*,*)    'Enter name of the unformatted file to create: '
      read(*,'(A)') str
      call allocate_lun(outlun)
      call mix_open_new_binary(str,outlun)
      call mix_write_text(inlun,outlun)
      end

c     Read a text header of an unformatted file.
c     ------------------------------------------
      program readh 
      integer     outlun
      character   str*50
      write(*,*)    'Enter name of binary file to read: '
      read(*,'(A)') str
      call allocate_lun(outlun)
      call mix_open_old_binary(str,outlun)
      call mix_read_text(outlun)
      end

   
c     ------------------------------------------------------------
c     Adding a new routine to a large program requires searching 
c     all "hardcoded" logical units, in order to find unused ones.
c     The following small routine may help, IF all other files
c     are ALREADY open.  The LUN range is small for portability.
c     ------------------------------------------------------------
      subroutine allocate_lun(lun)
      integer     lun, MINLUN, MAXLUN
      parameter   (MINLUN = 50, MAXLUN = 100)
      logical     log
      do lun = MINLUN, MAXLUN 
        inquire(unit=lun, opened=log)
        if (.not. log) return 
      end do
      stop 'allocate_lun: can''t allocate '
      end

c     Feel free to add the OPEN keywords you like
c     -------------------------------------------
      subroutine mix_open_text(fname,lun)
      character   fname*(*)
      integer     lun
      call allocate_lun(lun)
      open(unit=lun, file=fname, form='FORMATTED', status='OLD')
      return
      end

c     Feel free to add the OPEN keywords you like
c     -------------------------------------------
      subroutine mix_open_old_binary(fname,lun)
      character   fname*(*)
      integer     lun
      call allocate_lun(lun)
      open(unit=lun, file=fname, form='UNFORMATTED', status='OLD')
      return
      end

c     Feel free to add the OPEN keywords you like
c     -------------------------------------------
      subroutine mix_open_new_binary(fname,lun)
      character   fname*(*)
      integer     lun
      call allocate_lun(lun)
      open(unit=lun, file=fname, form='UNFORMATTED', status='NEW')
      return
      end

c     -----------------------------------------------------------
c     The procedure writes a text header of an unformatted file
c     BUGS: Actually, reading a short record into a larger string 
c           is disallowed by the FORTRAN 77 standard, and may 
c           break the routine on a compiler other than DEC's. 
c           See the remark in the next routine's header.
c     -----------------------------------------------------------
      subroutine mix_write_text(inlun,outlun)
      integer     outlun, inlun, inios, nline, MAXCOL
      parameter   (MAXCOL = 72)
      character   SIG*3, line*(MAXCOL)
      parameter   (SIG = '!  ')
      nline  = 0
      inios  = 0
c       Would be much nicer in Fortran 90...
      do while (inios .eq. 0)
        read(unit=inlun,fmt='(A)',iostat=inios) line
        if (inios .eq. 0) then
          write(unit=outlun) SIG, line
          nline = nline + 1
        endif
      end do
      if (nline .eq. 0) then
        write(*,*) 'mix_write_text: Input file empty? '
      else
        write(*,*) 'mix_write_text: Wrote ', nline, ' lines(s) '
      endif
      return
      end

c     ----------------------------------------------------------
c     The procedure reads the text header of an unformatted file
c     (if it exists), and display it on the screen (usually).
c     BUGS: see the remark in the previous routine.
c           If the first record after the text header is smaller
c           than MAXCOL, an I/O error ocurrs, and the position
c           in the file may be lost, making subsequent access
c           to the file risky.
c     ----------------------------------------------------------
      subroutine mix_read_text(lun)
      integer     lun, ios, nline, MAXCOL
      character   SIG*3
      parameter   (SIG = '!  ')
c       Many compilers can't handle an intrinsic function 
c       call at compile-time, replace "len(SIG)" with "3".
      parameter   (MAXCOL = 72 + len(SIG))
      character   line*(MAXCOL)
      logical     intext 
      nline  = 0
      ios    = 0
      intext = .true.
      do while (intext)
        read(unit=lun,iostat=ios) line
        if ((ios .eq. 0) .and. (line(1:3) .eq. SIG)) then
          write(*,*) line
          nline = nline + 1
        else
          intext = .false.
        endif
      end do
      backspace(unit=lun)
      if (nline .eq. 0) then
        write(*,*) 'mix_read_text: File has no text header '
      else
        write(*,*) 'mix_read_text: Read ', nline, ' lines(s) '
      endif
      return
      end