
C **********************************************************************
C *                                                                    *
C *                   LIBRARY MODULE SYSLIB (syslib.f)                 *
C *                                                                    *
C * Library module containing routines concerning the machine and the  *
C * operating system.                                                  *
C *                                                                    *
C * Contains:                                                          *
C *    machprec: Determines the machine precision.                     *
C *                                                                    *
C **********************************************************************


C **********************************************************************
C *                                                                    *
C *                         SUBROUTINE MACHPREC                        *
C *                                                                    *
C * Determines the machine precision, i. e. the smallest positive      *
C * number "prec" for which 1.0+prec > 1.0. The parameter "tiny"       *
C * specifies the relative accuracy of "prec".                         *
C *                                                                    *
C * Input parameters: none                                             *
C *                                                                    *
C * Output parameters:                                                 *
C *   prec: machine precision                                          *
C *                                                                    *
C * V7.0 MB                                                            *
C *                                                                    *
C **********************************************************************

      subroutine machprec (prec)

      implicit none

      real*8 tiny
      parameter (tiny=1.0d-6)

      real*8  prec,lower,upper,eps,tmp
      logical initial

      save eps,initial
      data initial /.true./

c ----------------------------------------------------------------------
c Determine machine precision
c   "Dummyroutine" must be called to escape the expression 1.0+eps > 1.0
c   from the optimizer which would reduce it to eps > 0.0.
c   The factor of two in the definition of "eps" has been included to
c   eliminate round-off artifacts.
c ----------------------------------------------------------------------
      if (initial) then
         lower=1.0d-99
         upper=1.0d-06
         do while (dabs(lower-upper)/upper .ge. tiny)
            eps=0.5d0*(lower+upper)
            tmp=1.0d0+eps
            call realdummyroutine(tmp)
            if (tmp .gt. 1.0d0) then
               upper=eps
            else
               lower=eps
            endif
         enddo
         eps=2.0d0*upper
         initial=.false.
      endif
      prec=eps

      return
      end

C **********************************************************************
C *                                                                    *
C *                      SUBROUTINE REALDUMMYROUTINE                   *
C *                                                                    *
C * Does not make anything. Only needed for formal reasons (see        *
C * subroutine "machprec").                                            *
C *                                                                    *
C * Input parameters:                                                  *
C *   x: real dummy parameter                                          *
C *                                                                    *
C * Output parameters: none                                            *
C *                                                                    *
C * V7.0 MB                                                            *
C *                                                                    *
C **********************************************************************

      subroutine realdummyroutine (x)

      implicit none

      real*8 x

      x=x

      return
      end

C **********************************************************************
C *
C *                            FUNCTION LOG2INT
C *
C * Converts a logical expression to integer, i.e. ".false." is mapped
C * to "0" and ".true." is mapped to "1". This function serves for
C * writing logicals to binary files in a platform-independent manner.
C * Note that ".true." is symbolised by "-1" on DEC machines and by "1"
C * on (all ?) others. On the other hand, DEC machines interpret "1"
C * also as ".true.", so the mapping defined by this function should
C * work on all platforms.
C *
C * MB 10/99
C *
C **********************************************************************

      integer function log2int (logvar)

      implicit none

      logical logvar

      if (logvar) then
         log2int = 1
      else
         log2int = 0
      endif

      return
      end

C **********************************************************************
C *
C *                            FUNCTION INT2LOG
C *
C * Converts an integer expression to logical, i.e. 0 is mapped to
C * ".false.", while all other values are mapped to ".true."
C *
C * MB 10/99
C *
C **********************************************************************

      logical function int2log (intvar)

      implicit none

      integer intvar

      if (intvar .eq. 0) then
         int2log = .false.
      else
         int2log = .true.
      endif

      return
      end
