#include "blaswrap.h" /* ssxt1.f -- translated by f2c (version 20061008). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" doublereal ssxt1_(integer *ijob, real *d1, integer *n1, real *d2, integer *n2, real *abstol, real *ulp, real *unfl) { /* System generated locals */ integer i__1; real ret_val, r__1, r__2, r__3, r__4; /* Local variables */ static integer i__, j; static real temp1, temp2; /* -- LAPACK test routine (version 3.1) -- Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. November 2006 Purpose ======= SSXT1 computes the difference between a set of eigenvalues. The result is returned as the function value. IJOB = 1: Computes max { min | D1(i)-D2(j) | } i j IJOB = 2: Computes max { min | D1(i)-D2(j) | / i j ( ABSTOL + |D1(i)|*ULP ) } Arguments ========= ITYPE (input) INTEGER Specifies the type of tests to be performed. (See above.) D1 (input) REAL array, dimension (N1) The first array. D1 should be in increasing order, i.e., D1(j) <= D1(j+1). N1 (input) INTEGER The length of D1. D2 (input) REAL array, dimension (N2) The second array. D2 should be in increasing order, i.e., D2(j) <= D2(j+1). N2 (input) INTEGER The length of D2. ABSTOL (input) REAL The absolute tolerance, used as a measure of the error. ULP (input) REAL Machine precision. UNFL (input) REAL The smallest positive number whose reciprocal does not overflow. ===================================================================== Parameter adjustments */ --d2; --d1; /* Function Body */ temp1 = 0.f; j = 1; i__1 = *n1; for (i__ = 1; i__ <= i__1; ++i__) { L10: if (d2[j] < d1[i__] && j < *n2) { ++j; goto L10; } if (j == 1) { temp2 = (r__1 = d2[j] - d1[i__], dabs(r__1)); if (*ijob == 2) { /* Computing MAX */ r__2 = *unfl, r__3 = *abstol + *ulp * (r__1 = d1[i__], dabs( r__1)); temp2 /= dmax(r__2,r__3); } } else { /* Computing MIN */ r__3 = (r__1 = d2[j] - d1[i__], dabs(r__1)), r__4 = (r__2 = d1[ i__] - d2[j - 1], dabs(r__2)); temp2 = dmin(r__3,r__4); if (*ijob == 2) { /* Computing MAX */ r__2 = *unfl, r__3 = *abstol + *ulp * (r__1 = d1[i__], dabs( r__1)); temp2 /= dmax(r__2,r__3); } } temp1 = dmax(temp1,temp2); /* L20: */ } ret_val = temp1; return ret_val; /* End of SSXT1 */ } /* ssxt1_ */