LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zlarot()

subroutine zlarot ( logical lrows,
logical lleft,
logical lright,
integer nl,
complex*16 c,
complex*16 s,
complex*16, dimension( * ) a,
integer lda,
complex*16 xleft,
complex*16 xright )

ZLAROT

Purpose:
!>
!>    ZLAROT applies a (Givens) rotation to two adjacent rows or
!>    columns, where one element of the first and/or last column/row
!>    for use on matrices stored in some format other than GE, so
!>    that elements of the matrix may be used or modified for which
!>    no array element is provided.
!>
!>    One example is a symmetric matrix in SB format (bandwidth=4), for
!>    which UPLO='L':  Two adjacent rows will have the format:
!>
!>    row j:     C> C> C> C> C> .  .  .  .
!>    row j+1:      C> C> C> C> C> .  .  .  .
!>
!>    '*' indicates elements for which storage is provided,
!>    '.' indicates elements for which no storage is provided, but
!>    are not necessarily zero; their values are determined by
!>    symmetry.  ' ' indicates elements which are necessarily zero,
!>     and have no storage provided.
!>
!>    Those columns which have two '*'s can be handled by DROT.
!>    Those columns which have no '*'s can be ignored, since as long
!>    as the Givens rotations are carefully applied to preserve
!>    symmetry, their values are determined.
!>    Those columns which have one '*' have to be handled separately,
!>    by using separate variables  and :
!>
!>    row j:     C> C> C> C> C> p  .  .  .
!>    row j+1:   q  C> C> C> C> C> .  .  .  .
!>
!>    The element p would have to be set correctly, then that column
!>    is rotated, setting p to its new value.  The next call to
!>    ZLAROT would rotate columns j and j+1, using p, and restore
!>    symmetry.  The element q would start out being zero, and be
!>    made non-zero by the rotation.  Later, rotations would presumably
!>    be chosen to zero q out.
!>
!>    Typical Calling Sequences: rotating the i-th and (i+1)-st rows.
!>    ------- ------- ---------
!>
!>      General dense matrix:
!>
!>              CALL ZLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S,
!>                      A(i,1),LDA, DUMMY, DUMMY)
!>
!>      General banded matrix in GB format:
!>
!>              j = MAX(1, i-KL )
!>              NL = MIN( N, i+KU+1 ) + 1-j
!>              CALL ZLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S,
!>                      A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT )
!>
!>              [ note that i+1-j is just MIN(i,KL+1) ]
!>
!>      Symmetric banded matrix in SY format, bandwidth K,
!>      lower triangle only:
!>
!>              j = MAX(1, i-K )
!>              NL = MIN( K+1, i ) + 1
!>              CALL ZLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S,
!>                      A(i,j), LDA, XLEFT, XRIGHT )
!>
!>      Same, but upper triangle only:
!>
!>              NL = MIN( K+1, N-i ) + 1
!>              CALL ZLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S,
!>                      A(i,i), LDA, XLEFT, XRIGHT )
!>
!>      Symmetric banded matrix in SB format, bandwidth K,
!>      lower triangle only:
!>
!>              [ same as for SY, except:]
!>                  . . . .
!>                      A(i+1-j,j), LDA-1, XLEFT, XRIGHT )
!>
!>              [ note that i+1-j is just MIN(i,K+1) ]
!>
!>      Same, but upper triangle only:
!>                  . . .
!>                      A(K+1,i), LDA-1, XLEFT, XRIGHT )
!>
!>      Rotating columns is just the transpose of rotating rows, except
!>      for GB and SB: (rotating columns i and i+1)
!>
!>      GB:
!>              j = MAX(1, i-KU )
!>              NL = MIN( N, i+KL+1 ) + 1-j
!>              CALL ZLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S,
!>                      A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM )
!>
!>              [note that KU+j+1-i is just MAX(1,KU+2-i)]
!>
!>      SB: (upper triangle)
!>
!>                   . . . . . .
!>                      A(K+j+1-i,i),LDA-1, XTOP, XBOTTM )
!>
!>      SB: (lower triangle)
!>
!>                   . . . . . .
!>                      A(1,i),LDA-1, XTOP, XBOTTM )
!> 
!>  LROWS  - LOGICAL
!>           If .TRUE., then ZLAROT will rotate two rows.  If .FALSE.,
!>           then it will rotate two columns.
!>           Not modified.
!>
!>  LLEFT  - LOGICAL
!>           If .TRUE., then XLEFT will be used instead of the
!>           corresponding element of A for the first element in the
!>           second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.)
!>           If .FALSE., then the corresponding element of A will be
!>           used.
!>           Not modified.
!>
!>  LRIGHT - LOGICAL
!>           If .TRUE., then XRIGHT will be used instead of the
!>           corresponding element of A for the last element in the
!>           first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If
!>           .FALSE., then the corresponding element of A will be used.
!>           Not modified.
!>
!>  NL     - INTEGER
!>           The length of the rows (if LROWS=.TRUE.) or columns (if
!>           LROWS=.FALSE.) to be rotated.  If XLEFT and/or XRIGHT are
!>           used, the columns/rows they are in should be included in
!>           NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at
!>           least 2.  The number of rows/columns to be rotated
!>           exclusive of those involving XLEFT and/or XRIGHT may
!>           not be negative, i.e., NL minus how many of LLEFT and
!>           LRIGHT are .TRUE. must be at least zero; if not, XERBLA
!>           will be called.
!>           Not modified.
!>
!>  C, S   - COMPLEX*16
!>           Specify the Givens rotation to be applied.  If LROWS is
!>           true, then the matrix ( c  s )
!>                                 ( _  _ )
!>                                 (-s  c )  is applied from the left;
!>           if false, then the transpose (not conjugated) thereof is
!>           applied from the right.  Note that in contrast to the
!>           output of ZROTG or to most versions of ZROT, both C and S
!>           are complex.  For a Givens rotation, |C|**2 + |S|**2 should
!>           be 1, but this is not checked.
!>           Not modified.
!>
!>  A      - COMPLEX*16 array.
!>           The array containing the rows/columns to be rotated.  The
!>           first element of A should be the upper left element to
!>           be rotated.
!>           Read and modified.
!>
!>  LDA    - INTEGER
!>           The  leading dimension of A.  If A contains
!>           a matrix stored in GE, HE, or SY format, then this is just
!>           the leading dimension of A as dimensioned in the calling
!>           routine.  If A contains a matrix stored in band (GB, HB, or
!>           SB) format, then this should be *one less* than the leading
!>           dimension used in the calling routine.  Thus, if A were
!>           dimensioned A(LDA,*) in ZLAROT, then A(1,j) would be the
!>           j-th element in the first of the two rows to be rotated,
!>           and A(2,j) would be the j-th in the second, regardless of
!>           how the array may be stored in the calling routine.  [A
!>           cannot, however, actually be dimensioned thus, since for
!>           band format, the row number may exceed LDA, which is not
!>           legal FORTRAN.]
!>           If LROWS=.TRUE., then LDA must be at least 1, otherwise
!>           it must be at least NL minus the number of .TRUE. values
!>           in XLEFT and XRIGHT.
!>           Not modified.
!>
!>  XLEFT  - COMPLEX*16
!>           If LLEFT is .TRUE., then XLEFT will be used and modified
!>           instead of A(2,1) (if LROWS=.TRUE.) or A(1,2)
!>           (if LROWS=.FALSE.).
!>           Read and modified.
!>
!>  XRIGHT - COMPLEX*16
!>           If LRIGHT is .TRUE., then XRIGHT will be used and modified
!>           instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1)
!>           (if LROWS=.FALSE.).
!>           Read and modified.
!> 
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 227 of file zlarot.f.

