c
c     Copyright (c) 1999,2000, Compaq Computer Corporation
c
c     See the file "license.terms" for information on usage and redistribution
c     of this file, and for a DISCLAIMER OF ALL WARRANTIES.
c
c    General utility routines
c
      subroutine upcase(string)
      implicit none
c
      character*(*) string
c
c     converts ASCII string to upper case
c
      integer i, strlen, ICHAR
      character*1 CHAR
c
      strlen = LEN(string)
      do 10 i=1,strlen
c        if character is between 'a' and 'z', convert to upper
         if( string(i:i) .ge. 'a' .and. string(i:i) .le. 'z' ) then
            string(i:i) = CHAR(ICHAR(string(i:i)) - 32 )
         endif
10    continue
      return
      end
c
      subroutine lowercase(string)
      implicit none
c
      character*(*) string
c
c     converts ASCII string to lower case
c
      integer i, strlen, ICHAR
      character*1 CHAR
c
      strlen = LEN(string)
      do 10 i=1,strlen
c        if character is between 'A' and 'Z', convert to upper
         if( string(i:i) .ge. 'A' .and. string(i:i) .le. 'Z' ) then
            string(i:i) = CHAR(ICHAR(string(i:i)) + 32 )
         endif
10    continue
      return
      end
c
      real function round_up_mant(value)
      implicit none
c
      real value
c
c     Function rounds mantissa of real number up to nearest whole number.
c     Examples:
c     1.66E1 -> 2.00E1; -1.45E23 -> -1.00E23
c
      real x, log10x, mantissa
      integer exponent
      logical is_negative
c
      x = value
      if ( x .eq. 0.0 ) then
         round_up_mant = 0.0
         return
      endif
c
      if( x .lt. 0.0 ) then
         is_negative = .TRUE.
         x = - x
      else
         is_negative = .FALSE.
      endif
c
      log10x = ALOG10(x)
      exponent = INT( log10x )
      mantissa = 10.0**( log10x - FLOAT(exponent) )
c
      if( is_negative ) then
         mantissa = - float( int(mantissa) )
      else
         mantissa = float( int(mantissa) + 1)
      endif
c
      round_up_mant = mantissa * 10.0**exponent
      return
      end
c
      real function round_down_mant(value)
      implicit none
c
      real value
c
c     Function rounds mantissa of value down to nearest whole number.
c
      real x, log10x, mantissa
      integer exponent
      logical is_negative
c
      x = value
      if ( x .eq. 0.0 ) then
         round_down_mant = 0.0
         return
      endif
c
      if( x .lt. 0.0 ) then
         is_negative = .TRUE.
         x = - x
      else
         is_negative = .FALSE.
      endif
c
      log10x = ALOG10(x)
      exponent = INT( log10x )
      mantissa = 10.0**( log10x - FLOAT(exponent) )
c
      if( is_negative ) then
         mantissa = - float( int(mantissa) + 1)
      else
         mantissa = float( int(mantissa) )
      endif
c
      round_down_mant = mantissa * 10.0**exponent
      return
      end
c
      real function round_up_whole(value)
c
      implicit none
      real value
c
c     Function rounds real number to up to next larger integer
c       and converts to real.
c     Real number must be in range of integer on VAX
c
      real LARGEINT, temp
      parameter ( LARGEINT = 2.0E9 ) ! about 2**31
c
      if( value .gt. LARGEINT .or. value .lt. -LARGEINT ) then
         round_up_whole = 0.0
         write(6,100)
100      format(' ','Error (round_up_whole): argument too large')
         return
      endif
c
c     Special cases: if input value is zero or exactly a whole
c     number, then leave it alone.
      temp = FLOAT( INT(value) )
      if( temp .eq. value ) then
         round_up_whole = value
         return
      endif
c
      if( value .gt. 0.0 ) then
         round_up_whole = FLOAT( INT(value) + 1 )
      else
         round_up_whole = temp
      endif
      return
      end
c
      real function round_down_whole(value)
      implicit none
c
      real value
c
c     Function rounds real number down to next smaller integer,
c        then converts to real.
c     Real number must be in range of integer on VAX
c
      real LARGEINT, temp
      parameter ( LARGEINT = 2.0E9 ) ! about 2**31
c
      if( value .gt. LARGEINT .or. value .lt. -LARGEINT ) then
         round_down_whole = 0.0
         write(6,100)
100      format(' ','Error (round_down_whole): argument too large')
         return
      endif
c
c     Special cases: if input value is zero or exactly a whole
c     number, then leave it alone.
      temp = FLOAT( INT(value) )
      if( temp .eq. value ) then
         round_down_whole = value
         return
      endif
c
      if( value .gt. 0.0 ) then
         round_down_whole = temp
      else
         round_down_whole = FLOAT( INT(value) - 1 )
      endif
      return
      end
c
      integer function string_len(string)
      implicit none
c
      character*(*) string
c
c     Function returns number of characters in string, not including
c     trailing blanks. If string is completely blank, it returns 0.
c
      integer i, ilen, LEN, length
c
      ilen = LEN(string)
      length = ilen
      do 100 i=ilen,1,-1
         if( string(i:i) .ne. ' ' ) goto 200
         length = length - 1
100      continue
c
200   string_len = length
      return
      end
c
      subroutine pm_date(date_string)
      implicit none
c
      character*(*) date_string
c
      integer      date_time(8)
      character*12 real_clock(3)
      character*3  months(12)
      data months/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug',
     1            'Sep','Oct','Nov','Dec'/
      save months
c
      call date_and_time (real_clock (1), real_clock (2),
     1                    real_clock (3), date_time)
c
      write(date_string,100,err=200) date_time(3), months(date_time(2)),
     1                               date_time(1)
100   format(i2,'-',a,'-',i4)
      goto 300
c
c     If error, fill with asterisks
200   date_string = '*'
c
300   continue
c
      return
      end
