LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
schktr.f
Go to the documentation of this file.
1 *> \brief \b SCHKTR
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 SCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
12 * THRESH, TSTERR, NMAX, A, AINV, B, X, XACT,
13 * WORK, RWORK, IWORK, NOUT )
14 *
15 * .. Scalar Arguments ..
16 * LOGICAL TSTERR
17 * INTEGER NMAX, NN, NNB, NNS, NOUT
18 * REAL THRESH
19 * ..
20 * .. Array Arguments ..
21 * LOGICAL DOTYPE( * )
22 * INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
23 * REAL A( * ), AINV( * ), B( * ), RWORK( * ),
24 * $ WORK( * ), X( * ), XACT( * )
25 * ..
26 *
27 *
28 *> \par Purpose:
29 * =============
30 *>
31 *> \verbatim
32 *>
33 *> SCHKTR tests STRTRI, -TRS, -RFS, and -CON, and SLATRS
34 *> \endverbatim
35 *
36 * Arguments:
37 * ==========
38 *
39 *> \param[in] DOTYPE
40 *> \verbatim
41 *> DOTYPE is LOGICAL array, dimension (NTYPES)
42 *> The matrix types to be used for testing. Matrices of type j
43 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
44 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
45 *> \endverbatim
46 *>
47 *> \param[in] NN
48 *> \verbatim
49 *> NN is INTEGER
50 *> The number of values of N contained in the vector NVAL.
51 *> \endverbatim
52 *>
53 *> \param[in] NVAL
54 *> \verbatim
55 *> NVAL is INTEGER array, dimension (NN)
56 *> The values of the matrix column dimension N.
57 *> \endverbatim
58 *>
59 *> \param[in] NNB
60 *> \verbatim
61 *> NNB is INTEGER
62 *> The number of values of NB contained in the vector NBVAL.
63 *> \endverbatim
64 *>
65 *> \param[in] NBVAL
66 *> \verbatim
67 *> NBVAL is INTEGER array, dimension (NNB)
68 *> The values of the blocksize NB.
69 *> \endverbatim
70 *>
71 *> \param[in] NNS
72 *> \verbatim
73 *> NNS is INTEGER
74 *> The number of values of NRHS contained in the vector NSVAL.
75 *> \endverbatim
76 *>
77 *> \param[in] NSVAL
78 *> \verbatim
79 *> NSVAL is INTEGER array, dimension (NNS)
80 *> The values of the number of right hand sides NRHS.
81 *> \endverbatim
82 *>
83 *> \param[in] THRESH
84 *> \verbatim
85 *> THRESH is REAL
86 *> The threshold value for the test ratios. A result is
87 *> included in the output file if RESULT >= THRESH. To have
88 *> every test ratio printed, use THRESH = 0.
89 *> \endverbatim
90 *>
91 *> \param[in] TSTERR
92 *> \verbatim
93 *> TSTERR is LOGICAL
94 *> Flag that indicates whether error exits are to be tested.
95 *> \endverbatim
96 *>
97 *> \param[in] NMAX
98 *> \verbatim
99 *> NMAX is INTEGER
100 *> The leading dimension of the work arrays.
101 *> NMAX >= the maximum value of N in NVAL.
102 *> \endverbatim
103 *>
104 *> \param[out] A
105 *> \verbatim
106 *> A is REAL array, dimension (NMAX*NMAX)
107 *> \endverbatim
108 *>
109 *> \param[out] AINV
110 *> \verbatim
111 *> AINV is REAL array, dimension (NMAX*NMAX)
112 *> \endverbatim
113 *>
114 *> \param[out] B
115 *> \verbatim
116 *> B is REAL array, dimension (NMAX*NSMAX)
117 *> where NSMAX is the largest entry in NSVAL.
118 *> \endverbatim
119 *>
120 *> \param[out] X
121 *> \verbatim
122 *> X is REAL array, dimension (NMAX*NSMAX)
123 *> \endverbatim
124 *>
125 *> \param[out] XACT
126 *> \verbatim
127 *> XACT is REAL array, dimension (NMAX*NSMAX)
128 *> \endverbatim
129 *>
130 *> \param[out] WORK
131 *> \verbatim
132 *> WORK is REAL array, dimension
133 *> (NMAX*max(3,NSMAX))
134 *> \endverbatim
135 *>
136 *> \param[out] RWORK
137 *> \verbatim
138 *> RWORK is REAL array, dimension
139 *> (max(NMAX,2*NSMAX))
140 *> \endverbatim
141 *>
142 *> \param[out] IWORK
143 *> \verbatim
144 *> IWORK is INTEGER array, dimension (NMAX)
145 *> \endverbatim
146 *>
147 *> \param[in] NOUT
148 *> \verbatim
149 *> NOUT is INTEGER
150 *> The unit number for output.
151 *> \endverbatim
152 *
153 * Authors:
154 * ========
155 *
156 *> \author Univ. of Tennessee
157 *> \author Univ. of California Berkeley
158 *> \author Univ. of Colorado Denver
159 *> \author NAG Ltd.
160 *
161 *> \date November 2011
162 *
163 *> \ingroup single_lin
164 *
165 * =====================================================================
166  SUBROUTINE schktr( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
167  $ thresh, tsterr, nmax, a, ainv, b, x, xact,
168  $ work, rwork, iwork, nout )
169 *
170 * -- LAPACK test routine (version 3.4.0) --
171 * -- LAPACK is a software package provided by Univ. of Tennessee, --
172 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
173 * November 2011
174 *
175 * .. Scalar Arguments ..
176  LOGICAL TSTERR
177  INTEGER NMAX, NN, NNB, NNS, NOUT
178  REAL THRESH
179 * ..
180 * .. Array Arguments ..
181  LOGICAL DOTYPE( * )
182  INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
183  REAL A( * ), AINV( * ), B( * ), RWORK( * ),
184  $ work( * ), x( * ), xact( * )
185 * ..
186 *
187 * =====================================================================
188 *
189 * .. Parameters ..
190  INTEGER NTYPE1, NTYPES
191  parameter ( ntype1 = 10, ntypes = 18 )
192  INTEGER NTESTS
193  parameter ( ntests = 9 )
194  INTEGER NTRAN
195  parameter ( ntran = 3 )
196  REAL ONE, ZERO
197  parameter ( one = 1.0e0, zero = 0.0e0 )
198 * ..
199 * .. Local Scalars ..
200  CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE
201  CHARACTER*3 PATH
202  INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
203  $ iuplo, k, lda, n, nb, nerrs, nfail, nrhs, nrun
204  REAL AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
205  $ rcondo, scale
206 * ..
207 * .. Local Arrays ..
208  CHARACTER TRANSS( ntran ), UPLOS( 2 )
209  INTEGER ISEED( 4 ), ISEEDY( 4 )
210  REAL RESULT( ntests )
211 * ..
212 * .. External Functions ..
213  LOGICAL LSAME
214  REAL SLANTR
215  EXTERNAL lsame, slantr
216 * ..
217 * .. External Subroutines ..
218  EXTERNAL alaerh, alahd, alasum, scopy, serrtr, sget04,
221  $ strtrs, xlaenv
222 * ..
223 * .. Scalars in Common ..
224  LOGICAL LERR, OK
225  CHARACTER*32 SRNAMT
226  INTEGER INFOT, IOUNIT
227 * ..
228 * .. Common blocks ..
229  COMMON / infoc / infot, iounit, ok, lerr
230  COMMON / srnamc / srnamt
231 * ..
232 * .. Intrinsic Functions ..
233  INTRINSIC max
234 * ..
235 * .. Data statements ..
236  DATA iseedy / 1988, 1989, 1990, 1991 /
237  DATA uplos / 'U', 'L' / , transs / 'N', 'T', 'C' /
238 * ..
239 * .. Executable Statements ..
240 *
241 * Initialize constants and the random number seed.
242 *
243  path( 1: 1 ) = 'Single precision'
244  path( 2: 3 ) = 'TR'
245  nrun = 0
246  nfail = 0
247  nerrs = 0
248  DO 10 i = 1, 4
249  iseed( i ) = iseedy( i )
250  10 CONTINUE
251 *
252 * Test the error exits
253 *
254  IF( tsterr )
255  $ CALL serrtr( path, nout )
256  infot = 0
257  CALL xlaenv( 2, 2 )
258 *
259  DO 120 in = 1, nn
260 *
261 * Do for each value of N in NVAL
262 *
263  n = nval( in )
264  lda = max( 1, n )
265  xtype = 'N'
266 *
267  DO 80 imat = 1, ntype1
268 *
269 * Do the tests only if DOTYPE( IMAT ) is true.
270 *
271  IF( .NOT.dotype( imat ) )
272  $ GO TO 80
273 *
274  DO 70 iuplo = 1, 2
275 *
276 * Do first for UPLO = 'U', then for UPLO = 'L'
277 *
278  uplo = uplos( iuplo )
279 *
280 * Call SLATTR to generate a triangular test matrix.
281 *
282  srnamt = 'SLATTR'
283  CALL slattr( imat, uplo, 'No transpose', diag, iseed, n,
284  $ a, lda, x, work, info )
285 *
286 * Set IDIAG = 1 for non-unit matrices, 2 for unit.
287 *
288  IF( lsame( diag, 'N' ) ) THEN
289  idiag = 1
290  ELSE
291  idiag = 2
292  END IF
293 *
294  DO 60 inb = 1, nnb
295 *
296 * Do for each blocksize in NBVAL
297 *
298  nb = nbval( inb )
299  CALL xlaenv( 1, nb )
300 *
301 *+ TEST 1
302 * Form the inverse of A.
303 *
304  CALL slacpy( uplo, n, n, a, lda, ainv, lda )
305  srnamt = 'STRTRI'
306  CALL strtri( uplo, diag, n, ainv, lda, info )
307 *
308 * Check error code from STRTRI.
309 *
310  IF( info.NE.0 )
311  $ CALL alaerh( path, 'STRTRI', info, 0, uplo // diag,
312  $ n, n, -1, -1, nb, imat, nfail, nerrs,
313  $ nout )
314 *
315 * Compute the infinity-norm condition number of A.
316 *
317  anorm = slantr( 'I', uplo, diag, n, n, a, lda, rwork )
318  ainvnm = slantr( 'I', uplo, diag, n, n, ainv, lda,
319  $ rwork )
320  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
321  rcondi = one
322  ELSE
323  rcondi = ( one / anorm ) / ainvnm
324  END IF
325 *
326 * Compute the residual for the triangular matrix times
327 * its inverse. Also compute the 1-norm condition number
328 * of A.
329 *
330  CALL strt01( uplo, diag, n, a, lda, ainv, lda, rcondo,
331  $ rwork, result( 1 ) )
332 *
333 * Print the test ratio if it is .GE. THRESH.
334 *
335  IF( result( 1 ).GE.thresh ) THEN
336  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
337  $ CALL alahd( nout, path )
338  WRITE( nout, fmt = 9999 )uplo, diag, n, nb, imat,
339  $ 1, result( 1 )
340  nfail = nfail + 1
341  END IF
342  nrun = nrun + 1
343 *
344 * Skip remaining tests if not the first block size.
345 *
346  IF( inb.NE.1 )
347  $ GO TO 60
348 *
349  DO 40 irhs = 1, nns
350  nrhs = nsval( irhs )
351  xtype = 'N'
352 *
353  DO 30 itran = 1, ntran
354 *
355 * Do for op(A) = A, A**T, or A**H.
356 *
357  trans = transs( itran )
358  IF( itran.EQ.1 ) THEN
359  norm = 'O'
360  rcondc = rcondo
361  ELSE
362  norm = 'I'
363  rcondc = rcondi
364  END IF
365 *
366 *+ TEST 2
367 * Solve and compute residual for op(A)*x = b.
368 *
369  srnamt = 'SLARHS'
370  CALL slarhs( path, xtype, uplo, trans, n, n, 0,
371  $ idiag, nrhs, a, lda, xact, lda, b,
372  $ lda, iseed, info )
373  xtype = 'C'
374  CALL slacpy( 'Full', n, nrhs, b, lda, x, lda )
375 *
376  srnamt = 'STRTRS'
377  CALL strtrs( uplo, trans, diag, n, nrhs, a, lda,
378  $ x, lda, info )
379 *
380 * Check error code from STRTRS.
381 *
382  IF( info.NE.0 )
383  $ CALL alaerh( path, 'STRTRS', info, 0,
384  $ uplo // trans // diag, n, n, -1,
385  $ -1, nrhs, imat, nfail, nerrs,
386  $ nout )
387 *
388 * This line is needed on a Sun SPARCstation.
389 *
390  IF( n.GT.0 )
391  $ dummy = a( 1 )
392 *
393  CALL strt02( uplo, trans, diag, n, nrhs, a, lda,
394  $ x, lda, b, lda, work, result( 2 ) )
395 *
396 *+ TEST 3
397 * Check solution from generated exact solution.
398 *
399  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
400  $ result( 3 ) )
401 *
402 *+ TESTS 4, 5, and 6
403 * Use iterative refinement to improve the solution
404 * and compute error bounds.
405 *
406  srnamt = 'STRRFS'
407  CALL strrfs( uplo, trans, diag, n, nrhs, a, lda,
408  $ b, lda, x, lda, rwork,
409  $ rwork( nrhs+1 ), work, iwork,
410  $ info )
411 *
412 * Check error code from STRRFS.
413 *
414  IF( info.NE.0 )
415  $ CALL alaerh( path, 'STRRFS', info, 0,
416  $ uplo // trans // diag, n, n, -1,
417  $ -1, nrhs, imat, nfail, nerrs,
418  $ nout )
419 *
420  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
421  $ result( 4 ) )
422  CALL strt05( uplo, trans, diag, n, nrhs, a, lda,
423  $ b, lda, x, lda, xact, lda, rwork,
424  $ rwork( nrhs+1 ), result( 5 ) )
425 *
426 * Print information about the tests that did not
427 * pass the threshold.
428 *
429  DO 20 k = 2, 6
430  IF( result( k ).GE.thresh ) THEN
431  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
432  $ CALL alahd( nout, path )
433  WRITE( nout, fmt = 9998 )uplo, trans,
434  $ diag, n, nrhs, imat, k, result( k )
435  nfail = nfail + 1
436  END IF
437  20 CONTINUE
438  nrun = nrun + 5
439  30 CONTINUE
440  40 CONTINUE
441 *
442 *+ TEST 7
443 * Get an estimate of RCOND = 1/CNDNUM.
444 *
445  DO 50 itran = 1, 2
446  IF( itran.EQ.1 ) THEN
447  norm = 'O'
448  rcondc = rcondo
449  ELSE
450  norm = 'I'
451  rcondc = rcondi
452  END IF
453  srnamt = 'STRCON'
454  CALL strcon( norm, uplo, diag, n, a, lda, rcond,
455  $ work, iwork, info )
456 *
457 * Check error code from STRCON.
458 *
459  IF( info.NE.0 )
460  $ CALL alaerh( path, 'STRCON', info, 0,
461  $ norm // uplo // diag, n, n, -1, -1,
462  $ -1, imat, nfail, nerrs, nout )
463 *
464  CALL strt06( rcond, rcondc, uplo, diag, n, a, lda,
465  $ rwork, result( 7 ) )
466 *
467 * Print the test ratio if it is .GE. THRESH.
468 *
469  IF( result( 7 ).GE.thresh ) THEN
470  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
471  $ CALL alahd( nout, path )
472  WRITE( nout, fmt = 9997 )norm, uplo, n, imat,
473  $ 7, result( 7 )
474  nfail = nfail + 1
475  END IF
476  nrun = nrun + 1
477  50 CONTINUE
478  60 CONTINUE
479  70 CONTINUE
480  80 CONTINUE
481 *
482 * Use pathological test matrices to test SLATRS.
483 *
484  DO 110 imat = ntype1 + 1, ntypes
485 *
486 * Do the tests only if DOTYPE( IMAT ) is true.
487 *
488  IF( .NOT.dotype( imat ) )
489  $ GO TO 110
490 *
491  DO 100 iuplo = 1, 2
492 *
493 * Do first for UPLO = 'U', then for UPLO = 'L'
494 *
495  uplo = uplos( iuplo )
496  DO 90 itran = 1, ntran
497 *
498 * Do for op(A) = A, A**T, and A**H.
499 *
500  trans = transs( itran )
501 *
502 * Call SLATTR to generate a triangular test matrix.
503 *
504  srnamt = 'SLATTR'
505  CALL slattr( imat, uplo, trans, diag, iseed, n, a,
506  $ lda, x, work, info )
507 *
508 *+ TEST 8
509 * Solve the system op(A)*x = b.
510 *
511  srnamt = 'SLATRS'
512  CALL scopy( n, x, 1, b, 1 )
513  CALL slatrs( uplo, trans, diag, 'N', n, a, lda, b,
514  $ scale, rwork, info )
515 *
516 * Check error code from SLATRS.
517 *
518  IF( info.NE.0 )
519  $ CALL alaerh( path, 'SLATRS', info, 0,
520  $ uplo // trans // diag // 'N', n, n,
521  $ -1, -1, -1, imat, nfail, nerrs, nout )
522 *
523  CALL strt03( uplo, trans, diag, n, 1, a, lda, scale,
524  $ rwork, one, b, lda, x, lda, work,
525  $ result( 8 ) )
526 *
527 *+ TEST 9
528 * Solve op(A)*X = b again with NORMIN = 'Y'.
529 *
530  CALL scopy( n, x, 1, b( n+1 ), 1 )
531  CALL slatrs( uplo, trans, diag, 'Y', n, a, lda,
532  $ b( n+1 ), scale, rwork, info )
533 *
534 * Check error code from SLATRS.
535 *
536  IF( info.NE.0 )
537  $ CALL alaerh( path, 'SLATRS', info, 0,
538  $ uplo // trans // diag // 'Y', n, n,
539  $ -1, -1, -1, imat, nfail, nerrs, nout )
540 *
541  CALL strt03( uplo, trans, diag, n, 1, a, lda, scale,
542  $ rwork, one, b( n+1 ), lda, x, lda, work,
543  $ result( 9 ) )
544 *
545 * Print information about the tests that did not pass
546 * the threshold.
547 *
548  IF( result( 8 ).GE.thresh ) THEN
549  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
550  $ CALL alahd( nout, path )
551  WRITE( nout, fmt = 9996 )'SLATRS', uplo, trans,
552  $ diag, 'N', n, imat, 8, result( 8 )
553  nfail = nfail + 1
554  END IF
555  IF( result( 9 ).GE.thresh ) THEN
556  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
557  $ CALL alahd( nout, path )
558  WRITE( nout, fmt = 9996 )'SLATRS', uplo, trans,
559  $ diag, 'Y', n, imat, 9, result( 9 )
560  nfail = nfail + 1
561  END IF
562  nrun = nrun + 2
563  90 CONTINUE
564  100 CONTINUE
565  110 CONTINUE
566  120 CONTINUE
567 *
568 * Print a summary of the results.
569 *
570  CALL alasum( path, nout, nfail, nrun, nerrs )
571 *
572  9999 FORMAT( ' UPLO=''', a1, ''', DIAG=''', a1, ''', N=', i5, ', NB=',
573  $ i4, ', type ', i2, ', test(', i2, ')= ', g12.5 )
574  9998 FORMAT( ' UPLO=''', a1, ''', TRANS=''', a1, ''', DIAG=''', a1,
575  $ ''', N=', i5, ', NB=', i4, ', type ', i2, ',
576  $ test(', i2, ')= ', g12.5 )
577  9997 FORMAT( ' NORM=''', a1, ''', UPLO =''', a1, ''', N=', i5, ',',
578  $ 11x, ' type ', i2, ', test(', i2, ')=', g12.5 )
579  9996 FORMAT( 1x, a, '( ''', a1, ''', ''', a1, ''', ''', a1, ''', ''',
580  $ a1, ''',', i5, ', ... ), type ', i2, ', test(', i2, ')=',
581  $ g12.5 )
582  RETURN
583 *
584 * End of SCHKTR
585 *
586  END
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine strt06(RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK, RAT)
STRT06
Definition: strt06.f:123
subroutine schktr(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKTR
Definition: schktr.f:169
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
Definition: slarhs.f:206
subroutine strtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
STRTRS
Definition: strtrs.f:142
subroutine strt03(UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
STRT03
Definition: strt03.f:171
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine strt05(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
STRT05
Definition: strt05.f:183
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine strt02(UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RESID)
STRT02
Definition: strt02.f:152
subroutine strt01(UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, WORK, RESID)
STRT01
Definition: strt01.f:126
subroutine serrtr(PATH, NUNIT)
SERRTR
Definition: serrtr.f:57
subroutine strrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
STRRFS
Definition: strrfs.f:184
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
subroutine slatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
SLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
Definition: slatrs.f:240
subroutine strcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, IWORK, INFO)
STRCON
Definition: strcon.f:139
subroutine strtri(UPLO, DIAG, N, A, LDA, INFO)
STRTRI
Definition: strtri.f:111
subroutine slattr(IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, INFO)
SLATTR
Definition: slattr.f:135
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75