      PROGRAM PROB06
C
C     PROBLEM 6
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,K,NK
      PARAMETER (KASES=4)
      INTEGER N(KASES)
      REAL SOLUT
      DATA N / 8196,16384,65536,262144/
      INTEGER ITIME
      REAL TIME
C
C               LOOP OVER KASES
C
      DO  K = 1, KASES
         NK=N(K)
      CALL mpTIMERstart()
         DO MANY=1,20
         CALL DOIT(NK,SOLUT)
        ENDDO
      ITIME=mpTIMERelapsed()

         PRINT *,'PROBLEM 6 WITH N = ',NK
         PRINT *,'GIVES SOLUTION =', SOLUT
      TIME=FLOAT(ITIME)/1000
      PRINT *, 'DECmpp ELAPSED TIME:',TIME,' SECONDS'

      ENDDO

      STOP
      END



      SUBROUTINE DOIT(NK,SOLUT)
      INTEGER NK
      REAL SOLUT
      DOUBLE PRECISION, ARRAY(NK) :: L,D,T,X,Y,U
      INTEGER II,K,LIMIT

c      L=0.88-0.1*SIN([1:NK]*12.36)
c      D=1.0d00+0.01*COS([1:NK]*8.11)
c      U=0.75+0.2*SIN([1:NK]*36.12+3.2)
      L=1.0d00
      D=0.5d00
      U=0.5d00
      Y=1.0d00
      X=0.0
      T=0.0
C
C
C      LIMIT = LOG BASE 2 OF N
C
         LIMIT = 1.44269504*ALOG(FLOAT(NK))+.01
         K = 1
C
C                                 MAIN LOOP
C
         DO II = 1, LIMIT

               L=L/D
               U=U/D
               Y=Y/D

C
C                         T IS A TEMPORARY ARRAY
C                   COMPUTE AND ASSIGN TO D, COMPUTE Y
C
           D(1:K) = 1.0    - U(1:K)*L(K+1:K+K)
           T(1:K) = Y(1:K) - U(1:K)*L(K+1:K+K)

           D(K+1:NK-K) = 1.0 - L(K+1:NK-K)*U(1:NK-2*K) -
     +                  U(K+1:NK-K)*L(2*K+1:NK)
           T(K+1:NK-K) = Y(K+1:NK-K)   - L(K+1:NK-K)*Y(1:NK-2*K) -
     +                  U(K+1:NK-K)*L(2*K+1:NK)

           D(NK-K+1:NK) = 1.0        - L(NK-K+1:NK)*U(NK-2*K+1:NK-K)
           T(NK-K+1:NK) = Y(NK-K+1:NK) - L(NK-K+1:NK)*Y(NK-2*K+1:NK-K)
C
C                          ASSIGN TO Y, COMPUTE L
C
            Y=T
            T(1:K)=0
            T(K+1:NK)=-L(K+1:NK)*L(1:NK-K)
C
C                          ASSIGN TO L, COMPUTE U
C
            L=T
            T(1:NK-K)=U(1:NK-K)*U(K+1:NK)
            T(NK-K+1:NK)=0
C
C                          ASSIGN TO U
C
            U=T

            K = 2*K

      ENDDO

      X=Y/D
      SOLUT=SUM(X)
C-------------------- to be removed -------------
C+SELF,IF=F77,F77PAR,IPSC860,IF=-HOST.
C      FSUM = 0.0
C+SELF,IF=F77,F77PAR.
C      DO I = 1, N-2
C+SELF,IF=IPSC860,IF=NODE.
C      DO I=ME+1,N,NPROCS
C+SELF,IF=F77,F77PAR,IPSC860,IF=-HOST.
C        FSUM = FSUM+EXP(A+H*I)
C      ENDDO
C
C+SELF,IF=CM2,CM5,DECMPP.
C      FSUM=SUM(EXP(A+H*[1:N]))
C
C-----------------end to be removed --------------

      RETURN
      END
