Annotation of rpl/lapack/blas/drotm.f, revision 1.17

1.9       bertrand    1: *> \brief \b DROTM
1.1       bertrand    2: *
1.9       bertrand    3: *  =========== DOCUMENTATION ===========
1.1       bertrand    4: *
1.14      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.1       bertrand    7: *
1.9       bertrand    8: *  Definition:
                      9: *  ===========
                     10: *
                     11: *       SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
1.14      bertrand   12: *
1.9       bertrand   13: *       .. Scalar Arguments ..
                     14: *       INTEGER INCX,INCY,N
                     15: *       ..
                     16: *       .. Array Arguments ..
                     17: *       DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
                     18: *       ..
1.14      bertrand   19: *
1.9       bertrand   20: *
                     21: *> \par Purpose:
                     22: *  =============
                     23: *>
                     24: *> \verbatim
                     25: *>
                     26: *>    APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
                     27: *>
                     28: *>    (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
                     29: *>    (DY**T)
                     30: *>
                     31: *>    DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
                     32: *>    LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
                     33: *>    WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
                     34: *>
                     35: *>    DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0
                     36: *>
                     37: *>      (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)
                     38: *>    H=(          )    (          )    (          )    (          )
                     39: *>      (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).
                     40: *>    SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
                     41: *> \endverbatim
                     42: *
                     43: *  Arguments:
                     44: *  ==========
                     45: *
                     46: *> \param[in] N
                     47: *> \verbatim
                     48: *>          N is INTEGER
                     49: *>         number of elements in input vector(s)
                     50: *> \endverbatim
                     51: *>
                     52: *> \param[in,out] DX
                     53: *> \verbatim
1.15      bertrand   54: *>          DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
1.9       bertrand   55: *> \endverbatim
                     56: *>
                     57: *> \param[in] INCX
                     58: *> \verbatim
                     59: *>          INCX is INTEGER
                     60: *>         storage spacing between elements of DX
                     61: *> \endverbatim
                     62: *>
                     63: *> \param[in,out] DY
                     64: *> \verbatim
1.15      bertrand   65: *>          DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
1.9       bertrand   66: *> \endverbatim
                     67: *>
                     68: *> \param[in] INCY
                     69: *> \verbatim
                     70: *>          INCY is INTEGER
                     71: *>         storage spacing between elements of DY
                     72: *> \endverbatim
                     73: *>
1.15      bertrand   74: *> \param[in] DPARAM
1.9       bertrand   75: *> \verbatim
1.15      bertrand   76: *>          DPARAM is DOUBLE PRECISION array, dimension (5)
1.9       bertrand   77: *>     DPARAM(1)=DFLAG
                     78: *>     DPARAM(2)=DH11
                     79: *>     DPARAM(3)=DH21
                     80: *>     DPARAM(4)=DH12
                     81: *>     DPARAM(5)=DH22
                     82: *> \endverbatim
                     83: *
                     84: *  Authors:
                     85: *  ========
                     86: *
1.14      bertrand   87: *> \author Univ. of Tennessee
                     88: *> \author Univ. of California Berkeley
                     89: *> \author Univ. of Colorado Denver
                     90: *> \author NAG Ltd.
1.1       bertrand   91: *
1.9       bertrand   92: *> \ingroup double_blas_level1
1.1       bertrand   93: *
1.9       bertrand   94: *  =====================================================================
                     95:       SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
1.1       bertrand   96: *
1.17    ! bertrand   97: *  -- Reference BLAS level1 routine --
1.9       bertrand   98: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
                     99: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.1       bertrand  100: *
1.9       bertrand  101: *     .. Scalar Arguments ..
                    102:       INTEGER INCX,INCY,N
                    103: *     ..
                    104: *     .. Array Arguments ..
                    105:       DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
                    106: *     ..
1.1       bertrand  107: *
                    108: *  =====================================================================
                    109: *
                    110: *     .. Local Scalars ..
                    111:       DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
                    112:       INTEGER I,KX,KY,NSTEPS
                    113: *     ..
                    114: *     .. Data statements ..
                    115:       DATA ZERO,TWO/0.D0,2.D0/
                    116: *     ..
                    117: *
                    118:       DFLAG = DPARAM(1)
1.8       bertrand  119:       IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN
                    120:       IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
1.1       bertrand  121: *
1.8       bertrand  122:          NSTEPS = N*INCX
                    123:          IF (DFLAG.LT.ZERO) THEN
                    124:             DH11 = DPARAM(2)
                    125:             DH12 = DPARAM(4)
                    126:             DH21 = DPARAM(3)
                    127:             DH22 = DPARAM(5)
                    128:             DO I = 1,NSTEPS,INCX
                    129:                W = DX(I)
                    130:                Z = DY(I)
                    131:                DX(I) = W*DH11 + Z*DH12
                    132:                DY(I) = W*DH21 + Z*DH22
                    133:             END DO
                    134:          ELSE IF (DFLAG.EQ.ZERO) THEN
                    135:             DH12 = DPARAM(4)
                    136:             DH21 = DPARAM(3)
                    137:             DO I = 1,NSTEPS,INCX
                    138:                W = DX(I)
                    139:                Z = DY(I)
                    140:                DX(I) = W + Z*DH12
                    141:                DY(I) = W*DH21 + Z
                    142:             END DO
                    143:          ELSE
                    144:             DH11 = DPARAM(2)
                    145:             DH22 = DPARAM(5)
                    146:             DO I = 1,NSTEPS,INCX
                    147:                W = DX(I)
                    148:                Z = DY(I)
                    149:                DX(I) = W*DH11 + Z
                    150:                DY(I) = -W + DH22*Z
                    151:             END DO
                    152:          END IF
1.4       bertrand  153:       ELSE
1.8       bertrand  154:          KX = 1
                    155:          KY = 1
                    156:          IF (INCX.LT.0) KX = 1 + (1-N)*INCX
                    157:          IF (INCY.LT.0) KY = 1 + (1-N)*INCY
1.1       bertrand  158: *
1.8       bertrand  159:          IF (DFLAG.LT.ZERO) THEN
                    160:             DH11 = DPARAM(2)
                    161:             DH12 = DPARAM(4)
                    162:             DH21 = DPARAM(3)
                    163:             DH22 = DPARAM(5)
                    164:             DO I = 1,N
                    165:                W = DX(KX)
                    166:                Z = DY(KY)
                    167:                DX(KX) = W*DH11 + Z*DH12
                    168:                DY(KY) = W*DH21 + Z*DH22
                    169:                KX = KX + INCX
                    170:                KY = KY + INCY
                    171:             END DO
                    172:          ELSE IF (DFLAG.EQ.ZERO) THEN
                    173:             DH12 = DPARAM(4)
                    174:             DH21 = DPARAM(3)
                    175:             DO I = 1,N
                    176:                W = DX(KX)
                    177:                Z = DY(KY)
                    178:                DX(KX) = W + Z*DH12
                    179:                DY(KY) = W*DH21 + Z
                    180:                KX = KX + INCX
                    181:                KY = KY + INCY
                    182:             END DO
                    183:          ELSE
                    184:              DH11 = DPARAM(2)
                    185:              DH22 = DPARAM(5)
                    186:              DO I = 1,N
                    187:                 W = DX(KX)
                    188:                 Z = DY(KY)
                    189:                 DX(KX) = W*DH11 + Z
                    190:                 DY(KY) = -W + DH22*Z
                    191:                 KX = KX + INCX
                    192:                 KY = KY + INCY
                    193:             END DO
                    194:          END IF
1.4       bertrand  195:       END IF
1.1       bertrand  196:       RETURN
1.17    ! bertrand  197: *
        !           198: *     End of DROTM
        !           199: *
1.1       bertrand  200:       END

CVSweb interface <joel.bertrand@systella.fr>