Skip to content

Commit c362fff

Browse files
weslleyspereiraweslleyspereira
committed
Minor changes
1 parent cdc8f33 commit c362fff

File tree

4 files changed

+114
-58
lines changed

4 files changed

+114
-58
lines changed

‎BLAS/SRC/crotg.f90‎

Lines changed: 29 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@
6969
!
7070
!> \date December 2021
7171
!
72-
!> \ingroup OTHERauxiliary
72+
!> \ingroup single_blas_level1
7373
!
7474
!> \par Further Details:
7575
! =====================
@@ -136,24 +136,38 @@ subroutine CROTG( a, b, c, s )
136136
r = f
137137
else if( f == czero ) then
138138
c = zero
139-
g1 = max( abs(real(g)), abs(aimag(g)) )
140-
rtmax = sqrt( safmax/2 )
141-
if( g1 > rtmin .and. g1 < rtmax ) then
139+
if( real(g) == zero ) then
140+
r = abs(aimag(g))
141+
s = conjg( g ) / r
142+
elseif( aimag(g) == zero ) then
143+
r = abs(real(g))
144+
s = conjg( g ) / r
145+
else
146+
g1 = max( abs(real(g)), abs(aimag(g)) )
147+
rtmax = sqrt( safmax/2 )
148+
if( g1 > rtmin .and. g1 < rtmax ) then
142149
!
143150
! Use unscaled algorithm
144151
!
145-
d = abs( g )
146-
s = conjg( g ) / d
147-
r = d
148-
else
152+
! The following two lines can be replaced by `d = abs( g )`.
153+
! This algorithm do not use the intrinsic complex abs.
154+
g2 = ABSSQ( g )
155+
d = sqrt( g2 )
156+
s = conjg( g ) / d
157+
r = d
158+
else
149159
!
150160
! Use scaled algorithm
151161
!
152-
u = min( safmax, max( safmin, g1 ) )
153-
gs = g / u
154-
d = abs( gs )
155-
s = conjg( gs ) / d
156-
r = d*u
162+
u = min( safmax, max( safmin, g1 ) )
163+
gs = g / u
164+
! The following two lines can be replaced by `d = abs( gs )`.
165+
! This algorithm do not use the intrinsic complex abs.
166+
g2 = ABSSQ( gs )
167+
d = sqrt( g2 )
168+
s = conjg( gs ) / d
169+
r = d*u
170+
end if
157171
end if
158172
else
159173
f1 = max( abs(real(f)), abs(aimag(f)) )
@@ -192,7 +206,7 @@ subroutine CROTG( a, b, c, s )
192206
r = f / c
193207
else
194208
! f2 / sqrt(f2 * h2) < safmin, then
195-
! h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
209+
! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
196210
r = f * ( h2 / d )
197211
end if
198212
s = conjg( g ) * ( f / d )
@@ -248,7 +262,7 @@ subroutine CROTG( a, b, c, s )
248262
r = fs / c
249263
else
250264
! f2 / sqrt(f2 * h2) < safmin, then
251-
! h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
265+
! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
252266
r = fs * ( h2 / d )
253267
end if
254268
s = conjg( gs ) * ( fs / d )

‎BLAS/SRC/zrotg.f90‎

Lines changed: 29 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@
6969
!
7070
!> \date December 2021
7171
!
72-
!> \ingroup OTHERauxiliary
72+
!> \ingroup single_blas_level1
7373
!
7474
!> \par Further Details:
7575
! =====================
@@ -136,24 +136,38 @@ subroutine ZROTG( a, b, c, s )
136136
r = f
137137
else if( f == czero ) then
138138
c = zero
139-
g1 = max( abs(real(g)), abs(aimag(g)) )
140-
rtmax = sqrt( safmax/2 )
141-
if( g1 > rtmin .and. g1 < rtmax ) then
139+
if( real(g) == zero ) then
140+
r = abs(aimag(g))
141+
s = conjg( g ) / r
142+
elseif( aimag(g) == zero ) then
143+
r = abs(real(g))
144+
s = conjg( g ) / r
145+
else
146+
g1 = max( abs(real(g)), abs(aimag(g)) )
147+
rtmax = sqrt( safmax/2 )
148+
if( g1 > rtmin .and. g1 < rtmax ) then
142149
!
143150
! Use unscaled algorithm
144151
!
145-
d = abs( g )
146-
s = conjg( g ) / d
147-
r = d
148-
else
152+
! The following two lines can be replaced by `d = abs( g )`.
153+
! This algorithm do not use the intrinsic complex abs.
154+
g2 = ABSSQ( g )
155+
d = sqrt( g2 )
156+
s = conjg( g ) / d
157+
r = d
158+
else
149159
!
150160
! Use scaled algorithm
151161
!
152-
u = min( safmax, max( safmin, g1 ) )
153-
gs = g / u
154-
d = abs( gs )
155-
s = conjg( gs ) / d
156-
r = d*u
162+
u = min( safmax, max( safmin, g1 ) )
163+
gs = g / u
164+
! The following two lines can be replaced by `d = abs( gs )`.
165+
! This algorithm do not use the intrinsic complex abs.
166+
g2 = ABSSQ( gs )
167+
d = sqrt( g2 )
168+
s = conjg( gs ) / d
169+
r = d*u
170+
end if
157171
end if
158172
else
159173
f1 = max( abs(real(f)), abs(aimag(f)) )
@@ -192,7 +206,7 @@ subroutine ZROTG( a, b, c, s )
192206
r = f / c
193207
else
194208
! f2 / sqrt(f2 * h2) < safmin, then
195-
! h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
209+
! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
196210
r = f * ( h2 / d )
197211
end if
198212
s = conjg( g ) * ( f / d )
@@ -248,7 +262,7 @@ subroutine ZROTG( a, b, c, s )
248262
r = fs / c
249263
else
250264
! f2 / sqrt(f2 * h2) < safmin, then
251-
! h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
265+
! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
252266
r = fs * ( h2 / d )
253267
end if
254268
s = conjg( gs ) * ( fs / d )

