cget10.c
Go to the documentation of this file.
00001 /* cget10.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 /* Table of constant values */
00017 
00018 static integer c__1 = 1;
00019 static complex c_b9 = {-1.f,0.f};
00020 
00021 /* Subroutine */ int cget10_(integer *m, integer *n, complex *a, integer *lda, 
00022          complex *b, integer *ldb, complex *work, real *rwork, real *result)
00023 {
00024     /* System generated locals */
00025     integer a_dim1, a_offset, b_dim1, b_offset, i__1;
00026     real r__1, r__2;
00027 
00028     /* Local variables */
00029     integer j;
00030     real eps, unfl, anorm;
00031     extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, 
00032             complex *, integer *), caxpy_(integer *, complex *, complex *, 
00033             integer *, complex *, integer *);
00034     real wnorm;
00035     extern doublereal clange_(char *, integer *, integer *, complex *, 
00036             integer *, real *), slamch_(char *), scasum_(
00037             integer *, complex *, integer *);
00038 
00039 
00040 /*  -- LAPACK test routine (version 3.1) -- */
00041 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00042 /*     November 2006 */
00043 
00044 /*     .. Scalar Arguments .. */
00045 /*     .. */
00046 /*     .. Array Arguments .. */
00047 /*     .. */
00048 
00049 /*  Purpose */
00050 /*  ======= */
00051 
00052 /*  CGET10 compares two matrices A and B and computes the ratio */
00053 /*  RESULT = norm( A - B ) / ( norm(A) * M * EPS ) */
00054 
00055 /*  Arguments */
00056 /*  ========= */
00057 
00058 /*  M       (input) INTEGER */
00059 /*          The number of rows of the matrices A and B. */
00060 
00061 /*  N       (input) INTEGER */
00062 /*          The number of columns of the matrices A and B. */
00063 
00064 /*  A       (input) COMPLEX array, dimension (LDA,N) */
00065 /*          The m by n matrix A. */
00066 
00067 /*  LDA     (input) INTEGER */
00068 /*          The leading dimension of the array A.  LDA >= max(1,M). */
00069 
00070 /*  B       (input) COMPLEX array, dimension (LDB,N) */
00071 /*          The m by n matrix B. */
00072 
00073 /*  LDB     (input) INTEGER */
00074 /*          The leading dimension of the array B.  LDB >= max(1,M). */
00075 
00076 /*  WORK    (workspace) COMPLEX array, dimension (M) */
00077 
00078 /*  RWORK   (workspace) COMPLEX array, dimension (M) */
00079 
00080 /*  RESULT  (output) REAL */
00081 /*          RESULT = norm( A - B ) / ( norm(A) * M * EPS ) */
00082 
00083 /*  ===================================================================== */
00084 
00085 /*     .. Parameters .. */
00086 /*     .. */
00087 /*     .. Local Scalars .. */
00088 /*     .. */
00089 /*     .. External Functions .. */
00090 /*     .. */
00091 /*     .. External Subroutines .. */
00092 /*     .. */
00093 /*     .. Intrinsic Functions .. */
00094 /*     .. */
00095 /*     .. Executable Statements .. */
00096 
00097 /*     Quick return if possible */
00098 
00099     /* Parameter adjustments */
00100     a_dim1 = *lda;
00101     a_offset = 1 + a_dim1;
00102     a -= a_offset;
00103     b_dim1 = *ldb;
00104     b_offset = 1 + b_dim1;
00105     b -= b_offset;
00106     --work;
00107     --rwork;
00108 
00109     /* Function Body */
00110     if (*m <= 0 || *n <= 0) {
00111         *result = 0.f;
00112         return 0;
00113     }
00114 
00115     unfl = slamch_("Safe minimum");
00116     eps = slamch_("Precision");
00117 
00118     wnorm = 0.f;
00119     i__1 = *n;
00120     for (j = 1; j <= i__1; ++j) {
00121         ccopy_(m, &a[j * a_dim1 + 1], &c__1, &work[1], &c__1);
00122         caxpy_(m, &c_b9, &b[j * b_dim1 + 1], &c__1, &work[1], &c__1);
00123 /* Computing MAX */
00124         r__1 = wnorm, r__2 = scasum_(n, &work[1], &c__1);
00125         wnorm = dmax(r__1,r__2);
00126 /* L10: */
00127     }
00128 
00129 /* Computing MAX */
00130     r__1 = clange_("1", m, n, &a[a_offset], lda, &rwork[1]);
00131     anorm = dmax(r__1,unfl);
00132 
00133     if (anorm > wnorm) {
00134         *result = wnorm / anorm / (*m * eps);
00135     } else {
00136         if (anorm < 1.f) {
00137 /* Computing MIN */
00138             r__1 = wnorm, r__2 = *m * anorm;
00139             *result = dmin(r__1,r__2) / anorm / (*m * eps);
00140         } else {
00141 /* Computing MIN */
00142             r__1 = wnorm / anorm, r__2 = (real) (*m);
00143             *result = dmin(r__1,r__2) / (*m * eps);
00144         }
00145     }
00146 
00147     return 0;
00148 
00149 /*     End of CGET10 */
00150 
00151 } /* cget10_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:27