TABLE OF CONTENTS

ABINIT/m_gwls_wf [ Modules ]

[ Top ] [ Modules ]

NAME

 m_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 !  Modules to handle low-level Abinit entities, like the Hamiltonian
30 !  and wavefunctions.
31 !---------------------------------------------------------------------
32 
33 module m_gwls_wf
34 
35 ! local modules
36 use m_gwls_utility
37 
38 ! abinit modules
39 use defs_basis
40 use m_abicore
41 use m_cgtools
42 use m_xmpi
43 
44 implicit none
45 save
46 private

m_hamiltonian/contribution [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  contribution

FUNCTION

  .

INPUTS

OUTPUT

PARENTS

CHILDREN

SOURCE

250 ! real(dp) function contribution(alpha,beta,k,norm_svne)
251 !
252 !
253 !!This section has been created automatically by the script Abilint (TD).
254 !!Do not modify the following lines by hand.
255 !#undef ABI_FUNC
256 !#define ABI_FUNC 'contribution'
257 !!End of the abilint section
258 !
259 !  implicit none
260 !  real(dp), intent(in) :: alpha(k), beta(k-1), norm_svne
261 !  integer, intent(in) :: k
262 !
263 !  integer :: i
264 !  real(dp), allocatable :: eq_lin(:,:)
265 !! *************************************************************************
266 !  ABI_ALLOCATE(eq_lin,(4,k))
267 !
268 !  !Copy the input data into 4 vectors that will be overwritten by dgtsv()
269 !  eq_lin = zero
270 !  eq_lin(1,1:k-1) = beta       !sub-diagonal (only the 1:kmax-1 elements are used)
271 !  eq_lin(2,:) = alpha      !diagonal
272 !  eq_lin(3,1:k-1) = beta       !supra-diagonal (only the 1:kmax-1 elements are used)
273 !  eq_lin(4,1) = 1.0        !the RHS vector to the linear equation (here, |1,0,0,...>)
274 !
275 !  !DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
276 !  !dgtsv(matrix size, # of column of RHS, sub-diagonal elements, diagonal elements, super-diagonal elements, 
277 !  !      RHS of equation (solution of equation at end of routine), size of RHS vector, 
278 !  !      error message integer (0: success, -i: illegal ith argument, i: ith factorization failed))
279 !  call dgtsv(k,1,eq_lin(1,1:k-1),eq_lin(2,:),eq_lin(3,1:k-1),eq_lin(4,:),k,i)
280 !  !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
281 !  !to SEX, at order k, from orbital n.
282 !  !We now replace the screened coulomb interaction by the coulomb hole...
283 !  contribution = (eq_lin(4,1)-1.0)*norm_svne**2
284 !  ABI_DEALLOCATE(eq_lin)
285 ! end function contribution

m_hamiltonian/contribution_bloc [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  contribution_bloc

FUNCTION

  .

INPUTS

OUTPUT

PARENTS

CHILDREN

SOURCE

307 ! function contribution_bloc(alpha,beta,kmax,norm_svne,nseeds)
308 !
309 !
310 !!This section has been created automatically by the script Abilint (TD).
311 !!Do not modify the following lines by hand.
312 !#undef ABI_FUNC
313 !#define ABI_FUNC 'contribution_bloc'
314 !!End of the abilint section
315 !
316 !  implicit none
317 !  real(dp) :: contribution_bloc(2)
318 !  integer, intent(in) :: kmax, nseeds
319 !  real(dp), intent(in) :: alpha(2,nseeds,nseeds,kmax), beta(2,nseeds,nseeds,kmax-1), norm_svne
320 !
321 !  integer :: i=0, j=0, k=0
322 !  integer, allocatable :: ipiv(:)
323 !  complex(dpc), allocatable :: a(:,:),b(:,:)  !For the (non-banded) solver of AX=B
324 !! *************************************************************************
325 !  !write(std_out,*)  "Allocating..."
326 !  ABI_ALLOCATE(a,(kmax*nseeds,kmax*nseeds))
327 !  ABI_ALLOCATE(b,(kmax*nseeds,1))
328 !  ABI_ALLOCATE(ipiv,(kmax*nseeds))
329 !  !write(std_out,*)  "Zeroing..."
330 !  a=zero
331 !  b=zero
332 !  ipiv=zero
333 !
334 !  !Copy the input data into 4 vectors that will be overwritten by dgtsv()
335 !   !do j=1,k*nseeds
336 !   ! do i=max(1,j-nseeds),min(k*nseeds,j+nseeds)
337 !   !  ab(2*nseeds+1+i-j,j) = cmplx(alpha
338 !   ! end do
339 !   !end do
340 !  !write(std_out,*)  "Copying alpha..."
341 !  do k=1,kmax
342 !   do j=1,nseeds
343 !    do i=1,nseeds
344 !     a((k-1)*nseeds+i,(k-1)*nseeds+j) = cmplx(alpha(1,i,j,k),alpha(2,i,j,k),dpc)
345 !    end do
346 !   end do
347 !  end do
348 !  !write(std_out,*)  "Copying beta..."
349 !  do k=1,kmax-1
350 !   do j=1,nseeds
351 !    do i=1,j
352 !      a(k*nseeds+i,(k-1)*nseeds+j) = cmplx(beta(1,i,j,k),beta(2,i,j,k),dpc)
353 !      a((k-1)*nseeds+i,k*nseeds+j) = cmplx(beta(1,j,i,k),-beta(2,j,i,k),dpc) 
354 !    end do
355 !   end do
356 !  end do 
357 !  !write(std_out,*)  "Setting RHS..."
358 !  b(1,1) = (1.0,0.0)
359 !
360 !  !write(std_out,*)  "Solving..."
361 !  call zgesv(kmax*nseeds,1,a,kmax*nseeds,ipiv,b,kmax*nseeds,i)
362 !  !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
363 !  !to SEX, at order k, from orbital n 
364 !  !write(std_out,*)  "Obtaining contribution..."
365 !  contribution_bloc(1) = real(b(1,1))*norm_svne**2
366 !  contribution_bloc(2) = aimag(b(1,1))*norm_svne**2
367 !  !write(std_out,*)  "Deallocating..."
368 !  ABI_DEALLOCATE(a)
369 !  ABI_DEALLOCATE(b)
370 !  ABI_DEALLOCATE(ipiv)
371 ! end function contribution_bloc

m_hamiltonian/norm_k [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  norm_k

FUNCTION

  .

INPUTS

OUTPUT

PARENTS

CHILDREN

SOURCE

123 real(dp) function norm_k(v)
124 
125 
126 !This section has been created automatically by the script Abilint (TD).
127 !Do not modify the following lines by hand.
128 #undef ABI_FUNC
129 #define ABI_FUNC 'norm_k'
130 !End of the abilint section
131 
132 implicit none
133 real(dp), intent(in) :: v(2,nk)
134 ! *************************************************************************
135 norm_k = 0.0_dp
136 
137 do i=1,nk
138 norm_k = norm_k + v(1,i)**2 + v(2,i)**2 
139 end do
140 call xmpi_sum(norm_k,cbf,i) ! sum on all processors
141 
142 norm_k = dsqrt(norm_k)
143 
144 end function norm_k

m_hamiltonian/norm_kc [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  norm_kc

FUNCTION

  .

INPUTS

OUTPUT

PARENTS

CHILDREN

SOURCE

166 real(dp) function norm_kc(v)
167 
168 
169 !This section has been created automatically by the script Abilint (TD).
170 !Do not modify the following lines by hand.
171 #undef ABI_FUNC
172 #define ABI_FUNC 'norm_kc'
173 !End of the abilint section
174 
175 implicit none
176 complex(dpc), intent(in) :: v(nk)
177 ! *************************************************************************
178 norm_kc = zero
179 
180 do i=1,nk
181 norm_kc = norm_kc + dble(v(i))**2+dimag(v(i))**2
182 end do
183 call xmpi_sum(norm_kc,cbf,i) ! sum on all processors
184 norm_kc = dsqrt(norm_kc)
185 
186 end function norm_kc

m_hamiltonian/scprod_k [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  scprod_k

FUNCTION

  .

INPUTS

OUTPUT

PARENTS

CHILDREN

SOURCE

393 function scprod_k(v1,v2)
394 !--------------------------------------------------------------------------------
395 ! This function computes the inner product of two "vectors" (typically 
396 ! wavefunctions), < v1 | v2 >.
397 !--------------------------------------------------------------------------------
398 
399 !This section has been created automatically by the script Abilint (TD).
400 !Do not modify the following lines by hand.
401 #undef ABI_FUNC
402 #define ABI_FUNC 'scprod_k'
403 !End of the abilint section
404 
405 implicit none
406 real(dp) :: scprod_k(2)
407 real(dp), intent(in) :: v1(2,nk), v2(2,nk) 
408 ! *************************************************************************
409 scprod_k = zero
410 
411 ! The mitaine way
412 !  do i=1,nk
413 !   scprod_k(1) = scprod_k(1) + v1(1,i)*v2(1,i) + v1(2,i)*v2(2,i)
414 !   scprod_k(2) = scprod_k(2) + v1(1,i)*v2(2,i) - v1(2,i)*v2(1,i)
415 !  end do
416 
417 ! The ABINIT way
418 scprod_k = cg_zdotc(nk,v1,v2)
419 
420 ! Collect from every processor
421 call xmpi_sum(scprod_k,cbf,i) ! sum on all processors 
422 
423 end function scprod_k

m_hamiltonian/scprod_kc [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  scprod_kc

FUNCTION

  .

INPUTS

OUTPUT

PARENTS

CHILDREN

SOURCE

208 complex(dpc) function scprod_kc(v1,v2)
209 
210 
211 !This section has been created automatically by the script Abilint (TD).
212 !Do not modify the following lines by hand.
213 #undef ABI_FUNC
214 #define ABI_FUNC 'scprod_kc'
215 !End of the abilint section
216 
217 implicit none
218 complex(dpc), intent(in) :: v1(nk), v2(nk) 
219 ! *************************************************************************
220 scprod_kc = zero
221 do i=1,nk
222 scprod_kc = scprod_kc + conjg(v1(i))*v2(i)
223 end do
224 call xmpi_sum(scprod_kc,cbf,i) ! sum on all processors
225 
226 !scprod_kc = sum(conjg(v1)*v2)  !Eliminated to avoid functions that return vectors embeded in another function/subroutine call. 
227 
228 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

 78 subroutine set_wf(dv2,nx2,ny2,nz2,nk2,nb2,ng2,cbf2,cf2,cb2)
 79 
 80 
 81 !This section has been created automatically by the script Abilint (TD).
 82 !Do not modify the following lines by hand.
 83 #undef ABI_FUNC
 84 #define ABI_FUNC 'set_wf'
 85 !End of the abilint section
 86 
 87 implicit none
 88 real(dp), intent(in) :: dv2
 89 integer, intent(in) :: nx2, ny2, nz2, nk2, nb2, ng2, cbf2, cf2, cb2
 90 ! *************************************************************************
 91 dv=dv2
 92 nx=nx2
 93 ny=ny2
 94 nz=nz2
 95 nk=nk2
 96 nb=nb2
 97 ng=ng2
 98 cbf=cbf2
 99 cf=cf2
100 cb=cb2
101 end subroutine set_wf