      PROGRAM NODE08
C
C     PROBLEM 08
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 PARTTYPE
      DATA PARTTYPE /20/
      INTEGER NK,MK
      REAL SUMD
      INTEGER NDIM,MDIM,I,J,N
      PARAMETER (NDIM=131072)
      PARAMETER (MDIM=8)
      REAL X(NDIM),DIFF(NDIM,MDIM)
      INTEGER IBEG,IEND,NMAX,MLEN
      INTEGER XTYPE,DTYPE
      DATA XTYPE,DTYPE /31,32/
      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


      IF(MOD(NK,NPROCS).EQ.0) THEN
        NMAX=NK/NPROCS
      ELSE
        NMAX=NK/NPROCS+1
      ENDIF

      IBEG=ME*NMAX+1
      IEND=(ME+1)*NMAX
      IF(IEND.GT.NK) IEND=NK


         DO I=IBEG,IEND
            X(I) = .2*I+.01*COS(FLOAT(I))
            DIFF(I,1) = SIN(X(I))
         ENDDO

         SUMD = 0
         N=NK

         DO J = 2, MK
            N = N-1

              MLEN=J-1
              IF(IBEG+MLEN-1.GT.IEND) MLEN=IEND-IBEG+1
              IF(ME.GT.0) CALL send0(X(IBEG),MLEN*4,XTYPE,ME-1)

           MLEN=J-1
           IF( (N-(NPROCS-1)*NMAX.LT.MLEN) .AND. (ME.EQ.NPROCS-2) )
     *      MLEN=N-(NPROCS-1)*NMAX

           IF(ME.LT.NPROCS-1) CALL recv0(X(IEND+1),MLEN*4,XTYPE)


           IF(ME.GT.0) CALL send0(DIFF(IBEG,J-1),4,DTYPE,ME-1)
           IF(ME.LT.NPROCS-1) CALL recv0(DIFF(IEND+1,J-1),4,DTYPE)

           IF(IEND.GT.N) IEND=N

           DO I=IBEG,IEND
             DIFF(I,J) = (DIFF(I+1,J-1)-DIFF(I,J-1))/(X(I+J-1)-X(I))
             SUMD = SUMD+DIFF(I,J)
           ENDDO
        ENDDO

      CALL gsum0(SUMD,1,4,PARTTYPE,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







