← Back to branch summary

~ubuntu-branches/ubuntu/saucy/nwchem/saucy

« back to all changes in this revision

Viewing changes to src/tools/ga-5-1/armci/f90/testnbfa_type.f90

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2012-02-09 20:02:41 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120209200241-jgk03qfsphal4ug2
Tags: 6.1-1
http://bugs.debian.org/632611
https://launchpad.net/bugs/791308
* New upstream release.

[ Michael Banck ]
* debian/patches/02_makefile_flags.patch: Updated.
* debian/patches/02_makefile_flags.patch: Use internal blas and lapack code.
* debian/patches/02_makefile_flags.patch: Define GCC4 for LINUX and LINUX64
  (Closes: #632611 and LP: #791308).
* debian/control (Build-Depends): Added openssh-client.
* debian/rules (USE_SCALAPACK, SCALAPACK): Removed variables (Closes:
  #654658).
* debian/rules (LIBDIR, USE_MPIF4, ARMCI_NETWORK): New variables.
* debian/TODO: New file.
* debian/control (Build-Depends): Removed libblas-dev, liblapack-dev and
  libscalapack-mpi-dev.
* debian/patches/04_show_testsuite_diff_output.patch: New patch, shows the
  diff output for failed tests.
* debian/patches/series: Adjusted.
* debian/testsuite: Optionally run all tests if "all" is passed as option.
* debian/rules: Run debian/testsuite with "all" if DEB_BUILD_OPTIONS
  contains "checkall".

[ Daniel Leidert ]
* debian/control: Used wrap-and-sort. Added Vcs-Svn and Vcs-Browser fields.
  (Priority): Moved to extra according to policy section 2.5.
  (Standards-Version): Bumped to 3.9.2.
  (Description): Fixed a typo.
* debian/watch: Added.
* debian/patches/03_hurd-i386_define_path_max.patch: Added.
  - Define MAX_PATH if not defines to fix FTBFS on hurd.
* debian/patches/series: Adjusted.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/tools/ga-5-1/armci/f90/testnbfa_type.f90
 
1
subroutine testanb_i4(nproc,me,remote_proc)
 
2
  use definekind
 
3
  use armci_types
 
4
  use armci_mem_f90
 
5
  use armci_nbmov
 
6
  use testa_init
 
7
  use checkput
 
8
  implicit none
 
9
  type(ARMCI_slice) :: src_slice, dst_slice
 
10
  integer :: nproc,me,remote_proc
 
11
  integer(kind=I4), pointer :: a7_i4(:,:,:,:,:,:,:), b7_i4(:,:,:,:,:,:,:)
 
12
  integer(kind=I4), pointer :: a6_i4(:,:,:,:,:,:),   b6_i4(:,:,:,:,:,:)
 
13
  integer(kind=I4), pointer :: a5_i4(:,:,:,:,:),     b5_i4(:,:,:,:,:)
 
14
  integer(kind=I4), pointer :: a4_i4(:,:,:,:),       b4_i4(:,:,:,:)
 
15
  integer(kind=I4), pointer :: a3_i4(:,:,:),         b3_i4(:,:,:)
 
16
  integer(kind=I4), pointer :: a2_i4(:,:),           b2_i4(:,:)
 
17
  integer(kind=I4), pointer :: a1_i4(:),             b1_i4(:)
 
18
  integer(kind=I4), pointer :: v_i4(:)
 
19
 
 
20
  integer :: lb(7), ub(7), rc, i, j
 
21
  integer :: pass
 
22
  integer :: myunit
 
23
  integer :: m
 
24
  integer :: rank
 
25
  integer :: joff
 
26
  integer :: vshape(1)
 
27
  integer :: extent(7)
 
28
  integer :: asize(7)
 
29
  integer :: score(7)
 
30
  integer :: vlb(1),vub(1)
 
31
  integer :: afirst,bfirst
 
32
 
 
33
  afirst = 1+me
 
34
  bfirst = afirst * afirst
 
35
 
 
36
  lb(:) = 1
 
37
  ub(:) = 7
 
38
 
 
39
  extent(:) = 1
 
40
  extent(:) = extent(:) + ub(:) - lb(:)
 
41
  asize(1) = extent(1)
 
42
  do m= 2,7
 
43
     asize(m) = asize(m-1)*extent(m)
 
44
  enddo
 
45
 
 
46
! Test I4 flavor.
 
47
  vlb(1) = 1
 
48
  vub(1) = asize(7)
 
49
  call ARMCI_Malloc_fa(v_i4,vlb,vub,rc)
 
50
  if (rc .ne. 0) then
 
51
     print *,' ARMCI_Malloc_fa for v_i4 failed rc = ',rc
 
52
     stop
 
53
  endif
 
54
 
 
55
  call ARMCI_Malloc_fa(a7_i4, lb, ub, rc)
 
56
  if (rc .ne. 0) then
 
57
     print *,' ARMCI_Malloc_fa for a7_i4 failed rc = ',rc
 
58
     stop
 
59
  endif
 
60
 
 
61
  call ARMCI_Malloc_fa(b7_i4, lb, ub, rc)
 
62
  if (rc .ne. 0) then
 
63
     print *,' ARMCI_Malloc_fa for b7_i4 failed rc = ',rc
 
64
     stop
 
65
  endif
 
66
 
 
67
  call ARMCI_Malloc_fa(a6_i4, lb, ub, rc)
 
68
  if (rc .ne. 0) then
 
69
     print *,' ARMCI_Malloc_fa for a6_i4 failed rc = ',rc
 
70
     stop
 
71
  endif
 
72
 
 
73
  call ARMCI_Malloc_fa(b6_i4, lb, ub, rc)
 
74
  if (rc .ne. 0) then
 
75
     print *,' ARMCI_Malloc_fa for b6_i4 failed rc = ',rc
 
76
     stop
 
77
  endif
 
78
 
 
79
  call ARMCI_Malloc_fa(a5_i4, lb, ub, rc)
 
80
  if (rc .ne. 0) then
 
81
     print *,' ARMCI_Malloc_fa for a5_i4 failed rc = ',rc
 
82
     stop
 
83
  endif
 
84
 
 
85
  call ARMCI_Malloc_fa(b5_i4, lb, ub, rc)
 
86
  if (rc .ne. 0) then
 
87
     print *,' ARMCI_Malloc_fa for b5_i4 failed rc = ',rc
 
88
     stop
 
89
  endif
 
90
 
 
91
  call ARMCI_Malloc_fa(a4_i4, lb, ub, rc)
 
92
  if (rc .ne. 0) then
 
93
     print *,' ARMCI_Malloc_fa for a4_i4 failed rc = ',rc
 
94
     stop
 
95
  endif
 
96
 
 
97
  call ARMCI_Malloc_fa(b4_i4, lb, ub, rc)
 
98
  if (rc .ne. 0) then
 
99
     print *,' ARMCI_Malloc_fa for b4_i4 failed rc = ',rc
 
100
     stop
 
101
  endif
 
102
 
 
103
  call ARMCI_Malloc_fa(a3_i4, lb, ub, rc)
 
104
  if (rc .ne. 0) then
 
105
     print *,' ARMCI_Malloc_fa for a3_i4 failed rc = ',rc
 
106
     stop
 
107
  endif
 
108
 
 
109
  call ARMCI_Malloc_fa(b3_i4, lb, ub, rc)
 
110
  if (rc .ne. 0) then
 
111
     print *,' ARMCI_Malloc_fa for b3_i4 failed rc = ',rc
 
112
     stop
 
113
  endif
 
114
 
 
115
  call ARMCI_Malloc_fa(a2_i4, lb, ub, rc)
 
116
  if (rc .ne. 0) then
 
117
     print *,' ARMCI_Malloc_fa for a2_i4 failed rc = ',rc
 
118
     stop
 
119
  endif
 
120
 
 
121
  call ARMCI_Malloc_fa(b2_i4, lb, ub, rc)
 
122
  if (rc .ne. 0) then
 
123
     print *,' ARMCI_Malloc_fa for b2_i4 failed rc = ',rc
 
124
     stop
 
125
  endif
 
126
 
 
127
  call ARMCI_Malloc_fa(a1_i4, lb, ub, rc)
 
128
  if (rc .ne. 0) then
 
129
     print *,' ARMCI_Malloc_fa for a1_i4 failed rc = ',rc
 
130
     stop
 
131
  endif
 
132
 
 
133
  call ARMCI_Malloc_fa(b1_i4, lb, ub, rc)
 
134
  if (rc .ne. 0) then
 
135
     print *,' ARMCI_Malloc_fa for b1_i4 failed rc = ',rc
 
136
     stop
 
137
  endif
 
138
 
 
139
! Let all processors get allocated.
 
140
 
 
141
  call ARMCI_Sync()
 
142
 
 
143
! I4 allocations done, now loop over slices.
 
144
! We will test three flavors of slices,
 
145
! all unit stride, unit stride in the first dimension only,
 
146
! all non-unit stride (2).
 
147
  score(:) = 0
 
148
  joff = remote_proc + 1
 
149
!
 
150
! Test Put.
 
151
!
 
152
  do m = 1,3
 
153
!    Initialize arrays.
 
154
!
 
155
     call init_7d(a7_i4,b7_i4,lb,ub,lb,ub,afirst,bfirst)
 
156
     a6_i4(:,:,:,:,:,:) = a7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
157
     a5_i4(:,:,:,:,:) = a7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
158
     a4_i4(:,:,:,:) = a7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
159
     a3_i4(:,:,:) = a7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
160
     a2_i4(:,:) = a7_i4(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
161
     a1_i4(:) = a7_i4(lb(1):ub(1),1,1,1,1,1,1)
 
162
     b6_i4(:,:,:,:,:,:) = b7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
163
     b5_i4(:,:,:,:,:) = b7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
164
     b4_i4(:,:,:,:) = b7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
165
     b3_i4(:,:,:) = b7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
166
     b2_i4(:,:) = b7_i4(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
167
     b1_i4(:) = b7_i4(lb(1):ub(1),1,1,1,1,1,1)
 
168
 
 
169
! Let all processors get initialized.
 
170
 
 
171
     call ARMCI_Sync()
 
172
 
 
173
! Set up slice info for the put.
 
174
!
 
175
! For m = 1, the slice has all unit strides.
 
176
! For m = 2, the first dimension has a unit stride and all other
 
177
!            dimensions have a stride of 2.
 
178
! For m = 3, all dimensions have a stride of 2.
 
179
!  
 
180
     src_slice%lo(:) = 2
 
181
     src_slice%hi(:) = 6
 
182
     src_slice%stride(:) = (m+2)/2
 
183
     src_slice%stride(1) = (m+1)/2
 
184
 
 
185
     dst_slice%lo(:) = 3
 
186
     dst_slice%hi(:) = 7
 
187
     dst_slice%stride(:) = (m+2)/2
 
188
     dst_slice%stride(1) = (m+1)/2
 
189
 
 
190
! Rank 1.     
 
191
     rank = 1
 
192
     call ARMCI_NbPut_fa(a1_i4, src_slice, b1_i4, dst_slice, remote_proc, rc)
 
193
     call ARMCI_Waitall_fa()
 
194
     call ARMCI_Sync()
 
195
     if (rc .ne. 0) then
 
196
        print *,me,': ARMCI_NbPut_fa for 1D I4, m = ',m,' failed, rc = ',rc
 
197
     endif
 
198
 
 
199
! Check that received b1 is the piece of the sent a1.
 
200
!
 
201
     call check_b(rank,b1_i4,dst_slice,src_slice,remote_proc, &
 
202
    &             lb,ub,lb,ub,joff,pass)
 
203
     score(1) = score(1) + pass
 
204
     if (pass .ne. 1) then
 
205
        print *,me,': ARMCI_NbPut_fa verify for 1D I4, m = ',m,' failed'
 
206
     endif
 
207
     call ARMCI_Sync()
 
208
 
 
209
! Rank 2.
 
210
 
 
211
     rank = 2
 
212
     vshape(1) = asize(2)
 
213
     call ARMCI_NbPut_fa(a2_i4, src_slice, b2_i4, dst_slice, remote_proc, rc)
 
214
     call ARMCI_Waitall_fa()
 
215
 
 
216
     call ARMCI_Sync()
 
217
     if (rc .ne. 0) then
 
218
        print *,me,': ARMCI_NbPut_fa for 2D I4, m = ',m,' failed, rc = ',rc
 
219
     endif
 
220
 
 
221
! Check that received b2 is the piece of the sent a2.
 
222
!
 
223
!     call check_b(rank,reshape(b2_i4,vshape),dst_slice,src_slice,remote_proc, &
 
224
!     call check_b(rank,b2_i4,dst_slice,src_slice,remote_proc, &
 
225
     v_i4(1:asize(2)) = reshape(b2_i4,vshape)
 
226
 
 
227
     call check_b(rank,v_i4,dst_slice,src_slice,remote_proc, &
 
228
    &             lb,ub,lb,ub,joff,pass)
 
229
     score(2) = score(2) + pass
 
230
     if (pass .ne. 1) then
 
231
        print *,me,': ARMCI_NbPut_fa verify for 2D I4, m = ',m,' failed'
 
232
     endif
 
233
     call ARMCI_Sync()
 
234
 
 
235
! Rank 3.
 
236
 
 
237
     rank = 3
 
238
     vshape(1) = asize(3)
 
239
     call ARMCI_NbPut_fa(a3_i4, src_slice, b3_i4, dst_slice, remote_proc, rc)
 
240
     call ARMCI_Waitall_fa()
 
241
     call ARMCI_Sync()
 
242
     if (rc .ne. 0) then
 
243
        print *,me,': ARMCI_NbPut_fa for 3D I4, m = ',m,' failed, rc = ',rc
 
244
     endif
 
245
 
 
246
! Check that received b3 is the piece of the sent a3.
 
247
!
 
248
     v_i4(1:asize(3)) = reshape(b3_i4,vshape)
 
249
     call check_b(rank,v_i4,dst_slice,src_slice,remote_proc, &
 
250
    &             lb,ub,lb,ub,joff,pass)
 
251
     score(3) = score(3) + pass
 
252
     if (pass .ne. 1) then
 
253
        print *,me,': ARMCI_NbPut_fa verify for 3D I4, m = ',m,' failed'
 
254
     endif
 
255
     call ARMCI_Sync()
 
256
 
 
257
! Rank 4.
 
258
 
 
259
     rank = 4
 
260
     vshape(1) = asize(4)
 
261
     call ARMCI_NbPut_fa(a4_i4, src_slice, b4_i4, dst_slice, remote_proc, rc)
 
262
     call ARMCI_Waitall_fa()
 
263
     call ARMCI_Sync()
 
264
     if (rc .ne. 0) then
 
265
        print *,me,': ARMCI_NbPut_fa for 4D I4, m = ',m,' failed, rc = ',rc
 
266
     endif
 
267
 
 
268
! Check that received b4 is the piece of the sent a4.
 
269
!
 
270
     v_i4(1:asize(4)) = reshape(b4_i4,vshape)
 
271
     call check_b(rank,v_i4,dst_slice,src_slice,remote_proc, &
 
272
    &             lb,ub,lb,ub,joff,pass)
 
273
     score(4) = score(4) + pass
 
274
     if (pass .ne. 1) then
 
275
        print *,me,': ARMCI_NbPut_fa verify for 4D I4, m = ',m,' failed'
 
276
     endif
 
277
     call ARMCI_Sync()
 
278
 
 
279
! Rank 5.
 
280
 
 
281
     rank = 5
 
282
     vshape(1) = asize(5)
 
283
     call ARMCI_NbPut_fa(a5_i4, src_slice, b5_i4, dst_slice, remote_proc, rc)
 
284
     call ARMCI_Waitall_fa()
 
285
     call ARMCI_Sync()
 
286
     if (rc .ne. 0) then
 
287
        print *,me,': ARMCI_NbPut_fa for 5D I4, m = ',m,' failed, rc = ',rc
 
288
     endif
 
289
 
 
290
! Check that received b5 is the piece of the sent a5.
 
291
!
 
292
     v_i4(1:asize(5)) = reshape(b5_i4,vshape)
 
293
     call check_b(rank,v_i4,dst_slice,src_slice,remote_proc, &
 
294
    &             lb,ub,lb,ub,joff,pass)
 
295
     score(5) = score(5) + pass
 
296
     if (pass .ne. 1) then
 
297
        print *,me,': ARMCI_NbPut_fa verify for 4D I4, m = ',m,' failed'
 
298
     endif
 
299
     call ARMCI_Sync()
 
300
 
 
301
! Rank 6.
 
302
 
 
303
     rank = 6
 
304
     vshape(1) = asize(6)
 
305
     call ARMCI_NbPut_fa(a6_i4, src_slice, b6_i4, dst_slice, remote_proc, rc)
 
306
     call ARMCI_Waitall_fa()
 
307
 
 
308
     call ARMCI_Sync()
 
309
     if (rc .ne. 0) then
 
310
        print *,me,': ARMCI_NbPut_fa for 6D I4, m = ',m,' failed, rc = ',rc
 
311
     endif
 
312
 
 
313
! Check that received b6 is the piece of the sent a6
 
314
!
 
315
     v_i4(1:asize(6)) = reshape(b6_i4,vshape)
 
316
     call check_b(rank,v_i4,dst_slice,src_slice,remote_proc, &
 
317
    &             lb,ub,lb,ub,joff,pass)
 
318
     score(6) = score(6) + pass
 
319
     if (pass .ne. 1) then
 
320
        print *,me,': ARMCI_NbPut_fa verify for 6D I4, m = ',m,' failed'
 
321
     endif
 
322
     call ARMCI_Sync()
 
323
 
 
324
! Rank 7.
 
325
 
 
326
     rank = 7
 
327
     vshape(1) = asize(7)
 
328
     call ARMCI_NbPut_fa(a7_i4, src_slice, b7_i4, dst_slice, remote_proc, rc)
 
329
     call ARMCI_Waitall_fa()
 
330
 
 
331
     call ARMCI_Sync()
 
332
     if (rc .ne. 0) then
 
333
        print *,me,': ARMCI_NbPut_fa for 7D I4, m = ',m,' failed, rc = ',rc
 
334
     endif
 
335
 
 
336
! Check that received b7 is the piece of the sent a7
 
337
!
 
338
     v_i4(1:asize(7)) = reshape(b7_i4,vshape)
 
339
     call check_b(rank,v_i4,dst_slice,src_slice,remote_proc, &
 
340
    &             lb,ub,lb,ub,joff,pass)
 
341
     score(7) = score(7) + pass
 
342
     if (pass .ne. 1) then
 
343
        print *,me,': ARMCI_NbPut_fa verify for 7D I4, m = ',m,' failed'
 
344
     endif
 
345
     call ARMCI_Sync()
 
346
 
 
347
  enddo
 
348
  if (me .eq. 0) then
 
349
     do m = 1,7
 
350
        if (score(m) .eq. 3) then
 
351
           print *,' ARMCI_NbPut_fa for I4, ',m,'D passed'
 
352
        endif
 
353
     enddo
 
354
  endif
 
355
!
 
356
! Test Get.
 
357
!
 
358
  score(:) = 0
 
359
  joff = (remote_proc + 1)*(remote_proc+1)
 
360
  do m = 1,3
 
361
!
 
362
!    Initialize arrays.
 
363
!
 
364
     call init_7d(a7_i4,b7_i4,lb,ub,lb,ub,afirst,bfirst)
 
365
     a6_i4 = a7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
366
     a5_i4 = a7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
367
     a4_i4 = a7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
368
     a3_i4 = a7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
369
     a2_i4 = a7_i4(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
370
     a1_i4 = a7_i4(lb(1):ub(1),1,1,1,1,1,1)
 
371
     b6_i4 = b7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
372
     b5_i4 = b7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
373
     b4_i4 = b7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
374
     b3_i4 = b7_i4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
375
     b2_i4 = b7_i4(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
376
     b1_i4 = b7_i4(lb(1):ub(1),1,1,1,1,1,1)
 
377
 
 
378
! Let all processors get initialized.
 
379
 
 
380
     call ARMCI_Sync()
 
381
 
 
382
! Set up slice info for the get.
 
383
!
 
384
! For m = 1, the slice has all unit strides.
 
385
! For m = 2, the first dimension has a unit stride and all other
 
386
!            dimensions have a stride of 2.
 
387
! For m = 3, all dimensions have a stride of 2.
 
388
!  
 
389
     src_slice%lo(:) = 2
 
390
     src_slice%hi(:) = 6
 
391
     src_slice%stride(:) = (m+2)/2
 
392
     src_slice%stride(1) = (m+1)/2
 
393
 
 
394
     dst_slice%lo(:) = 3
 
395
     dst_slice%hi(:) = 7
 
396
     dst_slice%stride(:) = (m+2)/2
 
397
     dst_slice%stride(1) = (m+1)/2
 
398
!
 
399
! Rank 1
 
400
!
 
401
     rank = 1
 
402
     call ARMCI_NbGet_fa(b1_i4, dst_slice, a1_i4, src_slice, remote_proc, rc)
 
403
     call ARMCI_Waitall_fa()
 
404
 
 
405
     call ARMCI_Sync()
 
406
!
 
407
! Check that recieved a is the piece of b that was sent.
 
408
 
 
409
     call check_b(rank,a1_i4,src_slice,dst_slice,remote_proc, &
 
410
    &             lb,ub,lb,ub,joff,pass)
 
411
     score(1) = score(1) + pass
 
412
     if (pass .ne. 1) then
 
413
        print *,me,': ARMCI_NbGet_fa verify for 1D I4, m = ',m,' failed'
 
414
     endif
 
415
     call ARMCI_Sync()
 
416
     
 
417
!
 
418
! Rank 2
 
419
!
 
420
     rank = 2
 
421
     vshape(1) = asize(2)
 
422
     call ARMCI_NbGet_fa(b2_i4, dst_slice, a2_i4, src_slice, remote_proc, rc)
 
423
     call ARMCI_Waitall_fa()
 
424
 
 
425
     call ARMCI_Sync()
 
426
!
 
427
! Check that recieved a is the piece of b that was sent.
 
428
 
 
429
     v_i4(1:asize(2)) = reshape(a2_i4,vshape)
 
430
     call check_b(rank,v_i4,src_slice,dst_slice,remote_proc, &
 
431
    &             lb,ub,lb,ub,joff,pass)
 
432
     score(2) = score(2) + pass
 
433
     if (pass .ne. 1) then
 
434
        print *,me,': ARMCI_NbGet_fa verify for 2D I4, m = ',m,' failed'
 
435
     endif
 
436
     call ARMCI_Sync()
 
437
     
 
438
!
 
439
! Rank 3
 
440
!
 
441
     rank = 3
 
442
     vshape(1) = asize(3)
 
443
     call ARMCI_NbGet_fa(b3_i4, dst_slice, a3_i4, src_slice, remote_proc, rc)
 
444
     call ARMCI_Waitall_fa()
 
445
 
 
446
     call ARMCI_Sync()
 
447
!
 
448
! Check that recieved a is the piece of b that was sent.
 
449
 
 
450
     v_i4(1:asize(3)) = reshape(a3_i4,vshape)
 
451
     call check_b(rank,v_i4,src_slice,dst_slice,remote_proc, &
 
452
    &             lb,ub,lb,ub,joff,pass)
 
453
     score(3) = score(3) + pass
 
454
     if (pass .ne. 1) then
 
455
        print *,me,': ARMCI_NbGet_fa verify for 3D I4, m = ',m,' failed'
 
456
     endif
 
457
     call ARMCI_Sync()
 
458
     
 
459
!
 
460
! Rank 4
 
461
!
 
462
     rank = 4
 
463
     vshape(1) = asize(4)
 
464
     call ARMCI_NbGet_fa(b4_i4, dst_slice, a4_i4, src_slice, remote_proc, rc)
 
465
     call ARMCI_Waitall_fa()
 
466
 
 
467
     call ARMCI_Sync()
 
468
!
 
469
! Check that recieved a is the piece of b that was sent.
 
470
 
 
471
     v_i4(1:asize(4)) = reshape(a4_i4,vshape)
 
472
     call check_b(rank,v_i4,src_slice,dst_slice,remote_proc, &
 
473
    &             lb,ub,lb,ub,joff,pass)
 
474
     score(4) = score(4) + pass
 
475
     if (pass .ne. 1) then
 
476
        print *,me,': ARMCI_NbGet_fa verify for 4D I4, m = ',m,' failed'
 
477
     endif
 
478
     call ARMCI_Sync()
 
479
     
 
480
!
 
481
! Rank 5
 
482
!
 
483
     rank = 5
 
484
     vshape(1) = asize(5)
 
485
     call ARMCI_NbGet_fa(b5_i4, dst_slice, a5_i4, src_slice, remote_proc, rc)
 
486
     call ARMCI_Waitall_fa()
 
487
 
 
488
     call ARMCI_Sync()
 
489
!
 
490
! Check that recieved a is the piece of b that was sent.
 
491
 
 
492
     v_i4(1:asize(5)) = reshape(a5_i4,vshape)
 
493
     call check_b(rank,v_i4,src_slice,dst_slice,remote_proc, &
 
494
    &             lb,ub,lb,ub,joff,pass)
 
495
     score(5) = score(5) + pass
 
496
     if (pass .ne. 1) then
 
497
        print *,me,': ARMCI_NbGet_fa verify for 5D I4, m = ',m,' failed'
 
498
     endif
 
499
     call ARMCI_Sync()
 
500
     
 
501
!
 
502
! Rank 6
 
503
!
 
504
     rank = 6
 
505
     vshape(1) = asize(6)
 
506
     call ARMCI_NbGet_fa(b6_i4, dst_slice, a6_i4, src_slice, remote_proc, rc)
 
507
     call ARMCI_Waitall_fa()
 
508
 
 
509
     call ARMCI_Sync()
 
510
!
 
511
! Check that recieved a is the piece of b that was sent.
 
512
 
 
513
     v_i4(1:asize(6)) = reshape(a6_i4,vshape)
 
514
     call check_b(rank,v_i4,src_slice,dst_slice,remote_proc, &
 
515
    &             lb,ub,lb,ub,joff,pass)
 
516
     score(6) = score(6) + pass
 
517
     if (pass .ne. 1) then
 
518
        print *,me,': ARMCI_NbGet_fa verify for 6D I4, m = ',m,' failed'
 
519
     endif
 
520
     call ARMCI_Sync()
 
521
     
 
522
!
 
523
! Rank 7
 
524
!
 
525
     rank = 7
 
526
     vshape(1) = asize(7)
 
527
     call ARMCI_NbGet_fa(b7_i4, dst_slice, a7_i4, src_slice, remote_proc, rc)
 
528
     call ARMCI_Waitall_fa()
 
529
 
 
530
     call ARMCI_Sync()
 
531
!
 
532
! Check that recieved a is the piece of b that was sent.
 
533
 
 
534
     v_i4(1:asize(7)) = reshape(a7_i4,vshape)
 
535
     call check_b(rank,v_i4,src_slice,dst_slice,remote_proc, &
 
536
    &             lb,ub,lb,ub,joff,pass)
 
537
     score(7) = score(7) + pass
 
538
     if (pass .ne. 1) then
 
539
        print *,me,': ARMCI_NbGet_fa verify for 7D I4, m = ',m,' failed'
 
540
     endif
 
541
     call ARMCI_Sync()
 
542
 
 
543
  enddo
 
544
  if (me .eq. 0) then
 
545
     do m = 1,7
 
546
        if (score(m) .eq. 3) then
 
547
           print *,' ARMCI_NbGet_fa for I4, ',m,'D passed'
 
548
        endif
 
549
     enddo
 
550
  endif
 
551
!
 
552
! Free v, a and b arrays.
 
553
!
 
554
  call ARMCI_Sync()
 
555
  call ARMCI_Free_fa(v_i4, rc)
 
556
  call ARMCI_Free_fa(a1_i4, rc)
 
557
  call ARMCI_Free_fa(b1_i4, rc)
 
558
  call ARMCI_Free_fa(a2_i4, rc)
 
559
  call ARMCI_Free_fa(b2_i4, rc)
 
560
  call ARMCI_Free_fa(a3_i4, rc)
 
561
  call ARMCI_Free_fa(b3_i4, rc)
 
562
  call ARMCI_Free_fa(a4_i4, rc)
 
563
  call ARMCI_Free_fa(b4_i4, rc)
 
564
  call ARMCI_Free_fa(a5_i4, rc)
 
565
  call ARMCI_Free_fa(b5_i4, rc)
 
566
  call ARMCI_Free_fa(a6_i4, rc)
 
567
  call ARMCI_Free_fa(b6_i4, rc)
 
568
  call ARMCI_Free_fa(a7_i4, rc)
 
569
  call ARMCI_Free_fa(b7_i4, rc)
 
570
  call ARMCI_Sync()
 
571
  return
 
572
endsubroutine
 
573
 
 
574
subroutine testanb_i8(nproc,me,remote_proc)
 
575
  use definekind
 
576
  use armci_types
 
577
  use armci_mem_f90
 
578
  use armci_nbmov
 
579
  use testa_init
 
580
  use checkput
 
581
  implicit none
 
582
  type(ARMCI_slice) :: src_slice, dst_slice
 
583
  integer :: nproc,me,remote_proc
 
584
  integer(kind=I8), pointer :: a7_i8(:,:,:,:,:,:,:), b7_i8(:,:,:,:,:,:,:)
 
585
  integer(kind=I8), pointer :: a6_i8(:,:,:,:,:,:),   b6_i8(:,:,:,:,:,:)
 
586
  integer(kind=I8), pointer :: a5_i8(:,:,:,:,:),     b5_i8(:,:,:,:,:)
 
587
  integer(kind=I8), pointer :: a4_i8(:,:,:,:),       b4_i8(:,:,:,:)
 
588
  integer(kind=I8), pointer :: a3_i8(:,:,:),         b3_i8(:,:,:)
 
589
  integer(kind=I8), pointer :: a2_i8(:,:),           b2_i8(:,:)
 
590
  integer(kind=I8), pointer :: a1_i8(:),             b1_i8(:)
 
591
  integer(kind=I8), pointer :: v_i8(:)
 
592
 
 
593
  integer :: lb(7), ub(7), rc, i, j
 
594
  integer :: pass
 
595
  integer :: myunit
 
596
  integer :: m
 
597
  integer :: rank
 
598
  integer :: joff
 
599
  integer :: vshape(1)
 
600
  integer :: extent(7)
 
601
  integer :: asize(7)
 
602
  integer :: score(7)
 
603
  integer :: vlb(1),vub(1)
 
604
  integer :: afirst,bfirst
 
605
  
 
606
  lb(:) = 1
 
607
  ub(:) = 7
 
608
 
 
609
  extent(:) = 1
 
610
  extent(:) = extent(:) + ub(:) - lb(:)
 
611
  asize(1) = extent(1)
 
612
  do m= 2,7
 
613
     asize(m) = asize(m-1)*extent(m)
 
614
  enddo
 
615
  afirst = (1+me)
 
616
  bfirst = afirst * afirst 
 
617
 
 
618
! Test I8 flavor.
 
619
  vlb(1) = 1
 
620
  vub(1) = asize(7)
 
621
  call ARMCI_Malloc_fa(v_i8,vlb,vub,rc)
 
622
  if (rc .ne. 0) then
 
623
     print *,' ARMCI_Malloc_fa for v_i8 failed rc = ',rc
 
624
     stop
 
625
  endif
 
626
 
 
627
  call ARMCI_Malloc_fa(a7_i8, lb, ub, rc)
 
628
  if (rc .ne. 0) then
 
629
     print *,' ARMCI_Malloc_fa for a7_i8 failed rc = ',rc
 
630
     stop
 
631
  endif
 
632
 
 
633
  call ARMCI_Malloc_fa(b7_i8, lb, ub, rc)
 
634
  if (rc .ne. 0) then
 
635
     print *,' ARMCI_Malloc_fa for b7_i8 failed rc = ',rc
 
636
     stop
 
637
  endif
 
638
 
 
639
  call ARMCI_Malloc_fa(a6_i8, lb, ub, rc)
 
640
  if (rc .ne. 0) then
 
641
     print *,' ARMCI_Malloc_fa for a6_i8 failed rc = ',rc
 
642
     stop
 
643
  endif
 
644
 
 
645
  call ARMCI_Malloc_fa(b6_i8, lb, ub, rc)
 
646
  if (rc .ne. 0) then
 
647
     print *,' ARMCI_Malloc_fa for b6_i8 failed rc = ',rc
 
648
     stop
 
649
  endif
 
650
 
 
651
  call ARMCI_Malloc_fa(a5_i8, lb, ub, rc)
 
652
  if (rc .ne. 0) then
 
653
     print *,' ARMCI_Malloc_fa for a5_i8 failed rc = ',rc
 
654
     stop
 
655
  endif
 
656
 
 
657
  call ARMCI_Malloc_fa(b5_i8, lb, ub, rc)
 
658
  if (rc .ne. 0) then
 
659
     print *,' ARMCI_Malloc_fa for b5_i8 failed rc = ',rc
 
660
     stop
 
661
  endif
 
662
 
 
663
  call ARMCI_Malloc_fa(a4_i8, lb, ub, rc)
 
664
  if (rc .ne. 0) then
 
665
     print *,' ARMCI_Malloc_fa for a4_i8 failed rc = ',rc
 
666
     stop
 
667
  endif
 
668
 
 
669
  call ARMCI_Malloc_fa(b4_i8, lb, ub, rc)
 
670
  if (rc .ne. 0) then
 
671
     print *,' ARMCI_Malloc_fa for b4_i8 failed rc = ',rc
 
672
     stop
 
673
  endif
 
674
 
 
675
  call ARMCI_Malloc_fa(a3_i8, lb, ub, rc)
 
676
  if (rc .ne. 0) then
 
677
     print *,' ARMCI_Malloc_fa for a3_i8 failed rc = ',rc
 
678
     stop
 
679
  endif
 
680
 
 
681
  call ARMCI_Malloc_fa(b3_i8, lb, ub, rc)
 
682
  if (rc .ne. 0) then
 
683
     print *,' ARMCI_Malloc_fa for b3_i8 failed rc = ',rc
 
684
     stop
 
685
  endif
 
686
 
 
687
  call ARMCI_Malloc_fa(a2_i8, lb, ub, rc)
 
688
  if (rc .ne. 0) then
 
689
     print *,' ARMCI_Malloc_fa for a2_i8 failed rc = ',rc
 
690
     stop
 
691
  endif
 
692
 
 
693
  call ARMCI_Malloc_fa(b2_i8, lb, ub, rc)
 
694
  if (rc .ne. 0) then
 
695
     print *,' ARMCI_Malloc_fa for b2_i8 failed rc = ',rc
 
696
     stop
 
697
  endif
 
698
 
 
699
  call ARMCI_Malloc_fa(a1_i8, lb, ub, rc)
 
700
  if (rc .ne. 0) then
 
701
     print *,' ARMCI_Malloc_fa for a1_i8 failed rc = ',rc
 
702
     stop
 
703
  endif
 
704
 
 
705
  call ARMCI_Malloc_fa(b1_i8, lb, ub, rc)
 
706
  if (rc .ne. 0) then
 
707
     print *,' ARMCI_Malloc_fa for b1_i8 failed rc = ',rc
 
708
     stop
 
709
  endif
 
710
 
 
711
! Let all processors get alloccated.
 
712
 
 
713
  call ARMCI_Sync()
 
714
 
 
715
! I8 allocations done, now loop over slices.
 
716
! We will test three flavors of slices,
 
717
! all unit stride, unit stride in the first dimension only,
 
718
! all non-unit stride (2).
 
719
  score(:) = 0
 
720
  joff = remote_proc + 1
 
721
!
 
722
! Test Put.
 
723
!
 
724
  do m = 1,3
 
725
!    Initialize arrays.
 
726
!
 
727
     call init_7d(a7_i8,b7_i8,lb,ub,lb,ub,afirst,bfirst)
 
728
     a6_i8(:,:,:,:,:,:) = a7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
729
     a5_i8(:,:,:,:,:) = a7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
730
     a4_i8(:,:,:,:) = a7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
731
     a3_i8(:,:,:) = a7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
732
     a2_i8(:,:) = a7_i8(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
733
     a1_i8(:) = a7_i8(lb(1):ub(1),1,1,1,1,1,1)
 
734
     b6_i8(:,:,:,:,:,:) = b7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
735
     b5_i8(:,:,:,:,:) = b7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
736
     b4_i8(:,:,:,:) = b7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
737
     b3_i8(:,:,:) = b7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
738
     b2_i8(:,:) = b7_i8(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
739
     b1_i8(:) = b7_i8(lb(1):ub(1),1,1,1,1,1,1)
 
740
 
 
741
! Let all processors get initialized.
 
742
 
 
743
     call ARMCI_Sync()
 
744
 
 
745
! Set up slice info for the put.
 
746
!
 
747
! For m = 1, the slice has all unit strides.
 
748
! For m = 2, the first dimension has a unit stride and all other
 
749
!            dimensions have a stride of 2.
 
750
! For m = 3, all dimensions have a stride of 2.
 
751
!  
 
752
     src_slice%lo(:) = 2
 
753
     src_slice%hi(:) = 6
 
754
     src_slice%stride(:) = (m+2)/2
 
755
     src_slice%stride(1) = (m+1)/2
 
756
 
 
757
     dst_slice%lo(:) = 3
 
758
     dst_slice%hi(:) = 7
 
759
     dst_slice%stride(:) = (m+2)/2
 
760
     dst_slice%stride(1) = (m+1)/2
 
761
 
 
762
! Rank 1.     
 
763
     rank = 1
 
764
     call ARMCI_NbPut_fa(a1_i8, src_slice, b1_i8, dst_slice, remote_proc, rc)
 
765
     call ARMCI_Waitall_fa()
 
766
 
 
767
     call ARMCI_Sync()
 
768
     if (rc .ne. 0) then
 
769
        print *,me,': ARMCI_NbPut_fa for 1D I8, m = ',m,' failed, rc = ',rc
 
770
     endif
 
771
 
 
772
! Check that received b1 is the piece of the sent a1.
 
773
!
 
774
     call check_b(rank,b1_i8,dst_slice,src_slice,remote_proc, &
 
775
    &             lb,ub,lb,ub,joff,pass)
 
776
     score(1) = score(1) + pass
 
777
     if (pass .ne. 1) then
 
778
        print *,me,': ARMCI_NbPut_fa verify for 1D I8, m = ',m,' failed'
 
779
     endif
 
780
     call ARMCI_Sync()
 
781
 
 
782
! Rank 2.
 
783
 
 
784
     rank = 2
 
785
     vshape(1) = asize(2)
 
786
     call ARMCI_NbPut_fa(a2_i8, src_slice, b2_i8, dst_slice, remote_proc, rc)
 
787
     call ARMCI_Waitall_fa()
 
788
 
 
789
     call ARMCI_Sync()
 
790
     if (rc .ne. 0) then
 
791
        print *,me,': ARMCI_NbPut_fa for 2D I8, m = ',m,' failed, rc = ',rc
 
792
     endif
 
793
 
 
794
! Check that received b2 is the piece of the sent a2.
 
795
!
 
796
!     call check_b(rank,reshape(b2_i8,vshape),dst_slice,src_slice,remote_proc, &
 
797
!     call check_b(rank,b2_i8,dst_slice,src_slice,remote_proc, &
 
798
     v_i8(1:asize(2)) = reshape(b2_i8,vshape)
 
799
 
 
800
     call check_b(rank,v_i8,dst_slice,src_slice,remote_proc, &
 
801
    &             lb,ub,lb,ub,joff,pass)
 
802
     score(2) = score(2) + pass
 
803
     if (pass .ne. 1) then
 
804
        print *,me,': ARMCI_NbPut_fa verify for 2D I8, m = ',m,' failed'
 
805
     endif
 
806
     call ARMCI_Sync()
 
807
 
 
808
! Rank 3.
 
809
 
 
810
     rank = 3
 
811
     vshape(1) = asize(3)
 
812
     call ARMCI_NbPut_fa(a3_i8, src_slice, b3_i8, dst_slice, remote_proc, rc)
 
813
     call ARMCI_Waitall_fa()
 
814
 
 
815
     call ARMCI_Sync()
 
816
     if (rc .ne. 0) then
 
817
        print *,me,': ARMCI_NbPut_fa for 3D I8, m = ',m,' failed, rc = ',rc
 
818
     endif
 
819
 
 
820
! Check that received b3 is the piece of the sent a3.
 
821
!
 
822
     v_i8(1:asize(3)) = reshape(b3_i8,vshape)
 
823
     call check_b(rank,v_i8,dst_slice,src_slice,remote_proc, &
 
824
    &             lb,ub,lb,ub,joff,pass)
 
825
     score(3) = score(3) + pass
 
826
     if (pass .ne. 1) then
 
827
        print *,me,': ARMCI_NbPut_fa verify for 3D I8, m = ',m,' failed'
 
828
     endif
 
829
     call ARMCI_Sync()
 
830
 
 
831
! Rank 4.
 
832
 
 
833
     rank = 4
 
834
     vshape(1) = asize(4)
 
835
     call ARMCI_NbPut_fa(a4_i8, src_slice, b4_i8, dst_slice, remote_proc, rc)
 
836
     call ARMCI_Waitall_fa()
 
837
 
 
838
     call ARMCI_Sync()
 
839
     if (rc .ne. 0) then
 
840
        print *,me,': ARMCI_NbPut_fa for 4D I8, m = ',m,' failed, rc = ',rc
 
841
     endif
 
842
 
 
843
! Check that received b4 is the piece of the sent a4.
 
844
!
 
845
     v_i8(1:asize(4)) = reshape(b4_i8,vshape)
 
846
     call check_b(rank,v_i8,dst_slice,src_slice,remote_proc, &
 
847
    &             lb,ub,lb,ub,joff,pass)
 
848
     score(4) = score(4) + pass
 
849
     if (pass .ne. 1) then
 
850
        print *,me,': ARMCI_NbPut_fa verify for 4D I8, m = ',m,' failed'
 
851
     endif
 
852
     call ARMCI_Sync()
 
853
 
 
854
! Rank 5.
 
855
 
 
856
     rank = 5
 
857
     vshape(1) = asize(5)
 
858
     call ARMCI_NbPut_fa(a5_i8, src_slice, b5_i8, dst_slice, remote_proc, rc)
 
859
     call ARMCI_Waitall_fa()
 
860
 
 
861
     call ARMCI_Sync()
 
862
     if (rc .ne. 0) then
 
863
        print *,me,': ARMCI_NbPut_fa for 5D I8, m = ',m,' failed, rc = ',rc
 
864
     endif
 
865
 
 
866
! Check that received b5 is the piece of the sent a5.
 
867
!
 
868
     v_i8(1:asize(5)) = reshape(b5_i8,vshape)
 
869
     call check_b(rank,v_i8,dst_slice,src_slice,remote_proc, &
 
870
    &             lb,ub,lb,ub,joff,pass)
 
871
     score(5) = score(5) + pass
 
872
     if (pass .ne. 1) then
 
873
        print *,me,': ARMCI_NbPut_fa verify for 4D I8, m = ',m,' failed'
 
874
     endif
 
875
     call ARMCI_Sync()
 
876
 
 
877
! Rank 6.
 
878
 
 
879
     rank = 6
 
880
     vshape(1) = asize(6)
 
881
     call ARMCI_NbPut_fa(a6_i8, src_slice, b6_i8, dst_slice, remote_proc, rc)
 
882
     call ARMCI_Waitall_fa()
 
883
 
 
884
     call ARMCI_Sync()
 
885
     if (rc .ne. 0) then
 
886
        print *,me,': ARMCI_NbPut_fa for 6D I8, m = ',m,' failed, rc = ',rc
 
887
     endif
 
888
 
 
889
! Check that received b6 is the piece of the sent a6
 
890
!
 
891
     v_i8(1:asize(6)) = reshape(b6_i8,vshape)
 
892
     call check_b(rank,v_i8,dst_slice,src_slice,remote_proc, &
 
893
    &             lb,ub,lb,ub,joff,pass)
 
894
     score(6) = score(6) + pass
 
895
     if (pass .ne. 1) then
 
896
        print *,me,': ARMCI_NbPut_fa verify for 6D I8, m = ',m,' failed'
 
897
     endif
 
898
     call ARMCI_Sync()
 
899
 
 
900
! Rank 7.
 
901
 
 
902
     rank = 7
 
903
     vshape(1) = asize(7)
 
904
     call ARMCI_NbPut_fa(a7_i8, src_slice, b7_i8, dst_slice, remote_proc, rc)
 
905
     call ARMCI_Waitall_fa()
 
906
 
 
907
     call ARMCI_Sync()
 
908
     if (rc .ne. 0) then
 
909
        print *,me,': ARMCI_NbPut_fa for 7D I8, m = ',m,' failed, rc = ',rc
 
910
     endif
 
911
 
 
912
! Check that received b7 is the piece of the sent a7
 
913
!
 
914
     v_i8(1:asize(7)) = reshape(b7_i8,vshape)
 
915
     call check_b(rank,v_i8,dst_slice,src_slice,remote_proc, &
 
916
    &             lb,ub,lb,ub,joff,pass)
 
917
     score(7) = score(7) + pass
 
918
     if (pass .ne. 1) then
 
919
        print *,me,': ARMCI_NbPut_fa verify for 7D I8, m = ',m,' failed'
 
920
     endif
 
921
     call ARMCI_Sync()
 
922
 
 
923
  enddo
 
924
  if (me .eq. 0) then
 
925
     do m = 1,7
 
926
        if (score(m) .eq. 3) then
 
927
           print *,' ARMCI_NbPut_fa for I8, ',m,'D passed'
 
928
        endif
 
929
     enddo
 
930
  endif
 
931
!
 
932
! Test Get.
 
933
!
 
934
  score(:) = 0
 
935
  joff = (remote_proc + 1)*(remote_proc+1)
 
936
  do m = 1,3
 
937
!
 
938
!    Initialize arrays.
 
939
!
 
940
     call init_7d(a7_i8,b7_i8,lb,ub,lb,ub,afirst,bfirst)
 
941
     a6_i8 = a7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
942
     a5_i8 = a7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
943
     a4_i8 = a7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
944
     a3_i8 = a7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
945
     a2_i8 = a7_i8(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
946
     a1_i8 = a7_i8(lb(1):ub(1),1,1,1,1,1,1)
 
947
     b6_i8 = b7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
948
     b5_i8 = b7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
949
     b4_i8 = b7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
950
     b3_i8 = b7_i8(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
951
     b2_i8 = b7_i8(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
952
     b1_i8 = b7_i8(lb(1):ub(1),1,1,1,1,1,1)
 
953
 
 
954
! Let all processors get initialized.
 
955
 
 
956
     call ARMCI_Sync()
 
957
 
 
958
! Set up slice info for the get.
 
959
!
 
960
! For m = 1, the slice has all unit strides.
 
961
! For m = 2, the first dimension has a unit stride and all other
 
962
!            dimensions have a stride of 2.
 
963
! For m = 3, all dimensions have a stride of 2.
 
964
!  
 
965
     src_slice%lo(:) = 2
 
966
     src_slice%hi(:) = 6
 
967
     src_slice%stride(:) = (m+2)/2
 
968
     src_slice%stride(1) = (m+1)/2
 
969
 
 
970
     dst_slice%lo(:) = 3
 
971
     dst_slice%hi(:) = 7
 
972
     dst_slice%stride(:) = (m+2)/2
 
973
     dst_slice%stride(1) = (m+1)/2
 
974
!
 
975
! Rank 1
 
976
!
 
977
     rank = 1
 
978
     call ARMCI_NbGet_fa(b1_i8, dst_slice, a1_i8, src_slice, remote_proc, rc)
 
979
     call ARMCI_Waitall_fa()
 
980
 
 
981
     call ARMCI_Sync()
 
982
!
 
983
! Check that recieved a is the piece of b that was sent.
 
984
 
 
985
     call check_b(rank,a1_i8,src_slice,dst_slice,remote_proc, &
 
986
    &             lb,ub,lb,ub,joff,pass)
 
987
     score(1) = score(1) + pass
 
988
     if (pass .ne. 1) then
 
989
        print *,me,': ARMCI_NbGet_fa verify for 1D I8, m = ',m,' failed'
 
990
     endif
 
991
     call ARMCI_Sync()
 
992
     
 
993
!
 
994
! Rank 2
 
995
!
 
996
     rank = 2
 
997
     vshape(1) = asize(2)
 
998
     call ARMCI_NbGet_fa(b2_i8, dst_slice, a2_i8, src_slice, remote_proc, rc)
 
999
     call ARMCI_Waitall_fa()
 
1000
 
 
1001
     call ARMCI_Sync()
 
1002
!
 
1003
! Check that recieved a is the piece of b that was sent.
 
1004
 
 
1005
     v_i8(1:asize(2)) = reshape(a2_i8,vshape)
 
1006
     call check_b(rank,v_i8,src_slice,dst_slice,remote_proc, &
 
1007
    &             lb,ub,lb,ub,joff,pass)
 
1008
     score(2) = score(2) + pass
 
1009
     if (pass .ne. 1) then
 
1010
        print *,me,': ARMCI_NbGet_fa verify for 2D I8, m = ',m,' failed'
 
1011
     endif
 
1012
     call ARMCI_Sync()
 
1013
     
 
1014
!
 
1015
! Rank 3
 
1016
!
 
1017
     rank = 3
 
1018
     vshape(1) = asize(3)
 
1019
     call ARMCI_NbGet_fa(b3_i8, dst_slice, a3_i8, src_slice, remote_proc, rc)
 
1020
     call ARMCI_Waitall_fa()
 
1021
 
 
1022
     call ARMCI_Sync()
 
1023
!
 
1024
! Check that recieved a is the piece of b that was sent.
 
1025
 
 
1026
     v_i8(1:asize(3)) = reshape(a3_i8,vshape)
 
1027
     call check_b(rank,v_i8,src_slice,dst_slice,remote_proc, &
 
1028
    &             lb,ub,lb,ub,joff,pass)
 
1029
     score(3) = score(3) + pass
 
1030
     if (pass .ne. 1) then
 
1031
        print *,me,': ARMCI_NbGet_fa verify for 3D I8, m = ',m,' failed'
 
1032
     endif
 
1033
     call ARMCI_Sync()
 
1034
     
 
1035
!
 
1036
! Rank 4
 
1037
!
 
1038
     rank = 4
 
1039
     vshape(1) = asize(4)
 
1040
     call ARMCI_NbGet_fa(b4_i8, dst_slice, a4_i8, src_slice, remote_proc, rc)
 
1041
     call ARMCI_Waitall_fa()
 
1042
 
 
1043
     call ARMCI_Sync()
 
1044
!
 
1045
! Check that recieved a is the piece of b that was sent.
 
1046
 
 
1047
     v_i8(1:asize(4)) = reshape(a4_i8,vshape)
 
1048
     call check_b(rank,v_i8,src_slice,dst_slice,remote_proc, &
 
1049
    &             lb,ub,lb,ub,joff,pass)
 
1050
     score(4) = score(4) + pass
 
1051
     if (pass .ne. 1) then
 
1052
        print *,me,': ARMCI_NbGet_fa verify for 4D I8, m = ',m,' failed'
 
1053
     endif
 
1054
     call ARMCI_Sync()
 
1055
     
 
1056
!
 
1057
! Rank 5
 
1058
!
 
1059
     rank = 5
 
1060
     vshape(1) = asize(5)
 
1061
     call ARMCI_NbGet_fa(b5_i8, dst_slice, a5_i8, src_slice, remote_proc, rc)
 
1062
     call ARMCI_Waitall_fa()
 
1063
 
 
1064
     call ARMCI_Sync()
 
1065
!
 
1066
! Check that recieved a is the piece of b that was sent.
 
1067
 
 
1068
     v_i8(1:asize(5)) = reshape(a5_i8,vshape)
 
1069
     call check_b(rank,v_i8,src_slice,dst_slice,remote_proc, &
 
1070
    &             lb,ub,lb,ub,joff,pass)
 
1071
     score(5) = score(5) + pass
 
1072
     if (pass .ne. 1) then
 
1073
        print *,me,': ARMCI_NbGet_fa verify for 5D I8, m = ',m,' failed'
 
1074
     endif
 
1075
     call ARMCI_Sync()
 
1076
     
 
1077
!
 
1078
! Rank 6
 
1079
!
 
1080
     rank = 6
 
1081
     vshape(1) = asize(6)
 
1082
     call ARMCI_NbGet_fa(b6_i8, dst_slice, a6_i8, src_slice, remote_proc, rc)
 
1083
     call ARMCI_Waitall_fa()
 
1084
 
 
1085
     call ARMCI_Sync()
 
1086
!
 
1087
! Check that recieved a is the piece of b that was sent.
 
1088
 
 
1089
     v_i8(1:asize(6)) = reshape(a6_i8,vshape)
 
1090
     call check_b(rank,v_i8,src_slice,dst_slice,remote_proc, &
 
1091
    &             lb,ub,lb,ub,joff,pass)
 
1092
     score(6) = score(6) + pass
 
1093
     if (pass .ne. 1) then
 
1094
        print *,me,': ARMCI_NbGet_fa verify for 6D I8, m = ',m,' failed'
 
1095
     endif
 
1096
     call ARMCI_Sync()
 
1097
     
 
1098
!
 
1099
! Rank 7
 
1100
!
 
1101
     rank = 7
 
1102
     vshape(1) = asize(7)
 
1103
     call ARMCI_NbGet_fa(b7_i8, dst_slice, a7_i8, src_slice, remote_proc, rc)
 
1104
     call ARMCI_Waitall_fa()
 
1105
 
 
1106
     call ARMCI_Sync()
 
1107
!
 
1108
! Check that recieved a is the piece of b that was sent.
 
1109
 
 
1110
     v_i8(1:asize(7)) = reshape(a7_i8,vshape)
 
1111
     call check_b(rank,v_i8,src_slice,dst_slice,remote_proc, &
 
1112
    &             lb,ub,lb,ub,joff,pass)
 
1113
     score(7) = score(7) + pass
 
1114
     if (pass .ne. 1) then
 
1115
        print *,me,': ARMCI_NbGet_fa verify for 7D I8, m = ',m,' failed'
 
1116
     endif
 
1117
     call ARMCI_Sync()
 
1118
 
 
1119
  enddo
 
1120
  if (me .eq. 0) then
 
1121
     do m = 1,7
 
1122
        if (score(m) .eq. 3) then
 
1123
           print *,' ARMCI_NbGet_fa for I8, ',m,'D passed'
 
1124
        endif
 
1125
     enddo
 
1126
  endif
 
1127
!
 
1128
! Free v, a and b arrays.
 
1129
!
 
1130
  call ARMCI_Sync()
 
1131
  call ARMCI_Free_fa(v_i8, rc)
 
1132
  call ARMCI_Free_fa(a1_i8, rc)
 
1133
  call ARMCI_Free_fa(b1_i8, rc)
 
1134
  call ARMCI_Free_fa(a2_i8, rc)
 
1135
  call ARMCI_Free_fa(b2_i8, rc)
 
1136
  call ARMCI_Free_fa(a3_i8, rc)
 
1137
  call ARMCI_Free_fa(b3_i8, rc)
 
1138
  call ARMCI_Free_fa(a4_i8, rc)
 
1139
  call ARMCI_Free_fa(b4_i8, rc)
 
1140
  call ARMCI_Free_fa(a5_i8, rc)
 
1141
  call ARMCI_Free_fa(b5_i8, rc)
 
1142
  call ARMCI_Free_fa(a6_i8, rc)
 
1143
  call ARMCI_Free_fa(b6_i8, rc)
 
1144
  call ARMCI_Free_fa(a7_i8, rc)
 
1145
  call ARMCI_Free_fa(b7_i8, rc)
 
1146
  call ARMCI_Sync()
 
1147
  return
 
1148
endsubroutine
 
1149
subroutine testanb_r4(nproc,me,remote_proc)
 
1150
  use definekind
 
1151
  use armci_types
 
1152
  use armci_mem_f90
 
1153
  use armci_nbmov
 
1154
  use testa_init
 
1155
  use checkput
 
1156
  implicit none
 
1157
  type(ARMCI_slice) :: src_slice, dst_slice
 
1158
  integer :: nproc,me,remote_proc
 
1159
  real(kind=R4), pointer :: a7(:,:,:,:,:,:,:), b7(:,:,:,:,:,:,:)
 
1160
  real(kind=R4), pointer :: a6(:,:,:,:,:,:),   b6(:,:,:,:,:,:)
 
1161
  real(kind=R4), pointer :: a5(:,:,:,:,:),     b5(:,:,:,:,:)
 
1162
  real(kind=R4), pointer :: a4(:,:,:,:),       b4(:,:,:,:)
 
1163
  real(kind=R4), pointer :: a3(:,:,:),         b3(:,:,:)
 
1164
  real(kind=R4), pointer :: a2(:,:),           b2(:,:)
 
1165
  real(kind=R4), pointer :: a1(:),             b1(:)
 
1166
  real(kind=R4), pointer :: v(:)
 
1167
 
 
1168
  integer :: lb(7), ub(7), rc, i, j
 
1169
  integer :: pass
 
1170
  integer :: myunit
 
1171
  integer :: m
 
1172
  integer :: rank
 
1173
  integer :: joff
 
1174
  integer :: vshape(1)
 
1175
  integer :: extent(7)
 
1176
  integer :: asize(7)
 
1177
  integer :: score(7)
 
1178
  integer :: vlb(1),vub(1)
 
1179
  integer :: afirst,bfirst
 
1180
 
 
1181
  afirst = 1+me
 
1182
  bfirst = afirst*afirst
 
1183
 
 
1184
  lb(:) = 1
 
1185
  ub(:) = 7
 
1186
 
 
1187
  extent(:) = 1
 
1188
  extent(:) = extent(:) + ub(:) - lb(:)
 
1189
  asize(1) = extent(1)
 
1190
  do m= 2,7
 
1191
     asize(m) = asize(m-1)*extent(m)
 
1192
  enddo
 
1193
 
 
1194
! Test R4 flavor.
 
1195
  vlb(1) = 1
 
1196
  vub(1) = asize(7)
 
1197
  call ARMCI_Malloc_fa(v,vlb,vub,rc)
 
1198
  if (rc .ne. 0) then
 
1199
     print *,' ARMCI_Malloc_fa for v failed rc = ',rc
 
1200
     stop
 
1201
  endif
 
1202
 
 
1203
  call ARMCI_Malloc_fa(a7, lb, ub, rc)
 
1204
  if (rc .ne. 0) then
 
1205
     print *,' ARMCI_Malloc_fa for a7 failed rc = ',rc
 
1206
     stop
 
1207
  endif
 
1208
 
 
1209
  call ARMCI_Malloc_fa(b7, lb, ub, rc)
 
1210
  if (rc .ne. 0) then
 
1211
     print *,' ARMCI_Malloc_fa for b7 failed rc = ',rc
 
1212
     stop
 
1213
  endif
 
1214
 
 
1215
  call ARMCI_Malloc_fa(a6, lb, ub, rc)
 
1216
  if (rc .ne. 0) then
 
1217
     print *,' ARMCI_Malloc_fa for a6 failed rc = ',rc
 
1218
     stop
 
1219
  endif
 
1220
 
 
1221
  call ARMCI_Malloc_fa(b6, lb, ub, rc)
 
1222
  if (rc .ne. 0) then
 
1223
     print *,' ARMCI_Malloc_fa for b6 failed rc = ',rc
 
1224
     stop
 
1225
  endif
 
1226
 
 
1227
  call ARMCI_Malloc_fa(a5, lb, ub, rc)
 
1228
  if (rc .ne. 0) then
 
1229
     print *,' ARMCI_Malloc_fa for a5 failed rc = ',rc
 
1230
     stop
 
1231
  endif
 
1232
 
 
1233
  call ARMCI_Malloc_fa(b5, lb, ub, rc)
 
1234
  if (rc .ne. 0) then
 
1235
     print *,' ARMCI_Malloc_fa for b5 failed rc = ',rc
 
1236
     stop
 
1237
  endif
 
1238
 
 
1239
  call ARMCI_Malloc_fa(a4, lb, ub, rc)
 
1240
  if (rc .ne. 0) then
 
1241
     print *,' ARMCI_Malloc_fa for a4 failed rc = ',rc
 
1242
     stop
 
1243
  endif
 
1244
 
 
1245
  call ARMCI_Malloc_fa(b4, lb, ub, rc)
 
1246
  if (rc .ne. 0) then
 
1247
     print *,' ARMCI_Malloc_fa for b4 failed rc = ',rc
 
1248
     stop
 
1249
  endif
 
1250
 
 
1251
  call ARMCI_Malloc_fa(a3, lb, ub, rc)
 
1252
  if (rc .ne. 0) then
 
1253
     print *,' ARMCI_Malloc_fa for a3 failed rc = ',rc
 
1254
     stop
 
1255
  endif
 
1256
 
 
1257
  call ARMCI_Malloc_fa(b3, lb, ub, rc)
 
1258
  if (rc .ne. 0) then
 
1259
     print *,' ARMCI_Malloc_fa for b3 failed rc = ',rc
 
1260
     stop
 
1261
  endif
 
1262
 
 
1263
  call ARMCI_Malloc_fa(a2, lb, ub, rc)
 
1264
  if (rc .ne. 0) then
 
1265
     print *,' ARMCI_Malloc_fa for a2 failed rc = ',rc
 
1266
     stop
 
1267
  endif
 
1268
 
 
1269
  call ARMCI_Malloc_fa(b2, lb, ub, rc)
 
1270
  if (rc .ne. 0) then
 
1271
     print *,' ARMCI_Malloc_fa for b2 failed rc = ',rc
 
1272
     stop
 
1273
  endif
 
1274
 
 
1275
  call ARMCI_Malloc_fa(a1, lb, ub, rc)
 
1276
  if (rc .ne. 0) then
 
1277
     print *,' ARMCI_Malloc_fa for a1 failed rc = ',rc
 
1278
     stop
 
1279
  endif
 
1280
 
 
1281
  call ARMCI_Malloc_fa(b1, lb, ub, rc)
 
1282
  if (rc .ne. 0) then
 
1283
     print *,' ARMCI_Malloc_fa for b1 failed rc = ',rc
 
1284
     stop
 
1285
  endif
 
1286
 
 
1287
! Let all processors get alloccated.
 
1288
 
 
1289
  call ARMCI_Sync()
 
1290
 
 
1291
! R4 allocations done, now loop over slices.
 
1292
! We will test three flavors of slices,
 
1293
! all unit stride, unit stride in the first dimension only,
 
1294
! all non-unit stride (2).
 
1295
  score(:) = 0
 
1296
  joff = remote_proc + 1
 
1297
!
 
1298
! Test Put.
 
1299
!
 
1300
  do m = 1,3
 
1301
!    Initialize arrays.
 
1302
!
 
1303
     call init_7d(a7,b7,lb,ub,lb,ub,afirst,bfirst)
 
1304
     a6(:,:,:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
1305
     a5(:,:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
1306
     a4(:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
1307
     a3(:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
1308
     a2(:,:) = a7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
1309
     a1(:) = a7(lb(1):ub(1),1,1,1,1,1,1)
 
1310
     b6(:,:,:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
1311
     b5(:,:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
1312
     b4(:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
1313
     b3(:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
1314
     b2(:,:) = b7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
1315
     b1(:) = b7(lb(1):ub(1),1,1,1,1,1,1)
 
1316
 
 
1317
! Let all processors get initialized.
 
1318
 
 
1319
     call ARMCI_Sync()
 
1320
 
 
1321
! Set up slice info for the put.
 
1322
!
 
1323
! For m = 1, the slice has all unit strides.
 
1324
! For m = 2, the first dimension has a unit stride and all other
 
1325
!            dimensions have a stride of 2.
 
1326
! For m = 3, all dimensions have a stride of 2.
 
1327
!  
 
1328
     src_slice%lo(:) = 2
 
1329
     src_slice%hi(:) = 6
 
1330
     src_slice%stride(:) = (m+2)/2
 
1331
     src_slice%stride(1) = (m+1)/2
 
1332
 
 
1333
     dst_slice%lo(:) = 3
 
1334
     dst_slice%hi(:) = 7
 
1335
     dst_slice%stride(:) = (m+2)/2
 
1336
     dst_slice%stride(1) = (m+1)/2
 
1337
 
 
1338
! Rank 1.     
 
1339
     rank = 1
 
1340
     call ARMCI_NbPut_fa(a1, src_slice, b1, dst_slice, remote_proc, rc)
 
1341
     call ARMCI_Waitall_fa()
 
1342
 
 
1343
     call ARMCI_Sync()
 
1344
     if (rc .ne. 0) then
 
1345
        print *,me,': ARMCI_NbPut_fa for 1D R4, m = ',m,' failed, rc = ',rc
 
1346
     endif
 
1347
 
 
1348
! Check that received b1 is the piece of the sent a1.
 
1349
!
 
1350
     call check_b(rank,b1,dst_slice,src_slice,remote_proc, &
 
1351
    &             lb,ub,lb,ub,joff,pass)
 
1352
     score(1) = score(1) + pass
 
1353
     if (pass .ne. 1) then
 
1354
        print *,me,': ARMCI_NbPut_fa verify for 1D R4, m = ',m,' failed'
 
1355
     endif
 
1356
     call ARMCI_Sync()
 
1357
 
 
1358
! Rank 2.
 
1359
 
 
1360
     rank = 2
 
1361
     vshape(1) = asize(2)
 
1362
     call ARMCI_NbPut_fa(a2, src_slice, b2, dst_slice, remote_proc, rc)
 
1363
     call ARMCI_Waitall_fa()
 
1364
 
 
1365
     call ARMCI_Sync()
 
1366
     if (rc .ne. 0) then
 
1367
        print *,me,': ARMCI_NbPut_fa for 2D R4, m = ',m,' failed, rc = ',rc
 
1368
     endif
 
1369
 
 
1370
! Check that received b2 is the piece of the sent a2.
 
1371
!
 
1372
!     call check_b(rank,reshape(b2,vshape),dst_slice,src_slice,remote_proc, &
 
1373
!     call check_b(rank,b2,dst_slice,src_slice,remote_proc, &
 
1374
     v(1:asize(2)) = reshape(b2,vshape)
 
1375
 
 
1376
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
1377
    &             lb,ub,lb,ub,joff,pass)
 
1378
     score(2) = score(2) + pass
 
1379
     if (pass .ne. 1) then
 
1380
        print *,me,': ARMCI_NbPut_fa verify for 2D R4, m = ',m,' failed'
 
1381
     endif
 
1382
     call ARMCI_Sync()
 
1383
 
 
1384
! Rank 3.
 
1385
 
 
1386
     rank = 3
 
1387
     vshape(1) = asize(3)
 
1388
     call ARMCI_NbPut_fa(a3, src_slice, b3, dst_slice, remote_proc, rc)
 
1389
     call ARMCI_Waitall_fa()
 
1390
 
 
1391
     call ARMCI_Sync()
 
1392
     if (rc .ne. 0) then
 
1393
        print *,me,': ARMCI_NbPut_fa for 3D R4, m = ',m,' failed, rc = ',rc
 
1394
     endif
 
1395
 
 
1396
! Check that received b3 is the piece of the sent a3.
 
1397
!
 
1398
     v(1:asize(3)) = reshape(b3,vshape)
 
1399
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
1400
    &             lb,ub,lb,ub,joff,pass)
 
1401
     score(3) = score(3) + pass
 
1402
     if (pass .ne. 1) then
 
1403
        print *,me,': ARMCI_NbPut_fa verify for 3D R4, m = ',m,' failed'
 
1404
     endif
 
1405
     call ARMCI_Sync()
 
1406
 
 
1407
! Rank 4.
 
1408
 
 
1409
     rank = 4
 
1410
     vshape(1) = asize(4)
 
1411
     call ARMCI_NbPut_fa(a4, src_slice, b4, dst_slice, remote_proc, rc)
 
1412
     call ARMCI_Waitall_fa()
 
1413
 
 
1414
     call ARMCI_Sync()
 
1415
     if (rc .ne. 0) then
 
1416
        print *,me,': ARMCI_NbPut_fa for 4D R4, m = ',m,' failed, rc = ',rc
 
1417
     endif
 
1418
 
 
1419
! Check that received b4 is the piece of the sent a4.
 
1420
!
 
1421
     v(1:asize(4)) = reshape(b4,vshape)
 
1422
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
1423
    &             lb,ub,lb,ub,joff,pass)
 
1424
     score(4) = score(4) + pass
 
1425
     if (pass .ne. 1) then
 
1426
        print *,me,': ARMCI_NbPut_fa verify for 4D R4, m = ',m,' failed'
 
1427
     endif
 
1428
     call ARMCI_Sync()
 
1429
 
 
1430
! Rank 5.
 
1431
 
 
1432
     rank = 5
 
1433
     vshape(1) = asize(5)
 
1434
     call ARMCI_NbPut_fa(a5, src_slice, b5, dst_slice, remote_proc, rc)
 
1435
     call ARMCI_Waitall_fa()
 
1436
 
 
1437
     call ARMCI_Sync()
 
1438
     if (rc .ne. 0) then
 
1439
        print *,me,': ARMCI_NbPut_fa for 5D R4, m = ',m,' failed, rc = ',rc
 
1440
     endif
 
1441
 
 
1442
! Check that received b5 is the piece of the sent a5.
 
1443
!
 
1444
     v(1:asize(5)) = reshape(b5,vshape)
 
1445
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
1446
    &             lb,ub,lb,ub,joff,pass)
 
1447
     score(5) = score(5) + pass
 
1448
     if (pass .ne. 1) then
 
1449
        print *,me,': ARMCI_NbPut_fa verify for 4D R4, m = ',m,' failed'
 
1450
     endif
 
1451
     call ARMCI_Sync()
 
1452
 
 
1453
! Rank 6.
 
1454
 
 
1455
     rank = 6
 
1456
     vshape(1) = asize(6)
 
1457
     call ARMCI_NbPut_fa(a6, src_slice, b6, dst_slice, remote_proc, rc)
 
1458
     call ARMCI_Waitall_fa()
 
1459
 
 
1460
     call ARMCI_Sync()
 
1461
     if (rc .ne. 0) then
 
1462
        print *,me,': ARMCI_NbPut_fa for 6D R4, m = ',m,' failed, rc = ',rc
 
1463
     endif
 
1464
 
 
1465
! Check that received b6 is the piece of the sent a6
 
1466
!
 
1467
     v(1:asize(6)) = reshape(b6,vshape)
 
1468
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
1469
    &             lb,ub,lb,ub,joff,pass)
 
1470
     score(6) = score(6) + pass
 
1471
     if (pass .ne. 1) then
 
1472
        print *,me,': ARMCI_NbPut_fa verify for 6D R4, m = ',m,' failed'
 
1473
     endif
 
1474
     call ARMCI_Sync()
 
1475
 
 
1476
! Rank 7.
 
1477
 
 
1478
     rank = 7
 
1479
     vshape(1) = asize(7)
 
1480
     call ARMCI_NbPut_fa(a7, src_slice, b7, dst_slice, remote_proc, rc)
 
1481
     call ARMCI_Waitall_fa()
 
1482
 
 
1483
     call ARMCI_Sync()
 
1484
     if (rc .ne. 0) then
 
1485
        print *,me,': ARMCI_NbPut_fa for 7D R4, m = ',m,' failed, rc = ',rc
 
1486
     endif
 
1487
 
 
1488
! Check that received b7 is the piece of the sent a7
 
1489
!
 
1490
     v(1:asize(7)) = reshape(b7,vshape)
 
1491
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
1492
    &             lb,ub,lb,ub,joff,pass)
 
1493
     score(7) = score(7) + pass
 
1494
     if (pass .ne. 1) then
 
1495
        print *,me,': ARMCI_NbPut_fa verify for 7D R4, m = ',m,' failed'
 
1496
     endif
 
1497
     call ARMCI_Sync()
 
1498
 
 
1499
  enddo
 
1500
  if (me .eq. 0) then
 
1501
     do m = 1,7
 
1502
        if (score(m) .eq. 3) then
 
1503
           print *,' ARMCI_NbPut_fa for R4, ',m,'D passed'
 
1504
        endif
 
1505
     enddo
 
1506
  endif
 
1507
!
 
1508
! Test Get.
 
1509
!
 
1510
  score(:) = 0
 
1511
  joff = (remote_proc + 1)*(remote_proc+1)
 
1512
  do m = 1,3
 
1513
!
 
1514
!    Initialize arrays.
 
1515
!
 
1516
     call init_7d(a7,b7,lb,ub,lb,ub,afirst,bfirst)
 
1517
     a6 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
1518
     a5 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
1519
     a4 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
1520
     a3 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
1521
     a2 = a7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
1522
     a1 = a7(lb(1):ub(1),1,1,1,1,1,1)
 
1523
     b6 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
1524
     b5 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
1525
     b4 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
1526
     b3 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
1527
     b2 = b7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
1528
     b1 = b7(lb(1):ub(1),1,1,1,1,1,1)
 
1529
 
 
1530
! Let all processors get initialized.
 
1531
 
 
1532
     call ARMCI_Sync()
 
1533
 
 
1534
! Set up slice info for the get.
 
1535
!
 
1536
! For m = 1, the slice has all unit strides.
 
1537
! For m = 2, the first dimension has a unit stride and all other
 
1538
!            dimensions have a stride of 2.
 
1539
! For m = 3, all dimensions have a stride of 2.
 
1540
!  
 
1541
     src_slice%lo(:) = 2
 
1542
     src_slice%hi(:) = 6
 
1543
     src_slice%stride(:) = (m+2)/2
 
1544
     src_slice%stride(1) = (m+1)/2
 
1545
 
 
1546
     dst_slice%lo(:) = 3
 
1547
     dst_slice%hi(:) = 7
 
1548
     dst_slice%stride(:) = (m+2)/2
 
1549
     dst_slice%stride(1) = (m+1)/2
 
1550
!
 
1551
! Rank 1
 
1552
!
 
1553
     rank = 1
 
1554
     call ARMCI_NbGet_fa(b1, dst_slice, a1, src_slice, remote_proc, rc)
 
1555
     call ARMCI_Waitall_fa()
 
1556
 
 
1557
     call ARMCI_Sync()
 
1558
!
 
1559
! Check that recieved a is the piece of b that was sent.
 
1560
 
 
1561
     call check_b(rank,a1,src_slice,dst_slice,remote_proc, &
 
1562
    &             lb,ub,lb,ub,joff,pass)
 
1563
     score(1) = score(1) + pass
 
1564
     if (pass .ne. 1) then
 
1565
        print *,me,': ARMCI_NbGet_fa verify for 1D R4, m = ',m,' failed'
 
1566
     endif
 
1567
     call ARMCI_Sync()
 
1568
     
 
1569
!
 
1570
! Rank 2
 
1571
!
 
1572
     rank = 2
 
1573
     vshape(1) = asize(2)
 
1574
     call ARMCI_NbGet_fa(b2, dst_slice, a2, src_slice, remote_proc, rc)
 
1575
     call ARMCI_Waitall_fa()
 
1576
 
 
1577
     call ARMCI_Sync()
 
1578
!
 
1579
! Check that recieved a is the piece of b that was sent.
 
1580
 
 
1581
     v(1:asize(2)) = reshape(a2,vshape)
 
1582
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
1583
    &             lb,ub,lb,ub,joff,pass)
 
1584
     score(2) = score(2) + pass
 
1585
     if (pass .ne. 1) then
 
1586
        print *,me,': ARMCI_NbGet_fa verify for 2D R4, m = ',m,' failed'
 
1587
     endif
 
1588
     call ARMCI_Sync()
 
1589
     
 
1590
!
 
1591
! Rank 3
 
1592
!
 
1593
     rank = 3
 
1594
     vshape(1) = asize(3)
 
1595
     call ARMCI_NbGet_fa(b3, dst_slice, a3, src_slice, remote_proc, rc)
 
1596
     call ARMCI_Waitall_fa()
 
1597
 
 
1598
     call ARMCI_Sync()
 
1599
!
 
1600
! Check that recieved a is the piece of b that was sent.
 
1601
 
 
1602
     v(1:asize(3)) = reshape(a3,vshape)
 
1603
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
1604
    &             lb,ub,lb,ub,joff,pass)
 
1605
     score(3) = score(3) + pass
 
1606
     if (pass .ne. 1) then
 
1607
        print *,me,': ARMCI_NbGet_fa verify for 3D R4, m = ',m,' failed'
 
1608
     endif
 
1609
     call ARMCI_Sync()
 
1610
     
 
1611
!
 
1612
! Rank 4
 
1613
!
 
1614
     rank = 4
 
1615
     vshape(1) = asize(4)
 
1616
     call ARMCI_NbGet_fa(b4, dst_slice, a4, src_slice, remote_proc, rc)
 
1617
     call ARMCI_Waitall_fa()
 
1618
 
 
1619
     call ARMCI_Sync()
 
1620
!
 
1621
! Check that recieved a is the piece of b that was sent.
 
1622
 
 
1623
     v(1:asize(4)) = reshape(a4,vshape)
 
1624
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
1625
    &             lb,ub,lb,ub,joff,pass)
 
1626
     score(4) = score(4) + pass
 
1627
     if (pass .ne. 1) then
 
1628
        print *,me,': ARMCI_NbGet_fa verify for 4D R4, m = ',m,' failed'
 
1629
     endif
 
1630
     call ARMCI_Sync()
 
1631
     
 
1632
!
 
1633
! Rank 5
 
1634
!
 
1635
     rank = 5
 
1636
     vshape(1) = asize(5)
 
1637
     call ARMCI_NbGet_fa(b5, dst_slice, a5, src_slice, remote_proc, rc)
 
1638
     call ARMCI_Waitall_fa()
 
1639
 
 
1640
     call ARMCI_Sync()
 
1641
!
 
1642
! Check that recieved a is the piece of b that was sent.
 
1643
 
 
1644
     v(1:asize(5)) = reshape(a5,vshape)
 
1645
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
1646
    &             lb,ub,lb,ub,joff,pass)
 
1647
     score(5) = score(5) + pass
 
1648
     if (pass .ne. 1) then
 
1649
        print *,me,': ARMCI_NbGet_fa verify for 5D R4, m = ',m,' failed'
 
1650
     endif
 
1651
     call ARMCI_Sync()
 
1652
     
 
1653
!
 
1654
! Rank 6
 
1655
!
 
1656
     rank = 6
 
1657
     vshape(1) = asize(6)
 
1658
     call ARMCI_NbGet_fa(b6, dst_slice, a6, src_slice, remote_proc, rc)
 
1659
     call ARMCI_Waitall_fa()
 
1660
 
 
1661
     call ARMCI_Sync()
 
1662
!
 
1663
! Check that recieved a is the piece of b that was sent.
 
1664
 
 
1665
     v(1:asize(6)) = reshape(a6,vshape)
 
1666
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
1667
    &             lb,ub,lb,ub,joff,pass)
 
1668
     score(6) = score(6) + pass
 
1669
     if (pass .ne. 1) then
 
1670
        print *,me,': ARMCI_NbGet_fa verify for 6D R4, m = ',m,' failed'
 
1671
     endif
 
1672
     call ARMCI_Sync()
 
1673
     
 
1674
!
 
1675
! Rank 7
 
1676
!
 
1677
     rank = 7
 
1678
     vshape(1) = asize(7)
 
1679
     call ARMCI_NbGet_fa(b7, dst_slice, a7, src_slice, remote_proc, rc)
 
1680
     call ARMCI_Waitall_fa()
 
1681
 
 
1682
     call ARMCI_Sync()
 
1683
!
 
1684
! Check that recieved a is the piece of b that was sent.
 
1685
 
 
1686
     v(1:asize(7)) = reshape(a7,vshape)
 
1687
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
1688
    &             lb,ub,lb,ub,joff,pass)
 
1689
     score(7) = score(7) + pass
 
1690
     if (pass .ne. 1) then
 
1691
        print *,me,': ARMCI_NbGet_fa verify for 7D R4, m = ',m,' failed'
 
1692
     endif
 
1693
     call ARMCI_Sync()
 
1694
 
 
1695
  enddo
 
1696
  if (me .eq. 0) then
 
1697
     do m = 1,7
 
1698
        if (score(m) .eq. 3) then
 
1699
           print *,' ARMCI_NbGet_fa for R4, ',m,'D passed'
 
1700
        endif
 
1701
     enddo
 
1702
  endif
 
1703
!
 
1704
! Free v, a and b arrays.
 
1705
!
 
1706
  call ARMCI_Sync()
 
1707
  call ARMCI_Free_fa(v, rc)
 
1708
  call ARMCI_Free_fa(a1, rc)
 
1709
  call ARMCI_Free_fa(b1, rc)
 
1710
  call ARMCI_Free_fa(a2, rc)
 
1711
  call ARMCI_Free_fa(b2, rc)
 
1712
  call ARMCI_Free_fa(a3, rc)
 
1713
  call ARMCI_Free_fa(b3, rc)
 
1714
  call ARMCI_Free_fa(a4, rc)
 
1715
  call ARMCI_Free_fa(b4, rc)
 
1716
  call ARMCI_Free_fa(a5, rc)
 
1717
  call ARMCI_Free_fa(b5, rc)
 
1718
  call ARMCI_Free_fa(a6, rc)
 
1719
  call ARMCI_Free_fa(b6, rc)
 
1720
  call ARMCI_Free_fa(a7, rc)
 
1721
  call ARMCI_Free_fa(b7, rc)
 
1722
  call ARMCI_Sync()
 
1723
  return
 
1724
endsubroutine
 
1725
subroutine testanb_r8(nproc,me,remote_proc)
 
1726
  use definekind
 
1727
  use armci_types
 
1728
  use armci_mem_f90
 
1729
  use armci_nbmov
 
1730
  use testa_init
 
1731
  use checkput
 
1732
  implicit none
 
1733
  type(ARMCI_slice) :: src_slice, dst_slice
 
1734
  integer :: nproc,me,remote_proc
 
1735
  real(kind=R8), pointer :: a7(:,:,:,:,:,:,:), b7(:,:,:,:,:,:,:)
 
1736
  real(kind=R8), pointer :: a6(:,:,:,:,:,:),   b6(:,:,:,:,:,:)
 
1737
  real(kind=R8), pointer :: a5(:,:,:,:,:),     b5(:,:,:,:,:)
 
1738
  real(kind=R8), pointer :: a4(:,:,:,:),       b4(:,:,:,:)
 
1739
  real(kind=R8), pointer :: a3(:,:,:),         b3(:,:,:)
 
1740
  real(kind=R8), pointer :: a2(:,:),           b2(:,:)
 
1741
  real(kind=R8), pointer :: a1(:),             b1(:)
 
1742
  real(kind=R8), pointer :: v(:)
 
1743
 
 
1744
  integer :: lb(7), ub(7), rc, i, j
 
1745
  integer :: pass
 
1746
  integer :: myunit
 
1747
  integer :: m
 
1748
  integer :: rank
 
1749
  integer :: joff
 
1750
  integer :: vshape(1)
 
1751
  integer :: extent(7)
 
1752
  integer :: asize(7)
 
1753
  integer :: score(7)
 
1754
  integer :: vlb(1),vub(1)
 
1755
  integer :: afirst,bfirst
 
1756
 
 
1757
  afirst = 1+me
 
1758
  bfirst = afirst*afirst
 
1759
 
 
1760
  lb(:) = 1
 
1761
  ub(:) = 7
 
1762
 
 
1763
  extent(:) = 1
 
1764
  extent(:) = extent(:) + ub(:) - lb(:)
 
1765
  asize(1) = extent(1)
 
1766
  do m= 2,7
 
1767
     asize(m) = asize(m-1)*extent(m)
 
1768
  enddo
 
1769
 
 
1770
! Test R8 flavor.
 
1771
  vlb(1) = 1
 
1772
  vub(1) = asize(7)
 
1773
  call ARMCI_Malloc_fa(v,vlb,vub,rc)
 
1774
  if (rc .ne. 0) then
 
1775
     print *,' ARMCI_Malloc_fa for v failed rc = ',rc
 
1776
     stop
 
1777
  endif
 
1778
 
 
1779
  call ARMCI_Malloc_fa(a7, lb, ub, rc)
 
1780
  if (rc .ne. 0) then
 
1781
     print *,' ARMCI_Malloc_fa for a7 failed rc = ',rc
 
1782
     stop
 
1783
  endif
 
1784
 
 
1785
  call ARMCI_Malloc_fa(b7, lb, ub, rc)
 
1786
  if (rc .ne. 0) then
 
1787
     print *,' ARMCI_Malloc_fa for b7 failed rc = ',rc
 
1788
     stop
 
1789
  endif
 
1790
 
 
1791
  call ARMCI_Malloc_fa(a6, lb, ub, rc)
 
1792
  if (rc .ne. 0) then
 
1793
     print *,' ARMCI_Malloc_fa for a6 failed rc = ',rc
 
1794
     stop
 
1795
  endif
 
1796
 
 
1797
  call ARMCI_Malloc_fa(b6, lb, ub, rc)
 
1798
  if (rc .ne. 0) then
 
1799
     print *,' ARMCI_Malloc_fa for b6 failed rc = ',rc
 
1800
     stop
 
1801
  endif
 
1802
 
 
1803
  call ARMCI_Malloc_fa(a5, lb, ub, rc)
 
1804
  if (rc .ne. 0) then
 
1805
     print *,' ARMCI_Malloc_fa for a5 failed rc = ',rc
 
1806
     stop
 
1807
  endif
 
1808
 
 
1809
  call ARMCI_Malloc_fa(b5, lb, ub, rc)
 
1810
  if (rc .ne. 0) then
 
1811
     print *,' ARMCI_Malloc_fa for b5 failed rc = ',rc
 
1812
     stop
 
1813
  endif
 
1814
 
 
1815
  call ARMCI_Malloc_fa(a4, lb, ub, rc)
 
1816
  if (rc .ne. 0) then
 
1817
     print *,' ARMCI_Malloc_fa for a4 failed rc = ',rc
 
1818
     stop
 
1819
  endif
 
1820
 
 
1821
  call ARMCI_Malloc_fa(b4, lb, ub, rc)
 
1822
  if (rc .ne. 0) then
 
1823
     print *,' ARMCI_Malloc_fa for b4 failed rc = ',rc
 
1824
     stop
 
1825
  endif
 
1826
 
 
1827
  call ARMCI_Malloc_fa(a3, lb, ub, rc)
 
1828
  if (rc .ne. 0) then
 
1829
     print *,' ARMCI_Malloc_fa for a3 failed rc = ',rc
 
1830
     stop
 
1831
  endif
 
1832
 
 
1833
  call ARMCI_Malloc_fa(b3, lb, ub, rc)
 
1834
  if (rc .ne. 0) then
 
1835
     print *,' ARMCI_Malloc_fa for b3 failed rc = ',rc
 
1836
     stop
 
1837
  endif
 
1838
 
 
1839
  call ARMCI_Malloc_fa(a2, lb, ub, rc)
 
1840
  if (rc .ne. 0) then
 
1841
     print *,' ARMCI_Malloc_fa for a2 failed rc = ',rc
 
1842
     stop
 
1843
  endif
 
1844
 
 
1845
  call ARMCI_Malloc_fa(b2, lb, ub, rc)
 
1846
  if (rc .ne. 0) then
 
1847
     print *,' ARMCI_Malloc_fa for b2 failed rc = ',rc
 
1848
     stop
 
1849
  endif
 
1850
 
 
1851
  call ARMCI_Malloc_fa(a1, lb, ub, rc)
 
1852
  if (rc .ne. 0) then
 
1853
     print *,' ARMCI_Malloc_fa for a1 failed rc = ',rc
 
1854
     stop
 
1855
  endif
 
1856
 
 
1857
  call ARMCI_Malloc_fa(b1, lb, ub, rc)
 
1858
  if (rc .ne. 0) then
 
1859
     print *,' ARMCI_Malloc_fa for b1 failed rc = ',rc
 
1860
     stop
 
1861
  endif
 
1862
 
 
1863
! Let all processors get alloccated.
 
1864
 
 
1865
  call ARMCI_Sync()
 
1866
 
 
1867
! R8 allocations done, now loop over slices.
 
1868
! We will test three flavors of slices,
 
1869
! all unit stride, unit stride in the first dimension only,
 
1870
! all non-unit stride (2).
 
1871
  score(:) = 0
 
1872
  joff = remote_proc + 1
 
1873
!
 
1874
! Test Put.
 
1875
!
 
1876
  do m = 1,3
 
1877
!    Initialize arrays.
 
1878
!
 
1879
     call init_7d(a7,b7,lb,ub,lb,ub,afirst,bfirst)
 
1880
     a6(:,:,:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
1881
     a5(:,:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
1882
     a4(:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
1883
     a3(:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
1884
     a2(:,:) = a7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
1885
     a1(:) = a7(lb(1):ub(1),1,1,1,1,1,1)
 
1886
     b6(:,:,:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
1887
     b5(:,:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
1888
     b4(:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
1889
     b3(:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
1890
     b2(:,:) = b7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
1891
     b1(:) = b7(lb(1):ub(1),1,1,1,1,1,1)
 
1892
 
 
1893
! Let all processors get initialized.
 
1894
 
 
1895
     call ARMCI_Sync()
 
1896
 
 
1897
! Set up slice info for the put.
 
1898
!
 
1899
! For m = 1, the slice has all unit strides.
 
1900
! For m = 2, the first dimension has a unit stride and all other
 
1901
!            dimensions have a stride of 2.
 
1902
! For m = 3, all dimensions have a stride of 2.
 
1903
!  
 
1904
     src_slice%lo(:) = 2
 
1905
     src_slice%hi(:) = 6
 
1906
     src_slice%stride(:) = (m+2)/2
 
1907
     src_slice%stride(1) = (m+1)/2
 
1908
 
 
1909
     dst_slice%lo(:) = 3
 
1910
     dst_slice%hi(:) = 7
 
1911
     dst_slice%stride(:) = (m+2)/2
 
1912
     dst_slice%stride(1) = (m+1)/2
 
1913
 
 
1914
! Rank 1.     
 
1915
     rank = 1
 
1916
     call ARMCI_NbPut_fa(a1, src_slice, b1, dst_slice, remote_proc, rc)
 
1917
     call ARMCI_Waitall_fa()
 
1918
 
 
1919
     call ARMCI_Sync()
 
1920
     if (rc .ne. 0) then
 
1921
        print *,me,': ARMCI_NbPut_fa for 1D R8, m = ',m,' failed, rc = ',rc
 
1922
     endif
 
1923
 
 
1924
! Check that received b1 is the piece of the sent a1.
 
1925
!
 
1926
     call check_b(rank,b1,dst_slice,src_slice,remote_proc, &
 
1927
    &             lb,ub,lb,ub,joff,pass)
 
1928
     score(1) = score(1) + pass
 
1929
     if (pass .ne. 1) then
 
1930
        print *,me,': ARMCI_NbPut_fa verify for 1D R8, m = ',m,' failed'
 
1931
     endif
 
1932
     call ARMCI_Sync()
 
1933
 
 
1934
! Rank 2.
 
1935
 
 
1936
     rank = 2
 
1937
     vshape(1) = asize(2)
 
1938
     call ARMCI_NbPut_fa(a2, src_slice, b2, dst_slice, remote_proc, rc)
 
1939
     call ARMCI_Waitall_fa()
 
1940
 
 
1941
     call ARMCI_Sync()
 
1942
     if (rc .ne. 0) then
 
1943
        print *,me,': ARMCI_NbPut_fa for 2D R8, m = ',m,' failed, rc = ',rc
 
1944
     endif
 
1945
 
 
1946
! Check that received b2 is the piece of the sent a2.
 
1947
!
 
1948
!     call check_b(rank,reshape(b2,vshape),dst_slice,src_slice,remote_proc, &
 
1949
!     call check_b(rank,b2,dst_slice,src_slice,remote_proc, &
 
1950
     v(1:asize(2)) = reshape(b2,vshape)
 
1951
 
 
1952
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
1953
    &             lb,ub,lb,ub,joff,pass)
 
1954
     score(2) = score(2) + pass
 
1955
     if (pass .ne. 1) then
 
1956
        print *,me,': ARMCI_NbPut_fa verify for 2D R8, m = ',m,' failed'
 
1957
     endif
 
1958
     call ARMCI_Sync()
 
1959
 
 
1960
! Rank 3.
 
1961
 
 
1962
     rank = 3
 
1963
     vshape(1) = asize(3)
 
1964
     call ARMCI_NbPut_fa(a3, src_slice, b3, dst_slice, remote_proc, rc)
 
1965
     call ARMCI_Waitall_fa()
 
1966
 
 
1967
     call ARMCI_Sync()
 
1968
     if (rc .ne. 0) then
 
1969
        print *,me,': ARMCI_NbPut_fa for 3D R8, m = ',m,' failed, rc = ',rc
 
1970
     endif
 
1971
 
 
1972
! Check that received b3 is the piece of the sent a3.
 
1973
!
 
1974
     v(1:asize(3)) = reshape(b3,vshape)
 
1975
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
1976
    &             lb,ub,lb,ub,joff,pass)
 
1977
     score(3) = score(3) + pass
 
1978
     if (pass .ne. 1) then
 
1979
        print *,me,': ARMCI_NbPut_fa verify for 3D R8, m = ',m,' failed'
 
1980
     endif
 
1981
     call ARMCI_Sync()
 
1982
 
 
1983
! Rank 4.
 
1984
 
 
1985
     rank = 4
 
1986
     vshape(1) = asize(4)
 
1987
     call ARMCI_NbPut_fa(a4, src_slice, b4, dst_slice, remote_proc, rc)
 
1988
     call ARMCI_Waitall_fa()
 
1989
 
 
1990
     call ARMCI_Sync()
 
1991
     if (rc .ne. 0) then
 
1992
        print *,me,': ARMCI_NbPut_fa for 4D R8, m = ',m,' failed, rc = ',rc
 
1993
     endif
 
1994
 
 
1995
! Check that received b4 is the piece of the sent a4.
 
1996
!
 
1997
     v(1:asize(4)) = reshape(b4,vshape)
 
1998
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
1999
    &             lb,ub,lb,ub,joff,pass)
 
2000
     score(4) = score(4) + pass
 
2001
     if (pass .ne. 1) then
 
2002
        print *,me,': ARMCI_NbPut_fa verify for 4D R8, m = ',m,' failed'
 
2003
     endif
 
2004
     call ARMCI_Sync()
 
2005
 
 
2006
! Rank 5.
 
2007
 
 
2008
     rank = 5
 
2009
     vshape(1) = asize(5)
 
2010
     call ARMCI_NbPut_fa(a5, src_slice, b5, dst_slice, remote_proc, rc)
 
2011
     call ARMCI_Waitall_fa()
 
2012
 
 
2013
     call ARMCI_Sync()
 
2014
     if (rc .ne. 0) then
 
2015
        print *,me,': ARMCI_NbPut_fa for 5D R8, m = ',m,' failed, rc = ',rc
 
2016
     endif
 
2017
 
 
2018
! Check that received b5 is the piece of the sent a5.
 
2019
!
 
2020
     v(1:asize(5)) = reshape(b5,vshape)
 
2021
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
2022
    &             lb,ub,lb,ub,joff,pass)
 
2023
     score(5) = score(5) + pass
 
2024
     if (pass .ne. 1) then
 
2025
        print *,me,': ARMCI_NbPut_fa verify for 4D R8, m = ',m,' failed'
 
2026
     endif
 
2027
     call ARMCI_Sync()
 
2028
 
 
2029
! Rank 6.
 
2030
 
 
2031
     rank = 6
 
2032
     vshape(1) = asize(6)
 
2033
     call ARMCI_NbPut_fa(a6, src_slice, b6, dst_slice, remote_proc, rc)
 
2034
     call ARMCI_Waitall_fa()
 
2035
 
 
2036
     call ARMCI_Sync()
 
2037
     if (rc .ne. 0) then
 
2038
        print *,me,': ARMCI_NbPut_fa for 6D R8, m = ',m,' failed, rc = ',rc
 
2039
     endif
 
2040
 
 
2041
! Check that received b6 is the piece of the sent a6
 
2042
!
 
2043
     v(1:asize(6)) = reshape(b6,vshape)
 
2044
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
2045
    &             lb,ub,lb,ub,joff,pass)
 
2046
     score(6) = score(6) + pass
 
2047
     if (pass .ne. 1) then
 
2048
        print *,me,': ARMCI_NbPut_fa verify for 6D R8, m = ',m,' failed'
 
2049
     endif
 
2050
     call ARMCI_Sync()
 
2051
 
 
2052
! Rank 7.
 
2053
 
 
2054
     rank = 7
 
2055
     vshape(1) = asize(7)
 
2056
     call ARMCI_NbPut_fa(a7, src_slice, b7, dst_slice, remote_proc, rc)
 
2057
     call ARMCI_Waitall_fa()
 
2058
 
 
2059
     call ARMCI_Sync()
 
2060
     if (rc .ne. 0) then
 
2061
        print *,me,': ARMCI_NbPut_fa for 7D R8, m = ',m,' failed, rc = ',rc
 
2062
     endif
 
2063
 
 
2064
! Check that received b7 is the piece of the sent a7
 
2065
!
 
2066
     v(1:asize(7)) = reshape(b7,vshape)
 
2067
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
2068
    &             lb,ub,lb,ub,joff,pass)
 
2069
     score(7) = score(7) + pass
 
2070
     if (pass .ne. 1) then
 
2071
        print *,me,': ARMCI_NbPut_fa verify for 7D R8, m = ',m,' failed'
 
2072
     endif
 
2073
     call ARMCI_Sync()
 
2074
 
 
2075
  enddo
 
2076
  if (me .eq. 0) then
 
2077
     do m = 1,7
 
2078
        if (score(m) .eq. 3) then
 
2079
           print *,' ARMCI_NbPut_fa for R8, ',m,'D passed'
 
2080
        endif
 
2081
     enddo
 
2082
  endif
 
2083
!
 
2084
! Test Get.
 
2085
!
 
2086
  score(:) = 0
 
2087
  joff = (remote_proc + 1)*(remote_proc+1)
 
2088
  do m = 1,3
 
2089
!
 
2090
!    Initialize arrays.
 
2091
!
 
2092
     call init_7d(a7,b7,lb,ub,lb,ub,afirst,bfirst)
 
2093
     a6 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
2094
     a5 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
2095
     a4 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
2096
     a3 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
2097
     a2 = a7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
2098
     a1 = a7(lb(1):ub(1),1,1,1,1,1,1)
 
2099
     b6 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
2100
     b5 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
2101
     b4 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
2102
     b3 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
2103
     b2 = b7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
2104
     b1 = b7(lb(1):ub(1),1,1,1,1,1,1)
 
2105
 
 
2106
! Let all processors get initialized.
 
2107
 
 
2108
     call ARMCI_Sync()
 
2109
 
 
2110
! Set up slice info for the get.
 
2111
!
 
2112
! For m = 1, the slice has all unit strides.
 
2113
! For m = 2, the first dimension has a unit stride and all other
 
2114
!            dimensions have a stride of 2.
 
2115
! For m = 3, all dimensions have a stride of 2.
 
2116
!  
 
2117
     src_slice%lo(:) = 2
 
2118
     src_slice%hi(:) = 6
 
2119
     src_slice%stride(:) = (m+2)/2
 
2120
     src_slice%stride(1) = (m+1)/2
 
2121
 
 
2122
     dst_slice%lo(:) = 3
 
2123
     dst_slice%hi(:) = 7
 
2124
     dst_slice%stride(:) = (m+2)/2
 
2125
     dst_slice%stride(1) = (m+1)/2
 
2126
!
 
2127
! Rank 1
 
2128
!
 
2129
     rank = 1
 
2130
     call ARMCI_NbGet_fa(b1, dst_slice, a1, src_slice, remote_proc, rc)
 
2131
     call ARMCI_Waitall_fa()
 
2132
 
 
2133
     call ARMCI_Sync()
 
2134
!
 
2135
! Check that recieved a is the piece of b that was sent.
 
2136
 
 
2137
     call check_b(rank,a1,src_slice,dst_slice,remote_proc, &
 
2138
    &             lb,ub,lb,ub,joff,pass)
 
2139
     score(1) = score(1) + pass
 
2140
     if (pass .ne. 1) then
 
2141
        print *,me,': ARMCI_NbGet_fa verify for 1D R8, m = ',m,' failed'
 
2142
     endif
 
2143
     call ARMCI_Sync()
 
2144
     
 
2145
!
 
2146
! Rank 2
 
2147
!
 
2148
     rank = 2
 
2149
     vshape(1) = asize(2)
 
2150
     call ARMCI_NbGet_fa(b2, dst_slice, a2, src_slice, remote_proc, rc)
 
2151
     call ARMCI_Waitall_fa()
 
2152
 
 
2153
     call ARMCI_Sync()
 
2154
!
 
2155
! Check that recieved a is the piece of b that was sent.
 
2156
 
 
2157
     v(1:asize(2)) = reshape(a2,vshape)
 
2158
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2159
    &             lb,ub,lb,ub,joff,pass)
 
2160
     score(2) = score(2) + pass
 
2161
     if (pass .ne. 1) then
 
2162
        print *,me,': ARMCI_NbGet_fa verify for 2D R8, m = ',m,' failed'
 
2163
     endif
 
2164
     call ARMCI_Sync()
 
2165
     
 
2166
!
 
2167
! Rank 3
 
2168
!
 
2169
     rank = 3
 
2170
     vshape(1) = asize(3)
 
2171
     call ARMCI_NbGet_fa(b3, dst_slice, a3, src_slice, remote_proc, rc)
 
2172
     call ARMCI_Waitall_fa()
 
2173
 
 
2174
     call ARMCI_Sync()
 
2175
!
 
2176
! Check that recieved a is the piece of b that was sent.
 
2177
 
 
2178
     v(1:asize(3)) = reshape(a3,vshape)
 
2179
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2180
    &             lb,ub,lb,ub,joff,pass)
 
2181
     score(3) = score(3) + pass
 
2182
     if (pass .ne. 1) then
 
2183
        print *,me,': ARMCI_NbGet_fa verify for 3D R8, m = ',m,' failed'
 
2184
     endif
 
2185
     call ARMCI_Sync()
 
2186
     
 
2187
!
 
2188
! Rank 4
 
2189
!
 
2190
     rank = 4
 
2191
     vshape(1) = asize(4)
 
2192
     call ARMCI_NbGet_fa(b4, dst_slice, a4, src_slice, remote_proc, rc)
 
2193
     call ARMCI_Waitall_fa()
 
2194
 
 
2195
     call ARMCI_Sync()
 
2196
!
 
2197
! Check that recieved a is the piece of b that was sent.
 
2198
 
 
2199
     v(1:asize(4)) = reshape(a4,vshape)
 
2200
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2201
    &             lb,ub,lb,ub,joff,pass)
 
2202
     score(4) = score(4) + pass
 
2203
     if (pass .ne. 1) then
 
2204
        print *,me,': ARMCI_NbGet_fa verify for 4D R8, m = ',m,' failed'
 
2205
     endif
 
2206
     call ARMCI_Sync()
 
2207
     
 
2208
!
 
2209
! Rank 5
 
2210
!
 
2211
     rank = 5
 
2212
     vshape(1) = asize(5)
 
2213
     call ARMCI_NbGet_fa(b5, dst_slice, a5, src_slice, remote_proc, rc)
 
2214
     call ARMCI_Waitall_fa()
 
2215
 
 
2216
     call ARMCI_Sync()
 
2217
!
 
2218
! Check that recieved a is the piece of b that was sent.
 
2219
 
 
2220
     v(1:asize(5)) = reshape(a5,vshape)
 
2221
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2222
    &             lb,ub,lb,ub,joff,pass)
 
2223
     score(5) = score(5) + pass
 
2224
     if (pass .ne. 1) then
 
2225
        print *,me,': ARMCI_NbGet_fa verify for 5D R8, m = ',m,' failed'
 
2226
     endif
 
2227
     call ARMCI_Sync()
 
2228
     
 
2229
!
 
2230
! Rank 6
 
2231
!
 
2232
     rank = 6
 
2233
     vshape(1) = asize(6)
 
2234
     call ARMCI_NbGet_fa(b6, dst_slice, a6, src_slice, remote_proc, rc)
 
2235
     call ARMCI_Waitall_fa()
 
2236
 
 
2237
     call ARMCI_Sync()
 
2238
!
 
2239
! Check that recieved a is the piece of b that was sent.
 
2240
 
 
2241
     v(1:asize(6)) = reshape(a6,vshape)
 
2242
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2243
    &             lb,ub,lb,ub,joff,pass)
 
2244
     score(6) = score(6) + pass
 
2245
     if (pass .ne. 1) then
 
2246
        print *,me,': ARMCI_NbGet_fa verify for 6D R8, m = ',m,' failed'
 
2247
     endif
 
2248
     call ARMCI_Sync()
 
2249
     
 
2250
!
 
2251
! Rank 7
 
2252
!
 
2253
     rank = 7
 
2254
     vshape(1) = asize(7)
 
2255
     call ARMCI_NbGet_fa(b7, dst_slice, a7, src_slice, remote_proc, rc)
 
2256
     call ARMCI_Waitall_fa()
 
2257
 
 
2258
     call ARMCI_Sync()
 
2259
!
 
2260
! Check that recieved a is the piece of b that was sent.
 
2261
 
 
2262
     v(1:asize(7)) = reshape(a7,vshape)
 
2263
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2264
    &             lb,ub,lb,ub,joff,pass)
 
2265
     score(7) = score(7) + pass
 
2266
     if (pass .ne. 1) then
 
2267
        print *,me,': ARMCI_NbGet_fa verify for 7D R8, m = ',m,' failed'
 
2268
     endif
 
2269
     call ARMCI_Sync()
 
2270
 
 
2271
  enddo
 
2272
  if (me .eq. 0) then
 
2273
     do m = 1,7
 
2274
        if (score(m) .eq. 3) then
 
2275
           print *,' ARMCI_NbGet_fa for R8, ',m,'D passed'
 
2276
        endif
 
2277
     enddo
 
2278
  endif
 
2279
!
 
2280
! Free v, a and b arrays.
 
2281
!
 
2282
  call ARMCI_Sync()
 
2283
  call ARMCI_Free_fa(v, rc)
 
2284
  call ARMCI_Free_fa(a1, rc)
 
2285
  call ARMCI_Free_fa(b1, rc)
 
2286
  call ARMCI_Free_fa(a2, rc)
 
2287
  call ARMCI_Free_fa(b2, rc)
 
2288
  call ARMCI_Free_fa(a3, rc)
 
2289
  call ARMCI_Free_fa(b3, rc)
 
2290
  call ARMCI_Free_fa(a4, rc)
 
2291
  call ARMCI_Free_fa(b4, rc)
 
2292
  call ARMCI_Free_fa(a5, rc)
 
2293
  call ARMCI_Free_fa(b5, rc)
 
2294
  call ARMCI_Free_fa(a6, rc)
 
2295
  call ARMCI_Free_fa(b6, rc)
 
2296
  call ARMCI_Free_fa(a7, rc)
 
2297
  call ARMCI_Free_fa(b7, rc)
 
2298
  call ARMCI_Sync()
 
2299
  return
 
2300
endsubroutine
 
2301
 
 
2302
subroutine testanb_c4(nproc,me,remote_proc)
 
2303
  use definekind
 
2304
  use armci_types
 
2305
  use armci_mem_f90
 
2306
  use armci_nbmov
 
2307
  use testa_init
 
2308
  use checkput
 
2309
  implicit none
 
2310
  type(ARMCI_slice) :: src_slice, dst_slice
 
2311
  integer :: nproc,me,remote_proc
 
2312
  complex(kind=C4), pointer :: a7(:,:,:,:,:,:,:), b7(:,:,:,:,:,:,:)
 
2313
  complex(kind=C4), pointer :: a6(:,:,:,:,:,:),   b6(:,:,:,:,:,:)
 
2314
  complex(kind=C4), pointer :: a5(:,:,:,:,:),     b5(:,:,:,:,:)
 
2315
  complex(kind=C4), pointer :: a4(:,:,:,:),       b4(:,:,:,:)
 
2316
  complex(kind=C4), pointer :: a3(:,:,:),         b3(:,:,:)
 
2317
  complex(kind=C4), pointer :: a2(:,:),           b2(:,:)
 
2318
  complex(kind=C4), pointer :: a1(:),             b1(:)
 
2319
  complex(kind=C4), pointer :: v(:)
 
2320
 
 
2321
  integer :: lb(7), ub(7), rc, i, j
 
2322
  integer :: pass
 
2323
  integer :: myunit
 
2324
  integer :: m
 
2325
  integer :: rank
 
2326
  integer :: joff
 
2327
  integer :: vshape(1)
 
2328
  integer :: extent(7)
 
2329
  integer :: asize(7)
 
2330
  integer :: score(7)
 
2331
  integer :: vlb(1),vub(1)
 
2332
  integer :: afirst,bfirst
 
2333
 
 
2334
  afirst = 1+me
 
2335
  bfirst = afirst*afirst
 
2336
 
 
2337
  lb(:) = 1
 
2338
  ub(:) = 7
 
2339
 
 
2340
  extent(:) = 1
 
2341
  extent(:) = extent(:) + ub(:) - lb(:)
 
2342
  asize(1) = extent(1)
 
2343
  do m= 2,7
 
2344
     asize(m) = asize(m-1)*extent(m)
 
2345
  enddo
 
2346
 
 
2347
! Test C4 flavor.
 
2348
  vlb(1) = 1
 
2349
  vub(1) = asize(7)
 
2350
  call ARMCI_Malloc_fa(v,vlb,vub,rc)
 
2351
  if (rc .ne. 0) then
 
2352
     print *,' ARMCI_Malloc_fa for v failed rc = ',rc
 
2353
     stop
 
2354
  endif
 
2355
 
 
2356
  call ARMCI_Malloc_fa(a7, lb, ub, rc)
 
2357
  if (rc .ne. 0) then
 
2358
     print *,' ARMCI_Malloc_fa for a7 failed rc = ',rc
 
2359
     stop
 
2360
  endif
 
2361
 
 
2362
  call ARMCI_Malloc_fa(b7, lb, ub, rc)
 
2363
  if (rc .ne. 0) then
 
2364
     print *,' ARMCI_Malloc_fa for b7 failed rc = ',rc
 
2365
     stop
 
2366
  endif
 
2367
 
 
2368
  call ARMCI_Malloc_fa(a6, lb, ub, rc)
 
2369
  if (rc .ne. 0) then
 
2370
     print *,' ARMCI_Malloc_fa for a6 failed rc = ',rc
 
2371
     stop
 
2372
  endif
 
2373
 
 
2374
  call ARMCI_Malloc_fa(b6, lb, ub, rc)
 
2375
  if (rc .ne. 0) then
 
2376
     print *,' ARMCI_Malloc_fa for b6 failed rc = ',rc
 
2377
     stop
 
2378
  endif
 
2379
 
 
2380
  call ARMCI_Malloc_fa(a5, lb, ub, rc)
 
2381
  if (rc .ne. 0) then
 
2382
     print *,' ARMCI_Malloc_fa for a5 failed rc = ',rc
 
2383
     stop
 
2384
  endif
 
2385
 
 
2386
  call ARMCI_Malloc_fa(b5, lb, ub, rc)
 
2387
  if (rc .ne. 0) then
 
2388
     print *,' ARMCI_Malloc_fa for b5 failed rc = ',rc
 
2389
     stop
 
2390
  endif
 
2391
 
 
2392
  call ARMCI_Malloc_fa(a4, lb, ub, rc)
 
2393
  if (rc .ne. 0) then
 
2394
     print *,' ARMCI_Malloc_fa for a4 failed rc = ',rc
 
2395
     stop
 
2396
  endif
 
2397
 
 
2398
  call ARMCI_Malloc_fa(b4, lb, ub, rc)
 
2399
  if (rc .ne. 0) then
 
2400
     print *,' ARMCI_Malloc_fa for b4 failed rc = ',rc
 
2401
     stop
 
2402
  endif
 
2403
 
 
2404
  call ARMCI_Malloc_fa(a3, lb, ub, rc)
 
2405
  if (rc .ne. 0) then
 
2406
     print *,' ARMCI_Malloc_fa for a3 failed rc = ',rc
 
2407
     stop
 
2408
  endif
 
2409
 
 
2410
  call ARMCI_Malloc_fa(b3, lb, ub, rc)
 
2411
  if (rc .ne. 0) then
 
2412
     print *,' ARMCI_Malloc_fa for b3 failed rc = ',rc
 
2413
     stop
 
2414
  endif
 
2415
 
 
2416
  call ARMCI_Malloc_fa(a2, lb, ub, rc)
 
2417
  if (rc .ne. 0) then
 
2418
     print *,' ARMCI_Malloc_fa for a2 failed rc = ',rc
 
2419
     stop
 
2420
  endif
 
2421
 
 
2422
  call ARMCI_Malloc_fa(b2, lb, ub, rc)
 
2423
  if (rc .ne. 0) then
 
2424
     print *,' ARMCI_Malloc_fa for b2 failed rc = ',rc
 
2425
     stop
 
2426
  endif
 
2427
 
 
2428
  call ARMCI_Malloc_fa(a1, lb, ub, rc)
 
2429
  if (rc .ne. 0) then
 
2430
     print *,' ARMCI_Malloc_fa for a1 failed rc = ',rc
 
2431
     stop
 
2432
  endif
 
2433
 
 
2434
  call ARMCI_Malloc_fa(b1, lb, ub, rc)
 
2435
  if (rc .ne. 0) then
 
2436
     print *,' ARMCI_Malloc_fa for b1 failed rc = ',rc
 
2437
     stop
 
2438
  endif
 
2439
 
 
2440
! Let all processors get alloccated.
 
2441
 
 
2442
  call ARMCI_Sync()
 
2443
 
 
2444
! C4 allocations done, now loop over slices.
 
2445
! We will test three flavors of slices,
 
2446
! all unit stride, unit stride in the first dimension only,
 
2447
! all non-unit stride (2).
 
2448
  score(:) = 0
 
2449
  joff = remote_proc + 1
 
2450
!
 
2451
! Test Put.
 
2452
!
 
2453
  do m = 1,3
 
2454
!    Initialize arrays.
 
2455
!
 
2456
     call init_7d(a7,b7,lb,ub,lb,ub,afirst,bfirst)
 
2457
     a6(:,:,:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
2458
     a5(:,:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
2459
     a4(:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
2460
     a3(:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
2461
     a2(:,:) = a7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
2462
     a1(:) = a7(lb(1):ub(1),1,1,1,1,1,1)
 
2463
     b6(:,:,:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
2464
     b5(:,:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
2465
     b4(:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
2466
     b3(:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
2467
     b2(:,:) = b7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
2468
     b1(:) = b7(lb(1):ub(1),1,1,1,1,1,1)
 
2469
 
 
2470
! Let all processors get initialized.
 
2471
 
 
2472
     call ARMCI_Sync()
 
2473
 
 
2474
! Set up slice info for the put.
 
2475
!
 
2476
! For m = 1, the slice has all unit strides.
 
2477
! For m = 2, the first dimension has a unit stride and all other
 
2478
!            dimensions have a stride of 2.
 
2479
! For m = 3, all dimensions have a stride of 2.
 
2480
!  
 
2481
     src_slice%lo(:) = 2
 
2482
     src_slice%hi(:) = 6
 
2483
     src_slice%stride(:) = (m+2)/2
 
2484
     src_slice%stride(1) = (m+1)/2
 
2485
 
 
2486
     dst_slice%lo(:) = 3
 
2487
     dst_slice%hi(:) = 7
 
2488
     dst_slice%stride(:) = (m+2)/2
 
2489
     dst_slice%stride(1) = (m+1)/2
 
2490
 
 
2491
! Rank 1.     
 
2492
     rank = 1
 
2493
     call ARMCI_NbPut_fa(a1, src_slice, b1, dst_slice, remote_proc, rc)
 
2494
     call ARMCI_Waitall_fa()
 
2495
 
 
2496
     call ARMCI_Sync()
 
2497
     if (rc .ne. 0) then
 
2498
        print *,me,': ARMCI_NbPut_fa for 1D C4, m = ',m,' failed, rc = ',rc
 
2499
     endif
 
2500
 
 
2501
! Check that received b1 is the piece of the sent a1.
 
2502
!
 
2503
     call check_b(rank,b1,dst_slice,src_slice,remote_proc, &
 
2504
    &             lb,ub,lb,ub,joff,pass)
 
2505
     score(1) = score(1) + pass
 
2506
     if (pass .ne. 1) then
 
2507
        print *,me,': ARMCI_NbPut_fa verify for 1D C4, m = ',m,' failed'
 
2508
     endif
 
2509
     call ARMCI_Sync()
 
2510
 
 
2511
! Rank 2.
 
2512
 
 
2513
     rank = 2
 
2514
     vshape(1) = asize(2)
 
2515
     call ARMCI_NbPut_fa(a2, src_slice, b2, dst_slice, remote_proc, rc)
 
2516
     call ARMCI_Waitall_fa()
 
2517
 
 
2518
     call ARMCI_Sync()
 
2519
     if (rc .ne. 0) then
 
2520
        print *,me,': ARMCI_NbPut_fa for 2D C4, m = ',m,' failed, rc = ',rc
 
2521
     endif
 
2522
 
 
2523
! Check that received b2 is the piece of the sent a2.
 
2524
!
 
2525
!     call check_b(rank,reshape(b2,vshape),dst_slice,src_slice,remote_proc, &
 
2526
!     call check_b(rank,b2,dst_slice,src_slice,remote_proc, &
 
2527
     v(1:asize(2)) = reshape(b2,vshape)
 
2528
 
 
2529
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
2530
    &             lb,ub,lb,ub,joff,pass)
 
2531
     score(2) = score(2) + pass
 
2532
     if (pass .ne. 1) then
 
2533
        print *,me,': ARMCI_NbPut_fa verify for 2D C4, m = ',m,' failed'
 
2534
     endif
 
2535
     call ARMCI_Sync()
 
2536
 
 
2537
! Rank 3.
 
2538
 
 
2539
     rank = 3
 
2540
     vshape(1) = asize(3)
 
2541
     call ARMCI_NbPut_fa(a3, src_slice, b3, dst_slice, remote_proc, rc)
 
2542
     call ARMCI_Waitall_fa()
 
2543
 
 
2544
     call ARMCI_Sync()
 
2545
     if (rc .ne. 0) then
 
2546
        print *,me,': ARMCI_NbPut_fa for 3D C4, m = ',m,' failed, rc = ',rc
 
2547
     endif
 
2548
 
 
2549
! Check that received b3 is the piece of the sent a3.
 
2550
!
 
2551
     v(1:asize(3)) = reshape(b3,vshape)
 
2552
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
2553
    &             lb,ub,lb,ub,joff,pass)
 
2554
     score(3) = score(3) + pass
 
2555
     if (pass .ne. 1) then
 
2556
        print *,me,': ARMCI_NbPut_fa verify for 3D C4, m = ',m,' failed'
 
2557
     endif
 
2558
     call ARMCI_Sync()
 
2559
 
 
2560
! Rank 4.
 
2561
 
 
2562
     rank = 4
 
2563
     vshape(1) = asize(4)
 
2564
     call ARMCI_NbPut_fa(a4, src_slice, b4, dst_slice, remote_proc, rc)
 
2565
     call ARMCI_Waitall_fa()
 
2566
 
 
2567
     call ARMCI_Sync()
 
2568
     if (rc .ne. 0) then
 
2569
        print *,me,': ARMCI_NbPut_fa for 4D C4, m = ',m,' failed, rc = ',rc
 
2570
     endif
 
2571
 
 
2572
! Check that received b4 is the piece of the sent a4.
 
2573
!
 
2574
     v(1:asize(4)) = reshape(b4,vshape)
 
2575
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
2576
    &             lb,ub,lb,ub,joff,pass)
 
2577
     score(4) = score(4) + pass
 
2578
     if (pass .ne. 1) then
 
2579
        print *,me,': ARMCI_NbPut_fa verify for 4D C4, m = ',m,' failed'
 
2580
     endif
 
2581
     call ARMCI_Sync()
 
2582
 
 
2583
! Rank 5.
 
2584
 
 
2585
     rank = 5
 
2586
     vshape(1) = asize(5)
 
2587
     call ARMCI_NbPut_fa(a5, src_slice, b5, dst_slice, remote_proc, rc)
 
2588
     call ARMCI_Waitall_fa()
 
2589
 
 
2590
     call ARMCI_Sync()
 
2591
     if (rc .ne. 0) then
 
2592
        print *,me,': ARMCI_NbPut_fa for 5D C4, m = ',m,' failed, rc = ',rc
 
2593
     endif
 
2594
 
 
2595
! Check that received b5 is the piece of the sent a5.
 
2596
!
 
2597
     v(1:asize(5)) = reshape(b5,vshape)
 
2598
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
2599
    &             lb,ub,lb,ub,joff,pass)
 
2600
     score(5) = score(5) + pass
 
2601
     if (pass .ne. 1) then
 
2602
        print *,me,': ARMCI_NbPut_fa verify for 4D C4, m = ',m,' failed'
 
2603
     endif
 
2604
     call ARMCI_Sync()
 
2605
 
 
2606
! Rank 6.
 
2607
 
 
2608
     rank = 6
 
2609
     vshape(1) = asize(6)
 
2610
     call ARMCI_NbPut_fa(a6, src_slice, b6, dst_slice, remote_proc, rc)
 
2611
     call ARMCI_Waitall_fa()
 
2612
 
 
2613
     call ARMCI_Sync()
 
2614
     if (rc .ne. 0) then
 
2615
        print *,me,': ARMCI_NbPut_fa for 6D C4, m = ',m,' failed, rc = ',rc
 
2616
     endif
 
2617
 
 
2618
! Check that received b6 is the piece of the sent a6
 
2619
!
 
2620
     v(1:asize(6)) = reshape(b6,vshape)
 
2621
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
2622
    &             lb,ub,lb,ub,joff,pass)
 
2623
     score(6) = score(6) + pass
 
2624
     if (pass .ne. 1) then
 
2625
        print *,me,': ARMCI_NbPut_fa verify for 6D C4, m = ',m,' failed'
 
2626
     endif
 
2627
     call ARMCI_Sync()
 
2628
 
 
2629
! Rank 7.
 
2630
 
 
2631
     rank = 7
 
2632
     vshape(1) = asize(7)
 
2633
     call ARMCI_NbPut_fa(a7, src_slice, b7, dst_slice, remote_proc, rc)
 
2634
     call ARMCI_Waitall_fa()
 
2635
 
 
2636
     call ARMCI_Sync()
 
2637
     if (rc .ne. 0) then
 
2638
        print *,me,': ARMCI_NbPut_fa for 7D C4, m = ',m,' failed, rc = ',rc
 
2639
     endif
 
2640
 
 
2641
! Check that received b7 is the piece of the sent a7
 
2642
!
 
2643
     v(1:asize(7)) = reshape(b7,vshape)
 
2644
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
2645
    &             lb,ub,lb,ub,joff,pass)
 
2646
     score(7) = score(7) + pass
 
2647
     if (pass .ne. 1) then
 
2648
        print *,me,': ARMCI_NbPut_fa verify for 7D C4, m = ',m,' failed'
 
2649
     endif
 
2650
     call ARMCI_Sync()
 
2651
 
 
2652
  enddo
 
2653
  if (me .eq. 0) then
 
2654
     do m = 1,7
 
2655
        if (score(m) .eq. 3) then
 
2656
           print *,' ARMCI_NbPut_fa for C4, ',m,'D passed'
 
2657
        endif
 
2658
     enddo
 
2659
  endif
 
2660
!
 
2661
! Test Get.
 
2662
!
 
2663
  score(:) = 0
 
2664
  joff = (remote_proc + 1)*(remote_proc+1)
 
2665
  do m = 1,3
 
2666
!
 
2667
!    Initialize arrays.
 
2668
!
 
2669
     call init_7d(a7,b7,lb,ub,lb,ub,afirst,bfirst)
 
2670
     a6 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
2671
     a5 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
2672
     a4 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
2673
     a3 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
2674
     a2 = a7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
2675
     a1 = a7(lb(1):ub(1),1,1,1,1,1,1)
 
2676
     b6 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
2677
     b5 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
2678
     b4 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
2679
     b3 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
2680
     b2 = b7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
2681
     b1 = b7(lb(1):ub(1),1,1,1,1,1,1)
 
2682
 
 
2683
! Let all processors get initialized.
 
2684
 
 
2685
     call ARMCI_Sync()
 
2686
 
 
2687
! Set up slice info for the get.
 
2688
!
 
2689
! For m = 1, the slice has all unit strides.
 
2690
! For m = 2, the first dimension has a unit stride and all other
 
2691
!            dimensions have a stride of 2.
 
2692
! For m = 3, all dimensions have a stride of 2.
 
2693
!  
 
2694
     src_slice%lo(:) = 2
 
2695
     src_slice%hi(:) = 6
 
2696
     src_slice%stride(:) = (m+2)/2
 
2697
     src_slice%stride(1) = (m+1)/2
 
2698
 
 
2699
     dst_slice%lo(:) = 3
 
2700
     dst_slice%hi(:) = 7
 
2701
     dst_slice%stride(:) = (m+2)/2
 
2702
     dst_slice%stride(1) = (m+1)/2
 
2703
!
 
2704
! Rank 1
 
2705
!
 
2706
     rank = 1
 
2707
     call ARMCI_NbGet_fa(b1, dst_slice, a1, src_slice, remote_proc, rc)
 
2708
     call ARMCI_Waitall_fa()
 
2709
 
 
2710
     call ARMCI_Sync()
 
2711
!
 
2712
! Check that recieved a is the piece of b that was sent.
 
2713
 
 
2714
     call check_b(rank,a1,src_slice,dst_slice,remote_proc, &
 
2715
    &             lb,ub,lb,ub,joff,pass)
 
2716
     score(1) = score(1) + pass
 
2717
     if (pass .ne. 1) then
 
2718
        print *,me,': ARMCI_NbGet_fa verify for 1D C4, m = ',m,' failed'
 
2719
     endif
 
2720
     call ARMCI_Sync()
 
2721
     
 
2722
!
 
2723
! Rank 2
 
2724
!
 
2725
     rank = 2
 
2726
     vshape(1) = asize(2)
 
2727
     call ARMCI_NbGet_fa(b2, dst_slice, a2, src_slice, remote_proc, rc)
 
2728
     call ARMCI_Waitall_fa()
 
2729
 
 
2730
     call ARMCI_Sync()
 
2731
!
 
2732
! Check that recieved a is the piece of b that was sent.
 
2733
 
 
2734
     v(1:asize(2)) = reshape(a2,vshape)
 
2735
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2736
    &             lb,ub,lb,ub,joff,pass)
 
2737
     score(2) = score(2) + pass
 
2738
     if (pass .ne. 1) then
 
2739
        print *,me,': ARMCI_NbGet_fa verify for 2D C4, m = ',m,' failed'
 
2740
     endif
 
2741
     call ARMCI_Sync()
 
2742
     
 
2743
!
 
2744
! Rank 3
 
2745
!
 
2746
     rank = 3
 
2747
     vshape(1) = asize(3)
 
2748
     call ARMCI_NbGet_fa(b3, dst_slice, a3, src_slice, remote_proc, rc)
 
2749
     call ARMCI_Waitall_fa()
 
2750
 
 
2751
     call ARMCI_Sync()
 
2752
!
 
2753
! Check that recieved a is the piece of b that was sent.
 
2754
 
 
2755
     v(1:asize(3)) = reshape(a3,vshape)
 
2756
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2757
    &             lb,ub,lb,ub,joff,pass)
 
2758
     score(3) = score(3) + pass
 
2759
     if (pass .ne. 1) then
 
2760
        print *,me,': ARMCI_NbGet_fa verify for 3D C4, m = ',m,' failed'
 
2761
     endif
 
2762
     call ARMCI_Sync()
 
2763
     
 
2764
!
 
2765
! Rank 4
 
2766
!
 
2767
     rank = 4
 
2768
     vshape(1) = asize(4)
 
2769
     call ARMCI_NbGet_fa(b4, dst_slice, a4, src_slice, remote_proc, rc)
 
2770
     call ARMCI_Waitall_fa()
 
2771
 
 
2772
     call ARMCI_Sync()
 
2773
!
 
2774
! Check that recieved a is the piece of b that was sent.
 
2775
 
 
2776
     v(1:asize(4)) = reshape(a4,vshape)
 
2777
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2778
    &             lb,ub,lb,ub,joff,pass)
 
2779
     score(4) = score(4) + pass
 
2780
     if (pass .ne. 1) then
 
2781
        print *,me,': ARMCI_NbGet_fa verify for 4D C4, m = ',m,' failed'
 
2782
     endif
 
2783
     call ARMCI_Sync()
 
2784
     
 
2785
!
 
2786
! Rank 5
 
2787
!
 
2788
     rank = 5
 
2789
     vshape(1) = asize(5)
 
2790
     call ARMCI_NbGet_fa(b5, dst_slice, a5, src_slice, remote_proc, rc)
 
2791
     call ARMCI_Waitall_fa()
 
2792
 
 
2793
     call ARMCI_Sync()
 
2794
!
 
2795
! Check that recieved a is the piece of b that was sent.
 
2796
 
 
2797
     v(1:asize(5)) = reshape(a5,vshape)
 
2798
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2799
    &             lb,ub,lb,ub,joff,pass)
 
2800
     score(5) = score(5) + pass
 
2801
     if (pass .ne. 1) then
 
2802
        print *,me,': ARMCI_NbGet_fa verify for 5D C4, m = ',m,' failed'
 
2803
     endif
 
2804
     call ARMCI_Sync()
 
2805
     
 
2806
!
 
2807
! Rank 6
 
2808
!
 
2809
     rank = 6
 
2810
     vshape(1) = asize(6)
 
2811
     call ARMCI_NbGet_fa(b6, dst_slice, a6, src_slice, remote_proc, rc)
 
2812
     call ARMCI_Waitall_fa()
 
2813
 
 
2814
     call ARMCI_Sync()
 
2815
!
 
2816
! Check that recieved a is the piece of b that was sent.
 
2817
 
 
2818
     v(1:asize(6)) = reshape(a6,vshape)
 
2819
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2820
    &             lb,ub,lb,ub,joff,pass)
 
2821
     score(6) = score(6) + pass
 
2822
     if (pass .ne. 1) then
 
2823
        print *,me,': ARMCI_NbGet_fa verify for 6D C4, m = ',m,' failed'
 
2824
     endif
 
2825
     call ARMCI_Sync()
 
2826
     
 
2827
!
 
2828
! Rank 7
 
2829
!
 
2830
     rank = 7
 
2831
     vshape(1) = asize(7)
 
2832
     call ARMCI_NbGet_fa(b7, dst_slice, a7, src_slice, remote_proc, rc)
 
2833
     call ARMCI_Waitall_fa()
 
2834
 
 
2835
     call ARMCI_Sync()
 
2836
!
 
2837
! Check that recieved a is the piece of b that was sent.
 
2838
 
 
2839
     v(1:asize(7)) = reshape(a7,vshape)
 
2840
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
2841
    &             lb,ub,lb,ub,joff,pass)
 
2842
     score(7) = score(7) + pass
 
2843
     if (pass .ne. 1) then
 
2844
        print *,me,': ARMCI_NbGet_fa verify for 7D C4, m = ',m,' failed'
 
2845
     endif
 
2846
     call ARMCI_Sync()
 
2847
 
 
2848
  enddo
 
2849
  if (me .eq. 0) then
 
2850
     do m = 1,7
 
2851
        if (score(m) .eq. 3) then
 
2852
           print *,' ARMCI_NbGet_fa for C4, ',m,'D passed'
 
2853
        endif
 
2854
     enddo
 
2855
  endif
 
2856
!
 
2857
! Free v, a and b arrays.
 
2858
!
 
2859
  call ARMCI_Sync()
 
2860
  call ARMCI_Free_fa(v, rc)
 
2861
  call ARMCI_Free_fa(a1, rc)
 
2862
  call ARMCI_Free_fa(b1, rc)
 
2863
  call ARMCI_Free_fa(a2, rc)
 
2864
  call ARMCI_Free_fa(b2, rc)
 
2865
  call ARMCI_Free_fa(a3, rc)
 
2866
  call ARMCI_Free_fa(b3, rc)
 
2867
  call ARMCI_Free_fa(a4, rc)
 
2868
  call ARMCI_Free_fa(b4, rc)
 
2869
  call ARMCI_Free_fa(a5, rc)
 
2870
  call ARMCI_Free_fa(b5, rc)
 
2871
  call ARMCI_Free_fa(a6, rc)
 
2872
  call ARMCI_Free_fa(b6, rc)
 
2873
  call ARMCI_Free_fa(a7, rc)
 
2874
  call ARMCI_Free_fa(b7, rc)
 
2875
  call ARMCI_Sync()
 
2876
  return
 
2877
endsubroutine
 
2878
 
 
2879
subroutine testanb_c8(nproc,me,remote_proc)
 
2880
  use definekind
 
2881
  use armci_types
 
2882
  use armci_mem_f90
 
2883
  use armci_nbmov
 
2884
  use testa_init
 
2885
  use checkput
 
2886
  implicit none
 
2887
  type(ARMCI_slice) :: src_slice, dst_slice
 
2888
  integer :: nproc,me,remote_proc
 
2889
  complex(kind=C8), pointer :: a7(:,:,:,:,:,:,:), b7(:,:,:,:,:,:,:)
 
2890
  complex(kind=C8), pointer :: a6(:,:,:,:,:,:),   b6(:,:,:,:,:,:)
 
2891
  complex(kind=C8), pointer :: a5(:,:,:,:,:),     b5(:,:,:,:,:)
 
2892
  complex(kind=C8), pointer :: a4(:,:,:,:),       b4(:,:,:,:)
 
2893
  complex(kind=C8), pointer :: a3(:,:,:),         b3(:,:,:)
 
2894
  complex(kind=C8), pointer :: a2(:,:),           b2(:,:)
 
2895
  complex(kind=C8), pointer :: a1(:),             b1(:)
 
2896
  complex(kind=C8), pointer :: v(:)
 
2897
 
 
2898
  integer :: lb(7), ub(7), rc, i, j
 
2899
  integer :: pass
 
2900
  integer :: myunit
 
2901
  integer :: m
 
2902
  integer :: rank
 
2903
  integer :: joff
 
2904
  integer :: vshape(1)
 
2905
  integer :: extent(7)
 
2906
  integer :: asize(7)
 
2907
  integer :: score(7)
 
2908
  integer :: vlb(1),vub(1)
 
2909
  integer :: afirst,bfirst
 
2910
 
 
2911
  afirst = 1+me
 
2912
  bfirst = afirst*afirst
 
2913
 
 
2914
  lb(:) = 1
 
2915
  ub(:) = 7
 
2916
  ub(7) = 3
 
2917
 
 
2918
  extent(:) = 1
 
2919
  extent(:) = extent(:) + ub(:) - lb(:)
 
2920
  asize(1) = extent(1)
 
2921
  do m= 2,7
 
2922
     asize(m) = asize(m-1)*extent(m)
 
2923
  enddo
 
2924
 
 
2925
! Test C8 flavor.
 
2926
  vlb(1) = 1
 
2927
  vub(1) = asize(7)
 
2928
  call ARMCI_Malloc_fa(v,vlb,vub,rc)
 
2929
  if (rc .ne. 0) then
 
2930
     print *,' ARMCI_Malloc_fa for v failed rc = ',rc
 
2931
     stop
 
2932
  endif
 
2933
 
 
2934
  call ARMCI_Malloc_fa(a7, lb, ub, rc)
 
2935
  if (rc .ne. 0) then
 
2936
     print *,' ARMCI_Malloc_fa for a7 failed rc = ',rc
 
2937
     stop
 
2938
  endif
 
2939
 
 
2940
  call ARMCI_Malloc_fa(b7, lb, ub, rc)
 
2941
  if (rc .ne. 0) then
 
2942
     print *,' ARMCI_Malloc_fa for b7 failed rc = ',rc
 
2943
     stop
 
2944
  endif
 
2945
 
 
2946
  call ARMCI_Malloc_fa(a6, lb, ub, rc)
 
2947
  if (rc .ne. 0) then
 
2948
     print *,' ARMCI_Malloc_fa for a6 failed rc = ',rc
 
2949
     stop
 
2950
  endif
 
2951
 
 
2952
  call ARMCI_Malloc_fa(b6, lb, ub, rc)
 
2953
  if (rc .ne. 0) then
 
2954
     print *,' ARMCI_Malloc_fa for b6 failed rc = ',rc
 
2955
     stop
 
2956
  endif
 
2957
 
 
2958
  call ARMCI_Malloc_fa(a5, lb, ub, rc)
 
2959
  if (rc .ne. 0) then
 
2960
     print *,' ARMCI_Malloc_fa for a5 failed rc = ',rc
 
2961
     stop
 
2962
  endif
 
2963
 
 
2964
  call ARMCI_Malloc_fa(b5, lb, ub, rc)
 
2965
  if (rc .ne. 0) then
 
2966
     print *,' ARMCI_Malloc_fa for b5 failed rc = ',rc
 
2967
     stop
 
2968
  endif
 
2969
 
 
2970
  call ARMCI_Malloc_fa(a4, lb, ub, rc)
 
2971
  if (rc .ne. 0) then
 
2972
     print *,' ARMCI_Malloc_fa for a4 failed rc = ',rc
 
2973
     stop
 
2974
  endif
 
2975
 
 
2976
  call ARMCI_Malloc_fa(b4, lb, ub, rc)
 
2977
  if (rc .ne. 0) then
 
2978
     print *,' ARMCI_Malloc_fa for b4 failed rc = ',rc
 
2979
     stop
 
2980
  endif
 
2981
 
 
2982
  call ARMCI_Malloc_fa(a3, lb, ub, rc)
 
2983
  if (rc .ne. 0) then
 
2984
     print *,' ARMCI_Malloc_fa for a3 failed rc = ',rc
 
2985
     stop
 
2986
  endif
 
2987
 
 
2988
  call ARMCI_Malloc_fa(b3, lb, ub, rc)
 
2989
  if (rc .ne. 0) then
 
2990
     print *,' ARMCI_Malloc_fa for b3 failed rc = ',rc
 
2991
     stop
 
2992
  endif
 
2993
 
 
2994
  call ARMCI_Malloc_fa(a2, lb, ub, rc)
 
2995
  if (rc .ne. 0) then
 
2996
     print *,' ARMCI_Malloc_fa for a2 failed rc = ',rc
 
2997
     stop
 
2998
  endif
 
2999
 
 
3000
  call ARMCI_Malloc_fa(b2, lb, ub, rc)
 
3001
  if (rc .ne. 0) then
 
3002
     print *,' ARMCI_Malloc_fa for b2 failed rc = ',rc
 
3003
     stop
 
3004
  endif
 
3005
 
 
3006
  call ARMCI_Malloc_fa(a1, lb, ub, rc)
 
3007
  if (rc .ne. 0) then
 
3008
     print *,' ARMCI_Malloc_fa for a1 failed rc = ',rc
 
3009
     stop
 
3010
  endif
 
3011
 
 
3012
  call ARMCI_Malloc_fa(b1, lb, ub, rc)
 
3013
  if (rc .ne. 0) then
 
3014
     print *,' ARMCI_Malloc_fa for b1 failed rc = ',rc
 
3015
     stop
 
3016
  endif
 
3017
 
 
3018
! Let all processors get alloccated.
 
3019
 
 
3020
  call ARMCI_Sync()
 
3021
 
 
3022
! C8 allocations done, now loop over slices.
 
3023
! We will test three flavors of slices,
 
3024
! all unit stride, unit stride in the first dimension only,
 
3025
! all non-unit stride (2).
 
3026
  score(:) = 0
 
3027
  joff = remote_proc + 1
 
3028
!
 
3029
! Test Put.
 
3030
!
 
3031
  do m = 1,3
 
3032
!    Initialize arrays.
 
3033
!
 
3034
     call init_7d(a7,b7,lb,ub,lb,ub,afirst,bfirst)
 
3035
     a6(:,:,:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
3036
     a5(:,:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
3037
     a4(:,:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
3038
     a3(:,:,:) = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
3039
     a2(:,:) = a7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
3040
     a1(:) = a7(lb(1):ub(1),1,1,1,1,1,1)
 
3041
     b6(:,:,:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
3042
     b5(:,:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
3043
     b4(:,:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
3044
     b3(:,:,:) = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
3045
     b2(:,:) = b7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
3046
     b1(:) = b7(lb(1):ub(1),1,1,1,1,1,1)
 
3047
 
 
3048
! Let all processors get initialized.
 
3049
 
 
3050
     call ARMCI_Sync()
 
3051
 
 
3052
! Set up slice info for the put.
 
3053
!
 
3054
! For m = 1, the slice has all unit strides.
 
3055
! For m = 2, the first dimension has a unit stride and all other
 
3056
!            dimensions have a stride of 2.
 
3057
! For m = 3, all dimensions have a stride of 2.
 
3058
!  
 
3059
     src_slice%lo(:) = 2
 
3060
     src_slice%hi(:) = 6
 
3061
     src_slice%lo(7) = 1
 
3062
     src_slice%hi(7) = 2
 
3063
     src_slice%stride(:) = (m+2)/2
 
3064
     src_slice%stride(1) = (m+1)/2
 
3065
 
 
3066
     dst_slice%lo(:) = 3
 
3067
     dst_slice%hi(:) = 7
 
3068
     dst_slice%lo(7) = 2
 
3069
     dst_slice%hi(7) = 3
 
3070
     dst_slice%stride(:) = (m+2)/2
 
3071
     dst_slice%stride(1) = (m+1)/2
 
3072
 
 
3073
! Rank 1.     
 
3074
     rank = 1
 
3075
     call ARMCI_NbPut_fa(a1, src_slice, b1, dst_slice, remote_proc, rc)
 
3076
     call ARMCI_Waitall_fa()
 
3077
 
 
3078
     call ARMCI_Sync()
 
3079
     if (rc .ne. 0) then
 
3080
        print *,me,': ARMCI_NbPut_fa for 1D C8, m = ',m,' failed, rc = ',rc
 
3081
     endif
 
3082
 
 
3083
! Check that received b1 is the piece of the sent a1.
 
3084
!
 
3085
     call check_b(rank,b1,dst_slice,src_slice,remote_proc, &
 
3086
    &             lb,ub,lb,ub,joff,pass)
 
3087
     score(1) = score(1) + pass
 
3088
     if (pass .ne. 1) then
 
3089
        print *,me,': ARMCI_NbPut_fa verify for 1D C8, m = ',m,' failed'
 
3090
     endif
 
3091
     call ARMCI_Sync()
 
3092
 
 
3093
! Rank 2.
 
3094
 
 
3095
     rank = 2
 
3096
     vshape(1) = asize(2)
 
3097
     call ARMCI_NbPut_fa(a2, src_slice, b2, dst_slice, remote_proc, rc)
 
3098
     call ARMCI_Waitall_fa()
 
3099
 
 
3100
     call ARMCI_Sync()
 
3101
     if (rc .ne. 0) then
 
3102
        print *,me,': ARMCI_NbPut_fa for 2D C8, m = ',m,' failed, rc = ',rc
 
3103
     endif
 
3104
 
 
3105
! Check that received b2 is the piece of the sent a2.
 
3106
!
 
3107
!     call check_b(rank,reshape(b2,vshape),dst_slice,src_slice,remote_proc, &
 
3108
!     call check_b(rank,b2,dst_slice,src_slice,remote_proc, &
 
3109
     v(1:asize(2)) = reshape(b2,vshape)
 
3110
 
 
3111
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
3112
    &             lb,ub,lb,ub,joff,pass)
 
3113
     score(2) = score(2) + pass
 
3114
     if (pass .ne. 1) then
 
3115
        print *,me,': ARMCI_NbPut_fa verify for 2D C8, m = ',m,' failed'
 
3116
     endif
 
3117
     call ARMCI_Sync()
 
3118
 
 
3119
! Rank 3.
 
3120
 
 
3121
     rank = 3
 
3122
     vshape(1) = asize(3)
 
3123
     call ARMCI_NbPut_fa(a3, src_slice, b3, dst_slice, remote_proc, rc)
 
3124
     call ARMCI_Waitall_fa()
 
3125
 
 
3126
     call ARMCI_Sync()
 
3127
     if (rc .ne. 0) then
 
3128
        print *,me,': ARMCI_NbPut_fa for 3D C8, m = ',m,' failed, rc = ',rc
 
3129
     endif
 
3130
 
 
3131
! Check that received b3 is the piece of the sent a3.
 
3132
!
 
3133
     v(1:asize(3)) = reshape(b3,vshape)
 
3134
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
3135
    &             lb,ub,lb,ub,joff,pass)
 
3136
     score(3) = score(3) + pass
 
3137
     if (pass .ne. 1) then
 
3138
        print *,me,': ARMCI_NbPut_fa verify for 3D C8, m = ',m,' failed'
 
3139
     endif
 
3140
     call ARMCI_Sync()
 
3141
 
 
3142
! Rank 4.
 
3143
 
 
3144
     rank = 4
 
3145
     vshape(1) = asize(4)
 
3146
     call ARMCI_NbPut_fa(a4, src_slice, b4, dst_slice, remote_proc, rc)
 
3147
     call ARMCI_Waitall_fa()
 
3148
 
 
3149
     call ARMCI_Sync()
 
3150
     if (rc .ne. 0) then
 
3151
        print *,me,': ARMCI_NbPut_fa for 4D C8, m = ',m,' failed, rc = ',rc
 
3152
     endif
 
3153
 
 
3154
! Check that received b4 is the piece of the sent a4.
 
3155
!
 
3156
     v(1:asize(4)) = reshape(b4,vshape)
 
3157
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
3158
    &             lb,ub,lb,ub,joff,pass)
 
3159
     score(4) = score(4) + pass
 
3160
     if (pass .ne. 1) then
 
3161
        print *,me,': ARMCI_NbPut_fa verify for 4D C8, m = ',m,' failed'
 
3162
     endif
 
3163
     call ARMCI_Sync()
 
3164
 
 
3165
! Rank 5.
 
3166
 
 
3167
     rank = 5
 
3168
     vshape(1) = asize(5)
 
3169
     call ARMCI_NbPut_fa(a5, src_slice, b5, dst_slice, remote_proc, rc)
 
3170
     call ARMCI_Waitall_fa()
 
3171
 
 
3172
     call ARMCI_Sync()
 
3173
     if (rc .ne. 0) then
 
3174
        print *,me,': ARMCI_NbPut_fa for 5D C8, m = ',m,' failed, rc = ',rc
 
3175
     endif
 
3176
 
 
3177
! Check that received b5 is the piece of the sent a5.
 
3178
!
 
3179
     v(1:asize(5)) = reshape(b5,vshape)
 
3180
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
3181
    &             lb,ub,lb,ub,joff,pass)
 
3182
     score(5) = score(5) + pass
 
3183
     if (pass .ne. 1) then
 
3184
        print *,me,': ARMCI_NbPut_fa verify for 4D C8, m = ',m,' failed'
 
3185
     endif
 
3186
     call ARMCI_Sync()
 
3187
 
 
3188
! Rank 6.
 
3189
 
 
3190
     rank = 6
 
3191
     vshape(1) = asize(6)
 
3192
     call ARMCI_NbPut_fa(a6, src_slice, b6, dst_slice, remote_proc, rc)
 
3193
     call ARMCI_Waitall_fa()
 
3194
 
 
3195
     call ARMCI_Sync()
 
3196
     if (rc .ne. 0) then
 
3197
        print *,me,': ARMCI_NbPut_fa for 6D C8, m = ',m,' failed, rc = ',rc
 
3198
     endif
 
3199
 
 
3200
! Check that received b6 is the piece of the sent a6
 
3201
!
 
3202
     v(1:asize(6)) = reshape(b6,vshape)
 
3203
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
3204
    &             lb,ub,lb,ub,joff,pass)
 
3205
     score(6) = score(6) + pass
 
3206
     if (pass .ne. 1) then
 
3207
        print *,me,': ARMCI_NbPut_fa verify for 6D C8, m = ',m,' failed'
 
3208
     endif
 
3209
     call ARMCI_Sync()
 
3210
 
 
3211
! Rank 7.
 
3212
 
 
3213
     rank = 7
 
3214
     vshape(1) = asize(7)
 
3215
     call ARMCI_NbPut_fa(a7, src_slice, b7, dst_slice, remote_proc, rc)
 
3216
     call ARMCI_Waitall_fa()
 
3217
 
 
3218
     call ARMCI_Sync()
 
3219
     if (rc .ne. 0) then
 
3220
        print *,me,': ARMCI_NbPut_fa for 7D C8, m = ',m,' failed, rc = ',rc
 
3221
     endif
 
3222
 
 
3223
! Check that received b7 is the piece of the sent a7
 
3224
!
 
3225
     v(1:asize(7)) = reshape(b7,vshape)
 
3226
     call check_b(rank,v,dst_slice,src_slice,remote_proc, &
 
3227
    &             lb,ub,lb,ub,joff,pass)
 
3228
     score(7) = score(7) + pass
 
3229
     if (pass .ne. 1) then
 
3230
        print *,me,': ARMCI_NbPut_fa verify for 7D C8, m = ',m,' failed'
 
3231
     endif
 
3232
     call ARMCI_Sync()
 
3233
 
 
3234
  enddo
 
3235
  if (me .eq. 0) then
 
3236
     do m = 1,7
 
3237
        if (score(m) .eq. 3) then
 
3238
           print *,' ARMCI_NbPut_fa for C8, ',m,'D passed'
 
3239
        endif
 
3240
     enddo
 
3241
  endif
 
3242
!
 
3243
! Test Get.
 
3244
!
 
3245
  score(:) = 0
 
3246
  joff = (remote_proc + 1)*(remote_proc+1)
 
3247
  do m = 1,3
 
3248
!
 
3249
!    Initialize arrays.
 
3250
!
 
3251
     call init_7d(a7,b7,lb,ub,lb,ub,afirst,bfirst)
 
3252
     a6 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
3253
     a5 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
3254
     a4 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
3255
     a3 = a7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
3256
     a2 = a7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
3257
     a1 = a7(lb(1):ub(1),1,1,1,1,1,1)
 
3258
     b6 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6),1)
 
3259
     b5 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),1,1)
 
3260
     b4 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),1,1,1)
 
3261
     b3 = b7(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),1,1,1,1)
 
3262
     b2 = b7(lb(1):ub(1),lb(2):ub(2),1,1,1,1,1)
 
3263
     b1 = b7(lb(1):ub(1),1,1,1,1,1,1)
 
3264
 
 
3265
! Let all processors get initialized.
 
3266
 
 
3267
     call ARMCI_Sync()
 
3268
 
 
3269
! Set up slice info for the get.
 
3270
!
 
3271
! For m = 1, the slice has all unit strides.
 
3272
! For m = 2, the first dimension has a unit stride and all other
 
3273
!            dimensions have a stride of 2.
 
3274
! For m = 3, all dimensions have a stride of 2.
 
3275
!  
 
3276
     src_slice%lo(:) = 2
 
3277
     src_slice%hi(:) = 6
 
3278
     src_slice%lo(7) = 1
 
3279
     src_slice%hi(7) = 2
 
3280
     src_slice%stride(:) = (m+2)/2
 
3281
     src_slice%stride(1) = (m+1)/2
 
3282
 
 
3283
     dst_slice%lo(:) = 3
 
3284
     dst_slice%hi(:) = 7
 
3285
     dst_slice%lo(7) = 2
 
3286
     dst_slice%hi(7) = 3
 
3287
     dst_slice%stride(:) = (m+2)/2
 
3288
     dst_slice%stride(1) = (m+1)/2
 
3289
!
 
3290
! Rank 1
 
3291
!
 
3292
     rank = 1
 
3293
     call ARMCI_NbGet_fa(b1, dst_slice, a1, src_slice, remote_proc, rc)
 
3294
     call ARMCI_Waitall_fa()
 
3295
 
 
3296
     call ARMCI_Sync()
 
3297
!
 
3298
! Check that recieved a is the piece of b that was sent.
 
3299
 
 
3300
     call check_b(rank,a1,src_slice,dst_slice,remote_proc, &
 
3301
    &             lb,ub,lb,ub,joff,pass)
 
3302
     score(1) = score(1) + pass
 
3303
     if (pass .ne. 1) then
 
3304
        print *,me,': ARMCI_NbGet_fa verify for 1D C8, m = ',m,' failed'
 
3305
     endif
 
3306
     call ARMCI_Sync()
 
3307
     
 
3308
!
 
3309
! Rank 2
 
3310
!
 
3311
     rank = 2
 
3312
     vshape(1) = asize(2)
 
3313
     call ARMCI_NbGet_fa(b2, dst_slice, a2, src_slice, remote_proc, rc)
 
3314
     call ARMCI_Waitall_fa()
 
3315
 
 
3316
     call ARMCI_Sync()
 
3317
!
 
3318
! Check that recieved a is the piece of b that was sent.
 
3319
 
 
3320
     v(1:asize(2)) = reshape(a2,vshape)
 
3321
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
3322
    &             lb,ub,lb,ub,joff,pass)
 
3323
     score(2) = score(2) + pass
 
3324
     if (pass .ne. 1) then
 
3325
        print *,me,': ARMCI_NbGet_fa verify for 2D C8, m = ',m,' failed'
 
3326
     endif
 
3327
     call ARMCI_Sync()
 
3328
     
 
3329
!
 
3330
! Rank 3
 
3331
!
 
3332
     rank = 3
 
3333
     vshape(1) = asize(3)
 
3334
     call ARMCI_NbGet_fa(b3, dst_slice, a3, src_slice, remote_proc, rc)
 
3335
     call ARMCI_Waitall_fa()
 
3336
 
 
3337
     call ARMCI_Sync()
 
3338
!
 
3339
! Check that recieved a is the piece of b that was sent.
 
3340
 
 
3341
     v(1:asize(3)) = reshape(a3,vshape)
 
3342
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
3343
    &             lb,ub,lb,ub,joff,pass)
 
3344
     score(3) = score(3) + pass
 
3345
     if (pass .ne. 1) then
 
3346
        print *,me,': ARMCI_NbGet_fa verify for 3D C8, m = ',m,' failed'
 
3347
     endif
 
3348
     call ARMCI_Sync()
 
3349
     
 
3350
!
 
3351
! Rank 4
 
3352
!
 
3353
     rank = 4
 
3354
     vshape(1) = asize(4)
 
3355
     call ARMCI_NbGet_fa(b4, dst_slice, a4, src_slice, remote_proc, rc)
 
3356
     call ARMCI_Waitall_fa()
 
3357
 
 
3358
     call ARMCI_Sync()
 
3359
!
 
3360
! Check that recieved a is the piece of b that was sent.
 
3361
 
 
3362
     v(1:asize(4)) = reshape(a4,vshape)
 
3363
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
3364
    &             lb,ub,lb,ub,joff,pass)
 
3365
     score(4) = score(4) + pass
 
3366
     if (pass .ne. 1) then
 
3367
        print *,me,': ARMCI_NbGet_fa verify for 4D C8, m = ',m,' failed'
 
3368
     endif
 
3369
     call ARMCI_Sync()
 
3370
     
 
3371
!
 
3372
! Rank 5
 
3373
!
 
3374
     rank = 5
 
3375
     vshape(1) = asize(5)
 
3376
     call ARMCI_NbGet_fa(b5, dst_slice, a5, src_slice, remote_proc, rc)
 
3377
     call ARMCI_Waitall_fa()
 
3378
 
 
3379
     call ARMCI_Sync()
 
3380
!
 
3381
! Check that recieved a is the piece of b that was sent.
 
3382
 
 
3383
     v(1:asize(5)) = reshape(a5,vshape)
 
3384
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
3385
    &             lb,ub,lb,ub,joff,pass)
 
3386
     score(5) = score(5) + pass
 
3387
     if (pass .ne. 1) then
 
3388
        print *,me,': ARMCI_NbGet_fa verify for 5D C8, m = ',m,' failed'
 
3389
     endif
 
3390
     call ARMCI_Sync()
 
3391
     
 
3392
!
 
3393
! Rank 6
 
3394
!
 
3395
     rank = 6
 
3396
     vshape(1) = asize(6)
 
3397
     call ARMCI_NbGet_fa(b6, dst_slice, a6, src_slice, remote_proc, rc)
 
3398
     call ARMCI_Waitall_fa()
 
3399
 
 
3400
     call ARMCI_Sync()
 
3401
!
 
3402
! Check that recieved a is the piece of b that was sent.
 
3403
 
 
3404
     v(1:asize(6)) = reshape(a6,vshape)
 
3405
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
3406
    &             lb,ub,lb,ub,joff,pass)
 
