Contents


NAME

     zlarz - applie a complex elementary reflector H to a complex
     M-by-N matrix C, from either the left or the right

SYNOPSIS

     SUBROUTINE ZLARZ(SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK)

     CHARACTER * 1 SIDE
     DOUBLE COMPLEX TAU
     DOUBLE COMPLEX V(*), C(LDC,*), WORK(*)
     INTEGER M, N, L, INCV, LDC

     SUBROUTINE ZLARZ_64(SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK)

     CHARACTER * 1 SIDE
     DOUBLE COMPLEX TAU
     DOUBLE COMPLEX V(*), C(LDC,*), WORK(*)
     INTEGER*8 M, N, L, INCV, LDC

  F95 INTERFACE
     SUBROUTINE LARZ(SIDE, [M], [N], L, V, [INCV], TAU, C, [LDC], [WORK])

     CHARACTER(LEN=1) :: SIDE
     COMPLEX(8) :: TAU
     COMPLEX(8), DIMENSION(:) :: V, WORK
     COMPLEX(8), DIMENSION(:,:) :: C
     INTEGER :: M, N, L, INCV, LDC

     SUBROUTINE LARZ_64(SIDE, [M], [N], L, V, [INCV], TAU, C, [LDC], [WORK])

     CHARACTER(LEN=1) :: SIDE
     COMPLEX(8) :: TAU
     COMPLEX(8), DIMENSION(:) :: V, WORK
     COMPLEX(8), DIMENSION(:,:) :: C
     INTEGER(8) :: M, N, L, INCV, LDC

  C INTERFACE
     #include <sunperf.h>

     void zlarz(char side, int m, int n, int l, doublecomplex *v,
               int  incv,  doublecomplex  *tau, doublecomplex *c,
               int ldc);

     void zlarz_64(char side, long m, long n, long l,  doublecom-
               plex *v, long incv, doublecomplex *tau, doublecom-
               plex *c, long ldc);

PURPOSE

     zlarz applies a complex elementary reflector H to a  complex
     M-by-N  matrix  C,  from  either the left or the right. H is
     represented in the form

           H = I - tau * v * v'

     where tau is a complex scalar and v is a complex vector.

     If tau = 0, then H is taken to be the unit matrix.

     To  apply  H'  (the  conjugate  transpose  of   H),   supply
     conjg(tau) instead tau.

     H is a product of k elementary  reflectors  as  returned  by
     CTZRZF.

ARGUMENTS

     SIDE (input)
               = 'L': form  H * C
               = 'R': form  C * H

     M (input) The number of rows of the matrix C.

     N (input) The number of columns of the matrix C.

     L (input) The number of entries of the vector  V  containing
               the  meaningful  part  of the Householder vectors.
               If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >=  L
               >= 0.

     V (input) The  vector  v  in  the  representation  of  H  as
               returned by CTZRZF. V is not used if TAU = 0.

     INCV (input)
               The increment between elements of v. INCV <> 0.

     TAU (input)
               The value tau in the representation of H.

     C (input/output)
               On entry, the M-by-N matrix  C.   On  exit,  C  is
               overwritten  by the matrix H * C if SIDE = 'L', or
               C * H if SIDE = 'R'.

     LDC (input)
               The leading dimension  of  the  array  C.  LDC  >=
               max(1,M).

     WORK (workspace)
               (N) if SIDE = 'L' or (M) if SIDE = 'R'

FURTHER DETAILS

     Based on contributions by
       A. Petitet, Computer Science Dept., Univ. of Tenn.,  Knox-
     ville, USA