![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.2.2.
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