TESTING/EIG/dsxt1.f

   1 *> \brief \b DSXT1
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       DOUBLE PRECISION FUNCTION DSXT1( IJOB, D1, N1, D2, N2, ABSTOL,
  12 *                        ULP, UNFL )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       INTEGER            IJOB, N1, N2
  16 *       DOUBLE PRECISION   ABSTOL, ULP, UNFL
  17 *       ..
  18 *       .. Array Arguments ..
  19 *       DOUBLE PRECISION   D1( * ), D2( * )
  20 *       ..
  21 *
  22 *
  23 *> \par Purpose:
  24 *  =============
  25 *>
  26 *> \verbatim
  27 *>
  28 *> DSXT1  computes the difference between a set of eigenvalues.
  29 *> The result is returned as the function value.
  30 *>
  31 *> IJOB = 1:   Computes   max { min | D1(i)-D2(j) | }
  32 *>                         i     j
  33 *>
  34 *> IJOB = 2:   Computes   max { min | D1(i)-D2(j) | /
  35 *>                         i     j
  36 *>                              ( ABSTOL + |D1(i)|*ULP ) }
  37 *> \endverbatim
  38 *
  39 *  Arguments:
  40 *  ==========
  41 *
  42 *> \param[in] IJOB
  43 *> \verbatim
  44 *>          IJOB is INTEGER
  45 *>          Specifies the type of tests to be performed.  (See above.)
  46 *> \endverbatim
  47 *>
  48 *> \param[in] D1
  49 *> \verbatim
  50 *>          D1 is DOUBLE PRECISION array, dimension (N1)
  51 *>          The first array.  D1 should be in increasing order, i.e.,
  52 *>          D1(j) <= D1(j+1).
  53 *> \endverbatim
  54 *>
  55 *> \param[in] N1
  56 *> \verbatim
  57 *>          N1 is INTEGER
  58 *>          The length of D1.
  59 *> \endverbatim
  60 *>
  61 *> \param[in] D2
  62 *> \verbatim
  63 *>          D2 is DOUBLE PRECISION array, dimension (N2)
  64 *>          The second array.  D2 should be in increasing order, i.e.,
  65 *>          D2(j) <= D2(j+1).
  66 *> \endverbatim
  67 *>
  68 *> \param[in] N2
  69 *> \verbatim
  70 *>          N2 is INTEGER
  71 *>          The length of D2.
  72 *> \endverbatim
  73 *>
  74 *> \param[in] ABSTOL
  75 *> \verbatim
  76 *>          ABSTOL is DOUBLE PRECISION
  77 *>          The absolute tolerance, used as a measure of the error.
  78 *> \endverbatim
  79 *>
  80 *> \param[in] ULP
  81 *> \verbatim
  82 *>          ULP is DOUBLE PRECISION
  83 *>          Machine precision.
  84 *> \endverbatim
  85 *>
  86 *> \param[in] UNFL
  87 *> \verbatim
  88 *>          UNFL is DOUBLE PRECISION
  89 *>          The smallest positive number whose reciprocal does not
  90 *>          overflow.
  91 *> \endverbatim
  92 *
  93 *  Authors:
  94 *  ========
  95 *
  96 *> \author Univ. of Tennessee
  97 *> \author Univ. of California Berkeley
  98 *> \author Univ. of Colorado Denver
  99 *> \author NAG Ltd.
 100 *
 101 *> \date November 2011
 102 *
 103 *> \ingroup double_eig
 104 *
 105 *  =====================================================================
 106       DOUBLE PRECISION FUNCTION DSXT1( IJOB, D1, N1, D2, N2, ABSTOL,
 107      $                 ULP, UNFL )
 108 *
 109 *  -- LAPACK test routine (version 3.4.0) --
 110 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 111 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 112 *     November 2011
 113 *
 114 *     .. Scalar Arguments ..
 115       INTEGER            IJOB, N1, N2
 116       DOUBLE PRECISION   ABSTOL, ULP, UNFL
 117 *     ..
 118 *     .. Array Arguments ..
 119       DOUBLE PRECISION   D1( * ), D2( * )
 120 *     ..
 121 *
 122 *  =====================================================================
 123 *
 124 *     .. Parameters ..
 125       DOUBLE PRECISION   ZERO
 126       PARAMETER          ( ZERO = 0.0D0 )
 127 *     ..
 128 *     .. Local Scalars ..
 129       INTEGER            I, J
 130       DOUBLE PRECISION   TEMP1, TEMP2
 131 *     ..
 132 *     .. Intrinsic Functions ..
 133       INTRINSIC          ABS, MAX, MIN
 134 *     ..
 135 *     .. Executable Statements ..
 136 *
 137       TEMP1 = ZERO
 138 *
 139       J = 1
 140       DO 20 I = 1, N1
 141    10    CONTINUE
 142          IF( D2( J ).LT.D1( I ) .AND. J.LT.N2 ) THEN
 143             J = J + 1
 144             GO TO 10
 145          END IF
 146          IF( J.EQ.1 ) THEN
 147             TEMP2 = ABS( D2( J )-D1( I ) )
 148             IF( IJOB.EQ.2 )
 149      $         TEMP2 = TEMP2 / MAX( UNFL, ABSTOL+ULP*ABS( D1( I ) ) )
 150          ELSE
 151             TEMP2 = MIN( ABS( D2( J )-D1( I ) ),
 152      $              ABS( D1( I )-D2( J-1 ) ) )
 153             IF( IJOB.EQ.2 )
 154      $         TEMP2 = TEMP2 / MAX( UNFL, ABSTOL+ULP*ABS( D1( I ) ) )
 155          END IF
 156          TEMP1 = MAX( TEMP1, TEMP2 )
 157    20 CONTINUE
 158 *
 159       DSXT1 = TEMP1
 160       RETURN
 161 *
 162 *     End of DSXT1
 163 *
 164       END