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_hsmt_offdiag
8 : USE m_juDFT
9 : IMPLICIT NONE
10 : CONTAINS
11 0 : SUBROUTINE hsmt_offdiag(n,atoms,fmpi,nococonv,lapw,td,usdus,fjgj,ispin,jspin,iintsp,jintsp,hmat)
12 : USE m_constants, ONLY : fpi_const,tpi_const
13 : USE m_types
14 : USE m_hsmt_spinor
15 : USE m_hsmt_fjgj
16 : IMPLICIT NONE
17 : TYPE(t_mpi),INTENT(IN) :: fmpi
18 : TYPE(t_nococonv),INTENT(IN) :: nococonv
19 : TYPE(t_atoms),INTENT(IN) :: atoms
20 : TYPE(t_lapw),INTENT(IN) :: lapw
21 : TYPE(t_usdus),INTENT(IN) :: usdus
22 : TYPE(t_tlmplm),INTENT(IN) :: td
23 : TYPE(t_fjgj),INTENT(IN) :: fjgj
24 : CLASS(t_mat),INTENT(INOUT) :: hmat(:,:)!(2,2)
25 :
26 : ! ..
27 : ! .. Scalar Arguments ..
28 : INTEGER, INTENT (IN) :: n,ispin,jspin,iintsp,jintsp
29 : ! ..
30 : ! ..
31 : ! .. Local Scalars ..
32 : REAL tnn(3),ski(3)
33 : INTEGER kii,ki,kj,l,nn,s
34 : COMPLEX :: fct
35 : ! ..
36 : ! .. Local Arrays ..
37 0 : REAL fleg1(0:atoms%lmaxd),fleg2(0:atoms%lmaxd),fl2p1(0:atoms%lmaxd)
38 0 : REAL fl2p1bt(0:atoms%lmaxd)
39 : REAL qssbti(3),qssbtj(3)
40 : COMPLEX:: chi(2,2,2,2)
41 0 : REAL, ALLOCATABLE :: plegend(:,:)
42 0 : COMPLEX, ALLOCATABLE :: cph(:)
43 :
44 0 : CALL timestart("offdiagonal setup")
45 :
46 0 : CALL hsmt_spinor_soc(n,1,nococonv,lapw,chi)
47 :
48 :
49 :
50 0 : DO l = 0,atoms%lmaxd
51 0 : fleg1(l) = REAL(l+l+1)/REAL(l+1)
52 0 : fleg2(l) = REAL(l)/REAL(l+1)
53 0 : fl2p1(l) = REAL(l+l+1)/fpi_const
54 0 : fl2p1bt(l) = fl2p1(l)*0.5
55 : END DO
56 : !$OMP PARALLEL DEFAULT(SHARED)&
57 : !$OMP PRIVATE(kii,ki,ski,kj,plegend,l)&
58 : !$OMP PRIVATE(cph,nn,tnn)&
59 0 : !$OMP PRIVATE(fct,s)
60 : ALLOCATE(cph(MAXVAL(lapw%nv)))
61 : ALLOCATE(plegend(MAXVAL(lapw%nv),0:atoms%lmaxd))
62 : plegend=0.0
63 : plegend(:,0)=1.0
64 : qssbti=MERGE(- nococonv%qss/2,+ nococonv%qss/2,iintsp.EQ.1)
65 : qssbtj=MERGE(- nococonv%qss/2,+ nococonv%qss/2,jintsp.EQ.1)
66 : !$OMP DO SCHEDULE(DYNAMIC,1)
67 : DO ki = fmpi%n_rank+1, lapw%nv(iintsp), fmpi%n_size
68 : kii=(ki-1)/fmpi%n_size+1
69 : !---> legendre polynomials
70 : DO kj = 1,ki
71 : plegend(kj,1) = DOT_PRODUCT(lapw%gk(:,kj,jintsp),lapw%gk(:,ki,iintsp))
72 : END DO
73 : DO l = 1,atoms%lmax(n) - 1
74 : plegend(:ki,l+1) = fleg1(l)*plegend(:ki,1)*plegend(:ki,l) - fleg2(l)*plegend(:ki,l-1)
75 : END DO
76 : !---> set up phase factors
77 : cph = 0.0
78 : ski = lapw%gvec(:,ki,iintsp) + qssbti
79 : DO nn = atoms%firstAtom(n), atoms%firstAtom(n) + atoms%neq(n) - 1
80 : tnn = tpi_const*atoms%taual(:,nn)
81 : DO kj = 1,ki
82 : cph(kj) = cph(kj) +&
83 : CMPLX(COS(DOT_PRODUCT(ski-lapw%gvec(:,kj,jintsp)+qssbtj,tnn)),&
84 : SIN(DOT_PRODUCT(lapw%gvec(:,kj,jintsp)+qssbtj-ski,tnn)))
85 : END DO
86 : END DO
87 :
88 : !---> update overlap and l-diagonal hamiltonian matrix
89 : s=atoms%lnonsph(n)+1
90 : DO l = 0,atoms%lnonsph(n)
91 : DO kj = 1,ki
92 : fct =cph(kj) * plegend(kj,l)*fl2p1(l)*(&
93 : fjgj%fj(ki,l,ispin,iintsp)*fjgj%fj(kj,l,jspin,jintsp) *td%h_off(l,l,n,ispin,jspin) + &
94 : fjgj%fj(ki,l,ispin,iintsp)*fjgj%gj(kj,l,jspin,jintsp) *td%h_off(l,l+s,n,ispin,jspin) + &
95 : fjgj%gj(ki,l,ispin,iintsp)*fjgj%fj(kj,l,jspin,jintsp) *td%h_off(l+s,l,n,ispin,jspin) + &
96 : fjgj%gj(ki,l,ispin,iintsp)*fjgj%gj(kj,l,jspin,jintsp) *td%h_off(l+s,l+s,n,ispin,jspin)* sqrt(usdus%ddn(l,n,ispin)*usdus%ddn(l,n,jspin)))
97 : hmat(1,1)%data_c(kj,kii)=hmat(1,1)%data_c(kj,kii) + CONJG(chi(1,1,iintsp,jintsp)*fct)
98 : hmat(1,2)%data_c(kj,kii)=hmat(1,2)%data_c(kj,kii) + CONJG(chi(1,2,iintsp,jintsp)*fct)
99 : hmat(2,1)%data_c(kj,kii)=hmat(2,1)%data_c(kj,kii) + CONJG(chi(2,1,iintsp,jintsp)*fct)
100 : hmat(2,2)%data_c(kj,kii)=hmat(2,2)%data_c(kj,kii) + CONJG(chi(2,2,iintsp,jintsp)*fct)
101 : ENDDO
102 : !---> end loop over l
103 : ENDDO
104 : !---> end loop over ki
105 : ENDDO
106 : !$OMP END DO
107 : !---> end loop over atom types (ntype)
108 : DEALLOCATE(plegend)
109 : DEALLOCATE(cph)
110 : !$OMP END PARALLEL
111 0 : CALL timestop("offdiagonal setup")
112 :
113 0 : RETURN
114 0 : END SUBROUTINE hsmt_offdiag
115 : END MODULE m_hsmt_offdiag
|
