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