SRC/zgeqr.f

   1 *
   2 *  Definition:
   3 *  ===========
   4 *
   5 *       SUBROUTINE ZGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
   6 *                        INFO)
   7 *
   8 *       .. Scalar Arguments ..
   9 *       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
  10 *       ..
  11 *       .. Array Arguments ..
  12 *       COMPLEX*16        A( LDA, * ), WORK1( * ), WORK2( * )
  13 *       ..
  14 *
  15 *
  16 *> \par Purpose:
  17 *  =============
  18 *>
  19 *> \verbatim
  20 *>
  21 *> ZGEQR computes a QR factorization of an M-by-N matrix A,
  22 *> using ZLATSQR when A is tall and skinny
  23 *> (M sufficiently greater than N), and otherwise ZGEQRT:
  24 *> A = Q * R .
  25 *> \endverbatim
  26 *
  27 *  Arguments:
  28 *  ==========
  29 *
  30 *> \param[in] M
  31 *> \verbatim
  32 *>          M is INTEGER
  33 *>          The number of rows of the matrix A.  M >= 0.
  34 *> \endverbatim
  35 *>
  36 *> \param[in] N
  37 *> \verbatim
  38 *>          N is INTEGER
  39 *>          The number of columns of the matrix A.  N >= 0.
  40 *> \endverbatim
  41 *>
  42 *> \param[in,out] A
  43 *> \verbatim
  44 *>          A is COMPLEX*16 array, dimension (LDA,N)
  45 *>          On entry, the M-by-N matrix A.
  46 *>          On exit, the elements on and above the diagonal of the array
  47 *>          contain the min(M,N)-by-N upper trapezoidal matrix R
  48 *>          (R is upper triangular if M >= N);
  49 *>          the elements below the diagonal represent Q (see Further Details).
  50 *> \endverbatim
  51 *>
  52 *> \param[in] LDA
  53 *> \verbatim
  54 *>          LDA is INTEGER
  55 *>          The leading dimension of the array A.  LDA >= max(1,M).
  56 *> \endverbatim
  57 *>
  58 *> \param[out] WORK1
  59 *> \verbatim
  60 *>          WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1))
  61 *>          WORK1 contains part of the data structure used to store Q.
  62 *>          WORK1(1): algorithm type = 1, to indicate output from
  63 *>                    ZLATSQR or ZGEQRT
  64 *>          WORK1(2): optimum size of WORK1
  65 *>          WORK1(3): minimum size of WORK1
  66 *>          WORK1(4): row block size
  67 *>          WORK1(5): column block size
  68 *>          WORK1(6:LWORK1): data structure needed for Q, computed by
  69 *>                           CLATSQR or CGEQRT
  70 *> \endverbatim
  71 *>
  72 *> \param[in] LWORK1
  73 *> \verbatim
  74 *>          LWORK1 is INTEGER
  75 *>          The dimension of the array WORK1.
  76 *>          If LWORK1 = -1, then a query is assumed. In this case the
  77 *>          routine calculates the optimal size of WORK1 and
  78 *>          returns this value in WORK1(2), and calculates the minimum
  79 *>          size of WORK1 and returns this value in WORK1(3).
  80 *>          No error message related to LWORK1 is issued by XERBLA when
  81 *>          LWORK1 = -1.
  82 *> \endverbatim
  83 *>
  84 *> \param[out] WORK2
  85 *> \verbatim
  86 *>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2))
  87 *> \endverbatim
  88 *>
  89 *> \param[in] LWORK2
  90 *> \verbatim
  91 *>          LWORK2 is INTEGER
  92 *>          The dimension of the array WORK2.
  93 *>          If LWORK2 = -1, then a query is assumed. In this case the
  94 *>          routine calculates the optimal size of WORK2 and
  95 *>          returns this value in WORK2(1), and calculates the minimum
  96 *>          size of WORK2 and returns this value in WORK2(2).
  97 *>          No error message related to LWORK2 is issued by XERBLA when
  98 *>          LWORK2 = -1.
  99 *> \endverbatim
 100 *>
 101 *> \param[out] INFO
 102 *> \verbatim
 103 *>          INFO is INTEGER
 104 *>          = 0:  successful exit
 105 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 106 *> \endverbatim
 107 *
 108 *  Authors:
 109 *  ========
 110 *
 111 *> \author Univ. of Tennessee
 112 *> \author Univ. of California Berkeley
 113 *> \author Univ. of Colorado Denver
 114 *> \author NAG Ltd.
 115 *
 116 *> \par Further Details:
 117 *  =====================
 118 *>
 119 *> \verbatim
 120 *>  Depending on the matrix dimensions M and N, and row and column
 121 *>  block sizes MB and NB returned by ILAENV, GEQR will use either
 122 *>  LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
 123 *>  the QR decomposition.
 124 *>  The output of LATSQR or GEQRT representing Q is stored in A and in
 125 *>  array WORK1(6:LWORK1) for later use.
 126 *>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB
 127 *>  which are needed to interpret A and WORK1(6:LWORK1) for later use.
 128 *>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
 129 *>  decide whether LATSQR or GEQRT was used is the same as used below in
 130 *>  GEQR. For a detailed description of A and WORK1(6:LWORK1), see
 131 *>  Further Details in LATSQR or GEQRT.
 132 *> \endverbatim
 133 *>
 134 *  =====================================================================
 135       SUBROUTINE ZGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
 136      $   INFO)
 137 *
 138 *  -- LAPACK computational routine (version 3.5.0) --
 139 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 140 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
 141 *     November 2013
 142 *
 143 *     .. Scalar Arguments ..
 144       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
 145 *     ..
 146 *     .. Array Arguments ..
 147       COMPLEX*16      A( LDA, * ), WORK1( * ), WORK2( * )
 148 *     ..
 149 *
 150 *  =====================================================================
 151 *
 152 *     ..
 153 *     .. Local Scalars ..
 154       LOGICAL    LQUERY, LMINWS
 155       INTEGER    MB, NB, I, II, KK, MINLW1, NBLCKS
 156 *     ..
 157 *     .. EXTERNAL FUNCTIONS ..
 158       LOGICAL            LSAME
 159       EXTERNAL           LSAME
 160 *     .. EXTERNAL SUBROUTINES ..
 161       EXTERNAL    ZLATSQR, ZGEQRT, XERBLA
 162 *     .. INTRINSIC FUNCTIONS ..
 163       INTRINSIC          MAX, MIN, MOD
 164 *     ..
 165 *     .. EXTERNAL FUNCTIONS ..
 166       INTEGER            ILAENV
 167       EXTERNAL           ILAENV
 168 *     ..
 169 *     .. EXECUTABLE STATEMENTS ..
 170 *
 171 *     TEST THE INPUT ARGUMENTS
 172 *
 173       INFO = 0
 174 *
 175       LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
 176 *
 177 *     Determine the block size
 178 *
 179       IF ( MIN(M,N).GT.0 ) THEN
 180         MB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 1, -1)
 181         NB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 2, -1)
 182       ELSE
 183         MB = M
 184         NB = 1
 185       END IF
 186       IF( MB.GT.M.OR.MB.LE.N) MB = M
 187       IF( NB.GT.MIN(M,N).OR.NB.LT.1) NB = 1
 188       MINLW1 = N + 5
 189       IF ((MB.GT.N).AND.(M.GT.N)) THEN
 190         IF(MOD(M-N, MB-N).EQ.0) THEN
 191           NBLCKS = (M-N)/(MB-N)
 192         ELSE
 193           NBLCKS = (M-N)/(MB-N) + 1
 194         END IF
 195       ELSE
 196         NBLCKS = 1
 197       END IF
 198 *
 199 *     Determine if the workspace size satisfies minimum size
 200 *
 201       LMINWS = .FALSE.
 202       IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5)
 203      $    .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5)
 204      $    .AND.(.NOT.LQUERY)) THEN
 205         IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN
 206             LMINWS = .TRUE.
 207             NB = 1
 208         END IF
 209         IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN
 210             LMINWS = .TRUE.
 211             MB = M
 212         END IF
 213         IF (LWORK2.LT.NB*N) THEN
 214             LMINWS = .TRUE.
 215             NB = 1
 216         END IF
 217       END IF
 218 *
 219       IF( M.LT.0 ) THEN
 220         INFO = -1
 221       ELSE IF( N.LT.0 ) THEN
 222         INFO = -2
 223       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
 224         INFO = -4
 225       ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 )
 226      $   .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN
 227         INFO = -6
 228       ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY)
 229      $   .AND.(.NOT.LMINWS)) THEN
 230         INFO = -8
 231       END IF
 232
 233       IF( INFO.EQ.0)  THEN
 234         WORK1(1) = 1
 235         WORK1(2) = NB * N * NBLCKS + 5
 236         WORK1(3) = MINLW1
 237         WORK1(4) = MB
 238         WORK1(5) = NB
 239         WORK2(1) = NB * N
 240         WORK2(2) = N
 241       END IF
 242       IF( INFO.NE.0 ) THEN
 243         CALL XERBLA( 'ZGEQR', -INFO )
 244         RETURN
 245       ELSE IF (LQUERY) THEN
 246        RETURN
 247       END IF
 248 *
 249 *     Quick return if possible
 250 *
 251       IF( MIN(M,N).EQ.0 ) THEN
 252           RETURN
 253       END IF
 254 *
 255 *     The QR Decomposition
 256 *
 257       IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN
 258          CALL ZGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO)
 259       ELSE
 260          CALL ZLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2,
 261      $                    LWORK2, INFO)
 262       END IF
 263       RETURN
 264 *
 265 *     End of ZGEQR
 266 *
 267       END