TABLE OF CONTENTS

ABINIT/m_gwls_wf [ Modules ]

[ Top ] [ Modules ]

NAME

 m_gwls_wf

FUNCTION

  .

COPYRIGHT

 Copyright (C) 2009-2024 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 .

SOURCE

16 #if defined HAVE_CONFIG_H
17 #include "config.h"
18 #endif
19 
20 #include "abi_common.h"
21 
22 
23 !---------------------------------------------------------------------
24 !  Modules to handle low-level Abinit entities, like the Hamiltonian
25 !  and wavefunctions.
26 !---------------------------------------------------------------------
27 
28 module m_gwls_wf
29 
30 ! local modules
31 use m_gwls_utility
32 
33 ! abinit modules
34 use defs_basis
35 use m_abicore
36 use m_cgtools
37 use m_xmpi
38 
39 implicit none
40 save
41 private

m_hamiltonian/contribution [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  contribution

FUNCTION

  .

INPUTS

OUTPUT

SOURCE

195 ! real(dp) function contribution(alpha,beta,k,norm_svne)
196 !
197 !  implicit none
198 !  real(dp), intent(in) :: alpha(k), beta(k-1), norm_svne
199 !  integer, intent(in) :: k
200 !
201 !  integer :: i
202 !  real(dp), allocatable :: eq_lin(:,:)
203 !! *************************************************************************
204 !  ABI_MALLOC(eq_lin,(4,k))
205 !
206 !  !Copy the input data into 4 vectors that will be overwritten by dgtsv()
207 !  eq_lin = zero
208 !  eq_lin(1,1:k-1) = beta       !sub-diagonal (only the 1:kmax-1 elements are used)
209 !  eq_lin(2,:) = alpha      !diagonal
210 !  eq_lin(3,1:k-1) = beta       !supra-diagonal (only the 1:kmax-1 elements are used)
211 !  eq_lin(4,1) = 1.0        !the RHS vector to the linear equation (here, |1,0,0,...>)
212 !
213 !  !DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
214 !  !dgtsv(matrix size, # of column of RHS, sub-diagonal elements, diagonal elements, super-diagonal elements,
215 !  !      RHS of equation (solution of equation at end of routine), size of RHS vector,
216 !  !      error message integer (0: success, -i: illegal ith argument, i: ith factorization failed))
217 !  call dgtsv(k,1,eq_lin(1,1:k-1),eq_lin(2,:),eq_lin(3,1:k-1),eq_lin(4,:),k,i)
218 !  !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
219 !  !to SEX, at order k, from orbital n.
220 !  !We now replace the screened coulomb interaction by the coulomb hole...
221 !  contribution = (eq_lin(4,1)-1.0)*norm_svne**2
222 !  ABI_FREE(eq_lin)
223 ! end function contribution

m_hamiltonian/contribution_bloc [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  contribution_bloc

FUNCTION

  .

INPUTS

OUTPUT

SOURCE

241 ! function contribution_bloc(alpha,beta,kmax,norm_svne,nseeds)
242 !
243 !  implicit none
244 !  real(dp) :: contribution_bloc(2)
245 !  integer, intent(in) :: kmax, nseeds
246 !  real(dp), intent(in) :: alpha(2,nseeds,nseeds,kmax), beta(2,nseeds,nseeds,kmax-1), norm_svne
247 !
248 !  integer :: i=0, j=0, k=0
249 !  integer, allocatable :: ipiv(:)
250 !  complex(dpc), allocatable :: a(:,:),b(:,:)  !For the (non-banded) solver of AX=B
251 !! *************************************************************************
252 !  !write(std_out,*)  "Allocating..."
253 !  ABI_MALLOC(a,(kmax*nseeds,kmax*nseeds))
254 !  ABI_MALLOC(b,(kmax*nseeds,1))
255 !  ABI_MALLOC(ipiv,(kmax*nseeds))
256 !  !write(std_out,*)  "Zeroing..."
257 !  a=zero
258 !  b=zero
259 !  ipiv=zero
260 !
261 !  !Copy the input data into 4 vectors that will be overwritten by dgtsv()
262 !   !do j=1,k*nseeds
263 !   ! do i=max(1,j-nseeds),min(k*nseeds,j+nseeds)
264 !   !  ab(2*nseeds+1+i-j,j) = cmplx(alpha
265 !   ! end do
266 !   !end do
267 !  !write(std_out,*)  "Copying alpha..."
268 !  do k=1,kmax
269 !   do j=1,nseeds
270 !    do i=1,nseeds
271 !     a((k-1)*nseeds+i,(k-1)*nseeds+j) = cmplx(alpha(1,i,j,k),alpha(2,i,j,k),dpc)
272 !    end do
273 !   end do
274 !  end do
275 !  !write(std_out,*)  "Copying beta..."
276 !  do k=1,kmax-1
277 !   do j=1,nseeds
278 !    do i=1,j
279 !      a(k*nseeds+i,(k-1)*nseeds+j) = cmplx(beta(1,i,j,k),beta(2,i,j,k),dpc)
280 !      a((k-1)*nseeds+i,k*nseeds+j) = cmplx(beta(1,j,i,k),-beta(2,j,i,k),dpc)
281 !    end do
282 !   end do
283 !  end do
284 !  !write(std_out,*)  "Setting RHS..."
285 !  b(1,1) = (1.0,0.0)
286 !
287 !  !write(std_out,*)  "Solving..."
288 !  call zgesv(kmax*nseeds,1,a,kmax*nseeds,ipiv,b,kmax*nseeds,i)
289 !  !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
290 !  !to SEX, at order k, from orbital n
291 !  !write(std_out,*)  "Obtaining contribution..."
292 !  contribution_bloc(1) = real(b(1,1))*norm_svne**2
293 !  contribution_bloc(2) = aimag(b(1,1))*norm_svne**2
294 !  !write(std_out,*)  "Deallocating..."
295 !  ABI_FREE(a)
296 !  ABI_FREE(b)
297 !  ABI_FREE(ipiv)
298 ! end function contribution_bloc

m_hamiltonian/norm_k [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  norm_k

FUNCTION

  .

INPUTS

OUTPUT

SOURCE

101 real(dp) function norm_k(v)
102 
103 implicit none
104 real(dp), intent(in) :: v(2,nk)
105 ! *************************************************************************
106 norm_k = 0.0_dp
107 
108 do i=1,nk
109 norm_k = norm_k + v(1,i)**2 + v(2,i)**2
110 end do
111 call xmpi_sum(norm_k,cbf,i) ! sum on all processors
112 
113 norm_k = dsqrt(norm_k)
114 
115 end function norm_k

m_hamiltonian/norm_kc [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  norm_kc

FUNCTION

  .

INPUTS

OUTPUT

SOURCE

133 real(dp) function norm_kc(v)
134 
135 implicit none
136 complex(dpc), intent(in) :: v(nk)
137 ! *************************************************************************
138 norm_kc = zero
139 
140 do i=1,nk
141 norm_kc = norm_kc + dble(v(i))**2+dimag(v(i))**2
142 end do
143 call xmpi_sum(norm_kc,cbf,i) ! sum on all processors
144 norm_kc = dsqrt(norm_kc)
145 
146 end function norm_kc

m_hamiltonian/scprod_k [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  scprod_k

FUNCTION

  .

INPUTS

OUTPUT

SOURCE

316 function scprod_k(v1,v2)
317 !--------------------------------------------------------------------------------
318 ! This function computes the inner product of two "vectors" (typically
319 ! wavefunctions), < v1 | v2 >.
320 !--------------------------------------------------------------------------------
321 implicit none
322 real(dp) :: scprod_k(2)
323 real(dp), intent(in) :: v1(2,nk), v2(2,nk)
324 ! *************************************************************************
325 scprod_k = zero
326 
327 ! The mitaine way
328 !  do i=1,nk
329 !   scprod_k(1) = scprod_k(1) + v1(1,i)*v2(1,i) + v1(2,i)*v2(2,i)
330 !   scprod_k(2) = scprod_k(2) + v1(1,i)*v2(2,i) - v1(2,i)*v2(1,i)
331 !  end do
332 
333 ! The ABINIT way
334 scprod_k = cg_zdotc(nk,v1,v2)
335 
336 ! Collect from every processor
337 call xmpi_sum(scprod_k,cbf,i) ! sum on all processors
338 
339 end function scprod_k

m_hamiltonian/scprod_kc [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  scprod_kc

FUNCTION

  .

INPUTS

OUTPUT

SOURCE

164 complex(dpc) function scprod_kc(v1,v2)
165 
166 implicit none
167 complex(dpc), intent(in) :: v1(nk), v2(nk)
168 ! *************************************************************************
169 scprod_kc = zero
170 do i=1,nk
171 scprod_kc = scprod_kc + conjg(v1(i))*v2(i)
172 end do
173 call xmpi_sum(scprod_kc,cbf,i) ! sum on all processors
174 
175 !scprod_kc = sum(conjg(v1)*v2)  !Eliminated to avoid functions that return vectors embeded in another function/subroutine call.
176 
177 end function scprod_kc

m_hamiltonian/set_wf [ Functions ]

[ Top ] [ m_hamiltonian ] [ Functions ]

NAME

  set_wf

FUNCTION

  .

INPUTS

OUTPUT

SOURCE

67 subroutine set_wf(dv2,nx2,ny2,nz2,nk2,nb2,ng2,cbf2,cf2,cb2)
68 
69 implicit none
70 real(dp), intent(in) :: dv2
71 integer, intent(in) :: nx2, ny2, nz2, nk2, nb2, ng2, cbf2, cf2, cb2
72 ! *************************************************************************
73 dv=dv2
74 nx=nx2
75 ny=ny2
76 nz=nz2
77 nk=nk2
78 nb=nb2
79 ng=ng2
80 cbf=cbf2
81 cf=cf2
82 cb=cb2
83 end subroutine set_wf