‎SRC/clartg.f90‎

Lines changed: 28 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -150,24 +150,38 @@ subroutine CLARTG( f, g, c, s, r )
150150
r = f
151151
else if( f == czero ) then
152152
c = zero
153-
g1 = max( abs(real(g)), abs(aimag(g)) )
154-
rtmax = sqrt( safmax/2 )
155-
if( g1 > rtmin .and. g1 < rtmax ) then
153+
if( real(g) == zero ) then
154+
r = abs(aimag(g))
155+
s = conjg( g ) / r
156+
elseif( aimag(g) == zero ) then
157+
r = abs(real(g))
158+
s = conjg( g ) / r
159+
else
160+
g1 = max( abs(real(g)), abs(aimag(g)) )
161+
rtmax = sqrt( safmax/2 )
162+
if( g1 > rtmin .and. g1 < rtmax ) then
156163
!
157164
! Use unscaled algorithm
158165
!
159-
d = abs( g )
160-
s = conjg( g ) / d
161-
r = d
162-
else
166+
! The following two lines can be replaced by `d = abs( g )`.
167+
! This algorithm do not use the intrinsic complex abs.
168+
g2 = ABSSQ( g )
169+
d = sqrt( g2 )
170+
s = conjg( g ) / d
171+
r = d
172+
else
163173
!
164174
! Use scaled algorithm
165175
!
166-
u = min( safmax, max( safmin, g1 ) )
167-
gs = g / u
168-
d = abs( gs )
169-
s = conjg( gs ) / d
170-
r = d*u
176+
u = min( safmax, max( safmin, g1 ) )
177+
gs = g / u
178+
! The following two lines can be replaced by `d = abs( gs )`.
179+
! This algorithm do not use the intrinsic complex abs.
180+
g2 = ABSSQ( gs )
181+
d = sqrt( g2 )
182+
s = conjg( gs ) / d
183+
r = d*u
184+
end if
171185
end if
172186
else
173187
f1 = max( abs(real(f)), abs(aimag(f)) )
@@ -206,7 +220,7 @@ subroutine CLARTG( f, g, c, s, r )
206220
r = f / c
207221
else
208222
! f2 / sqrt(f2 * h2) < safmin, then
209-
! h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
223+
! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
210224
r = f * ( h2 / d )
211225
end if
212226
s = conjg( g ) * ( f / d )
@@ -262,7 +276,7 @@ subroutine CLARTG( f, g, c, s, r )
262276
r = fs / c
263277
else
264278
! f2 / sqrt(f2 * h2) < safmin, then
265-
! h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
279+
! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
266280
r = fs * ( h2 / d )
267281
end if
268282
s = conjg( gs ) * ( fs / d )

‎SRC/zlartg.f90‎

Lines changed: 28 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -150,24 +150,38 @@ subroutine ZLARTG( f, g, c, s, r )
150150
r = f
151151
else if( f == czero ) then
152152
c = zero
153-
g1 = max( abs(real(g)), abs(aimag(g)) )
154-
rtmax = sqrt( safmax/2 )
155-
if( g1 > rtmin .and. g1 < rtmax ) then
153+
if( real(g) == zero ) then
154+
r = abs(aimag(g))
155+
s = conjg( g ) / r
156+
elseif( aimag(g) == zero ) then
157+
r = abs(real(g))
158+
s = conjg( g ) / r
159+
else
160+
g1 = max( abs(real(g)), abs(aimag(g)) )
161+
rtmax = sqrt( safmax/2 )
162+
if( g1 > rtmin .and. g1 < rtmax ) then
156163
!
157164
! Use unscaled algorithm
158165
!
159-
d = abs( g )
160-
s = conjg( g ) / d
161-
r = d
162-
else
166+
! The following two lines can be replaced by `d = abs( g )`.
167+
! This algorithm do not use the intrinsic complex abs.
168+
g2 = ABSSQ( g )
169+
d = sqrt( g2 )
170+
s = conjg( g ) / d
171+
r = d
172+
else
163173
!
164174
! Use scaled algorithm
165175
!
166-
u = min( safmax, max( safmin, g1 ) )
167-
gs = g / u
168-
d = abs( gs )
169-
s = conjg( gs ) / d
170-
r = d*u
176+
u = min( safmax, max( safmin, g1 ) )
177+
gs = g / u
178+
! The following two lines can be replaced by `d = abs( gs )`.
179+
! This algorithm do not use the intrinsic complex abs.
180+
g2 = ABSSQ( gs )
181+
d = sqrt( g2 )
182+
s = conjg( gs ) / d
183+
r = d*u
184+
end if
171185
end if
172186
else
173187
f1 = max( abs(real(f)), abs(aimag(f)) )
@@ -206,7 +220,7 @@ subroutine ZLARTG( f, g, c, s, r )
206220
r = f / c
207221
else
208222
! f2 / sqrt(f2 * h2) < safmin, then
209-
! h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
223+
! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
210224
r = f * ( h2 / d )
211225
end if
212226
s = conjg( g ) * ( f / d )
@@ -262,7 +276,7 @@ subroutine ZLARTG( f, g, c, s, r )
262276
r = fs / c
263277
else
264278
! f2 / sqrt(f2 * h2) < safmin, then
265-
! h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
279+
! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
266280
r = fs * ( h2 / d )
267281
end if
268282
s = conjg( gs ) * ( fs / d )

0 commit comments

Comments
 (0)