3407
     score(6) = score(6) + pass
 
3408
     if (pass .ne. 1) then
 
3409
        print *,me,': ARMCI_NbGet_fa verify for 6D C8, m = ',m,' failed'
 
3410
     endif
 
3411
     call ARMCI_Sync()
 
3412
     
 
3413
!
 
3414
! Rank 7
 
3415
!
 
3416
     rank = 7
 
3417
     vshape(1) = asize(7)
 
3418
     call ARMCI_NbGet_fa(b7, dst_slice, a7, src_slice, remote_proc, rc)
 
3419
     call ARMCI_Waitall_fa()
 
3420
 
 
3421
     call ARMCI_Sync()
 
3422
!
 
3423
! Check that recieved a is the piece of b that was sent.
 
3424
 
 
3425
     v(1:asize(7)) = reshape(a7,vshape)
 
3426
     call check_b(rank,v,src_slice,dst_slice,remote_proc, &
 
3427
    &             lb,ub,lb,ub,joff,pass)
 
3428
     score(7) = score(7) + pass
 
3429
     if (pass .ne. 1) then
 
3430
        print *,me,': ARMCI_NbGet_fa verify for 7D C8, m = ',m,' failed'
 
3431
     endif
 
3432
     call ARMCI_Sync()
 
3433
 
 
3434
  enddo
 
