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

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.15    ! bertrand   92: *> \date November 2017
1.1       bertrand   93: *
1.9       bertrand   94: *> \ingroup double_blas_level1
1.1       bertrand   95: *
1.9       bertrand   96: *  =====================================================================
                     97:       SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
1.1       bertrand   98: *
1.15    ! bertrand   99: *  -- Reference BLAS level1 routine (version 3.8.0) --
1.9       bertrand  100: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
                    101: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.15    ! bertrand  102: *     November 2017
1.1       bertrand  103: *
1.9       bertrand  104: *     .. Scalar Arguments ..
                    105:       INTEGER INCX,INCY,N
                    106: *     ..
                    107: *     .. Array Arguments ..
                    108:       DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
                    109: *     ..
1.1       bertrand  110: *
                    111: *  =====================================================================
                    112: *
                    113: *     .. Local Scalars ..
                    114:       DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
                    115:       INTEGER I,KX,KY,NSTEPS
                    116: *     ..
                    117: *     .. Data statements ..
                    118:       DATA ZERO,TWO/0.D0,2.D0/
                    119: *     ..
                    120: *
                    121:       DFLAG = DPARAM(1)
1.8       bertrand  122:       IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN
                    123:       IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
1.1       bertrand  124: *
1.8       bertrand  125:          NSTEPS = N*INCX
                    126:          IF (DFLAG.LT.ZERO) THEN
                    127:             DH11 = DPARAM(2)
                    128:             DH12 = DPARAM(4)
                    129:             DH21 = DPARAM(3)
                    130:             DH22 = DPARAM(5)
                    131:             DO I = 1,NSTEPS,INCX
                    132:                W = DX(I)
                    133:                Z = DY(I)
                    134:                DX(I) = W*DH11 + Z*DH12
                    135:                DY(I) = W*DH21 + Z*DH22
                    136:             END DO
                    137:          ELSE IF (DFLAG.EQ.ZERO) THEN
                    138:             DH12 = DPARAM(4)
                    139:             DH21 = DPARAM(3)
                    140:             DO I = 1,NSTEPS,INCX
                    141:                W = DX(I)
                    142:                Z = DY(I)
                    143:                DX(I) = W + Z*DH12
                    144:                DY(I) = W*DH21 + Z
                    145:             END DO
                    146:          ELSE
                    147:             DH11 = DPARAM(2)
                    148:             DH22 = DPARAM(5)
                    149:             DO I = 1,NSTEPS,INCX
                    150:                W = DX(I)
                    151:                Z = DY(I)
                    152:                DX(I) = W*DH11 + Z
                    153:                DY(I) = -W + DH22*Z
                    154:             END DO
                    155:          END IF
1.4       bertrand  156:       ELSE
1.8       bertrand  157:          KX = 1
                    158:          KY = 1
                    159:          IF (INCX.LT.0) KX = 1 + (1-N)*INCX
                    160:          IF (INCY.LT.0) KY = 1 + (1-N)*INCY
1.1       bertrand  161: *
1.8       bertrand  162:          IF (DFLAG.LT.ZERO) THEN
                    163:             DH11 = DPARAM(2)
                    164:             DH12 = DPARAM(4)
                    165:             DH21 = DPARAM(3)
                    166:             DH22 = DPARAM(5)
                    167:             DO I = 1,N
                    168:                W = DX(KX)
                    169:                Z = DY(KY)
                    170:                DX(KX) = W*DH11 + Z*DH12
                    171:                DY(KY) = W*DH21 + Z*DH22
                    172:                KX = KX + INCX
                    173:                KY = KY + INCY
                    174:             END DO
                    175:          ELSE IF (DFLAG.EQ.ZERO) THEN
                    176:             DH12 = DPARAM(4)
                    177:             DH21 = DPARAM(3)
                    178:             DO I = 1,N
                    179:                W = DX(KX)
                    180:                Z = DY(KY)
                    181:                DX(KX) = W + Z*DH12
                    182:                DY(KY) = W*DH21 + Z
                    183:                KX = KX + INCX
                    184:                KY = KY + INCY
                    185:             END DO
                    186:          ELSE
                    187:              DH11 = DPARAM(2)
                    188:              DH22 = DPARAM(5)
                    189:              DO I = 1,N
                    190:                 W = DX(KX)
                    191:                 Z = DY(KY)
                    192:                 DX(KX) = W*DH11 + Z
                    193:                 DY(KY) = -W + DH22*Z
                    194:                 KX = KX + INCX
                    195:                 KY = KY + INCY
                    196:             END DO
                    197:          END IF
1.4       bertrand  198:       END IF
1.1       bertrand  199:       RETURN
                    200:       END

CVSweb interface <joel.bertrand@systella.fr>