CLALSA  -  i  an  itermediate  step  in  solving the least
       squares problem by computing the SVD  of  the  coefficient
       matrix  in compact form (The singular vectors are computed
       as products of simple orthorgonal matrices.)


SYNOPSIS

       SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS,  B,  LDB,  BX,
                          LDBX,  U,  LDU,  VT,  K, DIFL, DIFR, Z,
                          POLES, GIVPTR,  GIVCOL,  LDGCOL,  PERM,
                          GIVNUM, C, S, RWORK, IWORK, INFO )

           INTEGER        ICOMPQ,  INFO,  LDB, LDBX, LDGCOL, LDU,
                          N, NRHS, SMLSIZ

           INTEGER        GIVCOL(  LDGCOL,  *  ),  GIVPTR(  *  ),
                          IWORK( * ), K( * ), PERM( LDGCOL, * )

           REAL           C( * ), DIFL( LDU, * ), DIFR( LDU, * ),
                          GIVNUM( LDU, *  ),  POLES(  LDU,  *  ),
                          RWORK(  *  ),  S( * ), U( LDU, * ), VT(
                          LDU, * ), Z( LDU, * )

           COMPLEX        B( LDB, * ), BX( LDBX, * )


PURPOSE

       CLALSA is an itermediate step in solving the least squares
       problem  by computing the SVD of the coefficient matrix in
       compact form (The singular vectors are computed  as  prod­
       ucts  of  simple  orthorgonal  matrices.).  If ICOMPQ = 0,
       CLALSA applies the inverse of  the  left  singular  vector
       matrix  of  an  upper  bidiagonal matrix to the right hand
       side; and if ICOMPQ = 1, CLALSA applies the right singular
       vector  matrix to the right hand side. The singular vector
       matrices were generated in compact form by CLALSA.


ARGUMENTS

       ICOMPQ (input) INTEGER Specifies whether the left  or  the
       right  singular vector matrix is involved.  = 0: Left sin­
       gular vector matrix
       = 1: Right singular vector matrix

       SMLSIZ (input) INTEGER The maximum size of the subproblems
       at the bottom of the computation tree.

       N      (input) INTEGER
              The row and column dimensions of the upper bidiago­
              nal matrix.

       NRHS   (input) INTEGER
              The number of columns of B and BX. NRHS must be  at
              least 1.

              On  input,  B  contains the right hand sides of the
              least squares problem in rows 1 through M. On  out­
              put, B contains the solution X in rows 1 through N.

       LDB    (input) INTEGER
              The leading dimension of B in the  calling  subpro­
              gram.  LDB must be at least max(1,MAX( M, N ) ).

       BX     (output) COMPLEX array, dimension ( LDBX, NRHS )
              On  exit,  the result of applying the left or right
              singular vector matrix to B.

       LDBX   (input) INTEGER
              The leading dimension of BX.

       U      (input) REAL array, dimension ( LDU, SMLSIZ ).
              On entry,  U  contains  the  left  singular  vector
              matrices of all subproblems at the bottom level.

       LDU    (input) INTEGER, LDU = > N.
              The  leading dimension of arrays U, VT, DIFL, DIFR,
              POLES, GIVNUM, and Z.

       VT     (input) REAL array, dimension ( LDU, SMLSIZ+1 ).
              On entry, VT' contains the  right  singular  vector
              matrices of all subproblems at the bottom level.

       K      (input) INTEGER array, dimension ( N ).

       DIFL   (input) REAL array, dimension ( LDU, NLVL ).
              where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.

       DIFR   (input) REAL array, dimension ( LDU, 2 * NLVL ).
              On  entry,  DIFL(*, I) and DIFR(*, 2 * I -1) record
              distances between singular values on the I-th level
              and  singular  values  on  the (I -1)-th level, and
              DIFR(*, 2 * I) record the  normalizing  factors  of
              the  right singular vectors matrices of subproblems
              on I-th level.

       Z      (input) REAL array, dimension ( LDU, NLVL ).
              On entry, Z(1, I) contains the  components  of  the
              deflation-  adjusted  updating  row vector for sub­
              problems on the I-th level.

       POLES  (input) REAL array, dimension ( LDU, 2 * NLVL ).
              On entry, POLES(*, 2 * I -1: 2 *  I)  contains  the
              new and old singular values involved in the secular
              equations on the I-th level.

              GIVPTR (input) INTEGER array, dimension ( N ).   On
              entry,  GIVPTR(  I  )  records the number of Givens
              rotations performed on  the  I-th  problem  on  the


              GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2
              * NLVL ).  On entry, for each I, GIVCOL(*, 2 * I  -
              1: 2 * I) records the locations of Givens rotations
              performed on the  I-th  level  on  the  computation
              tree.

              LDGCOL  (input) INTEGER, LDGCOL = > N.  The leading
              dimension of arrays GIVCOL and PERM.

       PERM   (input) INTEGER array, dimension ( LDGCOL, NLVL ).
              On entry, PERM(*, I) records permutations  done  on
              the I-th level of the computation tree.

              GIVNUM  (input)  REAL  array,  dimension ( LDU, 2 *
              NLVL ).  On entry, GIVNUM(*, 2  *I  -1  :  2  *  I)
              records  the  C-  and S- values of Givens rotations
              performed on the  I-th  level  on  the  computation
              tree.

       C      (input) REAL array, dimension ( N ).
              On  entry, if the I-th subproblem is not square, C(
              I ) contains  the  C-value  of  a  Givens  rotation
              related  to  the  right null space of the I-th sub­
              problem.

       S      (input) REAL array, dimension ( N ).
              On entry, if the I-th subproblem is not square,  S(
              I  )  contains  the  S-value  of  a Givens rotation
              related to the right null space of  the  I-th  sub­
              problem.

       RWORK  (workspace) REAL array, dimension at least
              max ( N, (SMLSZ+1)*NRHS*3 ).

       IWORK  (workspace) INTEGER array.
              The dimension must be at least 3 * N

       INFO   (output) INTEGER
              = 0:  successful exit.
              <  0:  if INFO = -i, the i-th argument had an ille­
              gal value.


FURTHER DETAILS

       Based on contributions by
          Ming Gu and Ren-Cang  Li,  Computer  Science  Division,
       University of
            California at Berkeley, USA
          Osni Marques, LBNL/NERSC, USA


Man(1) output converted with man2html