1*> \brief \b SCHKSY 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 SCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 12* THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, 13* XACT, 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( * ), AFAC( * ), AINV( * ), B( * ), 24* $ RWORK( * ), WORK( * ), X( * ), XACT( * ) 25* .. 26* 27* 28*> \par Purpose: 29* ============= 30*> 31*> \verbatim 32*> 33*> SCHKSY tests SSYTRF, -TRI2, -TRS, -TRS2, -RFS, and -CON. 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 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 (NBVAL) 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 maximum value permitted for N, used in dimensioning the 101*> work arrays. 102*> \endverbatim 103*> 104*> \param[out] A 105*> \verbatim 106*> A is REAL array, dimension (NMAX*NMAX) 107*> \endverbatim 108*> 109*> \param[out] AFAC 110*> \verbatim 111*> AFAC is REAL array, dimension (NMAX*NMAX) 112*> \endverbatim 113*> 114*> \param[out] AINV 115*> \verbatim 116*> AINV is REAL array, dimension (NMAX*NMAX) 117*> \endverbatim 118*> 119*> \param[out] B 120*> \verbatim 121*> B is REAL array, dimension (NMAX*NSMAX) 122*> where NSMAX is the largest entry in NSVAL. 123*> \endverbatim 124*> 125*> \param[out] X 126*> \verbatim 127*> X is REAL array, dimension (NMAX*NSMAX) 128*> \endverbatim 129*> 130*> \param[out] XACT 131*> \verbatim 132*> XACT is REAL array, dimension (NMAX*NSMAX) 133*> \endverbatim 134*> 135*> \param[out] WORK 136*> \verbatim 137*> WORK is REAL array, dimension (NMAX*max(3,NSMAX)) 138*> \endverbatim 139*> 140*> \param[out] RWORK 141*> \verbatim 142*> RWORK is REAL array, dimension (max(NMAX,2*NSMAX)) 143*> \endverbatim 144*> 145*> \param[out] IWORK 146*> \verbatim 147*> IWORK is INTEGER array, dimension (2*NMAX) 148*> \endverbatim 149*> 150*> \param[in] NOUT 151*> \verbatim 152*> NOUT is INTEGER 153*> The unit number for output. 154*> \endverbatim 155* 156* Authors: 157* ======== 158* 159*> \author Univ. of Tennessee 160*> \author Univ. of California Berkeley 161*> \author Univ. of Colorado Denver 162*> \author NAG Ltd. 163* 164*> \date November 2013 165* 166*> \ingroup single_lin 167* 168* ===================================================================== 169 SUBROUTINE SCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 170 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, 171 $ XACT, WORK, RWORK, IWORK, NOUT ) 172* 173* -- LAPACK test routine (version 3.5.0) -- 174* -- LAPACK is a software package provided by Univ. of Tennessee, -- 175* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 176* November 2013 177* 178* .. Scalar Arguments .. 179 LOGICAL TSTERR 180 INTEGER NMAX, NN, NNB, NNS, NOUT 181 REAL THRESH 182* .. 183* .. Array Arguments .. 184 LOGICAL DOTYPE( * ) 185 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) 186 REAL A( * ), AFAC( * ), AINV( * ), B( * ), 187 $ RWORK( * ), WORK( * ), X( * ), XACT( * ) 188* .. 189* 190* ===================================================================== 191* 192* .. Parameters .. 193 REAL ZERO 194 PARAMETER ( ZERO = 0.0E+0 ) 195 INTEGER NTYPES 196 PARAMETER ( NTYPES = 10 ) 197 INTEGER NTESTS 198 PARAMETER ( NTESTS = 9 ) 199* .. 200* .. Local Scalars .. 201 LOGICAL TRFCON, ZEROT 202 CHARACTER DIST, TYPE, UPLO, XTYPE 203 CHARACTER*3 PATH 204 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS, 205 $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE, 206 $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT 207 REAL ANORM, CNDNUM, RCOND, RCONDC 208* .. 209* .. Local Arrays .. 210 CHARACTER UPLOS( 2 ) 211 INTEGER ISEED( 4 ), ISEEDY( 4 ) 212 REAL RESULT( NTESTS ) 213* .. 214* .. External Functions .. 215 REAL SGET06, SLANSY 216 EXTERNAL SGET06, SLANSY 217* .. 218* .. External Subroutines .. 219 EXTERNAL ALAERH, ALAHD, ALASUM, SERRSY, SGET04, SLACPY, 220 $ SLARHS, SLATB4, SLATMS, SPOT02, SPOT03, SPOT05, 221 $ SSYCON, SSYCONV, SSYRFS, SSYT01, SSYTRF, 222 $ SSYTRI2, SSYTRS, SSYTRS2, XLAENV 223* .. 224* .. Intrinsic Functions .. 225 INTRINSIC MAX, MIN 226* .. 227* .. Scalars in Common .. 228 LOGICAL LERR, OK 229 CHARACTER*32 SRNAMT 230 INTEGER INFOT, NUNIT 231* .. 232* .. Common blocks .. 233 COMMON / INFOC / INFOT, NUNIT, OK, LERR 234 COMMON / SRNAMC / SRNAMT 235* .. 236* .. Data statements .. 237 DATA ISEEDY / 1988, 1989, 1990, 1991 / 238 DATA UPLOS / 'U', 'L' / 239* .. 240* .. Executable Statements .. 241* 242* Initialize constants and the random number seed. 243* 244 PATH( 1: 1 ) = 'Single precision' 245 PATH( 2: 3 ) = 'SY' 246 NRUN = 0 247 NFAIL = 0 248 NERRS = 0 249 DO 10 I = 1, 4 250 ISEED( I ) = ISEEDY( I ) 251 10 CONTINUE 252* 253* Test the error exits 254* 255 IF( TSTERR ) 256 $ CALL SERRSY( PATH, NOUT ) 257 INFOT = 0 258* 259* Set the minimum block size for which the block routine should 260* be used, which will be later returned by ILAENV 261* 262 CALL XLAENV( 2, 2 ) 263* 264* Do for each value of N in NVAL 265* 266 DO 180 IN = 1, NN 267 N = NVAL( IN ) 268 LDA = MAX( N, 1 ) 269 XTYPE = 'N' 270 NIMAT = NTYPES 271 IF( N.LE.0 ) 272 $ NIMAT = 1 273* 274 IZERO = 0 275* 276* Do for each value of matrix type IMAT 277* 278 DO 170 IMAT = 1, NIMAT 279* 280* Do the tests only if DOTYPE( IMAT ) is true. 281* 282 IF( .NOT.DOTYPE( IMAT ) ) 283 $ GO TO 170 284* 285* Skip types 3, 4, 5, or 6 if the matrix size is too small. 286* 287 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6 288 IF( ZEROT .AND. N.LT.IMAT-2 ) 289 $ GO TO 170 290* 291* Do first for UPLO = 'U', then for UPLO = 'L' 292* 293 DO 160 IUPLO = 1, 2 294 UPLO = UPLOS( IUPLO ) 295* 296* Begin generate the test matrix A. 297* 298* Set up parameters with SLATB4 for the matrix generator 299* based on the type of matrix to be generated. 300* 301 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 302 $ CNDNUM, DIST ) 303* 304* Generate a matrix with SLATMS. 305* 306 SRNAMT = 'SLATMS' 307 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 308 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 309 $ INFO ) 310* 311* Check error code from SLATMS and handle error. 312* 313 IF( INFO.NE.0 ) THEN 314 CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1, 315 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 316* 317* Skip all tests for this generated matrix 318* 319 GO TO 160 320 END IF 321* 322* For matrix types 3-6, zero one or more rows and 323* columns of the matrix to test that INFO is returned 324* correctly. 325* 326 IF( ZEROT ) THEN 327 IF( IMAT.EQ.3 ) THEN 328 IZERO = 1 329 ELSE IF( IMAT.EQ.4 ) THEN 330 IZERO = N 331 ELSE 332 IZERO = N / 2 + 1 333 END IF 334* 335 IF( IMAT.LT.6 ) THEN 336* 337* Set row and column IZERO to zero. 338* 339 IF( IUPLO.EQ.1 ) THEN 340 IOFF = ( IZERO-1 )*LDA 341 DO 20 I = 1, IZERO - 1 342 A( IOFF+I ) = ZERO 343 20 CONTINUE 344 IOFF = IOFF + IZERO 345 DO 30 I = IZERO, N 346 A( IOFF ) = ZERO 347 IOFF = IOFF + LDA 348 30 CONTINUE 349 ELSE 350 IOFF = IZERO 351 DO 40 I = 1, IZERO - 1 352 A( IOFF ) = ZERO 353 IOFF = IOFF + LDA 354 40 CONTINUE 355 IOFF = IOFF - IZERO 356 DO 50 I = IZERO, N 357 A( IOFF+I ) = ZERO 358 50 CONTINUE 359 END IF 360 ELSE 361 IF( IUPLO.EQ.1 ) THEN 362* 363* Set the first IZERO rows and columns to zero. 364* 365 IOFF = 0 366 DO 70 J = 1, N 367 I2 = MIN( J, IZERO ) 368 DO 60 I = 1, I2 369 A( IOFF+I ) = ZERO 370 60 CONTINUE 371 IOFF = IOFF + LDA 372 70 CONTINUE 373 ELSE 374* 375* Set the last IZERO rows and columns to zero. 376* 377 IOFF = 0 378 DO 90 J = 1, N 379 I1 = MAX( J, IZERO ) 380 DO 80 I = I1, N 381 A( IOFF+I ) = ZERO 382 80 CONTINUE 383 IOFF = IOFF + LDA 384 90 CONTINUE 385 END IF 386 END IF 387 ELSE 388 IZERO = 0 389 END IF 390* 391* End generate the test matrix A. 392* 393* 394* Do for each value of NB in NBVAL 395* 396 DO 150 INB = 1, NNB 397* 398* Set the optimal blocksize, which will be later 399* returned by ILAENV. 400* 401 NB = NBVAL( INB ) 402 CALL XLAENV( 1, NB ) 403* 404* Copy the test matrix A into matrix AFAC which 405* will be factorized in place. This is needed to 406* preserve the test matrix A for subsequent tests. 407* 408 CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 409* 410* Compute the L*D*L**T or U*D*U**T factorization of the 411* matrix. IWORK stores details of the interchanges and 412* the block structure of D. AINV is a work array for 413* block factorization, LWORK is the length of AINV. 414* 415 LWORK = MAX( 2, NB )*LDA 416 SRNAMT = 'SSYTRF' 417 CALL SSYTRF( UPLO, N, AFAC, LDA, IWORK, AINV, LWORK, 418 $ INFO ) 419* 420* Adjust the expected value of INFO to account for 421* pivoting. 422* 423 K = IZERO 424 IF( K.GT.0 ) THEN 425 100 CONTINUE 426 IF( IWORK( K ).LT.0 ) THEN 427 IF( IWORK( K ).NE.-K ) THEN 428 K = -IWORK( K ) 429 GO TO 100 430 END IF 431 ELSE IF( IWORK( K ).NE.K ) THEN 432 K = IWORK( K ) 433 GO TO 100 434 END IF 435 END IF 436* 437* Check error code from SSYTRF and handle error. 438* 439 IF( INFO.NE.K ) 440 $ CALL ALAERH( PATH, 'SSYTRF', INFO, K, UPLO, N, N, 441 $ -1, -1, NB, IMAT, NFAIL, NERRS, NOUT ) 442* 443* Set the condition estimate flag if the INFO is not 0. 444* 445 IF( INFO.NE.0 ) THEN 446 TRFCON = .TRUE. 447 ELSE 448 TRFCON = .FALSE. 449 END IF 450* 451*+ TEST 1 452* Reconstruct matrix from factors and compute residual. 453* 454 CALL SSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, AINV, 455 $ LDA, RWORK, RESULT( 1 ) ) 456 NT = 1 457* 458*+ TEST 2 459* Form the inverse and compute the residual, 460* if the factorization was competed without INFO > 0 461* (i.e. there is no zero rows and columns). 462* Do it only for the first block size. 463* 464 IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN 465 CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 466 SRNAMT = 'SSYTRI2' 467 LWORK = (N+NB+1)*(NB+3) 468 CALL SSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK, 469 $ LWORK, INFO ) 470* 471* Check error code from SSYTRI2 and handle error. 472* 473 IF( INFO.NE.0 ) 474 $ CALL ALAERH( PATH, 'SSYTRI2', INFO, -1, UPLO, N, 475 $ N, -1, -1, -1, IMAT, NFAIL, NERRS, 476 $ NOUT ) 477* 478* Compute the residual for a symmetric matrix times 479* its inverse. 480* 481 CALL SPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA, 482 $ RWORK, RCONDC, RESULT( 2 ) ) 483 NT = 2 484 END IF 485* 486* Print information about the tests that did not pass 487* the threshold. 488* 489 DO 110 K = 1, NT 490 IF( RESULT( K ).GE.THRESH ) THEN 491 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 492 $ CALL ALAHD( NOUT, PATH ) 493 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, 494 $ RESULT( K ) 495 NFAIL = NFAIL + 1 496 END IF 497 110 CONTINUE 498 NRUN = NRUN + NT 499* 500* Skip the other tests if this is not the first block 501* size. 502* 503 IF( INB.GT.1 ) 504 $ GO TO 150 505* 506* Do only the condition estimate if INFO is not 0. 507* 508 IF( TRFCON ) THEN 509 RCONDC = ZERO 510 GO TO 140 511 END IF 512* 513* Do for each value of NRHS in NSVAL. 514* 515 DO 130 IRHS = 1, NNS 516 NRHS = NSVAL( IRHS ) 517* 518*+ TEST 3 (Using DSYTRS) 519* Solve and compute residual for A * X = B. 520* 521* Choose a set of NRHS random solution vectors 522* stored in XACT and set up the right hand side B 523* 524 SRNAMT = 'SLARHS' 525 CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 526 $ NRHS, A, LDA, XACT, LDA, B, LDA, 527 $ ISEED, INFO ) 528 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 529* 530 SRNAMT = 'SSYTRS' 531 CALL SSYTRS( UPLO, N, NRHS, AFAC, LDA, IWORK, X, 532 $ LDA, INFO ) 533* 534* Check error code from SSYTRS and handle error. 535* 536 IF( INFO.NE.0 ) 537 $ CALL ALAERH( PATH, 'SSYTRS', INFO, 0, UPLO, N, 538 $ N, -1, -1, NRHS, IMAT, NFAIL, 539 $ NERRS, NOUT ) 540* 541 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 542* 543* Compute the residual for the solution 544* 545 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 546 $ LDA, RWORK, RESULT( 3 ) ) 547* 548*+ TEST 4 (Using DSYTRS2) 549* Solve and compute residual for A * X = B. 550* 551* Choose a set of NRHS random solution vectors 552* stored in XACT and set up the right hand side B 553* 554 SRNAMT = 'SLARHS' 555 CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 556 $ NRHS, A, LDA, XACT, LDA, B, LDA, 557 $ ISEED, INFO ) 558 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 559* 560 SRNAMT = 'DSYTRS2' 561 CALL SSYTRS2( UPLO, N, NRHS, AFAC, LDA, IWORK, X, 562 $ LDA, WORK, INFO ) 563* 564* Check error code from SSYTRS2 and handle error. 565* 566 IF( INFO.NE.0 ) 567 $ CALL ALAERH( PATH, 'SSYTRS2', INFO, 0, UPLO, N, 568 $ N, -1, -1, NRHS, IMAT, NFAIL, 569 $ NERRS, NOUT ) 570* 571 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 572* 573* Compute the residual for the solution 574* 575 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 576 $ LDA, RWORK, RESULT( 4 ) ) 577* 578*+ TEST 5 579* Check solution from generated exact solution. 580* 581 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 582 $ RESULT( 5 ) ) 583* 584*+ TESTS 6, 7, and 8 585* Use iterative refinement to improve the solution. 586* 587 SRNAMT = 'SSYRFS' 588 CALL SSYRFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, 589 $ IWORK, B, LDA, X, LDA, RWORK, 590 $ RWORK( NRHS+1 ), WORK, IWORK( N+1 ), 591 $ INFO ) 592* 593* Check error code from SSYRFS and handle error. 594* 595 IF( INFO.NE.0 ) 596 $ CALL ALAERH( PATH, 'SSYRFS', INFO, 0, UPLO, N, 597 $ N, -1, -1, NRHS, IMAT, NFAIL, 598 $ NERRS, NOUT ) 599* 600 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 601 $ RESULT( 6 ) ) 602 CALL SPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, 603 $ XACT, LDA, RWORK, RWORK( NRHS+1 ), 604 $ RESULT( 7 ) ) 605* 606* Print information about the tests that did not pass 607* the threshold. 608* 609 DO 120 K = 3, 8 610 IF( RESULT( K ).GE.THRESH ) THEN 611 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 612 $ CALL ALAHD( NOUT, PATH ) 613 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, 614 $ IMAT, K, RESULT( K ) 615 NFAIL = NFAIL + 1 616 END IF 617 120 CONTINUE 618 NRUN = NRUN + 6 619* 620* End do for each value of NRHS in NSVAL. 621* 622 130 CONTINUE 623* 624*+ TEST 9 625* Get an estimate of RCOND = 1/CNDNUM. 626* 627 140 CONTINUE 628 ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) 629 SRNAMT = 'SSYCON' 630 CALL SSYCON( UPLO, N, AFAC, LDA, IWORK, ANORM, RCOND, 631 $ WORK, IWORK( N+1 ), INFO ) 632* 633* Check error code from SSYCON and handle error. 634* 635 IF( INFO.NE.0 ) 636 $ CALL ALAERH( PATH, 'SSYCON', INFO, 0, UPLO, N, N, 637 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 638* 639* Compute the test ratio to compare to values of RCOND 640* 641 RESULT( 9 ) = SGET06( RCOND, RCONDC ) 642* 643* Print information about the tests that did not pass 644* the threshold. 645* 646 IF( RESULT( 9 ).GE.THRESH ) THEN 647 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 648 $ CALL ALAHD( NOUT, PATH ) 649 WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 9, 650 $ RESULT( 9 ) 651 NFAIL = NFAIL + 1 652 END IF 653 NRUN = NRUN + 1 654 150 CONTINUE 655* 656 160 CONTINUE 657 170 CONTINUE 658 180 CONTINUE 659* 660* Print a summary of the results. 661* 662 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 663* 664 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ', 665 $ I2, ', test ', I2, ', ratio =', G12.5 ) 666 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', 667 $ I2, ', test(', I2, ') =', G12.5 ) 668 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2, 669 $ ', test(', I2, ') =', G12.5 ) 670 RETURN 671* 672* End of SCHKSY 673* 674 END 675