001:       SUBROUTINE CORE_SGEQRT( M, N, IB, A, LDA, T, LDT,
002:      $                       TAU, WORK, INFO )
003: 
004: *********************************************************************
005: *     PLASMA core_blas routine (version 2.1.0)                      *
006: *     Author: Hatem Ltaief                                          *
007: *     Release Date: November, 15th 2009                             *
008: *     PLASMA is a software package provided by Univ. of Tennessee,  *
009: *     Univ. of California Berkeley and Univ. of Colorado Denver.    *
010: *********************************************************************
011: *
012: *     .. Scalar Arguments ..
013:       INTEGER            M, N, IB, LDA, LDT, INFO
014: *     ..
015: *     .. Array Arguments ..
016:       REAL            A( LDA, * ), T( LDT, * )
017:       REAL            TAU( * ), WORK( * )
018: *     ..
019: *
020: *  Purpose
021: *  =======
022: *
023: *  CORE_SGEQRT computes a QR factorization of a real M-by-N tile A:
024: *  A = Q * R.
025: *
026: *  Arguments
027: *  =========
028: *
029: *  M       (input) INTEGER
030: *          The number of rows of the tile A.  M >= 0.
031: *
032: *  N       (input) INTEGER
033: *          The number of columns of the tile A.  N >= 0.
034: *
035: *  IB      (input) INTEGER
036: *          The inner-blocking size.  IB >= 0.
037: *
038: *  A       (input/output) REAL array, dimension (LDA,N)
039: *          On entry, the M-by-N tile A.
040: *          On exit, the elements on and above the diagonal of the array
041: *          contain the min(M,N)-by-N upper trapezoidal tile R (R is
042: *          upper triangular if M >= N); the elements below the diagonal,
043: *          with the array TAU, represent the orthogonal tile Q as a
044: *          product of elementary reflectors (see Further Details).
045: *
046: *  LDA     (input) INTEGER
047: *          The leading dimension of the array A.  LDA >= max(1,M).
048: *
049: *  T       (output) REAL array, dimension (LDT,N)
050: *          The IB-by-N triangular factor T of the block reflector.
051: *          T is upper triangular by block (economic storage);
052: *          The rest of the array is not referenced.
053: *
054: *  LDT     (input) INTEGER
055: *          The leading dimension of the array T. LDT >= IB.
056: *
057: *  TAU     (output) REAL array, dimension (min(M,N))
058: *          The scalar factors of the elementary reflectors (see Further
059: *          Details).
060: *
061: *  WORK    (workspace) REAL array, dimension (N)
062: *
063: *  INFO    (output) INTEGER
064: *          = 0: successful exit
065: *          < 0: if INFO = -i, the i-th argument had an illegal value
066: *
067: *  Further Details
068: *  ===============
069: *
070: *  The tile Q is represented as a product of elementary reflectors
071: *
072: *     Q = H(1) H(2) . . . H(k), where k = min(M,N).
073: *
074: *  Each H(i) has the form
075: *
076: *     H(i) = I - tau * v * v'
077: *
078: *  where tau is a real scalar, and v is a real vector with
079: *  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
080: *  and tau in TAU(i).
081: *
082: *  =====================================================================
083: *
084: *     ..
085: *     .. Local Scalars ..
086:       INTEGER            I, K, SB, IINFO
087: *     ..
088: *     .. External Subroutines ..
089:       EXTERNAL           XERBLA, SGEQR2, SLARFT, CORE_SORMQR
090: *     ..
091: *     .. Intrinsic Functions ..
092:       INTRINSIC          MAX, MIN
093: *     ..
094: *     Test the input arguments.
095:       INFO = 0
096:       IF( M.LT.0 ) THEN
097:          INFO = -1
098:       ELSE IF( N.LT.0 ) THEN
099:          INFO = -2
100:       ELSE IF( IB.LT.0 ) THEN
101:          INFO = -3
102:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
103:          INFO = -5
104:       ELSE IF( LDT.LT.MAX( 1, IB ) ) THEN
105:          INFO = -7
106:       END IF
107:       IF( INFO.NE.0 ) THEN
108:          CALL XERBLA( 'CORE_SGEQRT', -INFO )
109:          RETURN
110:       END IF
111: *
112: *     Quick return if possible.
113: *
114:       IF( M.EQ.0 .OR. N.EQ.0 .OR. IB.EQ.0 )
115:      $   RETURN
116: *
117:       K = MIN( M, N )
118: *
119:       DO 10 I = 1, K, IB
120:          SB = MIN( IB, K-I+1 )
121:          CALL SGEQR2( M-I+1, SB, A( I, I ), LDA, TAU( I ), WORK, IINFO )
122: *
123:          CALL SLARFT( 'Forward', 'Columnwise', M-I+1, SB,
124:      $               A( I, I ), LDA, TAU( I ),
125:      $               T( 1, I ), LDT )
126: *
127:          CALL CORE_SORMQR( 'Left', 'Transpose',
128:      $                    M-I+1, N-I+1-SB, SB, SB,
129:      $                    A( I, I ), LDA,
130:      $                    T( 1, I ), LDT,     
131:      $                    A( I, I+SB ), LDA,
132:      $                    WORK, N-I+1-SB, IINFO )
133:  10   CONTINUE
134: *
135:       RETURN
136: *
137: *     End of CORE_SGEQRT.
138: *
139:       END
140: