1 /* drotm.f -- translated by f2c (version 20100827). 2 You must link the resulting object file with libf2c: 3 on Microsoft Windows system, link with libf2c.lib; 4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 5 or, if you install libf2c.a in a standard place, with -lf2c -lm 6 -- in that order, at the end of the command line, as in 7 cc *.o -lf2c -lm 8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 9 10 http://www.netlib.org/f2c/libf2c.zip 11 */ 12 13 #include "datatypes.h" 14 15 /* Subroutine */ int drotm_(integer *n, doublereal *dx, integer *incx, 16 doublereal *dy, integer *incy, doublereal *dparam) 17 { 18 /* Initialized data */ 19 20 static doublereal zero = 0.; 21 static doublereal two = 2.; 22 23 /* System generated locals */ 24 integer i__1, i__2; 25 26 /* Local variables */ 27 integer i__; 28 doublereal w, z__; 29 integer kx, ky; 30 doublereal dh11, dh12, dh21, dh22, dflag; 31 integer nsteps; 32 33 /* .. Scalar Arguments .. */ 34 /* .. */ 35 /* .. Array Arguments .. */ 36 /* .. */ 37 38 /* Purpose */ 39 /* ======= */ 40 41 /* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX */ 42 43 /* (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN */ 44 /* (DY**T) */ 45 46 /* DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE */ 47 /* LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. */ 48 /* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */ 49 50 /* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 */ 51 52 /* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) */ 53 /* H=( ) ( ) ( ) ( ) */ 54 /* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). */ 55 /* SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. */ 56 57 /* Arguments */ 58 /* ========= */ 59 60 /* N (input) INTEGER */ 61 /* number of elements in input vector(s) */ 62 63 /* DX (input/output) DOUBLE PRECISION array, dimension N */ 64 /* double precision vector with N elements */ 65 66 /* INCX (input) INTEGER */ 67 /* storage spacing between elements of DX */ 68 69 /* DY (input/output) DOUBLE PRECISION array, dimension N */ 70 /* double precision vector with N elements */ 71 72 /* INCY (input) INTEGER */ 73 /* storage spacing between elements of DY */ 74 75 /* DPARAM (input/output) DOUBLE PRECISION array, dimension 5 */ 76 /* DPARAM(1)=DFLAG */ 77 /* DPARAM(2)=DH11 */ 78 /* DPARAM(3)=DH21 */ 79 /* DPARAM(4)=DH12 */ 80 /* DPARAM(5)=DH22 */ 81 82 /* ===================================================================== */ 83 84 /* .. Local Scalars .. */ 85 /* .. */ 86 /* .. Data statements .. */ 87 /* Parameter adjustments */ 88 --dparam; 89 --dy; 90 --dx; 91 92 /* Function Body */ 93 /* .. */ 94 95 dflag = dparam[1]; 96 if (*n <= 0 || dflag + two == zero) { 97 goto L140; 98 } 99 if (! (*incx == *incy && *incx > 0)) { 100 goto L70; 101 } 102 103 nsteps = *n * *incx; 104 if (dflag < 0.) { 105 goto L50; 106 } else if (dflag == 0) { 107 goto L10; 108 } else { 109 goto L30; 110 } 111 L10: 112 dh12 = dparam[4]; 113 dh21 = dparam[3]; 114 i__1 = nsteps; 115 i__2 = *incx; 116 for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { 117 w = dx[i__]; 118 z__ = dy[i__]; 119 dx[i__] = w + z__ * dh12; 120 dy[i__] = w * dh21 + z__; 121 /* L20: */ 122 } 123 goto L140; 124 L30: 125 dh11 = dparam[2]; 126 dh22 = dparam[5]; 127 i__2 = nsteps; 128 i__1 = *incx; 129 for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) { 130 w = dx[i__]; 131 z__ = dy[i__]; 132 dx[i__] = w * dh11 + z__; 133 dy[i__] = -w + dh22 * z__; 134 /* L40: */ 135 } 136 goto L140; 137 L50: 138 dh11 = dparam[2]; 139 dh12 = dparam[4]; 140 dh21 = dparam[3]; 141 dh22 = dparam[5]; 142 i__1 = nsteps; 143 i__2 = *incx; 144 for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) { 145 w = dx[i__]; 146 z__ = dy[i__]; 147 dx[i__] = w * dh11 + z__ * dh12; 148 dy[i__] = w * dh21 + z__ * dh22; 149 /* L60: */ 150 } 151 goto L140; 152 L70: 153 kx = 1; 154 ky = 1; 155 if (*incx < 0) { 156 kx = (1 - *n) * *incx + 1; 157 } 158 if (*incy < 0) { 159 ky = (1 - *n) * *incy + 1; 160 } 161 162 if (dflag < 0.) { 163 goto L120; 164 } else if (dflag == 0) { 165 goto L80; 166 } else { 167 goto L100; 168 } 169 L80: 170 dh12 = dparam[4]; 171 dh21 = dparam[3]; 172 i__2 = *n; 173 for (i__ = 1; i__ <= i__2; ++i__) { 174 w = dx[kx]; 175 z__ = dy[ky]; 176 dx[kx] = w + z__ * dh12; 177 dy[ky] = w * dh21 + z__; 178 kx += *incx; 179 ky += *incy; 180 /* L90: */ 181 } 182 goto L140; 183 L100: 184 dh11 = dparam[2]; 185 dh22 = dparam[5]; 186 i__2 = *n; 187 for (i__ = 1; i__ <= i__2; ++i__) { 188 w = dx[kx]; 189 z__ = dy[ky]; 190 dx[kx] = w * dh11 + z__; 191 dy[ky] = -w + dh22 * z__; 192 kx += *incx; 193 ky += *incy; 194 /* L110: */ 195 } 196 goto L140; 197 L120: 198 dh11 = dparam[2]; 199 dh12 = dparam[4]; 200 dh21 = dparam[3]; 201 dh22 = dparam[5]; 202 i__2 = *n; 203 for (i__ = 1; i__ <= i__2; ++i__) { 204 w = dx[kx]; 205 z__ = dy[ky]; 206 dx[kx] = w * dh11 + z__ * dh12; 207 dy[ky] = w * dh21 + z__ * dh22; 208 kx += *incx; 209 ky += *incy; 210 /* L130: */ 211 } 212 L140: 213 return 0; 214 } /* drotm_ */ 215 216
