LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ zlqt05()

subroutine zlqt05 ( integer  M,
integer  N,
integer  L,
integer  NB,
double precision, dimension(6)  RESULT 
)

ZLQT05

Purpose:
 ZQRT05 tests ZTPLQT and ZTPMLQT.
Parameters
[in]M
          M is INTEGER
          Number of rows in lower part of the test matrix.
[in]N
          N is INTEGER
          Number of columns in test matrix.
[in]L
          L is INTEGER
          The number of rows of the upper trapezoidal part the
          lower test matrix.  0 <= L <= M.
[in]NB
          NB is INTEGER
          Block size of test matrix.  NB <= N.
[out]RESULT
          RESULT is DOUBLE PRECISION array, dimension (6)
          Results of each of the six tests below.

          RESULT(1) = | A - Q R |
          RESULT(2) = | I - Q^H Q |
          RESULT(3) = | Q C - Q C |
          RESULT(4) = | Q^H C - Q^H C |
          RESULT(5) = | C Q - C Q |
          RESULT(6) = | C Q^H - C Q^H |
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 79 of file zlqt05.f.

80  IMPLICIT NONE
81 *
82 * -- LAPACK test routine --
83 * -- LAPACK is a software package provided by Univ. of Tennessee, --
84 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
85 *
86 * .. Scalar Arguments ..
87  INTEGER LWORK, M, N, L, NB, LDT
88 * .. Return values ..
89  DOUBLE PRECISION RESULT(6)
90 *
91 * =====================================================================
92 *
93 * ..
94 * .. Local allocatable arrays
95  COMPLEX*16, ALLOCATABLE :: AF(:,:), Q(:,:),
96  $ R(:,:), RWORK(:), WORK( : ), T(:,:),
97  $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:)
98 *
99 * .. Parameters ..
100  DOUBLE PRECISION ZERO
101  COMPLEX*16 ONE, CZERO
102  parameter( zero = 0.0, one = (1.0,0.0), czero=(0.0,0.0) )
103 * ..
104 * .. Local Scalars ..
105  INTEGER INFO, J, K, N2, NP1,i
106  DOUBLE PRECISION ANORM, EPS, RESID, CNORM, DNORM
107 * ..
108 * .. Local Arrays ..
109  INTEGER ISEED( 4 )
110 * ..
111 * .. External Functions ..
112  DOUBLE PRECISION DLAMCH
113  DOUBLE PRECISION ZLANGE, ZLANSY
114  LOGICAL LSAME
115  EXTERNAL dlamch, zlange, zlansy, lsame
116 * ..
117 * .. Data statements ..
118  DATA iseed / 1988, 1989, 1990, 1991 /
119 *
120  eps = dlamch( 'Epsilon' )
121  k = m
122  n2 = m+n
123  IF( n.GT.0 ) THEN
124  np1 = m+1
125  ELSE
126  np1 = 1
127  END IF
128  lwork = n2*n2*nb
129 *
130 * Dynamically allocate all arrays
131 *
132  ALLOCATE(a(m,n2),af(m,n2),q(n2,n2),r(n2,n2),rwork(n2),
133  $ work(lwork),t(nb,m),c(n2,m),cf(n2,m),
134  $ d(m,n2),df(m,n2) )
135 *
136 * Put random stuff into A
137 *
138  ldt=nb
139  CALL zlaset( 'Full', m, n2, czero, czero, a, m )
140  CALL zlaset( 'Full', nb, m, czero, czero, t, nb )
141  DO j=1,m
142  CALL zlarnv( 2, iseed, m-j+1, a( j, j ) )
143  END DO
144  IF( n.GT.0 ) THEN
145  DO j=1,n-l
146  CALL zlarnv( 2, iseed, m, a( 1, min(n+m,m+1) + j - 1 ) )
147  END DO
148  END IF
149  IF( l.GT.0 ) THEN
150  DO j=1,l
151  CALL zlarnv( 2, iseed, m-j+1, a( j, min(n+m,n+m-l+1)
152  $ + j - 1 ) )
153  END DO
154  END IF
155 *
156 * Copy the matrix A to the array AF.
157 *
158  CALL zlacpy( 'Full', m, n2, a, m, af, m )
159 *
160 * Factor the matrix A in the array AF.
161 *
162  CALL ztplqt( m,n,l,nb,af,m,af(1,np1),m,t,ldt,work,info)
163 *
164 * Generate the (M+N)-by-(M+N) matrix Q by applying H to I
165 *
166  CALL zlaset( 'Full', n2, n2, czero, one, q, n2 )
167  CALL zgemlqt( 'L', 'N', n2, n2, k, nb, af, m, t, ldt, q, n2,
168  $ work, info )
169 *
170 * Copy L
171 *
172  CALL zlaset( 'Full', n2, n2, czero, czero, r, n2 )
173  CALL zlacpy( 'Lower', m, n2, af, m, r, n2 )
174 *
175 * Compute |L - A*Q*C| / |A| and store in RESULT(1)
176 *
177  CALL zgemm( 'N', 'C', m, n2, n2, -one, a, m, q, n2, one, r, n2)
178  anorm = zlange( '1', m, n2, a, m, rwork )
179  resid = zlange( '1', m, n2, r, n2, rwork )
180  IF( anorm.GT.zero ) THEN
181  result( 1 ) = resid / (eps*anorm*max(1,n2))
182  ELSE
183  result( 1 ) = zero
184  END IF
185 *
186 * Compute |I - Q*Q'| and store in RESULT(2)
187 *
188  CALL zlaset( 'Full', n2, n2, czero, one, r, n2 )
189  CALL zherk( 'U', 'N', n2, n2, dreal(-one), q, n2, dreal(one),
190  $ r, n2 )
191  resid = zlansy( '1', 'Upper', n2, r, n2, rwork )
192  result( 2 ) = resid / (eps*max(1,n2))
193 *
194 * Generate random m-by-n matrix C and a copy CF
195 *
196  CALL zlaset( 'Full', n2, m, czero, one, c, n2 )
197  DO j=1,m
198  CALL zlarnv( 2, iseed, n2, c( 1, j ) )
199  END DO
200  cnorm = zlange( '1', n2, m, c, n2, rwork)
201  CALL zlacpy( 'Full', n2, m, c, n2, cf, n2 )
202 *
203 * Apply Q to C as Q*C
204 *
205  CALL ztpmlqt( 'L','N', n,m,k,l,nb,af(1, np1),m,t,ldt,cf,n2,
206  $ cf(np1,1),n2,work,info)
207 *
208 * Compute |Q*C - Q*C| / |C|
209 *
210  CALL zgemm( 'N', 'N', n2, m, n2, -one, q, n2, c, n2, one, cf, n2 )
211  resid = zlange( '1', n2, m, cf, n2, rwork )
212  IF( cnorm.GT.zero ) THEN
213  result( 3 ) = resid / (eps*max(1,n2)*cnorm)
214  ELSE
215  result( 3 ) = zero
216  END IF
217 
218 *
219 * Copy C into CF again
220 *
221  CALL zlacpy( 'Full', n2, m, c, n2, cf, n2 )
222 *
223 * Apply Q to C as QT*C
224 *
225  CALL ztpmlqt( 'L','C',n,m,k,l,nb,af(1,np1),m,t,ldt,cf,n2,
226  $ cf(np1,1),n2,work,info)
227 *
228 * Compute |QT*C - QT*C| / |C|
229 *
230  CALL zgemm('C','N',n2,m,n2,-one,q,n2,c,n2,one,cf,n2)
231  resid = zlange( '1', n2, m, cf, n2, rwork )
232 
233  IF( cnorm.GT.zero ) THEN
234  result( 4 ) = resid / (eps*max(1,n2)*cnorm)
235  ELSE
236  result( 4 ) = zero
237  END IF
238 *
239 * Generate random m-by-n matrix D and a copy DF
240 *
241  DO j=1,n2
242  CALL zlarnv( 2, iseed, m, d( 1, j ) )
243  END DO
244  dnorm = zlange( '1', m, n2, d, m, rwork)
245  CALL zlacpy( 'Full', m, n2, d, m, df, m )
246 *
247 * Apply Q to D as D*Q
248 *
249  CALL ztpmlqt('R','N',m,n,k,l,nb,af(1,np1),m,t,ldt,df,m,
250  $ df(1,np1),m,work,info)
251 *
252 * Compute |D*Q - D*Q| / |D|
253 *
254  CALL zgemm('N','N',m,n2,n2,-one,d,m,q,n2,one,df,m)
255  resid = zlange('1',m, n2,df,m,rwork )
256  IF( cnorm.GT.zero ) THEN
257  result( 5 ) = resid / (eps*max(1,n2)*dnorm)
258  ELSE
259  result( 5 ) = zero
260  END IF
261 *
262 * Copy D into DF again
263 *
264  CALL zlacpy('Full',m,n2,d,m,df,m )
265 *
266 * Apply Q to D as D*QT
267 *
268  CALL ztpmlqt('R','C',m,n,k,l,nb,af(1,np1),m,t,ldt,df,m,
269  $ df(1,np1),m,work,info)
270 
271 *
272 * Compute |D*QT - D*QT| / |D|
273 *
274  CALL zgemm( 'N', 'C', m, n2, n2, -one, d, m, q, n2, one, df, m )
275  resid = zlange( '1', m, n2, df, m, rwork )
276  IF( cnorm.GT.zero ) THEN
277  result( 6 ) = resid / (eps*max(1,n2)*dnorm)
278  ELSE
279  result( 6 ) = zero
280  END IF
281 *
282 * Deallocate all arrays
283 *
284  DEALLOCATE ( a, af, q, r, rwork, work, t, c, d, cf, df)
285  RETURN
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
Definition: zgemm.f:187
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK
Definition: zherk.f:173
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:115
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:103
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: zlarnv.f:99
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: zlaset.f:106
double precision function zlansy(NORM, UPLO, N, A, LDA, WORK)
ZLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: zlansy.f:123
subroutine zgemlqt(SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, C, LDC, WORK, INFO)
ZGEMLQT
Definition: zgemlqt.f:168
subroutine ztplqt(M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK, INFO)
ZTPLQT
Definition: ztplqt.f:189
subroutine ztpmlqt(SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
ZTPMLQT
Definition: ztpmlqt.f:214
Here is the call graph for this function:
Here is the caller graph for this function: