Branch data Line data Source code
1 : : !!****m* ABINIT/m_mpi_setup
2 : : !! NAME
3 : : !! m_mpi_setup
4 : : !!
5 : : !! FUNCTION
6 : : !! Initialize MPI parameters and datastructures for parallel execution
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 1999-2026 ABINIT group (FJ, MT, FD)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! SOURCE
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : module m_mpi_setup
23 : :
24 : : use defs_basis
25 : : use m_distribfft
26 : : use m_xmpi
27 : : use m_xomp
28 : : use m_hdr
29 : : use m_sort
30 : : use m_errors
31 : : use m_abicore
32 : :
33 : : use defs_abitypes, only : MPI_type
34 : : use m_fstrings, only : sjoin, itoa
35 : : use m_time, only : abi_wtime
36 : : use m_parser, only : intagm
37 : : use m_geometry, only : mkrdim, metric
38 : : use m_fftcore, only : fftalg_for_npfft, getng, kpgcount
39 : : use m_mpinfo, only : init_mpi_enreg, mpi_distrib_is_ok, initmpi_atom, proc_distrb_cycle, &
40 : : initmpi_grid, initmpi_pert, initmpi_img, distrb2, distrb2_hf, initmpi_world
41 : : use m_libpaw_tools, only : libpaw_write_comm_set
42 : : use m_dtset, only : dataset_type
43 : : use m_kg, only : getmpw
44 : : use m_dtfil, only : mkfilename
45 : : use m_mep, only : NEB_CELL_ALGO_NONE
46 : :
47 : : implicit none
48 : :
49 : : private
50 : : !!***
51 : :
52 : : public :: mpi_setup
53 : : !!***
54 : :
55 : : contains
56 : : !!***
57 : :
58 : : !!****f* ABINIT/mpi_setup
59 : : !! NAME
60 : : !! mpi_setup
61 : : !!
62 : : !! FUNCTION
63 : : !! Big loop on the datasets:
64 : : !! - compute mgfft,mpw,nfft,... for this data set;
65 : : !! - fill mpi_enreg
66 : : !! *** At the output of this routine, all the dtsets input variables are known ***
67 : : !! The content of dtsets should not be modified anymore afterwards.
68 : : !!
69 : : !! INPUTS
70 : : !! filnam(5)=character strings giving file names
71 : : !! ndtset= number of datasets to be read; if 0, no multi-dataset mode
72 : : !! ndtset_alloc=number of datasets, corrected for allocation of at least
73 : : !! one data set.
74 : : !!
75 : : !! OUTPUT
76 : : !! dtsets(0:ndtset_alloc)=<type datafiles_type>contains all input variables,
77 : : !! some of which are initialized here, while other were already
78 : : !! initialized previously.
79 : : !!
80 : : !! SIDE EFFECTS
81 : : !! mpi_enregs=information about MPI parallelization
82 : : !!
83 : : !! SOURCE
84 : :
85 : 1445 : subroutine mpi_setup(dtsets,filnam,lenstr,mpi_enregs,ndtset,ndtset_alloc,string)
86 : :
87 : : !Arguments ------------------------------------
88 : : !scalars
89 : : integer,intent(in) :: lenstr,ndtset,ndtset_alloc
90 : : type(MPI_type),intent(inout) :: mpi_enregs(0:ndtset_alloc)
91 : : character(len=*),intent(in) :: string
92 : : !arrays
93 : : character(len=fnlen),intent(in) :: filnam(5)
94 : : type(dataset_type),intent(inout) :: dtsets(0:ndtset_alloc)
95 : :
96 : : !Local variables -------------------------------
97 : : !scalars
98 : : integer :: blocksize,exchn2n3d,iband,idtset,iexit,ii,iikpt,iikpt_modulo, prtvol
99 : : integer :: isppol,jdtset,marr,mband_lower,mband_upper
100 : : integer :: me_fft,mgfft,mgfftdg,mkmem,mpw,mpw_k,max_mpw,optdriver
101 : : integer :: mband_mem
102 : : integer :: nfft,nfftdg,nkpt,nkpt_me,npert,nproc,nproc_fft,nqpt
103 : : integer :: nspink,nsppol,nsym,nthreads,paral_fft,response,tnband,tread0,usepaw,vectsize
104 : : integer :: fftalg,fftalga,fftalgc
105 : : #ifdef HAVE_LINALG_ELPA
106 : : integer :: icol,irow,np
107 : : #endif
108 : : logical :: fftalg_read,forbid_threads,ortalg_read,paral_kgb_read,wfoptalg_read,do_check
109 : : real(dp) :: dilatmx,ecut,ecut_eff,ecutdg_eff,ucvol
110 : : character(len=500) :: msg
111 : : !arrays
112 : : integer :: ngfft(18),ngfftdg(18),ngfftc(3),tread(12)
113 : 1445 : integer,allocatable :: intarr(:),istwfk(:),symrel(:,:,:)
114 : 1445 : integer,allocatable :: mybands(:)
115 : 1445 : integer,pointer :: nkpt_rbz(:)
116 : : real(dp),parameter :: k0(3)=(/zero,zero,zero/)
117 : : real(dp) :: gmet(3,3),gprimd(3,3),kpt(3),qphon(3),rmet(3,3),rprimd(3,3)
118 : 1445 : real(dp),allocatable :: dprarr(:),kpt_with_shift(:,:)
119 : 1445 : real(dp),pointer :: nband_rbz(:,:)
120 : : character(len=6) :: nm_mkmem(3)
121 : :
122 : : !*************************************************************************
123 : :
124 : : DBG_ENTER("COLL")
125 : :
126 : 1445 : iexit=0;mpw_k=0
127 : :
128 : 1445 : call init_mpi_enreg(mpi_enregs(0))
129 : 1445 : call initmpi_img(dtsets(0),mpi_enregs(0),-1)
130 : 1445 : nthreads=xomp_get_num_threads(open_parallel=.True.)
131 : :
132 [ + + ]: 8457 : do idtset=1,ndtset_alloc
133 : 7012 : call init_mpi_enreg(mpi_enregs(idtset))
134 : :
135 : : ! Handy read-only variables.
136 : 7012 : optdriver = dtsets(idtset)%optdriver
137 : 7012 : prtvol = dtsets(idtset)%prtvol
138 : :
139 : : ! Read parallel input parameters
140 : 7012 : marr=max(12,dtsets(idtset)%npsp,dtsets(idtset)%nimage)
141 [ - + + - : 21036 : ABI_MALLOC(intarr,(marr))
+ - - + -
+ - + ]
142 [ - + + - : 21036 : ABI_MALLOC(dprarr,(marr))
+ - - + -
+ - + ]
143 : 7012 : nkpt =dtsets(idtset)%nkpt
144 : 7012 : nsppol=dtsets(idtset)%nsppol
145 [ + + ]: 7012 : jdtset=dtsets(idtset)%jdtset ; if(ndtset==0)jdtset=0
146 : 7012 : usepaw=dtsets(idtset)%usepaw
147 [ + + ]: 124867 : mband_upper=maxval(dtsets(idtset)%nband(1:nkpt*nsppol))
148 : : mband_lower=minval(dtsets(idtset)%nband(1:nkpt*nsppol))
149 : :
150 : : ! Compute metric for this dataset
151 [ - + - - : 7012 : call mkrdim(dtsets(idtset)%acell_orig(1:3,1),dtsets(idtset)%rprim_orig(1:3,1:3,1),rprimd)
- - ]
152 : 7012 : call metric(gmet,gprimd,-1,rmet,rprimd,ucvol)
153 : :
154 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'max_ncpus',tread0,'INT')
155 [ + + ]: 7012 : if (tread0==1) dtsets(idtset)%max_ncpus=intarr(1)
156 : :
157 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'paral_atom',tread0,'INT')
158 [ + + ]: 7012 : if(tread0==1) dtsets(idtset)%paral_atom=intarr(1)
159 : :
160 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'paral_rf',tread0,'INT')
161 [ + + + + ]: 7012 : if (tread0==1.and.any(optdriver==[RUNL_RESPFN, RUNL_NONLINEAR])) dtsets(idtset)%paral_rf=intarr(1)
162 : :
163 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'npimage',tread(2),'INT')
164 [ - + ]: 7012 : if(tread(2)==1) dtsets(idtset)%npimage=intarr(1)
165 : :
166 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'nppert',tread(3),'INT')
167 [ + + + + ]: 7012 : if (tread(3)==1.and.optdriver==RUNL_RESPFN) dtsets(idtset)%nppert=intarr(1)
168 : :
169 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'np_spkpt',tread(4),'INT')
170 [ + + ]: 7012 : if(tread(4)==1)then
171 : 254 : dtsets(idtset)%np_spkpt=intarr(1)
172 : : else
173 : : ! npkpt is obsolete, but still read
174 : 6758 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'npkpt',tread(4),'INT')
175 [ + + ]: 6758 : if(tread(4)==1)then
176 : 72 : dtsets(idtset)%np_spkpt=intarr(1)
177 : : endif
178 : : endif
179 : :
180 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'npspinor',tread(5),'INT')
181 : : ! original code
182 [ + + ]: 7012 : if(tread(5)==1) dtsets(idtset)%npspinor=intarr(1)
183 : :
184 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'npfft',tread(6),'INT')
185 [ + + ]: 7012 : if(tread(6)==1) dtsets(idtset)%npfft=intarr(1)
186 : :
187 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'npband',tread(7),'INT')
188 [ + + ]: 7012 : if(tread(7)==1) dtsets(idtset)%npband=intarr(1)
189 : :
190 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'bandpp',tread(8),'INT')
191 [ + + ]: 7012 : if(tread(8)==1) dtsets(idtset)%bandpp=intarr(1)
192 : :
193 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'use_slk',tread(9),'INT')
194 [ + + ]: 7012 : if(tread(9)==1) dtsets(idtset)%use_slk=intarr(1)
195 : :
196 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'np_slk',tread(10),'INT')
197 [ + + ]: 7012 : if(tread(10)==1) dtsets(idtset)%np_slk=intarr(1)
198 : :
199 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'slk_rankpp',tread(12),'INT')
200 [ - + ]: 7012 : if(tread(12)==1) dtsets(idtset)%slk_rankpp=intarr(1)
201 : :
202 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'pw_unbal_thresh',tread0,'DPR')
203 [ - + ]: 7012 : if(tread0==1) dtsets(idtset)%pw_unbal_thresh=dprarr(1)
204 : 7012 : mpi_enregs(idtset)%pw_unbal_thresh=dtsets(idtset)%pw_unbal_thresh
205 : :
206 : 7012 : call intagm(dprarr,intarr,jdtset,marr,12,string(1:lenstr),'gpu_devices',tread0,'INT')
207 [ - + - - ]: 7012 : if(tread0==1) dtsets(idtset)%gpu_devices(1:12)=intarr(1:12)
208 : :
209 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'gpu_nfft_blocks',tread0,'INT')
210 [ - + ]: 7012 : if(tread0==1) dtsets(idtset)%gpu_nfft_blocks=intarr(1)
211 : :
212 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'gpu_kokkos_nthrd',tread0,'INT')
213 [ - + ]: 7012 : if(tread0==1) dtsets(idtset)%gpu_kokkos_nthrd=intarr(1)
214 : :
215 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'gpu_linalg_limit',tread(11),'INT')
216 [ - + ]: 7012 : if(tread(11)==1) dtsets(idtset)%gpu_linalg_limit=intarr(1)
217 : :
218 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'gpu_nl_distrib',tread0,'INT')
219 [ - + ]: 7012 : if(tread0==1) dtsets(idtset)%gpu_nl_distrib=intarr(1)
220 : :
221 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'gpu_nl_splitsize',tread0,'INT')
222 [ - + ]: 7012 : if(tread0==1) dtsets(idtset)%gpu_nl_splitsize=intarr(1)
223 : :
224 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'gpu_thread_limit',tread0,'INT')
225 [ - + ]: 7012 : if(tread0==1) dtsets(idtset)%gpu_thread_limit=intarr(1)
226 : :
227 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'nphf',tread0,'INT')
228 [ - + ]: 7012 : if(tread0==1) dtsets(idtset)%nphf=intarr(1)
229 : :
230 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'autoparal',tread0,'INT')
231 [ + + ]: 7012 : if(tread0==1) dtsets(idtset)%autoparal=intarr(1)
232 : :
233 : : ! Read paral_kgb and disable it if not supported in optdriver
234 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'paral_kgb',tread(1),'INT')
235 : 7012 : paral_kgb_read=(tread(1)==1)
236 [ + + ]: 7012 : if (paral_kgb_read) dtsets(idtset)%paral_kgb=intarr(1)
237 : : if (xmpi_paral==0.and.dtsets(idtset)%paral_kgb==1) then
238 : : dtsets(idtset)%paral_kgb=0
239 : : write(msg, '(5a)' ) &
240 : : 'When ABINIT is compiled without MPI flag,',ch10,&
241 : : 'setting paral_kgb/=0 is useless. paral_kgb has been reset to 0.',ch10,&
242 : : 'Action: modify compilation option or paral_kgb in the input file.'
243 : : ABI_WARNING(msg)
244 : : end if
245 [ + + + + : 7012 : if (ALL(optdriver /= [RUNL_GSTATE, RUNL_GWLS, RUNL_RTTDDFT]) .and. dtsets(idtset)%paral_kgb/=0) then
+ + ]
246 : 20 : dtsets(idtset)%paral_kgb=0
247 : : write(msg, '(a,i0,a)') &
248 : 20 : "paral_kgb != 0 is not available in optdriver ",optdriver,". Setting paral_kgb to 0"
249 : 20 : ABI_COMMENT(msg)
250 : : end if
251 : :
252 : 7012 : wfoptalg_read=.false.
253 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'wfoptalg',tread0,'INT')
254 [ + + ]: 7012 : if(tread0==1) then
255 : 370 : dtsets(idtset)%wfoptalg=intarr(1)
256 : 370 : wfoptalg_read=.true.
257 : : else
258 [ + + ]: 6642 : if (dtsets(idtset)%usepaw==0) dtsets(idtset)%wfoptalg=0
259 [ + + ]: 6642 : if (dtsets(idtset)%usepaw/=0) dtsets(idtset)%wfoptalg=10
260 [ + + + + ]: 6642 : if ((optdriver==RUNL_GSTATE.or.optdriver==RUNL_GWLS).and.dtsets(idtset)%paral_kgb/=0) dtsets(idtset)%wfoptalg=114
261 : : end if
262 : :
263 : : ! Dump the list of irreducible perturbations and exit.
264 [ - + - - ]: 7012 : if (dtsets(idtset)%paral_rf==-1.and.optdriver/=RUNL_NONLINEAR) then
265 : 0 : call dtsets(idtset)%get_npert_rbz(nband_rbz, nkpt_rbz, npert)
266 [ # # ]: 0 : ABI_FREE(nband_rbz)
267 [ # # ]: 0 : ABI_FREE(nkpt_rbz)
268 : 0 : iexit = iexit + 1
269 : : end if
270 : :
271 : : ! From total number of procs, compute all possible distributions
272 : : ! Ignore exit flag if GW/EPH calculations because autoparal section is performed in screening/sigma/bethe_salpeter/eph
273 [ + + + + : 46683 : if (any(optdriver == [RUNL_SCREENING, RUNL_SIGMA, RUNL_BSE, RUNL_EPH, RUNL_GWR, RUNL_NONLINEAR])) then
+ + ]
274 : 522 : iexit = 0
275 : : else
276 : 6490 : call finddistrproc(dtsets,filnam,idtset,iexit,mband_upper,mpi_enregs(idtset),ndtset_alloc,tread)
277 : : end if
278 : :
279 : 7012 : call initmpi_img(dtsets(idtset),mpi_enregs(idtset),-1)
280 : 7012 : nproc=mpi_enregs(idtset)%nproc_cell
281 : :
282 : : ! Set paral_kgb to 1 when band-fft parallelism is activated
283 [ + + + + ]: 7012 : if (ANY(optdriver == [RUNL_GSTATE, RUNL_GWLS, RUNL_RTTDDFT])) then
284 [ + + ]: 5736 : if (mpi_enregs(idtset)%nproc_cell>1) then
285 [ + + + + ]: 1002 : if (dtsets(idtset)%npband>1.or.dtsets(idtset)%npfft>1) then
286 [ + + ]: 630 : if (.not.paral_kgb_read) dtsets(idtset)%paral_kgb=1
287 : : end if
288 : : end if
289 : : end if
290 : :
291 [ + + + + : 7012 : if ((optdriver/=RUNL_GSTATE.and.optdriver/=RUNL_GWLS.and.optdriver/=RUNL_RTTDDFT).and. &
+ - + - +
- + - -
+ ]
292 : : & (dtsets(idtset)%np_spkpt/=1 .or.dtsets(idtset)%npband/=1.or.dtsets(idtset)%npfft/=1.or. &
293 : : & dtsets(idtset)%npspinor/=1.or.dtsets(idtset)%bandpp/=1)) then
294 : : !& .or.(dtsets(idtset)%iscf<0)) then
295 : 0 : dtsets(idtset)%np_spkpt=1 ; dtsets(idtset)%npspinor=1 ; dtsets(idtset)%npfft=1
296 : 0 : dtsets(idtset)%npband=1; dtsets(idtset)%nphf=1
297 : 0 : dtsets(idtset)%paral_kgb=0
298 [ # # ]: 0 : if(optdriver/=RUNL_RESPFN) dtsets(idtset)%bandpp=1
299 : 0 : dtsets(idtset)%wfoptalg=0
300 : 0 : ABI_COMMENT('For non ground state calculations, set bandpp, npfft, npband, npspinor, np_spkpt and nphf to 1')
301 : : end if
302 : :
303 : : ! Take into account a possible change of paral_kgb (change of the default algorithm)
304 [ + + ]: 7012 : if (.not.wfoptalg_read) then
305 [ + + ]: 6642 : if (dtsets(idtset)%usepaw==0) dtsets(idtset)%wfoptalg=0
306 [ + + ]: 6642 : if (dtsets(idtset)%usepaw/=0) dtsets(idtset)%wfoptalg=10
307 [ + + + + ]: 6642 : if ((optdriver==RUNL_GSTATE.or.optdriver==RUNL_GWLS).and.dtsets(idtset)%paral_kgb/=0) dtsets(idtset)%wfoptalg=114
308 : : #ifndef HAVE_DFTI
309 : : if (mod(dtsets(idtset)%wfoptalg,10)==4) then
310 : : do iikpt=1,dtsets(idtset)%nkpt
311 : : if (any(abs(dtsets(idtset)%kpt(:,iikpt))>tol8)) dtsets(idtset)%istwfk(iikpt)=1
312 : : end do
313 : : end if
314 : : #else
315 [ + + - + ]: 6642 : if (mod(dtsets(idtset)%wfoptalg,10)==4.and.dtsets(idtset)%wfoptalg/=114) then
316 [ # # ]: 0 : do iikpt=1,dtsets(idtset)%nkpt
317 [ # # # # : 0 : if (any(abs(dtsets(idtset)%kpt(:,iikpt))>tol8)) dtsets(idtset)%istwfk(iikpt)=1
# # ]
318 : : end do
319 : : end if
320 : : #endif
321 : : end if
322 : :
323 [ + + + + ]: 7012 : if (dtsets(idtset)%wfoptalg==114.or.dtsets(idtset)%wfoptalg==14.or.dtsets(idtset)%wfoptalg==4) then !if LOBPCG
324 [ + + ]: 489 : if (dtsets(idtset)%autoparal==0) then
325 : : !Nband might have different values for different kpoint, but not bandpp.
326 : : !In this case, we just use the largest nband (mband_upper), and the input will probably fail
327 : : !at the bandpp check later on
328 [ + + ]: 436 : if(tread(8)==1) then
329 : : ! check if nblock_lobpcg is read from the input, if so error msg
330 : 34 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'nblock_lobpcg',tread0,'INT')
331 [ - + ]: 34 : if (tread0==1) then
332 : 0 : write(msg,'(3a)') 'Both bandpp and nblock_lobpcg are defined for the same dataset, this is confusing.',ch10,&
333 : 0 : 'Change the input to keep only nblock_lobpcg (preferably) or bandpp.'
334 : 0 : ABI_ERROR(msg)
335 : : end if
336 [ + - ]: 34 : if (mod(mband_upper,dtsets(idtset)%bandpp*dtsets(idtset)%npband)==0) then
337 : 34 : dtsets(idtset)%nblock_lobpcg=mband_upper/(dtsets(idtset)%bandpp*dtsets(idtset)%npband)
338 : : else
339 : 0 : write(msg,'(5a)') 'mband_upper( =max_{kpt}(nband) ) should be a mutltiple of npband*bandpp.',ch10,&
340 : 0 : 'Change nband, npband or bandpp in the input.',ch10,&
341 : 0 : 'A simpler solution is to use nblock_lobpcg instead of bandpp.'
342 : 0 : ABI_ERROR(msg)
343 : : end if
344 : : else
345 [ + - ]: 402 : if (mod(mband_upper,dtsets(idtset)%nblock_lobpcg*dtsets(idtset)%npband)==0) then
346 : 402 : dtsets(idtset)%bandpp=mband_upper/(dtsets(idtset)%nblock_lobpcg*dtsets(idtset)%npband)
347 : : else
348 : 0 : write(msg,'(3a)') 'mband_upper( =max_{kpt}(nband) ) should be a mutltiple of nblock_lobpcg*npband.',ch10,&
349 : 0 : 'Change nband, npband or nblock_lobpcg in the input.'
350 : 0 : ABI_ERROR(msg)
351 : : end if
352 : : end if
353 : : else ! autoparal /= 0
354 : : ! check if nblock_lobpcg is read from the input, if so error msg
355 : 53 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'nblock_lobpcg',tread0,'INT')
356 [ - + ]: 53 : if (tread0==1) then
357 : 0 : write(msg,'(3a)') 'When using autoparal, nblock_lobpcg is automatically set, so it cannot be in the input.',ch10,&
358 : 0 : 'Change the input to keep only autoparal or nblock_lobpcg.'
359 : 0 : ABI_ERROR(msg)
360 : : end if
361 : 53 : dtsets(idtset)%nblock_lobpcg=mband_upper/(dtsets(idtset)%bandpp*dtsets(idtset)%npband)
362 : : end if
363 : : end if
364 : :
365 : : ! Warning when using different number of bands for different kpoints (occopt=2)
366 [ + + + + : 7012 : if ( dtsets(idtset)%occopt==2 .and. dtsets(idtset)%nkpt>1 .and. &
+ - - + ]
367 : : & ((dtsets(idtset)%bandpp > 1) .or. (dtsets(idtset)%npband > 1)) ) then
368 : : write(msg, '(4a)' ) &
369 : : 'When working with blocks of bands (bandpp>1 or npband>1),'&
370 : 0 : &' the number of bands should be the same for every kpoints.',ch10,&
371 : 0 : &' The run will most probably fail on a other check. If it does not fail, ignore this message.'
372 : 0 : ABI_WARNING(msg)
373 : : end if
374 : :
375 : 7012 : dtsets(idtset)%densfor_pred=2
376 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'densfor_pred',tread0,'INT')
377 [ + + ]: 7012 : if(tread0==1) then
378 : 67 : dtsets(idtset)%densfor_pred=intarr(1)
379 : : else
380 [ + + ]: 6945 : if (dtsets(idtset)%paral_kgb==1) dtsets(idtset)%densfor_pred=6
381 : : end if
382 : : if((dtsets(idtset)%iscf==5.or.dtsets(idtset)%iscf==6) &
383 [ + + + + : 7012 : .and. dtsets(idtset)%ionmov==4 .and. dtsets(idtset)%densfor_pred/=3 )then
+ - ]
384 : 1 : dtsets(idtset)%densfor_pred=3
385 : : write(msg, '(a,a,a)' )&
386 : 1 : 'When ionmov==4 and iscf==5 or 6, densfor_pred must be 3.',ch10,&
387 : 2 : 'Set densfor_pred to 3.'
388 : 1 : ABI_COMMENT(msg)
389 : : end if
390 : :
391 : : #ifdef HAVE_LOTF
392 : : ! LOTF need densfor_pred=2
393 : : if(dtsets(idtset)%ionmov==23) dtsets(idtset)%densfor_pred=2
394 : : #endif
395 : :
396 [ + + ]: 7012 : if (usepaw==0) then
397 : 5796 : dtsets(idtset)%ortalg=2
398 : : else
399 : 1216 : dtsets(idtset)%ortalg=-2
400 : : end if
401 : 7012 : ortalg_read=.false.
402 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'ortalg',tread0,'INT')
403 [ + + ]: 7012 : if(tread0==1) then
404 : 17 : dtsets(idtset)%ortalg=intarr(1)
405 : 17 : ortalg_read=.true.
406 [ + + + + ]: 6995 : else if (dtsets(idtset)%wfoptalg>=10 .and. dtsets(idtset)%ortalg>0) then
407 : 205 : dtsets(idtset)%ortalg=-dtsets(idtset)%ortalg
408 : : end if
409 : :
410 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'iomode',tread0,'INT')
411 [ + + ]: 7012 : if(tread0==1) then
412 : 187 : dtsets(idtset)%iomode=intarr(1)
413 : : else
414 : : if ((xmpi_mpiio==1).and.(dtsets(idtset)%paral_kgb==1)) dtsets(idtset)%iomode=IO_MODE_MPI
415 : : #ifdef HAVE_NETCDF_DEFAULT
416 : 6825 : dtsets(idtset)%iomode=IO_MODE_ETSF
417 : : #endif
418 : : end if
419 : :
420 : 7012 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'pawmixdg',tread0,'INT')
421 [ + + ]: 7012 : if(tread0==1) then
422 : 51 : dtsets(idtset)%pawmixdg=intarr(1)
423 [ + + + + ]: 6961 : else if (dtsets(idtset)%npfft>1.and.usepaw==1) then
424 : 140 : dtsets(idtset)%pawmixdg=1
425 : : end if
426 : :
427 : : ! Cycle if the processor is not used
428 [ + - + + ]: 7012 : if (mpi_enregs(idtset)%me<0.or.iexit>0) then
429 [ - + ]: 1 : ABI_FREE(intarr)
430 [ - + ]: 1 : ABI_FREE(dprarr)
431 : 1 : cycle
432 : : end if
433 : :
434 : 7011 : response=0
435 : : if (dtsets(idtset)%rfddk/=0 .or. dtsets(idtset)%rf2_dkdk/=0 .or. dtsets(idtset)%rf2_dkde/=0 .or. &
436 [ + + + + : 7011 : & dtsets(idtset)%rfelfd/=0 .or. dtsets(idtset)%rfphon/=0 .or. dtsets(idtset)%rfstrs/=0 .or. &
+ + + + +
+ + + +
+ ]
437 : 723 : & dtsets(idtset)%rfmagn/=0) response=1
438 : :
439 : : ! If no MPI, set all npxxx variables to 1
440 [ + + ]: 7011 : if (nproc==1) then
441 : 5773 : dtsets(idtset)%np_spkpt = 1 ; dtsets(idtset)%npband = 1
442 : 5773 : dtsets(idtset)%npfft = 1 ; dtsets(idtset)%npspinor = 1
443 : 5773 : dtsets(idtset)%nphf = 1
444 : : end if
445 : :
446 : : ! --IF CUDA AND RECURSION:ONLY BAND PARALLELISATION
447 [ + + + + ]: 7011 : if(dtsets(idtset)%tfkinfunc==2 .and. nproc/=1)then
448 : 4 : dtsets(idtset)%npband = dtsets(idtset)%npband*dtsets(idtset)%np_spkpt*dtsets(idtset)%npspinor*dtsets(idtset)%npfft
449 : 4 : dtsets(idtset)%bandpp=1
450 : 4 : dtsets(idtset)%np_spkpt = 1
451 : 4 : dtsets(idtset)%npfft = 1
452 : 4 : dtsets(idtset)%npspinor = 1
453 : : write(msg, '(5a,i6,a)' )&
454 : 4 : 'If the recursion scheme is used (tfkinfunc==2),',ch10,&
455 : 4 : 'only the band parallelisation is active, we set:',ch10,&
456 : 8 : 'npfft= 1, np_spkpt= 1, npband=',dtsets(idtset)%npband,' .'
457 : 4 : ABI_WARNING(msg)
458 : : end if
459 : :
460 [ + + - + ]: 7011 : if (dtsets(idtset)%npspinor>=2.and.dtsets(idtset)%nspinor==1) then
461 : 0 : dtsets(idtset)%npspinor=1
462 : 0 : dtsets(idtset)%npfft=2*dtsets(idtset)%npfft
463 : : write(msg,'(3a)')&
464 : 0 : 'npspinor is bigger than nspinor !',ch10,&
465 : 0 : 'We set npspinor to 1 ; we set npfft to 2*npfft'
466 : 0 : ABI_WARNING(msg)
467 : : end if
468 : :
469 : : ! Some checks on parallelization data
470 [ + - ]: 7011 : if(dtsets(idtset)%paral_kgb < 0 ) then
471 : : cycle
472 [ + + + + : 7011 : else if(dtsets(idtset)%paral_kgb/=0.and.(dtsets(idtset)%bandpp/=1.or.dtsets(idtset)%npband/=1.or.&
+ + - + -
- - - ]
473 : : dtsets(idtset)%npfft/=1.or.dtsets(idtset)%np_spkpt/=1.or.dtsets(idtset)%npspinor/=1))then
474 [ - + ]: 628 : if(dtsets(idtset)%np_spkpt*dtsets(idtset)%npfft*dtsets(idtset)%npband*dtsets(idtset)%npspinor > nproc )then
475 : : write(msg,'(7a)')&
476 : 0 : 'The product of np_spkpt, npfft, npband and npspinor is bigger than the number of processors.',ch10,&
477 : 0 : 'The user-defined values of np_spkpt, npfft, npband or npspinor will be modified,',ch10,&
478 : 0 : 'in order to bring this product below nproc .',ch10,&
479 : 0 : 'At present, only a very simple algorithm is used ...'
480 : 0 : ABI_WARNING(msg)
481 : :
482 [ # # ]: 0 : if(dtsets(idtset)%np_spkpt*dtsets(idtset)%npband*dtsets(idtset)%npspinor <= nproc) then
483 : 0 : dtsets(idtset)%npfft=1
484 : 0 : ABI_WARNING('Set npfft to 1')
485 [ # # ]: 0 : else if(dtsets(idtset)%np_spkpt*dtsets(idtset)%npspinor <= nproc)then
486 : 0 : dtsets(idtset)%npfft=1
487 : 0 : dtsets(idtset)%npband=1
488 : 0 : ABI_WARNING('Set npfft and npband to 1')
489 [ # # ]: 0 : else if(dtsets(idtset)%np_spkpt <= nproc)then
490 : 0 : dtsets(idtset)%npfft=1
491 : 0 : dtsets(idtset)%npband=1
492 : 0 : dtsets(idtset)%npspinor=1
493 : 0 : ABI_WARNING('Set npfft ,npband and npspinor to 1')
494 : : else
495 : 0 : dtsets(idtset)%npfft=1
496 : 0 : dtsets(idtset)%npband=1
497 : 0 : dtsets(idtset)%np_spkpt=1
498 : 0 : dtsets(idtset)%npspinor=1
499 : 0 : ABI_WARNING('Set npfft, npband, nspinor and np_spkpt to 1')
500 : : end if
501 [ - + ]: 628 : else if(dtsets(idtset)%np_spkpt*dtsets(idtset)%npfft*dtsets(idtset)%npband*dtsets(idtset)%npspinor < nproc)then
502 : : write(msg,'(a,5i6,4a)')&
503 : 0 : 'np_spkpt,npfft,npband,npspinor,nproc=',&
504 : 0 : & dtsets(idtset)%np_spkpt,dtsets(idtset)%npfft,dtsets(idtset)%npband,dtsets(idtset)%npspinor,nproc,ch10,&
505 : 0 : 'The number of processors must not be greater than npfft*npband*np_spkpt*npspinor ',ch10,&
506 : 0 : 'when npfft or np_spkpt or npband or npspinor are chosen manually in the input file.'
507 : 0 : ABI_ERROR(msg)
508 : : end if
509 : : end if
510 : :
511 : : ! LOBPCG and ChebFi need paral_kgb=1 in parallel
512 [ + + ]: 630 : if ((dtsets(idtset)%npband*dtsets(idtset)%npfft>1).and. &
513 [ + + ]: 7011 : & (mod(dtsets(idtset)%wfoptalg,10)==1.or.mod(dtsets(idtset)%wfoptalg,10)==4)) then
514 : 582 : dtsets(idtset)%paral_kgb=1
515 : : end if
516 : :
517 : : ! Check size of Scalapack communicator
518 : : #ifdef HAVE_LINALG_ELPA
519 : : if(dtsets(idtset)%paral_kgb>0.and.dtsets(idtset)%np_slk>0) then
520 : : np=min(dtsets(idtset)%np_slk,dtsets(idtset)%npband*dtsets(idtset)%npfft*dtsets(idtset)%npspinor)
521 : : irow=int(sqrt(float(np)))
522 : : do while(mod(np,irow)/=0)
523 : : irow=irow-1
524 : : end do
525 : : icol=nproc/irow
526 : : if (icol>mband_lower) then
527 : : do while(icol>mband_lower)
528 : : icol=icol-1
529 : : do while(mod(np,icol)/=0)
530 : : icol=icol-1
531 : : end do
532 : : end do
533 : : dtsets(idtset)%np_slk=icol
534 : : write(msg,'(5a,i6,a)')&
535 : : 'The number of band*fft*spinor processors was not consistent with',ch10,&
536 : : 'the size of communicator used for ELPA library (np_slk).',ch10,&
537 : : 'np_slk value has been adjusted to ',dtsets(idtset)%np_slk,'.'
538 : : ABI_COMMENT(msg)
539 : : end if
540 : : end if
541 : : #endif
542 : :
543 : : !Additional check in case of a parallelized Hartree-Fock calculation
544 : : ! %usefock == option to perform Fock exchange calculation
545 : : ! %nphf == number of processors for Fock exchange calculation
546 [ + + - + ]: 7011 : if ((dtsets(idtset)%usefock==1).and.(dtsets(idtset)%nphf/=1)) then
547 : :
548 [ # # ]: 0 : if ((dtsets(idtset)%nphf<0).or.(dtsets(idtset)%nphf==0)) then
549 : 0 : ABI_ERROR('The value of variable nphf should be a non negative integer.')
550 : : end if
551 [ # # ]: 0 : if (dtsets(idtset)%paral_kgb/=0) then
552 : 0 : ABI_ERROR('Option paral_kgb should be turned off (value 0) for a parallelized Hartree-Fock calculation.')
553 : : end if
554 [ # # ]: 0 : if (response/=0) then
555 : 0 : ABI_ERROR('A response function calculation is not yet possible with a parallelized Hartree-Fock calculation.')
556 : : end if
557 [ # # ]: 0 : if (dtsets(idtset)%npspinor>1) then
558 : 0 : ABI_ERROR('The parallelism on spinors is not supported by a parallelized Hartree-Fock calculation.')
559 : : end if
560 [ # # ]: 0 : if (dtsets(idtset)%np_spkpt*dtsets(idtset)%nphf > nproc )then
561 : 0 : write(msg,'(a,3(a,i0))') ch10,&
562 : 0 : 'The product of variables np_spkpt and nphf is bigger than the number of processors: np_spkpt= ',&
563 : 0 : dtsets(idtset)%np_spkpt,' nphf= ',dtsets(idtset)%nphf ,' and nproc= ', nproc
564 : 0 : ABI_ERROR(msg)
565 : : end if
566 : : end if ! Fock
567 : :
568 : : !When using chebfi, the number of blocks is equal to the number of processors
569 : : if((dtsets(idtset)%wfoptalg == 1) .or. (dtsets(idtset)%wfoptalg == 111) .or. &
570 [ + + + - : 7011 : & (dtsets(idtset)%wfoptalg == 2) .or. (dtsets(idtset)%wfoptalg == 112)) then
+ + ]
571 : : !Nband might have different values for different kpoint, but not bandpp.
572 : : !In this case, we just use the largest nband (mband_upper), and the input will probably fail
573 : : !at the bandpp check later on
574 : 225 : dtsets(idtset)%bandpp = mband_upper / dtsets(idtset)%npband
575 [ - + ]: 225 : if(tread(8)==1) then
576 : : write(msg, '(a,i8,3a)' ) &
577 : 0 : 'bandpp has been internally set to ',dtsets(idtset)%bandpp,'.',ch10,&
578 : : 'Indeed, there is no need to specify bandpp in the input when using chebfi (wfoptalg=1,111)&
579 : 0 : or spectrum slicing (wfoptalg=2,112).'
580 : 0 : ABI_COMMENT(msg)
581 : : end if
582 : : end if
583 : :
584 : : !Check parallelization in case of RTTDDFT
585 : : !In particular ensure that bandpp = nband / npband
586 [ + + ]: 7011 : if (optdriver == RUNL_RTTDDFT) then
587 : 50 : dtsets(idtset)%bandpp = mband_upper / dtsets(idtset)%npband
588 [ - + ]: 50 : if ( tread(8) == 1 ) then
589 : 0 : write(msg, '(a,a)') 'Setting bandpp is useless in RT-TDDFT because it is automatically set to nband/npband.', ch10
590 : 0 : ABI_WARNING(msg)
591 : : end if
592 [ - + ]: 50 : if (dtsets(idtset)%npfft/=1) then
593 : 0 : dtsets(idtset)%npfft=1
594 : 0 : write(msg, '(a,a)') 'RT-TDDFT is not compatible with FFT-parallelization. Remove npfft or set it to 1.', ch10
595 : 0 : ABI_ERROR(msg)
596 : : end if
597 [ - + ]: 50 : if (dtsets(idtset)%npspinor/=1) then
598 : 0 : dtsets(idtset)%npspinor=1
599 : 0 : write(msg, '(a,a)') 'RT-TDDFT is not compatible with spinor parallelization. Remove npspinor or set it to 1.', ch10
600 : 0 : ABI_ERROR(msg)
601 : : end if
602 [ - + ]: 50 : if (dtsets(idtset)%nphf/=1) then
603 : 0 : dtsets(idtset)%nphf=1
604 : 0 : write(msg, '(a,a)') 'RT-TDDFT is not compatible with HF parallelization. Remove nphf or set it to 1.', ch10
605 : 0 : ABI_ERROR(msg)
606 : : end if
607 : : end if
608 : :
609 : : ! Set mpi_enreg
610 : 7011 : mpi_enregs(idtset)%paral_kgb=dtsets(idtset)%paral_kgb
611 [ + + ]: 7011 : if(dtsets(idtset)%paral_kgb/=0)then
612 : 628 : mpi_enregs(idtset)%nproc_spkpt=dtsets(idtset)%np_spkpt
613 : 628 : mpi_enregs(idtset)%nproc_fft=dtsets(idtset)%npfft
614 : 628 : mpi_enregs(idtset)%nproc_band=dtsets(idtset)%npband
615 : 628 : mpi_enregs(idtset)%nproc_spinor=min(dtsets(idtset)%npspinor,dtsets(idtset)%nspinor)
616 : 628 : mpi_enregs(idtset)%bandpp=dtsets(idtset)%bandpp
617 : : ! Additional setting in case of hybrid functional calculation => not yet tested (CMartins)
618 : : ! if (dtsets(idtset)%usefock==1) then
619 : : ! mpi_enregs(idtset)%nproc_hf = dtsets(idtset)%nphf
620 : : ! if (dtsets(idtset)%nphf>1) mpi_enregs(idtset)%paral_hf=1
621 : : ! end if
622 : : else
623 : 6383 : mpi_enregs(idtset)%bandpp = dtsets(idtset)%bandpp
624 : : ! Additional setting in case of a Fock exchange of PBE0 calculation
625 [ + + ]: 6383 : if (dtsets(idtset)%usefock==1) then
626 [ - + ]: 146 : if (dtsets(idtset)%nphf>1) mpi_enregs(idtset)%paral_hf=1
627 : 146 : mpi_enregs(idtset)%nproc_hf = dtsets(idtset)%nphf
628 [ - + ]: 146 : if (dtsets(idtset)%np_spkpt/=1) then
629 : 0 : mpi_enregs(idtset)%nproc_spkpt = dtsets(idtset)%np_spkpt
630 : : else
631 : 146 : mpi_enregs(idtset)%nproc_spkpt = mpi_enregs(idtset)%nproc_cell/mpi_enregs(idtset)%nproc_hf
632 : : end if
633 : : else
634 : 6237 : mpi_enregs(idtset)%nproc_spkpt = mpi_enregs(idtset)%nproc_cell
635 : : end if
636 : : end if
637 : :
638 [ + - ]: 7011 : if(dtsets(idtset)%paral_kgb>=0) then
639 : :
640 : : ! Compute processor distribution over perturbations
641 : 7011 : mpi_enregs(idtset)%paral_pert=dtsets(idtset)%paral_rf
642 [ + + ]: 7011 : if (mpi_enregs(idtset)%paral_pert==1) then
643 : 26 : dtsets(idtset)%nppert=max(1,dtsets(idtset)%nppert)
644 [ - + ]: 26 : if(dtsets(idtset)%nppert>mpi_enregs(idtset)%nproc) then
645 : 0 : ABI_ERROR('The number of processors must not be smaller than nppert !')
646 : : end if
647 : 26 : call initmpi_pert(dtsets(idtset),mpi_enregs(idtset))
648 : 26 : mpi_enregs(idtset)%nproc_spkpt = mpi_enregs(idtset)%nproc_cell
649 : 26 : nproc=mpi_enregs(idtset)%nproc_cell
650 : : end if
651 : : ! Cycle if the processor is not used
652 [ - + ]: 7011 : if (mpi_enregs(idtset)%me<0) then
653 [ # # ]: 0 : ABI_FREE(intarr)
654 [ # # ]: 0 : ABI_FREE(dprarr)
655 : 0 : cycle
656 : : end if
657 : :
658 : : ! Compute processor distribution over kpt (and eventually band-fft)
659 : 7011 : call initmpi_grid(mpi_enregs(idtset))
660 [ - + ]: 7011 : if(dtsets(idtset)%usewvl==1) mpi_enregs(idtset)%comm_fft=mpi_enregs(idtset)%comm_cell
661 : :
662 : : ! Initialize tabs used for k/spin parallelism (with sequential-type values)
663 [ - + + - : 35055 : ABI_MALLOC(mpi_enregs(idtset)%proc_distrb,(nkpt,mband_upper,nsppol))
- + + - -
+ + - + -
+ - - + -
+ - + ]
664 [ - + + - : 21033 : ABI_MALLOC(mpi_enregs(idtset)%my_kpttab,(nkpt))
+ - + - -
+ - + -
+ ]
665 [ + + + + : 1066505 : mpi_enregs(idtset)%proc_distrb(:,:,:)=0
+ + ]
666 [ + - + + : 234507 : mpi_enregs(idtset)%my_kpttab(:)=(/(ii,ii=1,nkpt)/)
+ + ]
667 [ + + + + ]: 21033 : mpi_enregs(idtset)%my_isppoltab(:)=1;if (dtsets(idtset)%nsppol==1) mpi_enregs(idtset)%my_isppoltab(2)=0
668 : :
669 : : ! HF or hybrid calculation : initialization of the array distrb_hf
670 [ + + ]: 7011 : if (dtsets(idtset)%usefock==1) then
671 [ - + + - : 584 : ABI_MALLOC(mpi_enregs(idtset)%distrb_hf,(dtsets(idtset)%nkpthf,dtsets(idtset)%nbandhf,1))
- + + - +
- + - - +
- + - + ]
672 : : ! The dimension of distrb_hf are given by %nkpthf and %nbandhf.
673 : : ! We assume that there will be no dependence in spinpol for all the occupied states.
674 [ + + + + : 12676 : mpi_enregs(idtset)%distrb_hf=0
+ + ]
675 : : end if
676 : :
677 : : ! Define k-points distribution (determine who I am)
678 : : ! Note that nkpt_me may differ from processor to processor
679 : : ! This fact will NOT be taken into account when
680 : : ! the memory needs will be evaluated in the subroutine memory.
681 : : ! Also, the reduction of k points due to symmetry in RF calculations
682 : : ! is NOT taken into account. This should be changed later ...
683 : 7011 : nkpt_me=nkpt
684 : 7011 : mband_mem=0
685 [ + - ]: 7011 : if(xmpi_paral==1 .and. dtsets(idtset)%usewvl == 0) then
686 : 7011 : nkpt_me=0
687 [ + + + + ]: 7011 : if(response==0 .or. (response==1 .and. dtsets(idtset)%efmas==1))then
688 : 6305 : mpi_enregs(idtset)%paralbd=0
689 : 6305 : call distrb2(mband_upper,mband_mem,dtsets(idtset)%nband,nkpt,nproc,nsppol,mpi_enregs(idtset))
690 [ + + ]: 64503 : do iikpt=1,nkpt
691 [ + + ]: 58198 : if(.not.(proc_distrb_cycle(mpi_enregs(idtset)%proc_distrb,iikpt,1,1,-1,mpi_enregs(idtset)%me_kpt)))&
692 : 56463 : & nkpt_me=nkpt_me+1
693 : : end do ! ikpt=1,nkpt
694 : : ! HF or hybrid calculation : define the occupied states distribution (in array distrb_hf)
695 [ + + ]: 6305 : if (dtsets(idtset)%usefock==1) then
696 : 146 : call distrb2_hf(dtsets(idtset)%nbandhf,dtsets(idtset)%nkpthf,nproc,nsppol,mpi_enregs(idtset))
697 : : end if
698 : : else ! response==1
699 : : ! TODO: check or remove the following comment which seems outdated
700 : : ! Wrongly assumes that the number of elements of the
701 : : ! k-point sets of the two spin polarizations is the maximal
702 : : ! value of one of these k-point sets ...
703 : : ! This is to be corrected when RF is implemented
704 : : ! for spin-polarized case.
705 : : ! ENDTODO
706 : 706 : mpi_enregs(idtset)%paralbd=1
707 : : ! nproc=mpi_enregs(idtset)%nproc_cell*mpi_enregs(idtset)%nproc_pert
708 : 706 : call distrb2(mband_upper,mband_mem,dtsets(idtset)%nband,nkpt,nproc,nsppol,mpi_enregs(idtset))
709 [ + + ]: 1474 : do isppol=1,nsppol
710 : 768 : nspink=0
711 [ + + ]: 57130 : do iikpt=1,nkpt
712 [ + + ]: 119736 : do iband=1,dtsets(idtset)%nband(iikpt+(isppol-1)*nkpt)
713 [ + + ]: 118968 : if(mpi_enregs(idtset)%proc_distrb(iikpt,iband,isppol)==mpi_enregs(idtset)%me_cell)then
714 : 44682 : nspink=nspink+1
715 : 44682 : exit
716 : : end if
717 : : end do ! iband
718 : : end do ! iikpt
719 [ + + ]: 1474 : if(nspink>nkpt_me)nkpt_me=nspink
720 : : end do ! isppol
721 : : ! Is nband present in input file or automatically estimated ?
722 : : tnband=0
723 : 706 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'nband',tnband,'INT')
724 : : ! If the number of bands was estimated, there might be a side effect
725 : : ! when the definitive number of bands is known. k points
726 : : ! might be attributed to different processors than the present
727 : : ! proc_distrb describes. At most, the number of k points could increase by 1 ...
728 [ + + ]: 706 : if(tnband==0)nkpt_me=nkpt_me+1
729 : : ! In any case, the maximal number of k points is nkpt
730 [ + + ]: 706 : if(nkpt_me>nkpt)nkpt_me=nkpt
731 : :
732 : : ! mband_mem
733 [ - + + - : 2118 : ABI_MALLOC (mybands, (mband_upper))
+ - + - -
+ - + ]
734 : 706 : mband_mem = 0
735 [ + + ]: 1474 : do isppol=1,nsppol
736 [ + + ]: 57836 : do iikpt=1,nkpt
737 [ + + ]: 395685 : mybands = 0
738 [ + + ]: 395665 : do iband=1,dtsets(idtset)%nband(iikpt+(isppol-1)*nkpt)
739 [ + + ]: 395665 : if(mpi_enregs(idtset)%proc_distrb(iikpt,iband,isppol)==mpi_enregs(idtset)%me_band)then
740 : 276619 : mybands(iband)=1
741 : : end if
742 : : end do ! iband
743 [ + + ]: 396453 : mband_mem = max(mband_mem, sum(mybands))
744 : : end do ! iikpt
745 : : end do ! isppol
746 [ - + ]: 706 : ABI_FREE (mybands)
747 : : end if ! response case
748 : : end if
749 : : end if
750 [ - + ]: 7011 : if (mband_mem == 0) mband_mem = mband_upper
751 : 7011 : dtsets(idtset)%mband_mem = mband_mem
752 : :
753 : : ! Take care of mkmems. Use the generic name -mkmem- for mkmem as well as mkqmem
754 : : ! and mk1mem.
755 : 7011 : nm_mkmem(1)='mkmem '
756 : 7011 : nm_mkmem(2)='mkqmem'
757 : 7011 : nm_mkmem(3)='mk1mem'
758 : :
759 [ + + ]: 28044 : do ii=1,3
760 : :
761 : : ! Read in mkmem here if it is in the input file
762 : : ! TODO: mkmem is not supported any longer. These variables can be removed.
763 [ + + ]: 21033 : if(ii==1)then
764 : 7011 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'mkmem',tread0,'INT')
765 [ + + ]: 14022 : else if(ii==2)then
766 : 7011 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'mkqmem',tread0,'INT')
767 : : else if(ii==3)then
768 : 7011 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'mk1mem',tread0,'INT')
769 : : end if
770 : :
771 : :
772 : : ! Note that mkmem is used as a dummy variable, representing mkmem as well
773 : : ! as mkqmem, and mk1mem.
774 [ - + ]: 21033 : if(tread0==1) then
775 : 0 : mkmem=intarr(1)
776 [ # # ]: 0 : if (mkmem<0) then
777 : : ! mkmem is unreasonable; must be zero or positive
778 : : write(msg, '(4a,i0,4a)')&
779 : 0 : nm_mkmem(ii),' must be positive or null but ',nm_mkmem(ii),' =',mkmem,ch10,&
780 : 0 : 'Use default ',nm_mkmem(ii),' = nkpt .'
781 : 0 : ABI_WARNING(msg)
782 : 0 : mkmem=nkpt
783 : : end if
784 : :
785 : : else
786 : :
787 : : ! mkmem was not set in the input file so default to incore solution
788 : : !write(msg,'(6a)') &
789 : : !'mpi_setup: ',nm_mkmem(ii),' undefined in the input file.','Use default ',nm_mkmem(ii),' = nkpt'
790 : : !call wrtout(std_out, msg)
791 : 21033 : mkmem=nkpt
792 : : end if
793 : :
794 : : ! Check whether nkpt distributed on the processors <= mkmem;
795 : : ! if so then may run entirely in core,
796 : : ! avoiding i/o to disk for wavefunctions and kg data.
797 : : ! mkmem/=0 to avoid i/o; mkmem==0 to use disk i/o for nkpt>=1.
798 [ + - + - ]: 21033 : if (nkpt_me<=mkmem .and. mkmem/=0 ) then
799 : : write(msg, '(a,i0,a,a,a,i0,a)' ) &
800 : 21033 : ' mpi_setup: With nkpt_me=',nkpt_me,' and ',nm_mkmem(ii),' = ',mkmem,', ground state wf handled in core.'
801 [ + + ]: 21033 : if (prtvol > 0) call wrtout(std_out,msg)
802 [ + + + + ]: 21033 : if(nkpt_me<mkmem .and. nkpt_me/=0)then
803 : 1902 : write(msg,'(3a)')' Resetting ',nm_mkmem(ii),' to nkpt_me to save memory space.'
804 : 1902 : mkmem=nkpt_me
805 [ + + ]: 1902 : if (prtvol > 0) call wrtout(std_out,msg)
806 : : end if
807 [ # # ]: 0 : else if(mkmem/=0)then
808 : : write(msg, '(a,i0,3a,i0,5a)' ) &
809 : 0 : ' mpi_setup: With nkpt_me=',nkpt_me,'and ',nm_mkmem(ii),' = ',mkmem,&
810 : 0 : ' ground state wf require disk i/o.',ch10,&
811 : 0 : ' Resetting ',nm_mkmem(ii),' to zero to save memory space.'
812 : 0 : mkmem=0
813 [ # # ]: 0 : if (prtvol > 0) call wrtout(std_out,msg)
814 : : end if
815 [ - + - - ]: 21033 : if(dtsets(idtset)%usewvl == 0 .or. dtsets(idtset)%usepaw==1)then
816 [ + + ]: 21033 : if(ii==1)dtsets(idtset)%mkmem=mkmem
817 : : end if
818 [ + + ]: 21033 : if(ii==2)dtsets(idtset)%mkqmem=mkmem
819 [ + + ]: 21033 : if(ii==3)dtsets(idtset)%mk1mem=mkmem
820 : :
821 [ - + - - ]: 28044 : if(dtsets(idtset)%usewvl == 1 .and. dtsets(idtset)%usepaw==1 )then
822 [ # # ]: 0 : if(dtsets(idtset)%mkmem .ne. dtsets(idtset)%nkpt) then
823 : 0 : ABI_ERROR("mkmem is not allowed for WVL+PAW")
824 : : end if
825 : : end if
826 : :
827 : : end do ! End the loop on the three possibilities mkmem, mkqmem, mk1mem.
828 : :
829 [ + + ]: 7011 : if(dtsets(idtset)%paral_kgb==1) mpi_enregs(idtset)%paralbd=0
830 : :
831 : : ! Check if some MPI processes are empty (MBPT codes uses a complete different MPI algorithm)
832 [ + + + + ]: 40187 : do_check = all(optdriver /= [RUNL_SCREENING, RUNL_SIGMA, RUNL_BSE, RUNL_EPH, RUNL_GWR])
833 [ + - + + ]: 7011 : if (dtsets(idtset)%usewvl == 0 .and. do_check) then
834 [ + + ]: 6517 : if (.not.mpi_distrib_is_ok(mpi_enregs(idtset),mband_upper,&
835 : : dtsets(idtset)%nkpt,dtsets(idtset)%mkmem,nsppol,msg=msg)) then
836 : 74 : write(msg,'(5a)') trim(msg),ch10,&
837 : 74 : 'YOU ARE STRONGLY ADVISED TO ACTIVATE AUTOMATIC PARALLELIZATION!',ch10,&
838 : 148 : 'USE "AUTOPARAL=1" IN THE INPUT FILE.'
839 : 74 : ABI_WARNING(msg)
840 : : end if
841 : : end if
842 : :
843 : : ! call mpi_setup1(dtsets(idtset),jdtset,lenstr,mband_upper,mpi_enregs(idtset),string)
844 : : ! Printing of processor distribution
845 : : ! MPIWF : here, set up the complete ngfft, containing the information
846 : : ! for the parallelisation of the FFT
847 : 7011 : call abi_io_redirect(new_io_comm=mpi_enregs(idtset)%comm_world)
848 : 7011 : call libpaw_write_comm_set(mpi_enregs(idtset)%comm_world)
849 : :
850 : : ! Default values for sequential case
851 : 7011 : paral_fft=0; nproc_fft=1; me_fft=0
852 : :
853 [ + - ]: 7011 : if(dtsets(idtset)%usewvl == 0)then
854 [ + + ]: 7011 : if(optdriver==RUNL_GSTATE.or.optdriver==RUNL_GWLS) then
855 : 5685 : paral_fft=1 ! parallelisation over FFT
856 [ + - ]: 5685 : if (mpi_enregs(idtset)%nproc_cell>0) then
857 [ + + ]: 5685 : if(mpi_enregs(idtset)%paral_kgb == 1) then
858 : :
859 [ - + - - ]: 596 : if((dtsets(idtset)%gpu_option/=ABI_GPU_DISABLED).and.(mpi_enregs(idtset)%nproc_fft/=1))then
860 : : write(msg,'(3a,i0)') &
861 : 0 : 'When the use of GPU is on, the number of FFT processors, npfft, must be 1',ch10,&
862 : 0 : 'However, npfft=',mpi_enregs(idtset)%nproc_fft
863 : 0 : ABI_ERROR(msg)
864 : : end if
865 : :
866 [ + + ]: 596 : if((dtsets(idtset)%cprj_in_memory/=0)) then
867 [ - + ]: 122 : if (mpi_enregs(idtset)%nproc_spinor/=1) then
868 : : write(msg,'(3a,i0)') &
869 : 0 : 'If cprj_in_memory/=0, the number of processors for spinors, npspinor, must be 1',ch10,&
870 : 0 : 'However, npspinor=',mpi_enregs(idtset)%nproc_spinor
871 : 0 : ABI_ERROR(msg)
872 : : end if
873 [ - + ]: 122 : if(mpi_enregs(idtset)%nproc_fft/=1)then
874 : : write(msg,'(3a,i0)') &
875 : 0 : 'If cprj_in_memory/=0, the number of FFT processors, npfft, must be 1',ch10,&
876 : 0 : 'However, npfft=',mpi_enregs(idtset)%nproc_fft
877 : 0 : ABI_ERROR(msg)
878 : : end if
879 : : end if
880 : :
881 [ - + ]: 596 : if(modulo(dtsets(idtset)%ngfft(2),mpi_enregs(idtset)%nproc_fft)/=0)then
882 : : write(msg,'(3a,i0,a,i0)') &
883 : 0 : 'The number of FFT processors, npfft, should be a multiple of ngfft(2).',ch10,&
884 : 0 : 'However, npfft=',mpi_enregs(idtset)%nproc_fft,' and ngfft(2)=',dtsets(idtset)%ngfft(2)
885 : 0 : ABI_BUG(msg)
886 : : end if
887 : :
888 [ + + ]: 4040 : do iikpt=1,nkpt*nsppol
889 : 3444 : iikpt_modulo = modulo(iikpt,nkpt)+1
890 [ + + ]: 4040 : if ((dtsets(idtset)%istwfk(iikpt_modulo)==2)) then !.and.(dtsets(idtset)%ngfft(7)==401)) then
891 [ + - + + : 171 : if ((mpi_enregs(idtset)%bandpp==0).or. &
- + ]
892 : : ((mpi_enregs(idtset)%bandpp/=1).and.(modulo(mpi_enregs(idtset)%bandpp,2)/=0))) then
893 : : write(msg,'(3a,i0)') &
894 : 0 : 'The number bandpp should be 1 or a multiple of 2',ch10,&
895 : 0 : 'However, bandpp=',mpi_enregs(idtset)%bandpp
896 : 0 : ABI_BUG(msg)
897 : : end if
898 [ - + ]: 171 : if(modulo(dtsets(idtset)%nband(iikpt),mpi_enregs(idtset)%nproc_band*mpi_enregs(idtset)%bandpp)/=0)then
899 : : write(msg,'(3a,i0,a,i0)') &
900 : 0 : 'The number of bands for the k-point, nband_k, should be a multiple of nproc_band*bandpp.',ch10,&
901 : 0 : 'However, nband_k=',dtsets(idtset)%nband(iikpt),' and nproc_band*bandpp=', &
902 : 0 : mpi_enregs(idtset)%nproc_band* mpi_enregs(idtset)%bandpp
903 : 0 : ABI_BUG(msg)
904 : : end if
905 : : else if ((dtsets(idtset)%istwfk(iikpt_modulo)==2) .and. (dtsets(idtset)%ngfft(7)==400)) then
906 : : ABI_BUG('The fftalg=400 with istwfk=2 is not valid')
907 : : else
908 [ - + ]: 3273 : if(modulo(dtsets(idtset)%nband(iikpt),mpi_enregs(idtset)%nproc_band*mpi_enregs(idtset)%bandpp)/=0)then
909 : : write(msg,'(3a,i0,a,i0)') &
910 : 0 : 'The number of band for the k-point, nband_k, should be a multiple of nproc_band*bandpp.',ch10,&
911 : 0 : 'However, nband_k=',dtsets(idtset)%nband(iikpt),' and nproc_band*bandpp=', &
912 : 0 : mpi_enregs(idtset)%nproc_band* mpi_enregs(idtset)%bandpp
913 : 0 : ABI_BUG(msg)
914 : : end if
915 [ - + ]: 3273 : if ((mpi_enregs(idtset)%bandpp==0)) then
916 : : write(msg,'(a,i0,2a,i0,2a,i0)')&
917 : 0 : 'The number bandpp should not be 0 with fftalg=',dtsets(idtset)%ngfft(7),ch10,&
918 : 0 : 'and istwfk=',dtsets(idtset)%istwfk(iikpt_modulo),ch10,&
919 : 0 : 'However, bandpp=',mpi_enregs(idtset)%bandpp
920 : 0 : ABI_BUG(msg)
921 : : end if
922 : : end if
923 : : end do
924 : :
925 : : if (xmpi_paral==1) then
926 [ + + ]: 596 : if(modulo(nkpt*nsppol,mpi_enregs(idtset)%nproc_spkpt)/=0)then
927 : : write(msg,'(3a,i0,a,i0)') &
928 : 16 : 'The number of KPT processors, np_spkpt, should be a multiple of nkpt*nsppol.',ch10,&
929 : 32 : 'However, np_spkpt=',mpi_enregs(idtset)%nproc_spkpt,' and nkpt*nsppol=',nkpt*nsppol
930 : 16 : ABI_WARNING(msg)
931 : : end if
932 : : end if
933 : : else
934 [ + + ]: 51539 : do iikpt=1,nkpt*nsppol
935 : 46450 : iikpt_modulo = modulo(iikpt,nkpt)+1
936 [ - + ]: 51539 : if(modulo(dtsets(idtset)%nband(iikpt),mpi_enregs(idtset)%nproc_band*mpi_enregs(idtset)%bandpp)/=0)then
937 : : write(msg,'(3a,i0,a,i0)') &
938 : 0 : 'The number of band for the k-point, nband_k, should be a multiple of npband*bandpp.',ch10,&
939 : 0 : 'However, nband_k=',dtsets(idtset)%nband(iikpt),' and npband*bandpp=', &
940 : 0 : mpi_enregs(idtset)%nproc_band* mpi_enregs(idtset)%bandpp
941 : 0 : ABI_BUG(msg)
942 : : end if
943 : : end do
944 : : end if
945 : : end if
946 : 5685 : nproc_fft=mpi_enregs(idtset)%nproc_fft
947 : 5685 : me_fft=mpi_enregs(idtset)%me_fft
948 : : end if
949 : : end if
950 : :
951 : : ! Compute mgfft,mpw,nfft for this data set (it is dependent of mpi_enreg)
952 [ - + + - : 21033 : ABI_MALLOC(istwfk,(nkpt))
+ - + - -
+ - + ]
953 [ - + + - : 21033 : ABI_MALLOC(kpt_with_shift,(3,nkpt))
+ - + - -
+ - + ]
954 : :
955 : : ! Set the default value of fftalg for given npfft but allow the user to override it.
956 : : ! Warning: If you need to change npfft, **DO IT** before this point so that here we get the correct fftalg
957 [ - + - - ]: 7011 : forbid_threads=(nthreads>1.and.dtsets(idtset)%bandpp>1)
958 : 7011 : dtsets(idtset)%ngfft(7) = fftalg_for_npfft(dtsets(idtset)%npfft,forbid_threads=forbid_threads)
959 : 7011 : dtsets(idtset)%ngfftdg(7) = fftalg_for_npfft(dtsets(idtset)%npfft,forbid_threads=forbid_threads)
960 : :
961 : : ! For RT-TDDFT make sure that we use the thread-safe version of FFT
962 : : ! in case of Goedecker's FFT with more than one thread
963 [ + + ]: 7011 : if (optdriver==RUNL_RTTDDFT) then
964 [ - + - - ]: 50 : if (dtsets(idtset)%ngfft(7)/100==FFT_SG .and. nthreads>1) then
965 : 0 : write(msg,'(3a)') 'fftalg=1XX is not thread-safe, so it cannot be used with nthreads>1',ch10,&
966 : 0 : 'thus switching fftalg to a thread-safe version.'
967 : 0 : ABI_WARNING(msg)
968 : 0 : dtsets(idtset)%ngfft(7) = 401
969 : 0 : dtsets(idtset)%ngfftdg(7) = 401
970 : : end if
971 : : end if
972 : :
973 : 7011 : fftalg_read=.false.
974 : 7011 : call intagm(dprarr,intarr,jdtset,marr,1,string(1:lenstr),'fftalg',tread0,'INT')
975 : :
976 [ + + ]: 7011 : if (tread0==1) then
977 : 261 : dtsets(idtset)%ngfft(7)=intarr(1)
978 [ + + ]: 261 : if (usepaw==1) dtsets(idtset)%ngfftdg(7)=intarr(1)
979 : : fftalg_read=.true.
980 : : end if
981 : :
982 : 7011 : ecut =dtsets(idtset)%ecut
983 : 7011 : dilatmx =dtsets(idtset)%dilatmx
984 [ + + ]: 133209 : ngfft(:) =dtsets(idtset)%ngfft(:)
985 [ + + ]: 120759 : istwfk(:)=dtsets(idtset)%istwfk(1:nkpt)
986 : 7011 : nsym =dtsets(idtset)%nsym
987 : :
988 : 7011 : nqpt=dtsets(idtset)%nqpt
989 [ + + + + ]: 9153 : qphon(:)=zero;if(nqpt/=0) qphon(:)=dtsets(idtset)%qptn(:)
990 : :
991 [ - + + - : 21033 : ABI_MALLOC(symrel,(3,3,nsym))
+ - + - -
+ - + ]
992 [ + + + + : 2217765 : symrel(:,:,1:nsym)=dtsets(idtset)%symrel(:,:,1:nsym)
+ + ]
993 : 7011 : ecut_eff=ecut*dilatmx**2
994 : :
995 [ + + ]: 7011 : if (usepaw==1) call wrtout(std_out,'getng is called for the coarse grid:')
996 [ + + ]: 7011 : kpt=k0; if (response==1.and.usepaw==1) kpt=qphon ! this is temporary
997 : :
998 : : call getng(dtsets(idtset)%boxcutmin,dtsets(idtset)%chksymtnons,ecut_eff,gmet,kpt,me_fft,mgfft,nfft,&
999 : : & ngfft,nproc_fft,nsym,paral_fft,symrel,dtsets(idtset)%tnons,&
1000 : 7011 : & gpu_option=dtsets(idtset)%gpu_option)
1001 : :
1002 [ + + ]: 133209 : dtsets(idtset)%ngfft(:)=ngfft(:)
1003 : 7011 : dtsets(idtset)%mgfft=mgfft
1004 : 7011 : dtsets(idtset)%nfft=nfft
1005 [ + + + + ]: 462003 : kpt_with_shift(:,:)=dtsets(idtset)%kpt(:,1:nkpt)/dtsets(idtset)%kptnrm
1006 : :
1007 : 7011 : exchn2n3d=dtsets(idtset)%exchn2n3d
1008 : 7011 : nproc_fft=ngfft(10) ; me_fft=ngfft(11)
1009 : 7011 : fftalg=ngfft(7); fftalga=fftalg/100; fftalgc=mod(fftalg,10)
1010 : :
1011 : : ! Initialize tables for MPI-FFT.
1012 : 7011 : call mpi_enregs(idtset)%distribfft%init('c',mpi_enregs(idtset)%nproc_fft,ngfft(2),ngfft(3))
1013 : :
1014 [ + + ]: 7011 : if(response/=0)then
1015 : : ! This value of mpw is used in the first part of respfn.f
1016 : 723 : call getmpw(ecut_eff,exchn2n3d,gmet,istwfk,kpt_with_shift,mpi_enregs(idtset),mpw_k,nkpt)
1017 : : end if
1018 [ + + ]: 7011 : if(nqpt/=0)then
1019 [ + + ]: 50423 : kpt_with_shift(1,:)=kpt_with_shift(1,:)+qphon(1)
1020 [ + + ]: 50423 : kpt_with_shift(2,:)=kpt_with_shift(2,:)+qphon(2)
1021 [ + + ]: 50423 : kpt_with_shift(3,:)=kpt_with_shift(3,:)+qphon(3)
1022 : : end if
1023 [ + - ]: 7011 : if (dtsets(idtset)%usewvl == 0) then
1024 [ + + ]: 7011 : if (dtsets(idtset)%neb_cell_algo==NEB_CELL_ALGO_NONE) then
1025 : 7010 : call getmpw(ecut_eff,exchn2n3d,gmet,istwfk,kpt_with_shift,mpi_enregs(idtset),mpw,nkpt)
1026 : : else
1027 : 1 : max_mpw=0
1028 [ + + ]: 8 : do ii=1,dtsets(idtset)%nimage
1029 [ - + - - : 7 : call mkrdim(dtsets(idtset)%acell_orig(1:3,ii),dtsets(idtset)%rprim_orig(1:3,1:3,ii),rprimd)
- - ]
1030 : 7 : call metric(gmet,gprimd,-1,rmet,rprimd,ucvol)
1031 : 7 : call getmpw(ecut_eff,exchn2n3d,gmet,istwfk,kpt_with_shift,mpi_enregs(idtset),mpw,nkpt)
1032 : 8 : if (mpw>max_mpw) max_mpw=mpw
1033 : : end do
1034 : 1 : mpw=max_mpw
1035 : : end if
1036 : :
1037 : : ! Allocate tables for parallel IO of the wavefunctions.
1038 [ + + ]: 628 : if( xmpi_mpiio==1 .and. mpi_enregs(idtset)%paral_kgb == 1 .and. &
1039 [ + + ]: 7011 : & any(dtsets(idtset)%iomode == [IO_MODE_MPI, IO_MODE_ETSF])) then
1040 [ - + + - : 1984 : ABI_MALLOC(mpi_enregs(idtset)%my_kgtab,(mpw,dtsets(idtset)%mkmem))
- + + - +
- + - - +
- + - + ]
1041 : : end if
1042 : : else
1043 : 0 : mpw = 0
1044 : : end if
1045 : :
1046 : : ! The dimensioning, in the RF case, should be done only with mpw,
1047 : : ! but mpw is used in the first part of respfn.f, and should at least
1048 : : ! be equal to mpw_k . The chosen way to code is not optimal, only convenient :
1049 : : ! it leads to a small waste of memory.
1050 [ + + + + ]: 7011 : if(response/=0 .and. mpw_k>mpw)mpw=mpw_k
1051 [ + + ]: 133209 : dtsets(idtset)%ngfft(:)=ngfft(:)
1052 : :
1053 : : ! Initialize ngfftc to the initial guess for the coarse mesh
1054 [ + + ]: 28044 : ngfftc(:) = 2
1055 : :
1056 : : ! In case of PAW, compute fine FFT parameters
1057 [ + + ]: 7011 : if (usepaw==1) then
1058 : 1215 : ecutdg_eff=dtsets(idtset)%pawecutdg*dtsets(idtset)%dilatmx**2
1059 [ + + ]: 23085 : ngfftdg(:)=dtsets(idtset)%ngfftdg(:)
1060 : 1215 : call wrtout(std_out,'getng is called for the fine grid:')
1061 : : ! Start with the coarse mesh as an initial guess for the fine mesh
1062 : : ! This ensures that the fine mesh will not be any coarser than the coarse mesh in each dimension
1063 [ + + ]: 4860 : ngfftc(:) = ngfft(1:3)
1064 [ + + ]: 1215 : kpt=k0; if (response==1.and.usepaw==1) kpt=qphon ! this is temporary
1065 : :
1066 : : call getng(dtsets(idtset)%bxctmindg,dtsets(idtset)%chksymtnons,&
1067 : : & ecutdg_eff,gmet,kpt,me_fft,mgfftdg,&
1068 : : & nfftdg,ngfftdg,nproc_fft,nsym,paral_fft,symrel,dtsets(idtset)%tnons,ngfftc,&
1069 : 1215 : & gpu_option=dtsets(idtset)%gpu_option)
1070 : :
1071 [ + + ]: 23085 : dtsets(idtset)%ngfftdg(:)=ngfftdg(:)
1072 : 1215 : dtsets(idtset)%mgfftdg=mgfftdg
1073 : 1215 : dtsets(idtset)%nfftdg=nfftdg
1074 : : ! Compute fft distribution for fine grid
1075 : 1215 : fftalg=ngfft(7); fftalga=fftalg/100; fftalgc=mod(fftalg,10)
1076 : 1215 : call mpi_enregs(idtset)%distribfft%init('f', mpi_enregs(idtset)%nproc_fft,ngfftdg(2),ngfftdg(3))
1077 : : end if
1078 : :
1079 : 7011 : dtsets(idtset)%mpw=mpw
1080 [ - + ]: 7011 : ABI_FREE(symrel)
1081 [ - + ]: 7011 : ABI_FREE(istwfk)
1082 [ - + ]: 7011 : ABI_FREE(kpt_with_shift)
1083 [ - + ]: 7011 : ABI_FREE(intarr)
1084 [ - + ]: 7011 : ABI_FREE(dprarr)
1085 : :
1086 : : ! Initialize data for the parallelization over atomic sites (PAW)
1087 [ + + ]: 7011 : if (dtsets(idtset)%natom==1) dtsets(idtset)%paral_atom=0
1088 [ + + ]: 7011 : if (dtsets(idtset)%usepaw==0) dtsets(idtset)%paral_atom=0
1089 [ - + ]: 7011 : if (dtsets(idtset)%usewvl/=0) dtsets(idtset)%paral_atom=0
1090 [ + + ]: 7011 : if (dtsets(idtset)%usedmft==1) dtsets(idtset)%paral_atom=0
1091 [ - + ]: 7011 : if (dtsets(idtset)%usedmft==10) dtsets(idtset)%paral_atom=0
1092 [ + + ]: 7011 : if (optdriver/=RUNL_GSTATE.and.optdriver/=RUNL_RESPFN.and.optdriver/=RUNL_GWLS) dtsets(idtset)%paral_atom=0
1093 [ + + ]: 7011 : if (dtsets(idtset)%macro_uj/=0) dtsets(idtset)%paral_atom=0
1094 : :
1095 : 7011 : call initmpi_atom(dtsets(idtset),mpi_enregs(idtset))
1096 : :
1097 : : ! In case of the use of a GPU (Cuda), some defaults can change
1098 : : ! according to a threshold on matrix sizes
1099 [ - + ]: 7011 : if (dtsets(idtset)%gpu_option==ABI_GPU_LEGACY) then
1100 [ # # ]: 0 : if (optdriver==RUNL_GSTATE.or.optdriver==RUNL_GWLS) then
1101 : 0 : vectsize=dtsets(idtset)%mpw*dtsets(idtset)%nspinor/dtsets(idtset)%npspinor
1102 [ # # # # : 0 : if (all(dtsets(idtset)%istwfk(:)==2)) vectsize=2*vectsize
# # ]
1103 : 0 : blocksize=dtsets(idtset)%npband*dtsets(idtset)%bandpp
1104 [ # # ]: 0 : if (dtsets(idtset)%paral_kgb==0) blocksize=dtsets(idtset)%npfft
1105 [ # # ]: 0 : if ((vectsize*blocksize**2)>=dtsets(idtset)%gpu_linalg_limit) then
1106 [ # # ]: 0 : if (.not.wfoptalg_read) then
1107 : 0 : dtsets(idtset)%wfoptalg=14
1108 [ # # ]: 0 : if (tread(8)==1) then ! bandpp read, so set nblock_lobpcg
1109 : 0 : dtsets(idtset)%nblock_lobpcg=mband_upper/(dtsets(idtset)%bandpp*dtsets(idtset)%npband)
1110 : : else ! bandpp set by nblock_lobpcg
1111 : 0 : dtsets(idtset)%bandpp=mband_upper/(dtsets(idtset)%nblock_lobpcg*dtsets(idtset)%npband)
1112 : : end if
1113 [ # # ]: 0 : if (.not.fftalg_read) then
1114 [ # # # # ]: 0 : forbid_threads=(nthreads>1.and.dtsets(idtset)%bandpp>1)
1115 : 0 : dtsets(idtset)%ngfft(7) = fftalg_for_npfft(dtsets(idtset)%npfft,forbid_threads=forbid_threads)
1116 [ # # ]: 0 : if (usepaw==1) dtsets(idtset)%ngfftdg(7) = fftalg_for_npfft(dtsets(idtset)%npfft,forbid_threads=forbid_threads)
1117 : : end if
1118 [ # # ]: 0 : if (.not.ortalg_read) dtsets(idtset)%ortalg=-abs(dtsets(idtset)%ortalg)
1119 : : end if
1120 : : end if
1121 : : end if
1122 : : end if
1123 : :
1124 : : ! initialize data for the parallelization for WVL:
1125 [ + - ]: 15467 : if(dtsets(idtset)%usewvl==1) then
1126 : 0 : mpi_enregs(idtset)%comm_wvl=mpi_enregs(idtset)%comm_cell
1127 : 0 : mpi_enregs(idtset)%nproc_wvl=xmpi_comm_size(mpi_enregs(idtset)%comm_wvl)
1128 : 0 : mpi_enregs(idtset)%me_wvl=xmpi_comm_rank(mpi_enregs(idtset)%comm_wvl)
1129 : : end if
1130 : :
1131 : : end do
1132 : :
1133 : : !This is not a very clean exit in case of paral_kgb<0
1134 [ + + ]: 1445 : if (iexit/=0)then
1135 : 1 : call wrtout(std_out, "Stopping now!")
1136 : 1 : call abi_abort('PERS', exit_status=0, print_config=.false.)
1137 : : end if
1138 : :
1139 : : DBG_EXIT("COLL")
1140 : :
1141 [ - + - + ]: 2889 : end subroutine mpi_setup
1142 : : !!***
1143 : :
1144 : : !!****f* ABINIT/finddistrproc
1145 : : !! NAME
1146 : : !! finddistrproc
1147 : : !!
1148 : : !! FUNCTION
1149 : : !! Given a total number of processors, find a suitable distribution
1150 : : !! that fill all the different levels of parallelization
1151 : : !! (npimage, nppert, np_spkpt, npspinor, npband, npfft, bandpp)
1152 : : !! Also determine parameters of parallel Linear Algebra routines
1153 : : !! (use_slk, np_slk, gpu_linalg_limit)
1154 : : !!
1155 : : !! INPUTS
1156 : : !! dtsets(0:ndtset_alloc)=<type datafiles_type>contains all input variables,
1157 : : !! for all datasets; at this stage only datasets with index lower than
1158 : : !! idtset are already initialized
1159 : : !! filnam(5)=character strings giving file names
1160 : : !! idtset=number of the current dataset
1161 : : !! mpi_enreg=information about MPI parallelization
1162 : : !! mband=maximum number of bands.
1163 : : !! ndtset_alloc=number of datasets, corrected for allocation of at least one data set
1164 : : !! tread(11)=flags indicating whether parallel input parameters were read from input file
1165 : : !! tread(1) : paral_kgb tread(6) : npfft
1166 : : !! tread(2) : npimage tread(7) : npband
1167 : : !! tread(3) : nppert tread(8) : bandpp
1168 : : !! tread(4) : np_spkpt tread(9) : use_slk
1169 : : !! tread(5) : nspinor tread(10): np_slk
1170 : : !! tread(11) : gpu_linalg_limit
1171 : : !!
1172 : : !! SIDE EFFECTS
1173 : : !! iexit= if incremented, an exit is required
1174 : : !! dtset%paral_kgb= flag for band-fft parallelism
1175 : : !! dtset%npimage = number of processors for parallelisation over image
1176 : : !! dtset%nppert = number of processors for parallelisation over perturbations
1177 : : !! dtset%npspinor = number of processors for parallelisation on spinor components
1178 : : !! dtset%np_spkpt = number of processors for parallelisation on spin / k points
1179 : : !! dtset%npfft = number of processors for parallelisation on fft grid
1180 : : !! dtset%npband = number of processors for parallelisation on bands
1181 : : !! dtset%nphf = number of processors for parallelisation on occupied states for fock exchange
1182 : : !! dtset%bandpp = internal parameter for lobpcg parallelisation algorithm
1183 : : !! dtset%use_slk = flag for ScalaPAck use
1184 : : !! dtset%np_slk = number of processors used in ScaLapack routines
1185 : : !! dtset%gpu_linalg_limit=threshold activating Linear Algebra on GPU
1186 : : !!
1187 : : !! SOURCE
1188 : :
1189 : 6490 : subroutine finddistrproc(dtsets,filnam,idtset,iexit,mband,mpi_enreg,ndtset_alloc,tread)
1190 : :
1191 : : !Arguments ------------------------------------
1192 : : !scalars
1193 : : integer,intent(in) :: idtset,mband,ndtset_alloc
1194 : : integer,intent(inout) :: iexit
1195 : : type(dataset_type),intent(inout),target :: dtsets(0:ndtset_alloc)
1196 : : type(MPI_type),intent(inout) :: mpi_enreg
1197 : : !arrays
1198 : : integer,intent(in) :: tread(11)
1199 : : character(len=fnlen),intent(in) :: filnam(5)
1200 : :
1201 : : !Local variables-------------------------------
1202 : : !scalars
1203 : : !128 should be a reasonable maximum for npfft (scaling is very poor for npfft>20)
1204 : : integer,parameter :: ALGO_NOT_SET=-1, ALGO_DEFAULT_PAR=2
1205 : : integer,parameter :: ALGO_CG=0, ALGO_LOBPCG_OLD=1, ALGO_LOBPCG_NEW=2, ALGO_CHEBFI=3, ALGO_CHEBFI_NEW=4
1206 : : integer,parameter :: NPFMAX=128,BLOCKSIZE_MAX=3000,MAXBAND_PRINT=10
1207 : : integer,parameter :: MAXCOUNT=250,MAXPRINT=10,MAXBENCH=25,MAXABIPY=25,NPF_CUTOFF=20
1208 : : real(dp),parameter :: relative_nband_range=0.025
1209 : : integer :: wf_algo,wf_algo_global,bpp,bpp_max,bpp_min,optdriver,autoparal,nblocks,blocksize
1210 : : integer :: npi_max,npi_min,npc,npc_max,npc_min
1211 : : integer :: np_sk,np_sk_max,np_sk_min,npp_max,npp_min
1212 : : integer :: nps,nps_max,nps_min,npf,npf_max,npf_min
1213 : : integer :: npb,npb_max,npb_min,max_ncpus,ount,paral_kgb
1214 : : integer :: work_size,nks_per_proc,tot_ncpus
1215 : : integer :: ib1,ib2,ibest,icount,ii,imin,jj,kk,mcount,mcount_eff,mpw
1216 : : integer :: n2,n3,ncell_eff,ncount,nimage_eff,nkpt_eff,npert_eff
1217 : : integer :: nproc,nproc1,nprocmin,np_slk,nthreads,use_linalg_gpu,omp_ncpus
1218 : : logical :: dtset_found,file_found,first_bpp,gbt_kgb,iam_master
1219 : : logical :: with_image,with_pert,with_kpt,with_spinor,with_fft,with_band,with_bandpp,with_thread
1220 : : real(dp):: acc_c,acc_k,acc_kgb,acc_kgb_0,acc_s,ecut_eff,eff,ucvol,weight0
1221 : : character(len=10) :: suffix
1222 : : character(len=20) :: strg
1223 : : character(len=500) :: msg,msgttl
1224 : : character(len=fnlen) :: filden
1225 : 6490 : type(hdr_type) :: hdr0
1226 : : !arrays
1227 : : integer :: idum(1),idum3(3),ngmax(3),ngmin(3)
1228 : 6490 : integer,allocatable :: nband_best(:),isort(:),jdtset_(:)
1229 : 6490 : integer,allocatable :: my_algo(:),my_distp(:,:),nproc_best(:)
1230 : 6490 : integer,pointer :: nkpt_rbz(:)
1231 : : real(dp) :: gmet(3,3),gprimd(3,3),rmet(3,3),rprimd(3,3)
1232 : 6490 : real(dp),allocatable :: weight(:)
1233 : 6490 : real(dp),pointer :: nband_rbz(:,:)
1234 : : type(dataset_type),pointer :: dtset
1235 : :
1236 : : !******************************************************************
1237 : :
1238 : : DBG_ENTER("COLL")
1239 : :
1240 : : !Select current dataset
1241 : 6490 : dtset => dtsets(idtset)
1242 : :
1243 : : ! The generic autoparal model predates GBT support in paral_kgb. Keep a
1244 : : ! separate flag so that GBT-specific restrictions can be applied while
1245 : : ! enumerating process distributions, instead of recommending a topology
1246 : : ! that will later be rejected by chkinp.
1247 [ + - ]: 14 : gbt_kgb = (dtset%use_gbt /= 0 .and. dtset%paral_kgb /= 0)
1248 : :
1249 : : !Is automatic parallelization activated?
1250 : 6490 : autoparal = dtset%autoparal
1251 [ + + ]: 6490 : if (autoparal==0) return
1252 : :
1253 : : !Is it available
1254 [ - + - - ]: 104 : if ((dtset%usefock==1).AND.(dtset%nphf/=1)) then
1255 : 0 : ABI_ERROR("autoparal>0 not available for Hartree-Fock or hybrid XC calculations!")
1256 : : end if
1257 [ - + - - : 104 : if ((autoparal>1).and.dtset%wfoptalg/=4.and.dtset%wfoptalg/=14) then
- - ]
1258 : 0 : ABI_ERROR("autoparal>1 only available for the old LOBPCG algorithm (wfoptalg=4/14)!")
1259 : : end if
1260 : :
1261 : : ! Unit number used for outputting the autoparal sections
1262 : 104 : ount = ab_out
1263 : :
1264 : : ! From the documentation:
1265 : : !
1266 : : ! If autoparal > 1 and max_ncpus is greater than 0, ABINIT analyzes the
1267 : : ! efficiency of the process distribution for each possible number of processors
1268 : : ! from 2 to max_ncpus. After having printed out the efficiency, the code stops.
1269 : :
1270 : : ! Handy local variables
1271 : 104 : iam_master = (mpi_enreg%me==0)
1272 : 104 : optdriver = dtset%optdriver
1273 [ - + ]: 104 : max_ncpus = dtset%max_ncpus ; if (dtset%paral_kgb<0) max_ncpus=abs(dtset%paral_kgb)
1274 : 104 : nthreads=xomp_get_max_threads()
1275 : 104 : nproc=mpi_enreg%nproc
1276 [ + + ]: 104 : if (max_ncpus>0) nproc = dtset%max_ncpus/nthreads
1277 : : if (xmpi_paral==0.and.max_ncpus<=0) nproc=1
1278 : :
1279 : 104 : nprocmin=2
1280 [ + + ]: 104 : if (xmpi_paral==1.and.max_ncpus<=0) nprocmin=max(2,nproc-100)
1281 [ + + ]: 104 : if (max_ncpus>0.and.autoparal/=0) nprocmin=1
1282 : :
1283 : 104 : wf_algo_global=ALGO_NOT_SET
1284 [ + + + + ]: 104 : if (dtset%wfoptalg==0.and.tread(1)==1) wf_algo_global=ALGO_CG
1285 [ - + ]: 104 : if (dtset%wfoptalg==4.or.dtset%wfoptalg==14) wf_algo_global=ALGO_LOBPCG_OLD
1286 [ + + ]: 104 : if (dtset%wfoptalg==114) wf_algo_global=ALGO_LOBPCG_NEW
1287 [ - + ]: 104 : if (dtset%wfoptalg==1) wf_algo_global=ALGO_CHEBFI
1288 [ - + ]: 104 : if (dtset%wfoptalg==111) wf_algo_global=ALGO_CHEBFI_NEW
1289 : :
1290 : : ! Some peculiar cases (with direct exit)
1291 : : ! MG: What is the meaning of max_ncpus < 0. This is not documented!
1292 [ + + ]: 104 : if (max_ncpus<=0) then
1293 [ + + ]: 103 : if (nproc==1.and.max_ncpus<=0) then
1294 [ + + ]: 5 : if (tread(1)==0.or.xmpi_paral==0) dtset%paral_kgb= 0
1295 [ + - ]: 5 : if (tread(2)==0.or.xmpi_paral==0) dtset%npimage = 1
1296 [ + - ]: 5 : if (tread(3)==0.or.xmpi_paral==0) dtset%nppert = 1
1297 [ + - ]: 5 : if (tread(4)==0.or.xmpi_paral==0) dtset%npspinor = 1
1298 [ + - ]: 5 : if (tread(5)==0.or.xmpi_paral==0) dtset%np_spkpt = 1
1299 [ + - ]: 5 : if (tread(6)==0.or.xmpi_paral==0) dtset%npfft = 1
1300 [ + - ]: 5 : if (tread(7)==0.or.xmpi_paral==0) dtset%npband = 1
1301 [ + - ]: 5 : if (tread(8)==0.or.xmpi_paral==0) dtset%bandpp = 1
1302 [ + - ]: 5 : if (tread(9)==0.or.xmpi_paral==0) dtset%use_slk = 0
1303 [ + - ]: 5 : if (tread(10)==0.or.xmpi_paral==0) dtset%np_slk = 1000000
1304 : 5 : return
1305 : : end if
1306 [ + - + + : 98 : if ((optdriver/=RUNL_GSTATE.and. optdriver/=RUNL_RESPFN.and. optdriver/=RUNL_GWLS).or. &
- + ]
1307 : : (optdriver==RUNL_GSTATE.and.dtset%usewvl==1)) then
1308 : 0 : dtset%paral_kgb= 0
1309 : 0 : dtset%npimage = max(1,dtset%npimage)
1310 : 0 : dtset%nppert = max(1,dtset%nppert)
1311 : 0 : dtset%npspinor = max(1,dtset%npspinor)
1312 : 0 : dtset%np_spkpt = max(1,dtset%np_spkpt)
1313 : 0 : dtset%npfft = max(1,dtset%npfft)
1314 : 0 : dtset%npband = max(1,dtset%npband)
1315 : 0 : dtset%bandpp = max(1,dtset%bandpp)
1316 : 0 : return
1317 : : end if
1318 : : end if
1319 : :
1320 : : ! Need the metric tensor
1321 [ - + ]: 99 : call mkrdim(dtset%acell_orig(1:3,1),dtset%rprim_orig(1:3,1:3,1),rprimd)
1322 : 99 : call metric(gmet,gprimd,-1,rmet,rprimd,ucvol)
1323 : :
1324 : : ! Determine some quantities related to plane waves
1325 : : ! - Crude estimation of the number of PW
1326 : : ! - Number of G vectors in each direction
1327 : 99 : mpw=0;ngmin=0;ngmax=0
1328 [ + + ]: 99 : if (optdriver==RUNL_GSTATE) then
1329 : 79 : ecut_eff = dtset%ecut*dtset%dilatmx**2
1330 : 79 : mpw = nint(ucvol*((two*ecut_eff)**1.5_dp)/(six*pi**2)) ! Crude estimation
1331 [ + + + + : 83 : if (all(dtset%istwfk(1:dtset%nkpt)>1)) mpw=mpw/2+1
+ + ]
1332 : 79 : call kpgcount(ecut_eff,dtset%exchn2n3d,gmet,dtset%istwfk,dtset%kpt,ngmax,ngmin,dtset%nkpt)
1333 : 79 : write(msg,'(a,i0)') ' getmpw sequential formula gave: ',mpw
1334 : 79 : call wrtout(std_out,msg)
1335 : : end if
1336 : :
1337 : : ! Parallelization over images
1338 : 99 : npi_min=1;npi_max=1;nimage_eff=1
1339 [ + + ]: 99 : if (optdriver==RUNL_GSTATE) then
1340 : 79 : nimage_eff=dtset%ndynimage
1341 [ + + ]: 79 : if (dtset%ntimimage<=1) nimage_eff=dtset%nimage
1342 : 79 : npi_min=max(1,dtset%npimage)
1343 : 79 : npi_max=min(nproc,nimage_eff)
1344 [ - + ]: 79 : if (tread(2)==1) npi_max=dtset%npimage
1345 : : end if
1346 : :
1347 : : !Parallelization over k-points and spin components (GS)
1348 : 99 : np_sk_min=1;np_sk_max=1;nkpt_eff=0
1349 [ + + ]: 99 : if (optdriver==RUNL_GSTATE) then
1350 : 79 : nkpt_eff=dtset%nkpt*dtset%nsppol
1351 : 79 : np_sk_min=max(1,dtset%np_spkpt)
1352 : 79 : np_sk_max=min(nproc,nkpt_eff)
1353 [ - + ]: 79 : if (tread(4)==1) np_sk_max=dtset%np_spkpt
1354 : : end if
1355 : :
1356 : : !Parallelization over perturbations, k-points and spin components (DFPT)
1357 : 99 : npp_min=1;npp_max=1;npert_eff=1
1358 [ + + ]: 99 : if (any(optdriver == [RUNL_RESPFN, RUNL_LONGWAVE])) then
1359 [ + - ]: 20 : if (dtset%paral_rf==1) then
1360 : 20 : call dtset%get_npert_rbz(nband_rbz, nkpt_rbz, npert_eff)
1361 [ + + ]: 76 : do jj=1,npert_eff
1362 [ + - - + : 10928 : ii=dtset%nsppol*nkpt_rbz(jj)*maxval(nband_rbz(:,jj))
- - + + ]
1363 : 76 : nkpt_eff=max(nkpt_eff,ii)
1364 : : end do
1365 : 20 : npp_min=max(1,dtset%nppert)
1366 : 20 : npp_max=min(nproc,npert_eff)
1367 [ + - ]: 20 : if (tread(3)==1) then
1368 : 20 : npp_max=dtset%nppert
1369 [ + + ]: 20 : if (npp_max>npert_eff) then
1370 : 4 : npp_min=npert_eff;npp_max=npert_eff
1371 : 4 : ABI_WARNING('nppert is bigger than npert; we set nppert=npert')
1372 : : end if
1373 : : end if
1374 : 20 : np_sk_min=1
1375 : 20 : np_sk_max=min(nproc,nkpt_eff)
1376 [ - + ]: 20 : ABI_FREE(nkpt_rbz)
1377 [ - + ]: 20 : ABI_FREE(nband_rbz)
1378 : : else
1379 : 0 : nkpt_eff=nproc
1380 : 0 : np_sk_min=nproc-5
1381 : 0 : np_sk_max=nproc
1382 : : end if
1383 : : end if
1384 : :
1385 : : !Parallelization over spinorial components
1386 : 99 : nps_min=1;nps_max=1
1387 [ + + ]: 99 : if (optdriver==RUNL_GSTATE) then
1388 : 79 : nps_min=max(1,dtset%npspinor)
1389 : 79 : nps_max=min(nproc,dtset%nspinor)
1390 [ - + ]: 79 : if (tread(5)==1) nps_max=dtset%npspinor
1391 : : ! GBT spinors belong to the same wavefunction and cannot presently be
1392 : : ! distributed over the spinor communicator.
1393 [ - + ]: 79 : if (dtset%use_gbt /= 0) then
1394 : 0 : nps_min=1
1395 : 0 : nps_max=1
1396 : : end if
1397 : : end if
1398 : :
1399 : : !KGB Parallelization
1400 : :
1401 : 99 : npf_min=1;npf_max=1
1402 : 99 : npb_min=1;npb_max=1
1403 : 99 : bpp_min=1;bpp_max=1
1404 : 99 : n2=0;n3=0
1405 [ + + ]: 99 : if (optdriver==RUNL_GSTATE) then
1406 : :
1407 : : ! >> FFT level
1408 : 79 : npf_min=max(1,dtset%npfft)
1409 : 79 : npf_min=min(npf_min,ngmin(2))
1410 : 79 : npf_max=min(nproc,NPFMAX)
1411 [ - + ]: 79 : if (tread(6)==1) then
1412 : 0 : npf_max=dtset%npfft
1413 [ # # ]: 0 : if (npf_max>ngmin(2)) then
1414 : : write(msg,'(3a)') &
1415 : 0 : "Value of npfft given in input file is too high for the FFT grid!",ch10,&
1416 : 0 : "Action: decrease npfft or increase FFT grid (ecut, ngfft, ...)."
1417 : 0 : ABI_ERROR(msg)
1418 : : end if
1419 : : end if
1420 : 79 : npf_max=min(npf_max,ngmin(2))
1421 : : ! Deactivate MPI FFT parallelism for GPU
1422 [ - + ]: 79 : if (dtset%gpu_option/=ABI_GPU_DISABLED) then
1423 : 0 : npf_min=1;npf_max=1
1424 : : end if
1425 : : !Deactivate MPI FFT parallelism for GPU
1426 [ + + + + ]: 79 : if (tread(1)==1.and.dtset%paral_kgb==0) then
1427 : 18 : npf_min=1;npf_max=1
1428 : : end if
1429 : : !Deactivate MPI FFT parallelism for multi-threaded LOBPCG / CHEBFI
1430 [ + + - + ]: 79 : if ((wf_algo_global==ALGO_LOBPCG_NEW.or.wf_algo_global==ALGO_CHEBFI.or.wf_algo_global==ALGO_CHEBFI_NEW).and.nthreads>1) then
1431 : 0 : npf_min=1;npf_max=1
1432 : : end if
1433 : :
1434 : : ! Number of FFT procs has to be a multiple of FFT grid sizes
1435 : : ! In case of a restart from a density file, it has to be
1436 : : ! compatible with the FFT grid used for the density
1437 : 79 : n2=dtset%ngfft(2) ; n3=dtset%ngfft(3)
1438 [ + + ]: 79 : if (n2==0.and.n3==0) then
1439 : : if (dtset%getden/=0.or.dtset%irdden/=0.or.&
1440 [ + + + - : 43 : & dtset%getkden/=0.or.dtset%irdkden/=0.or.dtset%iscf<0) then
+ - + - -
+ ]
1441 : 6 : dtset_found=.false.;file_found=.false.
1442 : : !1-Try to find ngfft from previous dataset
1443 [ - + - - ]: 6 : if (dtset%getden/=0.or.dtset%getkden/=0) then
1444 [ + + ]: 30 : do ii=1,ndtset_alloc
1445 [ - + ]: 24 : jj=dtset%getden;if (jj==0) jj=dtset%getkden
1446 [ - + ]: 24 : if (jj<0) jj=dtset%jdtset+jj
1447 [ + + ]: 30 : if (dtsets(ii)%jdtset==jj) then
1448 : 6 : dtset_found=.true.
1449 : 6 : n2=dtsets(ii)%ngfftdg(2);n3=dtsets(ii)%ngfftdg(3)
1450 : : end if
1451 : : end do
1452 : : end if
1453 : : !2-If not found, try to extract ngfft from density file
1454 [ - + ]: 6 : if (.not.dtset_found) then
1455 : : !Retrieve file name
1456 [ # # # # ]: 0 : if (dtset%getden/=0.or.dtset%irdden/=0) then
1457 [ # # ]: 0 : suffix='_DEN';if (dtset%nimage>1) suffix='_IMG1_DEN'
1458 [ # # # # ]: 0 : else if (dtset%getkden/=0.or.dtset%irdkden/=0) then
1459 [ # # ]: 0 : suffix='_KDEN';if (dtset%nimage>1) suffix='_IMG1_KDEN'
1460 : : end if
1461 [ # # # # : 0 : ABI_MALLOC(jdtset_,(0:ndtset_alloc))
# # # # #
# # # ]
1462 [ # # # # : 0 : jdtset_=0;if(ndtset_alloc/=0) jdtset_(0:ndtset_alloc)=dtsets(0:ndtset_alloc)%jdtset
# # ]
1463 : 0 : call mkfilename(filnam,filden,dtset%getden,idtset,dtset%irdden,jdtset_,ndtset_alloc,suffix,'den',ii)
1464 [ # # ]: 0 : ABI_FREE(jdtset_)
1465 : : !Retrieve ngfft from file header
1466 : 0 : idum3=0
1467 [ # # ]: 0 : if (mpi_enreg%me==0) then
1468 : 0 : inquire(file=trim(filden),exist=file_found)
1469 [ # # ]: 0 : if (file_found) then
1470 : 0 : call hdr0%from_fname(filden,ii,xmpi_comm_self)
1471 [ # # # # ]: 0 : idum3(1:2)=hdr0%ngfft(2:3);if (file_found) idum3(3)=1
1472 : 0 : call hdr0%free()
1473 : 0 : ABI_WARNING("Cannot find filden "//filden)
1474 : : end if
1475 : : end if
1476 : 0 : call xmpi_bcast(idum3,0,mpi_enreg%comm_world,ii)
1477 : 0 : n2=idum3(1);n3=idum3(2);file_found=(idum3(3)/=0)
1478 : : end if
1479 : : end if
1480 : : end if
1481 : :
1482 : : ! >> Band level
1483 : 79 : npb_min=max(1,dtset%npband)
1484 : 79 : npb_max=min(nproc,mband)
1485 [ - + ]: 79 : if (tread(7)==1) npb_max=dtset%npband
1486 [ + + + + ]: 79 : if (tread(1)==1.and.dtset%paral_kgb==0) then
1487 : 18 : npb_min=1;npb_max=1
1488 : : end if
1489 : :
1490 : : ! >> banddp level
1491 [ - + ]: 79 : if (tread(8)==1) then
1492 : 0 : bpp_min = dtset%bandpp
1493 : : else
1494 : 79 : bpp_min = 1
1495 : : end if
1496 : 79 : bpp_max=mband
1497 [ - + ]: 79 : if (wf_algo_global==ALGO_LOBPCG_OLD) bpp_max=max(4,nint(mband/10.)) ! reasonable bandpp max
1498 [ - + ]: 79 : if (tread(8)==1) bpp_max=dtset%bandpp
1499 [ + - ]: 79 : if (wf_algo_global==ALGO_CHEBFI) bpp_min=1 ! bandpp not used with ChebFi
1500 : 0 : if (wf_algo_global==ALGO_CHEBFI) bpp_max=1
1501 [ - + ]: 79 : if (wf_algo_global==ALGO_CHEBFI_NEW) bpp_min=1 ! bandpp not used with ChebFi
1502 : 0 : if (wf_algo_global==ALGO_CHEBFI_NEW) bpp_max=1 ! bandpp not used with ChebFi
1503 : :
1504 : : end if ! RUNL_GSTATE
1505 : :
1506 : : !Disable KGB parallelisation in some cases:
1507 : : ! - no GS
1508 : : ! - paral_kgb=0 present in input file
1509 : : ! - nstep=0
1510 : : ! - Hartree-Fock or hybrid calculation (for now on)
1511 : : if ( (optdriver/=RUNL_GSTATE).or.(dtset%paral_kgb==0.and.tread(1)==1).or. &
1512 [ + + + + : 99 : (dtset%nstep==0).or.(dtset%usefock==1)) then
+ + + - -
+ ]
1513 : 38 : nps_min=1; nps_max=1
1514 : 38 : npf_min=1; npf_max=1
1515 : 38 : npb_min=1; npb_max=1
1516 : 38 : bpp_min=1; bpp_max=1
1517 : : end if
1518 : :
1519 : : ! Which levels of parallelism do we have?
1520 : 99 : with_image =(npi_min/=1.or.npi_max/=1)
1521 : 99 : with_pert =(npp_min/=1.or.npp_max/=1)
1522 : 99 : with_kpt =(np_sk_min/=1.or.np_sk_max/=1)
1523 : 99 : with_spinor=(nps_min/=1.or.nps_max/=1)
1524 : 99 : with_fft =(npf_min/=1.or.npf_max/=1)
1525 : 99 : with_band =(npb_min/=1.or.npb_max/=1)
1526 : 99 : with_bandpp=(bpp_min/=1.or.bpp_max/=1)
1527 : 99 : with_thread=(nthreads>1)
1528 : :
1529 : : !Allocate lists
1530 [ - + ]: 99 : ABI_MALLOC(my_distp,(10,MAXCOUNT))
1531 [ - + ]: 99 : ABI_MALLOC(weight,(MAXCOUNT))
1532 [ - + ]: 99 : ABI_MALLOC(my_algo,(MAXCOUNT))
1533 [ + + + + : 222849 : my_distp(1:7,:)=0;weight(:)=zero
+ + ]
1534 [ + + ]: 24849 : my_distp(8,:)=dtset%use_slk
1535 [ + + ]: 24849 : my_distp(9,:)=dtset%np_slk
1536 [ + + ]: 24849 : my_distp(10,:)=dtset%gpu_linalg_limit
1537 [ + + ]: 24849 : my_algo(:)=wf_algo_global
1538 : 99 : icount=0;imin=1
1539 : :
1540 : : !Cells= images or perturbations
1541 : : npc_min=1;npc_max=1;ncell_eff=1
1542 : : if (optdriver==RUNL_GSTATE) then
1543 : 99 : ncell_eff=nimage_eff;npc_min=npi_min;npc_max=npi_max
1544 : : end if
1545 : 99 : if (any(optdriver == [RUNL_RESPFN, RUNL_LONGWAVE])) then
1546 : : ncell_eff=npert_eff;npc_min=npp_min;npc_max=npp_max
1547 : : end if
1548 : :
1549 : : !Loop over all possibilities
1550 : : !Computation of weight~"estimated acceleration"
1551 : : !================================================================
1552 : :
1553 : : !Cells= images or perturbations
1554 : 99 : npc_min=1;npc_max=1;ncell_eff=1
1555 [ + + ]: 99 : if (optdriver==RUNL_GSTATE) then
1556 : 79 : ncell_eff=nimage_eff;npc_min=npi_min;npc_max=npi_max
1557 : : end if
1558 [ + + ]: 99 : if (any(optdriver == [RUNL_RESPFN, RUNL_LONGWAVE])) then
1559 : 20 : ncell_eff=npert_eff;npc_min=npp_min;npc_max=npp_max
1560 : : end if
1561 : :
1562 : : !>>>>> CELLS
1563 [ + + ]: 240 : do npc=npc_min,npc_max
1564 [ + + ]: 141 : acc_c=one;if (npc>1) acc_c=0.99_dp*speedup_fdp(ncell_eff,npc)
1565 : :
1566 : : ! >>>>> K-POINTS
1567 [ + + ]: 681 : do np_sk=np_sk_min,np_sk_max
1568 : : ! -> for DFPT runs, impose that nsppol divides np_sk
1569 [ + + - + : 441 : if (any(optdriver == [RUNL_RESPFN, RUNL_LONGWAVE]) .and. modulo(np_sk,dtset%nsppol)>0.and.np_sk>1) cycle
- - ]
1570 [ + + ]: 441 : acc_k=one;if (np_sk>1) acc_k=0.96_dp*speedup_fdp(nkpt_eff,np_sk)
1571 : :
1572 : : ! >>>>> SPINORS
1573 [ + + ]: 1023 : do nps=nps_min,nps_max
1574 [ - + ]: 441 : acc_s=one;if (nps>1) acc_s=0.85_dp*speedup_fdp(dtset%nspinor,nps)
1575 : :
1576 : : ! >>>>> FFT
1577 [ + + ]: 1760 : do npf=npf_min,npf_max
1578 : : ! -> npf should divide ngfft if set (if unset, ngfft=0 so the modulo test is ok)
1579 [ + + - + ]: 878 : if((modulo(n2,npf)>0).or.(modulo(n3,npf)>0)) cycle
1580 : : ! -> npf should be only divisible by 2, 3 or 5
1581 : 790 : ii=npf
1582 [ + + ]: 1049 : do while (modulo(ii,2)==0)
1583 : 259 : ii=ii/2
1584 : : end do
1585 [ + + ]: 935 : do while (modulo(ii,3)==0)
1586 : 145 : ii=ii/3
1587 : : end do
1588 [ + + ]: 794 : do while (modulo(ii,5)==0)
1589 : 4 : ii=ii/5
1590 : : end do
1591 [ + + ]: 790 : if(ii/=1) cycle
1592 : :
1593 : : ! Change algo if npfft>1
1594 : 782 : wf_algo=wf_algo_global
1595 [ + + + + ]: 782 : if (optdriver==RUNL_GSTATE.and.npf>1.and. wf_algo_global==ALGO_NOT_SET) wf_algo=ALGO_DEFAULT_PAR
1596 : :
1597 : : ! FFT parallelism not compatible with multithreading
1598 [ + + ]: 502 : if (wf_algo==ALGO_LOBPCG_NEW.or.wf_algo==ALGO_CHEBFI.or.wf_algo==ALGO_CHEBFI_NEW) then
1599 [ - + ]: 358 : if (nthreads>1.and.npf>1) cycle
1600 : : end if
1601 : :
1602 : : ! >>>>> BANDS
1603 [ + + ]: 4271 : do npb=npb_min,npb_max
1604 : 3048 : nproc1=npc*np_sk*nps*npf*npb
1605 [ + + ]: 3048 : if (nproc1<nprocmin) cycle
1606 [ + + ]: 2966 : if (nproc1>nproc) cycle
1607 [ + + ]: 847 : if (modulo(mband,npb)>0) cycle
1608 : :
1609 [ - + ]: 706 : if (gbt_kgb) then
1610 [ # # # # ]: 0 : if ((dtset%use_gbt /= 1 .and. dtset%use_gbt /= 2) .or. nps /= 1) cycle
1611 [ # # ]: 0 : if (npb > 1 .or. npf > 1) then
1612 [ # # ]: 0 : if (mod(dtset%wfoptalg,10) /= 4) cycle
1613 : : else
1614 [ # # ]: 0 : if (dtset%wfoptalg /= 0) cycle
1615 : : end if
1616 : : end if
1617 : :
1618 : : ! Change algo if npband>1
1619 [ + + + + ]: 706 : if (optdriver==RUNL_GSTATE.and.npb>1.and. wf_algo_global==ALGO_NOT_SET) wf_algo=ALGO_DEFAULT_PAR
1620 : :
1621 : : ! Base speedup
1622 [ + + ]: 706 : acc_kgb_0=one;if (npb*npf*nthreads>1) acc_kgb_0=0.7_dp*speedup_fdp(mpw,(npb*npf*nthreads))
1623 : :
1624 [ + + - + ]: 706 : if (npb*npf>4.and.wf_algo==ALGO_LOBPCG_OLD) then
1625 : : ! Promote npb=npf
1626 : 0 : acc_kgb_0=acc_kgb_0*min((one*npf)/(one*npb),(one*npb)/(one*npf))
1627 : : ! Promote npf<=20
1628 [ # # ]: 0 : if (npf>20)then
1629 : : acc_kgb_0=acc_kgb_0* &
1630 : : & 0.2_dp+(one-0.2_dp)*(sin((pi*(npf-NPF_CUTOFF))/(one*(NPFMAX-NPF_CUTOFF))) &
1631 : 0 : & /((pi*(npf-NPF_CUTOFF))/(one*(NPFMAX-NPF_CUTOFF))))**2
1632 : : end if
1633 : : end if
1634 : :
1635 : 706 : first_bpp=.true.
1636 [ + + ]: 53612 : do bpp=bpp_min,bpp_max
1637 : :
1638 : : ! GBT uses the same validated multi-block constraints as old LOBPCG.
1639 : : ! Do not force bpp=mband/npb: this would restrict nblock_lobpcg to one.
1640 [ + + ]: 52028 : if (wf_algo==ALGO_LOBPCG_NEW) then
1641 : 51184 : blocksize=npb*bpp;nblocks=mband/blocksize
1642 [ + - ]: 51184 : if (modulo(bpp,nthreads)>0) cycle
1643 [ + + + + ]: 51184 : if ((bpp>1).and.(modulo(bpp,2)>0)) cycle
1644 [ + + ]: 26086 : if (modulo(mband,npb*bpp)>0) cycle
1645 [ - + ]: 844 : else if (wf_algo==ALGO_LOBPCG_OLD) then
1646 : 0 : blocksize=npb*bpp;nblocks=mband/blocksize
1647 [ # # ]: 0 : if (modulo(mband/npb,bpp)>0) cycle
1648 [ # # # # ]: 0 : if ((bpp>1).and.(modulo(bpp,2)>0)) cycle
1649 [ # # # # ]: 0 : if (one*npb*bpp >max(1.,mband/3.).and.(mband>30)) cycle
1650 [ # # # # ]: 0 : if (npb*npf<=4.and.(.not.first_bpp)) cycle
1651 [ - + ]: 844 : else if (wf_algo==ALGO_CHEBFI .or. wf_algo==ALGO_CHEBFI_NEW) then
1652 : : !Nothing
1653 : : else
1654 [ + + ]: 844 : if (bpp/=1.or.npb/=1) cycle
1655 : : end if
1656 : :
1657 : 2285 : first_bpp=.false.
1658 : :
1659 : 0 : acc_kgb=acc_kgb_0
1660 : : ! OLD LOBPCG: promote bpp*npb>mband/3
1661 [ + - ]: 2285 : if (wf_algo==ALGO_LOBPCG_OLD) then
1662 [ # # # # ]: 0 : if (npb*npf>4.and.mband>30) acc_kgb=acc_kgb*(one-(three*bpp*npb)/(one*mband))
1663 : : end if
1664 : : ! NEW LOBPCG: promote minimal number of blocks
1665 : : ! promote block size <= BLOCKSIZE_MAX
1666 [ + + ]: 2285 : if (wf_algo==ALGO_LOBPCG_NEW) then
1667 : 2073 : acc_kgb=acc_kgb*(one-0.9_dp*dble(nblocks-1)/dble(mband-1))
1668 [ - + ]: 2073 : if (blocksize>BLOCKSIZE_MAX) acc_kgb=acc_kgb*max(0.1_dp,one-dble(blocksize)/dble(10*BLOCKSIZE_MAX))
1669 [ + - ]: 2073 : if (nthreads==1) then
1670 : : ! Promote npband vs bandpp & npfft
1671 [ + + ]: 2073 : if (blocksize>1) acc_kgb=acc_kgb*(0.1_dp*bpp+0.9_dp-blocksize)/(one-blocksize)
1672 [ + + + - ]: 2073 : if (npb*npf>4.and.mband>100) acc_kgb=acc_kgb*(one-0.8_dp*((three*bpp*npb)/(one*mband)-one)**2)
1673 [ + + ]: 2073 : tot_ncpus=max(npb,npf);if (tot_ncpus==2) tot_ncpus=0
1674 : 2073 : acc_kgb=acc_kgb*(one-0.8_dp*((dble(npb)/dble(npf))-2_dp)**2/(tot_ncpus-2_dp)**2)
1675 : 2073 : eff=max(npf,20);acc_kgb=acc_kgb*(one-0.8_dp*min(one,(eff-20)**2))
1676 : : end if
1677 : : end if
1678 : :
1679 : : ! CHEBFI: promote npfft=npband and nband>=npfft
1680 [ - + ]: 2285 : if (wf_algo==ALGO_CHEBFI .or. wf_algo==ALGO_CHEBFI_NEW) then
1681 [ # # ]: 0 : if (npf>1) then
1682 [ # # ]: 0 : if (npb>npf) then
1683 : 0 : acc_kgb=acc_kgb*(one-0.8_dp*0.25_dp*((dble(npb)/dble(npf))-one)**2/(nproc1-one)**2)
1684 : : else
1685 : 0 : acc_kgb=acc_kgb*(one-0.8_dp*nproc1**2*((dble(npb)/dble(npf))-one)**2/(nproc1-one)**2)
1686 : : end if
1687 : : end if
1688 : : end if
1689 : :
1690 : : ! Resulting "weight"
1691 : : ! weight0=acc_c*acc_k*acc_s*acc_kgb
1692 : 2285 : weight0=nproc1*(acc_c+acc_k+acc_s+acc_kgb)/(npc+np_sk+nps+(npf*npb))
1693 : :
1694 : : ! Store data
1695 : 2285 : icount=icount+1
1696 [ + + ]: 5333 : if (icount<=MAXCOUNT) then
1697 [ + + ]: 1762 : my_algo(icount)=merge(ALGO_CG,wf_algo,wf_algo==ALGO_NOT_SET)
1698 [ + + ]: 14096 : my_distp(1:7,icount)=(/npc,np_sk,nps,npf,npb,bpp,nproc1/)
1699 : 1762 : weight(icount)=weight0
1700 [ + + ]: 1762 : if (weight0<weight(imin)) imin=icount
1701 : : else
1702 [ + + ]: 523 : if (weight0>weight(imin)) then
1703 [ + - ]: 393 : my_algo(imin)=merge(ALGO_CG,wf_algo,wf_algo==ALGO_NOT_SET)
1704 [ + + ]: 3144 : my_distp(1:7,imin)=(/npc,np_sk,nps,npf,npb,bpp,nproc1/)
1705 : 393 : weight(imin)=weight0
1706 [ + - - + : 99036 : idum=minloc(weight);imin=idum(1)
+ + + + +
+ ]
1707 : : end if
1708 : : end if
1709 : :
1710 : : end do ! bpp
1711 : : end do ! npb
1712 : : end do ! npf
1713 : : end do ! nps
1714 : : end do ! np_sk
1715 : : end do ! npc
1716 : :
1717 : : !Compute number of selected distributions
1718 : 99 : mcount_eff=icount
1719 : 99 : mcount=min(mcount_eff,MAXCOUNT)
1720 : :
1721 : : !Stop if no solution found
1722 [ - + ]: 99 : if (mcount==0) then
1723 : : ! Override here the 0 default value changed in indefo1
1724 : 0 : dtset%npimage = max(1,dtset%npimage)
1725 : 0 : dtset%nppert = max(1,dtset%nppert)
1726 : 0 : dtset%np_spkpt = max(1,dtset%np_spkpt)
1727 : 0 : dtset%npspinor = max(1,dtset%npspinor)
1728 : 0 : dtset%npfft = max(1,dtset%npfft)
1729 : 0 : dtset%npband = max(1,dtset%npband)
1730 : 0 : dtset%bandpp = max(1,dtset%bandpp)
1731 : : write(msg,'(a,i0,2a,i0,a)') &
1732 : 0 : 'Your input dataset does not let Abinit find an appropriate process distribution with nCPUs=',nproc*nthreads,ch10, &
1733 : 0 : 'Try to comment all the np* vars and set max_ncpus=',nthreads*nproc,' to have advice on process distribution.'
1734 : 0 : ABI_WARNING(msg)
1735 [ # # ]: 0 : if (max_ncpus>0) call wrtout(ab_out,msg, do_flush=.True.)
1736 : 0 : iexit=iexit+1
1737 : : end if
1738 : :
1739 : : !Sort data by increasing weight
1740 [ + - ]: 99 : if (mcount>0) then
1741 [ - + + - : 297 : ABI_MALLOC(isort,(mcount))
+ - - + -
+ ]
1742 [ - + + + : 5484 : isort=(/(ii,ii=1,mcount)/)
+ - + + +
- - + - -
+ + ]
1743 : 99 : call sort_dp(mcount,weight,isort,tol6)
1744 : 99 : ncount=min(mcount,MAXPRINT)
1745 : : end if
1746 : :
1747 : : !Deduce a global value for paral_kgb
1748 : 99 : paral_kgb=dtset%paral_kgb
1749 [ + + ]: 99 : if (tread(1)==0) then
1750 [ + - - + : 56 : if (any(my_algo(:)/=ALGO_CG)) paral_kgb=1
+ - ]
1751 : : end if
1752 : :
1753 : : ! ======================================
1754 : : ! Print output for abipy in Yaml format
1755 : : ! ======================================
1756 : :
1757 : : ! Please DO NOT CHANGE this part without contacting gmatteo first
1758 : : ! since ANY CHANGE can easily break the interface with AbiPy.
1759 [ + + - + : 99 : if (iam_master .and. max_ncpus > 0.and. (mcount>0 .or. wf_algo_global == ALGO_CG)) then
- - ]
1760 : 1 : write(ount,'(2a)')ch10,"--- !Autoparal"
1761 [ - + ]: 1 : if (optdriver==RUNL_GSTATE .and. paral_kgb == 0) then
1762 : 0 : write(ount,"(a)")"# Autoparal section for GS run (band-by-band CG method)"
1763 [ + - ]: 1 : else if (optdriver==RUNL_GSTATE) then
1764 : 1 : write(ount,'(a)')'# Autoparal section for GS calculations with paral_kgb 1'
1765 [ # # ]: 0 : else if (optdriver==RUNL_RESPFN) then
1766 : 0 : write(ount,'(a)')'# Autoparal section for DFPT calculations'
1767 [ # # ]: 0 : else if (optdriver==RUNL_LONGWAVE) then
1768 : 0 : write(ount,'(a)')'# Autoparal section for LONGWAVE calculations'
1769 : : else
1770 : 0 : ABI_ERROR(sjoin('Unsupported optdriver:', itoa(optdriver)))
1771 : : end if
1772 : 1 : write(ount,"(a)") "info:"
1773 : 1 : write(ount,"(a,i0)")" autoparal: ",autoparal
1774 : 1 : write(ount,"(a,i0)")" paral_kgb: ",paral_kgb
1775 : 1 : write(ount,"(a,i0)")" max_ncpus: ",max_ncpus
1776 : 1 : write(ount,"(a,i0)")" nspinor: ",dtset%nspinor
1777 : 1 : write(ount,"(a,i0)")" nsppol: ",dtset%nsppol
1778 : 1 : write(ount,"(a,i0)")" nkpt: ",dtset%nkpt
1779 : 1 : write(ount,"(a,i0)")" mband: ",mband
1780 : 1 : write(ount,"(a)")"configurations:"
1781 : :
1782 [ + - - + ]: 1 : if (optdriver==RUNL_GSTATE.and.paral_kgb==0) then
1783 : 0 : work_size = dtset%nkpt * dtset%nsppol
1784 [ # # ]: 0 : do ii=1,max_ncpus
1785 [ # # ]: 0 : if (ii > work_size) cycle
1786 [ # # ]: 0 : do omp_ncpus=1,nthreads
1787 : 0 : nks_per_proc = work_size / ii
1788 : 0 : nks_per_proc = nks_per_proc + MOD(work_size, ii)
1789 : 0 : eff = (one * work_size) / (ii * nks_per_proc)
1790 : 0 : write(ount,"(a,i0)")" - tot_ncpus: ",ii * omp_ncpus
1791 : 0 : write(ount,"(a,i0)")" mpi_ncpus: ",ii
1792 : 0 : write(ount,"(a,i0)")" omp_ncpus: ",omp_ncpus
1793 : 0 : write(ount,"(a,f12.9)")" efficiency: ",eff
1794 : : !write(ount,"(a,f12.2)")" mem_per_cpu: ",mempercpu_mb
1795 : : end do
1796 : : end do
1797 : :
1798 [ + - ]: 1 : else if (optdriver==RUNL_GSTATE) then
1799 : 1 : omp_ncpus=nthreads
1800 [ + + ]: 11 : do jj=mcount,mcount-min(ncount,MAXABIPY)+1,-1
1801 : 10 : ii=isort(jj)
1802 : 10 : tot_ncpus = my_distp(7,ii)
1803 : 10 : eff = weight(jj) / tot_ncpus
1804 : 10 : write(ount,'(a,i0)')' - tot_ncpus: ',tot_ncpus
1805 : 10 : write(ount,'(a,i0)')' mpi_ncpus: ',tot_ncpus
1806 : 10 : write(ount,"(a,i0)")" omp_ncpus: ",omp_ncpus
1807 : 10 : write(ount,'(a,f12.9)')' efficiency: ',eff
1808 : : !write(ount,'(a,f12.2)')' mem_per_cpu: ',mempercpu_mb
1809 : 10 : write(ount,'(a)' )' vars: {'
1810 : 10 : write(ount,'(a,i0,a)')' npimage: ',my_distp(1,ii),','
1811 : : ! Keep on using legacy npkpt instead of np_spkpt to maintain compatibility with AbiPy
1812 : 10 : write(ount,'(a,i0,a)')' npkpt: ',my_distp(2,ii),','
1813 : : !write(ount,'(a,i0,a)')' np_spkpt: ',my_distp(2,ii),','
1814 : 10 : write(ount,'(a,i0,a)')' npspinor: ',my_distp(3,ii),','
1815 : 10 : write(ount,'(a,i0,a)')' npfft: ', my_distp(4,ii),','
1816 : 10 : write(ount,'(a,i0,a)')' npband: ',my_distp(5,ii),','
1817 : 10 : write(ount,'(a,i0,a)')' bandpp: ',my_distp(6,ii),','
1818 : 11 : write(ount,'(a)') ' }'
1819 : : end do
1820 : :
1821 [ # # ]: 0 : else if (any(optdriver == [RUNL_RESPFN, RUNL_LONGWAVE])) then
1822 [ # # ]: 0 : do jj=mcount,mcount-min(ncount,MAXABIPY)+1,-1
1823 : 0 : ii=isort(jj)
1824 : 0 : tot_ncpus = my_distp(7,ii)
1825 : 0 : eff = weight(jj) / tot_ncpus
1826 : 0 : write(ount,'(a,i0)')' - tot_ncpus: ',tot_ncpus
1827 : 0 : write(ount,'(a,i0)')' mpi_ncpus: ',tot_ncpus
1828 : : !write(ount,'(a,i0)')' omp_ncpus: ',omp_ncpus !OMP not supported (yet)
1829 : 0 : write(ount,'(a,f12.9)')' efficiency: ',eff
1830 : : !write(ount,'(a,f12.2)')' mem_per_cpu: ',mempercpu_mb
1831 : 0 : write(ount,'(a)' )' vars: {'
1832 : 0 : write(ount,'(a,i0,a)')' nppert: ', my_distp(1,ii),','
1833 : : ! Keep on using legacy npkpt instead of np_spkpt to maintain compatibility with AbiPy
1834 : 0 : write(ount,'(a,i0,a)')' npkpt: ', my_distp(2,ii),','
1835 : : !write(ount,'(a,i0,a)')' np_spkpt: ', my_distp(2,ii),','
1836 : 0 : write(ount,'(a)') ' }'
1837 : : end do
1838 : : end if
1839 : 1 : write(ount,'(a)')"..."
1840 : : end if
1841 : :
1842 : : !Print out tab with selected choices
1843 [ + - + + ]: 99 : if (mcount>0.and.iam_master) then
1844 [ + - ]: 28 : if (nthreads==1) then
1845 : 28 : write(msg,'(a,1x,100("="),2a,i0,2a)') ch10,ch10,&
1846 : 56 : & ' Searching for all possible proc distributions for this input with #CPUs<=',nthreads*nproc,':',ch10
1847 : : else
1848 : 0 : write(msg,'(a,1x,100("="),2a,i0,a,i0,2a)') ch10,ch10,&
1849 : 0 : & ' Searching for all possible proc distributions for this input with #CPUs<=',nthreads*nproc,&
1850 : 0 : & ' and ',nthreads,' openMP threads:',ch10
1851 : : end if
1852 [ + + ]: 28 : call wrtout(std_out,msg);if(max_ncpus>0) call wrtout(ab_out,msg)
1853 : : !Titles of columns
1854 : 28 : msgttl='~'
1855 [ + + + - ]: 28 : if (with_image) msgttl=trim(msgttl)//'~~~~~~~~~~~'
1856 [ + + + - ]: 28 : if (with_pert) msgttl=trim(msgttl)//'~~~~~~~~~~~'
1857 [ + - ]: 28 : msgttl=trim(msgttl)//'~~~~~~~~~~~~~' ! kpt
1858 [ - + - - ]: 28 : if (with_spinor) msgttl=trim(msgttl)//'~~~~~~~~~~'
1859 [ + + + - ]: 28 : if (with_fft) msgttl=trim(msgttl)//'~~~~~~~~~~~~~'
1860 [ + + + - ]: 28 : if (with_band) msgttl=trim(msgttl)//'~~~~~~~~~~~~~'
1861 [ + + + - ]: 28 : if (with_bandpp) msgttl=trim(msgttl)//'~~~~~~~~~~~~~'
1862 [ - + - - ]: 28 : if (with_thread) msgttl=trim(msgttl)//'~~~~~~~~~~'
1863 [ + - ]: 28 : msgttl=trim(msgttl)//'~~~~~~~~~~~~~' ! nproc
1864 [ - + - - ]: 28 : if (with_thread) msgttl=trim(msgttl)//'~~~~~~~~~~~~~'
1865 [ + - ]: 28 : msgttl=trim(msgttl)//'~~~~~~~~~~~' ! CPUs
1866 : 28 : msgttl=' '//trim(msgttl)
1867 [ + + ]: 28 : call wrtout(std_out,msgttl);if(max_ncpus>0) call wrtout(ab_out,msgttl)
1868 : 28 : msg='|'
1869 [ + + + - ]: 28 : if (with_image) msg=trim(msg)//' npimage|'
1870 [ + + + - ]: 28 : if (with_pert) msg=trim(msg)//' nppert|'
1871 [ + - ]: 28 : msg=trim(msg)//' np_spkpt|'
1872 [ - + - - ]: 28 : if (with_spinor) msg=trim(msg)//' npspinor|'
1873 [ + + + - ]: 28 : if (with_fft) msg=trim(msg)//' npfft|'
1874 [ + + + - ]: 28 : if (with_band) msg=trim(msg)//' npband|'
1875 [ + + + - ]: 28 : if (with_bandpp) msg=trim(msg)//' bandpp|'
1876 [ - + - - ]: 28 : if (with_thread) msg=trim(msg)//' #Threads|'
1877 [ + - ]: 28 : msg=trim(msg)//' #MPI(proc)|'
1878 [ - + - - ]: 28 : if (with_thread) msg=trim(msg)//' #CPUs|'
1879 [ + - ]: 28 : msg=trim(msg)//' WEIGHT|'
1880 : 28 : msg=' '//trim(msg)
1881 [ + + ]: 28 : call wrtout(std_out,msg);if(max_ncpus>0) call wrtout(ab_out,msg)
1882 : 28 : msg='|'
1883 [ + + + - ]: 28 : write(strg,'(i4,a,i4,a)') npi_min,'<<',npi_max,'|';if (with_image) msg=trim(msg)//trim(strg)
1884 [ + + + - ]: 28 : write(strg,'(i4,a,i4,a)') npp_min,'<<',npp_max,'|';if (with_pert) msg=trim(msg)//trim(strg)
1885 [ + - ]: 28 : write(strg,'(i5,a,i5,a)') np_sk_min,'<<',np_sk_max,'|'; msg=trim(msg)//trim(strg)
1886 [ - + - - ]: 28 : write(strg,'(i5,a,i2,a)') nps_min,'<<',nps_max,'|';if (with_spinor) msg=trim(msg)//trim(strg)
1887 [ + + + - ]: 28 : write(strg,'(i5,a,i5,a)') npf_min,'<<',npf_max,'|';if (with_fft) msg=trim(msg)//trim(strg)
1888 [ + + + - ]: 28 : write(strg,'(i5,a,i5,a)') npb_min,'<<',npb_max,'|';if (with_band) msg=trim(msg)//trim(strg)
1889 [ + + + - ]: 28 : write(strg,'(i5,a,i5,a)') bpp_min,'<<',bpp_max,'|';if (with_bandpp) msg=trim(msg)//trim(strg)
1890 [ - + - - ]: 28 : write(strg,'(i9,a)' ) nthreads ,'|';if (with_thread) msg=trim(msg)//trim(strg)
1891 [ + - ]: 28 : write(strg,'(i5,a,i5,a)') 1 ,'<<',nproc ,'|'; msg=trim(msg)//trim(strg)
1892 [ - + - - ]: 28 : write(strg,'(i4,a,i6,a)') nthreads,'<<',nthreads*nproc,'|';if (with_thread) msg=trim(msg)//trim(strg)
1893 [ + - ]: 28 : write(strg,'(a,i6,a)') ' <=',nthreads*nproc,'|'; msg=trim(msg)//trim(strg)
1894 : 28 : msg=' '//trim(msg)
1895 [ + + ]: 28 : call wrtout(std_out,msg);if(max_ncpus>0) call wrtout(ab_out,msg)
1896 [ + + ]: 28 : call wrtout(std_out,msgttl);if(max_ncpus>0) call wrtout(ab_out,msgttl)
1897 : : !Loop over selected choices
1898 [ + + ]: 228 : do jj=mcount,mcount-ncount+1,-1
1899 : 200 : ii=isort(jj)
1900 : 200 : msg='|'
1901 [ + + + - ]: 200 : write(strg,'(i10,a)') my_distp(1,ii),'|';if (with_image) msg=trim(msg)//trim(strg)
1902 [ + + + - ]: 200 : write(strg,'(i10,a)') my_distp(1,ii),'|';if (with_pert) msg=trim(msg)//trim(strg)
1903 [ + - ]: 200 : write(strg,'(i12,a)') my_distp(2,ii),'|'; msg=trim(msg)//trim(strg)
1904 [ - + - - ]: 200 : write(strg,'(i9,a)') my_distp(3,ii),'|';if (with_spinor) msg=trim(msg)//trim(strg)
1905 [ + + + - ]: 200 : write(strg,'(i12,a)') my_distp(4,ii),'|';if (with_fft) msg=trim(msg)//trim(strg)
1906 [ + + + - ]: 200 : write(strg,'(i12,a)') my_distp(5,ii),'|';if (with_band) msg=trim(msg)//trim(strg)
1907 [ + + + - ]: 200 : write(strg,'(i12,a)') my_distp(6,ii),'|';if (with_bandpp) msg=trim(msg)//trim(strg)
1908 [ - + - - ]: 200 : write(strg,'(i9,a)') nthreads ,'|';if (with_thread) msg=trim(msg)//trim(strg)
1909 [ + - ]: 200 : write(strg,'(i12,a)') my_distp(7,ii),'|'; msg=trim(msg)//trim(strg)
1910 [ - + - - ]: 200 : write(strg,'(i12,a)') nthreads*my_distp(7,ii),'|';if (with_thread) msg=trim(msg)//trim(strg)
1911 [ + - ]: 200 : write(strg,'(f10.3,a)') weight(jj) ,'|'; msg=trim(msg)//trim(strg)
1912 : 200 : msg=' '//trim(msg)
1913 [ + + ]: 228 : call wrtout(std_out,msg);if(max_ncpus>0) call wrtout(ab_out,msg)
1914 : : end do
1915 : : !End of tab
1916 [ + + ]: 28 : call wrtout(std_out,msgttl);if(max_ncpus>0) call wrtout(ab_out,msgttl)
1917 : 28 : write(msg,'(a,i6,a,i6,a)')' Only the best possible choices for nproc are printed...'
1918 [ + + ]: 28 : call wrtout(std_out,msg);if(max_ncpus>0) call wrtout(ab_out,msg)
1919 : : end if ! mcount>0
1920 : :
1921 : : !Determine an optimal number of bands
1922 [ + + + + : 239 : if (optdriver==RUNL_GSTATE.and. &
+ + + + ]
1923 : : & (any(my_algo(1:mcount)==ALGO_LOBPCG_OLD.or. &
1924 : : & my_algo(1:mcount)==ALGO_LOBPCG_NEW.or. &
1925 : : & my_algo(1:mcount)==ALGO_CHEBFI.or. &
1926 : : & my_algo(1:mcount)==ALGO_CHEBFI_NEW))) then
1927 [ + - ]: 61 : if (mcount>0) then
1928 : 61 : icount=isort(mcount)
1929 : 61 : npc=my_distp(1,icount);np_sk=my_distp(2,icount)
1930 : 61 : nps=my_distp(3,icount);npf=my_distp(4,icount)
1931 : : else
1932 [ # # ]: 0 : npc=1;if (with_image ) npc=npi_min
1933 [ # # ]: 0 : np_sk=1;if (with_kpt ) np_sk=np_sk_min
1934 [ # # ]: 0 : nps=1;if (with_spinor) nps=nps_min
1935 [ # # ]: 0 : npf=1;if (with_fft ) npf=npf_min
1936 : : end if
1937 : 61 : nproc1=npc*np_sk*nps*npf
1938 : 61 : msg=ch10//' >>> Possible (best) choices for the number of bands (nband) are:'
1939 [ + + + - : 61 : if (with_image.or.with_kpt.or.with_spinor.or.with_fft) msg=trim(msg)//ch10//' with:'
+ - ]
1940 [ - + - - ]: 61 : write(strg,'(a,i0)') ' npimage=' ,npc;if (with_image) msg=trim(msg)//trim(strg)
1941 [ + + + - ]: 61 : write(strg,'(a,i0)') ' np_spkpt=' ,np_sk;if (with_kpt) msg=trim(msg)//trim(strg)
1942 [ - + - - ]: 61 : write(strg,'(a,i0)') ' npspinor=',nps;if (with_spinor) msg=trim(msg)//trim(strg)
1943 [ + - + - ]: 61 : write(strg,'(a,i0)') ' npfft=' ,npf;if (with_fft) msg=trim(msg)//trim(strg)
1944 [ + + ]: 61 : call wrtout(std_out,msg);if(max_ncpus>0) call wrtout(ab_out,msg)
1945 [ - + ]: 61 : ib1=mband-int(mband*relative_nband_range);if (my_algo(icount)==ALGO_CHEBFI .or. my_algo(icount)==ALGO_CHEBFI_NEW) ib1=mband
1946 : 61 : ib2=mband+int(mband*relative_nband_range)
1947 [ - + + - : 183 : ABI_MALLOC(nproc_best,(1+ib2-ib1))
+ - + - -
+ - + ]
1948 [ - + + - : 122 : ABI_MALLOC(nband_best,(1+ib2-ib1))
- + - + ]
1949 [ + + ]: 154 : nproc_best(:)=1
1950 [ - + + + : 401 : nband_best=(/(ii,ii=ib1,ib2)/)
+ - + + +
- - + - -
+ + ]
1951 [ + - ]: 61 : bpp=merge(1,nthreads,my_algo(icount)==ALGO_CHEBFI .or. my_algo(icount)==ALGO_CHEBFI_NEW)
1952 [ + + ]: 154 : do ii=ib1,ib2
1953 [ + + ]: 794 : do jj=1,nproc/nproc1
1954 : : ibest=1
1955 [ + + ]: 5292 : do kk=1,jj
1956 [ + + ]: 4652 : if (mod(jj,kk)/=0) cycle
1957 [ + + ]: 2454 : if (mod(ii,kk*bpp)==0) ibest=max(ibest,kk)
1958 : : end do
1959 : 733 : nproc_best(1+ii-ib1)=max(nproc_best(1+ii-ib1),ibest)
1960 : : end do
1961 : : end do
1962 : 61 : call sort_int(1+ib2-ib1,nproc_best,nband_best)
1963 : 61 : kk=-1
1964 [ + + ]: 133 : do ii=1+ib2-ib1,max(ib2-ib1-MAXBAND_PRINT,1),-1
1965 : 72 : write(msg,'(3(a,i6),a,i3,a,i5,a)') ' nband=',nband_best(ii),' using ',nproc1*nproc_best(ii)*nthreads,&
1966 : 144 : & ' CPUs =',nproc1*nproc_best(ii),' MPI x',nthreads,' threads (npband=',nproc_best(ii),')'
1967 [ + + ]: 72 : call wrtout(std_out,msg);if(max_ncpus>0) call wrtout(ab_out,msg)
1968 [ + + ]: 133 : if (nband_best(ii)==mband) kk=nproc_best(ii)
1969 : : end do
1970 [ + + + - ]: 154 : if (kk==maxval(nproc_best(:))) then
1971 : : if (my_algo(icount)/=ALGO_CHEBFI .or. my_algo(icount)/=ALGO_CHEBFI_NEW) then
1972 : 61 : write(msg,'(a,i6,a)') ' >>> The present nband value (',mband,') seems to be the best choice!'
1973 : : end if
1974 [ + - ]: 61 : if (my_algo(icount)==ALGO_CHEBFI .or. my_algo(icount)/=ALGO_CHEBFI_NEW) then
1975 : 61 : write(msg,'(a,i6,a)') ' >>> The present nband value (',mband,') seems to be a good choice!'
1976 : : end if
1977 [ + + ]: 61 : call wrtout(std_out,msg);if(max_ncpus>0) call wrtout(ab_out,msg)
1978 : : end if
1979 [ - + ]: 61 : ABI_FREE(nproc_best)
1980 [ - + ]: 61 : ABI_FREE(nband_best)
1981 : : end if
1982 : :
1983 [ + + + - : 1861 : if (optdriver==RUNL_GSTATE.and.(any(my_algo(1:mcount)==ALGO_CHEBFI .or. my_algo(1:mcount)==ALGO_CHEBFI_NEW))) then
+ - + + -
+ ]
1984 : : write(msg,'(5a)') &
1985 : 0 : & ' >>> Note that with the "Chebyshev Filtering" algorithm, it is often',ch10,&
1986 : 0 : & ' better to increase the number of bands (10% more or a few tens more).',ch10,&
1987 : 0 : & ' Advice: increase nband and put nbdbuf input variable to (nband_new-nband_old).'
1988 [ # # ]: 0 : call wrtout(std_out,msg);if(max_ncpus>0) call wrtout(ab_out,msg)
1989 : : end if
1990 : :
1991 : : !Refinement of the process distribution by mean of a LinAlg routines benchmarking
1992 [ + - + + : 99 : if (mcount>0.and.optdriver==RUNL_GSTATE.and.autoparal/=1) then
- + ]
1993 : 0 : icount=isort(mcount)
1994 [ # # ]: 0 : if (autoparal/=3) then
1995 [ # # ]: 0 : if (autoparal==2) then
1996 : 0 : write(msg,'(5a,9(a10,a1))') ch10, &
1997 : 0 : & ' Values below have been tested with respect to Linear Algebra performance;',ch10,&
1998 : 0 : & ' Weights below are corrected according:',ch10,&
1999 : 0 : & 'npimage','|','np_spkpt' ,'|','npspinor' ,'|','npfft' ,'|','npband','|',' bandpp ' ,'|',&
2000 : 0 : & 'nproc' ,'|','weight','|','new weight','|'
2001 : : else
2002 : 0 : write(msg,'(5a,11(a10,a1))') ch10, &
2003 : 0 : & ' Values below have been tested with respect to Linear Algebra performance;',ch10,&
2004 : 0 : & ' Weights below are corrected according:',ch10,&
2005 : 0 : & 'npimage','|','np_spkpt' ,'|','npspinor' ,'|','npfft' ,'|','npband','|',' bandpp ' ,'|',&
2006 : 0 : & 'nproc' ,'|','weight','|','new weight','|','best npslk','|','linalggpu' ,'|'
2007 : : end if
2008 [ # # ]: 0 : call wrtout(std_out,msg);if (max_ncpus > 0) call wrtout(ab_out,msg)
2009 : : end if
2010 : 0 : acc_k=zero
2011 [ # # ]: 0 : ncount=min(MAXBENCH,mcount);if (autoparal==3) ncount=1
2012 [ # # ]: 0 : do jj=mcount,mcount-ncount+1,-1
2013 : 0 : ii=isort(jj)
2014 : 0 : npf=my_distp(4,ii);npb=my_distp(5,ii);bpp=my_distp(6,ii)
2015 [ # # # # ]: 0 : if ((npb*npf*bpp>1).and.(npf*npb<=mpi_enreg%nproc)) then
2016 : 0 : use_linalg_gpu=dtset%gpu_option
2017 : 0 : call compute_kgb_indicator(acc_kgb,bpp,xmpi_world,mband,mpw,npb,npf,np_slk,use_linalg_gpu)
2018 [ # # ]: 0 : if (autoparal/=2) then
2019 : 0 : my_distp(9,ii)=np_slk
2020 [ # # ]: 0 : if (np_slk>0) my_distp(8,ii)=1
2021 : : ! * gpu_linalg_limit:
2022 : : ! No use of GPU: htgspw_01.outuge value ~2 *vectsize*blocksize**2 tested
2023 : : ! Use of GPU: tiny value ~0.5*vectsize*blocksize**2 tested
2024 : 0 : my_distp(10,ii)=2*dtset%mpw*(npb*bpp)**2/npf
2025 [ # # ]: 0 : if (use_linalg_gpu/=ABI_GPU_DISABLED) my_distp(10,ii)=my_distp(10,ii)/4
2026 : : end if
2027 [ # # ]: 0 : if (abs(acc_k)<=tol12) acc_k=acc_kgb ! Ref value : the first one computed
2028 : : ! * Weight (corrected by 10% of the computed ratio)
2029 : 0 : weight0=weight(jj)*(one + 0.1_dp*acc_k/acc_kgb)
2030 [ # # ]: 0 : if (autoparal==2) then
2031 : : write(msg, '(7(i10,a1),f9.2,a2,f9.5,a2)') &
2032 : 0 : & my_distp(1,ii),'|',my_distp(2,ii),'|',my_distp(3,ii),'|',my_distp(4,ii),'|',&
2033 : 0 : & my_distp(5,ii),'|',my_distp(6,ii),'|',my_distp(7,ii),'|',weight(jj),'=>', weight0,' |'
2034 [ # # ]: 0 : else if (autoparal==3) then
2035 : 0 : write(msg,'(a,5(a,i3))') ch10,' For npband=',npb,', npfft=',npf,' and bandpp=',bpp, &
2036 : 0 : & ', compute_kgb_indicator recommends you to set np_slk=',my_distp(9,ii),&
2037 : 0 : & ' and use_linalg_gpu=',use_linalg_gpu
2038 : : else
2039 : : write(msg, '(7(i10,a1),f9.2,a2,f9.5,a2,2(i10,a1))') &
2040 : 0 : & my_distp(1,ii),'|',my_distp(2,ii),'|',my_distp(3,ii),'|',my_distp(4,ii),'|',&
2041 : 0 : & my_distp(5,ii),'|',my_distp(6,ii),'|',my_distp(7,ii),'|',weight(jj),'=>', weight0,' |',&
2042 : 0 : & my_distp(9,ii),'|',use_linalg_gpu,'|'
2043 : : end if
2044 [ # # ]: 0 : call wrtout(std_out,msg);if (max_ncpus>0) call wrtout(ab_out,msg)
2045 : : ! We store the best value in weight(mcount) and keep icount
2046 [ # # ]: 0 : if (weight0 > weight(mcount)) then
2047 : 0 : icount=ii;weight(mcount)=weight0
2048 : : end if
2049 : : end if
2050 : : end do
2051 : : end if
2052 : :
2053 : : !Store new process distribution
2054 [ + - + + ]: 99 : if (mcount>0.and.max_ncpus<=0) then
2055 : 98 : icount=isort(mcount)
2056 : 98 : nproc1=my_distp(7,icount)
2057 : : ! Work load distribution
2058 [ + + ]: 98 : if (optdriver==RUNL_GSTATE) then
2059 : 78 : dtset%npimage= my_distp(1,icount)
2060 : 78 : dtset%nppert = 1
2061 : 78 : dtset%np_spkpt = my_distp(2,icount)
2062 : : end if
2063 [ + + ]: 98 : if (optdriver==RUNL_RESPFN) then
2064 : 20 : dtset%npimage= 1
2065 : 20 : dtset%nppert = my_distp(1,icount)
2066 : 20 : dtset%np_spkpt = 1
2067 : : end if
2068 : 98 : dtset%npspinor = my_distp(3,icount)
2069 : 98 : dtset%npfft = my_distp(4,icount)
2070 : 98 : dtset%npband = my_distp(5,icount)
2071 : 98 : dtset%bandpp = my_distp(6,icount)
2072 [ + + + + ]: 146 : if (tread(1)==0) dtset%paral_kgb= merge(0,1,my_algo(icount)==ALGO_CG)
2073 : : ! The following lines are mandatory : the DFT+DMFT must use ALL the
2074 : : ! available procs specified by the user. So nproc1=nproc.
2075 : : ! Works only if paral_kgb is not activated??
2076 [ - + - - ]: 98 : if (dtset%usedmft/=0.and.optdriver==RUNL_GSTATE) then
2077 [ # # ]: 0 : if (dtset%paral_kgb==0) then
2078 : 0 : dtset%npspinor = 1 ; dtset%npfft = 1
2079 : 0 : dtset%npband = 1 ; dtset%bandpp = 1
2080 : 0 : dtset%npimage = 1
2081 : : end if
2082 : 0 : nproc1 = nproc
2083 : : end if
2084 [ + + ]: 98 : if (dtset%npband*dtset%npfft*dtset%bandpp>1) dtset%paral_kgb=1
2085 : : ! LinAlg parameters: we change values only if they are not present in input file
2086 [ + + ]: 98 : if (dtset%paral_kgb==1) then
2087 [ + - ]: 52 : if (tread(9)==0) dtset%use_slk=my_distp(8,icount)
2088 [ + - ]: 52 : if (tread(10)==0) dtset%np_slk=my_distp(9,icount)
2089 [ + - ]: 52 : if (tread(11)==0) dtset%gpu_linalg_limit=my_distp(10,icount)
2090 : : end if
2091 : : ! New definition of "world" MPI communicator
2092 [ + + + - ]: 98 : if (optdriver==RUNL_RESPFN.and.dtset%paral_rf==1) then
2093 : 20 : nproc1=max(nproc1,dtset%nsppol*dtset%nkpt) ! Take into account the code in respfn.F90
2094 : 20 : nproc1=min(nproc1,nproc)
2095 : 20 : nproc1=(nproc1/dtset%nppert)*dtset%nppert
2096 : : end if
2097 : 98 : call initmpi_world(mpi_enreg,nproc1)
2098 : : end if
2099 : :
2100 : : !Final advice in case max_ncpus > 0
2101 [ + + + - ]: 99 : if (max_ncpus>0.and.mcount>0) then
2102 : 1 : write(msg,'(6a)') ch10,&
2103 : 1 : ' Launch a parallel version of ABINIT with a distribution of processors among the above list,',ch10,&
2104 : 1 : ' and the associated input variables (np_spkpt, npband, npfft, bandpp, etc.).',ch10,&
2105 : 2 : ' The higher weight should be better.'
2106 [ + - ]: 1 : call wrtout(std_out,msg);if (max_ncpus>0) call wrtout(ab_out,msg)
2107 : : end if
2108 : :
2109 [ + - ]: 99 : if (mcount>0) then
2110 [ - + ]: 99 : ABI_FREE(isort)
2111 : : end if
2112 [ - + ]: 99 : ABI_FREE(my_distp)
2113 [ - + ]: 99 : ABI_FREE(my_algo)
2114 [ - + ]: 99 : ABI_FREE(weight)
2115 : :
2116 : : !Final line
2117 : 99 : write(msg,'(a,100("="),2a)') " ",ch10,ch10
2118 [ + + ]: 99 : call wrtout(std_out,msg);if (max_ncpus>0) call wrtout(ab_out,msg)
2119 : :
2120 : : !max_ncpus requires a stop
2121 [ + + + + : 13079 : if (max_ncpus>0) then
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
- - - - -
- - - - -
- - - ]
2122 : 1 : iexit = iexit + 1 ! will stop in the parent.
2123 : : end if
2124 : :
2125 : : DBG_EXIT("COLL")
2126 : :
2127 : : contains
2128 : :
2129 : 839 : real(dp) pure function speedup_fdp(nn, mm)
2130 : : ! Expected linear speedup for a nn-sized problem and mm processes
2131 : : integer,intent(in) :: nn, mm
2132 [ + + + + : 1320 : speedup_fdp = (one*nn) / (one* ((nn / mm) + merge(0, 1, mod(nn, mm) == 0)))
- - + + ]
2133 : : end function speedup_fdp
2134 : :
2135 : : end subroutine finddistrproc
2136 : : !!***
2137 : :
2138 : : !!****f* ABINIT/compute_kgb_indicator
2139 : : !! NAME
2140 : : !! compute_kgb_indicator
2141 : : !!
2142 : : !! FUNCTION
2143 : : !! Only for "KGB" parallelism (LOBPCG algorithm for Ground-state):
2144 : : !! Give an indicator of performance for a given distribution of processors
2145 : : !! (npband, npfft and bandpp).
2146 : : !! Determine best choice of parameters for Scalapack and/or Magma Linear Algebra routines.
2147 : : !!
2148 : : !! INPUTS
2149 : : !! bandpp=internal lobpcg optimization variable
2150 : : !! glb_comm=communicator for global MPI communications
2151 : : !! mband=maximum number of bands.
2152 : : !! mband=maximum number of plane waves
2153 : : !! npband=number of processor 'band'
2154 : : !! npfft = number of processor 'fft'
2155 : : !! use_linalg_gpu=indicate if we also test the gpu linear algebra (compatible only with the legacy 2013 GPU code)
2156 : : !!
2157 : : !! OUTPUT
2158 : : !! acc_kgb = indicator of performance
2159 : : !! npslk = number of process to used in communicators
2160 : : !!
2161 : : !! SIDE EFFECTS
2162 : : !! This routine can be used to find an indicator in order to refine automatic process distribution.
2163 : : !! This indicator is returned in acc_kgb
2164 : : !! This routine can be used to find the optimal values of np_slk parameter (ScaLapack)
2165 : : !! and wheter or not we should use Magma for Linear Algebra in lobpcgwf
2166 : : !!
2167 : : !! SOURCE
2168 : :
2169 : 0 : subroutine compute_kgb_indicator(acc_kgb,bandpp,glb_comm,mband,mpw,npband,npfft,npslk,use_linalg_gpu)
2170 : :
2171 : : use m_abi_linalg
2172 : :
2173 : : !Arguments ------------------------------------
2174 : : !scalars
2175 : : integer,intent(in) :: bandpp,glb_comm,mband,mpw,npband,npfft
2176 : : integer,intent(inout) :: npslk,use_linalg_gpu
2177 : : real(dp),intent(inout) :: acc_kgb
2178 : :
2179 : : !Local variables-------------------------------
2180 : : !scalars
2181 : : integer,parameter :: max_number_of_npslk=10,max_number_of_iter=10
2182 : : integer :: blocksize,bigorder,ierr,ii,islk,islk1,iter,jj,keep_gpu
2183 : : integer :: kgb_comm,my_rank,np_slk,np_slk_max,np_slk_best,nranks
2184 : : integer :: use_lapack_gpu,use_slk,vectsize,wfoptalg
2185 : : real(dp) :: min_eigen,min_ortho,time_xeigen,time_xortho
2186 : : character(len=500) :: msg
2187 : : !arrays
2188 : 0 : integer,allocatable :: ranks(:),val_npslk(:)
2189 : 0 : real(dp),allocatable :: eigen(:),grama(:,:),gramb(:,:)
2190 : 0 : complex(dp),allocatable :: blockvectorbx(:,:),blockvectorx(:,:),sqgram(:,:)
2191 : : !******************************************************************
2192 : :
2193 : : DBG_ENTER("COLL")
2194 : :
2195 : : #ifdef DEBUG_MODE
2196 : : write(msg,'(a,3i3)') 'compute_kgb_indicator : (bpp,npb,npf) = ', bandpp, npband, npfft
2197 : : call wrtout(std_out,msg,'PERS')
2198 : : #endif
2199 : :
2200 : : !Create local communicator for test
2201 : : if (xmpi_paral==1) then
2202 : 0 : nranks=npfft*npband
2203 [ # # # # : 0 : ABI_MALLOC(ranks,(nranks))
# # # # #
# # # ]
2204 [ # # # # : 0 : ranks=(/((my_rank-1),my_rank=1,nranks)/)
# # # # #
# # # # #
# # ]
2205 : 0 : kgb_comm=xmpi_subcomm(glb_comm,nranks,ranks,my_rank_in_group=my_rank)
2206 [ # # ]: 0 : ABI_FREE(ranks)
2207 : : else
2208 : : kgb_comm=xmpi_comm_self
2209 : : my_rank=0
2210 : : end if
2211 : :
2212 : : !Only for process in the new subgroup
2213 [ # # ]: 0 : if (my_rank/=xmpi_undefined) then
2214 : :
2215 : : ! We enforce vectsize >=blocksize (This is not true in lobpcg but
2216 : : ! these are rare cases and this simplify the matrix constructions below...)
2217 : 0 : blocksize=npband*bandpp
2218 : 0 : vectsize=max(1+mpw/(npband*npfft),blocksize)
2219 : 0 : bigorder=3*blocksize
2220 : :
2221 [ # # # # : 0 : ABI_MALLOC(blockvectorx,(vectsize,blocksize))
# # # # #
# # # # #
# # ]
2222 [ # # # # : 0 : ABI_MALLOC(blockvectorbx,(vectsize,blocksize))
# # # # #
# # # ]
2223 [ # # # # : 0 : ABI_MALLOC(sqgram,(blocksize,blocksize))
# # # # #
# # # # #
# # ]
2224 [ # # # # : 0 : ABI_MALLOC(grama,(2*bigorder,bigorder))
# # # # #
# # # # #
# # # # ]
2225 [ # # # # : 0 : ABI_MALLOC(gramb,(2*bigorder,bigorder))
# # # # #
# # # ]
2226 [ # # # # : 0 : ABI_MALLOC(eigen,(bigorder))
# # # # #
# # # ]
2227 [ # # ]: 0 : ABI_MALLOC(val_npslk,(max_number_of_npslk)) ! not too much values tested
2228 : :
2229 : 0 : min_eigen=greatest_real
2230 : 0 : min_ortho=greatest_real
2231 : 0 : np_slk_best=-1 ; np_slk_max=0
2232 : : #ifdef HAVE_LINALG_SCALAPACK
2233 : : np_slk_max=min(max_number_of_npslk,npband*npfft)
2234 : : #endif
2235 : :
2236 : : ! Preselect a range of available np_slk values
2237 [ # # ]: 0 : val_npslk(1:)=0 ; val_npslk(2)=1
2238 : : do islk=3,np_slk_max
2239 : : np_slk=val_npslk(islk-1)*2
2240 : : do while ((modulo(npband*npfft,np_slk)>0).and.(np_slk<(npband*npfft)))
2241 : : np_slk=np_slk+1
2242 : : end do
2243 : : if(np_slk>(npband*npfft).or.np_slk>mband) exit
2244 : : val_npslk(islk)=np_slk
2245 : : end do
2246 : 0 : np_slk_max=islk-1
2247 : :
2248 : : ! Loop over np_slk values
2249 : 0 : islk1=1
2250 : : #ifdef HAVE_LINALG_MAGMA
2251 : : if (use_linalg_gpu==ABI_GPU_LEGACY) islk1=0
2252 : : #endif
2253 [ # # ]: 0 : do islk=islk1,np_slk_max
2254 : :
2255 : 0 : time_xortho=zero ; time_xeigen=zero
2256 : :
2257 : 0 : use_slk=0
2258 : : if (islk==0) then
2259 : : ! This is the test for the GPU
2260 : : use_lapack_gpu=1 ; np_slk=0
2261 : : else
2262 : 0 : use_lapack_gpu=0 ; np_slk=val_npslk(islk)
2263 [ # # ]: 0 : if (np_slk>0) use_slk=1
2264 : : end if
2265 : :
2266 : : ! Initialize linalg parameters for this np_slk value
2267 : : ! For the first np_slk value, everything is initialized
2268 : : ! For the following np_slk values, only Scalapack parameters are updated
2269 : 0 : wfoptalg=14 ! Simulate use of LOBPCG
2270 : : call abi_linalg_init(bigorder,RUNL_GSTATE,wfoptalg,1,&
2271 : 0 : & use_lapack_gpu,use_slk,np_slk,kgb_comm)
2272 : :
2273 : : ! We could do mband/blocksize iter as in lobpcg but it's too long
2274 [ # # ]: 0 : do iter=1,max_number_of_iter
2275 : :
2276 : : ! Build matrixes
2277 [ # # ]: 0 : do ii=1,vectsize
2278 [ # # ]: 0 : do jj=1,blocksize
2279 [ # # ]: 0 : if (ii>jj) then
2280 : 0 : blockvectorx(ii,jj) =czero
2281 : 0 : blockvectorbx(ii,jj)=czero
2282 : : else
2283 : 0 : blockvectorx(ii,jj) =cone
2284 : 0 : blockvectorbx(ii,jj)=cone
2285 : : end if
2286 : : end do
2287 : : end do
2288 [ # # # # : 0 : grama=zero;gramb=zero
# # # # ]
2289 [ # # ]: 0 : do jj=1,bigorder
2290 [ # # ]: 0 : do ii=jj,bigorder
2291 [ # # ]: 0 : if (ii==jj) then
2292 : 0 : grama(2*ii-1,jj)=one
2293 : 0 : gramb(2*ii-1,jj)=one
2294 : : else
2295 [ # # ]: 0 : grama(2*ii-1:2*ii,jj)=one
2296 : 0 : grama(2*jj-1,ii)= one
2297 : 0 : grama(2*jj ,ii)=-one
2298 : : end if
2299 : : end do
2300 : : end do
2301 : :
2302 : : ! Call to abi_xorthonormalize
2303 : 0 : time_xortho=time_xortho-abi_wtime()
2304 : 0 : call abi_xorthonormalize(blockvectorx,blockvectorbx,blocksize,kgb_comm,sqgram,vectsize)
2305 : 0 : time_xortho = time_xortho + abi_wtime()
2306 : :
2307 : : ! Call to abi_xhegv
2308 : 0 : time_xeigen=time_xeigen-abi_wtime()
2309 : : call abi_xhegv(1,'v','u',bigorder,grama,bigorder,gramb,bigorder,eigen,&
2310 : 0 : & x_cplx=2,use_slk=use_slk,use_gpu_magma=use_lapack_gpu)
2311 : 0 : time_xeigen=time_xeigen+abi_wtime()
2312 : :
2313 : : end do ! iter
2314 : :
2315 : : ! Finalize linalg parameters for this np_slk value
2316 : : ! For the last np_slk value, everything is finalized
2317 : : ! For the previous np_slk values, only Scalapack parameters are updated
2318 : 0 : call abi_linalg_finalize(use_lapack_gpu)
2319 : :
2320 : 0 : time_xortho= time_xortho*mband/blocksize
2321 : 0 : time_xeigen= time_xeigen*mband/blocksize
2322 : : if (time_xortho<min_ortho) min_ortho=time_xortho
2323 [ # # ]: 0 : if (time_xeigen<min_eigen) then
2324 : 0 : min_eigen=time_xeigen
2325 : 0 : np_slk_best=np_slk
2326 : 0 : keep_gpu=use_lapack_gpu
2327 : : end if
2328 : :
2329 : : end do ! np_slk
2330 : :
2331 : : #ifdef DEBUG_MODE
2332 : : write(msg,'(2(a,es15.3),a,i3)') ' In the best case, xortho took ',min_ortho,&
2333 : : ' and xeigen took ',min_eigen,' for np_slk=',np_slk_best
2334 : : call wrtout(std_out,msg,'PERS')
2335 : : #endif
2336 : :
2337 : : ! Final values to be sent to others process
2338 : 0 : acc_kgb=min_ortho+four*min_eigen
2339 : 0 : npslk=max(np_slk_best,1)
2340 : 0 : use_linalg_gpu=keep_gpu
2341 : :
2342 [ # # ]: 0 : ABI_FREE(blockvectorx)
2343 [ # # ]: 0 : ABI_FREE(blockvectorbx)
2344 [ # # ]: 0 : ABI_FREE(sqgram)
2345 [ # # ]: 0 : ABI_FREE(grama)
2346 [ # # ]: 0 : ABI_FREE(gramb)
2347 [ # # ]: 0 : ABI_FREE(eigen)
2348 : 0 : ABI_FREE(val_npslk)
2349 : :
2350 : : end if ! my_rank in group
2351 : :
2352 : : !Free local MPI communicator
2353 : 0 : call xmpi_comm_free(kgb_comm)
2354 : :
2355 : : !Broadcast of results to be sure every process has them
2356 : 0 : call xmpi_bcast(acc_kgb,0,glb_comm,ierr)
2357 : 0 : call xmpi_bcast(npslk,0,glb_comm,ierr)
2358 : 0 : call xmpi_bcast(use_linalg_gpu,0,glb_comm,ierr)
2359 : :
2360 : : #ifndef DEBUG_MODE
2361 : : ABI_UNUSED(msg)
2362 : : #endif
2363 : :
2364 : : DBG_EXIT("COLL")
2365 : :
2366 : 0 : end subroutine compute_kgb_indicator
2367 : : !!***
2368 : :
2369 : : end module m_mpi_setup
2370 : : !!***
|
