00001 /* cgennd.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 logical cgennd_(integer *m, integer *n, complex *a, integer *lda) 00017 { 00018 /* System generated locals */ 00019 integer a_dim1, a_offset, i__1, i__2; 00020 logical ret_val; 00021 00022 /* Builtin functions */ 00023 double r_imag(complex *); 00024 00025 /* Local variables */ 00026 integer i__, k; 00027 complex aii; 00028 00029 00030 /* -- LAPACK test routine (version 3.1) -- */ 00031 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00032 /* February 2008 */ 00033 00034 /* .. Scalar Arguments .. */ 00035 /* .. */ 00036 /* .. Array Arguments .. */ 00037 /* .. */ 00038 00039 /* Purpose */ 00040 /* ======= */ 00041 00042 /* CGENND tests that its argument has a real, non-negative diagonal. */ 00043 00044 /* Arguments */ 00045 /* ========= */ 00046 00047 /* M (input) INTEGER */ 00048 /* The number of rows in A. */ 00049 00050 /* N (input) INTEGER */ 00051 /* The number of columns in A. */ 00052 00053 /* A (input) COMPLEX array, dimension (LDA, N) */ 00054 /* The matrix. */ 00055 00056 /* LDA (input) INTEGER */ 00057 /* Leading dimension of A. */ 00058 00059 /* ===================================================================== */ 00060 00061 /* .. Parameters .. */ 00062 /* .. */ 00063 /* .. Local Scalars .. */ 00064 /* .. */ 00065 /* .. Intrinsics .. */ 00066 /* .. */ 00067 /* .. Executable Statements .. */ 00068 /* Parameter adjustments */ 00069 a_dim1 = *lda; 00070 a_offset = 1 + a_dim1; 00071 a -= a_offset; 00072 00073 /* Function Body */ 00074 k = min(*m,*n); 00075 i__1 = k; 00076 for (i__ = 1; i__ <= i__1; ++i__) { 00077 i__2 = i__ + i__ * a_dim1; 00078 aii.r = a[i__2].r, aii.i = a[i__2].i; 00079 if (aii.r < 0.f || r_imag(&aii) != 0.f) { 00080 ret_val = FALSE_; 00081 return ret_val; 00082 } 00083 } 00084 ret_val = TRUE_; 00085 return ret_val; 00086 } /* cgennd_ */