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 : MODULE m_hsvac
7 : USE m_juDFT
8 : CONTAINS
9 : !-----------------------------------------------------------------------------
10 : ! Calculate the vacuum contribution to the Hamiltonian and Overlap matrix
11 : !-----------------------------------------------------------------------------
12 288 : SUBROUTINE hsvac(vacuum, stars, fmpi, jsp, input, v, evac, cell, &
13 144 : & lapw, noco, nococonv, hmat, smat)
14 :
15 : USE m_vacfun
16 : USE m_types
17 :
18 : IMPLICIT NONE
19 :
20 : TYPE(t_input),INTENT(IN) :: input
21 : TYPE(t_vacuum),INTENT(IN) :: vacuum
22 : TYPE(t_noco),INTENT(IN) :: noco
23 : TYPE(t_nococonv),INTENT(IN) :: nococonv
24 : TYPE(t_stars),INTENT(IN) :: stars
25 : TYPE(t_cell),INTENT(IN) :: cell
26 : TYPE(t_lapw),INTENT(IN) :: lapw
27 : TYPE(t_mpi),INTENT(IN) :: fmpi
28 : TYPE(t_potden),INTENT(IN) :: v
29 : CLASS(t_mat),INTENT(INOUT) :: hmat(:,:),smat(:,:)
30 : ! ..
31 : ! .. Scalar Arguments ..
32 : INTEGER, INTENT (IN) :: jsp
33 : ! ..
34 : ! .. Array Arguments ..
35 : REAL, INTENT (IN) :: evac(2,input%jspins)
36 : ! ..
37 : ! .. Local Scalars ..
38 : COMPLEX :: hij,sij,apw_lo,c_1
39 : REAL :: d2,gz,sign,th,wronk
40 : INTEGER :: ikG,ikG2,ikGPr,ikGPr2,jspin,ikG0
41 : INTEGER :: ivac,igSpin,igSpinPr
42 : INTEGER :: iSpin,iSpinPr
43 : INTEGER :: nc
44 : ! ..
45 : ! .. Local Arrays ..
46 144 : INTEGER :: nv2(input%jspins)
47 144 : INTEGER :: kvac(2,lapw%dim_nv2d(),input%jspins)
48 144 : INTEGER :: map2(lapw%dim_nvd(),input%jspins)
49 144 : COMPLEX :: tddv(lapw%dim_nv2d(),lapw%dim_nv2d()),tduv(lapw%dim_nv2d(),lapw%dim_nv2d())
50 144 : COMPLEX :: tudv(lapw%dim_nv2d(),lapw%dim_nv2d()),tuuv(lapw%dim_nv2d(),lapw%dim_nv2d())
51 144 : COMPLEX :: a(lapw%dim_nvd(),input%jspins),b(lapw%dim_nvd(),input%jspins)
52 144 : REAL :: ddnv(lapw%dim_nv2d(),input%jspins),dudz(lapw%dim_nv2d(),input%jspins)
53 144 : REAL :: duz(lapw%dim_nv2d(),input%jspins), udz(lapw%dim_nv2d(),input%jspins)
54 144 : REAL :: uz(lapw%dim_nv2d(),input%jspins)
55 :
56 144 : d2 = SQRT(cell%omtil/cell%area)
57 :
58 : !---> set up mapping function from 3d-->2d lapws
59 360 : DO jspin = 1,input%jspins
60 216 : nv2(jspin) = 0
61 86032 : k_loop:DO ikG = 1, lapw%nv(jspin)
62 2005460 : DO ikG2 = 1, nv2(jspin)
63 2394578 : IF (all(lapw%gvec(1:2,ikG,jspin)==kvac(1:2,ikG2,jspin))) THEN
64 73368 : map2(ikG,jspin) = ikG2
65 73368 : CYCLE k_loop
66 : END IF
67 : END DO
68 12304 : nv2(jspin) = nv2(jspin) + 1
69 12304 : IF (nv2(jspin)>lapw%dim_nv2d()) CALL juDFT_error("hsvac:lapw%dim_nv2d()",calledby ="hsvac")
70 36912 : kvac(1:2,nv2(jspin),jspin) = lapw%gvec(1:2,ikG,jspin)
71 12520 : map2(ikG,jspin) = nv2(jspin)
72 : END DO k_loop
73 : END DO
74 :
75 : !---> loop over the two vacuua (1: upper; 2: lower)
76 432 : DO ivac = 1,2
77 288 : sign = 3. - 2.*ivac !+/- 1
78 720 : DO iSpin=MERGE(1,jsp,noco%l_noco),MERGE(2,jsp,noco%l_noco) !loop over global spin
79 288 : igSpin=MIN(SIZE(hmat,1),iSpin) !in colinear case igSpin=1
80 864 : DO iSpinPr=MERGE(1,jsp,noco%l_noco),MERGE(2,jsp,noco%l_noco) !loop over global spin
81 288 : igSpinPr=MIN(SIZE(hmat,1),iSpinPr) !in colinear case igSpinPr=1
82 : !---> get the wavefunctions and set up the tuuv, etc matrices
83 288 : CALL timestart("vacfun")
84 : CALL vacfun(fmpi, vacuum, stars, input, nococonv, iSpin, iSpinPr, &
85 : & cell, ivac, evac, lapw%bkpt, v%vac(:vacuum%nmzxyd,2:,:,:), v%vac(:,1,:,:), kvac, nv2, &
86 288 : & tuuv, tddv, tudv, tduv, uz, duz, udz, dudz, ddnv, wronk)
87 288 : CALL timestop("vacfun")
88 :
89 : !---> generate a and b coeffficients
90 576 : DO jspin = MIN(iSpin,iSpinPr),MAX(iSpin,iSpinPr)
91 118920 : DO ikG = 1,lapw%nv(jspin)
92 118344 : gz = sign*cell%bmat(3,3)*lapw%k3(ikG,jspin)
93 118344 : ikG2 = map2(ikG,jspin)
94 118344 : th = gz*cell%z1
95 118344 : c_1 = CMPLX( COS(th), SIN(th) )/ (d2*wronk)
96 118344 : a(ikG,jspin) = - c_1 * CMPLX(dudz(ikG2,jspin), gz*udz(ikG2,jspin) )
97 118632 : b(ikG,jspin) = c_1 * CMPLX(duz(ikG2,jspin), gz* uz(ikG2,jspin) )
98 : END DO
99 : END DO
100 :
101 : !---> update hamiltonian and overlap matrices
102 288 : IF (iSpinPr==iSpin) THEN
103 85960 : DO ikG = fmpi%n_rank + 1, lapw%nv(iSpin), fmpi%n_size
104 85672 : ikG0 = (ikG-1)/fmpi%n_size + 1 !local column index
105 85672 : ikG2 = map2(ikG,iSpin)
106 19492776 : DO ikGPr = 1, ikG - 1 !TODO check noco case
107 : !---> overlap: only (g-g') parallel=0 '
108 19492776 : IF (map2(ikGPr, iSpin).EQ.ikG2) THEN
109 : sij = CONJG(a(ikGPr,iSpin))*a(ikG,iSpin) + &
110 376356 : CONJG(b(ikGPr,iSpin))*b(ikG,iSpin)*ddnv(ikG2,iSpin)
111 : !+APW_LO
112 376356 : IF (input%l_useapw) THEN
113 : apw_lo = (a(ikG,iSpin) * uz(ikG2,iSpin) + b(ikG,iSpin) * udz(ikG2,iSpin)) &
114 : * CONJG(a(ikGPr,iSpin) * duz(ikG2,iSpin) + b(ikGPr,iSpin) * dudz(ikG2,iSpin)) &
115 : + CONJG(a(ikGPr,iSpin) * uz(ikG2,iSpin) + b(ikGPr,iSpin) * udz(ikG2,iSpin)) &
116 0 : * (a(ikG,iSpin) * duz(ikG2,iSpin) + b(ikG,iSpin) * dudz(ikG2,iSpin))
117 : ! IF (i.lt.10) write (3,'(2i4,2f20.10)') i,j,apw_lo
118 0 : IF (hmat(1,1)%l_real) THEN
119 0 : hmat(igSpin,igSpin)%data_r(ikGPr,ikG0) = hmat(igSpin,igSpin)%data_r(ikGPr,ikG0) + 0.25 * REAL(apw_lo)
120 : ELSE
121 0 : hmat(igSpin,igSpin)%data_c(ikGPr,ikG0) = hmat(igSpin,igSpin)%data_c(ikGPr,ikG0) + 0.25 * apw_lo
122 : END IF
123 : END IF
124 :
125 : !Overlap matrix
126 376356 : IF (hmat(1,1)%l_real) THEN
127 168336 : smat(igSpin,igSpin)%data_r(ikGPr,ikG0) = smat(igSpin,igSpin)%data_r(ikGPr,ikG0) + REAL(sij)
128 : ELSE
129 208020 : smat(igSpin,igSpin)%data_c(ikGPr,ikG0) = smat(igSpin,igSpin)%data_c(ikGPr,ikG0) + sij
130 : END IF
131 : END IF
132 : END DO
133 :
134 : !Diagonal term of Overlap matrix, Hamiltonian later
135 85672 : sij = CONJG(a(ikG,iSpin))*a(ikG,iSpin) + CONJG(b(ikG,iSpin))*b(ikG,iSpin)*ddnv(ikG2,iSpin)
136 85960 : IF (hmat(1,1)%l_real) THEN
137 29924 : smat(igSpin,igSpin)%data_r(ikGPr,ikG0) = smat(igSpin,igSpin)%data_r(ikGPr,ikG0) + REAL(sij)
138 : ELSE
139 55748 : smat(igSpin,igSpin)%data_c(ikGPr,ikG0) = smat(igSpin,igSpin)%data_c(ikGPr,ikG0) + sij
140 : END IF
141 : END DO
142 : END IF
143 :
144 : !---> hamiltonian update
145 86248 : DO ikG = fmpi%n_rank+1,lapw%nv(iSpin),fmpi%n_size
146 85672 : ikG0 = (ikG-1)/fmpi%n_size + 1 !local column index
147 85672 : ikG2 = map2(ikG,iSpin)
148 19578736 : DO ikGPr = 1, MERGE(ikG, lapw%nv(iSpinPr), iSpin==iSpinPr)
149 19492776 : ikGPr2 = map2(ikGPr, iSpinPr)
150 : !hij = CONJG(a(ikGPr, iSpinPr) * tuuv(ikG2, ikGPr2) + b(ikGPr,iSpinPr) * tudv(ikG2,ikGPr2)) * a(ikG,iSpin) &
151 : ! + CONJG(b(ikGPr, iSpinPr) * tddv(ikG2, ikGPr2) + a(ikGPr,iSpinPr) * tduv(ikG2,ikGPr2)) * b(ikG,iSpin)
152 : hij = CONJG(a(ikGPr, iSpinPr)) * tuuv(ikGPr2, ikG2) * a(ikG,iSpin) &
153 : + CONJG(b(ikGPr, iSpinPr)) * tddv(ikGPr2, ikG2) * b(ikG,iSpin) &
154 : + CONJG(a(ikGPr, iSpinPr)) * tudv(ikGPr2, ikG2) * b(ikG,iSpin) &
155 19492776 : + CONJG(b(ikGPr, iSpinPr)) * tduv(ikGPr2, ikG2) * a(ikG,iSpin)
156 19578448 : IF (hmat(1,1)%l_real) THEN
157 7462076 : hmat(igSpinPr,igSpin)%data_r(ikGPr,ikG0) = hmat(igSpinPr,igSpin)%data_r(ikGPr,ikG0) + REAL(hij)
158 : ELSE
159 12030700 : hmat(igSpinPr,igSpin)%data_c(ikGPr,ikG0) = hmat(igSpinPr,igSpin)%data_c(ikGPr,ikG0) + hij
160 : END IF
161 : END DO
162 : END DO
163 : !---> end of loop over different parts of the potential matrix
164 : END DO
165 : !---> end of loop over vacua
166 : END DO
167 : END DO
168 144 : END SUBROUTINE hsvac
169 : END MODULE m_hsvac
|
