![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZDRVHP 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 ZDRVHP( 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 *> ZDRVHP tests the driver routines ZHPSV 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 ZDRVHP( 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 = 10, 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, ZLANHP 00204 EXTERNAL DGET06, ZLANHP 00205 * .. 00206 * .. External Subroutines .. 00207 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZCOPY, ZERRVX, 00208 $ ZGET04, ZHPSV, ZHPSVX, ZHPT01, ZHPTRF, ZHPTRI, 00209 $ ZLACPY, ZLAIPD, ZLARHS, ZLASET, ZLATB4, ZLATMS, 00210 $ ZPPT02, ZPPT05 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 ) = 'Z' 00233 PATH( 2: 3 ) = 'HP' 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 * Set up parameters with ZLATB4 and generate a test matrix 00290 * with ZLATMS. 00291 * 00292 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 00293 $ CNDNUM, DIST ) 00294 * 00295 SRNAMT = 'ZLATMS' 00296 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 00297 $ CNDNUM, ANORM, KL, KU, PACKIT, A, LDA, WORK, 00298 $ INFO ) 00299 * 00300 * Check error code from ZLATMS. 00301 * 00302 IF( INFO.NE.0 ) THEN 00303 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1, 00304 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 00305 GO TO 160 00306 END IF 00307 * 00308 * For types 3-6, zero one or more rows and columns of the 00309 * matrix to test that INFO is returned correctly. 00310 * 00311 IF( ZEROT ) THEN 00312 IF( IMAT.EQ.3 ) THEN 00313 IZERO = 1 00314 ELSE IF( IMAT.EQ.4 ) THEN 00315 IZERO = N 00316 ELSE 00317 IZERO = N / 2 + 1 00318 END IF 00319 * 00320 IF( IMAT.LT.6 ) THEN 00321 * 00322 * Set row and column IZERO to zero. 00323 * 00324 IF( IUPLO.EQ.1 ) THEN 00325 IOFF = ( IZERO-1 )*IZERO / 2 00326 DO 20 I = 1, IZERO - 1 00327 A( IOFF+I ) = ZERO 00328 20 CONTINUE 00329 IOFF = IOFF + IZERO 00330 DO 30 I = IZERO, N 00331 A( IOFF ) = ZERO 00332 IOFF = IOFF + I 00333 30 CONTINUE 00334 ELSE 00335 IOFF = IZERO 00336 DO 40 I = 1, IZERO - 1 00337 A( IOFF ) = ZERO 00338 IOFF = IOFF + N - I 00339 40 CONTINUE 00340 IOFF = IOFF - IZERO 00341 DO 50 I = IZERO, N 00342 A( IOFF+I ) = ZERO 00343 50 CONTINUE 00344 END IF 00345 ELSE 00346 IOFF = 0 00347 IF( IUPLO.EQ.1 ) THEN 00348 * 00349 * Set the first IZERO rows and columns to zero. 00350 * 00351 DO 70 J = 1, N 00352 I2 = MIN( J, IZERO ) 00353 DO 60 I = 1, I2 00354 A( IOFF+I ) = ZERO 00355 60 CONTINUE 00356 IOFF = IOFF + J 00357 70 CONTINUE 00358 ELSE 00359 * 00360 * Set the last IZERO rows and columns to zero. 00361 * 00362 DO 90 J = 1, N 00363 I1 = MAX( J, IZERO ) 00364 DO 80 I = I1, N 00365 A( IOFF+I ) = ZERO 00366 80 CONTINUE 00367 IOFF = IOFF + N - J 00368 90 CONTINUE 00369 END IF 00370 END IF 00371 ELSE 00372 IZERO = 0 00373 END IF 00374 * 00375 * Set the imaginary part of the diagonals. 00376 * 00377 IF( IUPLO.EQ.1 ) THEN 00378 CALL ZLAIPD( N, A, 2, 1 ) 00379 ELSE 00380 CALL ZLAIPD( N, A, N, -1 ) 00381 END IF 00382 * 00383 DO 150 IFACT = 1, NFACT 00384 * 00385 * Do first for FACT = 'F', then for other values. 00386 * 00387 FACT = FACTS( IFACT ) 00388 * 00389 * Compute the condition number for comparison with 00390 * the value returned by ZHPSVX. 00391 * 00392 IF( ZEROT ) THEN 00393 IF( IFACT.EQ.1 ) 00394 $ GO TO 150 00395 RCONDC = ZERO 00396 * 00397 ELSE IF( IFACT.EQ.1 ) THEN 00398 * 00399 * Compute the 1-norm of A. 00400 * 00401 ANORM = ZLANHP( '1', UPLO, N, A, RWORK ) 00402 * 00403 * Factor the matrix A. 00404 * 00405 CALL ZCOPY( NPP, A, 1, AFAC, 1 ) 00406 CALL ZHPTRF( UPLO, N, AFAC, IWORK, INFO ) 00407 * 00408 * Compute inv(A) and take its norm. 00409 * 00410 CALL ZCOPY( NPP, AFAC, 1, AINV, 1 ) 00411 CALL ZHPTRI( UPLO, N, AINV, IWORK, WORK, INFO ) 00412 AINVNM = ZLANHP( '1', UPLO, N, AINV, RWORK ) 00413 * 00414 * Compute the 1-norm condition number of A. 00415 * 00416 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 00417 RCONDC = ONE 00418 ELSE 00419 RCONDC = ( ONE / ANORM ) / AINVNM 00420 END IF 00421 END IF 00422 * 00423 * Form an exact solution and set the right hand side. 00424 * 00425 SRNAMT = 'ZLARHS' 00426 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 00427 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED, 00428 $ INFO ) 00429 XTYPE = 'C' 00430 * 00431 * --- Test ZHPSV --- 00432 * 00433 IF( IFACT.EQ.2 ) THEN 00434 CALL ZCOPY( NPP, A, 1, AFAC, 1 ) 00435 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 00436 * 00437 * Factor the matrix and solve the system using ZHPSV. 00438 * 00439 SRNAMT = 'ZHPSV ' 00440 CALL ZHPSV( UPLO, N, NRHS, AFAC, IWORK, X, LDA, 00441 $ INFO ) 00442 * 00443 * Adjust the expected value of INFO to account for 00444 * pivoting. 00445 * 00446 K = IZERO 00447 IF( K.GT.0 ) THEN 00448 100 CONTINUE 00449 IF( IWORK( K ).LT.0 ) THEN 00450 IF( IWORK( K ).NE.-K ) THEN 00451 K = -IWORK( K ) 00452 GO TO 100 00453 END IF 00454 ELSE IF( IWORK( K ).NE.K ) THEN 00455 K = IWORK( K ) 00456 GO TO 100 00457 END IF 00458 END IF 00459 * 00460 * Check error code from ZHPSV . 00461 * 00462 IF( INFO.NE.K ) THEN 00463 CALL ALAERH( PATH, 'ZHPSV ', INFO, K, UPLO, N, 00464 $ N, -1, -1, NRHS, IMAT, NFAIL, 00465 $ NERRS, NOUT ) 00466 GO TO 120 00467 ELSE IF( INFO.NE.0 ) THEN 00468 GO TO 120 00469 END IF 00470 * 00471 * Reconstruct matrix from factors and compute 00472 * residual. 00473 * 00474 CALL ZHPT01( UPLO, N, A, AFAC, IWORK, AINV, LDA, 00475 $ RWORK, RESULT( 1 ) ) 00476 * 00477 * Compute residual of the computed solution. 00478 * 00479 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 00480 CALL ZPPT02( UPLO, N, NRHS, A, X, LDA, WORK, LDA, 00481 $ RWORK, RESULT( 2 ) ) 00482 * 00483 * Check solution from generated exact solution. 00484 * 00485 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00486 $ RESULT( 3 ) ) 00487 NT = 3 00488 * 00489 * Print information about the tests that did not pass 00490 * the threshold. 00491 * 00492 DO 110 K = 1, NT 00493 IF( RESULT( K ).GE.THRESH ) THEN 00494 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00495 $ CALL ALADHD( NOUT, PATH ) 00496 WRITE( NOUT, FMT = 9999 )'ZHPSV ', UPLO, N, 00497 $ IMAT, K, RESULT( K ) 00498 NFAIL = NFAIL + 1 00499 END IF 00500 110 CONTINUE 00501 NRUN = NRUN + NT 00502 120 CONTINUE 00503 END IF 00504 * 00505 * --- Test ZHPSVX --- 00506 * 00507 IF( IFACT.EQ.2 .AND. NPP.GT.0 ) 00508 $ CALL ZLASET( 'Full', NPP, 1, DCMPLX( ZERO ), 00509 $ DCMPLX( ZERO ), AFAC, NPP ) 00510 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), 00511 $ DCMPLX( ZERO ), X, LDA ) 00512 * 00513 * Solve the system and compute the condition number and 00514 * error bounds using ZHPSVX. 00515 * 00516 SRNAMT = 'ZHPSVX' 00517 CALL ZHPSVX( FACT, UPLO, N, NRHS, A, AFAC, IWORK, B, 00518 $ LDA, X, LDA, RCOND, RWORK, 00519 $ RWORK( NRHS+1 ), WORK, RWORK( 2*NRHS+1 ), 00520 $ INFO ) 00521 * 00522 * Adjust the expected value of INFO to account for 00523 * pivoting. 00524 * 00525 K = IZERO 00526 IF( K.GT.0 ) THEN 00527 130 CONTINUE 00528 IF( IWORK( K ).LT.0 ) THEN 00529 IF( IWORK( K ).NE.-K ) THEN 00530 K = -IWORK( K ) 00531 GO TO 130 00532 END IF 00533 ELSE IF( IWORK( K ).NE.K ) THEN 00534 K = IWORK( K ) 00535 GO TO 130 00536 END IF 00537 END IF 00538 * 00539 * Check the error code from ZHPSVX. 00540 * 00541 IF( INFO.NE.K ) THEN 00542 CALL ALAERH( PATH, 'ZHPSVX', INFO, K, FACT // UPLO, 00543 $ N, N, -1, -1, NRHS, IMAT, NFAIL, 00544 $ NERRS, NOUT ) 00545 GO TO 150 00546 END IF 00547 * 00548 IF( INFO.EQ.0 ) THEN 00549 IF( IFACT.GE.2 ) THEN 00550 * 00551 * Reconstruct matrix from factors and compute 00552 * residual. 00553 * 00554 CALL ZHPT01( UPLO, N, A, AFAC, IWORK, AINV, LDA, 00555 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 00556 K1 = 1 00557 ELSE 00558 K1 = 2 00559 END IF 00560 * 00561 * Compute residual of the computed solution. 00562 * 00563 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 00564 CALL ZPPT02( UPLO, N, NRHS, A, X, LDA, WORK, LDA, 00565 $ RWORK( 2*NRHS+1 ), RESULT( 2 ) ) 00566 * 00567 * Check solution from generated exact solution. 00568 * 00569 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 00570 $ RESULT( 3 ) ) 00571 * 00572 * Check the error bounds from iterative refinement. 00573 * 00574 CALL ZPPT05( UPLO, N, NRHS, A, B, LDA, X, LDA, 00575 $ XACT, LDA, RWORK, RWORK( NRHS+1 ), 00576 $ RESULT( 4 ) ) 00577 ELSE 00578 K1 = 6 00579 END IF 00580 * 00581 * Compare RCOND from ZHPSVX with the computed value 00582 * in RCONDC. 00583 * 00584 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 00585 * 00586 * Print information about the tests that did not pass 00587 * the threshold. 00588 * 00589 DO 140 K = K1, 6 00590 IF( RESULT( K ).GE.THRESH ) THEN 00591 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 00592 $ CALL ALADHD( NOUT, PATH ) 00593 WRITE( NOUT, FMT = 9998 )'ZHPSVX', FACT, UPLO, 00594 $ N, IMAT, K, RESULT( K ) 00595 NFAIL = NFAIL + 1 00596 END IF 00597 140 CONTINUE 00598 NRUN = NRUN + 7 - K1 00599 * 00600 150 CONTINUE 00601 * 00602 160 CONTINUE 00603 170 CONTINUE 00604 180 CONTINUE 00605 * 00606 * Print a summary of the results. 00607 * 00608 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 00609 * 00610 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2, 00611 $ ', test ', I2, ', ratio =', G12.5 ) 00612 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5, 00613 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 ) 00614 RETURN 00615 * 00616 * End of ZDRVHP 00617 * 00618 END