TABLE OF CONTENTS
- ABINIT/gwls_wf
- m_hamiltonian/contribution
- m_hamiltonian/contribution_bloc
- m_hamiltonian/norm_k
- m_hamiltonian/norm_kc
- m_hamiltonian/scprod_k
- m_hamiltonian/scprod_kc
- m_hamiltonian/set_wf
ABINIT/gwls_wf [ Modules ]
NAME
gwls_wf
FUNCTION
.
COPYRIGHT
Copyright (C) 2009-2018 ABINIT group (JLJ, BR, MC) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
PARENTS
CHILDREN
SOURCE
21 #if defined HAVE_CONFIG_H 22 #include "config.h" 23 #endif 24 25 #include "abi_common.h" 26 27 28 29 !--------------------------------------------------------------------- 30 ! Modules to handle low-level Abinit entities, like the Hamiltonian 31 ! and wavefunctions. 32 !--------------------------------------------------------------------- 33 34 module gwls_wf 35 36 ! local modules 37 use m_gwls_utility 38 39 ! abinit modules 40 use defs_basis 41 use m_profiling_abi 42 use m_cgtools 43 use m_xmpi 44 45 implicit none 46 save 47 private
m_hamiltonian/contribution [ Functions ]
[ Top ] [ m_hamiltonian ] [ Functions ]
NAME
contribution
FUNCTION
.
INPUTS
OUTPUT
PARENTS
CHILDREN
SOURCE
251 ! real(dp) function contribution(alpha,beta,k,norm_svne) 252 ! 253 ! 254 !!This section has been created automatically by the script Abilint (TD). 255 !!Do not modify the following lines by hand. 256 !#undef ABI_FUNC 257 !#define ABI_FUNC 'contribution' 258 !!End of the abilint section 259 ! 260 ! implicit none 261 ! real(dp), intent(in) :: alpha(k), beta(k-1), norm_svne 262 ! integer, intent(in) :: k 263 ! 264 ! integer :: i 265 ! real(dp), allocatable :: eq_lin(:,:) 266 !! ************************************************************************* 267 ! ABI_ALLOCATE(eq_lin,(4,k)) 268 ! 269 ! !Copy the input data into 4 vectors that will be overwritten by dgtsv() 270 ! eq_lin = zero 271 ! eq_lin(1,1:k-1) = beta !sub-diagonal (only the 1:kmax-1 elements are used) 272 ! eq_lin(2,:) = alpha !diagonal 273 ! eq_lin(3,1:k-1) = beta !supra-diagonal (only the 1:kmax-1 elements are used) 274 ! eq_lin(4,1) = 1.0 !the RHS vector to the linear equation (here, |1,0,0,...>) 275 ! 276 ! !DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO ) 277 ! !dgtsv(matrix size, # of column of RHS, sub-diagonal elements, diagonal elements, super-diagonal elements, 278 ! ! RHS of equation (solution of equation at end of routine), size of RHS vector, 279 ! ! error message integer (0: success, -i: illegal ith argument, i: ith factorization failed)) 280 ! call dgtsv(k,1,eq_lin(1,1:k-1),eq_lin(2,:),eq_lin(3,1:k-1),eq_lin(4,:),k,i) 281 ! !Do the scalar product between the <qr_k|sv|ne>=(1,0,0,...) vector and the solution x to T*x=(1,0,0,...) to obtain contribution 282 ! !to SEX, at order k, from orbital n. 283 ! !We now replace the screened coulomb interaction by the coulomb hole... 284 ! contribution = (eq_lin(4,1)-1.0)*norm_svne**2 285 ! ABI_DEALLOCATE(eq_lin) 286 ! end function contribution
m_hamiltonian/contribution_bloc [ Functions ]
[ Top ] [ m_hamiltonian ] [ Functions ]
NAME
contribution_bloc
FUNCTION
.
INPUTS
OUTPUT
PARENTS
CHILDREN
SOURCE
308 ! function contribution_bloc(alpha,beta,kmax,norm_svne,nseeds) 309 ! 310 ! 311 !!This section has been created automatically by the script Abilint (TD). 312 !!Do not modify the following lines by hand. 313 !#undef ABI_FUNC 314 !#define ABI_FUNC 'contribution_bloc' 315 !!End of the abilint section 316 ! 317 ! implicit none 318 ! real(dp) :: contribution_bloc(2) 319 ! integer, intent(in) :: kmax, nseeds 320 ! real(dp), intent(in) :: alpha(2,nseeds,nseeds,kmax), beta(2,nseeds,nseeds,kmax-1), norm_svne 321 ! 322 ! integer :: i=0, j=0, k=0 323 ! integer, allocatable :: ipiv(:) 324 ! complex(dpc), allocatable :: a(:,:),b(:,:) !For the (non-banded) solver of AX=B 325 !! ************************************************************************* 326 ! !write(std_out,*) "Allocating..." 327 ! ABI_ALLOCATE(a,(kmax*nseeds,kmax*nseeds)) 328 ! ABI_ALLOCATE(b,(kmax*nseeds,1)) 329 ! ABI_ALLOCATE(ipiv,(kmax*nseeds)) 330 ! !write(std_out,*) "Zeroing..." 331 ! a=zero 332 ! b=zero 333 ! ipiv=zero 334 ! 335 ! !Copy the input data into 4 vectors that will be overwritten by dgtsv() 336 ! !do j=1,k*nseeds 337 ! ! do i=max(1,j-nseeds),min(k*nseeds,j+nseeds) 338 ! ! ab(2*nseeds+1+i-j,j) = cmplx(alpha 339 ! ! end do 340 ! !end do 341 ! !write(std_out,*) "Copying alpha..." 342 ! do k=1,kmax 343 ! do j=1,nseeds 344 ! do i=1,nseeds 345 ! a((k-1)*nseeds+i,(k-1)*nseeds+j) = cmplx(alpha(1,i,j,k),alpha(2,i,j,k),dpc) 346 ! end do 347 ! end do 348 ! end do 349 ! !write(std_out,*) "Copying beta..." 350 ! do k=1,kmax-1 351 ! do j=1,nseeds 352 ! do i=1,j 353 ! a(k*nseeds+i,(k-1)*nseeds+j) = cmplx(beta(1,i,j,k),beta(2,i,j,k),dpc) 354 ! a((k-1)*nseeds+i,k*nseeds+j) = cmplx(beta(1,j,i,k),-beta(2,j,i,k),dpc) 355 ! end do 356 ! end do 357 ! end do 358 ! !write(std_out,*) "Setting RHS..." 359 ! b(1,1) = (1.0,0.0) 360 ! 361 ! !write(std_out,*) "Solving..." 362 ! call zgesv(kmax*nseeds,1,a,kmax*nseeds,ipiv,b,kmax*nseeds,i) 363 ! !Do the scalar product between the <qr_k|sv|ne>=(1,0,0,...) vector and the solution x to T*x=(1,0,0,...) to obtain contribution 364 ! !to SEX, at order k, from orbital n 365 ! !write(std_out,*) "Obtaining contribution..." 366 ! contribution_bloc(1) = real(b(1,1))*norm_svne**2 367 ! contribution_bloc(2) = aimag(b(1,1))*norm_svne**2 368 ! !write(std_out,*) "Deallocating..." 369 ! ABI_DEALLOCATE(a) 370 ! ABI_DEALLOCATE(b) 371 ! ABI_DEALLOCATE(ipiv) 372 ! end function contribution_bloc
m_hamiltonian/norm_k [ Functions ]
[ Top ] [ m_hamiltonian ] [ Functions ]
NAME
norm_k
FUNCTION
.
INPUTS
OUTPUT
PARENTS
CHILDREN
SOURCE
124 real(dp) function norm_k(v) 125 126 127 !This section has been created automatically by the script Abilint (TD). 128 !Do not modify the following lines by hand. 129 #undef ABI_FUNC 130 #define ABI_FUNC 'norm_k' 131 !End of the abilint section 132 133 implicit none 134 real(dp), intent(in) :: v(2,nk) 135 ! ************************************************************************* 136 norm_k = 0.0_dp 137 138 do i=1,nk 139 norm_k = norm_k + v(1,i)**2 + v(2,i)**2 140 end do 141 call xmpi_sum(norm_k,cbf,i) ! sum on all processors 142 143 norm_k = dsqrt(norm_k) 144 145 end function norm_k
m_hamiltonian/norm_kc [ Functions ]
[ Top ] [ m_hamiltonian ] [ Functions ]
NAME
norm_kc
FUNCTION
.
INPUTS
OUTPUT
PARENTS
CHILDREN
SOURCE
167 real(dp) function norm_kc(v) 168 169 170 !This section has been created automatically by the script Abilint (TD). 171 !Do not modify the following lines by hand. 172 #undef ABI_FUNC 173 #define ABI_FUNC 'norm_kc' 174 !End of the abilint section 175 176 implicit none 177 complex(dpc), intent(in) :: v(nk) 178 ! ************************************************************************* 179 norm_kc = zero 180 181 do i=1,nk 182 norm_kc = norm_kc + dble(v(i))**2+dimag(v(i))**2 183 end do 184 call xmpi_sum(norm_kc,cbf,i) ! sum on all processors 185 norm_kc = dsqrt(norm_kc) 186 187 end function norm_kc
m_hamiltonian/scprod_k [ Functions ]
[ Top ] [ m_hamiltonian ] [ Functions ]
NAME
scprod_k
FUNCTION
.
INPUTS
OUTPUT
PARENTS
CHILDREN
SOURCE
394 function scprod_k(v1,v2) 395 !-------------------------------------------------------------------------------- 396 ! This function computes the inner product of two "vectors" (typically 397 ! wavefunctions), < v1 | v2 >. 398 !-------------------------------------------------------------------------------- 399 400 !This section has been created automatically by the script Abilint (TD). 401 !Do not modify the following lines by hand. 402 #undef ABI_FUNC 403 #define ABI_FUNC 'scprod_k' 404 !End of the abilint section 405 406 implicit none 407 real(dp) :: scprod_k(2) 408 real(dp), intent(in) :: v1(2,nk), v2(2,nk) 409 ! ************************************************************************* 410 scprod_k = zero 411 412 ! The mitaine way 413 ! do i=1,nk 414 ! scprod_k(1) = scprod_k(1) + v1(1,i)*v2(1,i) + v1(2,i)*v2(2,i) 415 ! scprod_k(2) = scprod_k(2) + v1(1,i)*v2(2,i) - v1(2,i)*v2(1,i) 416 ! end do 417 418 ! The ABINIT way 419 scprod_k = cg_zdotc(nk,v1,v2) 420 421 ! Collect from every processor 422 call xmpi_sum(scprod_k,cbf,i) ! sum on all processors 423 424 end function scprod_k
m_hamiltonian/scprod_kc [ Functions ]
[ Top ] [ m_hamiltonian ] [ Functions ]
NAME
scprod_kc
FUNCTION
.
INPUTS
OUTPUT
PARENTS
CHILDREN
SOURCE
209 complex(dpc) function scprod_kc(v1,v2) 210 211 212 !This section has been created automatically by the script Abilint (TD). 213 !Do not modify the following lines by hand. 214 #undef ABI_FUNC 215 #define ABI_FUNC 'scprod_kc' 216 !End of the abilint section 217 218 implicit none 219 complex(dpc), intent(in) :: v1(nk), v2(nk) 220 ! ************************************************************************* 221 scprod_kc = zero 222 do i=1,nk 223 scprod_kc = scprod_kc + conjg(v1(i))*v2(i) 224 end do 225 call xmpi_sum(scprod_kc,cbf,i) ! sum on all processors 226 227 !scprod_kc = sum(conjg(v1)*v2) !Eliminated to avoid functions that return vectors embeded in another function/subroutine call. 228 229 end function scprod_kc
m_hamiltonian/set_wf [ Functions ]
[ Top ] [ m_hamiltonian ] [ Functions ]
NAME
set_wf
FUNCTION
.
INPUTS
OUTPUT
PARENTS
gwls_hamiltonian
CHILDREN
xmpi_sum
SOURCE
79 subroutine set_wf(dv2,nx2,ny2,nz2,nk2,nb2,ng2,cbf2,cf2,cb2) 80 81 82 !This section has been created automatically by the script Abilint (TD). 83 !Do not modify the following lines by hand. 84 #undef ABI_FUNC 85 #define ABI_FUNC 'set_wf' 86 !End of the abilint section 87 88 implicit none 89 real(dp), intent(in) :: dv2 90 integer, intent(in) :: nx2, ny2, nz2, nk2, nb2, ng2, cbf2, cf2, cb2 91 ! ************************************************************************* 92 dv=dv2 93 nx=nx2 94 ny=ny2 95 nz=nz2 96 nk=nk2 97 nb=nb2 98 ng=ng2 99 cbf=cbf2 100 cf=cf2 101 cb=cb2 102 end subroutine set_wf