test_zcomplexmult.f

Go to the documentation of this file.

*> \brief zmul tests the robustness and precision of the double complex multiplication
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*  Authors:
*  ========
*
*> \author Weslley S. Pereira, University of Colorado Denver, U.S.
*
*> \verbatim
*>
*> Tests:
*>
*> (a) Inf inputs:
*>    (1) y = ( Inf + 0   * I)
*>    (2) y = (-Inf + 0   * I)
*>    (3) y = ( 0   + Inf * I)
*>    (4) y = ( 0   - Inf * I)
*>    (5) y = ( Inf + Inf * I)
*> Tests:
*>    (a) 0 * y is NaN.
*>    (b) 1 * y is y is either y or NaN.
*>    (c) y * y is either  Inf or NaN (cases 1 and 3),
*>                 either -Inf or NaN (cases 2 and 4),
*>                 NaN (case 5).
*>
*> (b) NaN inputs:
*>    (1) y = (NaN + 0   * I)
*>    (2) y = (0   + NaN * I)
*>    (3) y = (NaN + NaN * I)
*> Tests:
*>    (a) 0 * y is NaN.
*>    (b) 1 * y is NaN.
*>    (c) y * y is NaN.
*>
*> \endverbatim
*
*> \ingroup auxOTHERauxiliary
*
*  =====================================================================
      program zmul
*
*  -- LAPACK test routine --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
 
*     ..
*     .. Constants ..
      integer           nnan, ninf
      parameter( nnan = 3, ninf = 5 )
      double complex    czero, cone
      parameter( czero = dcmplx( 0.0d0, 0.0d0 ),
     $                  cone  = dcmplx( 1.0d0, 0.0d0 ) )
*     ..
*     .. Local Variables ..
      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
      cinf(1) = dcmplx( ainf, 0.0d0 )
      cinf(2) = dcmplx(-ainf, 0.0d0 )
      cinf(3) = dcmplx( 0.0d0, ainf )
      cinf(4) = dcmplx( 0.0d0,-ainf )
      cinf(5) = dcmplx( ainf,  ainf )
*
*     .. NaN entries ..
      anan = ainf / ainf
      cnan(1) = dcmplx( anan, 0.0d0 )
      cnan(2) = dcmplx( 0.0d0, anan )
      cnan(3) = dcmplx( anan,  anan )
 
*
*     .. Tests ..
*
*     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"), ') * (',
     $         (es24.16e3,sp,es24.16e3,"*I"), ') = (',
     $         (es24.16e3,sp,es24.16e3,"*I"), ') differs from ', a17 )
*
*     End of zmul
*
      END