1 SUBROUTINE ZCHKPS( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL,
2 $ THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK,
3 $ RWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.2.1) --
6 * Craig Lucas, University of Manchester / NAG Ltd.
7 * -- April 2009
8 *
9 * .. Scalar Arguments ..
10 DOUBLE PRECISION THRESH
11 INTEGER NMAX, NN, NNB, NOUT, NRANK
12 LOGICAL TSTERR
13 * ..
14 * .. Array Arguments ..
15 COMPLEX*16 A( * ), AFAC( * ), PERM( * ), WORK( * )
16 DOUBLE PRECISION RWORK( * )
17 INTEGER NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
18 LOGICAL DOTYPE( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZCHKPS tests ZPSTRF.
25 *
26 * Arguments
27 * =========
28 *
29 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
30 * The matrix types to be used for testing. Matrices of type j
31 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
32 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
33 *
34 * NN (input) INTEGER
35 * The number of values of N contained in the vector NVAL.
36 *
37 * NVAL (input) INTEGER array, dimension (NN)
38 * The values of the matrix dimension N.
39 *
40 * NNB (input) INTEGER
41 * The number of values of NB contained in the vector NBVAL.
42 *
43 * NBVAL (input) INTEGER array, dimension (NBVAL)
44 * The values of the block size NB.
45 *
46 * NRANK (input) INTEGER
47 * The number of values of RANK contained in the vector RANKVAL.
48 *
49 * RANKVAL (input) INTEGER array, dimension (NBVAL)
50 * The values of the block size NB.
51 *
52 * THRESH (input) DOUBLE PRECISION
53 * The threshold value for the test ratios. A result is
54 * included in the output file if RESULT >= THRESH. To have
55 * every test ratio printed, use THRESH = 0.
56 *
57 * TSTERR (input) LOGICAL
58 * Flag that indicates whether error exits are to be tested.
59 *
60 * NMAX (input) INTEGER
61 * The maximum value permitted for N, used in dimensioning the
62 * work arrays.
63 *
64 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
65 *
66 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
67 *
68 * PERM (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
69 *
70 * PIV (workspace) INTEGER array, dimension (NMAX)
71 *
72 * WORK (workspace) COMPLEX*16 array, dimension (NMAX*3)
73 *
74 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX)
75 *
76 * NOUT (input) INTEGER
77 * The unit number for output.
78 *
79 * =====================================================================
80 *
81 * .. Parameters ..
82 DOUBLE PRECISION ONE
83 PARAMETER ( ONE = 1.0E+0 )
84 INTEGER NTYPES
85 PARAMETER ( NTYPES = 9 )
86 * ..
87 * .. Local Scalars ..
88 DOUBLE PRECISION ANORM, CNDNUM, RESULT, TOL
89 INTEGER COMPRANK, I, IMAT, IN, INB, INFO, IRANK, IUPLO,
90 $ IZERO, KL, KU, LDA, MODE, N, NB, NERRS, NFAIL,
91 $ NIMAT, NRUN, RANK, RANKDIFF
92 CHARACTER DIST, TYPE, UPLO
93 CHARACTER*3 PATH
94 * ..
95 * .. Local Arrays ..
96 INTEGER ISEED( 4 ), ISEEDY( 4 )
97 CHARACTER UPLOS( 2 )
98 * ..
99 * .. External Subroutines ..
100 EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRPS, ZLACPY,
101 $ ZLATB5, ZLATMT, ZPST01, ZPSTRF
102 * ..
103 * .. Scalars in Common ..
104 INTEGER INFOT, NUNIT
105 LOGICAL LERR, OK
106 CHARACTER*32 SRNAMT
107 * ..
108 * .. Common blocks ..
109 COMMON / INFOC / INFOT, NUNIT, OK, LERR
110 COMMON / SRNAMC / SRNAMT
111 * ..
112 * .. Intrinsic Functions ..
113 INTRINSIC DBLE, MAX, CEILING
114 * ..
115 * .. Data statements ..
116 DATA ISEEDY / 1988, 1989, 1990, 1991 /
117 DATA UPLOS / 'U', 'L' /
118 * ..
119 * .. Executable Statements ..
120 *
121 * Initialize constants and the random number seed.
122 *
123 PATH( 1: 1 ) = 'Zomplex Precision'
124 PATH( 2: 3 ) = 'PS'
125 NRUN = 0
126 NFAIL = 0
127 NERRS = 0
128 DO 100 I = 1, 4
129 ISEED( I ) = ISEEDY( I )
130 100 CONTINUE
131 *
132 * Test the error exits
133 *
134 IF( TSTERR )
135 $ CALL ZERRPS( PATH, NOUT )
136 INFOT = 0
137 *
138 * Do for each value of N in NVAL
139 *
140 DO 150 IN = 1, NN
141 N = NVAL( IN )
142 LDA = MAX( N, 1 )
143 NIMAT = NTYPES
144 IF( N.LE.0 )
145 $ NIMAT = 1
146 *
147 IZERO = 0
148 DO 140 IMAT = 1, NIMAT
149 *
150 * Do the tests only if DOTYPE( IMAT ) is true.
151 *
152 IF( .NOT.DOTYPE( IMAT ) )
153 $ GO TO 140
154 *
155 * Do for each value of RANK in RANKVAL
156 *
157 DO 130 IRANK = 1, NRANK
158 *
159 * Only repeat test 3 to 5 for different ranks
160 * Other tests use full rank
161 *
162 IF( ( IMAT.LT.3 .OR. IMAT.GT.5 ) .AND. IRANK.GT.1 )
163 $ GO TO 130
164 *
165 RANK = CEILING( ( N * DBLE( RANKVAL( IRANK ) ) )
166 $ / 100.E+0 )
167 *
168 *
169 * Do first for UPLO = 'U', then for UPLO = 'L'
170 *
171 DO 120 IUPLO = 1, 2
172 UPLO = UPLOS( IUPLO )
173 *
174 * Set up parameters with ZLATB5 and generate a test matrix
175 * with ZLATMT.
176 *
177 CALL ZLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM,
178 $ MODE, CNDNUM, DIST )
179 *
180 SRNAMT = 'ZLATMT'
181 CALL ZLATMT( N, N, DIST, ISEED, TYPE, RWORK, MODE,
182 $ CNDNUM, ANORM, RANK, KL, KU, UPLO, A,
183 $ LDA, WORK, INFO )
184 *
185 * Check error code from ZLATMT.
186 *
187 IF( INFO.NE.0 ) THEN
188 CALL ALAERH( PATH, 'ZLATMT', INFO, 0, UPLO, N,
189 $ N, -1, -1, -1, IMAT, NFAIL, NERRS,
190 $ NOUT )
191 GO TO 120
192 END IF
193 *
194 * Do for each value of NB in NBVAL
195 *
196 DO 110 INB = 1, NNB
197 NB = NBVAL( INB )
198 CALL XLAENV( 1, NB )
199 *
200 * Compute the pivoted L*L' or U'*U factorization
201 * of the matrix.
202 *
203 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
204 SRNAMT = 'ZPSTRF'
205 *
206 * Use default tolerance
207 *
208 TOL = -ONE
209 CALL ZPSTRF( UPLO, N, AFAC, LDA, PIV, COMPRANK,
210 $ TOL, RWORK, INFO )
211 *
212 * Check error code from ZPSTRF.
213 *
214 IF( (INFO.LT.IZERO)
215 $ .OR.(INFO.NE.IZERO.AND.RANK.EQ.N)
216 $ .OR.(INFO.LE.IZERO.AND.RANK.LT.N) ) THEN
217 CALL ALAERH( PATH, 'ZPSTRF', INFO, IZERO,
218 $ UPLO, N, N, -1, -1, NB, IMAT,
219 $ NFAIL, NERRS, NOUT )
220 GO TO 110
221 END IF
222 *
223 * Skip the test if INFO is not 0.
224 *
225 IF( INFO.NE.0 )
226 $ GO TO 110
227 *
228 * Reconstruct matrix from factors and compute residual.
229 *
230 * PERM holds permuted L*L^T or U^T*U
231 *
232 CALL ZPST01( UPLO, N, A, LDA, AFAC, LDA, PERM, LDA,
233 $ PIV, RWORK, RESULT, COMPRANK )
234 *
235 * Print information about the tests that did not pass
236 * the threshold or where computed rank was not RANK.
237 *
238 IF( N.EQ.0 )
239 $ COMPRANK = 0
240 RANKDIFF = RANK - COMPRANK
241 IF( RESULT.GE.THRESH ) THEN
242 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
243 $ CALL ALAHD( NOUT, PATH )
244 WRITE( NOUT, FMT = 9999 )UPLO, N, RANK,
245 $ RANKDIFF, NB, IMAT, RESULT
246 NFAIL = NFAIL + 1
247 END IF
248 NRUN = NRUN + 1
249 110 CONTINUE
250 *
251 120 CONTINUE
252 130 CONTINUE
253 140 CONTINUE
254 150 CONTINUE
255 *
256 * Print a summary of the results.
257 *
258 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
259 *
260 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', RANK =', I3,
261 $ ', Diff =', I5, ', NB =', I4, ', type ', I2, ', Ratio =',
262 $ G12.5 )
263 RETURN
264 *
265 * End of ZCHKPS
266 *
267 END
2 $ THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK,
3 $ RWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.2.1) --
6 * Craig Lucas, University of Manchester / NAG Ltd.
7 * -- April 2009
8 *
9 * .. Scalar Arguments ..
10 DOUBLE PRECISION THRESH
11 INTEGER NMAX, NN, NNB, NOUT, NRANK
12 LOGICAL TSTERR
13 * ..
14 * .. Array Arguments ..
15 COMPLEX*16 A( * ), AFAC( * ), PERM( * ), WORK( * )
16 DOUBLE PRECISION RWORK( * )
17 INTEGER NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
18 LOGICAL DOTYPE( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZCHKPS tests ZPSTRF.
25 *
26 * Arguments
27 * =========
28 *
29 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
30 * The matrix types to be used for testing. Matrices of type j
31 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
32 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
33 *
34 * NN (input) INTEGER
35 * The number of values of N contained in the vector NVAL.
36 *
37 * NVAL (input) INTEGER array, dimension (NN)
38 * The values of the matrix dimension N.
39 *
40 * NNB (input) INTEGER
41 * The number of values of NB contained in the vector NBVAL.
42 *
43 * NBVAL (input) INTEGER array, dimension (NBVAL)
44 * The values of the block size NB.
45 *
46 * NRANK (input) INTEGER
47 * The number of values of RANK contained in the vector RANKVAL.
48 *
49 * RANKVAL (input) INTEGER array, dimension (NBVAL)
50 * The values of the block size NB.
51 *
52 * THRESH (input) DOUBLE PRECISION
53 * The threshold value for the test ratios. A result is
54 * included in the output file if RESULT >= THRESH. To have
55 * every test ratio printed, use THRESH = 0.
56 *
57 * TSTERR (input) LOGICAL
58 * Flag that indicates whether error exits are to be tested.
59 *
60 * NMAX (input) INTEGER
61 * The maximum value permitted for N, used in dimensioning the
62 * work arrays.
63 *
64 * A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
65 *
66 * AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
67 *
68 * PERM (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
69 *
70 * PIV (workspace) INTEGER array, dimension (NMAX)
71 *
72 * WORK (workspace) COMPLEX*16 array, dimension (NMAX*3)
73 *
74 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX)
75 *
76 * NOUT (input) INTEGER
77 * The unit number for output.
78 *
79 * =====================================================================
80 *
81 * .. Parameters ..
82 DOUBLE PRECISION ONE
83 PARAMETER ( ONE = 1.0E+0 )
84 INTEGER NTYPES
85 PARAMETER ( NTYPES = 9 )
86 * ..
87 * .. Local Scalars ..
88 DOUBLE PRECISION ANORM, CNDNUM, RESULT, TOL
89 INTEGER COMPRANK, I, IMAT, IN, INB, INFO, IRANK, IUPLO,
90 $ IZERO, KL, KU, LDA, MODE, N, NB, NERRS, NFAIL,
91 $ NIMAT, NRUN, RANK, RANKDIFF
92 CHARACTER DIST, TYPE, UPLO
93 CHARACTER*3 PATH
94 * ..
95 * .. Local Arrays ..
96 INTEGER ISEED( 4 ), ISEEDY( 4 )
97 CHARACTER UPLOS( 2 )
98 * ..
99 * .. External Subroutines ..
100 EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRPS, ZLACPY,
101 $ ZLATB5, ZLATMT, ZPST01, ZPSTRF
102 * ..
103 * .. Scalars in Common ..
104 INTEGER INFOT, NUNIT
105 LOGICAL LERR, OK
106 CHARACTER*32 SRNAMT
107 * ..
108 * .. Common blocks ..
109 COMMON / INFOC / INFOT, NUNIT, OK, LERR
110 COMMON / SRNAMC / SRNAMT
111 * ..
112 * .. Intrinsic Functions ..
113 INTRINSIC DBLE, MAX, CEILING
114 * ..
115 * .. Data statements ..
116 DATA ISEEDY / 1988, 1989, 1990, 1991 /
117 DATA UPLOS / 'U', 'L' /
118 * ..
119 * .. Executable Statements ..
120 *
121 * Initialize constants and the random number seed.
122 *
123 PATH( 1: 1 ) = 'Zomplex Precision'
124 PATH( 2: 3 ) = 'PS'
125 NRUN = 0
126 NFAIL = 0
127 NERRS = 0
128 DO 100 I = 1, 4
129 ISEED( I ) = ISEEDY( I )
130 100 CONTINUE
131 *
132 * Test the error exits
133 *
134 IF( TSTERR )
135 $ CALL ZERRPS( PATH, NOUT )
136 INFOT = 0
137 *
138 * Do for each value of N in NVAL
139 *
140 DO 150 IN = 1, NN
141 N = NVAL( IN )
142 LDA = MAX( N, 1 )
143 NIMAT = NTYPES
144 IF( N.LE.0 )
145 $ NIMAT = 1
146 *
147 IZERO = 0
148 DO 140 IMAT = 1, NIMAT
149 *
150 * Do the tests only if DOTYPE( IMAT ) is true.
151 *
152 IF( .NOT.DOTYPE( IMAT ) )
153 $ GO TO 140
154 *
155 * Do for each value of RANK in RANKVAL
156 *
157 DO 130 IRANK = 1, NRANK
158 *
159 * Only repeat test 3 to 5 for different ranks
160 * Other tests use full rank
161 *
162 IF( ( IMAT.LT.3 .OR. IMAT.GT.5 ) .AND. IRANK.GT.1 )
163 $ GO TO 130
164 *
165 RANK = CEILING( ( N * DBLE( RANKVAL( IRANK ) ) )
166 $ / 100.E+0 )
167 *
168 *
169 * Do first for UPLO = 'U', then for UPLO = 'L'
170 *
171 DO 120 IUPLO = 1, 2
172 UPLO = UPLOS( IUPLO )
173 *
174 * Set up parameters with ZLATB5 and generate a test matrix
175 * with ZLATMT.
176 *
177 CALL ZLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM,
178 $ MODE, CNDNUM, DIST )
179 *
180 SRNAMT = 'ZLATMT'
181 CALL ZLATMT( N, N, DIST, ISEED, TYPE, RWORK, MODE,
182 $ CNDNUM, ANORM, RANK, KL, KU, UPLO, A,
183 $ LDA, WORK, INFO )
184 *
185 * Check error code from ZLATMT.
186 *
187 IF( INFO.NE.0 ) THEN
188 CALL ALAERH( PATH, 'ZLATMT', INFO, 0, UPLO, N,
189 $ N, -1, -1, -1, IMAT, NFAIL, NERRS,
190 $ NOUT )
191 GO TO 120
192 END IF
193 *
194 * Do for each value of NB in NBVAL
195 *
196 DO 110 INB = 1, NNB
197 NB = NBVAL( INB )
198 CALL XLAENV( 1, NB )
199 *
200 * Compute the pivoted L*L' or U'*U factorization
201 * of the matrix.
202 *
203 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
204 SRNAMT = 'ZPSTRF'
205 *
206 * Use default tolerance
207 *
208 TOL = -ONE
209 CALL ZPSTRF( UPLO, N, AFAC, LDA, PIV, COMPRANK,
210 $ TOL, RWORK, INFO )
211 *
212 * Check error code from ZPSTRF.
213 *
214 IF( (INFO.LT.IZERO)
215 $ .OR.(INFO.NE.IZERO.AND.RANK.EQ.N)
216 $ .OR.(INFO.LE.IZERO.AND.RANK.LT.N) ) THEN
217 CALL ALAERH( PATH, 'ZPSTRF', INFO, IZERO,
218 $ UPLO, N, N, -1, -1, NB, IMAT,
219 $ NFAIL, NERRS, NOUT )
220 GO TO 110
221 END IF
222 *
223 * Skip the test if INFO is not 0.
224 *
225 IF( INFO.NE.0 )
226 $ GO TO 110
227 *
228 * Reconstruct matrix from factors and compute residual.
229 *
230 * PERM holds permuted L*L^T or U^T*U
231 *
232 CALL ZPST01( UPLO, N, A, LDA, AFAC, LDA, PERM, LDA,
233 $ PIV, RWORK, RESULT, COMPRANK )
234 *
235 * Print information about the tests that did not pass
236 * the threshold or where computed rank was not RANK.
237 *
238 IF( N.EQ.0 )
239 $ COMPRANK = 0
240 RANKDIFF = RANK - COMPRANK
241 IF( RESULT.GE.THRESH ) THEN
242 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
243 $ CALL ALAHD( NOUT, PATH )
244 WRITE( NOUT, FMT = 9999 )UPLO, N, RANK,
245 $ RANKDIFF, NB, IMAT, RESULT
246 NFAIL = NFAIL + 1
247 END IF
248 NRUN = NRUN + 1
249 110 CONTINUE
250 *
251 120 CONTINUE
252 130 CONTINUE
253 140 CONTINUE
254 150 CONTINUE
255 *
256 * Print a summary of the results.
257 *
258 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
259 *
260 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', RANK =', I3,
261 $ ', Diff =', I5, ', NB =', I4, ', type ', I2, ', Ratio =',
262 $ G12.5 )
263 RETURN
264 *
265 * End of ZCHKPS
266 *
267 END