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