|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
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)) GO TO 140 00065 IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70 00066 * 00067 NSTEPS = N*INCX 00068 IF (DFLAG.LT.ZERO) THEN 00069 GO TO 50 00070 ELSE IF (DFLAG.EQ.ZERO) THEN 00071 GO TO 10 00072 ELSE 00073 GO TO 30 00074 END IF 00075 10 CONTINUE 00076 DH12 = DPARAM(4) 00077 DH21 = DPARAM(3) 00078 DO 20 I = 1,NSTEPS,INCX 00079 W = DX(I) 00080 Z = DY(I) 00081 DX(I) = W + Z*DH12 00082 DY(I) = W*DH21 + Z 00083 20 CONTINUE 00084 GO TO 140 00085 30 CONTINUE 00086 DH11 = DPARAM(2) 00087 DH22 = DPARAM(5) 00088 DO 40 I = 1,NSTEPS,INCX 00089 W = DX(I) 00090 Z = DY(I) 00091 DX(I) = W*DH11 + Z 00092 DY(I) = -W + DH22*Z 00093 40 CONTINUE 00094 GO TO 140 00095 50 CONTINUE 00096 DH11 = DPARAM(2) 00097 DH12 = DPARAM(4) 00098 DH21 = DPARAM(3) 00099 DH22 = DPARAM(5) 00100 DO 60 I = 1,NSTEPS,INCX 00101 W = DX(I) 00102 Z = DY(I) 00103 DX(I) = W*DH11 + Z*DH12 00104 DY(I) = W*DH21 + Z*DH22 00105 60 CONTINUE 00106 GO TO 140 00107 70 CONTINUE 00108 KX = 1 00109 KY = 1 00110 IF (INCX.LT.0) KX = 1 + (1-N)*INCX 00111 IF (INCY.LT.0) KY = 1 + (1-N)*INCY 00112 * 00113 IF (DFLAG.LT.ZERO) THEN 00114 GO TO 120 00115 ELSE IF (DFLAG.EQ.ZERO) THEN 00116 GO TO 80 00117 ELSE 00118 GO TO 100 00119 END IF 00120 80 CONTINUE 00121 DH12 = DPARAM(4) 00122 DH21 = DPARAM(3) 00123 DO 90 I = 1,N 00124 W = DX(KX) 00125 Z = DY(KY) 00126 DX(KX) = W + Z*DH12 00127 DY(KY) = W*DH21 + Z 00128 KX = KX + INCX 00129 KY = KY + INCY 00130 90 CONTINUE 00131 GO TO 140 00132 100 CONTINUE 00133 DH11 = DPARAM(2) 00134 DH22 = DPARAM(5) 00135 DO 110 I = 1,N 00136 W = DX(KX) 00137 Z = DY(KY) 00138 DX(KX) = W*DH11 + Z 00139 DY(KY) = -W + DH22*Z 00140 KX = KX + INCX 00141 KY = KY + INCY 00142 110 CONTINUE 00143 GO TO 140 00144 120 CONTINUE 00145 DH11 = DPARAM(2) 00146 DH12 = DPARAM(4) 00147 DH21 = DPARAM(3) 00148 DH22 = DPARAM(5) 00149 DO 130 I = 1,N 00150 W = DX(KX) 00151 Z = DY(KY) 00152 DX(KX) = W*DH11 + Z*DH12 00153 DY(KY) = W*DH21 + Z*DH22 00154 KX = KX + INCX 00155 KY = KY + INCY 00156 130 CONTINUE 00157 140 CONTINUE 00158 RETURN 00159 END
1.7.3 
