LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ zchkpo()

 subroutine zchkpo ( logical, dimension( * ) dotype, integer nn, integer, dimension( * ) nval, integer nnb, integer, dimension( * ) nbval, integer nns, integer, dimension( * ) nsval, double precision thresh, logical tsterr, integer nmax, complex*16, dimension( * ) a, complex*16, dimension( * ) afac, complex*16, dimension( * ) ainv, complex*16, dimension( * ) b, complex*16, dimension( * ) x, complex*16, dimension( * ) xact, complex*16, dimension( * ) work, double precision, dimension( * ) rwork, integer nout )

ZCHKPO

Purpose:
` ZCHKPO tests ZPOTRF, -TRI, -TRS, -RFS, and -CON`
Parameters
 [in] DOTYPE ``` DOTYPE is LOGICAL array, dimension (NTYPES) The matrix types to be used for testing. Matrices of type j (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.``` [in] NN ``` NN is INTEGER The number of values of N contained in the vector NVAL.``` [in] NVAL ``` NVAL is INTEGER array, dimension (NN) The values of the matrix dimension N.``` [in] NNB ``` NNB is INTEGER The number of values of NB contained in the vector NBVAL.``` [in] NBVAL ``` NBVAL is INTEGER array, dimension (NNB) The values of the blocksize NB.``` [in] NNS ``` NNS is INTEGER The number of values of NRHS contained in the vector NSVAL.``` [in] NSVAL ``` NSVAL is INTEGER array, dimension (NNS) The values of the number of right hand sides NRHS.``` [in] THRESH ``` THRESH is DOUBLE PRECISION The threshold value for the test ratios. A result is included in the output file if RESULT >= THRESH. To have every test ratio printed, use THRESH = 0.``` [in] TSTERR ``` TSTERR is LOGICAL Flag that indicates whether error exits are to be tested.``` [in] NMAX ``` NMAX is INTEGER The maximum value permitted for N, used in dimensioning the work arrays.``` [out] A ` A is COMPLEX*16 array, dimension (NMAX*NMAX)` [out] AFAC ` AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)` [out] AINV ` AINV is COMPLEX*16 array, dimension (NMAX*NMAX)` [out] B ``` B is COMPLEX*16 array, dimension (NMAX*NSMAX) where NSMAX is the largest entry in NSVAL.``` [out] X ` X is COMPLEX*16 array, dimension (NMAX*NSMAX)` [out] XACT ` XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)` [out] WORK ``` WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))``` [out] RWORK ``` RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NSMAX)``` [in] NOUT ``` NOUT is INTEGER The unit number for output.```

Definition at line 165 of file zchkpo.f.

