Program x07aafe

!     X07AAF Example Program Text

!     Mark 25 Release. NAG Copyright 2014.

!     .. Use Statements ..
      Use nag_library, Only: nag_wp, x02alf, x07aaf, x07abf, x07baf, x07bbf,   &
                             x07caf, x07cbf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter                   :: nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)                   :: neginf, qnan, x, y, zero
!     .. Local Arrays ..
      Integer                              :: exmode(3), newexmode(3)
!     .. Executable Statements ..
      Write (nout,*) 'X07AAF Example Program Results'
      Write (nout,*)

!     Turn exception halting mode off for the three common exceptions
!     overflow, division-by-zero, and invalid operation
      Write (nout,*) 'Turn exception halting off ...'
      exmode = (/0,0,0/)
      Call x07cbf(exmode)

!     Check that exception halting mode for the three common exceptions
!     was really turned off
      Call x07caf(newexmode)
      Write (nout,99999) 'Exception halting mode is now: ', newexmode

!     Look at some ordinary numbers
      x = 1.0_nag_wp
      Call diagnose('one',x)
      x = -2.0_nag_wp
      Call diagnose('-two',x)
      zero = 0.0_nag_wp
      Call diagnose('zero',zero)

!     Generate an infinity and a NaN and look at their properties
      Call x07baf(-1,neginf)
      Call diagnose('-Infinity',neginf)
      Call x07bbf(1,qnan)
      Call diagnose('Quiet NaN',qnan)

!     Do some operations which purposely raise exceptions
      Write (nout,*)
      Write (nout,*) 'Try to cause overflow - no trap should occur:'
      x = x02alf()
      y = -x*x
      Write (nout,99998) 'y = -huge() * huge() = ', y

      Write (nout,*)
      Write (nout,*) 'Try to cause NaN - no trap should occur:'
      y = zero/zero
      Write (nout,99998) 'y = 0.0 / 0.0 = ', y

      Write (nout,*)
      Write (nout,*) 'Try to cause division by zero - no trap should occur:'
      x = -1.0_nag_wp
      y = x/zero
      Write (nout,99998) 'y = -1.0 / 0.0 = ', y

99999 Format (1X,A,3I3)
99998 Format (1X,A,1P,E12.4)

    Contains

      Subroutine diagnose(c,x)

!       .. Implicit None Statement ..
        Implicit None
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In)      :: x
        Character (*), Intent (In)           :: c
!       .. Executable Statements ..
        Write (nout,*)
        Write (nout,99999) c, x

        If (x07aaf(x)) Then
          Write (nout,*) '"' // c // '" is finite'
        Else
          Write (nout,*) '"' // c // '" is not finite'
        End If
        If (x07abf(x)) Then
          Write (nout,*) '"' // c // '" is NaN'
        Else
          Write (nout,*) '"' // c // '" is not NaN'
        End If

        If (x<0.0_nag_wp) Then
          Write (nout,*) '"' // c // '" compares less than zero.'
        Else
          Write (nout,*) '"' // c // '" does not compare less than zero.'
        End If
        If (x==0.0_nag_wp) Then
          Write (nout,*) '"' // c // '" compares equal to zero.'
        Else
          Write (nout,*) '"' // c // '" does not compare equal to zero.'
        End If
        If (x>0.0_nag_wp) Then
          Write (nout,*) '"' // c // '" compares greater than zero.'
        Else
          Write (nout,*) '"' // c // '" does not compare greater than zero.'
        End If

        Return

99999   Format (1X,'Diagnosis of value "',A,'" which prints as ',1P,E12.4)

      End Subroutine diagnose

    End Program x07aafe