home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / adaptor / examples / dalib / schedule / all.f next >
Encoding:
Text File  |  1993-06-28  |  2.6 KB  |  117 lines
  1. c      test program for dalib_schedule
  2. c
  3.       program test
  4.          call test_get1 ()
  5.          call test_set1 ()
  6.          call test_get2 ()
  7.          call test_set2 ()
  8.       end
  9.  
  10.       subroutine test_get1 ()
  11.       parameter (N=10)
  12.       integer A(N), B(N), P(N), HA(N)
  13. cmf$  layout HA(:host)
  14.       real R(N)
  15.       forall (I=1:N) A(I) = I
  16. c     init P by random
  17.       call cmf_random (R)
  18.       P = R * N + 1
  19.       HA = P
  20.       print *, 'TEST of GET1'
  21.       print 10, HA
  22.       HA = A
  23.       call global_get (B, A, P)
  24. c     B = A(P)
  25.       print 11, HA
  26.       HA = B
  27.       print 12, HA
  28.   10  format (' P        : ',20I3)
  29.   11  format (' A        : ',20I3)
  30.   12  format (' B = A[P] : ',20I3)
  31.       end
  32.  
  33.       subroutine test_set1 ()
  34.       parameter (N=10)
  35.       integer A(N), B(N), P(N), HA(N)
  36. cmf$  layout HA(:host)
  37.       real R(N)
  38.       forall (I=1:N) A(I) = I
  39.       B = 0
  40. c     init P by random
  41.       call cmf_random (R)
  42.       P = R * N + 1
  43.       HA = P
  44.       print 10, HA
  45.       HA = A
  46.       print 11, HA
  47. c     B(P) = A
  48.       print *, 'TEST of SET1'
  49.       call global_send (B, P, A)
  50.       HA = B
  51.       print 12, HA
  52.   10  format (' P        : ',20I3)
  53.   11  format (' A        : ',20I3)
  54.   12  format (' B[P] = A : ',20I3)
  55.       end
  56.  
  57.       subroutine test_get2 ()
  58.       parameter (N=10)
  59.       integer A(3,N), B(N), P(N), Q(N), HA(N), HA1(3,N)
  60. cmf$  layout HA(:host)
  61. cmf$  layout HA1(:host)
  62.       real R(N)
  63.       forall (I=1:N,J=1:3) A(J,I) = J*10 + I
  64. c     init P by random
  65.       call cmf_random (R)
  66.       P = R * 3 + 1
  67.       call cmf_random (R)
  68.       Q = R * N + 1
  69.       print *, 'TEST of GET2'
  70.       HA = P
  71.       print 10, HA
  72.       HA = Q
  73.       print 11, HA
  74.       HA1 = A
  75.       do J = 1, 3
  76.         print 12, HA1 (J,:)
  77.       end do
  78.       call global_get (B, A, P, Q)
  79.       HA = B
  80.       print 13, HA
  81.   10  format (' P          : ',20I3)
  82.   11  format (' Q          : ',20I3)
  83.   12  format (' A          : ',20I3)
  84.   13  format (' B = A[P,Q] : ',20I3)
  85.       end
  86.  
  87.       subroutine test_set2 ()
  88.       parameter (N=10)
  89.       integer A(3,N), B(N), P(N), Q(N), HA(N), HA1(3,N)
  90. cmf$  layout HA (:host)
  91. cmf$  layout HA1 (:host)
  92.       real R(N)
  93.       forall (I=1:N) B(I) = I
  94.       A = 0
  95. c     init P by random
  96.       print *, 'TEST of SET2'
  97.       call cmf_random (R)
  98.       P = R * 3 + 1
  99.       HA = P
  100.       print 10, HA
  101.       call cmf_random (R)
  102.       Q = R * N + 1
  103.       HA = Q
  104.       print 11, HA
  105.       HA = B
  106.       print 12, HA
  107.       call global_send (A, P, Q, B)
  108.       HA1 = A
  109.       do J = 1, 3
  110.          print 13, HA1(J,:)
  111.       end do
  112.   10  format (' P          : ',20I3)
  113.   11  format (' Q          : ',20I3)
  114.   12  format (' B          : ',20I3)
  115.   13  format (' A[P,Q] = B : ',20I3)
  116.       end
  117.