1
       2
       3
       4
       5
       6
       7
       8
       9
      10
      11
      12
      13
      14
      15
      16
      17
      18
      19
      20
      21
      22
      23
      24
      25
      26
      27
      28
      29
      30
      31
      32
      33
      34
      35
      36
      37
      38
      39
      40
      41
      42
      43
      44
      45
      46
      47
      48
      49
      50
      51
      52
      53
      54
      55
      56
      57
      58
      59
      60
      61
      62
      63
      64
      65
      66
      67
      68
      69
      70
      71
      72
      73
      74
      75
      76
      77
      78
      79
      80
      81
      82
      83
      84
      85
      86
      87
      88
      89
      90
      91
      92
      93
      94
      95
      96
      97
      98
      99
     100
     101
     102
     103
     104
     105
     106
     107
     108
     109
     110
     111
     112
     113
     114
     115
     116
     117
     118
     119
     120
     121
     122
     123
     124
     125
     126
     127
     128
     129
     130
     131
     132
     133
     134
     135
     136
     137
     138
     139
     140
     141
     142
     143
     144
     145
     146
     147
     148
     149
     150
     151
     152
     153
     154
     155
     156
      SUBROUTINE DLQT01MNAAFQLLDATAUWORKLWORK,
     $                   RWORKRESULT )
*
*  -- LAPACK test routine (version 3.1) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     November 2006
*
*     .. Scalar Arguments ..
      INTEGER            LDALWORKMN
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION   ALDA* ), AFLDA* ), LLDA* ),
     $                   QLDA* ), RESULT* ), RWORK* ), TAU* ),
     $                   WORKLWORK )
*     ..
*
*  Purpose
*  =======
*
*  DLQT01 tests DGELQF, which computes the LQ factorization of an m-by-n
*  matrix A, and partially tests DORGLQ which forms the n-by-n
*  orthogonal matrix Q.
*
*  DLQT01 compares L with A*Q', and checks that Q is orthogonal.
*
*  Arguments
*  =========
*
*  M       (input) INTEGER
*          The number of rows of the matrix A.  M >= 0.
*
*  N       (input) INTEGER
*          The number of columns of the matrix A.  N >= 0.
*
*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
*          The m-by-n matrix A.
*
*  AF      (output) DOUBLE PRECISION array, dimension (LDA,N)
*          Details of the LQ factorization of A, as returned by DGELQF.
*          See DGELQF for further details.
*
*  Q       (output) DOUBLE PRECISION array, dimension (LDA,N)
*          The n-by-n orthogonal matrix Q.
*
*  L       (workspace) DOUBLE PRECISION array, dimension (LDA,max(M,N))
*
*  LDA     (input) INTEGER
*          The leading dimension of the arrays A, AF, Q and L.
*          LDA >= max(M,N).
*
*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
*          The scalar factors of the elementary reflectors, as returned
*          by DGELQF.
*
*  WORK    (workspace) DOUBLE PRECISION array, dimension (LWORK)
*
*  LWORK   (input) INTEGER
*          The dimension of the array WORK.
*
*  RWORK   (workspace) DOUBLE PRECISION array, dimension (max(M,N))
*
*  RESULT  (output) DOUBLE PRECISION array, dimension (2)
*          The test ratios:
*          RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS )
*          RESULT(2) = norm( I - Q*Q' ) / ( N * EPS )
*
*  =====================================================================
*
*     .. Parameters ..
      DOUBLE PRECISION   ZEROONE
      PARAMETER          ( ZERO = 0.0D+0ONE = 1.0D+0 )
      DOUBLE PRECISION   ROGUE
      PARAMETER          ( ROGUE = -1.0D+10 )
*     ..
*     .. Local Scalars ..
      INTEGER            INFOMINMN
      DOUBLE PRECISION   ANORMEPSRESID
*     ..
*     .. External Functions ..
      DOUBLE PRECISION   DLAMCHDLANGEDLANSY
      EXTERNAL           DLAMCHDLANGEDLANSY
*     ..
*     .. External Subroutines ..
      EXTERNAL           DGELQFDGEMMDLACPYDLASETDORGLQDSYRK
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          DBLEMAXMIN
*     ..
*     .. Scalars in Common ..
      CHARACTER*32       SRNAMT
*     ..
*     .. Common blocks ..
      COMMON             / SRNAMC / SRNAMT
*     ..
*     .. Executable Statements ..
*
      MINMN = MINMN )
      EPS = DLAMCH'Epsilon' )
*
*     Copy the matrix A to the array AF.
*
      CALL DLACPY'Full'MNALDAAFLDA )
*
*     Factorize the matrix A in the array AF.
*
      SRNAMT = 'DGELQF'
      CALL DGELQFMNAFLDATAUWORKLWORKINFO )
*
*     Copy details of Q
*
      CALL DLASET'Full'NNROGUEROGUEQLDA )
      IFN.GT.1 )
     $   CALL DLACPY'Upper'MN-1AF12 ), LDAQ12 ), LDA )
*
*     Generate the n-by-n matrix Q
*
      SRNAMT = 'DORGLQ'
      CALL DORGLQNNMINMNQLDATAUWORKLWORKINFO )
*
*     Copy L
*
      CALL DLASET'Full'MNZEROZEROLLDA )
      CALL DLACPY'Lower'MNAFLDALLDA )
*
*     Compute L - A*Q'
*
      CALL DGEMM'No transpose''Transpose'MNN-ONEALDAQ,
     $            LDAONELLDA )
*
*     Compute norm( L - Q'*A ) / ( N * norm(A) * EPS ) .
*
      ANORM = DLANGE'1'MNALDARWORK )
      RESID = DLANGE'1'MNLLDARWORK )
      IFANORM.GT.ZERO ) THEN
         RESULT1 ) = ( ( RESID / DBLEMAX1N ) ) ) / ANORM ) / EPS
      ELSE
         RESULT1 ) = ZERO
      END IF
*
*     Compute I - Q*Q'
*
      CALL DLASET'Full'NNZEROONELLDA )
      CALL DSYRK'Upper''No transpose'NN-ONEQLDAONEL,
     $            LDA )
*
*     Compute norm( I - Q*Q' ) / ( N * EPS ) .
*
      RESID = DLANSY'1''Upper'NLLDARWORK )
*
      RESULT2 ) = ( RESID / DBLEMAX1N ) ) ) / EPS
*
      RETURN
*
*     End of DLQT01
*
      END