/* ilaslc.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" #include "blaswrap.h" integer ilaslc_(integer *m, integer *n, real *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, ret_val, i__1; /* Local variables */ integer i__; /* -- LAPACK auxiliary routine (version 3.2.1) -- */ /* -- April 2009 -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ILASLC scans A for its last non-zero column. */ /* Arguments */ /* ========= */ /* M (input) INTEGER */ /* The number of rows of the matrix A. */ /* N (input) INTEGER */ /* The number of columns of the matrix A. */ /* A (input) REAL array, dimension (LDA,N) */ /* The m by n matrix A. */ /* LDA (input) INTEGER */ /* The leading dimension of the array A. LDA >= max(1,M). */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Executable Statements .. */ /* Quick test for the common case where one corner is non-zero. */ /* Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; /* Function Body */ if (*n == 0) { ret_val = *n; } else if (a[*n * a_dim1 + 1] != 0.f || a[*m + *n * a_dim1] != 0.f) { ret_val = *n; } else { /* Now scan each column from the end, returning with the first non-zero. */ for (ret_val = *n; ret_val >= 1; --ret_val) { i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { if (a[i__ + ret_val * a_dim1] != 0.f) { return ret_val; } } } } return ret_val; } /* ilaslc_ */