1 SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM) 2C***BEGIN PROLOGUE DROTMG 3C***DATE WRITTEN 780301 (YYMMDD) 4C***REVISION DATE 820801 (YYMMDD) 5C***CATEGORY NO. D1B10 6C***KEYWORDS BLAS,LINEAR ALGEBRA,MODIFIED GIVENS ROTATION,VECTOR 7C***AUTHOR LAWSON, C. L., (JPL) 8C HANSON, R. J., (SNLA) 9C KINCAID, D. R., (U. OF TEXAS) 10C KROGH, F. T., (JPL) 11C***PURPOSE Construct d.p. modified Givens transformation 12C***DESCRIPTION 13C 14C B L A S Subprogram 15C Description of Parameters 16C 17C --Input-- 18C DD1 double precision scalar 19C DD2 double precision scalar 20C DX1 double precision scalar 21C DX2 double precision scalar 22C DPARAM D.P. 5-vector. DPARAM(1)=DFLAG defined below. 23C Elements 2-5 define the transformation matrix H. 24C 25C --Output-- 26C DD1 changed to represent the effect of the transformation 27C DD2 changed to reflect the transformation 28C DX1 changed to reflect the transformation 29C DX2 unchanged 30C 31C Construct the modified Givens transformation matrix H which zeros 32C the second component of the 2-vector (DSQRT(DD1)*DX1,DSQRT(DD2)* 33C DY2)**T. 34C With DPARAM(1)=DFLAG, H has one of the following forms.. 35C 36C DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 37C 38C (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) 39C H=( ) ( ) ( ) ( ) 40C (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). 41C 42C Locations 2-5 of DPARAM contain DH11, DH21, DH12, and DH22 43C respectively. (Values of 1.D0, -1.D0, or 0.D0 implied by the 44C value of DPARAM(1) are not stored in DPARAM.) 45C***REFERENCES LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T., 46C *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*, 47C ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL 48C SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323 49C***ROUTINES CALLED (NONE) 50C***END PROLOGUE DROTMG 51C 52 DOUBLE PRECISION GAM,ONE,RGAMSQ,DD2,DH11,DH21,DPARAM,DP2, 53 1 DQ2,DU,DY1,ZERO,GAMSQ,DD1,DFLAG,DH12,DH22,DP1,DQ1, 54 2 DTEMP,DX1,TWO 55 DIMENSION DPARAM(5) 56 DATA ZERO,ONE,TWO /0.D0,1.D0,2.D0/ 57 DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/ 58C***FIRST EXECUTABLE STATEMENT DROTMG 59 IF(.NOT. DD1 .LT. ZERO) GO TO 10 60C GO ZERO-H-D-AND-DX1.. 61 GO TO 60 62 10 CONTINUE 63C CASE-DD1-NONNEGATIVE 64 DP2=DD2*DY1 65 IF(.NOT. DP2 .EQ. ZERO) GO TO 20 66 DFLAG=-TWO 67 GO TO 260 68C REGULAR-CASE.. 69 20 CONTINUE 70 DP1=DD1*DX1 71 DQ2=DP2*DY1 72 DQ1=DP1*DX1 73C 74 IF(.NOT. DABS(DQ1) .GT. DABS(DQ2)) GO TO 40 75 DH21=-DY1/DX1 76 DH12=DP2/DP1 77C 78 DU=ONE-DH12*DH21 79C 80 IF(.NOT. DU .LE. ZERO) GO TO 30 81C GO ZERO-H-D-AND-DX1.. 82 GO TO 60 83 30 CONTINUE 84 DFLAG=ZERO 85 DD1=DD1/DU 86 DD2=DD2/DU 87 DX1=DX1*DU 88C GO SCALE-CHECK.. 89 GO TO 100 90 40 CONTINUE 91 IF(.NOT. DQ2 .LT. ZERO) GO TO 50 92C GO ZERO-H-D-AND-DX1.. 93 GO TO 60 94 50 CONTINUE 95 DFLAG=ONE 96 DH11=DP1/DP2 97 DH22=DX1/DY1 98 DU=ONE+DH11*DH22 99 DTEMP=DD2/DU 100 DD2=DD1/DU 101 DD1=DTEMP 102 DX1=DY1*DU 103C GO SCALE-CHECK 104 GO TO 100 105C PROCEDURE..ZERO-H-D-AND-DX1.. 106 60 CONTINUE 107 DFLAG=-ONE 108 DH11=ZERO 109 DH12=ZERO 110 DH21=ZERO 111 DH22=ZERO 112C 113 DD1=ZERO 114 DD2=ZERO 115 DX1=ZERO 116C RETURN.. 117 GO TO 220 118C PROCEDURE..FIX-H.. 119 70 CONTINUE 120 IF(.NOT. DFLAG .GE. ZERO) GO TO 90 121C 122 IF(.NOT. DFLAG .EQ. ZERO) GO TO 80 123 DH11=ONE 124 DH22=ONE 125 DFLAG=-ONE 126 GO TO 90 127 80 CONTINUE 128 DH21=-ONE 129 DH12=ONE 130 DFLAG=-ONE 131 90 CONTINUE 132 GO TO IGO,(120,150,180,210) 133C PROCEDURE..SCALE-CHECK 134 100 CONTINUE 135 110 CONTINUE 136 IF(.NOT. DD1 .LE. RGAMSQ) GO TO 130 137 IF(DD1 .EQ. ZERO) GO TO 160 138 ASSIGN 120 TO IGO 139C FIX-H.. 140 GO TO 70 141 120 CONTINUE 142 DD1=DD1*GAM**2 143 DX1=DX1/GAM 144 DH11=DH11/GAM 145 DH12=DH12/GAM 146 GO TO 110 147 130 CONTINUE 148 140 CONTINUE 149 IF(.NOT. DD1 .GE. GAMSQ) GO TO 160 150 ASSIGN 150 TO IGO 151C FIX-H.. 152 GO TO 70 153 150 CONTINUE 154 DD1=DD1/GAM**2 155 DX1=DX1*GAM 156 DH11=DH11*GAM 157 DH12=DH12*GAM 158 GO TO 140 159 160 CONTINUE 160 170 CONTINUE 161 IF(.NOT. DABS(DD2) .LE. RGAMSQ) GO TO 190 162 IF(DD2 .EQ. ZERO) GO TO 220 163 ASSIGN 180 TO IGO 164C FIX-H.. 165 GO TO 70 166 180 CONTINUE 167 DD2=DD2*GAM**2 168 DH21=DH21/GAM 169 DH22=DH22/GAM 170 GO TO 170 171 190 CONTINUE 172 200 CONTINUE 173 IF(.NOT. DABS(DD2) .GE. GAMSQ) GO TO 220 174 ASSIGN 210 TO IGO 175C FIX-H.. 176 GO TO 70 177 210 CONTINUE 178 DD2=DD2/GAM**2 179 DH21=DH21*GAM 180 DH22=DH22*GAM 181 GO TO 200 182 220 CONTINUE 183 IF(DFLAG)250,230,240 184 230 CONTINUE 185 DPARAM(3)=DH21 186 DPARAM(4)=DH12 187 GO TO 260 188 240 CONTINUE 189 DPARAM(2)=DH11 190 DPARAM(5)=DH22 191 GO TO 260 192 250 CONTINUE 193 DPARAM(2)=DH11 194 DPARAM(3)=DH21 195 DPARAM(4)=DH12 196 DPARAM(5)=DH22 197 260 CONTINUE 198 DPARAM(1)=DFLAG 199 RETURN 200 END 201