![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SCHKTR 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 00012 * THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, 00013 * WORK, RWORK, IWORK, NOUT ) 00014 * 00015 * .. Scalar Arguments .. 00016 * LOGICAL TSTERR 00017 * INTEGER NMAX, NN, NNB, NNS, NOUT 00018 * REAL THRESH 00019 * .. 00020 * .. Array Arguments .. 00021 * LOGICAL DOTYPE( * ) 00022 * INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) 00023 * REAL A( * ), AINV( * ), B( * ), RWORK( * ), 00024 * $ WORK( * ), X( * ), XACT( * ) 00025 * .. 00026 * 00027 * 00028 *> \par Purpose: 00029 * ============= 00030 *> 00031 *> \verbatim 00032 *> 00033 *> SCHKTR tests STRTRI, -TRS, -RFS, and -CON, and SLATRS 00034 *> \endverbatim 00035 * 00036 * Arguments: 00037 * ========== 00038 * 00039 *> \param[in] DOTYPE 00040 *> \verbatim 00041 *> DOTYPE is LOGICAL array, dimension (NTYPES) 00042 *> The matrix types to be used for testing. Matrices of type j 00043 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 00044 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 00045 *> \endverbatim 00046 *> 00047 *> \param[in] NN 00048 *> \verbatim 00049 *> NN is INTEGER 00050 *> The number of values of N contained in the vector NVAL. 00051 *> \endverbatim 00052 *> 00053 *> \param[in] NVAL 00054 *> \verbatim 00055 *> NVAL is INTEGER array, dimension (NN) 00056 *> The values of the matrix column dimension N. 00057 *> \endverbatim 00058 *> 00059 *> \param[in] NNB 00060 *> \verbatim 00061 *> NNB is INTEGER 00062 *> The number of values of NB contained in the vector NBVAL. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] NBVAL 00066 *> \verbatim 00067 *> NBVAL is INTEGER array, dimension (NNB) 00068 *> The values of the blocksize NB. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] NNS 00072 *> \verbatim 00073 *> NNS is INTEGER 00074 *> The number of values of NRHS contained in the vector NSVAL. 00075 *> \endverbatim 00076 *> 00077 *> \param[in] NSVAL 00078 *> \verbatim 00079 *> NSVAL is INTEGER array, dimension (NNS) 00080 *> The values of the number of right hand sides NRHS. 00081 *> \endverbatim 00082 *> 00083 *> \param[in] THRESH 00084 *> \verbatim 00085 *> THRESH is REAL 00086 *> The threshold value for the test ratios. A result is 00087 *> included in the output file if RESULT >= THRESH. To have 00088 *> every test ratio printed, use THRESH = 0. 00089 *> \endverbatim 00090 *> 00091 *> \param[in] TSTERR 00092 *> \verbatim 00093 *> TSTERR is LOGICAL 00094 *> Flag that indicates whether error exits are to be tested. 00095 *> \endverbatim 00096 *> 00097 *> \param[in] NMAX 00098 *> \verbatim 00099 *> NMAX is INTEGER 00100 *> The leading dimension of the work arrays. 00101 *> NMAX >= the maximum value of N in NVAL. 00102 *> \endverbatim 00103 *> 00104 *> \param[out] A 00105 *> \verbatim 00106 *> A is REAL array, dimension (NMAX*NMAX) 00107 *> \endverbatim 00108 *> 00109 *> \param[out] AINV 00110 *> \verbatim 00111 *> AINV is REAL array, dimension (NMAX*NMAX) 00112 *> \endverbatim 00113 *> 00114 *> \param[out] B 00115 *> \verbatim 00116 *> B is REAL array, dimension (NMAX*NSMAX) 00117 *> where NSMAX is the largest entry in NSVAL. 00118 *> \endverbatim 00119 *> 00120 *> \param[out] X 00121 *> \verbatim 00122 *> X is REAL array, dimension (NMAX*NSMAX) 00123 *> \endverbatim 00124 *> 00125 *> \param[out] XACT 00126 *> \verbatim 00127 *> XACT is REAL array, dimension (NMAX*NSMAX) 00128 *> \endverbatim 00129 *> 00130 *> \param[out] WORK 00131 *> \verbatim 00132 *> WORK is REAL array, dimension 00133 *> (NMAX*max(3,NSMAX)) 00134 *> \endverbatim 00135 *> 00136 *> \param[out] RWORK 00137 *> \verbatim 00138 *> RWORK is REAL array, dimension 00139 *> (max(NMAX,2*NSMAX)) 00140 *> \endverbatim 00141 *> 00142 *> \param[out] IWORK 00143 *> \verbatim 00144 *> IWORK is INTEGER array, dimension (NMAX) 00145 *> \endverbatim 00146 *> 00147 *> \param[in] NOUT 00148 *> \verbatim 00149 *> NOUT is INTEGER 00150 *> The unit number for output. 00151 *> \endverbatim 00152 * 00153 * Authors: 00154 * ======== 00155 * 00156 *> \author Univ. of Tennessee 00157 *> \author Univ. of California Berkeley 00158 *> \author Univ. of Colorado Denver 00159 *> \author NAG Ltd. 00160 * 00161 *> \date November 2011 00162 * 00163 *> \ingroup single_lin 00164 * 00165 * ===================================================================== 00166 SUBROUTINE SCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 00167 $ THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, 00168 $ WORK, RWORK, IWORK, NOUT ) 00169 * 00170 * -- LAPACK test routine (version 3.4.0) -- 00171 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00172 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00173 * November 2011 00174 * 00175 * .. Scalar Arguments .. 00176 LOGICAL TSTERR 00177 INTEGER NMAX, NN, NNB, NNS, NOUT 00178 REAL THRESH 00179 * .. 00180 * .. Array Arguments .. 00181 LOGICAL DOTYPE( * ) 00182 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) 00183 REAL A( * ), AINV( * ), B( * ), RWORK( * ), 00184 $ WORK( * ), X( * ), XACT( * ) 00185 * .. 00186 * 00187 * ===================================================================== 00188 * 00189 * .. Parameters .. 00190 INTEGER NTYPE1, NTYPES 00191 PARAMETER ( NTYPE1 = 10, NTYPES = 18 ) 00192 INTEGER NTESTS 00193 PARAMETER ( NTESTS = 9 ) 00194 INTEGER NTRAN 00195 PARAMETER ( NTRAN = 3 ) 00196 REAL ONE, ZERO 00197 PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 ) 00198 * .. 00199 * .. Local Scalars .. 00200 CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE 00201 CHARACTER*3 PATH 00202 INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN, 00203 $ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN 00204 REAL AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI, 00205 $ RCONDO, SCALE 00206 * .. 00207 * .. Local Arrays .. 00208 CHARACTER TRANSS( NTRAN ), UPLOS( 2 ) 00209 INTEGER ISEED( 4 ), ISEEDY( 4 ) 00210 REAL RESULT( NTESTS ) 00211 * .. 00212 * .. External Functions .. 00213 LOGICAL LSAME 00214 REAL SLANTR 00215 EXTERNAL LSAME, SLANTR 00216 * .. 00217 * .. External Subroutines .. 00218 EXTERNAL ALAERH, ALAHD, ALASUM, SCOPY, SERRTR, SGET04, 00219 $ SLACPY, SLARHS, SLATRS, SLATTR, STRCON, STRRFS, 00220 $ STRT01, STRT02, STRT03, STRT05, STRT06, STRTRI, 00221 $ STRTRS, XLAENV 00222 * .. 00223 * .. Scalars in Common .. 00224 LOGICAL LERR, OK 00225 CHARACTER*32 SRNAMT 00226 INTEGER INFOT, IOUNIT 00227 * .. 00228 * .. Common blocks .. 00229 COMMON / INFOC / INFOT, IOUNIT, OK, LERR 00230 COMMON / SRNAMC / SRNAMT 00231 * .. 00232 * .. Intrinsic Functions .. 00233 INTRINSIC MAX 00234 * .. 00235 * .. Data statements .. 00236 DATA ISEEDY / 1988, 1989, 1990, 1991 / 00237 DATA UPLOS / 'U', 'L' / , TRANSS / 'N', 'T', 'C' / 00238 * .. 00239 * .. Executable Statements .. 00240 * 00241 * Initialize constants and the random number seed. 00242 * 00243 PATH( 1: 1 ) = 'Single precision' 00244 PATH( 2: 3 ) = 'TR' 00245 NRUN = 0 00246 NFAIL = 0 00247 NERRS = 0 00248 DO 10 I = 1, 4 00249 ISEED( I ) = ISEEDY( I ) 00250 10 CONTINUE 00251 * 00252 * Test the error exits 00253 * 00254 IF( TSTERR ) 00255 $ CALL SERRTR( PATH, NOUT ) 00256 INFOT = 0 00257 CALL XLAENV( 2, 2 ) 00258 * 00259 DO 120 IN = 1, NN 00260 * 00261 * Do for each value of N in NVAL 00262 * 00263 N = NVAL( IN ) 00264 LDA = MAX( 1, N ) 00265 XTYPE = 'N' 00266 * 00267 DO 80 IMAT = 1, NTYPE1 00268 * 00269 * Do the tests only if DOTYPE( IMAT ) is true. 00270 * 00271 IF( .NOT.DOTYPE( IMAT ) ) 00272 $ GO TO 80 00273 * 00274 DO 70 IUPLO = 1, 2 00275 * 00276 * Do first for UPLO = 'U', then for UPLO = 'L' 00277 * 00278 UPLO = UPLOS( IUPLO ) 00279 * 00280 * Call SLATTR to generate a triangular test matrix. 00281 * 00282 SRNAMT = 'SLATTR' 00283 CALL SLATTR( IMAT, UPLO, 'No transpose', DIAG, ISEED, N, 00284 $ A, LDA, X, WORK, INFO ) 00285 * 00286 * Set IDIAG = 1 for non-unit matrices, 2 for unit. 00287 * 00288 IF( LSAME( DIAG, 'N' ) ) THEN 00289 IDIAG = 1 00290 ELSE 00291 IDIAG = 2 00292 END IF 00293 * 00294 DO 60 INB = 1, NNB 00295 * 00296 * Do for each blocksize in NBVAL 00297 * 00298 NB = NBVAL( INB ) 00299 CALL XLAENV( 1, NB ) 00300 * 00301 *+ TEST 1 00302 * Form the inverse of A. 00303 * 00304 CALL SLACPY( UPLO, N, N, A, LDA, AINV, LDA ) 00305 SRNAMT = 'STRTRI' 00306 CALL STRTRI( UPLO, DIAG, N, AINV, LDA, INFO ) 00307 * 00308 * Check error code from STRTRI. 00309 * 00310 IF( INFO.NE.0 ) 00311 $ CALL ALAERH( PATH, 'STRTRI', INFO, 0, UPLO // DIAG, 00312 $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, 00313 $ NOUT ) 00314 * 00315 * Compute the infinity-norm condition number of A. 00316 * 00317 ANORM = SLANTR( 'I', UPLO, DIAG, N, N, A, LDA, RWORK ) 00318 AINVNM = SLANTR( 'I', UPLO, DIAG, N, N, AINV, LDA, 00319 $ RWORK ) 00320 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 00321 RCONDI = ONE 00322 ELSE 00323 RCONDI = ( ONE / ANORM ) / AINVNM 00324 END IF 00325 * 00326 * Compute the residual for the triangular matrix times 00327 * its inverse. Also compute the 1-norm condition number 00328 * of A. 00329 * 00330 CALL STRT01( UPLO, DIAG, N, A, LDA, AINV, LDA, RCONDO, 00331 $ RWORK, RESULT( 1 ) ) 00332 * 00333 * Print the test ratio if it is .GE. THRESH. 00334 * 00335 IF( RESULT( 1 ).GE.THRESH ) THEN 00336 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00337 $ CALL ALAHD( NOUT, PATH ) 00338 WRITE( NOUT, FMT = 9999 )UPLO, DIAG, N, NB, IMAT, 00339 $ 1, RESULT( 1 ) 00340 NFAIL = NFAIL + 1 00341 END IF 00342 NRUN = NRUN + 1 00343 * 00344 * Skip remaining tests if not the first block size. 00345 * 00346 IF( INB.NE.1 ) 00347 $ GO TO 60 00348 * 00349 DO 40 IRHS = 1, NNS 00350 NRHS = NSVAL( IRHS ) 00351 XTYPE = 'N' 00352 * 00353 DO 30 ITRAN = 1, NTRAN 00354 * 00355 * Do for op(A) = A, A**T, or A**H. 00356 * 00357 TRANS = TRANSS( ITRAN ) 00358 IF( ITRAN.EQ.1 ) THEN 00359 NORM = 'O' 00360 RCONDC = RCONDO 00361 ELSE 00362 NORM = 'I' 00363 RCONDC = RCONDI 00364 END IF 00365 * 00366 *+ TEST 2 00367 * Solve and compute residual for op(A)*x = b. 00368 * 00369 SRNAMT = 'SLARHS' 00370 CALL SLARHS( PATH, XTYPE, UPLO, TRANS, N, N, 0, 00371 $ IDIAG, NRHS, A, LDA, XACT, LDA, B, 00372 $ LDA, ISEED, INFO ) 00373 XTYPE = 'C' 00374 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 00375 * 00376 SRNAMT = 'STRTRS' 00377 CALL STRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, 00378 $ X, LDA, INFO ) 00379 * 00380 * Check error code from STRTRS. 00381 * 00382 IF( INFO.NE.0 ) 00383 $ CALL ALAERH( PATH, 'STRTRS', INFO, 0, 00384 $ UPLO // TRANS // DIAG, N, N, -1, 00385 $ -1, NRHS, IMAT, NFAIL, NERRS, 00386 $ NOUT ) 00387 * 00388 * This line is needed on a Sun SPARCstation. 00389 * 00390 IF( N.GT.0 ) 00391 $ DUMMY = A( 1 ) 00392 * 00393 CALL STRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA, 00394 $ X, LDA, B, LDA, WORK, RESULT( 2 ) ) 00395 * 00396 *+ TEST 3 00397 * Check solution from generated exact solution. 00398 * 00399 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00400 $ RESULT( 3 ) ) 00401 * 00402 *+ TESTS 4, 5, and 6 00403 * Use iterative refinement to improve the solution 00404 * and compute error bounds. 00405 * 00406 SRNAMT = 'STRRFS' 00407 CALL STRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, 00408 $ B, LDA, X, LDA, RWORK, 00409 $ RWORK( NRHS+1 ), WORK, IWORK, 00410 $ INFO ) 00411 * 00412 * Check error code from STRRFS. 00413 * 00414 IF( INFO.NE.0 ) 00415 $ CALL ALAERH( PATH, 'STRRFS', INFO, 0, 00416 $ UPLO // TRANS // DIAG, N, N, -1, 00417 $ -1, NRHS, IMAT, NFAIL, NERRS, 00418 $ NOUT ) 00419 * 00420 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00421 $ RESULT( 4 ) ) 00422 CALL STRT05( UPLO, TRANS, DIAG, N, NRHS, A, LDA, 00423 $ B, LDA, X, LDA, XACT, LDA, RWORK, 00424 $ RWORK( NRHS+1 ), RESULT( 5 ) ) 00425 * 00426 * Print information about the tests that did not 00427 * pass the threshold. 00428 * 00429 DO 20 K = 2, 6 00430 IF( RESULT( K ).GE.THRESH ) THEN 00431 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00432 $ CALL ALAHD( NOUT, PATH ) 00433 WRITE( NOUT, FMT = 9998 )UPLO, TRANS, 00434 $ DIAG, N, NRHS, IMAT, K, RESULT( K ) 00435 NFAIL = NFAIL + 1 00436 END IF 00437 20 CONTINUE 00438 NRUN = NRUN + 5 00439 30 CONTINUE 00440 40 CONTINUE 00441 * 00442 *+ TEST 7 00443 * Get an estimate of RCOND = 1/CNDNUM. 00444 * 00445 DO 50 ITRAN = 1, 2 00446 IF( ITRAN.EQ.1 ) THEN 00447 NORM = 'O' 00448 RCONDC = RCONDO 00449 ELSE 00450 NORM = 'I' 00451 RCONDC = RCONDI 00452 END IF 00453 SRNAMT = 'STRCON' 00454 CALL STRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, 00455 $ WORK, IWORK, INFO ) 00456 * 00457 * Check error code from STRCON. 00458 * 00459 IF( INFO.NE.0 ) 00460 $ CALL ALAERH( PATH, 'STRCON', INFO, 0, 00461 $ NORM // UPLO // DIAG, N, N, -1, -1, 00462 $ -1, IMAT, NFAIL, NERRS, NOUT ) 00463 * 00464 CALL STRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, 00465 $ RWORK, RESULT( 7 ) ) 00466 * 00467 * Print the test ratio if it is .GE. THRESH. 00468 * 00469 IF( RESULT( 7 ).GE.THRESH ) THEN 00470 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00471 $ CALL ALAHD( NOUT, PATH ) 00472 WRITE( NOUT, FMT = 9997 )NORM, UPLO, N, IMAT, 00473 $ 7, RESULT( 7 ) 00474 NFAIL = NFAIL + 1 00475 END IF 00476 NRUN = NRUN + 1 00477 50 CONTINUE 00478 60 CONTINUE 00479 70 CONTINUE 00480 80 CONTINUE 00481 * 00482 * Use pathological test matrices to test SLATRS. 00483 * 00484 DO 110 IMAT = NTYPE1 + 1, NTYPES 00485 * 00486 * Do the tests only if DOTYPE( IMAT ) is true. 00487 * 00488 IF( .NOT.DOTYPE( IMAT ) ) 00489 $ GO TO 110 00490 * 00491 DO 100 IUPLO = 1, 2 00492 * 00493 * Do first for UPLO = 'U', then for UPLO = 'L' 00494 * 00495 UPLO = UPLOS( IUPLO ) 00496 DO 90 ITRAN = 1, NTRAN 00497 * 00498 * Do for op(A) = A, A**T, and A**H. 00499 * 00500 TRANS = TRANSS( ITRAN ) 00501 * 00502 * Call SLATTR to generate a triangular test matrix. 00503 * 00504 SRNAMT = 'SLATTR' 00505 CALL SLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, 00506 $ LDA, X, WORK, INFO ) 00507 * 00508 *+ TEST 8 00509 * Solve the system op(A)*x = b. 00510 * 00511 SRNAMT = 'SLATRS' 00512 CALL SCOPY( N, X, 1, B, 1 ) 00513 CALL SLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, B, 00514 $ SCALE, RWORK, INFO ) 00515 * 00516 * Check error code from SLATRS. 00517 * 00518 IF( INFO.NE.0 ) 00519 $ CALL ALAERH( PATH, 'SLATRS', INFO, 0, 00520 $ UPLO // TRANS // DIAG // 'N', N, N, 00521 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 00522 * 00523 CALL STRT03( UPLO, TRANS, DIAG, N, 1, A, LDA, SCALE, 00524 $ RWORK, ONE, B, LDA, X, LDA, WORK, 00525 $ RESULT( 8 ) ) 00526 * 00527 *+ TEST 9 00528 * Solve op(A)*X = b again with NORMIN = 'Y'. 00529 * 00530 CALL SCOPY( N, X, 1, B( N+1 ), 1 ) 00531 CALL SLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, 00532 $ B( N+1 ), SCALE, RWORK, INFO ) 00533 * 00534 * Check error code from SLATRS. 00535 * 00536 IF( INFO.NE.0 ) 00537 $ CALL ALAERH( PATH, 'SLATRS', INFO, 0, 00538 $ UPLO // TRANS // DIAG // 'Y', N, N, 00539 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 00540 * 00541 CALL STRT03( UPLO, TRANS, DIAG, N, 1, A, LDA, SCALE, 00542 $ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK, 00543 $ RESULT( 9 ) ) 00544 * 00545 * Print information about the tests that did not pass 00546 * the threshold. 00547 * 00548 IF( RESULT( 8 ).GE.THRESH ) THEN 00549 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00550 $ CALL ALAHD( NOUT, PATH ) 00551 WRITE( NOUT, FMT = 9996 )'SLATRS', UPLO, TRANS, 00552 $ DIAG, 'N', N, IMAT, 8, RESULT( 8 ) 00553 NFAIL = NFAIL + 1 00554 END IF 00555 IF( RESULT( 9 ).GE.THRESH ) THEN 00556 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00557 $ CALL ALAHD( NOUT, PATH ) 00558 WRITE( NOUT, FMT = 9996 )'SLATRS', UPLO, TRANS, 00559 $ DIAG, 'Y', N, IMAT, 9, RESULT( 9 ) 00560 NFAIL = NFAIL + 1 00561 END IF 00562 NRUN = NRUN + 2 00563 90 CONTINUE 00564 100 CONTINUE 00565 110 CONTINUE 00566 120 CONTINUE 00567 * 00568 * Print a summary of the results. 00569 * 00570 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 00571 * 00572 9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5, ', NB=', 00573 $ I4, ', type ', I2, ', test(', I2, ')= ', G12.5 ) 00574 9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1, 00575 $ ''', N=', I5, ', NB=', I4, ', type ', I2, 00576 ', $ test(', I2, ')= ', G12.5 ) 00577 9997 FORMAT( ' NORM=''', A1, ''', UPLO =''', A1, ''', N=', I5, ',', 00578 $ 11X, ' type ', I2, ', test(', I2, ')=', G12.5 ) 00579 9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''', 00580 $ A1, ''',', I5, ', ... ), type ', I2, ', test(', I2, ')=', 00581 $ G12.5 ) 00582 RETURN 00583 * 00584 * End of SCHKTR 00585 * 00586 END