168*
169* -- LAPACK test routine --
170* -- LAPACK is a software package provided by Univ. of Tennessee, --
171* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172*
173* .. Scalar Arguments ..
174 LOGICAL TSTERR
175 INTEGER NMAX, NN, NNB, NNS, NOUT
176 DOUBLE PRECISION THRESH
177* ..
178* .. Array Arguments ..
179 LOGICAL DOTYPE( * )
180 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
181 DOUBLE PRECISION RWORK( * )
182 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
183 \$ WORK( * ), X( * ), XACT( * )
184* ..
185*
186* =====================================================================
187*
188* .. Parameters ..
189 COMPLEX*16 CZERO
190 parameter( czero = ( 0.0d+0, 0.0d+0 ) )
191 INTEGER NTYPES
192 parameter( ntypes = 9 )
193 INTEGER NTESTS
194 parameter( ntests = 8 )
195* ..
196* .. Local Scalars ..
197 LOGICAL ZEROT
198 CHARACTER DIST, TYPE, UPLO, XTYPE
199 CHARACTER*3 PATH
200 INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO,
201 \$ IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS,
202 \$ NFAIL, NIMAT, NRHS, NRUN
203 DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
204* ..
205* .. Local Arrays ..
206 CHARACTER UPLOS( 2 )
207 INTEGER ISEED( 4 ), ISEEDY( 4 )
208 DOUBLE PRECISION RESULT( NTESTS )
209* ..
210* .. External Functions ..
211 DOUBLE PRECISION DGET06, ZLANHE
212 EXTERNAL dget06, zlanhe
213* ..
214* .. External Subroutines ..
215 EXTERNAL alaerh, alahd, alasum, xlaenv, zerrpo, zget04,
218 \$ zpotri, zpotrs
219* ..
220* .. Scalars in Common ..
221 LOGICAL LERR, OK
222 CHARACTER*32 SRNAMT
223 INTEGER INFOT, NUNIT
224* ..
225* .. Common blocks ..
226 COMMON / infoc / infot, nunit, ok, lerr
227 COMMON / srnamc / srnamt
228* ..
229* .. Intrinsic Functions ..
230 INTRINSIC max
231* ..
232* .. Data statements ..
233 DATA iseedy / 1988, 1989, 1990, 1991 /
234 DATA uplos / 'U', 'L' /
235* ..
236* .. Executable Statements ..
237*
238* Initialize constants and the random number seed.
239*
240 path( 1: 1 ) = 'Zomplex precision'
241 path( 2: 3 ) = 'PO'
242 nrun = 0
243 nfail = 0
244 nerrs = 0
245 DO 10 i = 1, 4
246 iseed( i ) = iseedy( i )
247 10 CONTINUE
248*
249* Test the error exits
250*
251 IF( tsterr )
252 \$ CALL zerrpo( path, nout )
253 infot = 0
254*
255* Do for each value of N in NVAL
256*
257 DO 120 in = 1, nn
258 n = nval( in )
259 lda = max( n, 1 )
260 xtype = 'N'
261 nimat = ntypes
262 IF( n.LE.0 )
263 \$ nimat = 1
264*
265 izero = 0
266 DO 110 imat = 1, nimat
267*
268* Do the tests only if DOTYPE( IMAT ) is true.
269*
270 IF( .NOT.dotype( imat ) )
271 \$ GO TO 110
272*
273* Skip types 3, 4, or 5 if the matrix size is too small.
274*
275 zerot = imat.GE.3 .AND. imat.LE.5
276 IF( zerot .AND. n.LT.imat-2 )
277 \$ GO TO 110
278*
279* Do first for UPLO = 'U', then for UPLO = 'L'
280*
281 DO 100 iuplo = 1, 2
282 uplo = uplos( iuplo )
283*
284* Set up parameters with ZLATB4 and generate a test matrix
285* with ZLATMS.
286*
287 CALL zlatb4( path, imat, n, n, TYPE, KL, KU, ANORM, MODE,
288 \$ CNDNUM, DIST )
289*
290 srnamt = 'ZLATMS'
291 CALL zlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
292 \$ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
293 \$ INFO )
294*
295* Check error code from ZLATMS.
296*
297 IF( info.NE.0 ) THEN
298 CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n, -1,
299 \$ -1, -1, imat, nfail, nerrs, nout )
300 GO TO 100
301 END IF
302*
303* For types 3-5, zero one row and column of the matrix to
304* test that INFO is returned correctly.
305*
306 IF( zerot ) THEN
307 IF( imat.EQ.3 ) THEN
308 izero = 1
309 ELSE IF( imat.EQ.4 ) THEN
310 izero = n
311 ELSE
312 izero = n / 2 + 1
313 END IF
314 ioff = ( izero-1 )*lda
315*
316* Set row and column IZERO of A to 0.
317*
318 IF( iuplo.EQ.1 ) THEN
319 DO 20 i = 1, izero - 1
320 a( ioff+i ) = czero
321 20 CONTINUE
322 ioff = ioff + izero
323 DO 30 i = izero, n
324 a( ioff ) = czero
325 ioff = ioff + lda
326 30 CONTINUE
327 ELSE
328 ioff = izero
329 DO 40 i = 1, izero - 1
330 a( ioff ) = czero
331 ioff = ioff + lda
332 40 CONTINUE
333 ioff = ioff - izero
334 DO 50 i = izero, n
335 a( ioff+i ) = czero
336 50 CONTINUE
337 END IF
338 ELSE
339 izero = 0
340 END IF
341*
342* Set the imaginary part of the diagonals.
343*
344 CALL zlaipd( n, a, lda+1, 0 )
345*
346* Do for each value of NB in NBVAL
347*
348 DO 90 inb = 1, nnb
349 nb = nbval( inb )
350 CALL xlaenv( 1, nb )
351*
352* Compute the L*L' or U'*U factorization of the matrix.
353*
354 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
355 srnamt = 'ZPOTRF'
356 CALL zpotrf( uplo, n, afac, lda, info )
357*
358* Check error code from ZPOTRF.
359*
360 IF( info.NE.izero ) THEN
361 CALL alaerh( path, 'ZPOTRF', info, izero, uplo, n,
362 \$ n, -1, -1, nb, imat, nfail, nerrs,
363 \$ nout )
364 GO TO 90
365 END IF
366*
367* Skip the tests if INFO is not 0.
368*
369 IF( info.NE.0 )
370 \$ GO TO 90
371*
372*+ TEST 1
373* Reconstruct matrix from factors and compute residual.
374*
375 CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
376 CALL zpot01( uplo, n, a, lda, ainv, lda, rwork,
377 \$ result( 1 ) )
378*
379*+ TEST 2
380* Form the inverse and compute the residual.
381*
382 CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
383 srnamt = 'ZPOTRI'
384 CALL zpotri( uplo, n, ainv, lda, info )
385*
386* Check error code from ZPOTRI.
387*
388 IF( info.NE.0 )
389 \$ CALL alaerh( path, 'ZPOTRI', info, 0, uplo, n, n,
390 \$ -1, -1, -1, imat, nfail, nerrs, nout )
391*
392 CALL zpot03( uplo, n, a, lda, ainv, lda, work, lda,
393 \$ rwork, rcondc, result( 2 ) )
394*
395* Print information about the tests that did not pass
396* the threshold.
397*
398 DO 60 k = 1, 2
399 IF( result( k ).GE.thresh ) THEN
400 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
401 \$ CALL alahd( nout, path )
402 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
403 \$ result( k )
404 nfail = nfail + 1
405 END IF
406 60 CONTINUE
407 nrun = nrun + 2
408*
409* Skip the rest of the tests unless this is the first
410* blocksize.
411*
412 IF( inb.NE.1 )
413 \$ GO TO 90
414*
415 DO 80 irhs = 1, nns
416 nrhs = nsval( irhs )
417*
418*+ TEST 3
419* Solve and compute residual for A * X = B .
420*
421 srnamt = 'ZLARHS'
422 CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
423 \$ nrhs, a, lda, xact, lda, b, lda,
424 \$ iseed, info )
425 CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
426*
427 srnamt = 'ZPOTRS'
428 CALL zpotrs( uplo, n, nrhs, afac, lda, x, lda,
429 \$ info )
430*
431* Check error code from ZPOTRS.
432*
433 IF( info.NE.0 )
434 \$ CALL alaerh( path, 'ZPOTRS', info, 0, uplo, n,
435 \$ n, -1, -1, nrhs, imat, nfail,
436 \$ nerrs, nout )
437*
438 CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
439 CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
440 \$ lda, rwork, result( 3 ) )
441*
442*+ TEST 4
443* Check solution from generated exact solution.
444*
445 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
446 \$ result( 4 ) )
447*
448*+ TESTS 5, 6, and 7
449* Use iterative refinement to improve the solution.
450*
451 srnamt = 'ZPORFS'
452 CALL zporfs( uplo, n, nrhs, a, lda, afac, lda, b,
453 \$ lda, x, lda, rwork, rwork( nrhs+1 ),
454 \$ work, rwork( 2*nrhs+1 ), info )
455*
456* Check error code from ZPORFS.
457*
458 IF( info.NE.0 )
459 \$ CALL alaerh( path, 'ZPORFS', info, 0, uplo, n,
460 \$ n, -1, -1, nrhs, imat, nfail,
461 \$ nerrs, nout )
462*
463 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
464 \$ result( 5 ) )
465 CALL zpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
466 \$ xact, lda, rwork, rwork( nrhs+1 ),
467 \$ result( 6 ) )
468*
469* Print information about the tests that did not pass
470* the threshold.
471*
472 DO 70 k = 3, 7
473 IF( result( k ).GE.thresh ) THEN
474 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
475 \$ CALL alahd( nout, path )
476 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
477 \$ imat, k, result( k )
478 nfail = nfail + 1
479 END IF
480 70 CONTINUE
481 nrun = nrun + 5
482 80 CONTINUE
483*
484*+ TEST 8
485* Get an estimate of RCOND = 1/CNDNUM.
486*
487 anorm = zlanhe( '1', uplo, n, a, lda, rwork )
488 srnamt = 'ZPOCON'
489 CALL zpocon( uplo, n, afac, lda, anorm, rcond, work,
490 \$ rwork, info )
491*
492* Check error code from ZPOCON.
493*
494 IF( info.NE.0 )
495 \$ CALL alaerh( path, 'ZPOCON', info, 0, uplo, n, n,
496 \$ -1, -1, -1, imat, nfail, nerrs, nout )
497*
498 result( 8 ) = dget06( rcond, rcondc )
499*
500* Print the test ratio if it is .GE. THRESH.
501*
502 IF( result( 8 ).GE.thresh ) THEN
503 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
504 \$ CALL alahd( nout, path )
505 WRITE( nout, fmt = 9997 )uplo, n, imat, 8,
506 \$ result( 8 )
507 nfail = nfail + 1
508 END IF
509 nrun = nrun + 1
510 90 CONTINUE
511 100 CONTINUE
512 110 CONTINUE
513 120 CONTINUE
514*
515* Print a summary of the results.
516*
517 CALL alasum( path, nout, nfail, nrun, nerrs )
518*
519 9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
520 \$ i2, ', test ', i2, ', ratio =', g12.5 )
521 9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
522 \$ i2, ', test(', i2, ') =', g12.5 )
523 9997 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
524 \$ ', test(', i2, ') =', g12.5 )
525 RETURN
526*
527* End of ZCHKPO
528*
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
subroutine xlaenv(ispec, nvalue)
XLAENV
Definition xlaenv.f:81
subroutine zlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
ZLARHS
Definition zlarhs.f:208
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
Definition alaerh.f:147
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
double precision function dget06(rcond, rcondc)
DGET06
Definition dget06.f:55
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
double precision function zlanhe(norm, uplo, n, a, lda, work)
ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition zlanhe.f:124
subroutine zpocon(uplo, n, a, lda, anorm, rcond, work, rwork, info)
ZPOCON
Definition zpocon.f:121
subroutine zporfs(uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZPORFS
Definition zporfs.f:183
subroutine zpotrf(uplo, n, a, lda, info)
ZPOTRF
Definition zpotrf.f:107
subroutine zpotri(uplo, n, a, lda, info)
ZPOTRI
Definition zpotri.f:95
subroutine zpotrs(uplo, n, nrhs, a, lda, b, ldb, info)
ZPOTRS
Definition zpotrs.f:110
subroutine zerrpo(path, nunit)
ZERRPO
Definition zerrpo.f:55
subroutine zget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
ZGET04
Definition zget04.f:102
subroutine zlaipd(n, a, inda, vinda)
ZLAIPD
Definition zlaipd.f:83
subroutine zlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
ZLATB4
Definition zlatb4.f:121
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS
Definition zlatms.f:332
subroutine zpot01(uplo, n, a, lda, afac, ldafac, rwork, resid)
ZPOT01
Definition zpot01.f:106
subroutine zpot02(uplo, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
ZPOT02
Definition zpot02.f:127
subroutine zpot03(uplo, n, a, lda, ainv, ldainv, work, ldwork, rwork, rcond, resid)
ZPOT03
Definition zpot03.f:126
subroutine zpot05(uplo, n, nrhs, a, lda, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
ZPOT05
Definition zpot05.f:165
Here is the call graph for this function:
Here is the caller graph for this function: