Annotation of rpl/lapack/lapack/zlasr.f, revision 1.1

1.1     ! bertrand    1:       SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
        !             2: *
        !             3: *  -- LAPACK auxiliary routine (version 3.2) --
        !             4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
        !             5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
        !             6: *     November 2006
        !             7: *
        !             8: *     .. Scalar Arguments ..
        !             9:       CHARACTER          DIRECT, PIVOT, SIDE
        !            10:       INTEGER            LDA, M, N
        !            11: *     ..
        !            12: *     .. Array Arguments ..
        !            13:       DOUBLE PRECISION   C( * ), S( * )
        !            14:       COMPLEX*16         A( LDA, * )
        !            15: *     ..
        !            16: *
        !            17: *  Purpose
        !            18: *  =======
        !            19: *
        !            20: *  ZLASR applies a sequence of real plane rotations to a complex matrix
        !            21: *  A, from either the left or the right.
        !            22: *
        !            23: *  When SIDE = 'L', the transformation takes the form
        !            24: *
        !            25: *     A := P*A
        !            26: *
        !            27: *  and when SIDE = 'R', the transformation takes the form
        !            28: *
        !            29: *     A := A*P**T
        !            30: *
        !            31: *  where P is an orthogonal matrix consisting of a sequence of z plane
        !            32: *  rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
        !            33: *  and P**T is the transpose of P.
        !            34: *  
        !            35: *  When DIRECT = 'F' (Forward sequence), then
        !            36: *  
        !            37: *     P = P(z-1) * ... * P(2) * P(1)
        !            38: *  
        !            39: *  and when DIRECT = 'B' (Backward sequence), then
        !            40: *  
        !            41: *     P = P(1) * P(2) * ... * P(z-1)
        !            42: *  
        !            43: *  where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
        !            44: *  
        !            45: *     R(k) = (  c(k)  s(k) )
        !            46: *          = ( -s(k)  c(k) ).
        !            47: *  
        !            48: *  When PIVOT = 'V' (Variable pivot), the rotation is performed
        !            49: *  for the plane (k,k+1), i.e., P(k) has the form
        !            50: *  
        !            51: *     P(k) = (  1                                            )
        !            52: *            (       ...                                     )
        !            53: *            (              1                                )
        !            54: *            (                   c(k)  s(k)                  )
        !            55: *            (                  -s(k)  c(k)                  )
        !            56: *            (                                1              )
        !            57: *            (                                     ...       )
        !            58: *            (                                            1  )
        !            59: *  
        !            60: *  where R(k) appears as a rank-2 modification to the identity matrix in
        !            61: *  rows and columns k and k+1.
        !            62: *  
        !            63: *  When PIVOT = 'T' (Top pivot), the rotation is performed for the
        !            64: *  plane (1,k+1), so P(k) has the form
        !            65: *  
        !            66: *     P(k) = (  c(k)                    s(k)                 )
        !            67: *            (         1                                     )
        !            68: *            (              ...                              )
        !            69: *            (                     1                         )
        !            70: *            ( -s(k)                    c(k)                 )
        !            71: *            (                                 1             )
        !            72: *            (                                      ...      )
        !            73: *            (                                             1 )
        !            74: *  
        !            75: *  where R(k) appears in rows and columns 1 and k+1.
        !            76: *  
        !            77: *  Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
        !            78: *  performed for the plane (k,z), giving P(k) the form
        !            79: *  
        !            80: *     P(k) = ( 1                                             )
        !            81: *            (      ...                                      )
        !            82: *            (             1                                 )
        !            83: *            (                  c(k)                    s(k) )
        !            84: *            (                         1                     )
        !            85: *            (                              ...              )
        !            86: *            (                                     1         )
        !            87: *            (                 -s(k)                    c(k) )
        !            88: *  
        !            89: *  where R(k) appears in rows and columns k and z.  The rotations are
        !            90: *  performed without ever forming P(k) explicitly.
        !            91: *
        !            92: *  Arguments
        !            93: *  =========
        !            94: *
        !            95: *  SIDE    (input) CHARACTER*1
        !            96: *          Specifies whether the plane rotation matrix P is applied to
        !            97: *          A on the left or the right.
        !            98: *          = 'L':  Left, compute A := P*A
        !            99: *          = 'R':  Right, compute A:= A*P**T
        !           100: *
        !           101: *  PIVOT   (input) CHARACTER*1
        !           102: *          Specifies the plane for which P(k) is a plane rotation
        !           103: *          matrix.
        !           104: *          = 'V':  Variable pivot, the plane (k,k+1)
        !           105: *          = 'T':  Top pivot, the plane (1,k+1)
        !           106: *          = 'B':  Bottom pivot, the plane (k,z)
        !           107: *
        !           108: *  DIRECT  (input) CHARACTER*1
        !           109: *          Specifies whether P is a forward or backward sequence of
        !           110: *          plane rotations.
        !           111: *          = 'F':  Forward, P = P(z-1)*...*P(2)*P(1)
        !           112: *          = 'B':  Backward, P = P(1)*P(2)*...*P(z-1)
        !           113: *
        !           114: *  M       (input) INTEGER
        !           115: *          The number of rows of the matrix A.  If m <= 1, an immediate
        !           116: *          return is effected.
        !           117: *
        !           118: *  N       (input) INTEGER
        !           119: *          The number of columns of the matrix A.  If n <= 1, an
        !           120: *          immediate return is effected.
        !           121: *
        !           122: *  C       (input) DOUBLE PRECISION array, dimension
        !           123: *                  (M-1) if SIDE = 'L'
        !           124: *                  (N-1) if SIDE = 'R'
        !           125: *          The cosines c(k) of the plane rotations.
        !           126: *
        !           127: *  S       (input) DOUBLE PRECISION array, dimension
        !           128: *                  (M-1) if SIDE = 'L'
        !           129: *                  (N-1) if SIDE = 'R'
        !           130: *          The sines s(k) of the plane rotations.  The 2-by-2 plane
        !           131: *          rotation part of the matrix P(k), R(k), has the form
        !           132: *          R(k) = (  c(k)  s(k) )
        !           133: *                 ( -s(k)  c(k) ).
        !           134: *
        !           135: *  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
        !           136: *          The M-by-N matrix A.  On exit, A is overwritten by P*A if
        !           137: *          SIDE = 'R' or by A*P**T if SIDE = 'L'.
        !           138: *
        !           139: *  LDA     (input) INTEGER
        !           140: *          The leading dimension of the array A.  LDA >= max(1,M).
        !           141: *
        !           142: *  =====================================================================
        !           143: *
        !           144: *     .. Parameters ..
        !           145:       DOUBLE PRECISION   ONE, ZERO
        !           146:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
        !           147: *     ..
        !           148: *     .. Local Scalars ..
        !           149:       INTEGER            I, INFO, J
        !           150:       DOUBLE PRECISION   CTEMP, STEMP
        !           151:       COMPLEX*16         TEMP
        !           152: *     ..
        !           153: *     .. Intrinsic Functions ..
        !           154:       INTRINSIC          MAX
        !           155: *     ..
        !           156: *     .. External Functions ..
        !           157:       LOGICAL            LSAME
        !           158:       EXTERNAL           LSAME
        !           159: *     ..
        !           160: *     .. External Subroutines ..
        !           161:       EXTERNAL           XERBLA
        !           162: *     ..
        !           163: *     .. Executable Statements ..
        !           164: *
        !           165: *     Test the input parameters
        !           166: *
        !           167:       INFO = 0
        !           168:       IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
        !           169:          INFO = 1
        !           170:       ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
        !           171:      $         'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
        !           172:          INFO = 2
        !           173:       ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
        !           174:      $          THEN
        !           175:          INFO = 3
        !           176:       ELSE IF( M.LT.0 ) THEN
        !           177:          INFO = 4
        !           178:       ELSE IF( N.LT.0 ) THEN
        !           179:          INFO = 5
        !           180:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
        !           181:          INFO = 9
        !           182:       END IF
        !           183:       IF( INFO.NE.0 ) THEN
        !           184:          CALL XERBLA( 'ZLASR ', INFO )
        !           185:          RETURN
        !           186:       END IF
        !           187: *
        !           188: *     Quick return if possible
        !           189: *
        !           190:       IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
        !           191:      $   RETURN
        !           192:       IF( LSAME( SIDE, 'L' ) ) THEN
        !           193: *
        !           194: *        Form  P * A
        !           195: *
        !           196:          IF( LSAME( PIVOT, 'V' ) ) THEN
        !           197:             IF( LSAME( DIRECT, 'F' ) ) THEN
        !           198:                DO 20 J = 1, M - 1
        !           199:                   CTEMP = C( J )
        !           200:                   STEMP = S( J )
        !           201:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           202:                      DO 10 I = 1, N
        !           203:                         TEMP = A( J+1, I )
        !           204:                         A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
        !           205:                         A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
        !           206:    10                CONTINUE
        !           207:                   END IF
        !           208:    20          CONTINUE
        !           209:             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
        !           210:                DO 40 J = M - 1, 1, -1
        !           211:                   CTEMP = C( J )
        !           212:                   STEMP = S( J )
        !           213:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           214:                      DO 30 I = 1, N
        !           215:                         TEMP = A( J+1, I )
        !           216:                         A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
        !           217:                         A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
        !           218:    30                CONTINUE
        !           219:                   END IF
        !           220:    40          CONTINUE
        !           221:             END IF
        !           222:          ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
        !           223:             IF( LSAME( DIRECT, 'F' ) ) THEN
        !           224:                DO 60 J = 2, M
        !           225:                   CTEMP = C( J-1 )
        !           226:                   STEMP = S( J-1 )
        !           227:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           228:                      DO 50 I = 1, N
        !           229:                         TEMP = A( J, I )
        !           230:                         A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
        !           231:                         A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
        !           232:    50                CONTINUE
        !           233:                   END IF
        !           234:    60          CONTINUE
        !           235:             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
        !           236:                DO 80 J = M, 2, -1
        !           237:                   CTEMP = C( J-1 )
        !           238:                   STEMP = S( J-1 )
        !           239:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           240:                      DO 70 I = 1, N
        !           241:                         TEMP = A( J, I )
        !           242:                         A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
        !           243:                         A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
        !           244:    70                CONTINUE
        !           245:                   END IF
        !           246:    80          CONTINUE
        !           247:             END IF
        !           248:          ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
        !           249:             IF( LSAME( DIRECT, 'F' ) ) THEN
        !           250:                DO 100 J = 1, M - 1
        !           251:                   CTEMP = C( J )
        !           252:                   STEMP = S( J )
        !           253:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           254:                      DO 90 I = 1, N
        !           255:                         TEMP = A( J, I )
        !           256:                         A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
        !           257:                         A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
        !           258:    90                CONTINUE
        !           259:                   END IF
        !           260:   100          CONTINUE
        !           261:             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
        !           262:                DO 120 J = M - 1, 1, -1
        !           263:                   CTEMP = C( J )
        !           264:                   STEMP = S( J )
        !           265:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           266:                      DO 110 I = 1, N
        !           267:                         TEMP = A( J, I )
        !           268:                         A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
        !           269:                         A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
        !           270:   110                CONTINUE
        !           271:                   END IF
        !           272:   120          CONTINUE
        !           273:             END IF
        !           274:          END IF
        !           275:       ELSE IF( LSAME( SIDE, 'R' ) ) THEN
        !           276: *
        !           277: *        Form A * P'
        !           278: *
        !           279:          IF( LSAME( PIVOT, 'V' ) ) THEN
        !           280:             IF( LSAME( DIRECT, 'F' ) ) THEN
        !           281:                DO 140 J = 1, N - 1
        !           282:                   CTEMP = C( J )
        !           283:                   STEMP = S( J )
        !           284:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           285:                      DO 130 I = 1, M
        !           286:                         TEMP = A( I, J+1 )
        !           287:                         A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
        !           288:                         A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
        !           289:   130                CONTINUE
        !           290:                   END IF
        !           291:   140          CONTINUE
        !           292:             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
        !           293:                DO 160 J = N - 1, 1, -1
        !           294:                   CTEMP = C( J )
        !           295:                   STEMP = S( J )
        !           296:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           297:                      DO 150 I = 1, M
        !           298:                         TEMP = A( I, J+1 )
        !           299:                         A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
        !           300:                         A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
        !           301:   150                CONTINUE
        !           302:                   END IF
        !           303:   160          CONTINUE
        !           304:             END IF
        !           305:          ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
        !           306:             IF( LSAME( DIRECT, 'F' ) ) THEN
        !           307:                DO 180 J = 2, N
        !           308:                   CTEMP = C( J-1 )
        !           309:                   STEMP = S( J-1 )
        !           310:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           311:                      DO 170 I = 1, M
        !           312:                         TEMP = A( I, J )
        !           313:                         A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
        !           314:                         A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
        !           315:   170                CONTINUE
        !           316:                   END IF
        !           317:   180          CONTINUE
        !           318:             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
        !           319:                DO 200 J = N, 2, -1
        !           320:                   CTEMP = C( J-1 )
        !           321:                   STEMP = S( J-1 )
        !           322:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           323:                      DO 190 I = 1, M
        !           324:                         TEMP = A( I, J )
        !           325:                         A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
        !           326:                         A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
        !           327:   190                CONTINUE
        !           328:                   END IF
        !           329:   200          CONTINUE
        !           330:             END IF
        !           331:          ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
        !           332:             IF( LSAME( DIRECT, 'F' ) ) THEN
        !           333:                DO 220 J = 1, N - 1
        !           334:                   CTEMP = C( J )
        !           335:                   STEMP = S( J )
        !           336:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           337:                      DO 210 I = 1, M
        !           338:                         TEMP = A( I, J )
        !           339:                         A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
        !           340:                         A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
        !           341:   210                CONTINUE
        !           342:                   END IF
        !           343:   220          CONTINUE
        !           344:             ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
        !           345:                DO 240 J = N - 1, 1, -1
        !           346:                   CTEMP = C( J )
        !           347:                   STEMP = S( J )
        !           348:                   IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
        !           349:                      DO 230 I = 1, M
        !           350:                         TEMP = A( I, J )
        !           351:                         A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
        !           352:                         A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
        !           353:   230                CONTINUE
        !           354:                   END IF
        !           355:   240          CONTINUE
        !           356:             END IF
        !           357:          END IF
        !           358:       END IF
        !           359: *
        !           360:       RETURN
        !           361: *
        !           362: *     End of ZLASR
        !           363: *
        !           364:       END

CVSweb interface <joel.bertrand@systella.fr>