Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
 Path: blob/devel/mathlibs/src/parpack/pdlamch.f
5191 views
1
      DOUBLE PRECISION   FUNCTION PDLAMCH10( ICTXT, CMACH )

2
      include "mpif.h"

3
*

4
*  -- ScaLAPACK auxilliary routine (version 1.0) --

5
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,

6
*     and University of California, Berkeley.

7
*     February 28, 1995

8
*

9
*     .. Scalar Arguments ..

10
      CHARACTER          CMACH

11
      INTEGER            ICTXT

12
*     ..

13
*

14
*  Purpose

15
*  =======

16
*

17
*  PDLAMCH determines double precision machine parameters.

18
*

19
*  Arguments

20
*  =========

21
*

22
*  ICTXT   (global input) INTEGER

23
*          The BLACS context handle in which the computation takes

24
*          place.

25
*

26
*  CMACH   (global input) CHARACTER*1

27
*          Specifies the value to be returned by PDLAMCH:

28
*          = 'E' or 'e',   PDLAMCH := eps

29
*          = 'S' or 's ,   PDLAMCH := sfmin

30
*          = 'B' or 'b',   PDLAMCH := base

31
*          = 'P' or 'p',   PDLAMCH := eps*base

32
*          = 'N' or 'n',   PDLAMCH := t

33
*          = 'R' or 'r',   PDLAMCH := rnd

34
*          = 'M' or 'm',   PDLAMCH := emin

35
*          = 'U' or 'u',   PDLAMCH := rmin

36
*          = 'L' or 'l',   PDLAMCH := emax

37
*          = 'O' or 'o',   PDLAMCH := rmax

38
*

39
*          where

40
*

41
*          eps   = relative machine precision

42
*          sfmin = safe minimum, such that 1/sfmin does not overflow

43
*          base  = base of the machine

44
*          prec  = eps*base

45
*          t     = number of (base) digits in the mantissa

46
*          rnd   = 1.0 when rounding occurs in addition, 0.0 otherwise

47
*          emin  = minimum exponent before (gradual) underflow

48
*          rmin  = underflow threshold - base**(emin-1)

49
*          emax  = largest exponent before overflow

50
*          rmax  = overflow threshold  - (base**emax)*(1-eps)

51
*

52
*  =====================================================================

53
*

54
*     .. Local Scalars ..

55
      INTEGER            IDUMM

56
      DOUBLE PRECISION   TEMP, TEMP1

57
*     ..

58
*     .. External Subroutines ..

59
*      EXTERNAL           DGAMN2D, DGAMX2D

60
*     ..

61
*     .. External Functions ..

62
      LOGICAL            LSAME

63
      DOUBLE PRECISION   DLAMCH

64
      EXTERNAL           DLAMCH, LSAME

65
*     ..

66
*     .. Executable Statements ..

67
*

68
      TEMP1 = DLAMCH( CMACH )

69
*

70
      IF( LSAME( CMACH, 'E' ).OR.LSAME( CMACH, 'S' ).OR.

71
     $    LSAME( CMACH, 'M' ).OR.LSAME( CMACH, 'U' ) ) THEN

72
          CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_DOUBLE_PRECISION,

73
     $                        MPI_MAX, ICTXT, IDUMM )

74
*         CALL DGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,

75
*     $                 IDUMM, 1, -1, IDUMM )

76
      ELSE IF( LSAME( CMACH, 'L' ).OR.LSAME( CMACH, 'O' ) ) THEN

77
          CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_DOUBLE_PRECISION,

78
     $                        MPI_MIN, ICTXT, IDUMM )

79
*         CALL DGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,

80
*     $                 IDUMM, 1, -1, IDUMM )

81
      ELSE

82
          TEMP = TEMP1

83
      END IF

84
*

85
      PDLAMCH10 = TEMP

86
*

87
*     End of PDLAMCH

88
*

89
      END

90


91