File:  [local] / rpl / lapack / blas / drotm.f
Revision 1.7: download - view: text, annotated - select for diffs - revision graph
Tue Dec 21 13:51:25 2010 UTC (13 years, 5 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_0, rpl-4_0_24, rpl-4_0_22, rpl-4_0_21, rpl-4_0_20, rpl-4_0, HEAD
Mise à jour de lapack vers la version 3.3.0

    1:       SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
    2: *     .. Scalar Arguments ..
    3:       INTEGER INCX,INCY,N
    4: *     ..
    5: *     .. Array Arguments ..
    6:       DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
    7: *     ..
    8: *
    9: *  Purpose
   10: *  =======
   11: *
   12: *     APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
   13: *
   14: *     (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
   15: *     (DY**T)
   16: *
   17: *     DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
   18: *     LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
   19: *     WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
   20: *
   21: *     DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0
   22: *
   23: *       (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)
   24: *     H=(          )    (          )    (          )    (          )
   25: *       (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).
   26: *     SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
   27: *
   28: *  Arguments
   29: *  =========
   30: *
   31: *  N      (input) INTEGER
   32: *         number of elements in input vector(s)
   33: *
   34: *  DX     (input/output) DOUBLE PRECISION array, dimension N
   35: *         double precision vector with N elements
   36: *
   37: *  INCX   (input) INTEGER
   38: *         storage spacing between elements of DX
   39: *
   40: *  DY     (input/output) DOUBLE PRECISION array, dimension N
   41: *         double precision vector with N elements
   42: *
   43: *  INCY   (input) INTEGER
   44: *         storage spacing between elements of DY
   45: *
   46: *  DPARAM (input/output)  DOUBLE PRECISION array, dimension 5 
   47: *     DPARAM(1)=DFLAG
   48: *     DPARAM(2)=DH11
   49: *     DPARAM(3)=DH21
   50: *     DPARAM(4)=DH12
   51: *     DPARAM(5)=DH22
   52: *
   53: *  =====================================================================
   54: *
   55: *     .. Local Scalars ..
   56:       DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
   57:       INTEGER I,KX,KY,NSTEPS
   58: *     ..
   59: *     .. Data statements ..
   60:       DATA ZERO,TWO/0.D0,2.D0/
   61: *     ..
   62: *
   63:       DFLAG = DPARAM(1)
   64:       IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) GO TO 140
   65:       IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70
   66: *
   67:       NSTEPS = N*INCX
   68:       IF (DFLAG.LT.ZERO) THEN
   69:          GO TO 50
   70:       ELSE IF (DFLAG.EQ.ZERO) THEN
   71:          GO TO 10 
   72:       ELSE
   73:          GO TO 30
   74:       END IF
   75:    10 CONTINUE
   76:       DH12 = DPARAM(4)
   77:       DH21 = DPARAM(3)
   78:       DO 20 I = 1,NSTEPS,INCX
   79:           W = DX(I)
   80:           Z = DY(I)
   81:           DX(I) = W + Z*DH12
   82:           DY(I) = W*DH21 + Z
   83:    20 CONTINUE
   84:       GO TO 140
   85:    30 CONTINUE
   86:       DH11 = DPARAM(2)
   87:       DH22 = DPARAM(5)
   88:       DO 40 I = 1,NSTEPS,INCX
   89:           W = DX(I)
   90:           Z = DY(I)
   91:           DX(I) = W*DH11 + Z
   92:           DY(I) = -W + DH22*Z
   93:    40 CONTINUE
   94:       GO TO 140
   95:    50 CONTINUE
   96:       DH11 = DPARAM(2)
   97:       DH12 = DPARAM(4)
   98:       DH21 = DPARAM(3)
   99:       DH22 = DPARAM(5)
  100:       DO 60 I = 1,NSTEPS,INCX
  101:           W = DX(I)
  102:           Z = DY(I)
  103:           DX(I) = W*DH11 + Z*DH12
  104:           DY(I) = W*DH21 + Z*DH22
  105:    60 CONTINUE
  106:       GO TO 140
  107:    70 CONTINUE
  108:       KX = 1
  109:       KY = 1
  110:       IF (INCX.LT.0) KX = 1 + (1-N)*INCX
  111:       IF (INCY.LT.0) KY = 1 + (1-N)*INCY
  112: *
  113:       IF (DFLAG.LT.ZERO) THEN
  114:          GO TO 120
  115:       ELSE IF (DFLAG.EQ.ZERO) THEN
  116:          GO TO 80 
  117:       ELSE
  118:          GO TO 100
  119:       END IF
  120:    80 CONTINUE
  121:       DH12 = DPARAM(4)
  122:       DH21 = DPARAM(3)
  123:       DO 90 I = 1,N
  124:           W = DX(KX)
  125:           Z = DY(KY)
  126:           DX(KX) = W + Z*DH12
  127:           DY(KY) = W*DH21 + Z
  128:           KX = KX + INCX
  129:           KY = KY + INCY
  130:    90 CONTINUE
  131:       GO TO 140
  132:   100 CONTINUE
  133:       DH11 = DPARAM(2)
  134:       DH22 = DPARAM(5)
  135:       DO 110 I = 1,N
  136:           W = DX(KX)
  137:           Z = DY(KY)
  138:           DX(KX) = W*DH11 + Z
  139:           DY(KY) = -W + DH22*Z
  140:           KX = KX + INCX
  141:           KY = KY + INCY
  142:   110 CONTINUE
  143:       GO TO 140
  144:   120 CONTINUE
  145:       DH11 = DPARAM(2)
  146:       DH12 = DPARAM(4)
  147:       DH21 = DPARAM(3)
  148:       DH22 = DPARAM(5)
  149:       DO 130 I = 1,N
  150:           W = DX(KX)
  151:           Z = DY(KY)
  152:           DX(KX) = W*DH11 + Z*DH12
  153:           DY(KY) = W*DH21 + Z*DH22
  154:           KX = KX + INCX
  155:           KY = KY + INCY
  156:   130 CONTINUE
  157:   140 CONTINUE
  158:       RETURN
  159:       END

CVSweb interface <joel.bertrand@systella.fr>