1 | ! |
---|
2 | ! !INTERFACE: |
---|
3 | |
---|
4 | module m_GSMapTest |
---|
5 | ! |
---|
6 | ! !USES: |
---|
7 | ! |
---|
8 | implicit none |
---|
9 | |
---|
10 | private ! except |
---|
11 | |
---|
12 | ! !PUBLIC MEMBER FUNCTIONS: |
---|
13 | |
---|
14 | public :: testall |
---|
15 | public :: Identical |
---|
16 | |
---|
17 | interface testall |
---|
18 | module procedure testGSMap_ |
---|
19 | end interface |
---|
20 | |
---|
21 | interface Identical |
---|
22 | module procedure Identical_ |
---|
23 | end interface |
---|
24 | |
---|
25 | |
---|
26 | ! !REVISION HISTORY: |
---|
27 | !EOP ___________________________________________________________________ |
---|
28 | |
---|
29 | character(len=*),parameter :: myname='m_GSMapTest' |
---|
30 | |
---|
31 | contains |
---|
32 | |
---|
33 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
34 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
35 | !BOP ------------------------------------------------------------------- |
---|
36 | ! |
---|
37 | ! !IROUTINE: aVtest_ - Test the functions in the AttrVect module |
---|
38 | ! |
---|
39 | ! !DESCRIPTION: |
---|
40 | ! This routine writes diagnostic information about the input |
---|
41 | ! {\tt AttrVect}. Each line of the output will be preceded by the |
---|
42 | ! character argument {\tt identifier}. The output device is specified |
---|
43 | ! by the integer argument {\tt device}. |
---|
44 | ! |
---|
45 | ! !INTERFACE: |
---|
46 | |
---|
47 | subroutine testGSMap_(GSMap, identifier, mycomm, device) |
---|
48 | |
---|
49 | ! |
---|
50 | ! !USES: |
---|
51 | ! |
---|
52 | use m_GlobalSegMap ! Use all GlobalSegMap routines |
---|
53 | use m_GlobalToLocal ! Use all GlobalToLocal routines |
---|
54 | use m_stdio |
---|
55 | use m_die |
---|
56 | use m_mpif90 |
---|
57 | |
---|
58 | implicit none |
---|
59 | |
---|
60 | ! !INPUT PARAMETERS: |
---|
61 | |
---|
62 | type(GlobalSegMap), intent(in) :: GSMap |
---|
63 | character(len=*), intent(in) :: identifier |
---|
64 | integer, intent(in) :: device |
---|
65 | integer, intent(in) :: mycomm |
---|
66 | |
---|
67 | ! !REVISION HISTORY: |
---|
68 | ! 23Sep02 - E.T. Ong <eong@mcs.anl.gov> - initial prototype. |
---|
69 | !EOP ___________________________________________________________________ |
---|
70 | |
---|
71 | character(len=*),parameter :: myname_=myname//'::testGSMap_' |
---|
72 | integer :: myProc, mySize, ierr |
---|
73 | integer :: i, j, k, m, n, o |
---|
74 | integer :: first,last, owner, numlocs, nactive, npoints, proc |
---|
75 | integer, dimension(:), pointer :: points, owners, pelist, perm, & |
---|
76 | mystart, mylength |
---|
77 | integer, dimension(:), allocatable :: locs, slpArray |
---|
78 | logical :: found |
---|
79 | |
---|
80 | type(GlobalSegMap) :: PGSMap, P1GSMap |
---|
81 | |
---|
82 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
---|
83 | !:::::WRITE OUT INFO ABOUT THE GLOBALSEGMAP::::::::::::::::::::::::::::! |
---|
84 | !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! |
---|
85 | |
---|
86 | call MPI_COMM_RANK (mycomm, myProc, ierr) |
---|
87 | call MPI_COMM_SIZE(mycomm, mySize, ierr) |
---|
88 | |
---|
89 | write(device,*) identifier, ":: TYPE CHECK:" |
---|
90 | write(device,*) identifier, ":: COMP_ID = ", GSMap%comp_id |
---|
91 | write(device,*) identifier, ":: NGSEG = ", GSMap%ngseg |
---|
92 | write(device,*) identifier, ":: GSIZE = ", GSMap%gsize |
---|
93 | write(device,*) identifier, ":: START:: association status, & |
---|
94 | & size, values = ", associated(GSMap%start), size(GSMap%start) |
---|
95 | write(device,*) identifier, ":: START = ", GSMap%start |
---|
96 | write(device,*) identifier, ":: LENGTH:: association status, & |
---|
97 | &size, values = ", associated(GSMap%length), size(GSMap%length) |
---|
98 | write(device,*) identifier, ":: LENGTH = ", GSMap%length |
---|
99 | write(device,*) identifier, ":: PE_LOC:: association status, & |
---|
100 | &size, values = ", associated(GSMap%pe_loc), size(GSMap%pe_loc) |
---|
101 | write(device,*) identifier, ":: PE_LOC = ", GSMap%pe_loc |
---|
102 | |
---|
103 | write(device,*) identifier, ":: NGSEG_ = ", ngseg(GSMap) |
---|
104 | write(device,*) identifier, ":: NLSEG_ = ", nlseg(GSMap,myProc) |
---|
105 | write(device,*) identifier, ":: COMP_ID_ = ", comp_id(GSMap) |
---|
106 | write(device,*) identifier, ":: GSIZE_ = ", gsize(GSMap) |
---|
107 | write(device,*) identifier, ":: GLOBALSTORAGE = ", GlobalStorage(GSMap) |
---|
108 | write(device,*) identifier, ":: PROCESSSTORAGE = (PE, PE-STORAGE)" |
---|
109 | do i=1,mySize |
---|
110 | write(device,*) identifier, ":: PROCESSSTORAGE = ", & |
---|
111 | i-1, ProcessStorage(GSMap,i-1) |
---|
112 | enddo |
---|
113 | write(device,*) identifier, ":: LSIZE_ = ", lsize(GSMap,mycomm) |
---|
114 | write(device,*) identifier, ":: HALOED = ", haloed(GSMap) |
---|
115 | |
---|
116 | write(device,*) identifier, ":: SUBROUTINES CHECK:" |
---|
117 | write(device,*) identifier, ":: ORDERED POINTS = (PE, SIZE, FIRST, LAST)" |
---|
118 | |
---|
119 | do i=1,mySize |
---|
120 | |
---|
121 | first=1 |
---|
122 | last=0 |
---|
123 | |
---|
124 | proc = i-1 |
---|
125 | |
---|
126 | call OrderedPoints(GSMap,proc,points) |
---|
127 | |
---|
128 | npoints=size(points) |
---|
129 | if(npoints>0) then |
---|
130 | first = points(1) |
---|
131 | last = points(npoints) |
---|
132 | write(device,*) identifier, ":: ORDERED POINTS = ", proc, npoints, & |
---|
133 | first, last |
---|
134 | else |
---|
135 | write(device,*) identifier, ":: ORDERED POINTS :: EXTREME WARNING:: & |
---|
136 | &Process ", proc, " contains ", npoints, "points" |
---|
137 | write(device,*) identifier, ":: AS A RESULT, & |
---|
138 | &NOT TESTING RANK AND PELOCS::" |
---|
139 | EXIT |
---|
140 | ! call die(myname_,"OrderedPoints may have failed ") |
---|
141 | endif |
---|
142 | |
---|
143 | |
---|
144 | !:::CHECK THE CORRECTNESS OF ROUTINE RANK1_:::! !::NOT YET PUBLIC IN MODULE::! |
---|
145 | if(haloed(GSMap)) then |
---|
146 | do k=first,last |
---|
147 | call rank(GSMap,k,numlocs,owners) |
---|
148 | found = .false. |
---|
149 | do n=1,numlocs |
---|
150 | if(owners(n) /= proc) then |
---|
151 | found = .true. |
---|
152 | endif |
---|
153 | enddo |
---|
154 | if(.not.found) then |
---|
155 | call die(myname_,"SUBROUTINE RANKM_ failed!") |
---|
156 | endif |
---|
157 | enddo |
---|
158 | deallocate(owners,stat=ierr) |
---|
159 | if(ierr/=0) call die(myname_,"deallocate(owners)",ierr) |
---|
160 | else |
---|
161 | allocate(locs(npoints),stat=ierr) |
---|
162 | if(ierr/=0) call die(myname_,"allocate(locs)") |
---|
163 | call peLocs(GSMap,npoints,points,locs) |
---|
164 | do n=1,npoints |
---|
165 | if(locs(n) /= proc) then |
---|
166 | call die(myname_,"SUBROUTINE PELOCS FAILED!",locs(n)) |
---|
167 | endif |
---|
168 | enddo |
---|
169 | deallocate(locs,stat=ierr) |
---|
170 | if(ierr/=0) call die(myname_,"deallocate(locs)") |
---|
171 | do k=first,last |
---|
172 | call rank(GSMap,k,owner) |
---|
173 | if(owner /= proc) then |
---|
174 | write(device,*) identifier, ":: RANK1_ FAILED:: ", owner, proc, first, last, k |
---|
175 | call die(myname_,"SUBROUTINE RANK1_ failed!") |
---|
176 | endif |
---|
177 | enddo |
---|
178 | endif |
---|
179 | !:::::::::::::::::::::::::::::::::::::::::::::! |
---|
180 | |
---|
181 | deallocate(points,stat=ierr) |
---|
182 | if(ierr/=0) call die(myname_,"deallocate(points)",ierr) |
---|
183 | enddo |
---|
184 | |
---|
185 | call active_pes(GSMap, nactive, pelist) |
---|
186 | write(device,*) identifier, ":: ACTIVE PES (NUM_ACTIVE, PE_LIST) = ", & |
---|
187 | nactive, pelist |
---|
188 | deallocate(pelist,stat=ierr) |
---|
189 | if(ierr/=0) call die(myname_,"deallocate(pelist)",ierr) |
---|
190 | |
---|
191 | |
---|
192 | write(device,*) identifier, ":: TESTING INITP and INITP1" |
---|
193 | call init(PGSMAP, GSMap%comp_id, GSMap%ngseg, GSMap%gsize, GSMap%start, & |
---|
194 | GSMap%length, GSMap%pe_loc) |
---|
195 | |
---|
196 | k = size(GSMap%start)+size(GSMap%length)+size(GSMap%pe_loc) |
---|
197 | allocate(slparray(k),stat=ierr) |
---|
198 | if(ierr/=0) call die(myname_,"allocate(slparray)",ierr) |
---|
199 | |
---|
200 | slpArray(1:GSMap%ngseg) = GSMap%start(1:GSMap%ngseg) |
---|
201 | slpArray(GSMap%ngseg+1:2*GSMap%ngseg) = GSMap%length(1:GSMap%ngseg) |
---|
202 | slpArray(2*GSMap%ngseg+1:3*GSMap%ngseg) = GSMap%pe_loc(1:GSMap%ngseg) |
---|
203 | |
---|
204 | call init(P1GSMap, GSMap%comp_id, GSMap%ngseg, GSMap%gsize, slpArray) |
---|
205 | |
---|
206 | deallocate(slpArray,stat=ierr) |
---|
207 | if(ierr/=0) call die(myname_,"deallocate(slparray)",ierr) |
---|
208 | |
---|
209 | write(device,*) identifier, ":: COMPARE ALL GLOBALSEGMAPS: & |
---|
210 | & YOU SHOULD SEE 3 IDENTICAL COLUMNS OF NUMBERS:" |
---|
211 | write(device,*) identifier, ":: COMP_ID = ", & |
---|
212 | GSMap%comp_id, PGSMap%comp_id, P1GSMap%comp_id |
---|
213 | write(device,*) identifier, ":: NGSEG = ", & |
---|
214 | GSMap%ngseg, GSMap%ngseg, GSMap%ngseg |
---|
215 | write(device,*) identifier, ":: GSIZE = ", & |
---|
216 | GSMap%gsize, GSMap%gsize, GSMap%gsize |
---|
217 | write(device,*) identifier, ":: START:: association status = ", & |
---|
218 | associated(GSMap%start), associated(PGSMap%start), & |
---|
219 | associated(P1GSMap%start) |
---|
220 | write(device,*) identifier, ":: START:: size = ", & |
---|
221 | size(GSMap%start), size(PGSMap%start), size(P1GSMap%start) |
---|
222 | |
---|
223 | write(device,*) identifier, ":: LENGTH:: association status = ", & |
---|
224 | associated(GSMap%length), associated(PGSMap%length), & |
---|
225 | associated(P1GSMap%length) |
---|
226 | write(device,*) identifier, ":: LENGTH:: size = ", & |
---|
227 | size(GSMap%length), size(PGSMap%length), size(P1GSMap%length) |
---|
228 | |
---|
229 | |
---|
230 | write(device,*) identifier, ":: PE_LOC:: association status = ", & |
---|
231 | associated(GSMap%pe_loc), associated(PGSMap%pe_loc), & |
---|
232 | associated(P1GSMap%pe_loc) |
---|
233 | write(device,*) identifier, ":: PE_LOC:: size = ", & |
---|
234 | size(GSMap%pe_loc), size(PGSMap%pe_loc), size(P1GSMap%pe_loc) |
---|
235 | |
---|
236 | do i=1,GSMap%ngseg |
---|
237 | if( (GSMap%start(i) /= PGSMap%start(i)) .or. & |
---|
238 | (GSMap%start(i) /= P1GSMap%start(i)) ) then |
---|
239 | call die(myname_,"INITP or INITP1 failed -starts-!") |
---|
240 | endif |
---|
241 | if( (GSMap%length(i) /= PGSMap%length(i)) .or. & |
---|
242 | (GSMap%length(i) /= P1GSMap%length(i)) ) then |
---|
243 | call die(myname_,"INITP or INITP1 failed -lengths-!") |
---|
244 | endif |
---|
245 | if( (GSMap%pe_loc(i) /= PGSMap%pe_loc(i)) .or. & |
---|
246 | (GSMap%pe_loc(i) /= P1GSMap%pe_loc(i)) ) then |
---|
247 | call die(myname_,"INITP or INITP1 failed -pe_locs-!") |
---|
248 | endif |
---|
249 | enddo |
---|
250 | |
---|
251 | write(device,*) identifier, ":: TESTING SORT AND PERMUTE" |
---|
252 | |
---|
253 | call Sort(PGSMap,PGSMap%pe_loc,PGSMap%start,perm) |
---|
254 | call Permute(PGSMap, perm) |
---|
255 | |
---|
256 | deallocate(perm,stat=ierr) |
---|
257 | if(ierr/=0) call die(myname_,"deallocate(perm)") |
---|
258 | |
---|
259 | call SortPermute(P1GSMap,PGSMap%pe_loc,PGSMap%start) |
---|
260 | |
---|
261 | do i=1,GSMap%ngseg |
---|
262 | if( (P1GSMap%start(i) /= PGSMap%start(i)) ) then |
---|
263 | call die(myname_,"Sort or Permute failed -starts-!") |
---|
264 | endif |
---|
265 | if( (P1GSMap%length(i) /= PGSMap%length(i)) ) then |
---|
266 | call die(myname_,"Sort or Permute failed -lengths-!") |
---|
267 | endif |
---|
268 | if( (P1GSMap%pe_loc(i) /= PGSMap%pe_loc(i)) ) then |
---|
269 | call die(myname_,"Sort or Permute failed -pe_locs-!") |
---|
270 | endif |
---|
271 | enddo |
---|
272 | |
---|
273 | write(device,*) identifier, ":: TESTING GLOBALTOLOCAL FUNCTIONS ::" |
---|
274 | |
---|
275 | write(device,*) identifier, ":: TESTING GLOBALSEGMAPTOINDICES ::" |
---|
276 | |
---|
277 | call GlobalToLocalIndices(GSMap,mycomm,mystart,mylength) |
---|
278 | |
---|
279 | if(.NOT. (associated(mystart).and.associated(mylength)) ) then |
---|
280 | call die(myname_, "::GLOBALSEGMAPTOINDICES::& |
---|
281 | &mystart and/or mylength is not associated") |
---|
282 | endif |
---|
283 | |
---|
284 | if(size(mystart)<0) then |
---|
285 | call die(myname_, "::GLOBALSEGMAPTOINDICES::size(start) < 0") |
---|
286 | endif |
---|
287 | |
---|
288 | if(size(mystart) /= size(mylength)) then |
---|
289 | call die(myname_, "::GLOBALSEGMAPTOINDICES::size(start)/=size(length)") |
---|
290 | endif |
---|
291 | |
---|
292 | if(size(mystart) /= nlseg(GSMap,myProc)) then |
---|
293 | call die(myname_, "::GLOBALSEGMAPTOINDICES::size(start)/=nlseg") |
---|
294 | endif |
---|
295 | |
---|
296 | if(size(mystart)>0) then |
---|
297 | write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & |
---|
298 | &start = (size, values) ", & |
---|
299 | size(mystart), mystart |
---|
300 | else |
---|
301 | write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & |
---|
302 | &start has zero size" |
---|
303 | endif |
---|
304 | |
---|
305 | if(size(mylength)>0) then |
---|
306 | write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & |
---|
307 | &length = (size, values) ", & |
---|
308 | size(mylength), mylength |
---|
309 | else |
---|
310 | write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & |
---|
311 | &length has zero size" |
---|
312 | endif |
---|
313 | |
---|
314 | if(size(mystart)>0) then |
---|
315 | write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & |
---|
316 | &first, last indices = ", & |
---|
317 | mystart(1), mystart(size(mystart))+mylength(size(mylength))-1 |
---|
318 | else |
---|
319 | write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: NOT TESTING& |
---|
320 | & THIS ROUTINE BECAUSE START AND LENGTH HAVE ZERO SIZE" |
---|
321 | endif |
---|
322 | |
---|
323 | deallocate(mystart,mylength,stat=ierr) |
---|
324 | if(ierr/=0) call die(myname_,"deallocate(mystart,mylength)") |
---|
325 | |
---|
326 | write(device,*) identifier, ":: TESTING GLOBALSEGMAPTOINDEX" |
---|
327 | |
---|
328 | j=-12345 |
---|
329 | k=-12345 |
---|
330 | |
---|
331 | do i=1,GlobalStorage(GSMap) |
---|
332 | if(GlobalToLocalIndex(GSMap,i,mycomm)/=-1) then |
---|
333 | j=GlobalToLocalIndex(GSMap,i,mycomm) |
---|
334 | EXIT |
---|
335 | endif |
---|
336 | enddo |
---|
337 | |
---|
338 | do i=1,GlobalStorage(GSMap) |
---|
339 | if(GlobalToLocalIndex(GSMap,i,mycomm)/=-1) then |
---|
340 | k=GlobalToLocalIndex(GSMap,i,mycomm) |
---|
341 | endif |
---|
342 | enddo |
---|
343 | |
---|
344 | if( (j==-12345).and.(k==-12345) ) then |
---|
345 | write(device,*) identifier, ":: GlobalSegMapToIndex :: & |
---|
346 | &THIS PROCESS OWNS ZERO POINTS" |
---|
347 | else |
---|
348 | write(device,*) identifier, ":: GlobalSegMapToIndex :: & |
---|
349 | &first, last indices = ", j, k |
---|
350 | endif |
---|
351 | |
---|
352 | end subroutine testGSMap_ |
---|
353 | |
---|
354 | logical function Identical_(GSMap1,GSMap2) |
---|
355 | |
---|
356 | use m_GlobalSegMap ! Use all GlobalSegMap routines |
---|
357 | |
---|
358 | implicit none |
---|
359 | |
---|
360 | type(GlobalSegMap), intent(in) :: GSMap1, GSMap2 |
---|
361 | |
---|
362 | integer :: i |
---|
363 | Identical_=.true. |
---|
364 | |
---|
365 | if(GSMap1%comp_id /= GSMap2%comp_id) Identical_=.false. |
---|
366 | if(GSMap1%ngseg /= GSMap2%ngseg) Identical_=.false. |
---|
367 | if(GSMap1%gsize /= GSMap2%gsize) Identical_=.false. |
---|
368 | |
---|
369 | do i=1,GSMap1%ngseg |
---|
370 | if(GSMap1%start(i) /= GSMap2%start(i)) Identical_=.false. |
---|
371 | if(GSMap1%length(i) /= GSMap2%length(i)) Identical_ =.false. |
---|
372 | if(GSMap1%pe_loc(i) /= GSMap2%pe_loc(i)) Identical_ =.false. |
---|
373 | enddo |
---|
374 | |
---|
375 | end function Identical_ |
---|
376 | |
---|
377 | end module m_GSMapTest |
---|