kusano 2b45e8
      SUBROUTINE SGETF2F( M, N, A, LDA, IPIV, INFO )
kusano 2b45e8
*
kusano 2b45e8
*  -- LAPACK routine (version 3.0) --
kusano 2b45e8
*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
kusano 2b45e8
*     Courant Institute, Argonne National Lab, and Rice University
kusano 2b45e8
*     June 30, 1992
kusano 2b45e8
*
kusano 2b45e8
*     .. Scalar Arguments ..
kusano 2b45e8
      INTEGER            INFO, LDA, M, N
kusano 2b45e8
*     ..
kusano 2b45e8
*     .. Array Arguments ..
kusano 2b45e8
      INTEGER            IPIV( * )
kusano 2b45e8
      REAL               A( LDA, * )
kusano 2b45e8
*     ..
kusano 2b45e8
*
kusano 2b45e8
*  Purpose
kusano 2b45e8
*  =======
kusano 2b45e8
*
kusano 2b45e8
*  SGETF2 computes an LU factorization of a general m-by-n matrix A
kusano 2b45e8
*  using partial pivoting with row interchanges.
kusano 2b45e8
*
kusano 2b45e8
*  The factorization has the form
kusano 2b45e8
*     A = P * L * U
kusano 2b45e8
*  where P is a permutation matrix, L is lower triangular with unit
kusano 2b45e8
*  diagonal elements (lower trapezoidal if m > n), and U is upper
kusano 2b45e8
*  triangular (upper trapezoidal if m < n).
kusano 2b45e8
*
kusano 2b45e8
*  This is the right-looking Level 2 BLAS version of the algorithm.
kusano 2b45e8
*
kusano 2b45e8
*  Arguments
kusano 2b45e8
*  =========
kusano 2b45e8
*
kusano 2b45e8
*  M       (input) INTEGER
kusano 2b45e8
*          The number of rows of the matrix A.  M >= 0.
kusano 2b45e8
*
kusano 2b45e8
*  N       (input) INTEGER
kusano 2b45e8
*          The number of columns of the matrix A.  N >= 0.
kusano 2b45e8
*
kusano 2b45e8
*  A       (input/output) REAL array, dimension (LDA,N)
kusano 2b45e8
*          On entry, the m by n matrix to be factored.
kusano 2b45e8
*          On exit, the factors L and U from the factorization
kusano 2b45e8
*          A = P*L*U; the unit diagonal elements of L are not stored.
kusano 2b45e8
*
kusano 2b45e8
*  LDA     (input) INTEGER
kusano 2b45e8
*          The leading dimension of the array A.  LDA >= max(1,M).
kusano 2b45e8
*
kusano 2b45e8
*  IPIV    (output) INTEGER array, dimension (min(M,N))
kusano 2b45e8
*          The pivot indices; for 1 <= i <= min(M,N), row i of the
kusano 2b45e8
*          matrix was interchanged with row IPIV(i).
kusano 2b45e8
*
kusano 2b45e8
*  INFO    (output) INTEGER
kusano 2b45e8
*          = 0: successful exit
kusano 2b45e8
*          < 0: if INFO = -k, the k-th argument had an illegal value
kusano 2b45e8
*          > 0: if INFO = k, U(k,k) is exactly zero. The factorization
kusano 2b45e8
*               has been completed, but the factor U is exactly
kusano 2b45e8
*               singular, and division by zero will occur if it is used
kusano 2b45e8
*               to solve a system of equations.
kusano 2b45e8
*
kusano 2b45e8
*  =====================================================================
kusano 2b45e8
*
kusano 2b45e8
*     .. Parameters ..
kusano 2b45e8
      REAL               ONE, ZERO
kusano 2b45e8
      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
kusano 2b45e8
*     ..
kusano 2b45e8
*     .. Local Scalars ..
kusano 2b45e8
      INTEGER            J, JP
kusano 2b45e8
*     ..
kusano 2b45e8
*     .. External Functions ..
kusano 2b45e8
      INTEGER            ISAMAX
kusano 2b45e8
      EXTERNAL           ISAMAX
kusano 2b45e8
*     ..
kusano 2b45e8
*     .. External Subroutines ..
kusano 2b45e8
      EXTERNAL           SGER, SSCAL, SSWAP, XERBLA
kusano 2b45e8
*     ..
kusano 2b45e8
*     .. Intrinsic Functions ..
kusano 2b45e8
      INTRINSIC          MAX, MIN
kusano 2b45e8
*     ..
kusano 2b45e8
*     .. Executable Statements ..
kusano 2b45e8
*
kusano 2b45e8
*     Test the input parameters.
kusano 2b45e8
*
kusano 2b45e8
      INFO = 0
kusano 2b45e8
      IF( M.LT.0 ) THEN
kusano 2b45e8
         INFO = -1
kusano 2b45e8
      ELSE IF( N.LT.0 ) THEN
kusano 2b45e8
         INFO = -2
kusano 2b45e8
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
kusano 2b45e8
         INFO = -4
kusano 2b45e8
      END IF
kusano 2b45e8
      IF( INFO.NE.0 ) THEN
kusano 2b45e8
         CALL XERBLA( 'SGETF2', -INFO )
kusano 2b45e8
         RETURN
kusano 2b45e8
      END IF
kusano 2b45e8
*
kusano 2b45e8
*     Quick return if possible
kusano 2b45e8
*
kusano 2b45e8
      IF( M.EQ.0 .OR. N.EQ.0 )
kusano 2b45e8
     $   RETURN
kusano 2b45e8
*
kusano 2b45e8
      DO 10 J = 1, MIN( M, N )
kusano 2b45e8
*
kusano 2b45e8
*        Find pivot and test for singularity.
kusano 2b45e8
*
kusano 2b45e8
         JP = J - 1 + ISAMAX( M-J+1, A( J, J ), 1 )
kusano 2b45e8
         IPIV( J ) = JP
kusano 2b45e8
         IF( A( JP, J ).NE.ZERO ) THEN
kusano 2b45e8
*
kusano 2b45e8
*           Apply the interchange to columns 1:N.
kusano 2b45e8
*
kusano 2b45e8
            IF( JP.NE.J )
kusano 2b45e8
     $         CALL SSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA )
kusano 2b45e8
*
kusano 2b45e8
*           Compute elements J+1:M of J-th column.
kusano 2b45e8
*
kusano 2b45e8
            IF( J.LT.M )
kusano 2b45e8
     $         CALL SSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
kusano 2b45e8
*
kusano 2b45e8
         ELSE IF( INFO.EQ.0 ) THEN
kusano 2b45e8
*
kusano 2b45e8
            INFO = J
kusano 2b45e8
         END IF
kusano 2b45e8
*
kusano 2b45e8
         IF( J.LT.MIN( M, N ) ) THEN
kusano 2b45e8
*
kusano 2b45e8
*           Update trailing submatrix.
kusano 2b45e8
*
kusano 2b45e8
            CALL SGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA,
kusano 2b45e8
     $                 A( J+1, J+1 ), LDA )
kusano 2b45e8
         END IF
kusano 2b45e8
   10 CONTINUE
kusano 2b45e8
      RETURN
kusano 2b45e8
*
kusano 2b45e8
*     End of SGETF2
kusano 2b45e8
*
kusano 2b45e8
      END