      PROGRAM NODE07
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 MIMD/iPSC860-1.00-NODE   (F77+mp)
C       ==================================================
C
      INCLUDE 'picl_def.h'
      DOUBLE PRECISION HOST_SEC, NODE_SEC, STARTTIME
      INTEGER*4 TIMESIZE, TIMETYPE
      DATA TIMESIZE,TIMETYPE /8,10/
      INTEGER*4 ME,HOST,ALLNODES
      INTEGER*4 NPROCS,TOP,ORD,DIR
      INTEGER*4 INITTYPE
      DATA INITTYPE /1/
      DATA TOP,ORD,DIR,ALLNODES /1,1,1,-1/
C -----------------------------------------------------------
C           parameters of the initial broadcast
C -----------------------------------------------------------
      INTEGER*4 MSG(2),MSGSIZE
      DATA MSGSIZE /8/
      EQUIVALENCE (MSG(1),NK),(MSG(2),MK)
C -----------------------------------------------------------
C      parameters of messages with partial results
C -----------------------------------------------------------
      INTEGER*4 TYPE2,TYPE1
      DATA TYPE1,TYPE2 /20,21/
C
      INTEGER NK,MK
      REAL P(4)
      REAL DX
      INTEGER NMAX,MMAX,I,J,K
      PARAMETER (NMAX=10)
      PARAMETER (MMAX=131072)
      DIMENSION XI(NMAX),XL(NMAX)
      DIMENSION TEMP(NMAX),TAMP(NMAX),TUMP(NMAX)
      DIMENSION X(MMAX)
      REAL DENOM(NMAX)
      REAL TP
      REAL P1(2),P2(2)
      CALL open0(NPROCS,ME,HOST)
      CALL setarc0(NPROCS,TOP,ORD,DIR)

  100 CONTINUE
      STARTTIME=clock0()
      CALL bcast0(MSG,MSGSIZE,INITTYPE,HOST)
      IF(NK.GT.0) THEN
        IF (ME.LT.NPROCS) THEN


         DO I = 1, NK
         XI(I)=FLOAT(I-1)
         ENDDO

         DX=XI(NK)/MK
         DO K = ME+1, MK, NPROCS
            X(K)=0.5+(K-1)*DX
         ENDDO
         IF(ME.EQ.0) P(1)=X(1)
         IF(ME.EQ.NPROCS-1) P(1)=X(MK)

C
C               DENOMINATOR
C
         DO I = 1, NK
            TEMP(I) = 1.
            DENOM(I) = 1.0
            DO  J = 1, NK
               IF (J.NE.I) THEN
                  TEMP(J) = XI(I)-XI(J)
                  DENOM(I) = DENOM(I)*TEMP(J)
               ENDIF
             ENDDO

C
C       NOTE: THE DENOMINATOR IS INVERTED HERE SO THAT A MULTIPLICATION
C               CAN BE DONE LATER
C
            DENOM(I) = 1.0/DENOM(I)
         ENDDO

         DO K = ME+1, MK, NPROCS
            DO  I = 1, NK
               DO J = 1, NK
                  IF (J.NE.I) THEN
                     TAMP(J) = X(K)-XI(J)
                  ENDIF
               ENDDO
               TAMP(I) = 1.0
               PTAMP = 1.0
               DO  J = 1, NK
                  PTAMP = PTAMP*TAMP(J)
              ENDDO

               XL(I) = PTAMP*DENOM(I)
            ENDDO

            TP = 0
            DO I = 1, NK
               TUMP(I) = F(XI(I))*XL(I)
               TP = TP+TUMP(I)
               IF(K.EQ.1) P(2)=TP
               IF(K.EQ.MK) P(2)=TP
           ENDDO
         ENDDO

      IF(ME.EQ.0) CALL send0(P,8,TYPE1,HOST)
      IF(ME.EQ.NPROCS-1) CALL send0(P,8,TYPE2,HOST)
      NODE_SEC=clock0()-STARTTIME

      IF(ME.EQ.0) CALL send0(NODE_SEC,TIMESIZE,TIMETYPE,HOST)
      GOTO 100
      ENDIF

      ELSE

      CALL close0(1)
      WRITE(6,*) 'end of the job on node', ME
      STOP

      ENDIF
      END

      FUNCTION F (X)
      F = X**2-3.0*X-4.0
c      F=EXP(X)
      RETURN
      END












