OpenBLAS/reference/drotmgf.f at v0.3.22 · OpenMathLib/OpenBLAS · GitHub

Name: OpenBLAS/reference/drotmgf.f at v0.3.22 · OpenMathLib/OpenBLAS · GitHub
Rating: 4.4 (9752 reviews)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
SUBROUTINEDROTMGF (DD1,DD2,DX1,DY1,DPARAM)
C
C CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
C THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)*
C DY2)**T.
C WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
C
C DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
C
C (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
C H=( ) ( ) ( ) ( )
C (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
C LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22
C RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE
C VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)
C
C THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
C INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
C OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
C
DOUBLE PRECISION GAM,ONE,RGAMSQ,DD2,DH11,DH21,DPARAM,DP2,
1 DQ2,DU,DY1,ZERO,GAMSQ,DD1,DFLAG,DH12,DH22,DP1,DQ1,
2 DTEMP,DX1,TWO
DIMENSION DPARAM(5)
C
DATA ZERO,ONE,TWO /0.D0,1.D0,2.D0/
DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/
IF(.NOT. DD1 .LT. ZERO) GO TO10
C GO ZERO-H-D-AND-DX1..
GO TO60
10CONTINUE
C CASE-DD1-NONNEGATIVE
 DP2=DD2*DY1
IF(.NOT. DP2 .EQ. ZERO) GO TO20
 DFLAG=-TWO
GO TO260
C REGULAR-CASE..
20CONTINUE
 DP1=DD1*DX1
 DQ2=DP2*DY1
 DQ1=DP1*DX1
C
IF(.NOT. DABS(DQ1) .GT. DABS(DQ2)) GO TO40
 DH21=-DY1/DX1
 DH12=DP2/DP1
C
 DU=ONE-DH12*DH21
C
IF(.NOT. DU .LE. ZERO) GO TO30
C GO ZERO-H-D-AND-DX1..
GO TO60
30CONTINUE
 DFLAG=ZERO
 DD1=DD1/DU
 DD2=DD2/DU
 DX1=DX1*DU
C GO SCALE-CHECK..
GO TO100
40CONTINUE
IF(.NOT. DQ2 .LT. ZERO) GO TO50
C GO ZERO-H-D-AND-DX1..
GO TO60
50CONTINUE
 DFLAG=ONE
 DH11=DP1/DP2
 DH22=DX1/DY1
 DU=ONE+DH11*DH22
 DTEMP=DD2/DU
 DD2=DD1/DU
 DD1=DTEMP
 DX1=DY1*DU
C GO SCALE-CHECK
GO TO100
C PROCEDURE..ZERO-H-D-AND-DX1..
60CONTINUE
 DFLAG=-ONE
 DH11=ZERO
 DH12=ZERO
 DH21=ZERO
 DH22=ZERO
C
 DD1=ZERO
 DD2=ZERO
 DX1=ZERO
C RETURN..
GO TO220
C PROCEDURE..FIX-H..
70CONTINUE
IF(.NOT. DFLAG .GE. ZERO) GO TO90
C
IF(.NOT. DFLAG .EQ. ZERO) GO TO80
 DH11=ONE
 DH22=ONE
 DFLAG=-ONE
GO TO90
80CONTINUE
 DH21=-ONE
 DH12=ONE
 DFLAG=-ONE
90CONTINUE
GO TO IGO,(120,150,180,210)
C PROCEDURE..SCALE-CHECK
100CONTINUE
110CONTINUE
IF(.NOT. DD1 .LE. RGAMSQ) GO TO130
IF(DD1 .EQ. ZERO) GO TO160
ASSIGN120TO IGO
C FIX-H..
GO TO70
120CONTINUE
 DD1=DD1*GAM**2
 DX1=DX1/GAM
 DH11=DH11/GAM
 DH12=DH12/GAM
GO TO110
130CONTINUE
140CONTINUE
IF(.NOT. DD1 .GE. GAMSQ) GO TO160
ASSIGN150TO IGO
C FIX-H..
GO TO70
150CONTINUE
 DD1=DD1/GAM**2
 DX1=DX1*GAM
 DH11=DH11*GAM
 DH12=DH12*GAM
GO TO140
160CONTINUE
170CONTINUE
IF(.NOT. DABS(DD2) .LE. RGAMSQ) GO TO190
IF(DD2 .EQ. ZERO) GO TO220
ASSIGN180TO IGO
C FIX-H..
GO TO70
180CONTINUE
 DD2=DD2*GAM**2
 DH21=DH21/GAM
 DH22=DH22/GAM
GO TO170
190CONTINUE
200CONTINUE
IF(.NOT. DABS(DD2) .GE. GAMSQ) GO TO220
ASSIGN210TO IGO
C FIX-H..
GO TO70
210CONTINUE
 DD2=DD2/GAM**2
 DH21=DH21*GAM
 DH22=DH22*GAM
GO TO200
220CONTINUE
IF(DFLAG)250,230,240
230CONTINUE
 DPARAM(3)=DH21
 DPARAM(4)=DH12
GO TO260
240CONTINUE
 DPARAM(2)=DH11
 DPARAM(5)=DH22
GO TO260
250CONTINUE
 DPARAM(2)=DH11
 DPARAM(3)=DH21
 DPARAM(4)=DH12
 DPARAM(5)=DH22
260CONTINUE
 DPARAM(1)=DFLAG
RETURN
END