Line data Source code
1 : !!****p* ABINIT/testTransposer
2 : !! NAME
3 : !! testTransposer
4 : !!
5 : !! FUNCTION
6 : !! test the xgTransposer module with 8 MPI. No more no less.
7 : !! It includes testing of complex and real numbers, and all2all and gatherv
8 : !!
9 : !! COPYRIGHT
10 : !! Copyright (C) 1998-2026 ABINIT group (JB)
11 : !! This file is distributed under the terms of the
12 : !! GNU General Public License, see ~abinit/COPYING
13 : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
15 : !!
16 : !! NOTES
17 : !!
18 : !! INPUTS
19 : !! (main routine)
20 : !!
21 : !! OUTPUT
22 : !! (main routine)
23 : !!
24 : !! SOURCE
25 :
26 : #if defined HAVE_CONFIG_H
27 : #include "config.h"
28 : #endif
29 :
30 : #include "abi_common.h"
31 2 : program testTransposer
32 2 : use m_xg
33 : use m_xgTransposer
34 : use m_xmpi
35 : use m_time
36 : use defs_basis
37 : use m_profiling_abi
38 : use m_errors
39 :
40 : implicit none
41 :
42 : integer :: npw
43 : integer :: nband
44 : integer :: ncycle
45 : integer :: i
46 : integer :: ierr
47 : double precision :: errmax
48 : double precision :: walltime
49 : double precision :: cputime
50 : double precision :: maxt
51 : integer :: nCpuCols, nCpuRows
52 2 : double precision, allocatable :: cg(:,:)
53 2 : double precision, allocatable :: cg0(:,:)
54 2 : double precision, allocatable :: gh(:,:)
55 2 : double precision, allocatable :: ghc(:,:)
56 : character(len=40) :: names(8)
57 :
58 : double precision :: nflops, ftimes(2)
59 : integer :: ncount
60 : double precision :: times(2)
61 :
62 : type(xgBlock_t) :: xcgLinalg
63 : type(xgBlock_t) :: xcgColsRows
64 : type(xgBlock_t) :: xghLinalg
65 : type(xgBlock_t) :: xghColsRows
66 : type(xgBlock_t) :: xghcLinalg
67 : type(xgBlock_t) :: xghcColsRows
68 2 : type(xgTransposer_t) :: xgTransposer
69 :
70 :
71 2 : names(1662-1661) = 'xgTransposer_transpose@ColsRows'
72 2 : names(1663-1661) = 'xgTransposer_transpose@Linalg '
73 2 : names(1664-1661) = 'xgTransposer_*@all2all '
74 2 : names(1665-1661) = 'xgTransposer_*@gatherv '
75 2 : names(1666-1661) = 'xgTransposer_@reorganize '
76 2 : names(1667-1661) = 'xgTransposer_*constructor '
77 2 : names(1668-1661) = 'xgTransposer_free '
78 2 : names(1669-1661) = 'xgTransposer_transpose '
79 :
80 2 : call xmpi_init()
81 :
82 2 : npw = 4000+2*xmpi_comm_rank(xmpi_world)
83 2 : nband = 2000
84 2 : ncycle = 20
85 2 : if ( xmpi_comm_size(xmpi_world) > 1 ) then
86 0 : if ( MOD(xmpi_comm_size(xmpi_world),10) == 0 ) then
87 0 : nCpuRows = 2
88 0 : else if ( MOD(xmpi_comm_size(xmpi_world),8) == 0 ) then
89 0 : nCpuRows = 4
90 0 : else if ( MOD(xmpi_comm_size(xmpi_world),6) == 0 ) then
91 0 : nCpuRows = 3
92 0 : else if ( MOD(xmpi_comm_size(xmpi_world),4) == 0 ) then
93 0 : nCpuRows = 2
94 : else
95 0 : nCpuRows = 1
96 : end if
97 0 : nCpuCols = xmpi_comm_size(xmpi_world)/nCpuRows
98 : else
99 2 : nCpuRows = 1
100 2 : nCpuCols = 1
101 : end if
102 :
103 2 : std_out = 6+xmpi_comm_rank(xmpi_world)
104 :
105 2 : write(std_out,*) " nCpuRows,nCpuCols",nCpuRows,nCpuCols
106 :
107 :
108 : ! Initialize memory profiling if it is activated
109 : ! if a full memocc.prc report is desired, set the argument of abimem_init to "2" instead of "0"
110 : ! note that memocc.prc files can easily be multiple GB in size so don't use this option normally
111 : #ifdef HAVE_MEM_PROFILING
112 : call abimem_init(0)
113 : #endif
114 :
115 2 : call test1()
116 :
117 : ! nspinor = 1
118 2 : call test2(1)
119 :
120 : ! nspinor = 2
121 2 : call test2(2)
122 :
123 2 : call xg_finalize()
124 :
125 :
126 : ! Writes information on file about the memory before ending mpi module, if memory profiling is enabled
127 2 : call abinit_doctor("__testtransposer")
128 :
129 2 : call xmpi_end()
130 :
131 : contains
132 : !!***
133 :
134 : !!****f* testTransposer/test1
135 : !!
136 : !! NAME
137 : !! test1
138 : !!
139 : !! FUNCTION
140 : !!
141 : !! COPYRIGHT
142 : !! Copyright (C) 1998-2026 ABINIT group (JB)
143 : !! This file is distributed under the terms of the
144 : !! GNU General Public License, see ~abinit/COPYING
145 : !! or http://www.gnu.org/copyleft/gpl.txt .
146 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
147 : !!
148 : !! NOTES
149 : !!
150 : !! INPUTS
151 : !! (main routine)
152 : !!
153 : !! OUTPUT
154 : !! (main routine)
155 : !!
156 : !! SOURCE
157 2 : subroutine test1()
158 2 : ABI_MALLOC(cg, (2,npw*nband))
159 2 : ABI_MALLOC(cg0, (2,npw*nband))
160 :
161 2 : call random_number(cg)
162 48000002 : cg0(:,:) = cg(:,:)
163 :
164 2 : call xgBlock_map(xcgLinalg,cg,SPACE_C,npw,nband,xmpi_world)
165 :
166 2 : write(std_out,*) " Complex all2all"
167 : call xgTransposer_constructor(xgTransposer,xcgLinalg,xcgColsRows,1,&
168 2 : STATE_LINALG,TRANS_ALL2ALL,xmpi_comm_null,xmpi_comm_null,ncpuCols,ncpuRows,0)
169 2 : call backAndForth()
170 2 : call xgTransposer_free(xgTransposer)
171 2 : call printTimes()
172 :
173 2 : write(std_out,*) " Complex gatherv"
174 : call xgTransposer_constructor(xgTransposer,xcgLinalg,xcgColsRows,1,&
175 2 : STATE_LINALG,TRANS_GATHER,xmpi_comm_null,xmpi_comm_null,ncpuCols,ncpuRows,0)
176 2 : call backAndForth()
177 2 : call xgTransposer_free(xgTransposer)
178 2 : call printTimes()
179 :
180 2 : call xgBlock_map(xcgLinalg,cg,SPACE_CR,npw,nband,xmpi_world)
181 :
182 2 : write(std_out,*) " Real all2all"
183 : call xgTransposer_constructor(xgTransposer,xcgLinalg,xcgColsRows,1,&
184 2 : STATE_LINALG,TRANS_ALL2ALL,xmpi_comm_null,xmpi_comm_null,ncpuCols,ncpuRows,0)
185 2 : call backAndForth()
186 2 : call xgTransposer_free(xgTransposer)
187 2 : call printTimes()
188 :
189 2 : write(std_out,*) " Real gatherv"
190 : call xgTransposer_constructor(xgTransposer,xcgLinalg,xcgColsRows,1,&
191 2 : STATE_LINALG,TRANS_GATHER,xmpi_comm_null,xmpi_comm_null,ncpuCols,ncpuRows,0)
192 2 : call backAndForth()
193 2 : call xgTransposer_free(xgTransposer)
194 2 : call printTimes()
195 :
196 2 : write(std_out,*) " Complex all2all (nspinor=2)"
197 : call xgTransposer_constructor(xgTransposer,xcgLinalg,xcgColsRows,2,&
198 2 : STATE_LINALG,TRANS_ALL2ALL,xmpi_comm_null,xmpi_comm_null,ncpuCols,ncpuRows,0)
199 2 : call backAndForth()
200 2 : call xgTransposer_free(xgTransposer)
201 2 : call printTimes()
202 :
203 2 : write(std_out,*) " Complex gatherv (nspinor=2)"
204 : call xgTransposer_constructor(xgTransposer,xcgLinalg,xcgColsRows,2,&
205 2 : STATE_LINALG,TRANS_GATHER,xmpi_comm_null,xmpi_comm_null,ncpuCols,ncpuRows,0)
206 2 : call backAndForth()
207 2 : call xgTransposer_free(xgTransposer)
208 2 : call printTimes()
209 :
210 2 : call xgBlock_map(xcgLinalg,cg,SPACE_CR,npw,nband,xmpi_world)
211 :
212 2 : write(std_out,*) " Real all2all (nspinor=2)"
213 : call xgTransposer_constructor(xgTransposer,xcgLinalg,xcgColsRows,2,&
214 2 : STATE_LINALG,TRANS_ALL2ALL,xmpi_comm_null,xmpi_comm_null,ncpuCols,ncpuRows,0)
215 2 : call backAndForth()
216 2 : call xgTransposer_free(xgTransposer)
217 2 : call printTimes()
218 :
219 2 : write(std_out,*) " Real gatherv (nspinor=2)"
220 : call xgTransposer_constructor(xgTransposer,xcgLinalg,xcgColsRows,2,&
221 2 : STATE_LINALG,TRANS_GATHER,xmpi_comm_null,xmpi_comm_null,ncpuCols,ncpuRows,0)
222 2 : call backAndForth()
223 2 : call xgTransposer_free(xgTransposer)
224 2 : call printTimes()
225 :
226 2 : ABI_FREE(cg)
227 2 : ABI_FREE(cg0)
228 2 : end subroutine test1
229 : !!***
230 :
231 : !!****f* testTransposer/test2
232 : !!
233 : !! NAME
234 : !! test2
235 : !!
236 : !! FUNCTION
237 : !!
238 : !! COPYRIGHT
239 : !! Copyright (C) 1998-2026 ABINIT group (JB)
240 : !! This file is distributed under the terms of the
241 : !! GNU General Public License, see ~abinit/COPYING
242 : !! or http://www.gnu.org/copyleft/gpl.txt .
243 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
244 : !!
245 : !! NOTES
246 : !!
247 : !! INPUTS
248 : !! (main routine)
249 : !!
250 : !! OUTPUT
251 : !! (main routine)
252 : !!
253 : !! SOURCE
254 4 : subroutine test2(nspinor)
255 : integer,intent(in) :: nspinor
256 4 : type(xgTransposer_t) :: xgTransposerGh
257 4 : type(xgTransposer_t) :: xgTransposerGhc
258 : type(xg_t) :: dotLinalg
259 : type(xg_t) :: dotColsRows
260 : double precision :: maxdiff
261 :
262 4 : write(std_out,*) "Allocation"
263 4 : ABI_MALLOC(cg,(2,npw*nband))
264 4 : ABI_MALLOC(gh,(2,npw*nband))
265 4 : ABI_MALLOC(ghc,(2,npw*nband))
266 :
267 4 : write(std_out,*) "Mapping"
268 4 : call xgBlock_map(xcgLinalg,cg,SPACE_C,npw,nband,xmpi_world)
269 4 : call xgBlock_map(xghLinalg,gh,SPACE_C,npw,nband,xmpi_world)
270 4 : call xgBlock_map(xghcLinalg,ghc,SPACE_C,npw,nband,xmpi_world)
271 :
272 4 : write(std_out,*) "Transposer constructor : nspinor =",nspinor
273 :
274 : call xgTransposer_constructor(xgTransposer,xcgLinalg,xcgColsRows,nspinor,&
275 4 : STATE_LINALG,TRANS_ALL2ALL,xmpi_comm_null,xmpi_comm_null,ncpuCols,ncpuRows,0)
276 4 : call xgTransposer_copyConstructor(xgTransposerGh,xgTransposer,xghLinalg,xghColsRows,STATE_LINALG)
277 4 : call xgTransposer_copyConstructor(xgTransposerGhc,xgTransposer,xghcLinalg,xghcColsRows,STATE_LINALG)
278 :
279 4 : write(std_out,*) "Init data"
280 4 : call random_number(cg)
281 4 : call random_number(gh)
282 : !call initVectors()
283 :
284 4 : write(std_out,*) "Linalg division"
285 4 : call xgBlock_colwiseDivision(xcgLinalg,xghLinalg,xghcLinalg)
286 :
287 4 : write(std_out,*) "Linalg norm2"
288 4 : call xg_init(dotLinalg,SPACE_R,nband,1,xmpi_world)
289 4 : call xgBlock_colwiseNorm2(xghcLinalg,dotLinalg%self)
290 : !call xgBlock_print(dotLinalg%self,std_out)
291 :
292 4 : write(std_out,*) "Transposer transpose"
293 4 : call xgTransposer_transpose(xgTransposer,STATE_COLSROWS)
294 4 : call xgTransposer_transpose(xgTransposerGh,STATE_COLSROWS)
295 4 : call xgTransposer_transpose(xgTransposerGhc,STATE_COLSROWS)
296 :
297 4 : write(std_out,*) "ColsRows divisions"
298 4 : call xgBlock_colwiseDivision(xcgColsRows,xghColsRows,xghcColsRows)
299 :
300 4 : write(std_out,*) "Transposer transpose back"
301 4 : call xgTransposer_transpose(xgTransposerGhc,STATE_LINALG)
302 :
303 4 : write(std_out,*) "ColsRows norm2"
304 4 : call xg_init(dotColsRows,SPACE_R,nband,1,xmpi_world)
305 4 : call xgBlock_colwiseNorm2(xghcLinalg,dotColsRows%self)
306 : !call xgBlock_print(dotColsRows%self,std_out)
307 :
308 4 : write(std_out,*) "Compare"
309 4 : call xgBlock_saxpy(dotLinalg%self, -1.0d0, dotColsRows%self)
310 4 : call xgBlock_reshape(dotLinalg%self,1,nband)
311 4 : call xgBlock_colwiseNorm2(dotLinalg%self,dotColsRows%self,max_val=maxdiff)
312 4 : write(std_out,"(a,f20.4)") " Difference: ",sqrt(maxdiff)
313 :
314 4 : write(std_out,*) "Free everything"
315 4 : call xg_free(dotLinalg)
316 4 : call xg_free(dotColsRows)
317 :
318 4 : call xgTransposer_free(xgTransposer)
319 4 : call xgTransposer_free(xgTransposerGh)
320 4 : call xgTransposer_free(xgTransposerGhc)
321 :
322 4 : ABI_FREE(cg)
323 4 : ABI_FREE(gh)
324 4 : ABI_FREE(ghc)
325 :
326 12 : end subroutine test2
327 : !!***
328 :
329 : !!****f* testTransposer/initVectors
330 : !!
331 : !! NAME
332 : !! initVectors
333 : !!
334 : !! FUNCTION
335 : !!
336 : !! COPYRIGHT
337 : !! Copyright (C) 1998-2026 ABINIT group (JB)
338 : !! This file is distributed under the terms of the
339 : !! GNU General Public License, see ~abinit/COPYING
340 : !! or http://www.gnu.org/copyleft/gpl.txt .
341 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
342 : !!
343 : !! NOTES
344 : !!
345 : !! INPUTS
346 : !! (main routine)
347 : !!
348 : !! OUTPUT
349 : !! (main routine)
350 : !!
351 : !! SOURCE
352 :
353 : subroutine initVectors()
354 : integer, allocatable :: seed(:)
355 : integer :: n, iseed
356 : integer :: icol, irow
357 :
358 : call random_seed(size=n)
359 : ABI_MALLOC(seed,(n))
360 : do icol = 1, nband
361 : do iseed = 1, n
362 : seed(iseed) = (xmpi_comm_rank(xmpi_world)*nband+icol)*n+iseed
363 : end do
364 : call random_seed(put=seed)
365 : do irow = 1, npw
366 : call random_number(cg(:,(icol-1)*npw+1:icol*npw))
367 : call random_number(gh(:,(icol-1)*npw+1:icol*npw))
368 : end do
369 : end do
370 : ABI_FREE(seed)
371 : end subroutine initVectors
372 : !!***
373 :
374 : !!****f* testTransposer/backAndForth
375 : !!
376 : !! NAME
377 : !! backAndForth
378 : !!
379 : !! FUNCTION
380 : !!
381 : !! COPYRIGHT
382 : !! Copyright (C) 1998-2026 ABINIT group (JB)
383 : !! This file is distributed under the terms of the
384 : !! GNU General Public License, see ~abinit/COPYING
385 : !! or http://www.gnu.org/copyleft/gpl.txt .
386 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
387 : !!
388 : !! NOTES
389 : !!
390 : !! INPUTS
391 : !! (main routine)
392 : !!
393 : !! OUTPUT
394 : !! (main routine)
395 : !!
396 : !! SOURCE
397 :
398 16 : subroutine backAndForth()
399 :
400 16 : maxt = 0
401 16 : cputime = 0
402 336 : do i=1,ncycle
403 320 : walltime = abi_wtime()
404 320 : call xgTransposer_transpose(xgTransposer,STATE_COLSROWS)
405 320 : if ( ncpucols > 1 ) then ! for 1 both states are aliased !!
406 0 : call random_number(cg)
407 : end if
408 : !call xgBlock_scale(xcgLinalg,0.d0,1)
409 : !call xgBlock_print(xgeigen,6)
410 320 : call xgTransposer_transpose(xgTransposer,STATE_LINALG)
411 : !call xgBlock_print(xgx0,6)
412 320 : call xmpi_barrier(xmpi_world)
413 320 : walltime = abi_wtime() - walltime
414 320 : cputime = cputime + walltime
415 336 : call xmpi_max(walltime,maxt,xmpi_world,ierr)
416 : end do
417 16 : call xmpi_max(cputime,maxt,xmpi_world,ierr)
418 16 : write(std_out,"(a,f20.5)") "-Mean time: ", maxt/ncycle
419 384000016 : errmax = (sum(abs(cg0-cg)))/nband
420 16 : call xmpi_sum(errmax,xmpi_world,ierr)
421 16 : write(std_out,"(a,f20.14)") " Difference: ",errmax
422 16 : call xmpi_barrier(xmpi_world)
423 16 : end subroutine backAndForth
424 : !!***
425 :
426 : !!****f* testTransposer/printTimes
427 : !!
428 : !! NAME
429 : !! printTimes
430 : !!
431 : !! FUNCTION
432 : !!
433 : !! COPYRIGHT
434 : !! Copyright (C) 1998-2026 ABINIT group (JB)
435 : !! This file is distributed under the terms of the
436 : !! GNU General Public License, see ~abinit/COPYING
437 : !! or http://www.gnu.org/copyleft/gpl.txt .
438 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
439 : !!
440 : !! NOTES
441 : !!
442 : !! INPUTS
443 : !! (main routine)
444 : !!
445 : !! OUTPUT
446 : !! (main routine)
447 : !!
448 : !! SOURCE
449 :
450 16 : subroutine printTimes()
451 :
452 : double precision :: total(2)
453 : integer :: ntot
454 16 : write(std_out,'(1x,a30,a8,a17,a17)') "counter", "calls", "cpu_time", "wall_time"
455 16 : ntot = 0
456 16 : total(:) = 0.d0
457 144 : do i=1662,1669
458 128 : call time_accu(i,ncount,times,nflops,ftimes)
459 128 : total(1) = total(1) + times(1)
460 128 : total(2) = total(2) + times(2)
461 128 : ntot = ntot + ncount
462 144 : write(std_out,'(a,a30,i8,2F17.3)') "-",trim(names(i-1661)), ncount, times(1), times(2)
463 : end do
464 16 : write(std_out,'(a,a30,i8,2F17.3)') "-","total", ntot, total(1), total(2)
465 16 : call timab(1,0,times)
466 :
467 16 : end subroutine printTimes
468 :
469 :
470 : end program testTransposer
471 : !!***
|
