pwdft  0.1
PW-DFT code for education
Functions/Subroutines
libtetrabz_occ_mod Module Reference

Functions/Subroutines

subroutine, public libtetrabz_occ (ltetra, bvec, nb, nge, eig, ngw, wght, comm)
 
subroutine, public libtetrabz_fermieng (ltetra, bvec, nb, nge, eig, ngw, wght, ef, nelec, comm)
 
subroutine libtetrabz_occ_main (wlsm, nt_local, ik_global, ik_local, nb, nkBZ, eig, nk_local, occ, ef)
 

Function/Subroutine Documentation

◆ libtetrabz_occ()

subroutine, public libtetrabz_occ_mod::libtetrabz_occ ( integer(c_int), intent(in)  ltetra,
real(c_double), dimension(9), intent(in)  bvec,
integer(c_int), intent(in)  nb,
integer(c_int), dimension(3), intent(in)  nge,
real(c_double), dimension(nb,product(nge(1:3))), intent(in)  eig,
integer(c_int), dimension(3), intent(in)  ngw,
real(c_double), dimension(nb,product(ngw(1:3))), intent(out)  wght,
integer(c_int), intent(in), optional  comm 
)

Definition at line 35 of file libtetrabz_occ_mod.F90.

35  !
36  USE iso_c_binding
37  USE libtetrabz_common, ONLY : libtetrabz_initialize, libtetrabz_interpol_indx, libtetrabz_mpisum_dv
38  IMPLICIT NONE
39  !
40  INTEGER(C_INT),INTENT(IN) :: ltetra, nb, nge(3), ngw(3)
41  REAL(C_DOUBLE),INTENT(IN) :: bvec(9), eig(nb,PRODUCT(nge(1:3)))
42  REAL(C_DOUBLE),INTENT(OUT) :: wght(nb,PRODUCT(ngw(1:3)))
43  INTEGER(C_INT),INTENT(IN),OPTIONAL :: comm
44  !
45  LOGICAL :: linterpol
46  INTEGER :: nt_local, nk_local, nkBZ, ik, kintp(8)
47  INTEGER,ALLOCATABLE :: ik_global(:,:), ik_local(:,:)
48  REAL(8) :: wlsm(4,20), wintp(1,8)
49  REAL(8),ALLOCATABLE :: wghtd(:,:,:), kvec(:,:)
50  !
51  IF(PRESENT(comm)) THEN
52  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
53  & nt_local,nkbz,ik_global,ik_local,kvec,comm)
54  ELSE
55  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
56  & nt_local,nkbz,ik_global,ik_local,kvec)
57  END IF
58  !
59  IF(linterpol) THEN
60  !
61  ALLOCATE(wghtd(nb,1,nk_local))
62  CALL libtetrabz_occ_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,nk_local,wghtd,0d0)
63  !
64  ! Interpolation
65  !
66  wght(1:nb,1:product(ngw(1:3))) = 0d0
67  DO ik = 1, nk_local
68  CALL libtetrabz_interpol_indx(ngw,kvec(1:3,ik),kintp,wintp)
69  wght(1:nb,kintp(1:8)) = wght(1:nb, kintp(1:8)) &
70  & + matmul(wghtd(1:nb,1:1,ik), wintp(1:1,1:8))
71  END DO ! ik = 1, nk_local
72  DEALLOCATE(wghtd, kvec)
73  !
74  IF(PRESENT(comm)) CALL libtetrabz_mpisum_dv(comm, nb * product(ngw(1:3)), wght)
75  !
76  ELSE
77  CALL libtetrabz_occ_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,nk_local,wght,0d0)
78  END IF
79  !
80  DEALLOCATE(ik_global, ik_local)
81  !

References libtetrabz_common::libtetrabz_initialize(), libtetrabz_common::libtetrabz_interpol_indx(), libtetrabz_common::libtetrabz_mpisum_dv(), and libtetrabz_occ_main().

Here is the call graph for this function:

◆ libtetrabz_fermieng()

