![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZDRVSP 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 ZDRVSP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 00012 * A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, 00013 * NOUT ) 00014 * 00015 * .. Scalar Arguments .. 00016 * LOGICAL TSTERR 00017 * INTEGER NMAX, NN, NOUT, NRHS 00018 * DOUBLE PRECISION THRESH 00019 * .. 00020 * .. Array Arguments .. 00021 * LOGICAL DOTYPE( * ) 00022 * INTEGER IWORK( * ), NVAL( * ) 00023 * DOUBLE PRECISION RWORK( * ) 00024 * COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), 00025 * $ WORK( * ), X( * ), XACT( * ) 00026 * .. 00027 * 00028 * 00029 *> \par Purpose: 00030 * ============= 00031 *> 00032 *> \verbatim 00033 *> 00034 *> ZDRVSP tests the driver routines ZSPSV and -SVX. 00035 *> \endverbatim 00036 * 00037 * Arguments: 00038 * ========== 00039 * 00040 *> \param[in] DOTYPE 00041 *> \verbatim 00042 *> DOTYPE is LOGICAL array, dimension (NTYPES) 00043 *> The matrix types to be used for testing. Matrices of type j 00044 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 00045 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 00046 *> \endverbatim 00047 *> 00048 *> \param[in] NN 00049 *> \verbatim 00050 *> NN is INTEGER 00051 *> The number of values of N contained in the vector NVAL. 00052 *> \endverbatim 00053 *> 00054 *> \param[in] NVAL 00055 *> \verbatim 00056 *> NVAL is INTEGER array, dimension (NN) 00057 *> The values of the matrix dimension N. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] NRHS 00061 *> \verbatim 00062 *> NRHS is INTEGER 00063 *> The number of right hand side vectors to be generated for 00064 *> each linear system. 00065 *> \endverbatim 00066 *> 00067 *> \param[in] THRESH 00068 *> \verbatim 00069 *> THRESH is DOUBLE PRECISION 00070 *> The threshold value for the test ratios. A result is 00071 *> included in the output file if RESULT >= THRESH. To have 00072 *> every test ratio printed, use THRESH = 0. 00073 *> \endverbatim 00074 *> 00075 *> \param[in] TSTERR 00076 *> \verbatim 00077 *> TSTERR is LOGICAL 00078 *> Flag that indicates whether error exits are to be tested. 00079 *> \endverbatim 00080 *> 00081 *> \param[in] NMAX 00082 *> \verbatim 00083 *> NMAX is INTEGER 00084 *> The maximum value permitted for N, used in dimensioning the 00085 *> work arrays. 00086 *> \endverbatim 00087 *> 00088 *> \param[out] A 00089 *> \verbatim 00090 *> A is COMPLEX*16 array, dimension 00091 *> (NMAX*(NMAX+1)/2) 00092 *> \endverbatim 00093 *> 00094 *> \param[out] AFAC 00095 *> \verbatim 00096 *> AFAC is COMPLEX*16 array, dimension 00097 *> (NMAX*(NMAX+1)/2) 00098 *> \endverbatim 00099 *> 00100 *> \param[out] AINV 00101 *> \verbatim 00102 *> AINV is COMPLEX*16 array, dimension 00103 *> (NMAX*(NMAX+1)/2) 00104 *> \endverbatim 00105 *> 00106 *> \param[out] B 00107 *> \verbatim 00108 *> B is COMPLEX*16 array, dimension (NMAX*NRHS) 00109 *> \endverbatim 00110 *> 00111 *> \param[out] X 00112 *> \verbatim 00113 *> X is COMPLEX*16 array, dimension (NMAX*NRHS) 00114 *> \endverbatim 00115 *> 00116 *> \param[out] XACT 00117 *> \verbatim 00118 *> XACT is COMPLEX*16 array, dimension (NMAX*NRHS) 00119 *> \endverbatim 00120 *> 00121 *> \param[out] WORK 00122 *> \verbatim 00123 *> WORK is COMPLEX*16 array, dimension 00124 *> (NMAX*max(2,NRHS)) 00125 *> \endverbatim 00126 *> 00127 *> \param[out] RWORK 00128 *> \verbatim 00129 *> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS) 00130 *> \endverbatim 00131 *> 00132 *> \param[out] IWORK 00133 *> \verbatim 00134 *> IWORK is INTEGER array, dimension (NMAX) 00135 *> \endverbatim 00136 *> 00137 *> \param[in] NOUT 00138 *> \verbatim 00139 *> NOUT is INTEGER 00140 *> The unit number for output. 00141 *> \endverbatim 00142 * 00143 * Authors: 00144 * ======== 00145 * 00146 *> \author Univ. of Tennessee 00147 *> \author Univ. of California Berkeley 00148 *> \author Univ. of Colorado Denver 00149 *> \author NAG Ltd. 00150 * 00151 *> \date November 2011 00152 * 00153 *> \ingroup complex16_lin 00154 * 00155 * ===================================================================== 00156 SUBROUTINE ZDRVSP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 00157 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, 00158 $ NOUT ) 00159 * 00160 * -- LAPACK test routine (version 3.4.0) -- 00161 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00162 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00163 * November 2011 00164 * 00165 * .. Scalar Arguments .. 00166 LOGICAL TSTERR 00167 INTEGER NMAX, NN, NOUT, NRHS 00168 DOUBLE PRECISION THRESH 00169 * .. 00170 * .. Array Arguments .. 00171 LOGICAL DOTYPE( * ) 00172 INTEGER IWORK( * ), NVAL( * ) 00173 DOUBLE PRECISION RWORK( * ) 00174 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), 00175 $ WORK( * ), X( * ), XACT( * ) 00176 * .. 00177 * 00178 * ===================================================================== 00179 * 00180 * .. Parameters .. 00181 DOUBLE PRECISION ONE, ZERO 00182 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 00183 INTEGER NTYPES, NTESTS 00184 PARAMETER ( NTYPES = 11, NTESTS = 6 ) 00185 INTEGER NFACT 00186 PARAMETER ( NFACT = 2 ) 00187 * .. 00188 * .. Local Scalars .. 00189 LOGICAL ZEROT 00190 CHARACTER DIST, FACT, PACKIT, TYPE, UPLO, XTYPE 00191 CHARACTER*3 PATH 00192 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO, 00193 $ IZERO, J, K, K1, KL, KU, LDA, MODE, N, NB, 00194 $ NBMIN, NERRS, NFAIL, NIMAT, NPP, NRUN, NT 00195 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC 00196 * .. 00197 * .. Local Arrays .. 00198 CHARACTER FACTS( NFACT ) 00199 INTEGER ISEED( 4 ), ISEEDY( 4 ) 00200 DOUBLE PRECISION RESULT( NTESTS ) 00201 * .. 00202 * .. External Functions .. 00203 DOUBLE PRECISION DGET06, ZLANSP 00204 EXTERNAL DGET06, ZLANSP 00205 * .. 00206 * .. External Subroutines .. 00207 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZCOPY, ZERRVX, 00208 $ ZGET04, ZLACPY, ZLARHS, ZLASET, ZLATB4, ZLATMS, 00209 $ ZLATSP, ZPPT05, ZSPSV, ZSPSVX, ZSPT01, ZSPT02, 00210 $ ZSPTRF, ZSPTRI 00211 * .. 00212 * .. Scalars in Common .. 00213 LOGICAL LERR, OK 00214 CHARACTER*32 SRNAMT 00215 INTEGER INFOT, NUNIT 00216 * .. 00217 * .. Common blocks .. 00218 COMMON / INFOC / INFOT, NUNIT, OK, LERR 00219 COMMON / SRNAMC / SRNAMT 00220 * .. 00221 * .. Intrinsic Functions .. 00222 INTRINSIC DCMPLX, MAX, MIN 00223 * .. 00224 * .. Data statements .. 00225 DATA ISEEDY / 1988, 1989, 1990, 1991 / 00226 DATA FACTS / 'F', 'N' / 00227 * .. 00228 * .. Executable Statements .. 00229 * 00230 * Initialize constants and the random number seed. 00231 * 00232 PATH( 1: 1 ) = 'Zomplex precision' 00233 PATH( 2: 3 ) = 'SP' 00234 NRUN = 0 00235 NFAIL = 0 00236 NERRS = 0 00237 DO 10 I = 1, 4 00238 ISEED( I ) = ISEEDY( I ) 00239 10 CONTINUE 00240 * 00241 * Test the error exits 00242 * 00243 IF( TSTERR ) 00244 $ CALL ZERRVX( PATH, NOUT ) 00245 INFOT = 0 00246 * 00247 * Set the block size and minimum block size for testing. 00248 * 00249 NB = 1 00250 NBMIN = 2 00251 CALL XLAENV( 1, NB ) 00252 CALL XLAENV( 2, NBMIN ) 00253 * 00254 * Do for each value of N in NVAL 00255 * 00256 DO 180 IN = 1, NN 00257 N = NVAL( IN ) 00258 LDA = MAX( N, 1 ) 00259 NPP = N*( N+1 ) / 2 00260 XTYPE = 'N' 00261 NIMAT = NTYPES 00262 IF( N.LE.0 ) 00263 $ NIMAT = 1 00264 * 00265 DO 170 IMAT = 1, NIMAT 00266 * 00267 * Do the tests only if DOTYPE( IMAT ) is true. 00268 * 00269 IF( .NOT.DOTYPE( IMAT ) ) 00270 $ GO TO 170 00271 * 00272 * Skip types 3, 4, 5, or 6 if the matrix size is too small. 00273 * 00274 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6 00275 IF( ZEROT .AND. N.LT.IMAT-2 ) 00276 $ GO TO 170 00277 * 00278 * Do first for UPLO = 'U', then for UPLO = 'L' 00279 * 00280 DO 160 IUPLO = 1, 2 00281 IF( IUPLO.EQ.1 ) THEN 00282 UPLO = 'U' 00283 PACKIT = 'C' 00284 ELSE 00285 UPLO = 'L' 00286 PACKIT = 'R' 00287 END IF 00288 * 00289 IF( IMAT.NE.NTYPES ) THEN 00290 * 00291 * Set up parameters with ZLATB4 and generate a test 00292 * matrix with ZLATMS. 00293 * 00294 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, 00295 $ MODE, CNDNUM, DIST ) 00296 * 00297 SRNAMT = 'ZLATMS' 00298 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 00299 $ CNDNUM, ANORM, KL, KU, PACKIT, A, LDA, 00300 $ WORK, INFO ) 00301 * 00302 * Check error code from ZLATMS. 00303 * 00304 IF( INFO.NE.0 ) THEN 00305 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, 00306 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 00307 GO TO 160 00308 END IF 00309 * 00310 * For types 3-6, zero one or more rows and columns of 00311 * the matrix to test that INFO is returned correctly. 00312 * 00313 IF( ZEROT ) THEN 00314 IF( IMAT.EQ.3 ) THEN 00315 IZERO = 1 00316 ELSE IF( IMAT.EQ.4 ) THEN 00317 IZERO = N 00318 ELSE 00319 IZERO = N / 2 + 1 00320 END IF 00321 * 00322 IF( IMAT.LT.6 ) THEN 00323 * 00324 * Set row and column IZERO to zero. 00325 * 00326 IF( IUPLO.EQ.1 ) THEN 00327 IOFF = ( IZERO-1 )*IZERO / 2 00328 DO 20 I = 1, IZERO - 1 00329 A( IOFF+I ) = ZERO 00330 20 CONTINUE 00331 IOFF = IOFF + IZERO 00332 DO 30 I = IZERO, N 00333 A( IOFF ) = ZERO 00334 IOFF = IOFF + I 00335 30 CONTINUE 00336 ELSE 00337 IOFF = IZERO 00338 DO 40 I = 1, IZERO - 1 00339 A( IOFF ) = ZERO 00340 IOFF = IOFF + N - I 00341 40 CONTINUE 00342 IOFF = IOFF - IZERO 00343 DO 50 I = IZERO, N 00344 A( IOFF+I ) = ZERO 00345 50 CONTINUE 00346 END IF 00347 ELSE 00348 IF( IUPLO.EQ.1 ) THEN 00349 * 00350 * Set the first IZERO rows and columns to zero. 00351 * 00352 IOFF = 0 00353 DO 70 J = 1, N 00354 I2 = MIN( J, IZERO ) 00355 DO 60 I = 1, I2 00356 A( IOFF+I ) = ZERO 00357 60 CONTINUE 00358 IOFF = IOFF + J 00359 70 CONTINUE 00360 ELSE 00361 * 00362 * Set the last IZERO rows and columns to zero. 00363 * 00364 IOFF = 0 00365 DO 90 J = 1, N 00366 I1 = MAX( J, IZERO ) 00367 DO 80 I = I1, N 00368 A( IOFF+I ) = ZERO 00369 80 CONTINUE 00370 IOFF = IOFF + N - J 00371 90 CONTINUE 00372 END IF 00373 END IF 00374 ELSE 00375 IZERO = 0 00376 END IF 00377 ELSE 00378 * 00379 * Use a special block diagonal matrix to test alternate 00380 * code for the 2-by-2 blocks. 00381 * 00382 CALL ZLATSP( UPLO, N, A, ISEED ) 00383 END IF 00384 * 00385 DO 150 IFACT = 1, NFACT 00386 * 00387 * Do first for FACT = 'F', then for other values. 00388 * 00389 FACT = FACTS( IFACT ) 00390 * 00391 * Compute the condition number for comparison with 00392 * the value returned by ZSPSVX. 00393 * 00394 IF( ZEROT ) THEN 00395 IF( IFACT.EQ.1 ) 00396 $ GO TO 150 00397 RCONDC = ZERO 00398 * 00399 ELSE IF( IFACT.EQ.1 ) THEN 00400 * 00401 * Compute the 1-norm of A. 00402 * 00403 ANORM = ZLANSP( '1', UPLO, N, A, RWORK ) 00404 * 00405 * Factor the matrix A. 00406 * 00407 CALL ZCOPY( NPP, A, 1, AFAC, 1 ) 00408 CALL ZSPTRF( UPLO, N, AFAC, IWORK, INFO ) 00409 * 00410 * Compute inv(A) and take its norm. 00411 * 00412 CALL ZCOPY( NPP, AFAC, 1, AINV, 1 ) 00413 CALL ZSPTRI( UPLO, N, AINV, IWORK, WORK, INFO ) 00414 AINVNM = ZLANSP( '1', UPLO, N, AINV, RWORK ) 00415 * 00416 * Compute the 1-norm condition number of A. 00417 * 00418 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 00419 RCONDC = ONE 00420 ELSE 00421 RCONDC = ( ONE / ANORM ) / AINVNM 00422 END IF 00423 END IF 00424 * 00425 * Form an exact solution and set the right hand side. 00426 * 00427 SRNAMT = 'ZLARHS' 00428 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 00429 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED, 00430 $ INFO ) 00431 XTYPE = 'C' 00432 * 00433 * --- Test ZSPSV --- 00434 * 00435 IF( IFACT.EQ.2 ) THEN 00436 CALL ZCOPY( NPP, A, 1, AFAC, 1 ) 00437 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 00438 * 00439 * Factor the matrix and solve the system using ZSPSV. 00440 * 00441 SRNAMT = 'ZSPSV ' 00442 CALL ZSPSV( UPLO, N, NRHS, AFAC, IWORK, X, LDA, 00443 $ INFO ) 00444 * 00445 * Adjust the expected value of INFO to account for 00446 * pivoting. 00447 * 00448 K = IZERO 00449 IF( K.GT.0 ) THEN 00450 100 CONTINUE 00451 IF( IWORK( K ).LT.0 ) THEN 00452 IF( IWORK( K ).NE.-K ) THEN 00453 K = -IWORK( K ) 00454 GO TO 100 00455 END IF 00456 ELSE IF( IWORK( K ).NE.K ) THEN 00457 K = IWORK( K ) 00458 GO TO 100 00459 END IF 00460 END IF 00461 * 00462 * Check error code from ZSPSV . 00463 * 00464 IF( INFO.NE.K ) THEN 00465 CALL ALAERH( PATH, 'ZSPSV ', INFO, K, UPLO, N, 00466 $ N, -1, -1, NRHS, IMAT, NFAIL, 00467 $ NERRS, NOUT ) 00468 GO TO 120 00469 ELSE IF( INFO.NE.0 ) THEN 00470 GO TO 120 00471 END IF 00472 * 00473 * Reconstruct matrix from factors and compute 00474 * residual. 00475 * 00476 CALL ZSPT01( UPLO, N, A, AFAC, IWORK, AINV, LDA, 00477 $ RWORK, RESULT( 1 ) ) 00478 * 00479 * Compute residual of the computed solution. 00480 * 00481 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 00482 CALL ZSPT02( UPLO, N, NRHS, A, X, LDA, WORK, LDA, 00483 $ RWORK, RESULT( 2 ) ) 00484 * 00485 * Check solution from generated exact solution. 00486 * 00487 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00488 $ RESULT( 3 ) ) 00489 NT = 3 00490 * 00491 * Print information about the tests that did not pass 00492 * the threshold. 00493 * 00494 DO 110 K = 1, NT 00495 IF( RESULT( K ).GE.THRESH ) THEN 00496 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00497 $ CALL ALADHD( NOUT, PATH ) 00498 WRITE( NOUT, FMT = 9999 )'ZSPSV ', UPLO, N, 00499 $ IMAT, K, RESULT( K ) 00500 NFAIL = NFAIL + 1 00501 END IF 00502 110 CONTINUE 00503 NRUN = NRUN + NT 00504 120 CONTINUE 00505 END IF 00506 * 00507 * --- Test ZSPSVX --- 00508 * 00509 IF( IFACT.EQ.2 .AND. NPP.GT.0 ) 00510 $ CALL ZLASET( 'Full', NPP, 1, DCMPLX( ZERO ), 00511 $ DCMPLX( ZERO ), AFAC, NPP ) 00512 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), 00513 $ DCMPLX( ZERO ), X, LDA ) 00514 * 00515 * Solve the system and compute the condition number and 00516 * error bounds using ZSPSVX. 00517 * 00518 SRNAMT = 'ZSPSVX' 00519 CALL ZSPSVX( FACT, UPLO, N, NRHS, A, AFAC, IWORK, B, 00520 $ LDA, X, LDA, RCOND, RWORK, 00521 $ RWORK( NRHS+1 ), WORK, RWORK( 2*NRHS+1 ), 00522 $ INFO ) 00523 * 00524 * Adjust the expected value of INFO to account for 00525 * pivoting. 00526 * 00527 K = IZERO 00528 IF( K.GT.0 ) THEN 00529 130 CONTINUE 00530 IF( IWORK( K ).LT.0 ) THEN 00531 IF( IWORK( K ).NE.-K ) THEN 00532 K = -IWORK( K ) 00533 GO TO 130 00534 END IF 00535 ELSE IF( IWORK( K ).NE.K ) THEN 00536 K = IWORK( K ) 00537 GO TO 130 00538 END IF 00539 END IF 00540 * 00541 * Check the error code from ZSPSVX. 00542 * 00543 IF( INFO.NE.K ) THEN 00544 CALL ALAERH( PATH, 'ZSPSVX', INFO, K, FACT // UPLO, 00545 $ N, N, -1, -1, NRHS, IMAT, NFAIL, 00546 $ NERRS, NOUT ) 00547 GO TO 150 00548 END IF 00549 * 00550 IF( INFO.EQ.0 ) THEN 00551 IF( IFACT.GE.2 ) THEN 00552 * 00553 * Reconstruct matrix from factors and compute 00554 * residual. 00555 * 00556 CALL ZSPT01( UPLO, N, A, AFAC, IWORK, AINV, LDA, 00557 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 00558 K1 = 1 00559 ELSE 00560 K1 = 2 00561 END IF 00562 * 00563 * Compute residual of the computed solution. 00564 * 00565 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 00566 CALL ZSPT02( UPLO, N, NRHS, A, X, LDA, WORK, LDA, 00567 $ RWORK( 2*NRHS+1 ), RESULT( 2 ) ) 00568 * 00569 * Check solution from generated exact solution. 00570 * 00571 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00572 $ RESULT( 3 ) ) 00573 * 00574 * Check the error bounds from iterative refinement. 00575 * 00576 CALL ZPPT05( UPLO, N, NRHS, A, B, LDA, X, LDA, 00577 $ XACT, LDA, RWORK, RWORK( NRHS+1 ), 00578 $ RESULT( 4 ) ) 00579 ELSE 00580 K1 = 6 00581 END IF 00582 * 00583 * Compare RCOND from ZSPSVX with the computed value 00584 * in RCONDC. 00585 * 00586 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 00587 * 00588 * Print information about the tests that did not pass 00589 * the threshold. 00590 * 00591 DO 140 K = K1, 6 00592 IF( RESULT( K ).GE.THRESH ) THEN 00593 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00594 $ CALL ALADHD( NOUT, PATH ) 00595 WRITE( NOUT, FMT = 9998 )'ZSPSVX', FACT, UPLO, 00596 $ N, IMAT, K, RESULT( K ) 00597 NFAIL = NFAIL + 1 00598 END IF 00599 140 CONTINUE 00600 NRUN = NRUN + 7 - K1 00601 * 00602 150 CONTINUE 00603 * 00604 160 CONTINUE 00605 170 CONTINUE 00606 180 CONTINUE 00607 * 00608 * Print a summary of the results. 00609 * 00610 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 00611 * 00612 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2, 00613 $ ', test ', I2, ', ratio =', G12.5 ) 00614 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5, 00615 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 ) 00616 RETURN 00617 * 00618 * End of ZDRVSP 00619 * 00620 END