![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLALS0 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CLALS0 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clals0.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clals0.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clals0.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, 00022 * PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, 00023 * POLES, DIFL, DIFR, Z, K, C, S, RWORK, INFO ) 00024 * 00025 * .. Scalar Arguments .. 00026 * INTEGER GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL, 00027 * $ LDGNUM, NL, NR, NRHS, SQRE 00028 * REAL C, S 00029 * .. 00030 * .. Array Arguments .. 00031 * INTEGER GIVCOL( LDGCOL, * ), PERM( * ) 00032 * REAL DIFL( * ), DIFR( LDGNUM, * ), 00033 * $ GIVNUM( LDGNUM, * ), POLES( LDGNUM, * ), 00034 * $ RWORK( * ), Z( * ) 00035 * COMPLEX B( LDB, * ), BX( LDBX, * ) 00036 * .. 00037 * 00038 * 00039 *> \par Purpose: 00040 * ============= 00041 *> 00042 *> \verbatim 00043 *> 00044 *> CLALS0 applies back the multiplying factors of either the left or the 00045 *> right singular vector matrix of a diagonal matrix appended by a row 00046 *> to the right hand side matrix B in solving the least squares problem 00047 *> using the divide-and-conquer SVD approach. 00048 *> 00049 *> For the left singular vector matrix, three types of orthogonal 00050 *> matrices are involved: 00051 *> 00052 *> (1L) Givens rotations: the number of such rotations is GIVPTR; the 00053 *> pairs of columns/rows they were applied to are stored in GIVCOL; 00054 *> and the C- and S-values of these rotations are stored in GIVNUM. 00055 *> 00056 *> (2L) Permutation. The (NL+1)-st row of B is to be moved to the first 00057 *> row, and for J=2:N, PERM(J)-th row of B is to be moved to the 00058 *> J-th row. 00059 *> 00060 *> (3L) The left singular vector matrix of the remaining matrix. 00061 *> 00062 *> For the right singular vector matrix, four types of orthogonal 00063 *> matrices are involved: 00064 *> 00065 *> (1R) The right singular vector matrix of the remaining matrix. 00066 *> 00067 *> (2R) If SQRE = 1, one extra Givens rotation to generate the right 00068 *> null space. 00069 *> 00070 *> (3R) The inverse transformation of (2L). 00071 *> 00072 *> (4R) The inverse transformation of (1L). 00073 *> \endverbatim 00074 * 00075 * Arguments: 00076 * ========== 00077 * 00078 *> \param[in] ICOMPQ 00079 *> \verbatim 00080 *> ICOMPQ is INTEGER 00081 *> Specifies whether singular vectors are to be computed in 00082 *> factored form: 00083 *> = 0: Left singular vector matrix. 00084 *> = 1: Right singular vector matrix. 00085 *> \endverbatim 00086 *> 00087 *> \param[in] NL 00088 *> \verbatim 00089 *> NL is INTEGER 00090 *> The row dimension of the upper block. NL >= 1. 00091 *> \endverbatim 00092 *> 00093 *> \param[in] NR 00094 *> \verbatim 00095 *> NR is INTEGER 00096 *> The row dimension of the lower block. NR >= 1. 00097 *> \endverbatim 00098 *> 00099 *> \param[in] SQRE 00100 *> \verbatim 00101 *> SQRE is INTEGER 00102 *> = 0: the lower block is an NR-by-NR square matrix. 00103 *> = 1: the lower block is an NR-by-(NR+1) rectangular matrix. 00104 *> 00105 *> The bidiagonal matrix has row dimension N = NL + NR + 1, 00106 *> and column dimension M = N + SQRE. 00107 *> \endverbatim 00108 *> 00109 *> \param[in] NRHS 00110 *> \verbatim 00111 *> NRHS is INTEGER 00112 *> The number of columns of B and BX. NRHS must be at least 1. 00113 *> \endverbatim 00114 *> 00115 *> \param[in,out] B 00116 *> \verbatim 00117 *> B is COMPLEX array, dimension ( LDB, NRHS ) 00118 *> On input, B contains the right hand sides of the least 00119 *> squares problem in rows 1 through M. On output, B contains 00120 *> the solution X in rows 1 through N. 00121 *> \endverbatim 00122 *> 00123 *> \param[in] LDB 00124 *> \verbatim 00125 *> LDB is INTEGER 00126 *> The leading dimension of B. LDB must be at least 00127 *> max(1,MAX( M, N ) ). 00128 *> \endverbatim 00129 *> 00130 *> \param[out] BX 00131 *> \verbatim 00132 *> BX is COMPLEX array, dimension ( LDBX, NRHS ) 00133 *> \endverbatim 00134 *> 00135 *> \param[in] LDBX 00136 *> \verbatim 00137 *> LDBX is INTEGER 00138 *> The leading dimension of BX. 00139 *> \endverbatim 00140 *> 00141 *> \param[in] PERM 00142 *> \verbatim 00143 *> PERM is INTEGER array, dimension ( N ) 00144 *> The permutations (from deflation and sorting) applied 00145 *> to the two blocks. 00146 *> \endverbatim 00147 *> 00148 *> \param[in] GIVPTR 00149 *> \verbatim 00150 *> GIVPTR is INTEGER 00151 *> The number of Givens rotations which took place in this 00152 *> subproblem. 00153 *> \endverbatim 00154 *> 00155 *> \param[in] GIVCOL 00156 *> \verbatim 00157 *> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 ) 00158 *> Each pair of numbers indicates a pair of rows/columns 00159 *> involved in a Givens rotation. 00160 *> \endverbatim 00161 *> 00162 *> \param[in] LDGCOL 00163 *> \verbatim 00164 *> LDGCOL is INTEGER 00165 *> The leading dimension of GIVCOL, must be at least N. 00166 *> \endverbatim 00167 *> 00168 *> \param[in] GIVNUM 00169 *> \verbatim 00170 *> GIVNUM is REAL array, dimension ( LDGNUM, 2 ) 00171 *> Each number indicates the C or S value used in the 00172 *> corresponding Givens rotation. 00173 *> \endverbatim 00174 *> 00175 *> \param[in] LDGNUM 00176 *> \verbatim 00177 *> LDGNUM is INTEGER 00178 *> The leading dimension of arrays DIFR, POLES and 00179 *> GIVNUM, must be at least K. 00180 *> \endverbatim 00181 *> 00182 *> \param[in] POLES 00183 *> \verbatim 00184 *> POLES is REAL array, dimension ( LDGNUM, 2 ) 00185 *> On entry, POLES(1:K, 1) contains the new singular 00186 *> values obtained from solving the secular equation, and 00187 *> POLES(1:K, 2) is an array containing the poles in the secular 00188 *> equation. 00189 *> \endverbatim 00190 *> 00191 *> \param[in] DIFL 00192 *> \verbatim 00193 *> DIFL is REAL array, dimension ( K ). 00194 *> On entry, DIFL(I) is the distance between I-th updated 00195 *> (undeflated) singular value and the I-th (undeflated) old 00196 *> singular value. 00197 *> \endverbatim 00198 *> 00199 *> \param[in] DIFR 00200 *> \verbatim 00201 *> DIFR is REAL array, dimension ( LDGNUM, 2 ). 00202 *> On entry, DIFR(I, 1) contains the distances between I-th 00203 *> updated (undeflated) singular value and the I+1-th 00204 *> (undeflated) old singular value. And DIFR(I, 2) is the 00205 *> normalizing factor for the I-th right singular vector. 00206 *> \endverbatim 00207 *> 00208 *> \param[in] Z 00209 *> \verbatim 00210 *> Z is REAL array, dimension ( K ) 00211 *> Contain the components of the deflation-adjusted updating row 00212 *> vector. 00213 *> \endverbatim 00214 *> 00215 *> \param[in] K 00216 *> \verbatim 00217 *> K is INTEGER 00218 *> Contains the dimension of the non-deflated matrix, 00219 *> This is the order of the related secular equation. 1 <= K <=N. 00220 *> \endverbatim 00221 *> 00222 *> \param[in] C 00223 *> \verbatim 00224 *> C is REAL 00225 *> C contains garbage if SQRE =0 and the C-value of a Givens 00226 *> rotation related to the right null space if SQRE = 1. 00227 *> \endverbatim 00228 *> 00229 *> \param[in] S 00230 *> \verbatim 00231 *> S is REAL 00232 *> S contains garbage if SQRE =0 and the S-value of a Givens 00233 *> rotation related to the right null space if SQRE = 1. 00234 *> \endverbatim 00235 *> 00236 *> \param[out] RWORK 00237 *> \verbatim 00238 *> RWORK is REAL array, dimension 00239 *> ( K*(1+NRHS) + 2*NRHS ) 00240 *> \endverbatim 00241 *> 00242 *> \param[out] INFO 00243 *> \verbatim 00244 *> INFO is INTEGER 00245 *> = 0: successful exit. 00246 *> < 0: if INFO = -i, the i-th argument had an illegal value. 00247 *> \endverbatim 00248 * 00249 * Authors: 00250 * ======== 00251 * 00252 *> \author Univ. of Tennessee 00253 *> \author Univ. of California Berkeley 00254 *> \author Univ. of Colorado Denver 00255 *> \author NAG Ltd. 00256 * 00257 *> \date November 2011 00258 * 00259 *> \ingroup complexOTHERcomputational 00260 * 00261 *> \par Contributors: 00262 * ================== 00263 *> 00264 *> Ming Gu and Ren-Cang Li, Computer Science Division, University of 00265 *> California at Berkeley, USA \n 00266 *> Osni Marques, LBNL/NERSC, USA \n 00267 * 00268 * ===================================================================== 00269 SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, 00270 $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, 00271 $ POLES, DIFL, DIFR, Z, K, C, S, RWORK, INFO ) 00272 * 00273 * -- LAPACK computational 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 GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL, 00280 $ LDGNUM, NL, NR, NRHS, SQRE 00281 REAL C, S 00282 * .. 00283 * .. Array Arguments .. 00284 INTEGER GIVCOL( LDGCOL, * ), PERM( * ) 00285 REAL DIFL( * ), DIFR( LDGNUM, * ), 00286 $ GIVNUM( LDGNUM, * ), POLES( LDGNUM, * ), 00287 $ RWORK( * ), Z( * ) 00288 COMPLEX B( LDB, * ), BX( LDBX, * ) 00289 * .. 00290 * 00291 * ===================================================================== 00292 * 00293 * .. Parameters .. 00294 REAL ONE, ZERO, NEGONE 00295 PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0, NEGONE = -1.0E0 ) 00296 * .. 00297 * .. Local Scalars .. 00298 INTEGER I, J, JCOL, JROW, M, N, NLP1 00299 REAL DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, TEMP 00300 * .. 00301 * .. External Subroutines .. 00302 EXTERNAL CCOPY, CLACPY, CLASCL, CSROT, CSSCAL, SGEMV, 00303 $ XERBLA 00304 * .. 00305 * .. External Functions .. 00306 REAL SLAMC3, SNRM2 00307 EXTERNAL SLAMC3, SNRM2 00308 * .. 00309 * .. Intrinsic Functions .. 00310 INTRINSIC AIMAG, CMPLX, MAX, REAL 00311 * .. 00312 * .. Executable Statements .. 00313 * 00314 * Test the input parameters. 00315 * 00316 INFO = 0 00317 * 00318 IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN 00319 INFO = -1 00320 ELSE IF( NL.LT.1 ) THEN 00321 INFO = -2 00322 ELSE IF( NR.LT.1 ) THEN 00323 INFO = -3 00324 ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN 00325 INFO = -4 00326 END IF 00327 * 00328 N = NL + NR + 1 00329 * 00330 IF( NRHS.LT.1 ) THEN 00331 INFO = -5 00332 ELSE IF( LDB.LT.N ) THEN 00333 INFO = -7 00334 ELSE IF( LDBX.LT.N ) THEN 00335 INFO = -9 00336 ELSE IF( GIVPTR.LT.0 ) THEN 00337 INFO = -11 00338 ELSE IF( LDGCOL.LT.N ) THEN 00339 INFO = -13 00340 ELSE IF( LDGNUM.LT.N ) THEN 00341 INFO = -15 00342 ELSE IF( K.LT.1 ) THEN 00343 INFO = -20 00344 END IF 00345 IF( INFO.NE.0 ) THEN 00346 CALL XERBLA( 'CLALS0', -INFO ) 00347 RETURN 00348 END IF 00349 * 00350 M = N + SQRE 00351 NLP1 = NL + 1 00352 * 00353 IF( ICOMPQ.EQ.0 ) THEN 00354 * 00355 * Apply back orthogonal transformations from the left. 00356 * 00357 * Step (1L): apply back the Givens rotations performed. 00358 * 00359 DO 10 I = 1, GIVPTR 00360 CALL CSROT( NRHS, B( GIVCOL( I, 2 ), 1 ), LDB, 00361 $ B( GIVCOL( I, 1 ), 1 ), LDB, GIVNUM( I, 2 ), 00362 $ GIVNUM( I, 1 ) ) 00363 10 CONTINUE 00364 * 00365 * Step (2L): permute rows of B. 00366 * 00367 CALL CCOPY( NRHS, B( NLP1, 1 ), LDB, BX( 1, 1 ), LDBX ) 00368 DO 20 I = 2, N 00369 CALL CCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), LDBX ) 00370 20 CONTINUE 00371 * 00372 * Step (3L): apply the inverse of the left singular vector 00373 * matrix to BX. 00374 * 00375 IF( K.EQ.1 ) THEN 00376 CALL CCOPY( NRHS, BX, LDBX, B, LDB ) 00377 IF( Z( 1 ).LT.ZERO ) THEN 00378 CALL CSSCAL( NRHS, NEGONE, B, LDB ) 00379 END IF 00380 ELSE 00381 DO 100 J = 1, K 00382 DIFLJ = DIFL( J ) 00383 DJ = POLES( J, 1 ) 00384 DSIGJ = -POLES( J, 2 ) 00385 IF( J.LT.K ) THEN 00386 DIFRJ = -DIFR( J, 1 ) 00387 DSIGJP = -POLES( J+1, 2 ) 00388 END IF 00389 IF( ( Z( J ).EQ.ZERO ) .OR. ( POLES( J, 2 ).EQ.ZERO ) ) 00390 $ THEN 00391 RWORK( J ) = ZERO 00392 ELSE 00393 RWORK( J ) = -POLES( J, 2 )*Z( J ) / DIFLJ / 00394 $ ( POLES( J, 2 )+DJ ) 00395 END IF 00396 DO 30 I = 1, J - 1 00397 IF( ( Z( I ).EQ.ZERO ) .OR. 00398 $ ( POLES( I, 2 ).EQ.ZERO ) ) THEN 00399 RWORK( I ) = ZERO 00400 ELSE 00401 RWORK( I ) = POLES( I, 2 )*Z( I ) / 00402 $ ( SLAMC3( POLES( I, 2 ), DSIGJ )- 00403 $ DIFLJ ) / ( POLES( I, 2 )+DJ ) 00404 END IF 00405 30 CONTINUE 00406 DO 40 I = J + 1, K 00407 IF( ( Z( I ).EQ.ZERO ) .OR. 00408 $ ( POLES( I, 2 ).EQ.ZERO ) ) THEN 00409 RWORK( I ) = ZERO 00410 ELSE 00411 RWORK( I ) = POLES( I, 2 )*Z( I ) / 00412 $ ( SLAMC3( POLES( I, 2 ), DSIGJP )+ 00413 $ DIFRJ ) / ( POLES( I, 2 )+DJ ) 00414 END IF 00415 40 CONTINUE 00416 RWORK( 1 ) = NEGONE 00417 TEMP = SNRM2( K, RWORK, 1 ) 00418 * 00419 * Since B and BX are complex, the following call to SGEMV 00420 * is performed in two steps (real and imaginary parts). 00421 * 00422 * CALL SGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, ZERO, 00423 * $ B( J, 1 ), LDB ) 00424 * 00425 I = K + NRHS*2 00426 DO 60 JCOL = 1, NRHS 00427 DO 50 JROW = 1, K 00428 I = I + 1 00429 RWORK( I ) = REAL( BX( JROW, JCOL ) ) 00430 50 CONTINUE 00431 60 CONTINUE 00432 CALL SGEMV( 'T', K, NRHS, ONE, RWORK( 1+K+NRHS*2 ), K, 00433 $ RWORK( 1 ), 1, ZERO, RWORK( 1+K ), 1 ) 00434 I = K + NRHS*2 00435 DO 80 JCOL = 1, NRHS 00436 DO 70 JROW = 1, K 00437 I = I + 1 00438 RWORK( I ) = AIMAG( BX( JROW, JCOL ) ) 00439 70 CONTINUE 00440 80 CONTINUE 00441 CALL SGEMV( 'T', K, NRHS, ONE, RWORK( 1+K+NRHS*2 ), K, 00442 $ RWORK( 1 ), 1, ZERO, RWORK( 1+K+NRHS ), 1 ) 00443 DO 90 JCOL = 1, NRHS 00444 B( J, JCOL ) = CMPLX( RWORK( JCOL+K ), 00445 $ RWORK( JCOL+K+NRHS ) ) 00446 90 CONTINUE 00447 CALL CLASCL( 'G', 0, 0, TEMP, ONE, 1, NRHS, B( J, 1 ), 00448 $ LDB, INFO ) 00449 100 CONTINUE 00450 END IF 00451 * 00452 * Move the deflated rows of BX to B also. 00453 * 00454 IF( K.LT.MAX( M, N ) ) 00455 $ CALL CLACPY( 'A', N-K, NRHS, BX( K+1, 1 ), LDBX, 00456 $ B( K+1, 1 ), LDB ) 00457 ELSE 00458 * 00459 * Apply back the right orthogonal transformations. 00460 * 00461 * Step (1R): apply back the new right singular vector matrix 00462 * to B. 00463 * 00464 IF( K.EQ.1 ) THEN 00465 CALL CCOPY( NRHS, B, LDB, BX, LDBX ) 00466 ELSE 00467 DO 180 J = 1, K 00468 DSIGJ = POLES( J, 2 ) 00469 IF( Z( J ).EQ.ZERO ) THEN 00470 RWORK( J ) = ZERO 00471 ELSE 00472 RWORK( J ) = -Z( J ) / DIFL( J ) / 00473 $ ( DSIGJ+POLES( J, 1 ) ) / DIFR( J, 2 ) 00474 END IF 00475 DO 110 I = 1, J - 1 00476 IF( Z( J ).EQ.ZERO ) THEN 00477 RWORK( I ) = ZERO 00478 ELSE 00479 RWORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, -POLES( I+1, 00480 $ 2 ) )-DIFR( I, 1 ) ) / 00481 $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 ) 00482 END IF 00483 110 CONTINUE 00484 DO 120 I = J + 1, K 00485 IF( Z( J ).EQ.ZERO ) THEN 00486 RWORK( I ) = ZERO 00487 ELSE 00488 RWORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, -POLES( I, 00489 $ 2 ) )-DIFL( I ) ) / 00490 $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 ) 00491 END IF 00492 120 CONTINUE 00493 * 00494 * Since B and BX are complex, the following call to SGEMV 00495 * is performed in two steps (real and imaginary parts). 00496 * 00497 * CALL SGEMV( 'T', K, NRHS, ONE, B, LDB, WORK, 1, ZERO, 00498 * $ BX( J, 1 ), LDBX ) 00499 * 00500 I = K + NRHS*2 00501 DO 140 JCOL = 1, NRHS 00502 DO 130 JROW = 1, K 00503 I = I + 1 00504 RWORK( I ) = REAL( B( JROW, JCOL ) ) 00505 130 CONTINUE 00506 140 CONTINUE 00507 CALL SGEMV( 'T', K, NRHS, ONE, RWORK( 1+K+NRHS*2 ), K, 00508 $ RWORK( 1 ), 1, ZERO, RWORK( 1+K ), 1 ) 00509 I = K + NRHS*2 00510 DO 160 JCOL = 1, NRHS 00511 DO 150 JROW = 1, K 00512 I = I + 1 00513 RWORK( I ) = AIMAG( B( JROW, JCOL ) ) 00514 150 CONTINUE 00515 160 CONTINUE 00516 CALL SGEMV( 'T', K, NRHS, ONE, RWORK( 1+K+NRHS*2 ), K, 00517 $ RWORK( 1 ), 1, ZERO, RWORK( 1+K+NRHS ), 1 ) 00518 DO 170 JCOL = 1, NRHS 00519 BX( J, JCOL ) = CMPLX( RWORK( JCOL+K ), 00520 $ RWORK( JCOL+K+NRHS ) ) 00521 170 CONTINUE 00522 180 CONTINUE 00523 END IF 00524 * 00525 * Step (2R): if SQRE = 1, apply back the rotation that is 00526 * related to the right null space of the subproblem. 00527 * 00528 IF( SQRE.EQ.1 ) THEN 00529 CALL CCOPY( NRHS, B( M, 1 ), LDB, BX( M, 1 ), LDBX ) 00530 CALL CSROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, S ) 00531 END IF 00532 IF( K.LT.MAX( M, N ) ) 00533 $ CALL CLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, 00534 $ BX( K+1, 1 ), LDBX ) 00535 * 00536 * Step (3R): permute rows of B. 00537 * 00538 CALL CCOPY( NRHS, BX( 1, 1 ), LDBX, B( NLP1, 1 ), LDB ) 00539 IF( SQRE.EQ.1 ) THEN 00540 CALL CCOPY( NRHS, BX( M, 1 ), LDBX, B( M, 1 ), LDB ) 00541 END IF 00542 DO 190 I = 2, N 00543 CALL CCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), LDB ) 00544 190 CONTINUE 00545 * 00546 * Step (4R): apply back the Givens rotations performed. 00547 * 00548 DO 200 I = GIVPTR, 1, -1 00549 CALL CSROT( NRHS, B( GIVCOL( I, 2 ), 1 ), LDB, 00550 $ B( GIVCOL( I, 1 ), 1 ), LDB, GIVNUM( I, 2 ), 00551 $ -GIVNUM( I, 1 ) ) 00552 200 CONTINUE 00553 END IF 00554 * 00555 RETURN 00556 * 00557 * End of CLALS0 00558 * 00559 END