subroutine, public libtetrabz_occ_mod::libtetrabz_fermieng ( integer(c_int), intent(in)  ltetra,
real(c_double), dimension(9), intent(in)  bvec,
integer(c_int), intent(in)  nb,
integer(c_int), dimension(3), intent(in)  nge,
real(c_double), dimension(nb,product(nge(1:3))), intent(in)  eig,
integer(c_int), dimension(3), intent(in)  ngw,
real(c_double), dimension(nb,product(ngw(1:3))), intent(out)  wght,
real(c_double), intent(out)  ef,
real(c_double), intent(in)  nelec,
integer(c_int), intent(in), optional  comm 
)

Definition at line 87 of file libtetrabz_occ_mod.F90.

87  !
88  USE iso_c_binding
89  USE libtetrabz_common, ONLY : libtetrabz_initialize, libtetrabz_interpol_indx, &
90  & libtetrabz_mpisum_d, libtetrabz_mpisum_dv
91  IMPLICIT NONE
92  !
93  INTEGER(C_INT),INTENT(IN) :: ltetra, nb, nge(3), ngw(3)
94  REAL(C_DOUBLE),INTENT(IN) :: bvec(9), nelec, eig(nb,PRODUCT(nge(1:3)))
95  REAL(C_DOUBLE),INTENT(OUT) :: ef
96  REAL(C_DOUBLE),INTENT(OUT) :: wght(nb,PRODUCT(ngw(1:3)))
97  INTEGER(C_INT),INTENT(IN),OPTIONAL :: comm
98  !
99  LOGICAL :: linterpol
100  INTEGER :: nt_local, nk_local, nkBZ, ik, kintp(8)
101  INTEGER,ALLOCATABLE :: ik_global(:,:), ik_local(:,:)
102  REAL(8) :: wlsm(4,20), wintp(1,8)
103  REAL(8),ALLOCATABLE :: wghtd(:,:,:), kvec(:,:)
104  !
105  INTEGER :: iter, maxiter = 300
106  REAL(8) :: elw, eup, eps= 1d-10, sumkmid
107  !
108  IF(PRESENT(comm)) THEN
109  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
110  & nt_local,nkbz,ik_global,ik_local,kvec,comm)
111  ELSE
112  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
113  & nt_local,nkbz,ik_global,ik_local,kvec)
114  END IF
115  !
116  IF(linterpol) ALLOCATE(wghtd(nb,1,nk_local))
117  !
118  elw = minval(eig(1:nb,1:product(nge(1:3))))
119  eup = maxval(eig(1:nb,1:product(nge(1:3))))
120  !
121  ! Bisection method
122  !
123  DO iter = 1, maxiter
124  !
125  ef = (eup + elw) / 2.d0
126  !
127  ! Calc. # of electrons
128  !
129  IF(linterpol) THEN
130  CALL libtetrabz_occ_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,nk_local,wghtd,ef)
131  sumkmid = sum(wghtd(1:nb,1,1:nk_local))
132  !
133  IF(PRESENT(comm)) CALL libtetrabz_mpisum_d(comm,sumkmid)
134  !
135  ELSE
136  CALL libtetrabz_occ_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,nk_local,wght,ef)
137  sumkmid = sum(wght(1:nb,1:nk_local))
138  END IF
139  !
140  ! convergence check
141  !
142  IF(abs(sumkmid - nelec) < eps) THEN
143  EXIT
144  ELSE IF(sumkmid < nelec) THEN
145  elw = ef
146  ELSE
147  eup = ef
148  ENDIF
149  !
150  END DO ! iter
151  !
152  IF(iter >= maxiter) stop "libtetrabz_fermieng"
153  !
154  IF(linterpol) THEN
155  !
156  ! Interpolation
157  !
158  wght(1:nb,1:product(ngw(1:3))) = 0d0
159  DO ik = 1, nk_local
160  CALL libtetrabz_interpol_indx(ngw,kvec(1:3,ik),kintp,wintp)
161  wght(1:nb,kintp(1:8)) = wght(1:nb, kintp(1:8)) &
162  & + matmul(wghtd(1:nb,1:1,ik), wintp(1:1,1:8))
163  END DO ! ik = 1, nk_local
164  DEALLOCATE(wghtd, kvec)
165  !
166  IF(PRESENT(comm)) CALL libtetrabz_mpisum_dv(comm, nb * product(ngw(1:3)), wght)
167  !
168  END IF ! (linterpol)
169  !
170  DEALLOCATE(ik_global, ik_local)
171  !

