TABLE OF CONTENTS
abinit/prep_nonlop [ Functions ]
[ Top ] [ abinit ] [ Functions ]
NAME
prep_nonlop
FUNCTION
this routine prepares the data to the call of nonlop.
COPYRIGHT
Copyright (C) 1998-2018 ABINIT group (FB,MT,GZ,MD,FDahm) this file is distributed under the terms of the gnu general public license, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt . for the initials of contributors, see ~abinit/doc/developers/contributors.txt .
INPUTS
choice: chooses possible output:
choice=1 => a non-local energy contribution
=2 => a gradient with respect to atomic position(s)
=3 => a gradient with respect to strain(s)
=23=> a gradient with respect to atm. pos. and strain(s)
=4 => a 2nd derivative with respect to atomic pos.
=24=> a gradient and 2nd derivative with respect to atomic pos.
=5 => a gradient with respect to k wavevector
=6 => 2nd derivatives with respect to strain and atm. pos.
=7 => no operator, just projections
blocksize= size of block for FFT
cpopt=flag defining the status of cwaveprj=<Proj_i|Cnk> scalars (see below, side effects)
cwavef(2,npw*my_nspinor*blocksize)=planewave coefficients of wavefunction.
gvnlc=matrix elements <G|Vnonlocal|C>
hamk <type(gs_hamiltonian_type)>=data defining the Hamiltonian at a given k (NL part involved here)
idir=direction of the - atom to be moved in the case (choice=2,signs=2),
- k point direction in the case (choice=5,signs=2)
- strain component (1:6) in the case (choice=2,signs=2) or (choice=6,signs=1)
lambdablock(blocksize)=factor to be used when computing (Vln-lambda.S) - only for paw_opt=2
mpi_enreg=informations about mpi parallelization
nnlout=dimension of enlout (when signs=1):
ntypat=number of types of atoms in cell
paw_opt= define the nonlocal operator concerned with
signs= if 1, get contracted elements (energy, forces, stress, ...)
if 2, applies the non-local operator to a function in reciprocal space
tim_nonlop=timing code of the calling routine (can be set to 0 if not attributed)
OUTPUT
==== if (signs==1) ====
enlout_block(nnlout)=
if paw_opt==0, 1 or 2: contribution of this block of states to the nl part of various properties
if paw_opt==3: contribution of this block of states to <c|S|c> (where S=overlap when PAW)
==== if (signs==2) ====
if paw_opt==0, 1, 2 or 4:
gvnlc(2,my_nspinor*npw)=result of the aplication of the nl operator
or one of its derivative to the input vect.
if paw_opt==3 or 4:
gsc(2,my_nspinor*npw*(paw_opt/3))=result of the aplication of (I+S)
to the input vect. (where S=overlap when PAW)
SIDE EFFECTS
==== ONLY IF useylm=1 cwaveprj(natom,my_nspinor) <type(pawcprj_type)>=projected input wave function |c> on non-local projector =<p_lmn|c> and derivatives Treatment depends on cpopt parameter: if cpopt=-1, <p_lmn|in> (and derivatives) have to be computed (and not saved) if cpopt= 0, <p_lmn|in> have to be computed and saved derivatives are eventually computed but not saved if cpopt= 1, <p_lmn|in> and first derivatives have to be computed and saved other derivatives are eventually computed but not saved if cpopt= 2 <p_lmn|in> are already in memory; only derivatives are computed here and not saved (if useylm=0, should have cpopt=-1)
PARENTS
energy,forstrnps,m_invovl,m_lobpcgwf,vtowfk
CHILDREN
dcopy,nonlop,prep_index_wavef_bandpp,prep_sort_wavef_spin,timab xmpi_allgather,xmpi_alltoallv
NOTES
cprj (as well as cg) is distributed over band processors. Only the mod((iband-1)/mpi_enreg%bandpp,mpi_enreg%nproc_band) projected WFs are stored on each proc.
SOURCE
85 #if defined HAVE_CONFIG_H 86 #include "config.h" 87 #endif 88 89 #include "abi_common.h" 90 91 subroutine prep_nonlop(choice,cpopt,cwaveprj,enlout_block,hamk,idir,lambdablock,& 92 & blocksize,mpi_enreg,nnlout,paw_opt,signs,gsc,& 93 & tim_nonlop,cwavef,gvnlc,already_transposed) 94 95 use defs_basis 96 use defs_abitypes 97 use m_profiling_abi 98 use m_xmpi 99 use m_errors 100 use m_bandfft_kpt, only : bandfft_kpt,bandfft_kpt_get_ikpt 101 use m_hamiltonian, only : gs_hamiltonian_type 102 use m_pawcprj, only : pawcprj_type 103 104 !This section has been created automatically by the script Abilint (TD). 105 !Do not modify the following lines by hand. 106 #undef ABI_FUNC 107 #define ABI_FUNC 'prep_nonlop' 108 use interfaces_18_timing 109 use interfaces_66_nonlocal 110 use interfaces_66_wfs, except_this_one => prep_nonlop 111 !End of the abilint section 112 113 implicit none 114 115 !Arguments ------------------------------------ 116 integer,intent(in) :: blocksize,choice,cpopt,idir,signs,nnlout,paw_opt 117 logical,optional,intent(in) :: already_transposed 118 real(dp),intent(in) :: lambdablock(blocksize) 119 real(dp),intent(out) :: enlout_block(nnlout*blocksize),gvnlc(:,:),gsc(:,:) 120 real(dp),intent(inout) :: cwavef(:,:) 121 type(gs_hamiltonian_type),intent(in) :: hamk 122 type(mpi_type),intent(inout) :: mpi_enreg 123 type(pawcprj_type),intent(inout) :: cwaveprj(:,:) 124 125 !Local variables------------------------------- 126 !scalars 127 integer :: bandpp,ier,ikpt_this_proc,my_nspinor,ndatarecv,nproc_band,npw,nspinortot 128 integer :: old_me_g0,spaceComm=0,tim_nonlop 129 logical :: do_transpose 130 character(len=500) :: msg 131 !arrays 132 integer,allocatable :: index_wavef_band(:) 133 integer, allocatable :: rdisplsloc(:),recvcountsloc(:),sdisplsloc(:),sendcountsloc(:) 134 integer,ABI_CONTIGUOUS pointer :: rdispls(:),recvcounts(:),sdispls(:),sendcounts(:) 135 real(dp) :: lambda_nonlop(mpi_enreg%bandpp),tsec(2) 136 real(dp), allocatable :: cwavef_alltoall2(:,:),gvnlc_alltoall2(:,:),gsc_alltoall2(:,:) 137 real(dp), allocatable :: cwavef_alltoall1(:,:),gvnlc_alltoall1(:,:),gsc_alltoall1(:,:) 138 real(dp),allocatable :: enlout(:) 139 140 ! ************************************************************************* 141 142 DBG_ENTER('COLL') 143 144 call timab(570,1,tsec) 145 146 do_transpose = .true. 147 if(present(already_transposed)) then 148 if(already_transposed) do_transpose = .false. 149 end if 150 151 nproc_band = mpi_enreg%nproc_band 152 bandpp = mpi_enreg%bandpp 153 spaceComm=mpi_enreg%comm_fft 154 if(mpi_enreg%paral_kgb==1) spaceComm=mpi_enreg%comm_band 155 my_nspinor=max(1,hamk%nspinor/mpi_enreg%nproc_spinor) 156 nspinortot=hamk%nspinor 157 158 !Check sizes 159 npw=hamk%npw_k;if (.not.do_transpose) npw=hamk%npw_fft_k 160 if (size(cwavef)/=2*npw*my_nspinor*blocksize) then 161 msg = 'Incorrect size for cwavef!' 162 MSG_BUG(msg) 163 end if 164 if(choice/=0.and.signs==2) then 165 if (paw_opt/=3) then 166 if (size(gvnlc)/=2*npw*my_nspinor*blocksize) then 167 msg = 'Incorrect size for gvnlc!' 168 MSG_BUG(msg) 169 end if 170 end if 171 if(paw_opt>=3) then 172 if (size(gsc)/=2*npw*my_nspinor*blocksize) then 173 msg = 'Incorrect size for gsc!' 174 MSG_BUG(msg) 175 end if 176 end if 177 end if 178 if(cpopt>=0) then 179 if (size(cwaveprj)/=hamk%natom*my_nspinor*mpi_enreg%bandpp) then 180 msg = 'Incorrect size for cwaveprj!' 181 MSG_BUG(msg) 182 end if 183 end if 184 185 ABI_ALLOCATE(sendcountsloc,(nproc_band)) 186 ABI_ALLOCATE(sdisplsloc ,(nproc_band)) 187 ABI_ALLOCATE(recvcountsloc,(nproc_band)) 188 ABI_ALLOCATE(rdisplsloc ,(nproc_band)) 189 190 ikpt_this_proc=bandfft_kpt_get_ikpt() 191 192 recvcounts => bandfft_kpt(ikpt_this_proc)%recvcounts(:) 193 sendcounts => bandfft_kpt(ikpt_this_proc)%sendcounts(:) 194 rdispls => bandfft_kpt(ikpt_this_proc)%rdispls (:) 195 sdispls => bandfft_kpt(ikpt_this_proc)%sdispls (:) 196 ndatarecv = bandfft_kpt(ikpt_this_proc)%ndatarecv 197 198 ABI_ALLOCATE(cwavef_alltoall2,(2,ndatarecv*my_nspinor*bandpp)) 199 ABI_ALLOCATE(gsc_alltoall2,(2,ndatarecv*my_nspinor*(paw_opt/3)*bandpp)) 200 ABI_ALLOCATE(gvnlc_alltoall2,(2,ndatarecv*my_nspinor*bandpp)) 201 202 if(do_transpose .and. (bandpp/=1 .or. (bandpp==1 .and. mpi_enreg%paral_spinor==0.and.nspinortot==2)))then 203 ABI_ALLOCATE(cwavef_alltoall1,(2,ndatarecv*my_nspinor*bandpp)) 204 if(signs==2)then 205 if (paw_opt/=3) then 206 ABI_ALLOCATE(gvnlc_alltoall1,(2,ndatarecv*my_nspinor*bandpp)) 207 end if 208 if (paw_opt==3.or.paw_opt==4) then 209 ABI_ALLOCATE(gsc_alltoall1,(2,ndatarecv*my_nspinor*bandpp)) 210 end if 211 end if 212 end if 213 214 ABI_ALLOCATE(enlout,(nnlout*bandpp)) 215 enlout = zero 216 217 recvcountsloc(:)=recvcounts(:)*2*my_nspinor*bandpp 218 rdisplsloc(:)=rdispls(:)*2*my_nspinor*bandpp 219 sendcountsloc(:)=sendcounts(:)*2*my_nspinor 220 sdisplsloc(:)=sdispls(:)*2*my_nspinor 221 222 if(do_transpose) then 223 call timab(581,1,tsec) 224 if(bandpp/=1 .or. (bandpp==1 .and. mpi_enreg%paral_spinor==0.and.nspinortot==2))then 225 call xmpi_alltoallv(cwavef,sendcountsloc,sdisplsloc,cwavef_alltoall1,& 226 & recvcountsloc,rdisplsloc,spaceComm,ier) 227 else 228 call xmpi_alltoallv(cwavef,sendcountsloc,sdisplsloc,cwavef_alltoall2,& 229 & recvcountsloc,rdisplsloc,spaceComm,ier) 230 end if 231 call timab(581,2,tsec) 232 else 233 ! Here, we cheat, and use DCOPY to bypass some compiler's overzealous bound-checking 234 ! (ndatarecv*my_nspinor*bandpp might be greater than the declared size of cwavef) 235 call DCOPY(2*ndatarecv*my_nspinor*bandpp,cwavef,1,cwavef_alltoall2,1) 236 end if 237 238 if(hamk%istwf_k==2) then 239 old_me_g0=mpi_enreg%me_g0 240 if (mpi_enreg%me_fft==0) then 241 mpi_enreg%me_g0=1 242 else 243 mpi_enreg%me_g0=0 244 end if 245 end if 246 247 !===================================================================== 248 if (bandpp==1) then 249 250 251 if (do_transpose .and. mpi_enreg%paral_spinor==0.and.nspinortot==2) then !Sort WF by spin 252 call prep_sort_wavef_spin(nproc_band,my_nspinor,ndatarecv,recvcounts,rdispls,index_wavef_band) 253 cwavef_alltoall2(:, :)=cwavef_alltoall1(:,index_wavef_band) 254 end if 255 256 if (paw_opt==2) lambda_nonlop(1)=lambdablock(mpi_enreg%me_band+1) 257 call nonlop(choice,cpopt,cwaveprj,enlout,hamk,idir,lambda_nonlop,mpi_enreg,1,nnlout,paw_opt,& 258 & signs,gsc_alltoall2,tim_nonlop,cwavef_alltoall2,gvnlc_alltoall2) 259 260 if (do_transpose .and. mpi_enreg%paral_spinor == 0 .and. nspinortot==2.and.signs==2) then 261 if (paw_opt/=3) gvnlc_alltoall1(:,index_wavef_band)=gvnlc_alltoall2(:,:) 262 if (paw_opt==3.or.paw_opt==4) gsc_alltoall1(:,index_wavef_band)=gsc_alltoall2(:,:) 263 end if 264 265 else ! bandpp/=1 266 267 ! ------------------------------------------------------------- 268 ! Computation of the index used to sort the waves functions below bandpp 269 ! ------------------------------------------------------------- 270 if(do_transpose) then 271 call prep_index_wavef_bandpp(nproc_band,bandpp,& 272 & my_nspinor,ndatarecv,recvcounts,rdispls,index_wavef_band) 273 274 ! ------------------------------------------------------- 275 ! Sorting of the waves functions below bandpp 276 ! ------------------------------------------------------- 277 cwavef_alltoall2(:,:) = cwavef_alltoall1(:,index_wavef_band) 278 end if 279 280 ! ------------------------------------------------------- 281 ! Call nonlop 282 ! ------------------------------------------------------- 283 if(paw_opt == 2) lambda_nonlop(1:bandpp) = lambdablock((mpi_enreg%me_band*bandpp)+1:((mpi_enreg%me_band+1)*bandpp)) 284 call nonlop(choice,cpopt,cwaveprj,enlout,hamk,idir,lambda_nonlop,mpi_enreg,bandpp,nnlout,paw_opt,& 285 & signs,gsc_alltoall2,tim_nonlop,cwavef_alltoall2,gvnlc_alltoall2) 286 287 ! ----------------------------------------------------- 288 ! Sorting of waves functions below the processors 289 ! ----------------------------------------------------- 290 if(do_transpose.and.signs==2) then 291 if (paw_opt/=3) gvnlc_alltoall1(:,index_wavef_band)=gvnlc_alltoall2(:,:) 292 if (paw_opt==3.or.paw_opt==4) gsc_alltoall1(:,index_wavef_band)=gsc_alltoall2(:,:) 293 end if 294 295 end if 296 297 !===================================================================== 298 ! ------------------------------------------------------- 299 ! Deallocation 300 ! ------------------------------------------------------- 301 if (allocated(index_wavef_band)) then 302 ABI_DEALLOCATE(index_wavef_band) 303 end if 304 305 !Transpose the gsc_alltoall or gvlnc_alltoall tabs 306 !according to the paw_opt and signs values 307 if(do_transpose) then 308 if (signs==2) then 309 call timab(581,1,tsec) 310 if(bandpp/=1 .or. (bandpp==1 .and. mpi_enreg%paral_spinor==0.and.nspinortot==2))then 311 if (paw_opt/=3) then 312 call xmpi_alltoallv(gvnlc_alltoall1,recvcountsloc,rdisplsloc,gvnlc,& 313 & sendcountsloc,sdisplsloc,spaceComm,ier) 314 end if 315 if (paw_opt==3.or.paw_opt==4) then 316 call xmpi_alltoallv(gsc_alltoall1,recvcountsloc,rdisplsloc,gsc,& 317 & sendcountsloc,sdisplsloc,spaceComm,ier) 318 end if 319 else 320 if (paw_opt/=3) then 321 call xmpi_alltoallv(gvnlc_alltoall2,recvcountsloc,rdisplsloc,gvnlc,& 322 & sendcountsloc,sdisplsloc,spaceComm,ier) 323 end if 324 if (paw_opt==3.or.paw_opt==4) then 325 call xmpi_alltoallv(gsc_alltoall2,recvcountsloc,rdisplsloc,gsc,& 326 & sendcountsloc,sdisplsloc,spaceComm,ier) 327 end if 328 end if 329 call timab(581,2,tsec) 330 end if 331 else 332 ! TODO check other usages, maybe 333 call DCOPY(2*ndatarecv*my_nspinor*bandpp, gsc_alltoall2, 1, gsc, 1) 334 end if 335 if (hamk%istwf_k==2) mpi_enreg%me_g0=old_me_g0 336 337 if (nnlout>0) then 338 call xmpi_allgather(enlout,nnlout*bandpp,enlout_block,spaceComm,ier) 339 end if 340 ABI_DEALLOCATE(enlout) 341 ABI_DEALLOCATE(sendcountsloc) 342 ABI_DEALLOCATE(sdisplsloc) 343 ABI_DEALLOCATE(recvcountsloc) 344 ABI_DEALLOCATE(rdisplsloc) 345 ABI_DEALLOCATE(cwavef_alltoall2) 346 ABI_DEALLOCATE(gvnlc_alltoall2) 347 ABI_DEALLOCATE(gsc_alltoall2) 348 if(do_transpose .and. (bandpp/=1 .or. (bandpp==1 .and. mpi_enreg%paral_spinor==0.and.nspinortot==2)))then 349 ABI_DEALLOCATE(cwavef_alltoall1) 350 if(signs==2)then 351 if (paw_opt/=3) then 352 ABI_DEALLOCATE(gvnlc_alltoall1) 353 end if 354 if (paw_opt==3.or.paw_opt==4) then 355 ABI_DEALLOCATE(gsc_alltoall1) 356 end if 357 end if 358 end if 359 360 call timab(570,2,tsec) 361 362 DBG_EXIT('COLL') 363 364 end subroutine prep_nonlop