![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZLAQR2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZLAQR2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlaqr2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlaqr2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlaqr2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, 00022 * IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, 00023 * NV, WV, LDWV, WORK, LWORK ) 00024 * 00025 * .. Scalar Arguments .. 00026 * INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, 00027 * $ LDZ, LWORK, N, ND, NH, NS, NV, NW 00028 * LOGICAL WANTT, WANTZ 00029 * .. 00030 * .. Array Arguments .. 00031 * COMPLEX*16 H( LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ), 00032 * $ WORK( * ), WV( LDWV, * ), Z( LDZ, * ) 00033 * .. 00034 * 00035 * 00036 *> \par Purpose: 00037 * ============= 00038 *> 00039 *> \verbatim 00040 *> 00041 *> ZLAQR2 is identical to ZLAQR3 except that it avoids 00042 *> recursion by calling ZLAHQR instead of ZLAQR4. 00043 *> 00044 *> Aggressive early deflation: 00045 *> 00046 *> ZLAQR2 accepts as input an upper Hessenberg matrix 00047 *> H and performs an unitary similarity transformation 00048 *> designed to detect and deflate fully converged eigenvalues from 00049 *> a trailing principal submatrix. On output H has been over- 00050 *> written by a new Hessenberg matrix that is a perturbation of 00051 *> an unitary similarity transformation of H. It is to be 00052 *> hoped that the final version of H has many zero subdiagonal 00053 *> entries. 00054 *> 00055 *> \endverbatim 00056 * 00057 * Arguments: 00058 * ========== 00059 * 00060 *> \param[in] WANTT 00061 *> \verbatim 00062 *> WANTT is LOGICAL 00063 *> If .TRUE., then the Hessenberg matrix H is fully updated 00064 *> so that the triangular Schur factor may be 00065 *> computed (in cooperation with the calling subroutine). 00066 *> If .FALSE., then only enough of H is updated to preserve 00067 *> the eigenvalues. 00068 *> \endverbatim 00069 *> 00070 *> \param[in] WANTZ 00071 *> \verbatim 00072 *> WANTZ is LOGICAL 00073 *> If .TRUE., then the unitary matrix Z is updated so 00074 *> so that the unitary Schur factor may be computed 00075 *> (in cooperation with the calling subroutine). 00076 *> If .FALSE., then Z is not referenced. 00077 *> \endverbatim 00078 *> 00079 *> \param[in] N 00080 *> \verbatim 00081 *> N is INTEGER 00082 *> The order of the matrix H and (if WANTZ is .TRUE.) the 00083 *> order of the unitary matrix Z. 00084 *> \endverbatim 00085 *> 00086 *> \param[in] KTOP 00087 *> \verbatim 00088 *> KTOP is INTEGER 00089 *> It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0. 00090 *> KBOT and KTOP together determine an isolated block 00091 *> along the diagonal of the Hessenberg matrix. 00092 *> \endverbatim 00093 *> 00094 *> \param[in] KBOT 00095 *> \verbatim 00096 *> KBOT is INTEGER 00097 *> It is assumed without a check that either 00098 *> KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together 00099 *> determine an isolated block along the diagonal of the 00100 *> Hessenberg matrix. 00101 *> \endverbatim 00102 *> 00103 *> \param[in] NW 00104 *> \verbatim 00105 *> NW is INTEGER 00106 *> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). 00107 *> \endverbatim 00108 *> 00109 *> \param[in,out] H 00110 *> \verbatim 00111 *> H is COMPLEX*16 array, dimension (LDH,N) 00112 *> On input the initial N-by-N section of H stores the 00113 *> Hessenberg matrix undergoing aggressive early deflation. 00114 *> On output H has been transformed by a unitary 00115 *> similarity transformation, perturbed, and the returned 00116 *> to Hessenberg form that (it is to be hoped) has some 00117 *> zero subdiagonal entries. 00118 *> \endverbatim 00119 *> 00120 *> \param[in] LDH 00121 *> \verbatim 00122 *> LDH is integer 00123 *> Leading dimension of H just as declared in the calling 00124 *> subroutine. N .LE. LDH 00125 *> \endverbatim 00126 *> 00127 *> \param[in] ILOZ 00128 *> \verbatim 00129 *> ILOZ is INTEGER 00130 *> \endverbatim 00131 *> 00132 *> \param[in] IHIZ 00133 *> \verbatim 00134 *> IHIZ is INTEGER 00135 *> Specify the rows of Z to which transformations must be 00136 *> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. 00137 *> \endverbatim 00138 *> 00139 *> \param[in,out] Z 00140 *> \verbatim 00141 *> Z is COMPLEX*16 array, dimension (LDZ,N) 00142 *> IF WANTZ is .TRUE., then on output, the unitary 00143 *> similarity transformation mentioned above has been 00144 *> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. 00145 *> If WANTZ is .FALSE., then Z is unreferenced. 00146 *> \endverbatim 00147 *> 00148 *> \param[in] LDZ 00149 *> \verbatim 00150 *> LDZ is integer 00151 *> The leading dimension of Z just as declared in the 00152 *> calling subroutine. 1 .LE. LDZ. 00153 *> \endverbatim 00154 *> 00155 *> \param[out] NS 00156 *> \verbatim 00157 *> NS is integer 00158 *> The number of unconverged (ie approximate) eigenvalues 00159 *> returned in SR and SI that may be used as shifts by the 00160 *> calling subroutine. 00161 *> \endverbatim 00162 *> 00163 *> \param[out] ND 00164 *> \verbatim 00165 *> ND is integer 00166 *> The number of converged eigenvalues uncovered by this 00167 *> subroutine. 00168 *> \endverbatim 00169 *> 00170 *> \param[out] SH 00171 *> \verbatim 00172 *> SH is COMPLEX*16 array, dimension KBOT 00173 *> On output, approximate eigenvalues that may 00174 *> be used for shifts are stored in SH(KBOT-ND-NS+1) 00175 *> through SR(KBOT-ND). Converged eigenvalues are 00176 *> stored in SH(KBOT-ND+1) through SH(KBOT). 00177 *> \endverbatim 00178 *> 00179 *> \param[out] V 00180 *> \verbatim 00181 *> V is COMPLEX*16 array, dimension (LDV,NW) 00182 *> An NW-by-NW work array. 00183 *> \endverbatim 00184 *> 00185 *> \param[in] LDV 00186 *> \verbatim 00187 *> LDV is integer scalar 00188 *> The leading dimension of V just as declared in the 00189 *> calling subroutine. NW .LE. LDV 00190 *> \endverbatim 00191 *> 00192 *> \param[in] NH 00193 *> \verbatim 00194 *> NH is integer scalar 00195 *> The number of columns of T. NH.GE.NW. 00196 *> \endverbatim 00197 *> 00198 *> \param[out] T 00199 *> \verbatim 00200 *> T is COMPLEX*16 array, dimension (LDT,NW) 00201 *> \endverbatim 00202 *> 00203 *> \param[in] LDT 00204 *> \verbatim 00205 *> LDT is integer 00206 *> The leading dimension of T just as declared in the 00207 *> calling subroutine. NW .LE. LDT 00208 *> \endverbatim 00209 *> 00210 *> \param[in] NV 00211 *> \verbatim 00212 *> NV is integer 00213 *> The number of rows of work array WV available for 00214 *> workspace. NV.GE.NW. 00215 *> \endverbatim 00216 *> 00217 *> \param[out] WV 00218 *> \verbatim 00219 *> WV is COMPLEX*16 array, dimension (LDWV,NW) 00220 *> \endverbatim 00221 *> 00222 *> \param[in] LDWV 00223 *> \verbatim 00224 *> LDWV is integer 00225 *> The leading dimension of W just as declared in the 00226 *> calling subroutine. NW .LE. LDV 00227 *> \endverbatim 00228 *> 00229 *> \param[out] WORK 00230 *> \verbatim 00231 *> WORK is COMPLEX*16 array, dimension LWORK. 00232 *> On exit, WORK(1) is set to an estimate of the optimal value 00233 *> of LWORK for the given values of N, NW, KTOP and KBOT. 00234 *> \endverbatim 00235 *> 00236 *> \param[in] LWORK 00237 *> \verbatim 00238 *> LWORK is integer 00239 *> The dimension of the work array WORK. LWORK = 2*NW 00240 *> suffices, but greater efficiency may result from larger 00241 *> values of LWORK. 00242 *> 00243 *> If LWORK = -1, then a workspace query is assumed; ZLAQR2 00244 *> only estimates the optimal workspace size for the given 00245 *> values of N, NW, KTOP and KBOT. The estimate is returned 00246 *> in WORK(1). No error message related to LWORK is issued 00247 *> by XERBLA. Neither H nor Z are accessed. 00248 *> \endverbatim 00249 * 00250 * Authors: 00251 * ======== 00252 * 00253 *> \author Univ. of Tennessee 00254 *> \author Univ. of California Berkeley 00255 *> \author Univ. of Colorado Denver 00256 *> \author NAG Ltd. 00257 * 00258 *> \date November 2011 00259 * 00260 *> \ingroup complex16OTHERauxiliary 00261 * 00262 *> \par Contributors: 00263 * ================== 00264 *> 00265 *> Karen Braman and Ralph Byers, Department of Mathematics, 00266 *> University of Kansas, USA 00267 *> 00268 * ===================================================================== 00269 SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, 00270 $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, 00271 $ NV, WV, LDWV, WORK, LWORK ) 00272 * 00273 * -- LAPACK auxiliary routine (version 3.4.0) -- 00274 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00275 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00276 * November 2011 00277 * 00278 * .. Scalar Arguments .. 00279 INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, 00280 $ LDZ, LWORK, N, ND, NH, NS, NV, NW 00281 LOGICAL WANTT, WANTZ 00282 * .. 00283 * .. Array Arguments .. 00284 COMPLEX*16 H( LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ), 00285 $ WORK( * ), WV( LDWV, * ), Z( LDZ, * ) 00286 * .. 00287 * 00288 * ================================================================ 00289 * 00290 * .. Parameters .. 00291 COMPLEX*16 ZERO, ONE 00292 PARAMETER ( ZERO = ( 0.0d0, 0.0d0 ), 00293 $ ONE = ( 1.0d0, 0.0d0 ) ) 00294 DOUBLE PRECISION RZERO, RONE 00295 PARAMETER ( RZERO = 0.0d0, RONE = 1.0d0 ) 00296 * .. 00297 * .. Local Scalars .. 00298 COMPLEX*16 BETA, CDUM, S, TAU 00299 DOUBLE PRECISION FOO, SAFMAX, SAFMIN, SMLNUM, ULP 00300 INTEGER I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN, 00301 $ KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWKOPT 00302 * .. 00303 * .. External Functions .. 00304 DOUBLE PRECISION DLAMCH 00305 EXTERNAL DLAMCH 00306 * .. 00307 * .. External Subroutines .. 00308 EXTERNAL DLABAD, ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, 00309 $ ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR 00310 * .. 00311 * .. Intrinsic Functions .. 00312 INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN 00313 * .. 00314 * .. Statement Functions .. 00315 DOUBLE PRECISION CABS1 00316 * .. 00317 * .. Statement Function definitions .. 00318 CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) ) 00319 * .. 00320 * .. Executable Statements .. 00321 * 00322 * ==== Estimate optimal workspace. ==== 00323 * 00324 JW = MIN( NW, KBOT-KTOP+1 ) 00325 IF( JW.LE.2 ) THEN 00326 LWKOPT = 1 00327 ELSE 00328 * 00329 * ==== Workspace query call to ZGEHRD ==== 00330 * 00331 CALL ZGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO ) 00332 LWK1 = INT( WORK( 1 ) ) 00333 * 00334 * ==== Workspace query call to ZUNMHR ==== 00335 * 00336 CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, 00337 $ WORK, -1, INFO ) 00338 LWK2 = INT( WORK( 1 ) ) 00339 * 00340 * ==== Optimal workspace ==== 00341 * 00342 LWKOPT = JW + MAX( LWK1, LWK2 ) 00343 END IF 00344 * 00345 * ==== Quick return in case of workspace query. ==== 00346 * 00347 IF( LWORK.EQ.-1 ) THEN 00348 WORK( 1 ) = DCMPLX( LWKOPT, 0 ) 00349 RETURN 00350 END IF 00351 * 00352 * ==== Nothing to do ... 00353 * ... for an empty active block ... ==== 00354 NS = 0 00355 ND = 0 00356 WORK( 1 ) = ONE 00357 IF( KTOP.GT.KBOT ) 00358 $ RETURN 00359 * ... nor for an empty deflation window. ==== 00360 IF( NW.LT.1 ) 00361 $ RETURN 00362 * 00363 * ==== Machine constants ==== 00364 * 00365 SAFMIN = DLAMCH( 'SAFE MINIMUM' ) 00366 SAFMAX = RONE / SAFMIN 00367 CALL DLABAD( SAFMIN, SAFMAX ) 00368 ULP = DLAMCH( 'PRECISION' ) 00369 SMLNUM = SAFMIN*( DBLE( N ) / ULP ) 00370 * 00371 * ==== Setup deflation window ==== 00372 * 00373 JW = MIN( NW, KBOT-KTOP+1 ) 00374 KWTOP = KBOT - JW + 1 00375 IF( KWTOP.EQ.KTOP ) THEN 00376 S = ZERO 00377 ELSE 00378 S = H( KWTOP, KWTOP-1 ) 00379 END IF 00380 * 00381 IF( KBOT.EQ.KWTOP ) THEN 00382 * 00383 * ==== 1-by-1 deflation window: not much to do ==== 00384 * 00385 SH( KWTOP ) = H( KWTOP, KWTOP ) 00386 NS = 1 00387 ND = 0 00388 IF( CABS1( S ).LE.MAX( SMLNUM, ULP*CABS1( H( KWTOP, 00389 $ KWTOP ) ) ) ) THEN 00390 NS = 0 00391 ND = 1 00392 IF( KWTOP.GT.KTOP ) 00393 $ H( KWTOP, KWTOP-1 ) = ZERO 00394 END IF 00395 WORK( 1 ) = ONE 00396 RETURN 00397 END IF 00398 * 00399 * ==== Convert to spike-triangular form. (In case of a 00400 * . rare QR failure, this routine continues to do 00401 * . aggressive early deflation using that part of 00402 * . the deflation window that converged using INFQR 00403 * . here and there to keep track.) ==== 00404 * 00405 CALL ZLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT ) 00406 CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 ) 00407 * 00408 CALL ZLASET( 'A', JW, JW, ZERO, ONE, V, LDV ) 00409 CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1, 00410 $ JW, V, LDV, INFQR ) 00411 * 00412 * ==== Deflation detection loop ==== 00413 * 00414 NS = JW 00415 ILST = INFQR + 1 00416 DO 10 KNT = INFQR + 1, JW 00417 * 00418 * ==== Small spike tip deflation test ==== 00419 * 00420 FOO = CABS1( T( NS, NS ) ) 00421 IF( FOO.EQ.RZERO ) 00422 $ FOO = CABS1( S ) 00423 IF( CABS1( S )*CABS1( V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) 00424 $ THEN 00425 * 00426 * ==== One more converged eigenvalue ==== 00427 * 00428 NS = NS - 1 00429 ELSE 00430 * 00431 * ==== One undeflatable eigenvalue. Move it up out of the 00432 * . way. (ZTREXC can not fail in this case.) ==== 00433 * 00434 IFST = NS 00435 CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO ) 00436 ILST = ILST + 1 00437 END IF 00438 10 CONTINUE 00439 * 00440 * ==== Return to Hessenberg form ==== 00441 * 00442 IF( NS.EQ.0 ) 00443 $ S = ZERO 00444 * 00445 IF( NS.LT.JW ) THEN 00446 * 00447 * ==== sorting the diagonal of T improves accuracy for 00448 * . graded matrices. ==== 00449 * 00450 DO 30 I = INFQR + 1, NS 00451 IFST = I 00452 DO 20 J = I + 1, NS 00453 IF( CABS1( T( J, J ) ).GT.CABS1( T( IFST, IFST ) ) ) 00454 $ IFST = J 00455 20 CONTINUE 00456 ILST = I 00457 IF( IFST.NE.ILST ) 00458 $ CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO ) 00459 30 CONTINUE 00460 END IF 00461 * 00462 * ==== Restore shift/eigenvalue array from T ==== 00463 * 00464 DO 40 I = INFQR + 1, JW 00465 SH( KWTOP+I-1 ) = T( I, I ) 00466 40 CONTINUE 00467 * 00468 * 00469 IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN 00470 IF( NS.GT.1 .AND. S.NE.ZERO ) THEN 00471 * 00472 * ==== Reflect spike back into lower triangle ==== 00473 * 00474 CALL ZCOPY( NS, V, LDV, WORK, 1 ) 00475 DO 50 I = 1, NS 00476 WORK( I ) = DCONJG( WORK( I ) ) 00477 50 CONTINUE 00478 BETA = WORK( 1 ) 00479 CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU ) 00480 WORK( 1 ) = ONE 00481 * 00482 CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT ) 00483 * 00484 CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT, 00485 $ WORK( JW+1 ) ) 00486 CALL ZLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, 00487 $ WORK( JW+1 ) ) 00488 CALL ZLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, 00489 $ WORK( JW+1 ) ) 00490 * 00491 CALL ZGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), 00492 $ LWORK-JW, INFO ) 00493 END IF 00494 * 00495 * ==== Copy updated reduced window into place ==== 00496 * 00497 IF( KWTOP.GT.1 ) 00498 $ H( KWTOP, KWTOP-1 ) = S*DCONJG( V( 1, 1 ) ) 00499 CALL ZLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH ) 00500 CALL ZCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ), 00501 $ LDH+1 ) 00502 * 00503 * ==== Accumulate orthogonal matrix in order update 00504 * . H and Z, if requested. ==== 00505 * 00506 IF( NS.GT.1 .AND. S.NE.ZERO ) 00507 $ CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, 00508 $ WORK( JW+1 ), LWORK-JW, INFO ) 00509 * 00510 * ==== Update vertical slab in H ==== 00511 * 00512 IF( WANTT ) THEN 00513 LTOP = 1 00514 ELSE 00515 LTOP = KTOP 00516 END IF 00517 DO 60 KROW = LTOP, KWTOP - 1, NV 00518 KLN = MIN( NV, KWTOP-KROW ) 00519 CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), 00520 $ LDH, V, LDV, ZERO, WV, LDWV ) 00521 CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH ) 00522 60 CONTINUE 00523 * 00524 * ==== Update horizontal slab in H ==== 00525 * 00526 IF( WANTT ) THEN 00527 DO 70 KCOL = KBOT + 1, N, NH 00528 KLN = MIN( NH, N-KCOL+1 ) 00529 CALL ZGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV, 00530 $ H( KWTOP, KCOL ), LDH, ZERO, T, LDT ) 00531 CALL ZLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ), 00532 $ LDH ) 00533 70 CONTINUE 00534 END IF 00535 * 00536 * ==== Update vertical slab in Z ==== 00537 * 00538 IF( WANTZ ) THEN 00539 DO 80 KROW = ILOZ, IHIZ, NV 00540 KLN = MIN( NV, IHIZ-KROW+1 ) 00541 CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), 00542 $ LDZ, V, LDV, ZERO, WV, LDWV ) 00543 CALL ZLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), 00544 $ LDZ ) 00545 80 CONTINUE 00546 END IF 00547 END IF 00548 * 00549 * ==== Return the number of deflations ... ==== 00550 * 00551 ND = JW - NS 00552 * 00553 * ==== ... and the number of shifts. (Subtracting 00554 * . INFQR from the spike length takes care 00555 * . of the case of a rare QR failure while 00556 * . calculating eigenvalues of the deflation 00557 * . window.) ==== 00558 * 00559 NS = NS - INFQR 00560 * 00561 * ==== Return optimal workspace. ==== 00562 * 00563 WORK( 1 ) = DCMPLX( LWKOPT, 0 ) 00564 * 00565 * ==== End of ZLAQR2 ==== 00566 * 00567 END