001: SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM) 002: * .. Scalar Arguments .. 003: INTEGER INCX,INCY,N 004: * .. 005: * .. Array Arguments .. 006: DOUBLE PRECISION DPARAM(5),DX(1),DY(1) 007: * .. 008: * 009: * Purpose 010: * ======= 011: * 012: * APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX 013: * 014: * (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN 015: * (DY**T) 016: * 017: * DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE 018: * LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. 019: * WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. 020: * 021: * DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 022: * 023: * (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) 024: * H=( ) ( ) ( ) ( ) 025: * (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). 026: * SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. 027: * 028: * Arguments 029: * ========= 030: * 031: * N (input) INTEGER 032: * number of elements in input vector(s) 033: * 034: * DX (input/output) DOUBLE PRECISION array, dimension N 035: * double precision vector with 5 elements 036: * 037: * INCX (input) INTEGER 038: * storage spacing between elements of DX 039: * 040: * DY (input/output) DOUBLE PRECISION array, dimension N 041: * double precision vector with N elements 042: * 043: * INCY (input) INTEGER 044: * storage spacing between elements of DY 045: * 046: * DPARAM (input/output) DOUBLE PRECISION array, dimension 5 047: * DPARAM(1)=DFLAG 048: * DPARAM(2)=DH11 049: * DPARAM(3)=DH21 050: * DPARAM(4)=DH12 051: * DPARAM(5)=DH22 052: * 053: * ===================================================================== 054: * 055: * .. Local Scalars .. 056: DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO 057: INTEGER I,KX,KY,NSTEPS 058: * .. 059: * .. Data statements .. 060: DATA ZERO,TWO/0.D0,2.D0/ 061: * .. 062: * 063: DFLAG = DPARAM(1) 064: IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) GO TO 140 065: IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70 066: * 067: NSTEPS = N*INCX 068: IF (DFLAG) 50,10,30 069: 10 CONTINUE 070: DH12 = DPARAM(4) 071: DH21 = DPARAM(3) 072: DO 20 I = 1,NSTEPS,INCX 073: W = DX(I) 074: Z = DY(I) 075: DX(I) = W + Z*DH12 076: DY(I) = W*DH21 + Z 077: 20 CONTINUE 078: GO TO 140 079: 30 CONTINUE 080: DH11 = DPARAM(2) 081: DH22 = DPARAM(5) 082: DO 40 I = 1,NSTEPS,INCX 083: W = DX(I) 084: Z = DY(I) 085: DX(I) = W*DH11 + Z 086: DY(I) = -W + DH22*Z 087: 40 CONTINUE 088: GO TO 140 089: 50 CONTINUE 090: DH11 = DPARAM(2) 091: DH12 = DPARAM(4) 092: DH21 = DPARAM(3) 093: DH22 = DPARAM(5) 094: DO 60 I = 1,NSTEPS,INCX 095: W = DX(I) 096: Z = DY(I) 097: DX(I) = W*DH11 + Z*DH12 098: DY(I) = W*DH21 + Z*DH22 099: 60 CONTINUE 100: GO TO 140 101: 70 CONTINUE 102: KX = 1 103: KY = 1 104: IF (INCX.LT.0) KX = 1 + (1-N)*INCX 105: IF (INCY.LT.0) KY = 1 + (1-N)*INCY 106: * 107: IF (DFLAG) 120,80,100 108: 80 CONTINUE 109: DH12 = DPARAM(4) 110: DH21 = DPARAM(3) 111: DO 90 I = 1,N 112: W = DX(KX) 113: Z = DY(KY) 114: DX(KX) = W + Z*DH12 115: DY(KY) = W*DH21 + Z 116: KX = KX + INCX 117: KY = KY + INCY 118: 90 CONTINUE 119: GO TO 140 120: 100 CONTINUE 121: DH11 = DPARAM(2) 122: DH22 = DPARAM(5) 123: DO 110 I = 1,N 124: W = DX(KX) 125: Z = DY(KY) 126: DX(KX) = W*DH11 + Z 127: DY(KY) = -W + DH22*Z 128: KX = KX + INCX 129: KY = KY + INCY 130: 110 CONTINUE 131: GO TO 140 132: 120 CONTINUE 133: DH11 = DPARAM(2) 134: DH12 = DPARAM(4) 135: DH21 = DPARAM(3) 136: DH22 = DPARAM(5) 137: DO 130 I = 1,N 138: W = DX(KX) 139: Z = DY(KY) 140: DX(KX) = W*DH11 + Z*DH12 141: DY(KY) = W*DH21 + Z*DH22 142: KX = KX + INCX 143: KY = KY + INCY 144: 130 CONTINUE 145: 140 CONTINUE 146: RETURN 147: END 148: