      PROGRAM PROB07
C
C     PROBLEM 07
C
C  REFERENCE:  PROBLEMS TO TEST PARALLEL AND VECTOR LANGUAGES
C              CSD-TR 516, COMPUTER SCIENCE, PURDUE UNIVERSITY
C              JOHN R. RICE, MAY 1, 1985
C
C              REVISED BY JOHN R. RICE AND J. JING, OCT. 1, 1990
C
C
C      *************************************************
C      *      Adapted for FORTRAN D benchmarking       *
C      *    by  T. HAUPT  (haupt@sccs.npac.syr.edu)    *
C      *                                               *
C      *    Northeast Parallel Architectures Center    *
C      *   at Syracuse University, Syracuse, NY, USA   *
C      *************************************************
C
C
C       VERSION SIMD/DECmpp-1.00
C       ==================================================
C
      INTEGER KASES,NK,MK
      PARAMETER (KASES=3)
      INTEGER N(KASES),M(KASES)
      DATA N /3,5,10/
      DATA M /2048,16384,32768/
      REAL P(4)
      INTEGER ITIME
      REAL TIME

      DO 50 K =  1, KASES

      NK=N(K)
      DO 40 I = 1, KASES

      CALL mpTIMERstart()
      DO MANY=1,50
      MK=M(I)
      CALL DOIT(NK,MK,P)
      ENDDO
      ITIME=mpTIMERelapsed()

      PRINT *,'PROBLEM 7 WITH N,M =',NK,MK
         WRITE (6,*) 'GIVES P(',P(1),')  =',P(2)
         WRITE (6,*) 'AND   P(',P(3),')  =',P(4)

      TIME=FLOAT(ITIME)/1000
      PRINT *, 'DECmpp ELAPSED TIME:',TIME,' SECONDS'

   40 CONTINUE
   50 CONTINUE
      STOP
      END

      SUBROUTINE DOIT(NK,MK,P)
      INTEGER NK,MK
      REAL P(4)
      REAL DX
      REAL, ARRAY(NK)       :: XI,DENOM,F
      REAL, ARRAY(MK)       :: X,TP
      REAL, ARRAY(MK,NK)    :: TAMP,XL
      LOGICAL, ARRAY(MK,NK) :: MASK1
C  +SELF,IF=CM2.
CMF$  LAYOUT TAMP(:NEWS,:SERIAL)
CMF$  LAYOUT XL(:NEWS,:SERIAL)
C     MAP TAMP(ALLBITS,MEMORY)
C     MAP XL(ALLBITS,MEMORY)
      REAL, ARRAY(NK,NK)    :: TEMP
      LOGICAL, ARRAY(NK,NK) :: MASK
      LOGICAL, ARRAY(NK)    :: MASK0
      INTEGER I,K
      INTERFACE
       SUBROUTINE FUN(XI,NK,F)
        INTEGER NK
        REAL, ARRAY(NK) :: XI,F
      END INTERFACE

         XI = [1:NK]-1.0
         DX=XI(NK)/MK
         X =  0.5+([1:MK]-1.0)*DX
         CALL FUN(XI,NK,F)
         MASK=.TRUE.
         DO I=1,NK
          MASK(I,I)=.FALSE.
         ENDDO

C        to jest macierz 3x3, 5x5, lub 10x10 TYLKO!

         TEMP=SPREAD(XI,2,NK)-SPREAD(XI,1,NK)
         DENOM=PRODUCT(TEMP,DIM=2,MASK=MASK)

          TAMP=SPREAD(X,2,NK)-SPREAD(XI,1,MK)
          DO I=1,NK
          MASK1=SPREAD(MASK(I,1:NK),1,MK)
          XL(1:MK,I)=PRODUCT(TAMP,DIM=2,MASK=MASK1)/DENOM(I)
          ENDDO
          TP=SUM(SPREAD(F,1,MK)*XL,DIM=2)

          P(1)=X(1)
          P(2)=TP(1)
          P(3)=X(MK)
          P(4)=TP(MK)


      RETURN
      END

       SUBROUTINE FUN(X,NK,F)
        INTEGER NK
        REAL, ARRAY(NK) :: X,F
      F = X**2-3.0*X-4.0
c      F=EXP(X)
      RETURN
      END












