      PROGRAM NODE14
C
C     PROBLEM 14
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(5),MSGSIZE
      DATA MSGSIZE /20/
      EQUIVALENCE (MSG(1),NK),(MSG(2),A),(MSG(3),B)
      EQUIVALENCE (MSG(4),METH),(MSG(5),IFUN)
C -----------------------------------------------------------
C      parameters of messages with partial results
C -----------------------------------------------------------
      INTEGER*4 PARTTYPE,HTYPE
      DATA PARTTYPE,HTYPE /20,21/
      REAL PSUM(4),H
      INTEGER NK,METH,IFUN
      REAL A,B,RESULT
      INTEGER NSIMP,NG
      REAL H77
      INTEGER JJ
      REAL SUM1,SUM2,SUM3
      INTEGER JJMAX,JJMIN,JB1,JB2,JE,NMAX
      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

C
      IF(METH.EQ.1) THEN
C
C        TRAPEZOIDAL RULE
C
           H = (B-A)/NK
           RESULT = 0

           IF(ME.EQ.0) call send0(H,4,HTYPE,HOST)
           IF(MOD(NK,NPROCS).EQ.0) THEN
              NMAX=NK/NPROCS
           ELSE
              NMAX=NK/NPROCS+1
           ENDIF

           JJMIN=ME*NMAX+1
           JJMAX=(ME+1)*NMAX

           IF(JJMAX.GT.NK) JJMAX=NK

           IF(ME.EQ.NPROCS-1) JJMAX=JJMAX-1

           DO JJ = JJMIN,JJMAX
              RESULT = RESULT + F(A+H*JJ,IFUN)
           ENDDO
            PSUM(1)=RESULT
            CALL gsum0(PSUM,1,4,PARTTYPE,HOST)



      ENDIF


      IF(METH.EQ.2) THEN
C
C        SIMPSON's METHOD
C
           NSIMP = NK
           IF (MOD(NSIMP,2).EQ.1) NSIMP = NSIMP-1
           H = (B-A)/NSIMP

           SUM1 = 0
           SUM2 = 0

           IF(ME.EQ.0) call send0(H,4,HTYPE,HOST)
           IF(MOD(NSIMP,NPROCS).EQ.0) THEN
             NMAX=NSIMP/NPROCS
           ELSE
             NMAX=NSIMP/NPROCS+1
           ENDIF

           JJMIN=ME*NMAX+1
           JJMAX=(ME+1)*NMAX

           IF(JJMAX.GT.NSIMP) JJMAX=NSIMP

           IF(MOD(JJMIN,2).EQ.0) THEN
             JB1=JJMIN+1
             JB2=JJMIN
           ELSE
             JB1=JJMIN
             JB2=JJMIN+1
           ENDIF

           IF(ME.EQ.NPROCS-1) THEN
             JE=JJMAX-1
           ELSE
             JE=JJMAX
           ENDIF

           DO JJ = JB1,JE,2
              SUM1 = SUM1 + F(A+H*JJ,IFUN)
           ENDDO

           DO JJ = JB2,JE,2
              SUM2 = SUM2 + F(A+H*JJ,IFUN)
           ENDDO
            PSUM(1)=SUM1
            PSUM(2)=SUM2
            CALL gsum0(PSUM,2,4,PARTTYPE,HOST)
      ENDIF

      IF(METH.EQ.3) THEN
C
C        GAUSS' METHOD
C
            NG=(NK-MOD(NK,3))/3
            H = (B-A)/NG
            H77 = .774596669241*H


            SUM1 = 0
            SUM2 = 0
            SUM3 = 0

           IF(ME.EQ.0) call send0(H,4,HTYPE,HOST)
           IF(MOD(NG,NPROCS).EQ.0) THEN
              NMAX=NG/NPROCS
           ELSE
              NMAX=NG/NPROCS+1
           ENDIF

           JJMIN=ME*NMAX+1
           JJMAX=(ME+1)*NMAX

           IF(JJMAX.GT.NG) JJMAX=NG

           DO JJ = JJMIN,JJMAX
               SUM1 = SUM1+F(A+JJ*H-H/2.0-H77,IFUN)
               SUM2 = SUM2+F(A+JJ*H-H/2.0,IFUN)
               SUM3 = SUM3+F(A+JJ*H-H/2.0+H77,IFUN)
            ENDDO
            PSUM(1)=SUM1
            PSUM(2)=SUM2
            PSUM(3)=SUM3
            CALL gsum0(PSUM,3,4,PARTTYPE,HOST)


      ENDIF
C     messages already sent
      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,IFUN)
      INTEGER IFUN
      REAL X

      IF (IFUN.EQ.1) F = EXP(X)
      IF (IFUN.EQ.2) F = SQRT(ABS(X-.2345))
      IF (IFUN.EQ.3) F = 1.+X*X+1./(1.+100.*X*X)
      RETURN
      END



