TABLE OF CONTENTS


ABINIT/gwls_wf [ Modules ]

[ Top ] [ 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