00001 /* dsxt1.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 doublereal dsxt1_(integer *ijob, doublereal *d1, integer *n1, doublereal *d2, 00017 integer *n2, doublereal *abstol, doublereal *ulp, doublereal *unfl) 00018 { 00019 /* System generated locals */ 00020 integer i__1; 00021 doublereal ret_val, d__1, d__2, d__3, d__4; 00022 00023 /* Local variables */ 00024 integer i__, j; 00025 doublereal temp1, temp2; 00026 00027 00028 /* -- LAPACK test routine (version 3.1) -- */ 00029 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00030 /* November 2006 */ 00031 00032 /* .. Scalar Arguments .. */ 00033 /* .. */ 00034 /* .. Array Arguments .. */ 00035 /* .. */ 00036 00037 /* Purpose */ 00038 /* ======= */ 00039 00040 /* DSXT1 computes the difference between a set of eigenvalues. */ 00041 /* The result is returned as the function value. */ 00042 00043 /* IJOB = 1: Computes max { min | D1(i)-D2(j) | } */ 00044 /* i j */ 00045 00046 /* IJOB = 2: Computes max { min | D1(i)-D2(j) | / */ 00047 /* i j */ 00048 /* ( ABSTOL + |D1(i)|*ULP ) } */ 00049 00050 /* Arguments */ 00051 /* ========= */ 00052 00053 /* ITYPE (input) INTEGER */ 00054 /* Specifies the type of tests to be performed. (See above.) */ 00055 00056 /* D1 (input) DOUBLE PRECISION array, dimension (N1) */ 00057 /* The first array. D1 should be in increasing order, i.e., */ 00058 /* D1(j) <= D1(j+1). */ 00059 00060 /* N1 (input) INTEGER */ 00061 /* The length of D1. */ 00062 00063 /* D2 (input) DOUBLE PRECISION array, dimension (N2) */ 00064 /* The second array. D2 should be in increasing order, i.e., */ 00065 /* D2(j) <= D2(j+1). */ 00066 00067 /* N2 (input) INTEGER */ 00068 /* The length of D2. */ 00069 00070 /* ABSTOL (input) DOUBLE PRECISION */ 00071 /* The absolute tolerance, used as a measure of the error. */ 00072 00073 /* ULP (input) DOUBLE PRECISION */ 00074 /* Machine precision. */ 00075 00076 /* UNFL (input) DOUBLE PRECISION */ 00077 /* The smallest positive number whose reciprocal does not */ 00078 /* overflow. */ 00079 00080 /* ===================================================================== */ 00081 00082 /* .. Parameters .. */ 00083 /* .. */ 00084 /* .. Local Scalars .. */ 00085 /* .. */ 00086 /* .. Intrinsic Functions .. */ 00087 /* .. */ 00088 /* .. Executable Statements .. */ 00089 00090 /* Parameter adjustments */ 00091 --d2; 00092 --d1; 00093 00094 /* Function Body */ 00095 temp1 = 0.; 00096 00097 j = 1; 00098 i__1 = *n1; 00099 for (i__ = 1; i__ <= i__1; ++i__) { 00100 L10: 00101 if (d2[j] < d1[i__] && j < *n2) { 00102 ++j; 00103 goto L10; 00104 } 00105 if (j == 1) { 00106 temp2 = (d__1 = d2[j] - d1[i__], abs(d__1)); 00107 if (*ijob == 2) { 00108 /* Computing MAX */ 00109 d__2 = *unfl, d__3 = *abstol + *ulp * (d__1 = d1[i__], abs( 00110 d__1)); 00111 temp2 /= max(d__2,d__3); 00112 } 00113 } else { 00114 /* Computing MIN */ 00115 d__3 = (d__1 = d2[j] - d1[i__], abs(d__1)), d__4 = (d__2 = d1[i__] 00116 - d2[j - 1], abs(d__2)); 00117 temp2 = min(d__3,d__4); 00118 if (*ijob == 2) { 00119 /* Computing MAX */ 00120 d__2 = *unfl, d__3 = *abstol + *ulp * (d__1 = d1[i__], abs( 00121 d__1)); 00122 temp2 /= max(d__2,d__3); 00123 } 00124 } 00125 temp1 = max(temp1,temp2); 00126 /* L20: */ 00127 } 00128 00129 ret_val = temp1; 00130 return ret_val; 00131 00132 /* End of DSXT1 */ 00133 00134 } /* dsxt1_ */