Skip to content

Commit f461d4f

Browse files
weslleyspereiraweslleyspereira
committed
Fixes bugs. Updates documentation. Tests for ABS and complex division run on the Makefile build
1 parent 19fafd4 commit f461d4f

File tree

3 files changed

+129
-55
lines changed

3 files changed

+129
-55
lines changed

‎INSTALL/Makefile‎

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
TOPSRCDIR = ..
22
include $(TOPSRCDIR)/make.inc
33

4-
.PHONY: all testlsame testslamch testdlamch testsecond testdsecnd testieee testversion
5-
all: testlsame testslamch testdlamch testsecond testdsecnd testieee testversion
4+
.PHONY: all testlsame testslamch testdlamch testsecond testdsecnd testieee testversion test_zcomplexabs test_zcomplexdiv
5+
all: testlsame testslamch testdlamch testsecond testdsecnd testieee testversion test_zcomplexabs test_zcomplexdiv
66

77
testlsame: lsame.o lsametst.o
88
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
@@ -27,6 +27,12 @@ testieee: tstiee.o $(TOPSRCDIR)/SRC/ieeeck.o $(TOPSRCDIR)/SRC/ilaenv.o $(TOPSRCD
2727
testversion: ilaver.o LAPACK_version.o
2828
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
2929

30+
test_zcomplexabs: test_zcomplexabs.o
31+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
32+
33+
test_zcomplexdiv: test_zcomplexdiv.o
34+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
35+
3036
.PHONY: run
3137
run: all
3238
./testlsame
@@ -36,13 +42,15 @@ run: all
3642
./testdsecnd
3743
./testieee
3844
./testversion
45+
./test_zcomplexabs 2> test_zcomplexabs.err
46+
./test_zcomplexdiv 2> test_zcomplexdiv.err
3947

4048
.PHONY: clean cleanobj cleanexe cleantest
4149
clean: cleanobj cleanexe cleantest
4250
cleanobj:
4351
rm -f *.o
4452
cleanexe:
45-
rm -f test*
53+
rm -f testlsame testslamch testdlamch testsecond testdsecnd testieee testversion test_zcomplexabs test_zcomplexdiv
4654
cleantest:
4755
rm -f core
4856

‎INSTALL/test_zcomplexabs.f‎

Lines changed: 50 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,10 @@
1-
*> \brief zabs tests the robustness and precision of the intrinsic ABS for double complex
1+
*> \brief zabs tests the robustness and precision of the intrinsic ABS for double complex
2+
*
3+
* =========== DOCUMENTATION ===========
4+
*
5+
* Online html documentation available at
6+
* http://www.netlib.org/lapack/explore-html/
7+
*
28
*> \author Weslley S. Pereira, University of Colorado Denver, U.S.
39
*
410
*> \verbatim
@@ -32,35 +38,47 @@
3238
*>
3339
*> \endverbatim
3440
*
41+
*> \ingroup auxOTHERauxiliary
42+
*
43+
* =====================================================================
3544
program zabs
45+
*
46+
* -- LAPACK test routine --
47+
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
3648

49+
* ..
50+
* .. Local parameters ..
3751
logical debug
3852
parameter ( debug = .false. )
39-
40-
integer N, i, nNaN, nInf, min, Max, m
53+
integer N, nNaN, nInf
4154
parameter ( N = 4, nNaN = 3, nInf = 5 )
42-
43-
double precision X( N ), R, threeFourth, fiveFourth, answerC,
44-
$ answerD, oneHalf, aInf, aNaN, relDiff, b,
45-
$ eps, blueMin, blueMax, Xj, stepX(N), limX(N)
55+
double precision threeFourth, fiveFourth, oneHalf
4656
parameter ( threeFourth = 3.0d0 / 4,
4757
$ fiveFourth = 5.0d0 / 4,
4858
$ oneHalf = 1.0d0 / 2 )
49-
59+
* ..
60+
* .. Local Variables ..
61+
integer i, min, Max, m, subnormalTreatedAs0,
62+
$ caseAFails, caseBFails, caseCFails, caseDFails
63+
double precision X( N ), R, answerC,
64+
$ answerD, aInf, aNaN, relDiff, b,
65+
$ eps, blueMin, blueMax, Xj, stepX(N), limX(N)
5066
double complex Y, cInf( nInf ), cNaN( nNaN )
67+
*
68+
* .. Intrinsic Functions ..
5169
intrinsic ABS, DBLE, RADIX, CEILING, TINY, DIGITS, SQRT,
5270
$ MAXEXPONENT, MINEXPONENT, FLOOR, HUGE, DCMPLX,
5371
$ EPSILON
5472

55-
integer subnormalTreatedAs0, caseAFails, caseBFails,
56-
$ caseCFails, caseDFails
5773
*
74+
* .. Initialize error counts ..
5875
subnormalTreatedAs0 = 0
5976
caseAFails = 0
6077
caseBFails = 0
6178
caseCFails = 0
6279
caseDFails = 0
6380
*
81+
* .. Initialize machine constants ..
6482
min = MINEXPONENT(0.0d0)
6583
Max = MAXEXPONENT(0.0d0)
6684
m = DIGITS(0.0d0)
@@ -69,20 +87,40 @@ program zabs
6987
blueMin = b**CEILING( (min - 1) * 0.5d0 )
7088
blueMax = b**FLOOR( (Max - m + 1) * 0.5d0 )
7189
*
90+
* .. Vector X ..
7291
X(1) = TINY(0.0d0) * b**( DBLE(1-m) )
7392
X(2) = TINY(0.0d0)
7493
X(3) = HUGE(0.0d0)
7594
X(4) = b**( DBLE(Max-1) )
7695
*
96+
* .. Then modify X using the step ..
7797
stepX(1) = 2.0
7898
stepX(2) = 2.0
7999
stepX(3) = 0.0
80100
stepX(4) = 0.5
81101
*
102+
* .. Up to the value ..
82103
limX(1) = X(2)
83104
limX(2) = 1.0
84105
limX(3) = 0.0
85106
limX(4) = 2.0
107+
*
108+
* .. Inf entries ..
109+
aInf = X(3) * 2
110+
cInf(1) = DCMPLX( aInf, 0.0d0 )
111+
cInf(2) = DCMPLX(-aInf, 0.0d0 )
112+
cInf(3) = DCMPLX( 0.0d0, aInf )
113+
cInf(4) = DCMPLX( 0.0d0,-aInf )
114+
cInf(5) = DCMPLX( aInf, aInf )
115+
*
116+
* .. NaN entries ..
117+
aNaN = aInf / aInf
118+
cNaN(1) = DCMPLX( aNaN, 0.0d0 )
119+
cNaN(2) = DCMPLX( 0.0d0, aNaN )
120+
cNaN(3) = DCMPLX( aNaN, aNaN )
121+
122+
*
123+
* .. Tests ..
86124
*
87125
if( debug ) then
88126
print *, '# X :=', X
@@ -107,18 +145,6 @@ program zabs
107145
endif
108146
100 continue
109147
endif
110-
*
111-
aInf = X(3) * 2
112-
cInf(1) = DCMPLX( aInf, 0.0d0 )
113-
cInf(2) = DCMPLX(-aInf, 0.0d0 )
114-
cInf(3) = DCMPLX( 0.0d0, aInf )
115-
cInf(4) = DCMPLX( 0.0d0,-aInf )
116-
cInf(5) = DCMPLX( aInf, aInf )
117-
*
118-
aNaN = aInf / aInf
119-
cNaN(1) = DCMPLX( aNaN, 0.0d0 )
120-
cNaN(2) = DCMPLX( 0.0d0, aNaN )
121-
cNaN(3) = DCMPLX( aNaN, aNaN )
122148
*
123149
* Test (a) y = x + 0 * I, |y| = x
124150
do 10 i = 1, N
@@ -257,10 +283,12 @@ program zabs
257283
endif
258284
60 continue
259285
*
286+
* If anything was written to stderr, print the message
260287
if( (caseAFails .gt. 0) .or. (caseBFails .gt. 0) .or.
261288
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) )
262289
$ print *, "# Please check the failed ABS(a+b*I) in [stderr]"
263290
*
291+
* .. Formats ..
264292
9997 FORMAT( '[',A1,I1, '] ABS(', (ES8.1,SP,ES8.1,"*I"), ' ) = ',
265293
$ ES8.1, ' differs from Inf' )
266294
*

‎INSTALL/test_zcomplexdiv.f‎

Lines changed: 68 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,13 @@
11
*> \brief zdiv tests the robustness and precision of the double complex division
2+
*
3+
* =========== DOCUMENTATION ===========
4+
*
5+
* Online html documentation available at
6+
* http://www.netlib.org/lapack/explore-html/
7+
*
8+
* Authors:
9+
* ========
10+
*
211
*> \author Weslley S. Pereira, University of Colorado Denver, U.S.
312
*
413
*> \verbatim
@@ -42,31 +51,42 @@
4251
*>
4352
*> \endverbatim
4453
*
54+
*> \ingroup auxOTHERauxiliary
55+
*
56+
* =====================================================================
4557
program zdiv
58+
*
59+
* -- LAPACK test routine --
60+
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
4661

62+
* ..
63+
* .. Local parameters ..
4764
logical debug
4865
parameter ( debug = .false. )
49-
50-
integer N, i, nNaN, nInf, min, Max, m
66+
integer N, nNaN, nInf
5167
parameter ( N = 4, nNaN = 3, nInf = 5 )
52-
53-
double precision X( N ), threeFourth, fiveFourth, aInf, aNaN, b,
54-
$ eps, blueMin, blueMax, OV, Xj, stepX(N), limX(N)
68+
double precision threeFourth, fiveFourth
5569
parameter ( threeFourth = 3.0d0 / 4,
5670
$ fiveFourth = 5.0d0 / 4 )
57-
58-
double complex Y, Y2, R, cInf( nInf ), cNaN( nNaN ), czero,
59-
$ cone
71+
double complex czero, cone
6072
parameter ( czero = DCMPLX( 0.0d0, 0.0d0 ),
6173
$ cone = DCMPLX( 1.0d0, 0.0d0 ) )
74+
* ..
75+
* .. Local Variables ..
76+
integer i, min, Max, m,
77+
$ subnormalTreatedAs0, caseAFails, caseBFails,
78+
$ caseCFails, caseDFails, caseEFails, caseFFails
79+
double precision X( N ), aInf, aNaN, b,
80+
$ eps, blueMin, blueMax, OV, Xj, stepX(N), limX(N)
81+
double complex Y, Y2, R, cInf( nInf ), cNaN( nNaN )
6282
*
83+
* .. Intrinsic Functions ..
6384
intrinsic DCONJG, DBLE, RADIX, CEILING, TINY, DIGITS,
6485
$ MAXEXPONENT, MINEXPONENT, FLOOR, HUGE, DCMPLX,
6586
$ EPSILON
6687

67-
integer subnormalTreatedAs0, caseAFails, caseBFails,
68-
$ caseCFails, caseDFails
6988
*
89+
* .. Initialize error counts ..
7090
subnormalTreatedAs0 = 0
7191
caseAFails = 0
7292
caseBFails = 0
@@ -75,6 +95,7 @@ program zdiv
7595
caseEFails = 0
7696
caseFFails = 0
7797
*
98+
* .. Initialize machine constants ..
7899
min = MINEXPONENT(0.0d0)
79100
Max = MAXEXPONENT(0.0d0)
80101
m = DIGITS(0.0d0)
@@ -84,20 +105,40 @@ program zdiv
84105
blueMax = b**FLOOR( (Max - m + 1) * 0.5d0 )
85106
OV = HUGE(0.0d0)
86107
*
108+
* .. Vector X ..
87109
X(1) = TINY(0.0d0) * b**( DBLE(1-m) )
88110
X(2) = TINY(0.0d0)
89111
X(3) = OV
90112
X(4) = b**( DBLE(Max-1) )
91113
*
114+
* .. Then modify X using the step ..
92115
stepX(1) = 2.0
93116
stepX(2) = 2.0
94117
stepX(3) = 0.0
95118
stepX(4) = 0.5
96119
*
120+
* .. Up to the value ..
97121
limX(1) = X(2)
98122
limX(2) = 1.0
99123
limX(3) = 0.0
100124
limX(4) = 2.0
125+
*
126+
* .. Inf entries ..
127+
aInf = OV * 2
128+
cInf(1) = DCMPLX( aInf, 0.0d0 )
129+
cInf(2) = DCMPLX(-aInf, 0.0d0 )
130+
cInf(3) = DCMPLX( 0.0d0, aInf )
131+
cInf(4) = DCMPLX( 0.0d0,-aInf )
132+
cInf(5) = DCMPLX( aInf, aInf )
133+
*
134+
* .. NaN entries ..
135+
aNaN = aInf / aInf
136+
cNaN(1) = DCMPLX( aNaN, 0.0d0 )
137+
cNaN(2) = DCMPLX( 0.0d0, aNaN )
138+
cNaN(3) = DCMPLX( aNaN, aNaN )
139+
140+
*
141+
* .. Tests ..
101142
*
102143
if( debug ) then
103144
print *, '# X :=', X
@@ -107,26 +148,21 @@ program zdiv
107148
*
108149
Xj = X(1)
109150
if( Xj .eq. 0.0d0 ) then
110-
print *, "# Subnormal numbers treated as 0"
151+
subnormalTreatedAs0 = subnormalTreatedAs0 + 1
152+
if( debug .or. subnormalTreatedAs0 .eq. 1 ) then
153+
print *, "!! fl( subnormal ) may be 0"
154+
endif
111155
else
112156
do 100 i = 1, N
113157
Xj = X(i)
114-
if( Xj .eq. 0.0d0 ) print *,
115-
$ "# Subnormal numbers may be treated as 0"
158+
if( Xj .eq. 0.0d0 ) then
159+
subnormalTreatedAs0 = subnormalTreatedAs0 + 1
160+
if( debug .or. subnormalTreatedAs0 .eq. 1 ) then
161+
print *, "!! fl( subnormal ) may be 0"
162+
endif
163+
endif
116164
100 continue
117165
endif
118-
*
119-
aInf = OV * 2
120-
cInf(1) = DCMPLX( aInf, 0.0d0 )
121-
cInf(2) = DCMPLX(-aInf, 0.0d0 )
122-
cInf(3) = DCMPLX( 0.0d0, aInf )
123-
cInf(4) = DCMPLX( 0.0d0,-aInf )
124-
cInf(5) = DCMPLX( aInf, aInf )
125-
*
126-
aNaN = aInf / aInf
127-
cNaN(1) = DCMPLX( aNaN, 0.0d0 )
128-
cNaN(2) = DCMPLX( 0.0d0, aNaN )
129-
cNaN(3) = DCMPLX( aNaN, aNaN )
130166
*
131167
* Test (a) y = x + 0 * I, y/y = 1
132168
do 10 i = 1, N
@@ -296,11 +332,6 @@ program zdiv
296332
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'NaN'
297333
endif
298334
70 continue
299-
*
300-
if( (caseAFails .gt. 0) .or. (caseBFails .gt. 0) .or.
301-
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) .or.
302-
$ (caseEFails .gt. 0) .or. (caseFFails .gt. 0) )
303-
$ print *, "# Please check the failed divisions in [stderr]"
304335
*
305336
* Test (h) NaNs
306337
do 80 i = 1, nNaN
@@ -319,6 +350,13 @@ program zdiv
319350
endif
320351
80 continue
321352
*
353+
* If anything was written to stderr, print the message
354+
if( (caseAFails .gt. 0) .or. (caseBFails .gt. 0) .or.
355+
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) .or.
356+
$ (caseEFails .gt. 0) .or. (caseFFails .gt. 0) )
357+
$ print *, "# Please check the failed divisions in [stderr]"
358+
*
359+
* .. Formats ..
322360
9998 FORMAT( '[',A2,I1, '] X = ', ES24.16E3, ' : ', A15, ' = ',
323361
$ (ES24.16E3,SP,ES24.16E3,"*I"), ' differs from ', A10 )
324362
*

0 commit comments

Comments
 (0)