      PROGRAM PROB09
C
C     PROBLEM 9
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,NK,MK
      PARAMETER (KASES=4)
      INTEGER N(KASES),M(KASES)
      DATA N /64,256,256,512/
      DATA M /128,128,256,512/
      REAL TARRAY(2),TIME1,TIME2


      DO 50 K = 1, KASES
C      K=1

      TIME1=DTIME(TARRAY)
      DO MANY=1,3
      NK=N(K)
      MK=M(K)
      CALL DOIT(NK,MK,TSUMT,NINT)
      ENDDO
      TIME2=DTIME(TARRAY)

      PRINT 60, N(K),M(K)
  60  FORMAT ('PROBLEM 9 WITH N,M =',I6,2X,I6)
      PRINT *,'GIVES TSUMT =',TSUMT
      PRINT *,'AFTER ',NINT,' ITERATIONS'

      PRINT *, 'TIME',TIME2,' SECONDS'
      PRINT *, 'USER:',TARRAY(1),' SYSTEM:',TARRAY(2)

   50 CONTINUE

      STOP
      END


      SUBROUTINE DOIT(NK,MK,TSUMT,NINT)
      INTEGER NK,MK
      INTEGER NINT
      REAL TSUMT,TOLER,ERR
      DATA TOLER /0.05/
      INTEGER NDIM,MDIM
      PARAMETER (NDIM=512,MDIM=512)
      REAL  U(NDIM,MDIM), T(NDIM,MDIM)
C
C     intitialization
C
         NINT=0
         ERR=1.0E10

         DO  I = 1, NK
            DO  J = 1, MK
                U(I,J) = I*(I+1)+FLOAT(J)/(J+1)
               T(I,J)=0.0
            ENDDO
         ENDDO

C
C      update U
C
       DO WHILE (ERR.GT.TOLER)

       NINT=NINT+1

       DO 40 I = 2, NK-1
          DO 30 J = 2, MK-1
               T(I,J) = (U(I,J)+U(I+1,J)+U(I-1,J)+U(I,J+1)+U(I+1,J+1)+U(
     *            I-1,J+1)+U(I,J-1)+U(I+1,J-1)+U(I-1,J-1))/9.
   30     CONTINUE
          T(I,1) = (U(I,1)+U(I,2)+U(I-1,1)+U(I+1,1)+U(I-1,2)+U(I+1,2))
     *         /6.
          T(I,MK) = (U(I,MK)+U(I,MK-1)+U(I-1,MK)+U(I+1,MK)+U(I-1,MK-1)+
     *        U(I+1 ,MK-1))/6.
   40  CONTINUE
       DO 50 J = 1, MK-1
          T(1,J) = (U(1,J)+U(1,J+1)+U(1,J-1)+U(2,J)+U(2,J+1)+U(2,J-1))
     *         /6.
          T(NK,J) = (U(NK,J)+U(NK,J+1)+U(NK,J-1)+U(NK-1,J)+U(NK-1,J+1)+
     *         U(NK-1,J-1))/6.
   50  CONTINUE
       T(1,1) = (U(1,1)+U(1,2)+U(2,2)+U(2,1))/4.
       T(NK,1) = (U(NK,1)+U(NK,2)+U(NK-1,2)+U(NK-1,1))/4.
       T(1,MK) = (U(1,MK)+U(2,MK)+U(1,MK-1)+U(2,MK-1))/4.
       T(NK,MK) = (U(NK,MK)+U(NK-1,MK)+U(NK,MK-1)+U(NK-1,MK-1))/4.

       ERR=-1.0
       DO 60 I=1,NK
       DO 60 J=1,MK
         IF(ABS(U(I,J)).GT.0.001) THEN
           ERR=AMAX1(ERR,ABS(U(I,J)-T(I,J))/U(I,J))
         ELSE
           ERR=AMAX1(ERR,ABS(U(I,J)-T(I,J))/0.001)
         ENDIF
       U(I,J)=T(I,J)
   60  CONTINUE



c       ERR=0
       END DO


       TSUMT = 0.0
       DO 75 I = 1, NK
        DO 72 J = 1, MK
          TSUMT = TSUMT+U(I,J)
   72   CONTINUE
   75  CONTINUE
C
      RETURN
      END





