c-----------------------------------------------------------
c     Utility routines used in Physics 410  course and 
c     available in 'libp410f.a' on various machines.
c
c     Copyright Matthew W. Choptuik, 1988-2000
c
c     User routines:
c
c        i4arg
c        r8arg
c        getu
c        indlnb
c
c     Support routines
c
c        onedot
c        s2i4
c        s2r8
c-----------------------------------------------------------

c-----------------------------------------------------------
c     Converts argument 'argno' to integer*4 and returns 
c     value or 'defval' if parsing error or if argument is 
c     single dot ('.')
c-----------------------------------------------------------
      integer function i4arg(argno,defval)

         implicit       none
         
         real*8         r8_never
         parameter    ( r8_never = -1.0d-60 )

         integer        i4_never 
         parameter    ( i4_never = -2 000 000 000 )

         logical        onedot
         integer        iargc
         integer        s2i4

         integer        argno
         integer        defval

         character*32   argi

         if( argno .le. iargc() ) then
            call getarg(argno,argi)
            if( onedot(argi) ) then
               i4arg = defval
            else
               i4arg = s2i4(argi)
               if( i4arg .eq. i4_never ) then
                  i4arg = defval
               end if
            end if
         else
            i4arg = defval
         end if

         return

      end

c-----------------------------------------------------------
c     Converts argument 'argno' to real*8 and returns 
c     value or 'defval' if parsing error or if argument is 
c     single dot ('.')
c-----------------------------------------------------------
      double precision function r8arg(argno,defval)

         implicit       none
         
         real*8         r8_never
         parameter    ( r8_never = -1.0d-60 )

         integer        i4_never 
         parameter    ( i4_never = -2 000 000 000 )

         logical        onedot 
         integer        iargc
         real*8         s2r8

         integer        argno
         real*8         defval

         character*32   argi

         if( argno .le. iargc() ) then
            call getarg(argno,argi)
            if( onedot(argi) ) then
               r8arg = defval
            else 
               r8arg = s2r8(argi)
               if( r8arg .eq. r8_never ) then
                  r8arg = defval
               end if
            end if
         else
            r8arg = defval
         end if

         return

      end
 
c-----------------------------------------------------------
c     Returns index of last non-blank character in S.
c-----------------------------------------------------------
      integer function indlnb(s)
 
         character*(*)    s
         integer          i
 
         do indlnb = len(s) , 1 , -1
            if( s(indlnb:indlnb) .ne. ' ' ) RETURN
         end do
         indlnb = 0
 
         return
 
      end

c-----------------------------------------------------------
c     Returns first unit number .ge. umin not attached to 
c     a file.
c-----------------------------------------------------------
      integer function getu()

         implicit      none

         integer       umin
         parameter   ( umin = 10 )

         integer       umax
         parameter   ( umax = 99 )

         integer       u
         logical       opened

         getu = -1
         do u = umin , umax
            inquire(unit=u,opened=opened)
            if( .not. opened ) then
               getu = u
               return
            end if       
         end do
         write(0,*) 'getu: Panic--no available unit number'
         stop

      end

c-----------------------------------------------------------
c     Utility routine for parameter handling.
c-----------------------------------------------------------
      logical function onedot(s)

         character*(*)     s

         integer           indlnb

         onedot = s(1:1) .eq. '.'  .and.  indlnb(s) .eq. 1

         return

      end

c-----------------------------------------------------------
c     Converts string to integer.
c-----------------------------------------------------------
      integer function s2i4(s)

         implicit      none

         real*8       r8_never
         parameter  ( r8_never = -1.0d-60 )

         integer      i4_never 
         parameter  ( i4_never = -2 000 000 000 )

         integer       indlnb

         character*(*) s     

         character*32  buffer
         integer       lens

         integer       default
         parameter   ( default = 0 )

         lens = indlnb(s)
         if( lens .gt. 99 ) then
            write(*,*) '>>> s2i4:: String too long for conversion.'
            s2i4 = default
         else 
            if( lens .le. 9 ) then
               write(buffer,100) lens
            else 
               write(buffer,101) lens
            end if
 100        format('(I',i1,')')
 101        format('(I',i2,')')
            read(s,fmt=buffer,end=900,err=900) s2i4
         end if

         return

 900        s2i4 = i4_never
         return

      end

c-----------------------------------------------------------
c     Converts string to real*8 value.
c-----------------------------------------------------------
      double precision function s2r8(s)

         implicit      none

         real*8       r8_never
         parameter  ( r8_never = -1.0d-60 )

         integer      i4_never 
         parameter  ( i4_never = -2 000 000 000 )

         integer       indlnb

         character*(*) s     

         character*32  buffer
         integer       lens

         double precision default
         parameter      ( default = 0.0d0 )

         lens = indlnb(s)
         if( lens .gt. 99 ) then
            write(*,*) '>>> s2r8:: String too long for conversion.'
            s2r8 = default
         else 
            if( lens .le. 9 ) then
               write(buffer,100) lens
            else 
               write(buffer,101) lens
            end if
 100        format('(G',i1,'.0)')
 101        format('(G',i2,'.0)')
            read(s,fmt=buffer,end=900,err=900) s2r8
         end if

         return

 900        s2r8 = r8_never 
         return

      end
