TESTING/MATGEN/zlarot.f

   1 *> \brief \b ZLAROT
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE ZLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT,
  12 *                          XRIGHT )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       LOGICAL            LLEFT, LRIGHT, LROWS
  16 *       INTEGER            LDA, NL
  17 *       COMPLEX*16         C, S, XLEFT, XRIGHT
  18 *       ..
  19 *       .. Array Arguments ..
  20 *       COMPLEX*16         A( * )
  21 *       ..
  22 *
  23 *
  24 *> \par Purpose:
  25 *  =============
  26 *>
  27 *> \verbatim
  28 *>
  29 *>    ZLAROT applies a (Givens) rotation to two adjacent rows or
  30 *>    columns, where one element of the first and/or last column/row
  31 *>    for use on matrices stored in some format other than GE, so
  32 *>    that elements of the matrix may be used or modified for which
  33 *>    no array element is provided.
  34 *>
  35 *>    One example is a symmetric matrix in SB format (bandwidth=4), for
  36 *>    which UPLO='L':  Two adjacent rows will have the format:
  37 *>
  38 *>    row j:     C> C> C> C> C> .  .  .  .
  39 *>    row j+1:      C> C> C> C> C> .  .  .  .
  40 *>
  41 *>    '*' indicates elements for which storage is provided,
  42 *>    '.' indicates elements for which no storage is provided, but
  43 *>    are not necessarily zero; their values are determined by
  44 *>    symmetry.  ' ' indicates elements which are necessarily zero,
  45 *>     and have no storage provided.
  46 *>
  47 *>    Those columns which have two '*'s can be handled by DROT.
  48 *>    Those columns which have no '*'s can be ignored, since as long
  49 *>    as the Givens rotations are carefully applied to preserve
  50 *>    symmetry, their values are determined.
  51 *>    Those columns which have one '*' have to be handled separately,
  52 *>    by using separate variables "p" and "q":
  53 *>
  54 *>    row j:     C> C> C> C> C> p  .  .  .
  55 *>    row j+1:   q  C> C> C> C> C> .  .  .  .
  56 *>
  57 *>    The element p would have to be set correctly, then that column
  58 *>    is rotated, setting p to its new value.  The next call to
  59 *>    ZLAROT would rotate columns j and j+1, using p, and restore
  60 *>    symmetry.  The element q would start out being zero, and be
  61 *>    made non-zero by the rotation.  Later, rotations would presumably
  62 *>    be chosen to zero q out.
  63 *>
  64 *>    Typical Calling Sequences: rotating the i-th and (i+1)-st rows.
  65 *>    ------- ------- ---------
  66 *>
  67 *>      General dense matrix:
  68 *>
  69 *>              CALL ZLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S,
  70 *>                      A(i,1),LDA, DUMMY, DUMMY)
  71 *>
  72 *>      General banded matrix in GB format:
  73 *>
  74 *>              j = MAX(1, i-KL )
  75 *>              NL = MIN( N, i+KU+1 ) + 1-j
  76 *>              CALL ZLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S,
  77 *>                      A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT )
  78 *>
  79 *>              [ note that i+1-j is just MIN(i,KL+1) ]
  80 *>
  81 *>      Symmetric banded matrix in SY format, bandwidth K,
  82 *>      lower triangle only:
  83 *>
  84 *>              j = MAX(1, i-K )
  85 *>              NL = MIN( K+1, i ) + 1
  86 *>              CALL ZLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S,
  87 *>                      A(i,j), LDA, XLEFT, XRIGHT )
  88 *>
  89 *>      Same, but upper triangle only:
  90 *>
  91 *>              NL = MIN( K+1, N-i ) + 1
  92 *>              CALL ZLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S,
  93 *>                      A(i,i), LDA, XLEFT, XRIGHT )
  94 *>
  95 *>      Symmetric banded matrix in SB format, bandwidth K,
  96 *>      lower triangle only:
  97 *>
  98 *>              [ same as for SY, except:]
  99 *>                  . . . .
 100 *>                      A(i+1-j,j), LDA-1, XLEFT, XRIGHT )
 101 *>
 102 *>              [ note that i+1-j is just MIN(i,K+1) ]
 103 *>
 104 *>      Same, but upper triangle only:
 105 *>                  . . .
 106 *>                      A(K+1,i), LDA-1, XLEFT, XRIGHT )
 107 *>
 108 *>      Rotating columns is just the transpose of rotating rows, except
 109 *>      for GB and SB: (rotating columns i and i+1)
 110 *>
 111 *>      GB:
 112 *>              j = MAX(1, i-KU )
 113 *>              NL = MIN( N, i+KL+1 ) + 1-j
 114 *>              CALL ZLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S,
 115 *>                      A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM )
 116 *>
 117 *>              [note that KU+j+1-i is just MAX(1,KU+2-i)]
 118 *>
 119 *>      SB: (upper triangle)
 120 *>
 121 *>                   . . . . . .
 122 *>                      A(K+j+1-i,i),LDA-1, XTOP, XBOTTM )
 123 *>
 124 *>      SB: (lower triangle)
 125 *>
 126 *>                   . . . . . .
 127 *>                      A(1,i),LDA-1, XTOP, XBOTTM )
 128 *> \endverbatim
 129 *
 130 *  Arguments:
 131 *  ==========
 132 *
 133 *> \verbatim
 134 *>  LROWS  - LOGICAL
 135 *>           If .TRUE., then ZLAROT will rotate two rows.  If .FALSE.,
 136 *>           then it will rotate two columns.
 137 *>           Not modified.
 138 *>
 139 *>  LLEFT  - LOGICAL
 140 *>           If .TRUE., then XLEFT will be used instead of the
 141 *>           corresponding element of A for the first element in the
 142 *>           second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.)
 143 *>           If .FALSE., then the corresponding element of A will be
 144 *>           used.
 145 *>           Not modified.
 146 *>
 147 *>  LRIGHT - LOGICAL
 148 *>           If .TRUE., then XRIGHT will be used instead of the
 149 *>           corresponding element of A for the last element in the
 150 *>           first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If
 151 *>           .FALSE., then the corresponding element of A will be used.
 152 *>           Not modified.
 153 *>
 154 *>  NL     - INTEGER
 155 *>           The length of the rows (if LROWS=.TRUE.) or columns (if
 156 *>           LROWS=.FALSE.) to be rotated.  If XLEFT and/or XRIGHT are
 157 *>           used, the columns/rows they are in should be included in
 158 *>           NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at
 159 *>           least 2.  The number of rows/columns to be rotated
 160 *>           exclusive of those involving XLEFT and/or XRIGHT may
 161 *>           not be negative, i.e., NL minus how many of LLEFT and
 162 *>           LRIGHT are .TRUE. must be at least zero; if not, XERBLA
 163 *>           will be called.
 164 *>           Not modified.
 165 *>
 166 *>  C, S   - COMPLEX*16
 167 *>           Specify the Givens rotation to be applied.  If LROWS is
 168 *>           true, then the matrix ( c  s )
 169 *>                                 ( _  _ )
 170 *>                                 (-s  c )  is applied from the left;
 171 *>           if false, then the transpose (not conjugated) thereof is
 172 *>           applied from the right.  Note that in contrast to the
 173 *>           output of ZROTG or to most versions of ZROT, both C and S
 174 *>           are complex.  For a Givens rotation, |C|**2 + |S|**2 should
 175 *>           be 1, but this is not checked.
 176 *>           Not modified.
 177 *>
 178 *>  A      - COMPLEX*16 array.
 179 *>           The array containing the rows/columns to be rotated.  The
 180 *>           first element of A should be the upper left element to
 181 *>           be rotated.
 182 *>           Read and modified.
 183 *>
 184 *>  LDA    - INTEGER
 185 *>           The "effective" leading dimension of A.  If A contains
 186 *>           a matrix stored in GE, HE, or SY format, then this is just
 187 *>           the leading dimension of A as dimensioned in the calling
 188 *>           routine.  If A contains a matrix stored in band (GB, HB, or
 189 *>           SB) format, then this should be *one less* than the leading
 190 *>           dimension used in the calling routine.  Thus, if A were
 191 *>           dimensioned A(LDA,*) in ZLAROT, then A(1,j) would be the
 192 *>           j-th element in the first of the two rows to be rotated,
 193 *>           and A(2,j) would be the j-th in the second, regardless of
 194 *>           how the array may be stored in the calling routine.  [A
 195 *>           cannot, however, actually be dimensioned thus, since for
 196 *>           band format, the row number may exceed LDA, which is not
 197 *>           legal FORTRAN.]
 198 *>           If LROWS=.TRUE., then LDA must be at least 1, otherwise
 199 *>           it must be at least NL minus the number of .TRUE. values
 200 *>           in XLEFT and XRIGHT.
 201 *>           Not modified.
 202 *>
 203 *>  XLEFT  - COMPLEX*16
 204 *>           If LLEFT is .TRUE., then XLEFT will be used and modified
 205 *>           instead of A(2,1) (if LROWS=.TRUE.) or A(1,2)
 206 *>           (if LROWS=.FALSE.).
 207 *>           Read and modified.
 208 *>
 209 *>  XRIGHT - COMPLEX*16
 210 *>           If LRIGHT is .TRUE., then XRIGHT will be used and modified
 211 *>           instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1)
 212 *>           (if LROWS=.FALSE.).
 213 *>           Read and modified.
 214 *> \endverbatim
 215 *
 216 *  Authors:
 217 *  ========
 218 *
 219 *> \author Univ. of Tennessee
 220 *> \author Univ. of California Berkeley
 221 *> \author Univ. of Colorado Denver
 222 *> \author NAG Ltd.
 223 *
 224 *> \date November 2011
 225 *
 226 *> \ingroup complex16_matgen
 227 *
 228 *  =====================================================================
 229       SUBROUTINE ZLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT,
 230      $                   XRIGHT )
 231 *
 232 *  -- LAPACK auxiliary routine (version 3.4.0) --
 233 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 234 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 235 *     November 2011
 236 *
 237 *     .. Scalar Arguments ..
 238       LOGICAL            LLEFT, LRIGHT, LROWS
 239       INTEGER            LDA, NL
 240       COMPLEX*16         C, S, XLEFT, XRIGHT
 241 *     ..
 242 *     .. Array Arguments ..
 243       COMPLEX*16         A( * )
 244 *     ..
 245 *
 246 *  =====================================================================
 247 *
 248 *     .. Local Scalars ..
 249       INTEGER            IINC, INEXT, IX, IY, IYT, J, NT
 250       COMPLEX*16         TEMPX
 251 *     ..
 252 *     .. Local Arrays ..
 253       COMPLEX*16         XT( 2 ), YT( 2 )
 254 *     ..
 255 *     .. External Subroutines ..
 256       EXTERNAL           XERBLA
 257 *     ..
 258 *     .. Intrinsic Functions ..
 259       INTRINSIC          DCONJG
 260 *     ..
 261 *     .. Executable Statements ..
 262 *
 263 *     Set up indices, arrays for ends
 264 *
 265       IF( LROWS ) THEN
 266          IINC = LDA
 267          INEXT = 1
 268       ELSE
 269          IINC = 1
 270          INEXT = LDA
 271       END IF
 272 *
 273       IF( LLEFT ) THEN
 274          NT = 1
 275          IX = 1 + IINC
 276          IY = 2 + LDA
 277          XT( 1 ) = A( 1 )
 278          YT( 1 ) = XLEFT
 279       ELSE
 280          NT = 0
 281          IX = 1
 282          IY = 1 + INEXT
 283       END IF
 284 *
 285       IF( LRIGHT ) THEN
 286          IYT = 1 + INEXT + ( NL-1 )*IINC
 287          NT = NT + 1
 288          XT( NT ) = XRIGHT
 289          YT( NT ) = A( IYT )
 290       END IF
 291 *
 292 *     Check for errors
 293 *
 294       IF( NL.LT.NT ) THEN
 295          CALL XERBLA( 'ZLAROT', 4 )
 296          RETURN
 297       END IF
 298       IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN
 299          CALL XERBLA( 'ZLAROT', 8 )
 300          RETURN
 301       END IF
 302 *
 303 *     Rotate
 304 *
 305 *     ZROT( NL-NT, A(IX),IINC, A(IY),IINC, C, S ) with complex C, S
 306 *
 307       DO 10 J = 0, NL - NT - 1
 308          TEMPX = C*A( IX+J*IINC ) + S*A( IY+J*IINC )
 309          A( IY+J*IINC ) = -DCONJG( S )*A( IX+J*IINC ) +
 310      $                    DCONJG( C )*A( IY+J*IINC )
 311          A( IX+J*IINC ) = TEMPX
 312    10 CONTINUE
 313 *
 314 *     ZROT( NT, XT,1, YT,1, C, S ) with complex C, S
 315 *
 316       DO 20 J = 1, NT
 317          TEMPX = C*XT( J ) + S*YT( J )
 318          YT( J ) = -DCONJG( S )*XT( J ) + DCONJG( C )*YT( J )
 319          XT( J ) = TEMPX
 320    20 CONTINUE
 321 *
 322 *     Stuff values back into XLEFT, XRIGHT, etc.
 323 *
 324       IF( LLEFT ) THEN
 325          A( 1 ) = XT( 1 )
 326          XLEFT = YT( 1 )
 327       END IF
 328 *
 329       IF( LRIGHT ) THEN
 330          XRIGHT = XT( NT )
 331          A( IYT ) = YT( NT )
 332       END IF
 333 *
 334       RETURN
 335 *
 336 *     End of ZLAROT
 337 *
 338       END