LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM) 00002 * .. Scalar Arguments .. 00003 INTEGER INCX,INCY,N 00004 * .. 00005 * .. Array Arguments .. 00006 DOUBLE PRECISION DPARAM(5),DX(*),DY(*) 00007 * .. 00008 * 00009 * Purpose 00010 * ======= 00011 * 00012 * APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX 00013 * 00014 * (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN 00015 * (DY**T) 00016 * 00017 * DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE 00018 * LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. 00019 * WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. 00020 * 00021 * DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 00022 * 00023 * (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) 00024 * H=( ) ( ) ( ) ( ) 00025 * (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). 00026 * SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. 00027 * 00028 * Arguments 00029 * ========= 00030 * 00031 * N (input) INTEGER 00032 * number of elements in input vector(s) 00033 * 00034 * DX (input/output) DOUBLE PRECISION array, dimension N 00035 * double precision vector with N elements 00036 * 00037 * INCX (input) INTEGER 00038 * storage spacing between elements of DX 00039 * 00040 * DY (input/output) DOUBLE PRECISION array, dimension N 00041 * double precision vector with N elements 00042 * 00043 * INCY (input) INTEGER 00044 * storage spacing between elements of DY 00045 * 00046 * DPARAM (input/output) DOUBLE PRECISION array, dimension 5 00047 * DPARAM(1)=DFLAG 00048 * DPARAM(2)=DH11 00049 * DPARAM(3)=DH21 00050 * DPARAM(4)=DH12 00051 * DPARAM(5)=DH22 00052 * 00053 * ===================================================================== 00054 * 00055 * .. Local Scalars .. 00056 DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO 00057 INTEGER I,KX,KY,NSTEPS 00058 * .. 00059 * .. Data statements .. 00060 DATA ZERO,TWO/0.D0,2.D0/ 00061 * .. 00062 * 00063 DFLAG = DPARAM(1) 00064 IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN 00065 IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN 00066 * 00067 NSTEPS = N*INCX 00068 IF (DFLAG.LT.ZERO) THEN 00069 DH11 = DPARAM(2) 00070 DH12 = DPARAM(4) 00071 DH21 = DPARAM(3) 00072 DH22 = DPARAM(5) 00073 DO I = 1,NSTEPS,INCX 00074 W = DX(I) 00075 Z = DY(I) 00076 DX(I) = W*DH11 + Z*DH12 00077 DY(I) = W*DH21 + Z*DH22 00078 END DO 00079 ELSE IF (DFLAG.EQ.ZERO) THEN 00080 DH12 = DPARAM(4) 00081 DH21 = DPARAM(3) 00082 DO I = 1,NSTEPS,INCX 00083 W = DX(I) 00084 Z = DY(I) 00085 DX(I) = W + Z*DH12 00086 DY(I) = W*DH21 + Z 00087 END DO 00088 ELSE 00089 DH11 = DPARAM(2) 00090 DH22 = DPARAM(5) 00091 DO I = 1,NSTEPS,INCX 00092 W = DX(I) 00093 Z = DY(I) 00094 DX(I) = W*DH11 + Z 00095 DY(I) = -W + DH22*Z 00096 END DO 00097 END IF 00098 ELSE 00099 KX = 1 00100 KY = 1 00101 IF (INCX.LT.0) KX = 1 + (1-N)*INCX 00102 IF (INCY.LT.0) KY = 1 + (1-N)*INCY 00103 * 00104 IF (DFLAG.LT.ZERO) THEN 00105 DH11 = DPARAM(2) 00106 DH12 = DPARAM(4) 00107 DH21 = DPARAM(3) 00108 DH22 = DPARAM(5) 00109 DO I = 1,N 00110 W = DX(KX) 00111 Z = DY(KY) 00112 DX(KX) = W*DH11 + Z*DH12 00113 DY(KY) = W*DH21 + Z*DH22 00114 KX = KX + INCX 00115 KY = KY + INCY 00116 END DO 00117 ELSE IF (DFLAG.EQ.ZERO) THEN 00118 DH12 = DPARAM(4) 00119 DH21 = DPARAM(3) 00120 DO I = 1,N 00121 W = DX(KX) 00122 Z = DY(KY) 00123 DX(KX) = W + Z*DH12 00124 DY(KY) = W*DH21 + Z 00125 KX = KX + INCX 00126 KY = KY + INCY 00127 END DO 00128 ELSE 00129 DH11 = DPARAM(2) 00130 DH22 = DPARAM(5) 00131 DO I = 1,N 00132 W = DX(KX) 00133 Z = DY(KY) 00134 DX(KX) = W*DH11 + Z 00135 DY(KY) = -W + DH22*Z 00136 KX = KX + INCX 00137 KY = KY + INCY 00138 END DO 00139 END IF 00140 END IF 00141 RETURN 00142 END