References libtetrabz_common::libtetrabz_initialize(), libtetrabz_common::libtetrabz_interpol_indx(), libtetrabz_common::libtetrabz_mpisum_d(), libtetrabz_common::libtetrabz_mpisum_dv(), and libtetrabz_occ_main().

Here is the call graph for this function:

◆ libtetrabz_occ_main()

subroutine libtetrabz_occ_mod::libtetrabz_occ_main ( real(8), dimension(4,20), intent(in)  wlsm,
integer, intent(in)  nt_local,
integer, dimension(20,nt_local), intent(in)  ik_global,
integer, dimension(20,nt_local), intent(in)  ik_local,
integer, intent(in)  nb,
integer, intent(in)  nkBZ,
real(8), dimension(nb,nkbz), intent(in)  eig,
integer, intent(in)  nk_local,
real(8), dimension(nb,nk_local), intent(out)  occ,
real(8), intent(in)  ef 
)

Definition at line 177 of file libtetrabz_occ_mod.F90.

177  !
178  USE libtetrabz_common, ONLY : libtetrabz_sort, &
179  & libtetrabz_tsmall_a1, libtetrabz_tsmall_b1, &
180  & libtetrabz_tsmall_b2, libtetrabz_tsmall_b3, &
181  & libtetrabz_tsmall_c1, libtetrabz_tsmall_c2, &
182  & libtetrabz_tsmall_c3
183  IMPLICIT NONE
184  !
185  INTEGER,INTENT(IN) :: nt_local, nb, nkBZ, nk_local, &
186  & ik_global(20,nt_local), ik_local(20,nt_local)
187  REAL(8),INTENT(IN) :: wlsm(4,20), ef, eig(nb,nkBZ)
188  REAL(8),INTENT(OUT) :: occ(nb,nk_local)
189  !
190  INTEGER :: ib, indx(4), it
191  REAL(8) :: e(4), ei1(4,nb), tsmall(4,4), V, w1(4)
192  !
193  occ(1:nb,1:nk_local) = 0d0
194  !
195  !$OMP PARALLEL DEFAULT(NONE) &
196  !$OMP & SHARED(ef,eig,ik_global,ik_local,nb,nt_local,occ,wlsm) &
197  !$OMP & PRIVATE(e,ei1,ib,indx,it,tsmall,V,w1)
198  !
199  DO it = 1, nt_local
200  !
201  DO ib = 1, nb
202  ei1(1:4,ib) = matmul(wlsm(1:4,1:20), eig(ib,ik_global(1:20,it)))
203  END DO
204  !
205  !$OMP DO
206  DO ib = 1, nb
207  !
208  w1(1:4) = 0d0
209  e(1:4) = ei1(1:4, ib) - ef
210  CALL libtetrabz_sort(4,e,indx)
211  !
212  IF(e(1) <= 0d0 .AND. 0d0 < e(2)) THEN
213  !
214  CALL libtetrabz_tsmall_a1(e,v,tsmall)
215  w1(indx(1:4)) = w1(indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
216  !
217  ELSE IF(e(2) <= 0d0 .AND. 0d0 < e(3)) THEN
218  !
219  CALL libtetrabz_tsmall_b1(e,v,tsmall)
220  w1(indx(1:4)) = w1(indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
221  !
222  CALL libtetrabz_tsmall_b2(e,v,tsmall)
223  w1(indx(1:4)) = w1(indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
224  !
225  CALL libtetrabz_tsmall_b3(e,v,tsmall)
226  w1(indx(1:4)) = w1(indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
227  !
228  ELSE IF(e(3) <= 0d0 .AND. 0d0 < e(4)) THEN
229  !
230  CALL libtetrabz_tsmall_c1(e,v,tsmall)
231  w1(indx(1:4)) = w1(indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
232  !
233  CALL libtetrabz_tsmall_c2(e,v,tsmall)
234  w1(indx(1:4)) = w1(indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
235  !
236  CALL libtetrabz_tsmall_c3(e,v,tsmall)
237  w1(indx(1:4)) = w1(indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
238  !
239  ELSE IF(e(4) <= 0d0) THEN
240  !
241  w1(1:4) = 0.25d0
242  !
243  ELSE
244  !
245  cycle
246  !
247  END IF
248  !
249  occ(ib,ik_local(1:20,it)) = occ(ib,ik_local(1:20,it)) &
250  & + matmul(w1(1:4), wlsm(1:4,1:20))
251  !
252  END DO ! ib
253  !$OMP END DO NOWAIT
254  !
255  END DO ! it
256  !
257  !$OMP END PARALLEL
258  !
259  occ(1:nb,1:nk_local) = occ(1:nb,1:nk_local) / dble(6 * nkbz)
260  !

References libtetrabz_common::libtetrabz_sort(), libtetrabz_common::libtetrabz_tsmall_a1(), libtetrabz_common::libtetrabz_tsmall_b1(), libtetrabz_common::libtetrabz_tsmall_b2(), libtetrabz_common::libtetrabz_tsmall_b3(), libtetrabz_common::libtetrabz_tsmall_c1(), libtetrabz_common::libtetrabz_tsmall_c2(), and libtetrabz_common::libtetrabz_tsmall_c3().

Referenced by libtetrabz_fermieng(), and libtetrabz_occ().

Here is the call graph for this function:
Here is the caller graph for this function:
libtetrabz_common::libtetrabz_tsmall_b2
subroutine, public libtetrabz_tsmall_b2(e, V, tsmall)
Definition: libtetrabz_common.F90:432
libtetrabz_common::libtetrabz_mpisum_d
subroutine, public libtetrabz_mpisum_d(comm, scaler)
Definition: libtetrabz_common.F90:666
libtetrabz_common::libtetrabz_tsmall_c1
subroutine, public libtetrabz_tsmall_c1(e, V, tsmall)
Definition: libtetrabz_common.F90:484
libtetrabz_common::libtetrabz_mpisum_dv
subroutine, public libtetrabz_mpisum_dv(comm, ndim, vector)
Definition: libtetrabz_common.F90:687
libtetrabz_common::libtetrabz_tsmall_a1
subroutine, public libtetrabz_tsmall_a1(e, V, tsmall)
Definition: libtetrabz_common.F90:380
libtetrabz_common::libtetrabz_tsmall_b1
subroutine, public libtetrabz_tsmall_b1(e, V, tsmall)
Definition: libtetrabz_common.F90:406
libtetrabz_common::libtetrabz_initialize
subroutine, public libtetrabz_initialize(ltetra, nge, ngw, bvec, linterpol, wlsm, nk_local, nt_local, nkBZ, ik_global, ik_local, kvec, comm)
Definition: libtetrabz_common.F90:40
libtetrabz_common::libtetrabz_interpol_indx
subroutine, public libtetrabz_interpol_indx(ng, kvec, kintp, wintp)
Definition: libtetrabz_common.F90:340
libtetrabz_common::libtetrabz_tsmall_c3
subroutine, public libtetrabz_tsmall_c3(e, V, tsmall)
Definition: libtetrabz_common.F90:536
libtetrabz_common::libtetrabz_tsmall_c2
subroutine, public libtetrabz_tsmall_c2(e, V, tsmall)
Definition: libtetrabz_common.F90:510
libtetrabz_common
Definition: libtetrabz_common.F90:23
libtetrabz_common::libtetrabz_tsmall_b3
subroutine, public libtetrabz_tsmall_b3(e, V, tsmall)
Definition: libtetrabz_common.F90:458
libtetrabz_common::libtetrabz_sort
subroutine, public libtetrabz_sort(n, key, indx)
Definition: libtetrabz_common.F90:308