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_hsfock
8 :
9 : ! 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
10 : ! This module is the driver routine for the calculation of the Hartree c
11 : ! Fock exchange term by using the mixed basis set. c
12 : ! c
13 : ! hsfock c
14 : ! | c
15 : ! |- symm.F: c
16 : ! | calculates the irreducible representation c
17 : ! | c
18 : ! |- wavefproducts.F: s s* c
19 : ! | computes the repsentation of phi phi in the mixed basis c
20 : ! | n,k n',k+q c
21 : ! | c
22 : ! |- exchange.F: c
23 : ! | calculates valence-valence part of the exchange matrix (mat_ex), c
24 : ! | c
25 : ! |- exchange_core.F c
26 : ! | calculate valence-core contribution c
27 : ! c
28 : ! variables: c
29 : ! fi%kpts%nkptf := number of kpoints c
30 : ! fi%kpts%nkpt := number of irreducible kpoints c
31 : ! nbands := number of bands for which the exchange matrix (mat_ex) c
32 : ! in the space of the wavefunctions is calculated c
33 : ! te_hfex := hf exchange contribution to the total energy c
34 : ! parent := parent(ikpt) points to the symmetry equivalent point c
35 : ! under the little group of kpoint nk c
36 : ! symop := symop(ikpt) points to the symmetry operation, which c
37 : ! maps parent(ikpt) on ikpt c
38 : ! c
39 : ! c
40 : ! M.Betzinger (09/07) c
41 : ! 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
42 :
43 : CONTAINS
44 :
45 24 : SUBROUTINE hsfock(fi, k_pack, mpdata, lapw, jsp, hybdat, &
46 24 : eig_irr, nococonv, stars, &
47 : results, xcpot, fmpi, vx_tmp)
48 :
49 : use m_ex_to_vx
50 : USE m_judft
51 : USE m_types
52 : USE m_intgrf
53 : USE m_wrapper
54 : USE m_io_hybrid
55 : USE m_hsefunctional
56 : USE m_symm_hf
57 : USE m_exchange_valence_hf
58 : USE m_exchange_core
59 : USE m_symmetrizeh
60 : use m_work_package
61 : USE m_eig66_data
62 : use m_eig66_mpi
63 : use m_calc_cmt
64 : IMPLICIT NONE
65 :
66 : type(t_fleurinput), intent(in) :: fi
67 : type(t_k_package), intent(in) :: k_pack
68 : TYPE(t_xcpot_inbuild), INTENT(IN) :: xcpot
69 : TYPE(t_mpi), INTENT(IN) :: fmpi
70 : TYPE(t_nococonv), INTENT(IN) :: nococonv
71 : TYPE(t_lapw), INTENT(IN) :: lapw
72 : type(t_stars), intent(in) :: stars
73 : TYPE(t_mpdata), intent(inout) :: mpdata
74 : TYPE(t_hybdat), INTENT(INOUT) :: hybdat
75 : TYPE(t_results), INTENT(INOUT) :: results
76 : type(t_mat), intent(inout) :: vx_tmp
77 :
78 : ! scalars
79 : INTEGER, INTENT(IN) :: jsp
80 :
81 : ! arrays
82 : REAL, INTENT(IN) :: eig_irr(:, :)
83 :
84 : ! local scalars
85 : INTEGER :: l, itype
86 : INTEGER :: iband, nk
87 : INTEGER :: ikpt, ikpt0
88 : INTEGER :: nsymop
89 : INTEGER :: ncstd
90 : INTEGER :: ok
91 : REAL :: a_ex
92 :
93 : ! local arrays
94 24 : INTEGER :: nsest(hybdat%nbands(k_pack%nk ,jsp)), indx_sest(hybdat%nbands(k_pack%nk ,jsp), hybdat%nbands(k_pack%nk ,jsp))
95 24 : INTEGER :: rrot(3, 3, fi%sym%nsym), ierr
96 24 : INTEGER :: psym(fi%sym%nsym) ! Note: psym is only filled up to index nsymop
97 : INTEGER :: tempI, tempJ
98 :
99 24 : INTEGER, ALLOCATABLE :: parent(:)
100 24 : INTEGER, ALLOCATABLE :: n_q(:)
101 24 : complex, allocatable :: cmt_nk(:,:,:)
102 :
103 24 : complex :: c_phase_k(hybdat%nbands(k_pack%nk ,jsp))
104 24 : REAL :: wl_iks(fi%input%neig, fi%kpts%nkptf)
105 24 : TYPE(t_mat) :: mat_ex
106 :
107 24 : CALL timestart("total time hsfock")
108 24 : nk = k_pack%nk
109 : ! initialize weighting factor for HF exchange part
110 24 : a_ex = xcpot%get_exchange_weight()
111 204 : ncstd = sum([((hybdat%nindxc(l, itype)*(2*l + 1)*fi%atoms%neq(itype), l=0, hybdat%lmaxc(itype)), itype=1, fi%atoms%ntype)])
112 24 : IF(nk == 1 .and. fmpi%irank == 0) WRITE(*, *) 'calculate new HF matrix'
113 24 : IF(nk == 1 .and. jsp == 1 .and. fi%input%imix > 10) CALL system('rm -f broyd*')
114 : ! calculate all symmetrie operations, which yield k invariant
115 :
116 72 : allocate(parent(fi%kpts%nkptf), stat=ok)
117 24 : IF(ok /= 0) call judft_error('mhsfock: failure allocation parent')
118 216 : parent = 0
119 :
120 120 : allocate(cmt_nk(hybdat%nbands(nk,jsp), hybdat%maxlmindx, fi%atoms%nat), stat=ierr)
121 24 : if(ierr /= 0) call judft_error("can't allocate cmt_nk")
122 : call calc_cmt(fi%atoms, fi%cell, fi%input, fi%noco, nococonv, fi%hybinp, hybdat, mpdata, fi%kpts, &
123 24 : fi%sym, hybdat%zmat(nk,jsp)%mat, jsp, nk, c_phase_k, cmt_nk, k_pack%submpi)
124 :
125 :
126 24 : CALL symm_hf_init(fi, nk, nsymop, rrot, psym)
127 :
128 : CALL symm_hf(fi, nk, hybdat, results, k_pack%submpi, eig_irr, mpdata, cmt_nk,&
129 24 : rrot, nsymop, psym, n_q, parent, nsest, indx_sest, jsp)
130 :
131 : ! remove weights(wtkpt) in w_iks
132 216 : DO ikpt = 1, fi%kpts%nkptf
133 13176 : DO iband = 1, fi%input%neig
134 12960 : ikpt0 = fi%kpts%bkp(ikpt)
135 13152 : wl_iks(iband, ikpt) = results%w_iks(iband, ikpt0, jsp)/(fi%kpts%wtkpt(ikpt0)*fi%kpts%nkptf)
136 : END DO
137 : END DO
138 :
139 : ! calculate contribution from valence electrons to the
140 : ! HF exchange
141 24 : mat_ex%l_real = fi%sym%invs
142 24 : PRINT*, "exchange_valence_hf"
143 :
144 : CALL exchange_valence_hf(k_pack, fi, fmpi, hybdat%zmat(nk,jsp)%mat, mpdata, jsp, hybdat, lapw, eig_irr, results, &
145 24 : n_q, wl_iks, xcpot, nococonv, stars, nsest, indx_sest, cmt_nk, mat_ex)
146 :
147 :
148 : ! calculate contribution from the core states to the HF exchange
149 24 : PRINT*, "core exchange calculation"
150 24 : CALL timestart("core exchange calculation")
151 :
152 24 : IF(xcpot%is_name("hse") .OR. xcpot%is_name("vhse")) THEN
153 0 : CALL timestart("hse: exchange vccv")
154 : CALL exchange_vccvHSE(nk, fi, mpdata, hybdat, jsp, lapw, nsymop, nsest, indx_sest, &
155 0 : fmpi%irank, a_ex, results, cmt_nk, mat_ex)
156 0 : CALL timestop("hse: exchange vccv")
157 :
158 0 : CALL timestart("hse: exchange cccc")
159 0 : CALL exchange_ccccHSE(nk, fi, hybdat, ncstd, a_ex, results)
160 :
161 0 : CALL timestop("hse: exchange cccc")
162 :
163 : ELSE
164 : CALL exchange_vccv1(nk, fi, mpdata, hybdat, jsp, &
165 24 : lapw, k_pack%submpi, nsymop, nsest, indx_sest, a_ex, results, cmt_nk, mat_ex)
166 :
167 24 : if(k_pack%submpi%root()) then
168 24 : CALL exchange_cccc(nk, fi%atoms, hybdat, ncstd, fi%sym, fi%kpts, a_ex, results)
169 : endif
170 : END IF
171 :
172 24 : CALL timestop("core exchange calculation")
173 24 : if(k_pack%submpi%root()) then
174 24 : call ex_to_vx(fi, nk, jsp, nsymop, psym, hybdat, lapw, hybdat%zmat(nk,jsp)%mat, mat_ex, vx_tmp)
175 24 : call vx_tmp%u2l()
176 : ELSE
177 : #ifdef CPP_MPI
178 : ! balance post read_z barrier
179 0 : call MPI_Barrier(MPI_COMM_WORLD, ierr)
180 0 : hybdat%max_q = hybdat%max_q - 1
181 : #endif
182 : endif
183 :
184 24 : hybdat%l_addhf = .True.
185 24 : CALL timestop("total time hsfock")
186 24 : END SUBROUTINE hsfock
187 : END MODULE m_hsfock
|