      PROGRAM PROB14
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 SEQUENTIAL-1.00  (PLAIN FORTRAN77)
C       ==================================================
      INTEGER KASES,JFUNK,NFUNK
      PARAMETER (KASES=4)
      INTEGER N(KASES)
      DATA N / 8192,16384,65536,262144/
      DATA NFUNK /3/
      INTEGER METH,IFUN,NK
      REAL RESULT,TRUE,A,B,ERROR

      REAL TARRAY(2),TIME1,TIME2
C      DO  IFUN=1,NFUNK
C     remember: there is corresponding ENDDO (!)
      IFUN=2
      CALL FVALS(A,B,TRUE,IFUN)
      DO  K = 1, KASES
         NK=N(K)
       DO METH=1,3
      TIME1=DTIME(TARRAY)
       DO MANY=1,50
         CALL DOIT(NK,A,B,METH,IFUN,RESULT)
       ENDDO
      TIME2=DTIME(TARRAY)
         ERROR = RESULT - TRUE
         PRINT *, ' '
         PRINT *,'PROBLEM 14 WITH N = ',NK
         PRINT *,'METHOD',METH,' FUNCTION ',IFUN
         PRINT *,'GIVES INTEGRAL ESTIMATE =', RESULT
         PRINT *,'ERROR (ESTIMATE-TRUE VALUE) = ',ERROR
      PRINT *, 'TIME',TIME2,' SECONDS'
      PRINT *, 'USER:',TARRAY(1),' SYSTEM:',TARRAY(2)
        ENDDO
       ENDDO
C      ENDDO
      STOP
      END


      SUBROUTINE  DOIT(NK,A,B,METH,IFUN,RESULT)
      INTEGER NK,METH,IFUN
      REAL A,B,RESULT
      INTEGER NSIMP,NG
      REAL H77
      REAL H
      INTEGER JJ
      REAL SUM1,SUM2,SUM3
C
      IF(METH.EQ.1) THEN
C
C        TRAPEZOIDAL RULE
C
           H = (B-A)/NK
           RESULT = 0


           DO JJ = 1, NK-1

              RESULT = RESULT + F(A+H*JJ,IFUN)
           ENDDO
           RESULT=(RESULT*2.0+F(A,IFUN)+F(B,IFUN))*H/2.0

      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

           DO JJ = 1, NSIMP-1,2
              SUM1 = SUM1 + F(A+H*JJ,IFUN)
           ENDDO

           DO JJ  = 2, NSIMP-2, 2
              SUM2 = SUM2 + F(A+H*JJ,IFUN)
           ENDDO
           RESULT = H*(F(A,IFUN)+F(B,IFUN)+4.0*SUM1+2.0*SUM2)/3.

      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

            DO JJ = 1, NG
               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
            RESULT = H*(5.0*(SUM1+SUM3)+8.0*SUM2)/18.0

      ENDIF

      RETURN
      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

      SUBROUTINE FVALS (A,B,TRUE,IFUN)
      IF (IFUN.EQ.1) THEN
         A = 0.
         B = 1.
         TRUE = 1.71828182845
      ENDIF
      IF (IFUN.EQ.2) THEN
         A = 0.
         B = 1.
         TRUE = .5222099422093
      ENDIF
      IF (IFUN.EQ.3) THEN
         A = -1.
         B = 2.
         TRUE = 6.29919656054
      ENDIF
      RETURN
      END


