pslamch.f

Go to the documentation of this file.

      REAL               function pslamch( ictxt, cmach )
*
*  -- ScaLAPACK auxiliary routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      CHARACTER          cmach
      INTEGER            ictxt
*     ..
*
*  Purpose
*  =======
*
*  PSLAMCH determines single precision machine parameters.
*
*  Arguments
*  =========
*
*  ICTXT   (global input) INTEGER
*          The BLACS context handle in which the computation takes
*          place.
*
*  CMACH   (global input) CHARACTER*1
*          Specifies the value to be returned by PSLAMCH:
*          = 'E' or 'e',   PSLAMCH := eps
*          = 'S' or 's ,   PSLAMCH := sfmin
*          = 'B' or 'b',   PSLAMCH := base
*          = 'P' or 'p',   PSLAMCH := eps*base
*          = 'N' or 'n',   PSLAMCH := t
*          = 'R' or 'r',   PSLAMCH := rnd
*          = 'M' or 'm',   PSLAMCH := emin
*          = 'U' or 'u',   PSLAMCH := rmin
*          = 'L' or 'l',   PSLAMCH := emax
*          = 'O' or 'o',   PSLAMCH := rmax
*
*          where
*
*          eps   = relative machine precision
*          sfmin = safe minimum, such that 1/sfmin does not overflow
*          base  = base of the machine
*          prec  = eps*base
*          t     = number of (base) digits in the mantissa
*          rnd   = 1.0 when rounding occurs in addition, 0.0 otherwise
*          emin  = minimum exponent before (gradual) underflow
*          rmin  = underflow threshold - base**(emin-1)
*          emax  = largest exponent before overflow
*          rmax  = overflow threshold  - (base**emax)*(1-eps)
*
*  =====================================================================
*
*     .. Local Scalars ..
      INTEGER            idumm
      REAL               temp
*     ..
*     .. External Subroutines ..
      EXTERNAL           sgamn2d, sgamx2d
*     ..
*     .. External Functions ..
      LOGICAL            lsame
      REAL               slamch
      EXTERNAL           lsame, slamch
*     ..
*     .. Executable Statements ..
*
      temp = slamch( cmach )
      idumm = 0
*
      IF( lsame( cmach, 'E' ).OR.lsame( cmach, 'S' ).OR.
     $    lsame( cmach, 'M' ).OR.lsame( cmach, 'U' ) ) THEN
         CALL sgamx2d( ictxt, 'All', ' ', 1, 1, temp, 1, idumm,
     $                 idumm, -1, -1, idumm )
      ELSE IF( lsame( cmach, 'L' ).OR.lsame( cmach, 'O' ) ) THEN
         CALL sgamn2d( ictxt, 'All', ' ', 1, 1, temp, 1, idumm,
     $                 idumm, -1, -1, idumm )
      END IF
*
      pslamch = temp
*
*     End of PSLAMCH
*
      END