home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / vrac / laipe.zip / FMENTRY.FOR < prev    next >
Text File  |  1995-07-31  |  7KB  |  263 lines
  1. C
  2. C
  3. C  Program to demo parallel performance of the following LAIPE subroutine
  4. C  (1) meSolution_CSG_S that solves a system of linear equations by a
  5. C      multiple-entry solver. The left side matrix is symmetric.
  6. C
  7. C  If a multiple-processor computer is available, this subroutine will
  8. C  be implemented in a loop. The loop bound begins with one to the number
  9. C  of system processors, and each loop sets the loop counter as the
  10. C  number of employed processors. Keep computer STANDING ALONE while
  11. C  running this program, and elapsed time with respect to different
  12. C  number of precossors will be reported.
  13. C
  14. C  Running this program, user has to provide the matrix order, i.e., 40000,
  15. C  the lower bandwidth, i.e., 15, and the number of vectors in the right
  16. C  side of equations, i.e., 2. Larger order may have a better performance.
  17. C
  18. C  define global variables
  19. C
  20.       PARAMETER (LIMIT=7000000)
  21.       REAL*4 A(LIMIT)
  22. C
  23. C  variables for memory distribution
  24. C  where IndexA : index to the left side matrix [A]
  25. C        IndexX : index to the right side vector(s)
  26. C        IndexSolution : index to the exact solution that is used to
  27. C                        check accuracy
  28. C        IndexWorking : index to a working space
  29. C
  30.       INTEGER*4 IndexA,IndexX,IndexWorking,IndexSolution
  31. C
  32. C  variable for collecting elapsed time
  33. C
  34.       REAL*4 Second
  35. C
  36. C  variables for calculating accuracy
  37. C
  38.       REAL*4 Lower,Upper,R4TEMP
  39. C
  40. C  variables for problem size
  41. C  where N : matrix order
  42. C        M : lower bandwidth
  43. C        Nset : number of vectors in the right side of equations
  44. C
  45.       INTEGER*4 N,M,Nset
  46. C
  47. C  variables for number of processors
  48. C  where CPUs : number of system processors
  49. C        Processors: number of employed processors
  50. C
  51.       INTEGER*4 Processors,CPUs
  52. C
  53. C  execution flag
  54. C
  55.       LOGICAL*4 NoGood
  56. C
  57. C  numerical zero
  58. C
  59.       REAL*4 ZERO
  60.       DATA ZERO/0.0001/
  61. C
  62. C  enter order of the system
  63. C
  64.       WRITE(*,'('' Enter order (i.e., 40000 or something else): '',$)')
  65.       READ(*,*) N
  66. C
  67. C  enter half bandwidth
  68. C
  69.       WRITE(*,
  70.      &'('' Enter half bandwidth (i.e., 15 or something else): '',$)')
  71.       READ(*,*) M
  72. C
  73. C  enter number of vectors
  74. C
  75.       WRITE(*,
  76.      &'('' Enter number of vectors (i.e., 2 or something else): '',$)')
  77.       READ(*,*) Nset
  78. C
  79. C  memory distribution
  80. C
  81.       IndexX=1
  82.       IndexSolution=IndexX+N*Nset
  83.       IndexA=IndexSolution+N*Nset
  84.       IndexWorking=IndexA+(N-1)*M+N
  85. C
  86. C  check memory space
  87. C
  88.       IF(IndexWorking+2*M*N.GT.LIMIT) THEN
  89.          WRITE(*,'('' Memory overflow'')')
  90.          STOP
  91.       END IF
  92. C
  93. C  get number of system processors
  94. C
  95.       CALL GetCPUs(CPUs)
  96. C
  97. C  set processors to execute the following statements
  98. C
  99.       DO Processors=1,CPUS
  100.          CALL SetEmployedProcessors(Processors)
  101. C
  102. C  generate left side matrix and right side vector
  103. C
  104.          Write(*,*)
  105.          Write(*,'('' Generate data in a pseudo-random procedure...'',
  106.      &             $)')
  107.          CALL GenerateData(A(IndexX),A(IndexA),
  108.      &                     A(IndexSolution),N,M,Nset)
  109. C
  110. C  output number of employed processors
  111. C
  112.          WRITE(*,
  113.      &   '(/,'' Number of employed processors: '',I3)') Processors
  114. C
  115. C  start collecting elapsed time spent in the solution
  116. C
  117.          CALL CollectElapsedTime
  118. C      
  119. C  solve in parallel
  120. C
  121.          CALL meSolution_CSG_S
  122.      &       (
  123.      &        A(IndexA),
  124.      &        N,
  125.      &        M,
  126.      &        A(IndexX),
  127.      &        Nset,
  128.      &        A(IndexWorking),
  129.      &        Zero,
  130.      &        NoGood
  131.      &       )
  132. C
  133. C  output elapsed time
  134. C
  135.          CALL GetElapsedTime(Second)
  136.          Write(*,'('' Solve>>> Elapsed Time (seconds): '',F8.2)')
  137.      &                                                   Second
  138. C
  139. C  stop if the system is not suitable for routine Decompose_DSG
  140. C
  141.          IF(NoGood) THEN
  142.             WRITE(*,'('' The system is not suit for routine'',
  143.      &                '' Decompose_CSG.'')')
  144.             STOP
  145.          END IF
  146. C
  147. C  calculate lower and upper bounds of relative errror
  148. C
  149.          KK=IndexX
  150.          JJ=IndexSolution
  151.          DO II=1,Nset
  152.             Lower=(A(JJ)-A(KK))/A(JJ)
  153.             Upper=Lower
  154.             DO I=2,N
  155.                JJ=JJ+1
  156.                KK=KK+1
  157.                R4TEMP=(A(JJ)-A(KK))/A(JJ)
  158.                IF(R4TEMP.LT.Lower) THEN
  159.                   Lower=R4TEMP
  160.                ELSE IF(R4TEMP.GT.Upper) THEN
  161.                   Upper=R4TEMP
  162.                END IF
  163.             END DO
  164.             JJ=JJ+1
  165.             KK=KK+1
  166. C
  167. C  output lower bound and upper bound of relative error
  168. C
  169.             WRITE(*,*) 'Lower and upper bound of the relative error:'
  170.             WRITE(*,*) Lower,Upper
  171.          END DO
  172.       END DO
  173.       STOP
  174.       END
  175.       SUBROUTINE GenerateData(X,A,Solution,N,M,Nset)
  176. C
  177. C
  178. C  routine to generate the left side matrix, and the right side vector
  179. C  (A)FORTRAN CALL: CALL GenerateData(X,A,Solution,N,M,Nset)
  180. C     1.X: <R4> right side vector, dimension(N,Nset)
  181. C     2.A: <R4> left side matrix, dimension(*)
  182. C     3.Solution: <R4> return the solution for checking accuracy,
  183. C                      dimension(N,Nset)
  184. C     3.N: <I4> order
  185. C     4.M: <I4> half bandwidth
  186. C     5.Nset: <I4> number of vectors
  187. C
  188.       INTEGER*4 N,M,SEED,Nset
  189.       REAL*4 A(M,1),X(N,1),Solution(N,1)
  190. C
  191. C  private variables
  192. C
  193.       REAL*4 R4TEMP$
  194.       AUTOMATIC R4TEMP$
  195. C
  196. C  left side matrix
  197. C
  198.       Seed=456789
  199.       DO I=1,N
  200.          DO J=I,MIN0(I+M,N)
  201.             A(J,I)=RAN(SEED)*100.0
  202.          END DO
  203.       END DO
  204.       DO I=1,N
  205.          DO J=I+1,MIN0(I+M,N)
  206.             IF(A(J,I).GT.A(I,I)) THEN
  207.                R4TEMP$=A(J,I)
  208.                A(J,I)=A(I,I)
  209.                A(I,I)=R4TEMP$
  210.             END IF
  211.          END DO
  212.       END DO
  213.       DO I=1,N
  214.          A(I,I)=A(I,I)*50.0
  215.       END DO
  216. C
  217. C  the solution
  218. C
  219.       DO II=1,Nset
  220.          DO I=1,N
  221.             Solution(I,II)=Ran(Seed)*500.0
  222.          END DO
  223.       END DO
  224. C
  225. C  right side vector
  226. C
  227.       DO II=1,Nset
  228.          DO I=1,N
  229.             X(I,II)=A(I,I)*Solution(I,II)
  230.          END DO
  231.          DO I=1,N
  232.             DO J=I+1,MIN0(N,I+M)
  233.                X(I,II)=X(I,II)+A(J,I)*Solution(J,II)
  234.                X(J,II)=X(J,II)+A(J,I)*Solution(I,II)
  235.             END DO
  236.          END DO
  237.       END DO
  238. C
  239.       RETURN
  240.       END
  241.       REAL*4 FUNCTION RAN(SEED)
  242. C
  243. C
  244. C  function to generate a pseudo-random number
  245. C  (A)FORTRAN ENTRY: RAN(SEED)
  246. C     1.RAN: <R4> return a random number
  247. C     2.SEED: <I4> a seed (updated)
  248. C
  249.       INTEGER*4 SEED,A
  250.       REAL*8 RTEMPA,RTEMPB
  251.       DATA M/2147483647/,A/16807/
  252. C
  253. C  generate a random number
  254. C
  255.       RTEMPA=DFLOAT(SEED)*A
  256.       ITEMP=INT(RTEMPA/DFLOAT(M))
  257.       RTEMPB=DFLOAT(M)*DFLOAT(ITEMP)
  258.       SEED=INT(RTEMPA-RTEMPB)
  259.       RAN=DFLOAT(SEED)/DFLOAT(M)
  260. C
  261.       RETURN
  262.       END
  263.