Program x07aafe ! X07AAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. 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