Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 :
7 : MODULE m_add_vnonlocal
8 : USE m_judft
9 : USE m_types
10 : use m_types_mpimat
11 : ! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c
12 : ! This module is the driver routine for the calculation of the Hartree c
13 : ! Fock exchange term by using the mixed basis set. c
14 : ! c
15 : ! hsfock c
16 : ! | c
17 : ! |- symm.F: c
18 : ! | calculates the irreducible representation c
19 : ! | c
20 : ! |- wavefproducts.F: s s* c
21 : ! | computes the repsentation of phi phi in the mixed basis c
22 : ! | n,k n',k+q c
23 : ! | c
24 : ! |- exchange.F: c
25 : ! | calculates valence-valence part of the exchange matrix (mat_ex), c
26 : ! | c
27 : ! |- exchange_core.F c
28 : ! | calculate valence-core contribution c
29 : ! c
30 : ! variables: c
31 : ! fi%kpts%nkptf := number of kpoints c
32 : ! fi%kpts%nkpt := number of irreducible kpoints c
33 : ! nbands := number of bands for which the exchange matrix (mat_ex) c
34 : ! in the space of the wavefunctions is calculated c
35 : ! te_hfex := hf exchange contribution to the total energy c
36 : ! mnobd := maximum number of occupied bands c
37 : ! parent := parent(ikpt) points to the symmetry equivalent point c
38 : ! under the little group of kpoint nk c
39 : ! symop := symop(ikpt) points to the symmetry operation, which c
40 : ! maps parent(ikpt) on ikpt c
41 : ! c
42 : ! c
43 : ! M.Betzinger (09/07) c
44 : ! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c
45 : CONTAINS
46 372 : SUBROUTINE add_vnonlocal(nk, lapw, fi, hybdat, jsp,&
47 : xcpot, fmpi, nococonv, hmat)
48 : USE m_constants
49 : USE m_symm_hf, ONLY: symm_hf
50 : USE m_intgrf, ONLY: intgrf, intgrf_init
51 : USE m_exchange_valence_hf
52 : USE m_exchange_core
53 : USE m_symmetrizeh
54 : USE m_wrapper
55 : USE m_hsefunctional, ONLY: exchange_vccvHSE, exchange_ccccHSE
56 : USE m_io_hybrid
57 : use m_glob_tofrom_loc
58 : IMPLICIT NONE
59 :
60 : type(t_fleurinput), intent(in) :: fi
61 : CLASS(t_xcpot), INTENT(IN) :: xcpot
62 : TYPE(t_hybdat), INTENT(INOUT) :: hybdat
63 : TYPE(t_lapw), INTENT(IN) :: lapw
64 : type(t_mpi), intent(in) :: fmpi
65 : type(t_nococonv),intent(in) :: nococonv
66 : TYPE(t_mat), INTENT(INOUT) :: hmat
67 :
68 : INTEGER, INTENT(IN) :: jsp
69 : INTEGER, INTENT(IN) :: nk
70 :
71 : ! local scalars
72 : INTEGER :: iband, nbasfcn, i, i0, j, ierr, iband_loc, pe_iband
73 : INTEGER :: tempI, tempJ
74 372 : integer, allocatable :: list(:)
75 : REAL :: a_ex
76 372 : class(t_mat), allocatable :: tmp, z
77 372 : COMPLEX :: exch(fi%input%neig)
78 :
79 372 : call timestart("add_vnonlocal")
80 372 : call timestart("apply v_x")
81 : ! initialize weighting factor for HF exchange part
82 372 : a_ex = xcpot%get_exchange_weight()
83 :
84 372 : nbasfcn = lapw%nv(jsp) + fi%atoms%nlotot
85 :
86 372 : IF (hmat%l_real) THEN
87 17376 : DO i = fmpi%n_rank+1,hmat%matsize1,fmpi%n_size
88 17136 : i0=(i-1)/fmpi%n_size+1
89 1609596 : DO j = 1,MIN(i,hmat%matsize1)
90 1609356 : hmat%data_r(j,i0) = hmat%data_r(j, i0) - a_ex * hybdat%v_x(nk, jsp)%data_r(j, i0)
91 : enddo
92 : enddo
93 : else
94 12034 : DO i = fmpi%n_rank+1,hmat%matsize1,fmpi%n_size
95 11902 : i0=(i-1)/fmpi%n_size+1
96 1091376 : DO j = 1,MIN(i,hmat%matsize1)
97 1091244 : hmat%data_c(j,i0) = hmat%data_c(j, i0) - a_ex * CONJG(hybdat%v_x(nk, jsp)%data_c(j, i0))
98 : enddo
99 : enddo
100 : endif
101 372 : call timestop("apply v_x")
102 :
103 372 : IF (fmpi%n_size == 1) THEN
104 0 : ALLOCATE (t_mat::z, tmp)
105 : ELSE
106 372 : ALLOCATE (t_mpimat::z, tmp)
107 : END IF
108 :
109 372 : CALL z%init(hmat%l_real, nbasfcn, hybdat%nbands(nk, jsp), fmpi%sub_comm, .false.)
110 29382 : list = [(i, i= fmpi%n_rank+1,hybdat%nbands(nk,jsp), fmpi%n_size )]
111 372 : call read_z(fi%atoms, fi%cell, hybdat, fi%kpts, fi%sym, fi%noco, nococonv, fi%input, nk, jsp, z, list=list)
112 :
113 : #ifdef CPP_MPI
114 372 : call timestart("post add_vnonl read_z barrier")
115 372 : call MPI_Barrier(fmpi%mpi_comm, ierr)
116 372 : call timestop("post add_vnonl read_z barrier")
117 : #endif
118 :
119 : ! calculate exchange contribution of current k-point nk to total energy (te_hfex)
120 : ! in the case of a spin-unpolarized calculation the factor 2 is added in eigen.F90
121 :
122 24972 : exch = 0
123 : select type(vx =>hybdat%v_x(nk, jsp))
124 : class is (t_mat)
125 0 : if(nbasfcn /= vx%matsize2) call juDFT_error("these dimension should match. is this a spin issue?")
126 : class is (t_mpimat)
127 372 : if(nbasfcn /= vx%global_size2) call juDFT_error("these dimension should match. is this a spin issue?")
128 : end select
129 : !z%matsize1 = MIN(z%matsize1, hybdat%v_x(nk, jsp)%matsize2)
130 372 : call tmp%init(hmat%l_real, nbasfcn, hybdat%nbands(nk, jsp), fmpi%sub_comm, .false.)
131 372 : IF (hybdat%v_x(nk, jsp)%l_real) then
132 240 : CALL hybdat%v_x(nk, jsp)%multiply(z, tmp)
133 : else
134 132 : CALL hybdat%v_x(nk, jsp)%multiply(z, tmp, transA="T")
135 : endif
136 :
137 : ! WRITE (oUnit, '(A)') " K-points, iband, exch - div (eV), div (eV), exch (eV)"
138 19216 : DO iband = 1, hybdat%nbands(nk, jsp)
139 18844 : call glob_to_loc(fmpi, iband, pe_iband, iband_loc)
140 18844 : if(pe_iband == fmpi%n_rank) then
141 9422 : IF (z%l_real) THEN
142 804180 : exch(iband) = dot_product(z%data_r(:z%matsize1, iband_loc), tmp%data_r(:, iband_loc))
143 : ELSE
144 586432 : exch(iband) = dot_product(z%data_c(:z%matsize1, iband_loc), tmp%data_c(:, iband_loc))
145 : END IF
146 : endif
147 : #ifdef CPP_MPI
148 18844 : call MPI_Bcast(exch(iband), 1, MPI_DOUBLE_COMPLEX, pe_iband, fmpi%sub_comm, ierr)
149 : #endif
150 19216 : IF (iband <= hybdat%nobd(nk,jsp)) THEN
151 3794 : hybdat%results%te_hfex%valence = hybdat%results%te_hfex%valence - real(a_ex*hybdat%results%w_iks(iband, nk, jsp)*exch(iband))
152 : END IF
153 : ! IF (hybdat%l_calhf) THEN
154 : ! WRITE (oUnit, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F15.5)') &
155 : ! fi%kpts%bkf(:, nk), iband, (REAL(exch(iband)) - hybdat%div_vv(iband, nk, jsp))*(-hartree_to_ev_const), &
156 : ! hybdat%div_vv(iband, nk, jsp)*(-hartree_to_ev_const), REAL(exch(iband))*(-hartree_to_ev_const)
157 : ! END IF
158 : END DO
159 372 : call timestop("add_vnonlocal")
160 744 : END SUBROUTINE add_vnonlocal
161 372 : END MODULE m_add_vnonlocal
|
