c
c	fpsetmask.f 1.4 92/07/01 15:19:47
c
c  Copyright 1991 Intel Corporation, Inc.
c  See the "Copyright" file for complete rights and liability information.
c
c  Uses fpsetmask() to set floating-point exceptions.
c
c  Can run on a multi-node cube, but only node 0 does anything.

      integer   iam, newmask, oldmask
      integer   list(100)
      integer*4 seed
      real      a, r

c  Identify self.

      iam = mynode()

c  Node 0 does all the work.

      if(iam .eq. 0) then

c    Set floating-point exception mask:
c       1     Enables invalid operation exceptions.
c       2     Enables denormalization exceptions.
c       4     Enables divide-by-zero exceptions.
c       8     Enables overflow exceptions.
c       16    Enables underflow exceptions.

         newmask = 1 + 2 + 4 + 8 + 16
c         newmask =     2 + 4 + 8 + 16
c         newmask = 1     + 4 + 8 + 16
c         newmask = 1 + 2     + 8 + 16
c         newmask = 1 + 2 + 4 + 8 + 16
c         newmask = 1 + 2 + 4     + 16
c         newmask = 1 
c         newmask = 2 
c         newmask = 4 
c         newmask = 1 + 4 
c         newmask = 8 
c         newmask = 16 
         oldmask = fpsetmask(newmask)

c    Display old and new floating-point exception masks.

         write(*, 100) oldmask, newmask
100      format('Old mask was: ', i10, /, 'New mask is:  ', i10)

c    Ensure that all I/O is flushed if an exception occurs.

         call forceflush()

c    Build list of random integers in the range 0..100.

         seed = (2 * mclock()/(iam+1)) + 1
         do 1, i = 1, 100
            list(i) = int(100*ran(seed))
1        continue

c    Delete file named "mydata" (if it exists).

         open(unit = 12, file = '/cfs/mydata',
     1        status = 'unknown', form = 'unformatted')
         close(unit = 12, file = '/cfs/mydata', status = 'delete')

c    Open the file.

         open(unit = 12, file = '/cfs/mydata',
     1        status = 'new', form = 'unformatted')

c    Write to the file.

         write(12) (list(i), i = 1, 100)

c    The next statement causes a divide-by-zero exception.

         r = 0.0
         a = 1.0/r

      endif

      end
