home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / examples / purdue / prob09.fcm < prev    next >
Encoding:
Text File  |  1993-06-26  |  3.8 KB  |  172 lines
  1.       PROGRAM PROB09
  2. C
  3. C     PROBLEM 9
  4. C
  5. C  REFERENCE:  PROBLEMS TO TEST PARALLEL AND VECTOR LANGUAGES
  6. C              CSD-TR 516, COMPUTER SCIENCE, PURDUE UNIVERSITY
  7. C              JOHN R. RICE, MAY 1, 1985
  8. C
  9. C              REVISED BY JOHN R. RICE AND J. JING, OCT. 1, 1990
  10. C
  11. C
  12. C      *************************************************
  13. C      *      Adapted for FORTRAN D benchmarking       *
  14. C      *    by  T. HAUPT  (haupt@sccs.npac.syr.edu)    *
  15. C      *                                               *
  16. C      *    Northeast Parallel Architectures Center    *
  17. C      *   at Syracuse University, Syracuse, NY, USA   *
  18. C      *************************************************
  19. C
  20. C
  21. C       VERSION SIMD/CM2-1.00
  22. C       ==================================================
  23. C
  24.       INCLUDE '/usr/include/cm/paris-configuration-fort.h'
  25.       INTEGER KASES,NK,MK, NINT
  26.       PARAMETER (KASES=4)
  27.       INTEGER N(KASES),M(KASES)
  28. cmf$  layout N(:SERIAL)
  29. cmf$  layout M(:SERIAL)
  30.       DATA N /64,256,256,512/
  31.       DATA M /128,128,256,512/
  32.    
  33.       PRINT *, 'PROBLEM 9 started'
  34.  
  35.  
  36.       DO 50 K = 1, KASES
  37. C      K=1
  38.  
  39.       CALL CM_TIMER_CLEAR(0)
  40.       CALL CM_TIMER_START(0)
  41.       DO MANY=1,3
  42.       NK=N(K)
  43.       MK=M(K)
  44.       CALL DOIT(NK,MK,TSUMT,NINT)
  45.       ENDDO
  46.       CALL CM_TIMER_STOP(0)
  47.  
  48.       PRINT 60, N(K),M(K)
  49.   60  FORMAT ('PROBLEM 9 WITH N,M =',I6,2X,I6)
  50.       PRINT *,'GIVES TSUMT =',TSUMT
  51.       PRINT *,'AFTER ',NINT,' ITERATIONS'
  52.  
  53.       CALL CM_TIMER_PRINT(0)
  54.  
  55.    50 CONTINUE
  56.  
  57. c     STOP
  58.       END
  59.  
  60.  
  61.       SUBROUTINE DOIT(NK,MK,TSUMT,NINT)
  62.       INTEGER NK,MK
  63.       INTEGER NINT
  64.       REAL TSUMT,TOLER,ERROR
  65.       DATA TOLER /0.05/
  66.       REAL, ARRAY(NK,MK) :: U, T, LU, RU, ERRM
  67. C
  68. C     intitialization
  69. C
  70.       NINT=0
  71.       ERROR=1.0E10
  72.  
  73. !HPF$ INDEPENDENT, LOCAL_ACCESS
  74.       DO J = 1, MK 
  75.          DO I = 1, NK
  76.             U(I,J) = I*(I+1)+FLOAT(J)/(J+1)
  77.             T(I,J) = 0.0
  78.          END DO
  79.       END DO
  80.  
  81. C
  82. C      update U
  83. C
  84.        DO WHILE (ERROR.GT.TOLER)
  85.  
  86.        NINT=NINT+1
  87.  
  88.        LU = cshift (U,2,1)
  89. c      U(_,j+1) -> LU(_,j)
  90.  
  91.        RU = cshift (U,2,-1)
  92. c      U(_,j-1) -> LU(_,j)
  93.  
  94.  
  95. c      update inner board
  96. !HPF$  INDEPENDENT, LOCAL_ACCESS
  97.        DO J= 2, MK-1  
  98.           DO I = 2, NK-1 
  99.              T(I,J) = (U(I,J) + U(I+1,J) + U(I-1,J)
  100.      $          + LU(I,J) + LU(I+1,J) + LU(I-1,J)
  101.      $          + RU(I,J) + RU(I+1,J) + RU(I-1,J) ) / 9.
  102.           END DO
  103.        END DO
  104.  
  105. c       RU(i-1,j)  U(i-1,j) LU(i-1,j)
  106. c       RU(i  ,j)  U(i  ,j) LU(i  ,j)
  107. c       RU(i+1,j)  U(i+1,j) LU(i+1,j)
  108.  
  109.  
  110. c      update left column
  111.  
  112. !HPF$  INDEPENDENT, LOCAL_ACCESS
  113.        DO J = 1, 1   
  114.           DO I = 2, NK-1
  115.              T(I,J) = (U(I,J) + U(I+1,J) + U(I-1,J)
  116.      $            + LU(I,J) + LU(I+1,J) + LU(I-1,J) ) / 6.
  117.           END DO
  118.        END DO
  119.  
  120. c      update right column
  121. !HPF$  INDEPENDENT, LOCAL_ACCESS
  122.        DO J = MK, MK   
  123.           DO I = 2, NK-1
  124.              T(I,J) = (U(I,J) + U(I+1,J) + U(I-1,J)
  125.      $            + RU(I,J) + RU(I+1,J) + RU(I-1,J) ) / 6.
  126.           END DO
  127.        END DO
  128.  
  129. c      update top row
  130. !HPF$  INDEPENDENT, LOCAL_ACCESS
  131.        DO J = 2, MK-1 
  132.           T(1,J) = (U(1,J) + U(2,J) + LU(1,J)
  133.      $         + LU(2,J) + RU(1,J) + RU(2,J) ) / 6.
  134.        END DO
  135.  
  136. c      update bottom row
  137. !HPF$  INDEPENDENT, LOCAL_ACCESS
  138.        DO J = 2, MK-1 
  139.           T(NK,J) = (U(NK,J) + U(NK-1,J) + LU(NK,J)
  140.      $         + LU(NK-1,J) + RU(NK,J) + RU(NK-1,J) ) / 6.
  141.        END DO
  142.  
  143. c      update corners
  144.        T(1,1) = (U(1,1)+LU(1,1)+LU(2,1)+U(2,1)) / 4.
  145.        T(1,MK) = (U(1,MK)+RU(1,MK)+RU(2,MK)+U(2,MK)) / 4.
  146.        T(NK,1) = (U(NK,1)+LU(NK,1)+LU(NK-1,1)+U(NK-1,1)) / 4.
  147.        T(NK,MK) = (U(NK,MK)+RU(NK,MK)+RU(NK-1,MK)+U(NK-1,MK)) / 4.
  148.  
  149.        WHERE (ABS(U).GT.0.001)
  150.           ERRM=ABS((U-T)/U)
  151.        ELSEWHERE
  152.           ERRM=ABS((U-T)/0.001)
  153.        ENDWHERE
  154.  
  155.        ERROR=MAXVAL(ERRM)
  156.  
  157.        U=T
  158.  
  159. c       ERROR=0
  160.        END DO
  161.  
  162.  
  163.        TSUMT= SUM(U(1:NK,1:MK))
  164.  
  165. c     RETURN
  166.       END
  167.  
  168.  
  169.  
  170.  
  171.  
  172.