230*
231* -- LAPACK auxiliary routine --
232* -- LAPACK is a software package provided by Univ. of Tennessee, --
233* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
234*
235* .. Scalar Arguments ..
236 LOGICAL LLEFT, LRIGHT, LROWS
237 INTEGER LDA, NL
238 COMPLEX*16 C, S, XLEFT, XRIGHT
239* ..
240* .. Array Arguments ..
241 COMPLEX*16 A( * )
242* ..
243*
244* =====================================================================
245*
246* .. Local Scalars ..
247 INTEGER IINC, INEXT, IX, IY, IYT, J, NT
248 COMPLEX*16 TEMPX
249* ..
250* .. Local Arrays ..
251 COMPLEX*16 XT( 2 ), YT( 2 )
252* ..
253* .. External Subroutines ..
254 EXTERNAL xerbla
255* ..
256* .. Intrinsic Functions ..
257 INTRINSIC dconjg
258* ..
259* .. Executable Statements ..
260*
261* Set up indices, arrays for ends
262*
263 IF( lrows ) THEN
264 iinc = lda
265 inext = 1
266 ELSE
267 iinc = 1
268 inext = lda
269 END IF
270*
271 IF( lleft ) THEN
272 nt = 1
273 ix = 1 + iinc
274 iy = 2 + lda
275 xt( 1 ) = a( 1 )
276 yt( 1 ) = xleft
277 ELSE
278 nt = 0
279 ix = 1
280 iy = 1 + inext
281 END IF
282*
283 IF( lright ) THEN
284 iyt = 1 + inext + ( nl-1 )*iinc
285 nt = nt + 1
286 xt( nt ) = xright
287 yt( nt ) = a( iyt )
288 END IF
289*
290* Check for errors
291*
292 IF( nl.LT.nt ) THEN
293 CALL xerbla( 'ZLAROT', 4 )
294 RETURN
295 END IF
296 IF( lda.LE.0 .OR. ( .NOT.lrows .AND. lda.LT.nl-nt ) ) THEN
297 CALL xerbla( 'ZLAROT', 8 )
298 RETURN
299 END IF
300*
301* Rotate
302*
303* ZROT( NL-NT, A(IX),IINC, A(IY),IINC, C, S ) with complex C, S
304*
305 DO 10 j = 0, nl - nt - 1
306 tempx = c*a( ix+j*iinc ) + s*a( iy+j*iinc )
307 a( iy+j*iinc ) = -dconjg( s )*a( ix+j*iinc ) +
308 $ dconjg( c )*a( iy+j*iinc )
309 a( ix+j*iinc ) = tempx
310 10 CONTINUE
311*
312* ZROT( NT, XT,1, YT,1, C, S ) with complex C, S
313*
314 DO 20 j = 1, nt
315 tempx = c*xt( j ) + s*yt( j )
316 yt( j ) = -dconjg( s )*xt( j ) + dconjg( c )*yt( j )
317 xt( j ) = tempx
318 20 CONTINUE
319*
320* Stuff values back into XLEFT, XRIGHT, etc.
321*
322 IF( lleft ) THEN
323 a( 1 ) = xt( 1 )
324 xleft = yt( 1 )
325 END IF
326*
327 IF( lright ) THEN
328 xright = xt( nt )
329 a( iyt ) = yt( nt )
330 END IF
331*
332 RETURN
333*
334* End of ZLAROT
335*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
Here is the call graph for this function:
Here is the caller graph for this function: