Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 27 additions & 3 deletions INSTALL/test_zcomplexabs.f
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,8 @@ program zabs
* ..
* .. Local Variables ..
integer i, min, Max, m, subnormalTreatedAs0,
$ caseAFails, caseBFails, caseCFails, caseDFails
$ caseAFails, caseBFails, caseCFails, caseDFails,
$ caseEFails, caseFFails, nFailingTests, nTests
double precision X( N ), R, answerC,
$ answerD, aInf, aNaN, relDiff, b,
$ eps, blueMin, blueMax, Xj, stepX(N), limX(N)
Expand All @@ -77,6 +78,10 @@ program zabs
caseBFails = 0
caseCFails = 0
caseDFails = 0
caseEFails = 0
caseFFails = 0
nFailingTests = 0
nTests = 0
*
* .. Initialize machine constants ..
min = MINEXPONENT(0.0d0)
Expand Down Expand Up @@ -156,6 +161,7 @@ program zabs
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( Xj, 0.0d0 )
R = ABS( Y )
if( R .ne. Xj ) then
Expand All @@ -180,6 +186,7 @@ program zabs
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( 0.0d0, Xj )
R = ABS( Y )
if( R .ne. Xj ) then
Expand Down Expand Up @@ -209,6 +216,7 @@ program zabs
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
answerC = fiveFourth * Xj
Y = DCMPLX( threeFourth * Xj, Xj )
R = ABS( Y )
Expand Down Expand Up @@ -247,6 +255,7 @@ program zabs
print *, "!! [d] fl( subnormal ) may be 0"
endif
else
nTests = nTests + 1
Y = DCMPLX( oneHalf * Xj, oneHalf * Xj )
R = ABS( Y )
relDiff = ABS(R-answerD)/answerD
Expand All @@ -267,26 +276,41 @@ program zabs
*
* Test (e) Infs
do 50 i = 1, nInf
nTests = nTests + 1
Y = cInf(i)
R = ABS( Y )
if( .not.(R .gt. HUGE(0.0d0)) ) then
caseEFails = caseEFails + 1
WRITE( *, FMT = 9997 ) 'i',i, Y, R
endif
50 continue
*
* Test (f) NaNs
do 60 i = 1, nNaN
nTests = nTests + 1
Y = cNaN(i)
R = ABS( Y )
if( R .eq. R ) then
caseFFails = caseFFails + 1
WRITE( *, FMT = 9998 ) 'n',i, Y, R
endif
60 continue
*
* If any test fails, displays a message
nFailingTests = caseAFails + caseBFails + caseCFails + caseDFails
$ + caseEFails + caseFFails
if( nFailingTests .gt. 0 ) then
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
$ " pass for ABS(a+b*I),", nFailingTests, " tests fail."
else
print *, "# All tests pass for ABS(a+b*I)"
endif
*
* If anything was written to stderr, print the message
if( (caseAFails .gt. 0) .or. (caseBFails .gt. 0) .or.
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) )
$ print *, "# Please check the failed ABS(a+b*I) in [stderr]"
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) ) then
print *, "# Please check the failed ABS(a+b*I) in [stderr]"
endif
*
* .. Formats ..
9997 FORMAT( '[',A1,I1, '] ABS(', (ES8.1,SP,ES8.1,"*I"), ' ) = ',
Expand Down
33 changes: 32 additions & 1 deletion INSTALL/test_zcomplexdiv.f
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,9 @@ program zdiv
* .. Local Variables ..
integer i, min, Max, m,
$ subnormalTreatedAs0, caseAFails, caseBFails,
$ caseCFails, caseDFails, caseEFails, caseFFails
$ caseCFails, caseDFails, caseEFails, caseFFails,
$ caseInfFails, caseNaNFails, nFailingTests,
$ nTests
double precision X( N ), aInf, aNaN, b,
$ eps, blueMin, blueMax, OV, Xj, stepX(N), limX(N)
double complex Y, Y2, R, cInf( nInf ), cNaN( nNaN )
Expand All @@ -94,6 +96,10 @@ program zdiv
caseDFails = 0
caseEFails = 0
caseFFails = 0
caseInfFails = 0
caseNaNFails = 0
nFailingTests = 0
nTests = 0
*
* .. Initialize machine constants ..
min = MINEXPONENT(0.0d0)
Expand Down Expand Up @@ -174,6 +180,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( Xj, 0.0d0 )
R = Y / Y
if( R .ne. 1.0D0 ) then
Expand All @@ -199,6 +206,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( 0.0d0, Xj )
R = Y / Y
if( R .ne. 1.0D0 ) then
Expand All @@ -224,6 +232,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( Xj, Xj )
R = Y / Y
if( R .ne. 1.0D0 ) then
Expand All @@ -249,6 +258,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( 0.0d0, Xj )
Y2 = DCMPLX( Xj, 0.0d0 )
R = Y / Y2
Expand All @@ -275,6 +285,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( 0.0d0, Xj )
Y2 = DCMPLX( Xj, 0.0d0 )
R = Y2 / Y
Expand All @@ -301,6 +312,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( Xj, Xj )
R = Y / DCONJG( Y )
if( R .ne. DCMPLX(0.0D0,1.0D0) ) then
Expand All @@ -318,38 +330,57 @@ program zdiv
*
* Test (g) Infs
do 70 i = 1, nInf
nTests = nTests + 3
Y = cInf(i)
R = czero / Y
if( (R .ne. czero) .and. (R .eq. R) ) then
caseInfFails = caseInfFails + 1
WRITE( *, FMT = 9998 ) 'ia',i, czero, Y, R, 'NaN and 0'
endif
R = cone / Y
if( (R .ne. czero) .and. (R .eq. R) ) then
caseInfFails = caseInfFails + 1
WRITE( *, FMT = 9998 ) 'ib',i, cone, Y, R, 'NaN and 0'
endif
R = Y / Y
if( R .eq. R ) then
caseInfFails = caseInfFails + 1
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'NaN'
endif
70 continue
*
* Test (h) NaNs
do 80 i = 1, nNaN
nTests = nTests + 3
Y = cNaN(i)
R = czero / Y
if( R .eq. R ) then
caseNaNFails = caseNaNFails + 1
WRITE( *, FMT = 9998 ) 'na',i, czero, Y, R, 'NaN'
endif
R = cone / Y
if( R .eq. R ) then
caseNaNFails = caseNaNFails + 1
WRITE( *, FMT = 9998 ) 'nb',i, cone, Y, R, 'NaN'
endif
R = Y / Y
if( R .eq. R ) then
caseNaNFails = caseNaNFails + 1
WRITE( *, FMT = 9998 ) 'nc',i, Y, Y, R, 'NaN'
endif
80 continue
*
* If any test fails, displays a message
nFailingTests = caseAFails + caseBFails + caseCFails + caseDFails
$ + caseEFails + caseFFails + caseInfFails
$ + caseNaNFails
if( nFailingTests .gt. 0 ) then
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
$ " pass for complex division,", nFailingTests," fail."
else
print *, "# All tests pass for complex division."
endif
*
* If anything was written to stderr, print the message
if( (caseAFails .gt. 0) .or. (caseBFails .gt. 0) .or.
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) .or.
Expand Down
23 changes: 22 additions & 1 deletion INSTALL/test_zcomplexmult.f
Original file line number Diff line number Diff line change
Expand Up @@ -55,14 +55,18 @@ program zmul
$ cone = DCMPLX( 1.0d0, 0.0d0 ) )
* ..
* .. Local Variables ..
integer i
integer i, nFailingTests, nTests
double precision aInf, aNaN, OV
double complex Y, R, cInf( nInf ), cNaN( nNaN )
*
* .. Intrinsic Functions ..
intrinsic HUGE, DCMPLX

