c             This file contains a set of utility subroutines.

c ======================================================================
c ======================================================================
      function concat(text1,text2)

c General information:

c     Function concat concatenates two strings.

c     This subroutine is used since standard Fortran does not allow
c     concatenation for assumed length character strings.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: the first string to concatenate:
      character*(*) text1
c        If the string is char(0) terminated and does not overflow, it
c     will be preserved.  Else, trailing blanks and control characters
c     will be truncated, but the first character will remain.

c     Input: the second string to concatenate:
      character*(*) text2

c     Output: the concatenated string:
      character*80 concat

c Local variables:

c     Index over the characters in string concat:
      integer i

c     The length of the truncated string:
      integer length

c Executable statements:

c     Put in the first string:
      concat=text1

c     Truncate it:
      do 100 i=80,1,-1
         length=i
         if(concat(i:i).gt.' ' .or. concat(i:i).eq.char(0))goto 110
 100  continue
 110  if(concat(length:length).eq.char(0))length=length-1

c     Add the second string after it:
      if(length.lt.80)concat(length+1:80)=text2

c Exit:

      return
      end

c ======================================================================
c ======================================================================
      subroutine bell(module)

c General information:

c     Subroutine bell rings a warning bell.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called bell:
      character*(*) module

c Info for compiling or changing subroutine bell:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cprt(module,text,nonewl) writes line "text" to the screen.
c     Nonzero "nonewl" suppresses the starting of a new line.
      external cprt

c Executable statements:

c     Output the bell character to standard output:
      call cprt(concat(module,'->bell'),char(7),1)

c Exit:

      return
      end

c ======================================================================
c ======================================================================
      subroutine cprt(module,text,nonewl)

c General information:

c     Subroutine cprt prints a line of text to the standard output,
c     usually the screen.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called cprt:
      character*(*) module

c     Input: line to print:
      character*(*) text
c        Trailing blanks and tabs will be truncated, as will a single
c     char(0) terminator. But the first character will always remain.

c     Input: nonzero to suppress starting a new line:
      integer nonewl

c Info for compiling or changing subroutine cprt:

c     This is a low level subroutine and should not use other subroutines.

c Local variables

c     Truncated line to print:
      character*79 line

c     Index over the characters in line:
      integer i

c     Truncated length of the string:
      integer length

c Executable statements:

c     Truncate the line:
      line=text
      do 100 i=79,1,-1
         length=i
         if(line(i:i).ne.' ' .and. line(i:i).ne.char(9))goto 101
 100  continue
 101  if(line(length:length).eq.char(0))length=max(1,length-1)

c     Print the line to standard output:
      if(nonewl.eq.0)then
         print110,line(1:length)
 110     format(' ',a)
      else
         print120,line(1:length)
 120     format(' ',a)
      endif

c Exit:

      return
      end

c ======================================================================
c ======================================================================
      subroutine cwrite(module,text,io,show)

c General information:

c     Subroutine cwrite outputs a line of text.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called cwrite:
      character*(*) module

c     Input: line to output:
      character*(*) text
c        Trailing blanks and tabs will be truncated, as will a single
c     char(0) terminator. But the first character will always remain.

c     Input: I/O unit of the output file (ignored if not positive):
      integer io

c     Input: nonzero if the line is to be shown on standard output:
      integer show

c Info for compiling or changing subroutine cwrite:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cprt(module,text,nonewl) writes line "text" to the screen.
c     Nonzero "nonewl" suppresses the starting of a new line.
      external cprt

c        ioerr(module,io,errnum,text1,text2,text3) kills the program
c     after a fatal I/O error on I/O unit "io", printing the lines
c     "text1", "text2", and "text3", and possibly other info based on
c     Fortran IOSTAT error code "errnum".
      external ioerr
      integer errnum

c Local variables

c     Truncated line to print:
      character*79 line

c     Index over the characters in line:
      integer i

c     Truncated length of the string:
      integer length

c Executable statements:

c     Truncate the line:
      line=text
      do 100 i=79,1,-1
         length=i
         if(line(i:i).ne.' ' .and. line(i:i).ne.char(9))goto 101
 100  continue
 101  if(line(length:length).eq.char(0))length=max(1,length-1)

c Executable statements:

c     Print the line:
      if(show.ne.0)call cprt(concat(module,'->cwrite'),text,0)

c     Write the line to the output file:
      if(io.gt.0)write(io,120,err=810,iostat=errnum)line(1:length)
 120  format(a)

c     All done:
      goto 900

c Exit:

