C******************************************************************************
C Description:  An example primitive using OpenMP under NeXtMidas
C
C AUTHOR: William Reese  06/2012
C Version: $Id: openmp_example.for,v 1.1 2012/06/29 17:42:54 lsn Exp $
C
C******************************************************************************

      PROGRAM OPENMP_EXAMPLE
      implicit none
      include 'primitive.inc'

      integer*4 i, j

c
c     Make an array that would be too big for the stack.
c     The default stack size is very small (64kB on x86_64 RHEL 4u6)
c     and cannot grow due to other thread stacks and various pieces
c     sitting below the pthread stacks in virtual memory.
c     Change the x() arry to be on the stack to see a nice
c     segmentation violation due to the inability of the kernel to
c     extend the stack downwards
c

      parameter (j=128*(2**10))
      real*4 x(*)
      pointer (p_x, x)
      integer*8 size

      real*8 n
      character(20) nval

c
c     Don't let OpenMP handle signals in case we run under Java
c
      call setenvqq("KMP_HANDLE_SIGNALS=false")

c
c     m$malloc64 takes an integer*8 as the first argument,
c     and calling this as m$malloc64 (j*4, p_x) would pass
c     an integer*4.
c

      size = j*4
      call m$malloc64 (size, p_x)
      if (p_x .eq. 0) then
        call m$error ('Could not allocate')
      endif

c
c     register with X-Midas/NeXtMidas
c

      call M$CHECKIN

c
c     signal start of processing
c

      call M$SYNC()

c
c     a trivial OpenMP directive which parellelizes the do loop
c
c$OMP PARALLEL DO
      do i = 1, j
        x(i) = i
      enddo

c
c     now n must be private to each thread and the thread p riveate
c     values are summed
c
      n = 0
c$OMP PARALLEL DO REDUCTION(+:n)
      do i = 1, j
        n = n + x(i)
      enddo

      i = m$d2a (n, nval)
      call m$info ('Done with n = '//nval)

c
c     m$return() cleans up our X-Midas/NeXtMidas state, including
c     any memory we've allocated using m$malloc/M$malloc64
c
      call M$RETURN

      END