*
* .. Initialize error counts ..
nFailingTests = 0
nTests = 0
*
* .. Inf entries ..
OV = HUGE(0.0d0)
aInf = OV * 2
Expand All @@ -83,48 +87,65 @@ program zmul
*
* Test (a) Infs
do 10 i = 1, nInf
nTests = nTests + 3
Y = cInf(i)
R = czero * Y
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ia',i, czero, Y, R, 'NaN'
endif
R = cone * Y
if( (R .ne. Y) .and. (R .eq. R) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ib',i, cone, Y, R,
$ 'the input and NaN'
endif
R = Y * Y
if( (i.eq.1) .or. (i.eq.2) ) then
if( (R .ne. cInf(1)) .and. (R .eq. R) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'Inf and NaN'
endif
else if( (i.eq.3) .or. (i.eq.4) ) then
if( (R .ne. cInf(2)) .and. (R .eq. R) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, '-Inf and NaN'
endif
else
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'NaN'
endif
endif
10 continue
*
* Test (b) NaNs
do 20 i = 1, nNaN
nTests = nTests + 3
Y = cNaN(i)
R = czero * Y
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'na',i, czero, Y, R, 'NaN'
endif
R = cone * Y
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'nb',i, cone, Y, R, 'NaN'
endif
R = Y * Y
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'nc',i, Y, Y, R, 'NaN'
endif
20 continue
*
if( nFailingTests .gt. 0 ) then
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
$ " pass for complex multiplication,", nFailingTests," fail."
else
print *, "# All tests pass for complex multiplication."
endif
*
* .. Formats ..
9998 FORMAT( '[',A2,I1, '] (', (ES24.16E3,SP,ES24.16E3,"*I"), ') * (',
Expand Down
22 changes: 21 additions & 1 deletion INSTALL/test_zminMax.f
Original file line number Diff line number Diff line change
Expand Up @@ -44,13 +44,17 @@ program zmul
parameter ( zero = 0.0d0 )
* ..
* .. Local Variables ..
integer i
integer i, nFailingTests, nTests
double precision aInf, aNaN, OV, R, X(n), Y(n)
*
* .. Intrinsic Functions ..
intrinsic HUGE, MIN, MAX

*
* .. Initialize error counts ..
nFailingTests = 0
nTests = 0
*
* .. Inf and NaN entries ..
OV = HUGE(0.0d0)
aInf = OV * 2
Expand All @@ -62,35 +66,51 @@ program zmul
* .. Tests ..
*
do 10 i = 1, 3
nTests = nTests + 2
R = MIN( X(i), Y(i) )
if( R .ne. X(i) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MIN', X(i), Y(i), R
endif
R = MAX( X(i), Y(i) )
if( R .ne. Y(i) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MAX', X(i), Y(i), R
endif
10 continue
do 20 i = 4, 6
nTests = nTests + 2
R = MIN( X(i), Y(i) )
if( R .ne. Y(i) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MIN', X(i), Y(i), R
endif
R = MAX( X(i), Y(i) )
if( R .ne. X(i) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MAX', X(i), Y(i), R
endif
20 continue
do 30 i = 7, 8
nTests = nTests + 2
R = MIN( X(i), Y(i) )
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MIN', X(i), Y(i), R
endif
R = MAX( X(i), Y(i) )
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MAX', X(i), Y(i), R
endif
30 continue
*
if( nFailingTests .gt. 0 ) then
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
$ " pass for intrinsic MIN and MAX,", nFailingTests," fail."
else
print *, "# All tests pass for intrinsic MIN and MAX."
endif
*
* .. Formats ..
9998 FORMAT( '[',A1,I1, '] ', A3, '(', F5.0, ',', F5.0, ') = ', F5.0 )
Expand Down