c     Jump here on I/O errors:
 810  call ioerr('cwrite',io,errnum,
     & concat('Error while writing to the output file for module '//
     & char(0),concat(module,'.')),
     & concat('Tried to write: '//char(0),concat(text,'.')),
     &'No disk space? File protection? Program error?')

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine exit0(module)

c General information:

c     Subroutine exit0 exits the program after successful completion.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called exit0:
      character*(*) module

c Info for compiling or changing subroutine exit0:

c     Subroutine exit0 can be modified to return an error code

c Exit:

      stop
      end

c ======================================================================
c ======================================================================
      subroutine exit1(module,code)

c General information:

c     Subroutine exit1 kills the program after a fatal error.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called exit1:
      character*(*) module

c     Input: nonzero error code indicating the type of error:
      integer code

c Info for compiling or changing subroutine exit1:

c     Subroutine exit1 can be modified to return an error code

c Exit:

      stop
      end

c ======================================================================
c ======================================================================
      subroutine fatal(module,text1,text2,text3)

c General information:

c     Subroutine fatal exits the program after a fatal error has occurred.
c     But it first writes some info to the screen, including the lines
c     text1, text2, and text3, up to the first blank one.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called fatal:
      character*(*) module

c     Input: error information line 1:
      character*(*) text1
c     Input: error information line 2:
      character*(*) text2
c     Input: error information line 3:
      character*(*) text3

c External variables and info for compiling or changing subroutine fatal:

c     Required subroutines and functions:

c        bell(module) rings the terminal's warning bell.
      external bell

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cprt(module,text,nonewl) writes line "text" to the screen.
c     Nonzero "nonewl" suppresses the starting of a new line.
      external cprt

c        exit1(module,code) kills the program after a fatal error,
c     returning an error code "code" to the operating system.
      external exit1

c Executable statements:

c     Print the message:
      call bell(concat(module,'->fatal'))
      call cprt(concat(module,'->fatal'),
     & concat('*** '//char(0),
     & concat(module,': Program terminating on a fatal error:')),0)
      if(text1.eq.' ')goto 900
      call cprt(concat(module,'->fatal'),
     & concat('    '//char(0),text1),0)
      if(text2.eq.' ')goto 900
      call cprt(concat(module,'->fatal'),
     & concat('    '//char(0),text2),0)
      if(text3.eq.' ')goto 900
      call cprt(concat(module,'->fatal'),
     & concat('    '//char(0),text3),0)

c Exit:

c     Kill the program:
 900  call exit1(concat(module,'->fatal'),4)
c     For picky compilers:
      return
      end

c ======================================================================
c ======================================================================
      subroutine fclose(module,filnam,io)

c General information:

c     Subroutine fclose closes a file.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called fclose:
      character*(*) module

c     Input: name of the file to close:
      character*(*) filnam

c     Input: Fortan I/O unit number on which the file is open:
      integer io

c External variables and info for compiling or changing subroutine fclose:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        fatal(module,text1,text2,text3) kills the program after a
c     fatal error, printing the lines "text1", "text2" and "text3".
      external fatal

c        fio(module,io) sets "io" to a free I/O unit if zero, or marks
c     I/O unit "io" as open if positive or -"io" as free if negative.
      external fio

c        ioerr(module,io,errnum,text1,text2,text3) kills the program
c     after a fatal I/O error on I/O unit "io", printing the lines
c     "text1", "text2", and "text3", and possibly other info based on
c     Fortran IOSTAT error code "errnum".
      external ioerr
      integer errnum

c Executable statements:

c     Check the input unit:

      if(io.le.0)call fatal('fclose',
     & concat('While processing a file-close request for module '//
     & char(0),concat(module,'.')),
     &'Invalid I/O unit number specified.',
     &'Correct the program code.')

c     Mark the unit as no longer used:

      call fio(concat(module,'->fclose'),-io)

c     Close the file:

      close(io,err=810,iostat=errnum)

c     All done:

      goto 900

c Exit:

c     Jump here for various I/O errors:
 810  call ioerr('fclose',0,errnum,
     & concat('While processing a file-close request for module '//
     &  char(0),concat(module,'.')),
     & concat('Error while trying to close file '//char(0),
     &  concat(filnam,'.')),
     &'No disk space? File system? Program error?')

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine fcreat(module,filnam,io)

c General information:

c     Subroutine fcreat creates a new file.

c     Any existing file of the same name will be deleted.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called fcreat:
      character*(*) module

c     Input: name of the new file to create:
      character*(*) filnam

c     Input/Output: Fortran I/O unit number on which to open the file:
      integer io
c        If io is initialized to zero, subroutine fcreat will set it to
c     the next available I/O unit.

c External variables and info for compiling or changing subroutine fcreat:

c     Subroutine fcreat could be modified to ask for confirmation before
c     deleting any existing old file.

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        fatal(module,text1,text2,text3) kills the program after a
c     fatal error, printing the lines "text1", "text2" and "text3".
      external fatal

c        fio(module,io) sets "io" to a free I/O unit if zero, or marks
c     I/O unit "io" as open if positive or -"io" as free if negative.
      external fio

c        ioerr(module,io,errnum,text1,text2,text3) kills the program
c     after a fatal I/O error on I/O unit "io", printing the lines
c     "text1", "text2", and "text3", and possibly other info based on
c     Fortran IOSTAT error code "errnum".
      external ioerr
      integer errnum

c Local variables:

c     Whether an old version of the file exists:
      logical exists

c Executable statements:

c     Check the input unit:

      if(io.lt.0)call fatal('fcreat',
     & concat('While processing a new file request for module '//
     &  char(0),concat(module,'.')),
     &'Invalid I/O unit number specified.',
     &'Correct the program code.')

c     Get a valid I/O number or mark unit io as used:

      call fio(concat(module,'->fcreat'),io)

c     Delete any existing file:

      inquire(file=filnam,exist=exists,err=810,iostat=errnum)

      if(exists)then
         open(io,file=filnam,status='old',err=820,iostat=errnum)
         close(io,status='delete',err=830,iostat=errnum)
      endif

c     Open the new file:

      open(io,file=filnam,err=840,iostat=errnum)

c     All done:

      goto 900

c Exit:

c     Jump here for various I/O errors:
 810  call ioerr('fcreat',0,errnum,
     & concat('While processing a new file request for module '//
     &  char(0),concat(module,'.')),
     & concat('Error while checking for an existing file '//char(0),
     &  concat(filnam,'.')),
     &'Check the file name and the file system.')
 820  call ioerr('fcreat',0,errnum,
     & concat('While processing a new file request for module '//
     &  char(0),concat(module,'.')),
     & concat('Error accessing existing file '//char(0),
     &  concat(filnam,'.')),
     &'Check the file protection and availability.')
 830  call ioerr('fcreat',0,errnum,
     & concat('While processing a new file request for module '//
     &  char(0),concat(module,'.')),
     & concat('Error deleting existing file '//char(0),
     &  concat(filnam,'.')),
     &'Check the file protection and file system.')
 840  call ioerr('fcreat',0,errnum,
     & concat('While processing a new file request for module '//
     &  char(0),concat(module,'.')),
     & concat('Error creating new file '//char(0),concat(filnam,'.')),
     &'No disk space? Invalid filename? Directory protection?')

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine fio(module,io)

c General information:

c     Subroutine fio manages the Fortran I/O unit numbers.
c     It keeps track of free unit numbers and can return the next
c     available unit number.  It will avoid the usually reserved
c     unit numbers 5, 6, and 7 unless they are first released.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called fio:
      character*(*) module

c     Input/Output: the Fortran I/O unit number.
      integer io
c        If io is zero, it will be set to the next free I/O unit, and
c     subroutine fio marks this unit as no longer free.
c        If io is positive, it will marked as no longer free. Call fio
c     before actually opening the file.
c        If io is negative, it will be marked as free. Call fio before
c     actually closing the file.

c External variables and info for compiling or changing subroutine fio:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cprt(module,text,nonewl) writes line "text" to the screen.
c     Nonzero "nonewl" suppresses the starting of a new line.
      external cprt

c        fatal(module,text1,text2,text3) kills the program after a
c     fatal error, printing the lines "text1", "text2" and "text3".
      external fatal

c        ioerr(module,io,errnum,text1,text2,text3) kills the program
c     after a fatal I/O error on I/O unit "io", printing the lines
c     "text1", "text2", and "text3", and possibly other info based on
c     Fortran IOSTAT error code "errnum".
      external ioerr
      integer errnum

c        iwrite(module,text,val,io,show) writes integer "val" and its
c     description "text" to I/O unit "io" if nonzero, and to the screen
c     if "show" is nonzero.
      external iwrite

c Local variables:

c     Whether we have been initialized:
      integer init

c     The largest I/O unit number to use:
      integer maxio
      parameter(maxio=99)

c     The table of I/O unit numbers:
      integer table(maxio)
      save table

c     Index in the table:
      integer i

c     Whether the I/O unit is open:
      logical open

c     Whether we have warned for a lot of open files:
      integer warned

c     Data statements:
      data init/0/
      data warned/0/

c Executable statements:

c Initialize the table of I/O unit numbers:

      if(init.eq.0)then
c        Mark all unit numbers except the standard ones as free:
         do 100 i=1,maxio
            table(i)=-i
            if(i.ge.5 .and. i.le.7)table(i)=i
 100     continue
         init=1
      endif

c For io = 0, return the lowest free I/O unit number:

      if(io.eq.0)then

c        Search the table for the first unit not marked as opened:

         do 210 i=1,maxio

            if(table(i).ge.0)goto 210
            io=i

c           Do not check standard units 5 and 6 any further
            if(io.eq.5 .or. io.eq.6)goto 290

c           Check whether the unit is really free:
            inquire(i,opened=open,err=810,iostat=errnum)
            if(.not.open)goto 290

c           Correct the table entry:
            table(i)=i
            call cprt(concat(module,'->fio'),concat('*** fio: '//
     &       'While processing an I/O unit request for module '//
     &        char(0),concat(module,'.')),0)
            call iwrite(concat(module,'->fio'),'    Warning: '//
     &      'I/O unit marked as free is in use. Unit number',i,0,1)

 210     continue

c        Seemingly no free units. Search the hard way:

         do 220 i=1,maxio

c           Ignore the standard units in this search:
            if(i.ge.5 .and. i.le.7)goto 220

c           Check whether the unit is really closed:
            inquire(i,opened=open,err=820,iostat=errnum)
            if(.not.open)then
               io=i
               call cprt(concat(module,'->fio'),concat('*** fio: '//
     &         'While processing an I/O unit request for module '//
     &          char(0),concat(module,'.')),0)
               call iwrite(concat(module,'->fio'),'    Warning: '//
     &         'I/O unit marked as in use is free. Unit number',i,0,1)
               goto 290
            endif

 220     continue

c        Nothing free:

         call fatal('fio',
     &    concat('While searching for a free I/O unit for module '//
     &     char(0),concat(module,'.')),
     &   'No free I/O units were found.',
     &   'Please check the program code.')

c        Exit:

 290     table(io)=io
         if(warned.ne.0 .or. io.lt.9)goto 900
         warned=1
         call cprt(concat(module,'->fio'),'*** fio: '//
     &   'Warning: the program is using a lot of I/O units.',0)
         goto 900

      endif

c For io > 0, mark unit I/O as in use:

      if(io.gt.0)then

c        Check that the unit is still free:
         inquire(io,opened=open,err=830,iostat=errnum)
         if(open)then
            call iwrite(concat(module,'->fio'),
     &      '    fio: Checking new I/O unit number',io,0,1)
            call fatal(concat(module,'->fio'),
     &      'The selected I/O number is already open.',
     &      'Check the program code.',' ')
         endif

c        Update the table:
         if(io.lt.maxio)table(io)=io
         goto 900

      endif

c For io < 0, mark unit I/O as free:

      if(io.lt.0)then

c        Check that the unit is still open:
         inquire(-io,opened=open,err=840,iostat=errnum)
         if(.not.open)then
            call iwrite(concat(module,'->fio'),
     &      '    Checking existing I/O unit number',-io,0,1)
            call fatal(concat(module,'->fio'),
     &      'The selected I/O number is closed.',
     &      'Check the program code.',' ')
         endif

c        Update the table:
         if(-io.lt.maxio)table(-io)=io
         goto 900

      endif

c Exit:

c     Jump here for various I/O errors:
 810  call ioerr('fio',0,errnum,
     & concat('While processing an I/O unit request from module '//
     &  char(0),concat(module,'.')),
     &'Error while checking a seemingly free I/O unit number.',
     &'Check the program code.')
 820  call ioerr('fio',0,errnum,
     & concat('While processing an I/O unit request from module '//
     &  char(0),concat(module,'.')),
     &'Error while checking a seemingly taken I/O unit number.',
     &'Check the program code.')
 830  call ioerr('fio',0,errnum,
     & concat('While checking a new I/O unit number for module '//
     &  char(0),concat(module,'.')),
     &'Error while checking the I/O unit number.',
     &'Check the program code.')
 840  call ioerr('fio',0,errnum,
     & concat('While checking an old I/O unit for module '//char(0),
     &  concat(module,'.')),
     &'Error while checking the I/O unit number.',
     &'Check the program code.')

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine fopen(module,filnam,io)

c General information:

c     Subroutine fopen opens an existing file for reading.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called fopen:
      character*(*) module

c     Input: name of the file to open:
      character*(*) filnam

c     Input: Fortan I/O unit number on which to open the file:
      integer io
c        If io is initialized to zero, subroutine fopen will set it to
c     the next available I/O unit.

c External variables and info for compiling or changing subroutine fopen:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        fatal(module,text1,text2,text3) kills the program after a
c     fatal error, printing the lines "text1", "text2" and "text3".
      external fatal

c        fio(module,io) sets "io" to a free I/O unit if zero, or marks
c     I/O unit "io" as open if positive or -"io" as free if negative.
      external fio

c        ioerr(module,io,errnum,text1,text2,text3) kills the program
c     after a fatal I/O error on I/O unit "io", printing the lines
c     "text1", "text2", and "text3", and possibly other info based on
c     Fortran IOSTAT error code "errnum".
      external ioerr
      integer errnum

c Local variables:

c     Whether the file exists:
      logical exists

c Executable statements:

c     Check for the existence of the file:

      inquire(file=filnam,exist=exists,err=810,iostat=errnum)
      if(.not.exists)call fatal('fopen',
     & concat('While processing a file-open request for module '//
     &  char(0),concat(module,'.')),
     & concat('The file '//char(0),
     &  concat(filnam,' to open does not exist.')),
     &'Create it first.')

c     Check the input unit:

      if(io.lt.0)call fatal('fopen',
     & concat('While processing a file-open request for module '//
     &  char(0),concat(module,'.')),
     &'Invalid I/O unit number specified.',
     &'Correct the program code.')

c     Get a valid I/O number or mark unit io as used:

      call fio(concat(module,'->fopen'),io)

c     Open the file:

      open(io,file=filnam,err=820,iostat=errnum)

c     All done:

      goto 900

c Exit:

c     Jump here for various I/O errors:
 810  call ioerr('fopen',0,errnum,
     & concat('While processing a file-open request for module '//
     &  char(0),concat(module,'.')),
     & concat('Error while looking for the file '//char(0),
     &  concat(filnam,' to open.')),
     &'Check the file name and file system.')
 820  call ioerr('fopen',0,errnum,
     & concat('While processing a file-open request for module '//
     &  char(0),concat(module,'.')),
     & concat('Error while trying to open the file '//char(0),
     &  concat(filnam,'.')),
     &'No disk space? File protection? Directory protection?')

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      function iask(module,text,io)

c General information:

c     Function iask obtains an integer number from the user.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called iask:
      character*(*) module

c     Input: description of the number (not more than about 40 characters):
      character*(*) text

c     Input: I/O unit of the output file (ignored if not positive):
      integer io

c     Output: value of the number as entered by the user.
      integer iask

c External variables and info for compiling or changing function iask:

c     Required subroutines and functions:

c        bell(module) rings the terminal's warning bell.
      external bell

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cprt(module,text,nonewl) writes line "text" to the screen.
c     Nonzero "nonewl" suppresses the starting of a new line.
      external cprt

c        fatal(module,text1,text2,text3) kills the program after a
c     fatal error, printing the lines "text1", "text2" and "text3".
      external fatal

c        iwrite(module,text,val,io,show) writes integer "val" and its
c     description "text" to I/O unit "io" if nonzero, and to the screen
c     if "show" is nonzero.
      external iwrite

c Local variables:

c     Fortran IOSTAT error code:
      integer errnum

c Executable statements:

c     Write the prompt:
      call cprt(concat(module,'->iask'),
     & concat('Please enter '//char(0),concat(text,': '//char(0))),2)
      goto 190
 120  if(errnum.lt.0)goto 810
      call bell(concat(module,'->iask'))
      call cprt(concat(module,'->iask'),
     &'*** iask: Unable to read the integer value you entered.',0)
      call cprt(concat(module,'->iask'),concat(
     &'    Please reenter '//char(0),concat(text,': '//char(0))),2)
 190  continue

c     Read the integer:
      read(*,*,err=120,end=810,iostat=errnum)iask

c     Output the integer:
      call iwrite(concat(module,'->iask'),
     & concat('Entered value of '//char(0),text),iask,io,0)

c     All done:
      goto 900

c Exit:

c     Jump here on I/O errors:
 810  call fatal('iask',concat(
     & 'Input closed while trying to read an integer for module '//
     &  char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),' ')

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine ioerr(module,io,errnum,text1,text2,text3)

c General information:

c     Subroutine ioerr kills the program after a fatal I/O error has
c     occurred.

c     Before terminating the program, ioerr first prints some info,
c     including the lines text1, text2, and text3, up to the first blank
c     one. The last nonblank line should be a suggestion to the user how
c     to fix the error, such as 'Check your disk.'  Subroutine ioerr
c     will leave this suggestion away if it can figure out exactly what
c     is wrong from code errnum.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c      implicit none

c     Subroutine that called ioerr:
      character*(*) module

c     Input: the I/O unit on which the error occurred:
      integer io

c     Input: the error number returned by the IOSTAT parameter:
      integer errnum

c     Error description line 1:
      character*(*) text1
c     Error description line 2:
      character*(*) text2
c     Error description line 3:
      character*(*) text3

c External variables and info for compiling or changing subroutine ioerr:

c     Subroutine ioerr may be made more informative by processing the
c     error code as given by your compiler.  However, this will also
c     make it more specific for a certain compiler and hardware.

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cprt(module,text,nonewl) writes line "text" to the screen.
c     Nonzero "nonewl" suppresses the starting of a new line.
      external cprt

c        exit1(module,code) kills the program after a fatal error,
c     returning an error code "code" to the operating system.
      external exit1

c        itoc(val,string,length) writes integer "val" into character*25
c     "string" and returns the length of the resulting string "length".
      external itoc

c Local variables:

c     The IOSTAT error code as a string:
      character*25 cerr
c     The length of this string:
      integer cerrlt

c     The file name:
      character*132 nam

c     Number of nonblank characters in the file name:
      integer namlt

c     Character index in the file name:
      integer i

c     Our number for the fix to apply:
      integer havfix

c Executable statements:

c     Print the header:

      call cprt(concat(module,'->ioerr'),
     & concat('*** '//char(0),concat(module,': Fatal I/O error:')),0)

c     Print the file name:

      if(io.le.0)goto 190
      nam=' '
      inquire(io,name=nam,err=190)
      do 100 i=132,1,-1
         namlt=i
         if(nam(i:i).gt.' ' .and. nam(i:i).le.char(126))goto 120
 100  continue
      goto 190
 120  call cprt(concat(module,'->ioerr'),'    File: '//nam(1:namlt),0)
 190  continue

c     Process the error code:

c     Start by assuming that we do not have any error code:
      havfix=1
c     If errnum is nonzero, assume that the error code will be unknown:
      if(errnum.ne.0)havfix=2
c     Negative errnum probably indicates end-of-file:
      if(errnum.lt.0)havfix=3

c     Write the message lines, leaving the last one away if we have
c     already shown the fix to apply based on the value of errnum:

      if(text1.eq.' ')goto 290
      if(havfix.gt.2 .and. text2.eq.' ')goto 290
      call cprt(concat(module,'->ioerr'),
     & concat('    '//char(0),text1),0)
      if(text2.eq.' ')goto 290
      if(havfix.gt.2 .and. text3.eq.' ')goto 290
      call cprt(concat(module,'->ioerr'),
     & concat('    '//char(0),text2),0)
      if(text3.eq.' ' .or. havfix.gt.2)goto 290
      call cprt(concat(module,'->ioerr'),
     & concat('    '//char(0),text3),0)
 290  continue

c     Write information obtained from the error code errnum:

      goto(410,420,430),havfix
 410  goto 900
 420  call itoc(errnum,cerr,cerrlt)
      call cprt(concat(module,'->ioerr'),
     & '    IOSTAT error code: '//cerr(1:cerrlt),0)
      goto 900
 430  call cprt(concat(module,'->ioerr'),
     &'    A premature end-of-file occurred: check that the file is',0)
      call cprt(concat(module,'->ioerr'),
     &'    complete and that the last line is empty.',0)
      goto 900

c Exit:

c     Kill the program:
 900  call exit1(concat(module,'->ioerr'),8)
c     For picky compilers:
      return
      end

c ======================================================================
c ======================================================================
      function iread(module,text,ioin,io,show)

c General information:

c     Function iread obtains an integer number from the input file.

c     It can write the value of the number, with its description text,
c     to the output file and standard output.

c     It assumes that the number is the first nonblank part of the line.
c     Hence, comment lines may be freely inserted before the line with
c     the number as long as the comment lines do not start with a digit
c     or sign.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called iread:
      character*(*) module

c     Input: description of the integer (not more than about 40 characters):
      character*(*) text

c     Input: I/O unit of the input file:
      integer ioin

c     Input: I/O unit of the output file (ignored if not positive):
      integer io

c     Input: nonzero if the number is to be shown on standard output:
      integer show

c     Output: value of the integer as read from the file.
      integer iread

c External variables and info for compiling or changing function iread:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        fatal(module,text1,text2,text3) kills the program after a
c     fatal error, printing the lines "text1", "text2" and "text3".
      external fatal

c        ioerr(module,io,errnum,text1,text2,text3) kills the program
c     after a fatal I/O error on I/O unit "io", printing the lines
c     "text1", "text2", and "text3", and possibly other info based on
c     Fortran IOSTAT error code "errnum".
      external ioerr
      integer errnum

c        iwrite(module,text,val,io,show) writes integer "val" and its
c     description "text" to I/O unit "io" if nonzero, and to the screen
c     if "show" is nonzero.
      external iwrite

c Local variables:

c     Character line read from the input file:
      character*133 inline

c     Character pointer:
      integer i

c     Position of the first nonblank character in the line:
      integer first

c     Position of the last character of the integer in the line:
      integer last

c     Position of the first digit in the line:
      integer digit

c Executable statements:

c     Read the next line from the input file:
 100  read(ioin,110,err=810,end=811,iostat=errnum)inline
 110  format(a133)

c     Skip past leading blanks:
      do 200 i=1,133
         first=i
         if(inline(i:i).gt.' ' .and. inline(i:i).le.char(126))goto 210
 200  continue
c     Line is blank. Next line.
      goto 100
 210  continue

c     Next line if this one does not start with a number:
      digit=first
      if(inline(first:first).eq.'+' .or.
     & inline(first:first).eq.'-')digit=first+1
      if(digit.gt.133)goto 100
      if(inline(digit:digit).lt.'0' .or.
     & inline(digit:digit).gt.'9')goto 100

c     Terminate the number string at any reasonable terminator:
      do 300 i=digit+1,133
         last=i-1
         if(inline(i:i).ge.'0' .and. inline(i:i).le.'9')goto 300
         goto 310
 300  continue
      call fatal('iread',
     & concat('Error while reading the input file in module '//
     &  char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),
     &'Unrecognized integer: '//inline(1:47))
 310  continue

c     Read the integer:
      if(first.gt.1)inline(1:first-1)=' '
      inline(last+1:133)=' '
      read(inline,410,err=820,iostat=errnum)iread
 410  format(bn,i133)

c     Output the integer:
      call iwrite(concat(module,'->iread'),text,iread,io,show)

c     All done:
      goto 900

c Exit:

c     Jump here on I/O errors:
 810  call ioerr('iread',ioin,errnum,
     & concat('Error while reading the input file in module '//
     &  char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),
     &'Check the file system.')
 811  call ioerr('iread',ioin,errnum,
     & concat('End-of-file while reading the input file in module '//
     &  char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),
     &'Check the input file.')
 820  call ioerr('iread',0,errnum,
     & concat('Error while reading the input file in module '//
     &  char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),
     &'Unrecognized integer: '//inline(1:47))

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine itoc(val,string,length)

c General information:

c     Subroutine itoc writes an integer to a character*25 string.
c     On errors, length is set to 3 and string(1:3) to '***'.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: integer to convert:
      integer val

c     Output: integer val as a character string:
      character*25 string

c     Output: length of the string:
      integer length

c Info for compiling or changing subroutine itoc:

c     Subroutine itoc could be modified to exame the IOSTAT code on errors.

c Local variables:

c     Index over the string:
      integer i

c     First and last nonblank characters in the string:
      integer first,last

c Executable statements:

c     Write the number to the string:
      string=' '
      write(string,10,err=810)val
 10   format(i25)

c     Find the first nonblank character:
      do 110 i=1,25
         first=i
         if(string(i:i).gt.' ' .and. string(i:i).le.char(126))goto 111
 110  continue
      goto 700
 111  continue

c     Find the last nonblank character:
      do 120 i=25,first,-1
         last=i
         if(string(i:i).gt.' ' .and. string(i:i).le.char(126))goto 121
 120  continue
      goto 700
 121  continue

c     Kill the leading blanks:
      do 130 i=first,last
         string(i-first+1:i-first+1)=string(i:i)
 130  continue
      length=last-first+1

c     All done:
      goto 900

c Exit:

c     Jump here when we cannot write it:
 700  length=3
      string(1:3)='***'
      goto 900
c     Jump here on I/O errors:
 810  goto 700

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine iwrite(module,text,val,io,show)

c General information:

c     Subroutine iwrite outputs the value of an integer number.

c     If argument io is positive, subroutine iwrite writes description
c     text and integer val to Fortran I/O unit io.

c     If argument show is nonzero, subroutine iwrite prints description
c     text and integer val on the standard output device.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called iwrite:
      character*(*) module

c     Input: description of the integer (not more than about 40 characters):
      character*(*) text

c     Input: value of the integer to print:
      integer val

c     Input: I/O unit of the output file (ignored if not positive):
      integer io

c     Input: nonzero if the number is to be shown on standard output:
      integer show

c External variables and info for compiling or changing subroutine iwrite:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cwrite(module,text,io,show) writes line "text" to I/O unit
c     "io" if nonzero, and to the screen if "show" is nonzero.
      external cwrite

c        itoc(val,string,length) writes integer "val" into character*25
c     "string" and returns the length of the resulting string "length".
      external itoc

c Local variables:

c     Integer val as a character string:
      character*25 string

c     Length of the character string:
      integer length

c Executable statements:

c     Convert the integer to a string:
      call itoc(val,string,length)

c     Write the line:
      call cwrite(concat(module,'->iwrite'),
     & concat(text,': '//string(1:length)),io,show)

c     All done:
      goto 900

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      function rask(module,text,io)

c General information:

c     Function rask obtains a real number from the user.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called rask:
      character*(*) module

c     Input: description of the number (not more than about 40 characters):
      character*(*) text

c     Input: I/O unit of the output file (ignored if not positive):
      integer io

c     Output: value of the number as entered by the user.
      double precision rask

c External variables and info for compiling or changing function rask:

c     Required subroutines and functions:

c        bell(module) rings the terminal's warning bell.
      external bell

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cprt(module,text,nonewl) writes line "text" to the screen.
c     Nonzero "nonewl" suppresses the starting of a new line.
      external cprt

c        fatal(module,text1,text2,text3) kills the program after a
c     fatal error, printing the lines "text1", "text2" and "text3".
      external fatal

c        rwrite(module,text,val,io,show) writes number "val" and its
c     description "text" to I/O unit "io" if nonzero, and to the screen
c     if "show" is nonzero.
      external rwrite

c Local variables:

c     Fortran IOSTAT error code:
      integer errnum

c Executable statements:

c     Write the prompt:
      call cprt(concat(module,'->rask'),
     & concat('Please enter '//char(0),concat(text,': '//char(0))),1)
      goto 190
 120  if(errnum.lt.0)goto 810
      call bell(concat(module,'->rask'))
      call cprt(concat(module,'->rask'),
     &'*** rask: Unable to read the number you entered.',0)
      call cprt(concat(module,'->rask'),concat(
     &'    Please reenter '//char(0),concat(text,': '//char(0))),1)
 190  continue

c     Read the number:
      read(*,*,err=120,end=810,iostat=errnum)rask

c     Output the number:
      call rwrite(concat(module,'->rask'),
     & concat('Entered value of '//char(0),text),rask,io,0)

c     All done:
      goto 900

c Exit:

c     Jump here on I/O errors:
 810  call fatal('rask',concat(
     & 'Input closed while trying to read a number for module '//
     &  char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),' ')

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      function rread(module,text,ioin,io,show)

c General information:

c     Function rread obtains a real number from the input file.

c     It can write the value of the number, with its description text,
c     to the output file and standard output.

c     It assumes that the number is the first nonblank part of the line.
c     Hence, comment lines may be freely inserted before the line with
c     the number as long as the comment lines do not start with a digit,
c     sign, or decimal point.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called rread:
      character*(*) module

c     Input: description of the number (not more than about 40 characters):
      character*(*) text

c     Input: I/O unit of the input file:
      integer ioin

c     Input: I/O unit of the output file (ignored if not positive):
      integer io

c     Input: nonzero if the number is to be shown on standard output:
      integer show

c     Output: value of the number as read from the file.
      double precision rread

c External variables and info for compiling or changing function rread:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        fatal(module,text1,text2,text3) kills the program after a
c     fatal error, printing the lines "text1", "text2" and "text3".
      external fatal

c        ioerr(module,io,errnum,text1,text2,text3) kills the program
c     after a fatal I/O error on I/O unit "io", printing the lines
c     "text1", "text2", and "text3", and possibly other info based on
c     Fortran IOSTAT error code "errnum".
      external ioerr
      integer errnum

c        rwrite(module,text,val,io,show) writes number "val" and its
c     description "text" to I/O unit "io" if nonzero, and to the screen
c     if "show" is nonzero.
      external rwrite

c Local variables:

c     Character line read from the input file:
      character*133 inline

c     Character pointer:
      integer i

c     Position of the first nonblank character in the line:
      integer first

c     Position of the last character of the number string in the line:
      integer last

c     Position of the first digit in the line:
      integer digit

c Executable statements:

c     Read the next line from the input file:
 100  read(ioin,110,err=810,end=811,iostat=errnum)inline
 110  format(a133)

c     Skip past leading blanks:
      do 200 i=1,133
         first=i
         if(inline(i:i).gt.' ' .and. inline(i:i).le.char(126))goto 210
 200  continue
c     Line is blank. Next line.
      goto 100
 210  continue

c     Next line if this one does not start with a number:
      digit=first
      if(inline(first:first).eq.'.' .or.
     & inline(first:first).eq.'+' .or.
     & inline(first:first).eq.'-')digit=first+1
      if(digit.gt.133)goto 100
      if(inline(digit:digit).lt.'0' .or.
     & inline(digit:digit).gt.'9')goto 100

c     Terminate the number string at any reasonable terminator:
      do 300 i=digit+1,133
         last=i-1
         if(inline(i:i).ge.'0' .and. inline(i:i).le.'9')goto 300
         if(inline(i:i).eq.'E' .or. inline(i:i).eq.'e')goto 300
         if(inline(i:i).eq.'D' .or. inline(i:i).eq.'d')goto 300
         if(inline(i:i).eq.'+' .or. inline(i:i).eq.'-')goto 300
         goto 310
 300  continue
      call fatal('rread',
     & concat('Error while reading the input file in module '//
     & char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),
     &'Unrecognized number: '//inline(1:48))
 310  continue

c     Read the number:
      if(first.gt.1)inline(1:first-1)=' '
      inline(last+1:133)=' '
      read(inline,410,err=820,iostat=errnum)rread
 410  format(bn,f133.0)

c     Output the number:
      call rwrite(concat(module,'->rread'),text,rread,io,show)

      goto 900

c Exit:

c     Jump here on I/O errors:
 810  call ioerr('rread',ioin,errnum,
     & concat('Error while reading the input file in module '//
     &  char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),
     &'Check the file system.')
 811  call ioerr('rread',ioin,errnum,
     & concat('End-of-file while reading the input file in module '//
     &  char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),
     &'Check the input file.')
 820  call ioerr('rread',0,errnum,
     & concat('Error while reading the input file in module '//
     &  char(0),concat(module,'.')),
     & concat('Tried to read: '//char(0),concat(text,'.')),
     &'Unrecognized number: '//inline(1:48))

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine rtoc(val,string,length)

c General information:

c     Subroutine rtoc writes a real number to a character*25 string.
c     On errors, length is set to 3 and string(1:3) to '***'.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: number to convert:
      double precision val

c     Output: integer val as a character string:
      character*25 string

c     Output: length of the string:
      integer length

c Info for compiling or changing subroutine rtoc:

c     Subroutine rtoc could be modified to exame the IOSTAT code on errors.

c Local variables:

c     Index over the string:
      integer i

c     First and last nonblank characters in the string:
      integer first,last

c Executable statements:

c     Write the number to the string:
      string=' '
      write(string,10,err=810)val
 10   format(g25.7)

c     Find the first nonblank character:
      do 110 i=1,25
         first=i
         if(string(i:i).gt.' ' .and. string(i:i).le.char(126))goto 111
 110  continue
      goto 700
 111  continue

c     Find the last nonblank character:
      do 120 i=25,first,-1
         last=i
         if(string(i:i).gt.' ' .and. string(i:i).le.char(126))goto 121
 120  continue
      goto 700
 121  continue

c     Kill the leading blanks:
      do 130 i=first,last
         string(i-first+1:i-first+1)=string(i:i)
 130  continue
      length=last-first+1

c     All done:
      goto 900

c Exit:

c     Jump here when we cannot write it:
 700  length=3
      string(1:3)='***'
      goto 900
c     Jump here on I/O errors:
 810  goto 700

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine rwrite(module,text,val,io,show)

c General information:

c     Subroutine rwrite outputs the value of a real number.

c     If argument io is positive, subroutine rwrite writes description
c     text and real number val to Fortran I/O unit io.

c     If argument show is nonzero, subroutine rwrite prints description
c     text and real number val on the standard output device.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c     Avoid typos:
c      implicit none

c     Input: program or subroutine that called rwrite:
      character*(*) module

c     Input: description of the number (not more than about 40 characters):
      character*(*) text

c     Input: value of the number to print:
      double precision val

c     Input: I/O unit of the output file (ignored if not positive):
      integer io

c     Input: nonzero if the number is to be shown on standard output:
      integer show

c External variables and info for compiling or changing subroutine rwrite:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cwrite(module,text,io,show) writes line "text" to I/O unit
c     "io" if nonzero, and to the screen if "show" is nonzero.
      external cwrite

c        rtoc(val,string,length) writes number "val" into character*25
c     "string" and returns the length of the resulting string "length".
      external rtoc

c Local variables:

c     Number val as a character string:
      character*25 string

c     Length of the character string:
      integer length

c Executable statements:

c     Convert the number to a string:
      call rtoc(val,string,length)

c     Write the line:
      call cwrite(concat(module,'->rwrite'),
     & concat(text,': '//string(1:length)),io,show)

c     All done:
      goto 900

c Exit:

c     Jump here when done:
 900  return
      end

c ======================================================================
c ======================================================================
      subroutine warn(module,io,text1,text2,text3)

c General information:

c     Subroutine warn writes a warning to the screen, and also to the file
c     open on I/O unit io, if positive, and then resumes execution.

c     Copyright 1996 Leon van Dommelen
c     Version 1.0 Leon van Dommelen 12/16/96

c Arguments:

c      implicit none

c     Input: program or subroutine that called warn:
      character*(*) module

c     Input: I/O unit to also write the warning to (only used if positive):
      integer io

c     Input: warning line 1 (must be nonempty):
      character*(*) text1
c     Input: warning line 2:
      character*(*) text2
c     Input: warning line 3:
      character*(*) text3

c External variables and info for compiling or changing subroutine warn:

c     Required subroutines and functions:

c        concat(text1,text2) concatenates strings "text1" and "text2".
      character*80 concat
      external concat

c        cwrite(module,text,io,show) writes line "text" to I/O unit
c     "io" if nonzero, and to the screen if "show" is nonzero.
      external cwrite

c Executable statements:

c     Print the message:
      call cwrite(concat(module,'->warn'),
     & concat('*** '//char(0),concat(module,
     &  concat(': Warning: '//char(0),text1))),io,1)
      if(text2.eq.' ')goto 900
      call cwrite(concat(module,'->warn'),
     & concat('    '//char(0),text2),io,1)
      if(text3.eq.' ')goto 900
      call cwrite(concat(module,'->warn'),
     & concat('    '//char(0),text3),io,1)
      goto 900

c Exit:

c     Jump here when done:
 900  return
      end