d3/dc6/ssxt1_8f_source.html

00001       REAL             FUNCTION SSXT1( IJOB, D1, N1, D2, N2, ABSTOL,
00002      $                 ULP, UNFL )
00003 *
00004 *  -- LAPACK test routine (version 3.1) --
00005 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            IJOB, N1, N2
00010       REAL               ABSTOL, ULP, UNFL
00011 *     ..
00012 *     .. Array Arguments ..
00013       REAL               D1( * ), D2( * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  SSXT1  computes the difference between a set of eigenvalues.
00020 *  The result is returned as the function value.
00021 *
00022 *  IJOB = 1:   Computes   max { min | D1(i)-D2(j) | }
00023 *                          i     j
00024 *
00025 *  IJOB = 2:   Computes   max { min | D1(i)-D2(j) | /
00026 *                          i     j
00027 *                               ( ABSTOL + |D1(i)|*ULP ) }
00028 *
00029 *  Arguments
00030 *  =========
00031 *
00032 *  ITYPE   (input) INTEGER
00033 *          Specifies the type of tests to be performed.  (See above.)
00034 *
00035 *  D1      (input) REAL array, dimension (N1)
00036 *          The first array.  D1 should be in increasing order, i.e.,
00037 *          D1(j) <= D1(j+1).
00038 *
00039 *  N1      (input) INTEGER
00040 *          The length of D1.
00041 *
00042 *  D2      (input) REAL array, dimension (N2)
00043 *          The second array.  D2 should be in increasing order, i.e.,
00044 *          D2(j) <= D2(j+1).
00045 *
00046 *  N2      (input) INTEGER
00047 *          The length of D2.
00048 *
00049 *  ABSTOL  (input) REAL
00050 *          The absolute tolerance, used as a measure of the error.
00051 *
00052 *  ULP     (input) REAL
00053 *          Machine precision.
00054 *
00055 *  UNFL    (input) REAL
00056 *          The smallest positive number whose reciprocal does not
00057 *          overflow.
00058 *
00059 *  =====================================================================
00060 *
00061 *     .. Parameters ..
00062       REAL               ZERO
00063       PARAMETER          ( ZERO = 0.0E0 )
00064 *     ..
00065 *     .. Local Scalars ..
00066       INTEGER            I, J
00067       REAL               TEMP1, TEMP2
00068 *     ..
00069 *     .. Intrinsic Functions ..
00070       INTRINSIC          ABS, MAX, MIN
00071 *     ..
00072 *     .. Executable Statements ..
00073 *
00074       TEMP1 = ZERO
00075 *
00076       J = 1
00077       DO 20 I = 1, N1
00078    10    CONTINUE
00079          IF( D2( J ).LT.D1( I ) .AND. J.LT.N2 ) THEN
00080             J = J + 1
00081             GO TO 10
00082          END IF
00083          IF( J.EQ.1 ) THEN
00084             TEMP2 = ABS( D2( J )-D1( I ) )
00085             IF( IJOB.EQ.2 )
00086      $         TEMP2 = TEMP2 / MAX( UNFL, ABSTOL+ULP*ABS( D1( I ) ) )
00087          ELSE
00088             TEMP2 = MIN( ABS( D2( J )-D1( I ) ),
00089      $              ABS( D1( I )-D2( J-1 ) ) )
00090             IF( IJOB.EQ.2 )
00091      $         TEMP2 = TEMP2 / MAX( UNFL, ABSTOL+ULP*ABS( D1( I ) ) )
00092          END IF
00093          TEMP1 = MAX( TEMP1, TEMP2 )
00094    20 CONTINUE
00095 *
00096       SSXT1 = TEMP1
00097       RETURN
00098 *
00099 *     End of SSXT1
00100 *
00101       END