3435
  if (me .eq. 0) then
 
3436
     do m = 1,7
 
3437
        if (score(m) .eq. 3) then
 
3438
           print *,' ARMCI_NbGet_fa for C8, ',m,'D passed'
 
3439
        endif
 
3440
     enddo
 
3441
  endif
 
3442
!
 
3443
! Free v, a and b arrays.
 
3444
!
 
3445
  call ARMCI_Sync()
 
3446
  call ARMCI_Free_fa(v, rc)
 
3447
  call ARMCI_Free_fa(a1, rc)
 
3448
  call ARMCI_Free_fa(b1, rc)
 
3449
  call ARMCI_Free_fa(a2, rc)
 
3450
  call ARMCI_Free_fa(b2, rc)
 
3451
  call ARMCI_Free_fa(a3, rc)
 
3452
  call ARMCI_Free_fa(b3, rc)
 
3453
  call ARMCI_Free_fa(a4, rc)
 
3454
  call ARMCI_Free_fa(b4, rc)
 
3455
  call ARMCI_Free_fa(a5, rc)
 
3456
  call ARMCI_Free_fa(b5, rc)
 
3457
  call ARMCI_Free_fa(a6, rc)
 
3458
  call ARMCI_Free_fa(b6, rc)
 
3459
  call ARMCI_Free_fa(a7, rc)
 
3460
  call ARMCI_Free_fa(b7, rc)
 
3461
  call ARMCI_Sync()
 
3462
  return
 
3463
endsubroutine