c
c	forceflush.f 1.4 92/07/01 15:19:35
c
c  Copyright 1991 Intel Corporation, Inc.
c  See the "Copyright" file for complete rights and liability information.
c
c  Begins writing a list to a file (/cfs/mydata) and then causes a
c  divide-by-zero exception.  However, because forceflush() was called,
c  all elements of the list are successfully flushed to the file.

c
c  Note:  To verify that the file "mydata" contains the entire list,
c         load the program in the file "mydata.f" 
c
c  Can run on a multi-node cube, but only node 0 does anything.

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

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.

         newmask = 1 + 2 + 4 + 8
         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
         a = 1/r

      endif

      end
