Skip to content

Commit 55e6ff5

Browse files
committed
Incorrect behaviour in SLACN2 under Fortran 95 SIGN semantics.
1 parent 1c1bd1e commit 55e6ff5

File tree

1 file changed

+18
-5
lines changed

1 file changed

+18
-5
lines changed

SRC/slacn2.f

Lines changed: 18 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -160,7 +160,7 @@ SUBROUTINE SLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
160160
* ..
161161
* .. Local Scalars ..
162162
INTEGER I, JLAST
163-
REAL ALTSGN, ESTOLD, TEMP
163+
REAL ALTSGN, ESTOLD, TEMP, XS
164164
* ..
165165
* .. External Functions ..
166166
INTEGER ISAMAX
@@ -171,7 +171,7 @@ SUBROUTINE SLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
171171
EXTERNAL SCOPY
172172
* ..
173173
* .. Intrinsic Functions ..
174-
INTRINSIC ABS, NINT, REAL, SIGN
174+
INTRINSIC ABS, NINT, REAL
175175
* ..
176176
* .. Executable Statements ..
177177
*
@@ -199,7 +199,11 @@ SUBROUTINE SLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
199199
EST = SASUM( N, X, 1 )
200200
*
201201
DO 30 I = 1, N
202-
X( I ) = SIGN( ONE, X( I ) )
202+
IF( X(I).GE.ZERO ) THEN
203+
X(I) = ONE
204+
ELSE
205+
X(I) = -ONE
206+
END IF
203207
ISGN( I ) = NINT( X( I ) )
204208
30 CONTINUE
205209
KASE = 2
@@ -232,7 +236,12 @@ SUBROUTINE SLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
232236
ESTOLD = EST
233237
EST = SASUM( N, V, 1 )
234238
DO 80 I = 1, N
235-
IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
239+
IF( X(I).GE.ZERO ) THEN
240+
XS = ONE
241+
ELSE
242+
XS = -ONE
243+
END IF
244+
IF( NINT( XS ).NE.ISGN( I ) )
236245
$ GO TO 90
237246
80 CONTINUE
238247
* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
@@ -244,7 +253,11 @@ SUBROUTINE SLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
244253
$ GO TO 120
245254
*
246255
DO 100 I = 1, N
247-
X( I ) = SIGN( ONE, X( I ) )
256+
IF( X(I).GE.ZERO ) THEN
257+
X(I) = ONE
258+
ELSE
259+
X(I) = -ONE
260+
END IF
248261
ISGN( I ) = NINT( X( I ) )
249262
100 CONTINUE
250263
KASE = 2

0 commit comments

Comments
 (0)