diff --git a/INSTALL/test_zcomplexabs.f b/INSTALL/test_zcomplexabs.f index 8dedcf18dc..6dceb83f66 100644 --- a/INSTALL/test_zcomplexabs.f +++ b/INSTALL/test_zcomplexabs.f @@ -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) @@ -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) @@ -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 @@ -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 @@ -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 ) @@ -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 @@ -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"), ' ) = ', diff --git a/INSTALL/test_zcomplexdiv.f b/INSTALL/test_zcomplexdiv.f index fa3ea73b8e..6a11c14f24 100644 --- a/INSTALL/test_zcomplexdiv.f +++ b/INSTALL/test_zcomplexdiv.f @@ -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 ) @@ -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) @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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. diff --git a/INSTALL/test_zcomplexmult.f b/INSTALL/test_zcomplexmult.f index 6fce1ef8fc..4ce81cebb4 100644 --- a/INSTALL/test_zcomplexmult.f +++ b/INSTALL/test_zcomplexmult.f @@ -55,7 +55,7 @@ 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 ) * @@ -63,6 +63,10 @@ program zmul intrinsic HUGE, DCMPLX * +* .. Initialize error counts .. + nFailingTests = 0 + nTests = 0 +* * .. Inf entries .. OV = HUGE(0.0d0) aInf = OV * 2 @@ -83,27 +87,33 @@ 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 @@ -111,20 +121,31 @@ program zmul * * 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"), ') * (', diff --git a/INSTALL/test_zminMax.f b/INSTALL/test_zminMax.f index b98dd3c34f..178ab6d533 100644 --- a/INSTALL/test_zminMax.f +++ b/INSTALL/test_zminMax.f @@ -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 @@ -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 )