1*> \brief \b CDRVHE_ROOK
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE CDRVHE_ROOK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
12*                               NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK,
13*                               IWORK, NOUT )
14*
15*       .. Scalar Arguments ..
16*       LOGICAL            TSTERR
17*       INTEGER            NMAX, NN, NOUT, NRHS
18*       REAL               THRESH
19*       ..
20*       .. Array Arguments ..
21*       LOGICAL            DOTYPE( * )
22*       INTEGER            IWORK( * ), NVAL( * )
23*       REAL               RWORK( * )
24*       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
25*      $                   WORK( * ), X( * ), XACT( * )
26*       ..
27*
28*
29*> \par Purpose:
30*  =============
31*>
32*> \verbatim
33*>
34*> CDRVHE_ROOK tests the driver routines CHESV_ROOK.
35*> \endverbatim
36*
37*  Arguments:
38*  ==========
39*
40*> \param[in] DOTYPE
41*> \verbatim
42*>          DOTYPE is LOGICAL array, dimension (NTYPES)
43*>          The matrix types to be used for testing.  Matrices of type j
44*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
45*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
46*> \endverbatim
47*>
48*> \param[in] NN
49*> \verbatim
50*>          NN is INTEGER
51*>          The number of values of N contained in the vector NVAL.
52*> \endverbatim
53*>
54*> \param[in] NVAL
55*> \verbatim
56*>          NVAL is INTEGER array, dimension (NN)
57*>          The values of the matrix dimension N.
58*> \endverbatim
59*>
60*> \param[in] NRHS
61*> \verbatim
62*>          NRHS is INTEGER
63*>          The number of right hand side vectors to be generated for
64*>          each linear system.
65*> \endverbatim
66*>
67*> \param[in] THRESH
68*> \verbatim
69*>          THRESH is REAL
70*>          The threshold value for the test ratios.  A result is
71*>          included in the output file if RESULT >= THRESH.  To have
72*>          every test ratio printed, use THRESH = 0.
73*> \endverbatim
74*>
75*> \param[in] TSTERR
76*> \verbatim
77*>          TSTERR is LOGICAL
78*>          Flag that indicates whether error exits are to be tested.
79*> \endverbatim
80*>
81*> \param[in] NMAX
82*> \verbatim
83*>          NMAX is INTEGER
84*>          The maximum value permitted for N, used in dimensioning the
85*>          work arrays.
86*> \endverbatim
87*>
88*> \param[out] A
89*> \verbatim
90*>          A is COMPLEX array, dimension (NMAX*NMAX)
91*> \endverbatim
92*>
93*> \param[out] AFAC
94*> \verbatim
95*>          AFAC is COMPLEX array, dimension (NMAX*NMAX)
96*> \endverbatim
97*>
98*> \param[out] AINV
99*> \verbatim
100*>          AINV is COMPLEX array, dimension (NMAX*NMAX)
101*> \endverbatim
102*>
103*> \param[out] B
104*> \verbatim
105*>          B is COMPLEX array, dimension (NMAX*NRHS)
106*> \endverbatim
107*>
108*> \param[out] X
109*> \verbatim
110*>          X is COMPLEX array, dimension (NMAX*NRHS)
111*> \endverbatim
112*>
113*> \param[out] XACT
114*> \verbatim
115*>          XACT is COMPLEX array, dimension (NMAX*NRHS)
116*> \endverbatim
117*>
118*> \param[out] WORK
119*> \verbatim
120*>          WORK is COMPLEX array, dimension (NMAX*max(2,NRHS))
121*> \endverbatim
122*>
123*> \param[out] RWORK
124*> \verbatim
125*>          RWORK is REAL array, dimension (NMAX+2*NRHS)
126*> \endverbatim
127*>
128*> \param[out] IWORK
129*> \verbatim
130*>          IWORK is INTEGER array, dimension (NMAX)
131*> \endverbatim
132*>
133*> \param[in] NOUT
134*> \verbatim
135*>          NOUT is INTEGER
136*>          The unit number for output.
137*> \endverbatim
138*
139*  Authors:
140*  ========
141*
142*> \author Univ. of Tennessee
143*> \author Univ. of California Berkeley
144*> \author Univ. of Colorado Denver
145*> \author NAG Ltd.
146*
147*> \ingroup complex_lin
148*
149*  =====================================================================
150      SUBROUTINE CDRVHE_ROOK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
151     $                        NMAX, A, AFAC, AINV, B, X, XACT, WORK,
152     $                        RWORK, IWORK, NOUT )
153*
154*  -- LAPACK test routine --
155*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
156*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
157*
158*     .. Scalar Arguments ..
159      LOGICAL            TSTERR
160      INTEGER            NMAX, NN, NOUT, NRHS
161      REAL               THRESH
162*     ..
163*     .. Array Arguments ..
164      LOGICAL            DOTYPE( * )
165      INTEGER            IWORK( * ), NVAL( * )
166      REAL               RWORK( * )
167      COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
168     $                   WORK( * ), X( * ), XACT( * )
169*     ..
170*
171*  =====================================================================
172*
173*     .. Parameters ..
174      REAL               ONE, ZERO
175      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
176      INTEGER            NTYPES, NTESTS
177      PARAMETER          ( NTYPES = 10, NTESTS = 3 )
178      INTEGER            NFACT
179      PARAMETER          ( NFACT = 2 )
180*     ..
181*     .. Local Scalars ..
182      LOGICAL            ZEROT
183      CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
184      CHARACTER*3        MATPATH, PATH
185      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
186     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
187     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
188      REAL               AINVNM, ANORM, CNDNUM, RCONDC
189*     ..
190*     .. Local Arrays ..
191      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
192      INTEGER            ISEED( 4 ), ISEEDY( 4 )
193      REAL               RESULT( NTESTS )
194
195*     ..
196*     .. External Functions ..
197      REAL               CLANHE
198      EXTERNAL           CLANHE
199*     ..
200*     .. External Subroutines ..
201      EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, CERRVX,
202     $                   CGET04, CLACPY, CLARHS, CLATB4, CLATMS,
203     $                   CHESV_ROOK, CHET01_ROOK, CPOT02,
204     $                   CHETRF_ROOK, CHETRI_ROOK
205*     ..
206*     .. Scalars in Common ..
207      LOGICAL            LERR, OK
208      CHARACTER*32       SRNAMT
209      INTEGER            INFOT, NUNIT
210*     ..
211*     .. Common blocks ..
212      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
213      COMMON             / SRNAMC / SRNAMT
214*     ..
215*     .. Intrinsic Functions ..
216      INTRINSIC          MAX, MIN
217*     ..
218*     .. Data statements ..
219      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
220      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
221*     ..
222*     .. Executable Statements ..
223*
224*     Initialize constants and the random number seed.
225*
226*     Test path
227*
228      PATH( 1: 1 ) = 'Complex precision'
229      PATH( 2: 3 ) = 'HR'
230*
231*     Path to generate matrices
232*
233      MATPATH( 1: 1 ) = 'Complex precision'
234      MATPATH( 2: 3 ) = 'HE'
235*
236      NRUN = 0
237      NFAIL = 0
238      NERRS = 0
239      DO 10 I = 1, 4
240         ISEED( I ) = ISEEDY( I )
241   10 CONTINUE
242      LWORK = MAX( 2*NMAX, NMAX*NRHS )
243*
244*     Test the error exits
245*
246      IF( TSTERR )
247     $   CALL CERRVX( PATH, NOUT )
248      INFOT = 0
249*
250*     Set the block size and minimum block size for which the block
251*     routine should be used, which will be later returned by ILAENV.
252*
253      NB = 1
254      NBMIN = 2
255      CALL XLAENV( 1, NB )
256      CALL XLAENV( 2, NBMIN )
257*
258*     Do for each value of N in NVAL
259*
260      DO 180 IN = 1, NN
261         N = NVAL( IN )
262         LDA = MAX( N, 1 )
263         XTYPE = 'N'
264         NIMAT = NTYPES
265         IF( N.LE.0 )
266     $      NIMAT = 1
267*
268         DO 170 IMAT = 1, NIMAT
269*
270*           Do the tests only if DOTYPE( IMAT ) is true.
271*
272            IF( .NOT.DOTYPE( IMAT ) )
273     $         GO TO 170
274*
275*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
276*
277            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
278            IF( ZEROT .AND. N.LT.IMAT-2 )
279     $         GO TO 170
280*
281*           Do first for UPLO = 'U', then for UPLO = 'L'
282*
283            DO 160 IUPLO = 1, 2
284               UPLO = UPLOS( IUPLO )
285*
286*                 Begin generate the test matrix A.
287*
288*                 Set up parameters with CLATB4 for the matrix generator
289*                 based on the type of matrix to be generated.
290*
291                  CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
292     $                         MODE, CNDNUM, DIST )
293*
294*                 Generate a matrix with CLATMS.
295*
296                  SRNAMT = 'CLATMS'
297                  CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
298     $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
299     $                         WORK, INFO )
300*
301*                 Check error code from CLATMS and handle error.
302*
303                  IF( INFO.NE.0 ) THEN
304                     CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
305     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
306                     GO TO 160
307                  END IF
308*
309*                 For types 3-6, zero one or more rows and columns of
310*                 the matrix to test that INFO is returned correctly.
311*
312                  IF( ZEROT ) THEN
313                     IF( IMAT.EQ.3 ) THEN
314                        IZERO = 1
315                     ELSE IF( IMAT.EQ.4 ) THEN
316                        IZERO = N
317                     ELSE
318                        IZERO = N / 2 + 1
319                     END IF
320*
321                     IF( IMAT.LT.6 ) THEN
322*
323*                       Set row and column IZERO to zero.
324*
325                        IF( IUPLO.EQ.1 ) THEN
326                           IOFF = ( IZERO-1 )*LDA
327                           DO 20 I = 1, IZERO - 1
328                              A( IOFF+I ) = ZERO
329   20                      CONTINUE
330                           IOFF = IOFF + IZERO
331                           DO 30 I = IZERO, N
332                              A( IOFF ) = ZERO
333                              IOFF = IOFF + LDA
334   30                      CONTINUE
335                        ELSE
336                           IOFF = IZERO
337                           DO 40 I = 1, IZERO - 1
338                              A( IOFF ) = ZERO
339                              IOFF = IOFF + LDA
340   40                      CONTINUE
341                           IOFF = IOFF - IZERO
342                           DO 50 I = IZERO, N
343                              A( IOFF+I ) = ZERO
344   50                      CONTINUE
345                        END IF
346                     ELSE
347                        IF( IUPLO.EQ.1 ) THEN
348*
349*                       Set the first IZERO rows and columns to zero.
350*
351                           IOFF = 0
352                           DO 70 J = 1, N
353                              I2 = MIN( J, IZERO )
354                              DO 60 I = 1, I2
355                                 A( IOFF+I ) = ZERO
356   60                         CONTINUE
357                              IOFF = IOFF + LDA
358   70                      CONTINUE
359                        ELSE
360*
361*                       Set the first IZERO rows and columns to zero.
362*
363                           IOFF = 0
364                           DO 90 J = 1, N
365                              I1 = MAX( J, IZERO )
366                              DO 80 I = I1, N
367                                 A( IOFF+I ) = ZERO
368   80                         CONTINUE
369                              IOFF = IOFF + LDA
370   90                      CONTINUE
371                        END IF
372                     END IF
373                  ELSE
374                     IZERO = 0
375                  END IF
376*
377*                 End generate the test matrix A.
378*
379*
380               DO 150 IFACT = 1, NFACT
381*
382*                 Do first for FACT = 'F', then for other values.
383*
384                  FACT = FACTS( IFACT )
385*
386*                 Compute the condition number for comparison with
387*                 the value returned by CHESVX_ROOK.
388*
389                  IF( ZEROT ) THEN
390                     IF( IFACT.EQ.1 )
391     $                  GO TO 150
392                     RCONDC = ZERO
393*
394                  ELSE IF( IFACT.EQ.1 ) THEN
395*
396*                    Compute the 1-norm of A.
397*
398                     ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
399*
400*                    Factor the matrix A.
401*
402                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
403                     CALL CHETRF_ROOK( UPLO, N, AFAC, LDA, IWORK, WORK,
404     $                                 LWORK, INFO )
405*
406*                    Compute inv(A) and take its norm.
407*
408                     CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
409                     LWORK = (N+NB+1)*(NB+3)
410                     CALL CHETRI_ROOK( UPLO, N, AINV, LDA, IWORK,
411     $                                 WORK, INFO )
412                     AINVNM = CLANHE( '1', UPLO, N, AINV, LDA, RWORK )
413*
414*                    Compute the 1-norm condition number of A.
415*
416                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
417                        RCONDC = ONE
418                     ELSE
419                        RCONDC = ( ONE / ANORM ) / AINVNM
420                     END IF
421                  END IF
422*
423*                 Form an exact solution and set the right hand side.
424*
425                  SRNAMT = 'CLARHS'
426                  CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
427     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
428     $                         INFO )
429                  XTYPE = 'C'
430*
431*                 --- Test CHESV_ROOK  ---
432*
433                  IF( IFACT.EQ.2 ) THEN
434                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
435                     CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
436*
437*                    Factor the matrix and solve the system using
438*                    CHESV_ROOK.
439*
440                     SRNAMT = 'CHESV_ROOK'
441                     CALL CHESV_ROOK( UPLO, N, NRHS, AFAC, LDA, IWORK,
442     $                                X, LDA, WORK, LWORK, INFO )
443*
444*                    Adjust the expected value of INFO to account for
445*                    pivoting.
446*
447                     K = IZERO
448                     IF( K.GT.0 ) THEN
449  100                   CONTINUE
450                        IF( IWORK( K ).LT.0 ) THEN
451                           IF( IWORK( K ).NE.-K ) THEN
452                              K = -IWORK( K )
453                              GO TO 100
454                           END IF
455                        ELSE IF( IWORK( K ).NE.K ) THEN
456                           K = IWORK( K )
457                           GO TO 100
458                        END IF
459                     END IF
460*
461*                    Check error code from CHESV_ROOK and handle error.
462*
463                     IF( INFO.NE.K ) THEN
464                        CALL ALAERH( PATH, 'CHESV_ROOK', INFO, K, UPLO,
465     $                               N, N, -1, -1, NRHS, IMAT, NFAIL,
466     $                               NERRS, NOUT )
467                        GO TO 120
468                     ELSE IF( INFO.NE.0 ) THEN
469                        GO TO 120
470                     END IF
471*
472*+    TEST 1      Reconstruct matrix from factors and compute
473*                 residual.
474*
475                     CALL CHET01_ROOK( UPLO, N, A, LDA, AFAC, LDA,
476     $                                 IWORK, AINV, LDA, RWORK,
477     $                                 RESULT( 1 ) )
478*
479*+    TEST 2      Compute residual of the computed solution.
480*
481                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
482                     CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
483     $                            LDA, RWORK, RESULT( 2 ) )
484*
485*+    TEST 3
486*                 Check solution from generated exact solution.
487*
488                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
489     $                            RESULT( 3 ) )
490                     NT = 3
491*
492*                    Print information about the tests that did not pass
493*                    the threshold.
494*
495                     DO 110 K = 1, NT
496                        IF( RESULT( K ).GE.THRESH ) THEN
497                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
498     $                        CALL ALADHD( NOUT, PATH )
499                           WRITE( NOUT, FMT = 9999 )'CHESV_ROOK', UPLO,
500     $                            N, IMAT, K, RESULT( K )
501                           NFAIL = NFAIL + 1
502                        END IF
503  110                CONTINUE
504                     NRUN = NRUN + NT
505  120                CONTINUE
506                  END IF
507*
508  150          CONTINUE
509*
510  160       CONTINUE
511  170    CONTINUE
512  180 CONTINUE
513*
514*     Print a summary of the results.
515*
516      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
517*
518 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
519     $      ', test ', I2, ', ratio =', G12.5 )
520      RETURN
521*
522*     End of CDRVHE_ROOK
523*
524      END
525