home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / examples / dalib / replic / all.f next >
Encoding:
Text File  |  1993-04-28  |  2.2 KB  |  120 lines
  1.       program replicate
  2.  
  3.       logical okay
  4.  
  5.       call rep1 (okay)
  6.       if (.not. okay) print *, 'ERROR : Replicate 1'
  7.       call rep2 (okay)
  8.       if (.not. okay) print *, 'ERROR : Replicate 2'
  9.       call rep3 (okay)
  10.       if (.not. okay) print *, 'ERROR : Replicate 3'
  11.       call rep4 (okay)
  12.       if (.not. okay) print *, 'ERROR : Replicate 4'
  13.  
  14.       end
  15.  
  16.       subroutine rep1 (okay)
  17.       logical okay
  18.  
  19.       real a(10), ra(5), x
  20. cmf$  layout ra(:serial)
  21.  
  22.       forall (i=1:10) a(i) = i
  23.  
  24.       ra = 0
  25.       ra = a(4:8)
  26.  
  27.       n = 0
  28.       do i = 4, 8
  29.         n = n +i 
  30.       end do
  31.  
  32.       x = sum (ra)
  33.       okay = (x .eq. n)
  34.       print *, 'Result is ', x, ' and should be ', n
  35.       end
  36.  
  37.       subroutine rep2 (okay)
  38.       logical okay 
  39.  
  40.       double precision a(10,10), ra(5,5), x
  41.       integer i, j, n
  42.  
  43. cmf$  layout ra(:serial,:serial)
  44.  
  45.       forall (i=1:10,j=1:10) a(i,j) = i + j
  46.  
  47.       ra = 0
  48.       ra = a(4:8,2:6)
  49.  
  50.       n = 0
  51.       do i = 4, 8
  52.         do j = 2, 6
  53.            n = n + i + j
  54.         end do
  55.       end do
  56.  
  57.       x = sum (ra)
  58.       okay = (x == n)
  59.       print *, 'Result is ', x, ' and should be ', n
  60.       end
  61.  
  62.       subroutine rep3 (okay)
  63.       logical okay
  64.  
  65.       double precision a(10,10,10), ra(5,5,5), x
  66.       integer i, j, n
  67.  
  68. cmf$  layout ra(:serial,:serial,:serial)
  69.  
  70.       forall (i=1:10,j=1:10,k=1:10) a(i,j,k) = i + 2*j - k
  71.  
  72.       ra = 0
  73.       ra = a(4:8,2:6,5:9)
  74.  
  75.       n = 0
  76.       do i = 4, 8
  77.         do j = 2, 6
  78.           do k = 5,9
  79.             n = n + i + 2*j - k
  80.           end do
  81.         end do
  82.       end do
  83.  
  84.       x = sum (ra)
  85.       okay = (x == n)
  86.       print *, 'Result is ', x, ' and should be ', n
  87.       end
  88.  
  89.       subroutine rep4 (okay)
  90.       logical okay
  91.  
  92.       integer a(10,10,10,10)
  93.       integer ra(5,5,5,10), x
  94.       integer i, j, k, l, n
  95.  
  96. cmf$  layout ra(:serial,:serial,:serial,:serial)
  97.  
  98.       forall (i=1:10,j=1:10,k=1:10,l=1:10)
  99.         a(i,j,k,l) = i + 2*j - k + 3*l
  100.       end forall
  101.  
  102.       ra = 0
  103.       ra = a(4:8,2:6,5:9,1:10)
  104.  
  105.       n = 0
  106.       do i = 4, 8
  107.         do j = 2, 6
  108.           do k = 5,9
  109.             do l = 1, 10
  110.                n = n + i + 2*j - k + 3*l
  111.             end do
  112.           end do
  113.         end do
  114.       end do
  115.  
  116.       x = sum (ra)
  117.       okay = (x .eq. n)
  118.       print *, 'Result is ', x, ' and should be ', n
  119.       end
  120.