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

1.9     ! bertrand    1: *> \brief \b DROTM
1.1       bertrand    2: *
1.9     ! bertrand    3: *  =========== DOCUMENTATION ===========
1.1       bertrand    4: *
1.9     ! 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)
        !            12: * 
        !            13: *       .. Scalar Arguments ..
        !            14: *       INTEGER INCX,INCY,N
        !            15: *       ..
        !            16: *       .. Array Arguments ..
        !            17: *       DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
        !            18: *       ..
        !            19: *  
        !            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
        !            54: *>          DX is DOUBLE PRECISION array, dimension N
        !            55: *>         double precision vector with N elements
        !            56: *> \endverbatim
        !            57: *>
        !            58: *> \param[in] INCX
        !            59: *> \verbatim
        !            60: *>          INCX is INTEGER
        !            61: *>         storage spacing between elements of DX
        !            62: *> \endverbatim
        !            63: *>
        !            64: *> \param[in,out] DY
        !            65: *> \verbatim
        !            66: *>          DY is DOUBLE PRECISION array, dimension N
        !            67: *>         double precision vector with N elements
        !            68: *> \endverbatim
        !            69: *>
        !            70: *> \param[in] INCY
        !            71: *> \verbatim
        !            72: *>          INCY is INTEGER
        !            73: *>         storage spacing between elements of DY
        !            74: *> \endverbatim
        !            75: *>
        !            76: *> \param[in,out] DPARAM
        !            77: *> \verbatim
        !            78: *>          DPARAM is DOUBLE PRECISION array, dimension 5
        !            79: *>     DPARAM(1)=DFLAG
        !            80: *>     DPARAM(2)=DH11
        !            81: *>     DPARAM(3)=DH21
        !            82: *>     DPARAM(4)=DH12
        !            83: *>     DPARAM(5)=DH22
        !            84: *> \endverbatim
        !            85: *
        !            86: *  Authors:
        !            87: *  ========
        !            88: *
        !            89: *> \author Univ. of Tennessee 
        !            90: *> \author Univ. of California Berkeley 
        !            91: *> \author Univ. of Colorado Denver 
        !            92: *> \author NAG Ltd. 
1.1       bertrand   93: *
1.9     ! bertrand   94: *> \date November 2011
1.1       bertrand   95: *
1.9     ! bertrand   96: *> \ingroup double_blas_level1
1.1       bertrand   97: *
1.9     ! bertrand   98: *  =====================================================================
        !            99:       SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
1.1       bertrand  100: *
1.9     ! bertrand  101: *  -- Reference BLAS level1 routine (version 3.4.0) --
        !           102: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
        !           103: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
        !           104: *     November 2011
1.1       bertrand  105: *
1.9     ! bertrand  106: *     .. Scalar Arguments ..
        !           107:       INTEGER INCX,INCY,N
        !           108: *     ..
        !           109: *     .. Array Arguments ..
        !           110:       DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
        !           111: *     ..
1.1       bertrand  112: *
                    113: *  =====================================================================
                    114: *
                    115: *     .. Local Scalars ..
                    116:       DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
                    117:       INTEGER I,KX,KY,NSTEPS
                    118: *     ..
                    119: *     .. Data statements ..
                    120:       DATA ZERO,TWO/0.D0,2.D0/
                    121: *     ..
                    122: *
                    123:       DFLAG = DPARAM(1)
1.8       bertrand  124:       IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN
                    125:       IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
1.1       bertrand  126: *
1.8       bertrand  127:          NSTEPS = N*INCX
                    128:          IF (DFLAG.LT.ZERO) THEN
                    129:             DH11 = DPARAM(2)
                    130:             DH12 = DPARAM(4)
                    131:             DH21 = DPARAM(3)
                    132:             DH22 = DPARAM(5)
                    133:             DO I = 1,NSTEPS,INCX
                    134:                W = DX(I)
                    135:                Z = DY(I)
                    136:                DX(I) = W*DH11 + Z*DH12
                    137:                DY(I) = W*DH21 + Z*DH22
                    138:             END DO
                    139:          ELSE IF (DFLAG.EQ.ZERO) THEN
                    140:             DH12 = DPARAM(4)
                    141:             DH21 = DPARAM(3)
                    142:             DO I = 1,NSTEPS,INCX
                    143:                W = DX(I)
                    144:                Z = DY(I)
                    145:                DX(I) = W + Z*DH12
                    146:                DY(I) = W*DH21 + Z
                    147:             END DO
                    148:          ELSE
                    149:             DH11 = DPARAM(2)
                    150:             DH22 = DPARAM(5)
                    151:             DO I = 1,NSTEPS,INCX
                    152:                W = DX(I)
                    153:                Z = DY(I)
                    154:                DX(I) = W*DH11 + Z
                    155:                DY(I) = -W + DH22*Z
                    156:             END DO
                    157:          END IF
1.4       bertrand  158:       ELSE
1.8       bertrand  159:          KX = 1
                    160:          KY = 1
                    161:          IF (INCX.LT.0) KX = 1 + (1-N)*INCX
                    162:          IF (INCY.LT.0) KY = 1 + (1-N)*INCY
1.1       bertrand  163: *
1.8       bertrand  164:          IF (DFLAG.LT.ZERO) THEN
                    165:             DH11 = DPARAM(2)
                    166:             DH12 = DPARAM(4)
                    167:             DH21 = DPARAM(3)
                    168:             DH22 = DPARAM(5)
                    169:             DO I = 1,N
                    170:                W = DX(KX)
                    171:                Z = DY(KY)
                    172:                DX(KX) = W*DH11 + Z*DH12
                    173:                DY(KY) = W*DH21 + Z*DH22
                    174:                KX = KX + INCX
                    175:                KY = KY + INCY
                    176:             END DO
                    177:          ELSE IF (DFLAG.EQ.ZERO) THEN
                    178:             DH12 = DPARAM(4)
                    179:             DH21 = DPARAM(3)
                    180:             DO I = 1,N
                    181:                W = DX(KX)
                    182:                Z = DY(KY)
                    183:                DX(KX) = W + Z*DH12
                    184:                DY(KY) = W*DH21 + Z
                    185:                KX = KX + INCX
                    186:                KY = KY + INCY
                    187:             END DO
                    188:          ELSE
                    189:              DH11 = DPARAM(2)
                    190:              DH22 = DPARAM(5)
                    191:              DO I = 1,N
                    192:                 W = DX(KX)
                    193:                 Z = DY(KY)
                    194:                 DX(KX) = W*DH11 + Z
                    195:                 DY(KY) = -W + DH22*Z
                    196:                 KX = KX + INCX
                    197:                 KY = KY + INCY
                    198:             END DO
                    199:          END IF
1.4       bertrand  200:       END IF
1.1       bertrand  201:       RETURN
                    202:       END

CVSweb interface <joel.bertrand@systella.fr>