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_rhonmt21
8 : ! *************************************************************
9 : ! subroutine sets up the coefficients of the spin (up,down)
10 : ! part of the non-spherical muffin-tin density.
11 : ! pk`00 ff`01 gb`02
12 : ! Added parallelization and reworked for the efficient use with FFN.
13 : ! R. Hilgers July '20
14 : ! *************************************************************
15 : USE m_gaunt,ONLY:gaunt1
16 : USE m_types_setup
17 : USE m_types_cdnval
18 : USE m_constants
19 :
20 : IMPLICIT NONE
21 :
22 : CONTAINS
23 :
24 0 : SUBROUTINE rhonmt21(atoms,sphhar,we,ne,sym,eigVecCoeffs,uunmt21,udnmt21,dunmt21,ddnmt21)
25 :
26 :
27 : TYPE(t_sym), INTENT(IN) :: sym
28 : TYPE(t_sphhar), INTENT(IN) :: sphhar
29 : TYPE(t_atoms), INTENT(IN) :: atoms
30 : TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
31 :
32 : ! .. Scalar Arguments ..
33 : INTEGER, INTENT(IN) :: ne
34 :
35 : ! .. Array Arguments ..
36 : REAL, INTENT(IN) :: we(:)!(nobd)
37 : COMPLEX, INTENT(INOUT) :: uunmt21(:,:,:)!((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
38 : COMPLEX, INTENT(INOUT) :: udnmt21(:,:,:)!((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
39 : COMPLEX, INTENT(INOUT) :: dunmt21(:,:,:)!((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
40 : COMPLEX, INTENT(INOUT) :: ddnmt21(:,:,:)!((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
41 :
42 : ! .. Local Scalars ..
43 : COMPLEX coef, cil, coef1
44 0 : COMPLEX :: temp(ne)
45 :
46 : COMPLEX CPP_BLAS_cdotc
47 : EXTERNAL CPP_BLAS_cdotc
48 :
49 : INTEGER jmem,l,lh,llp,llpmax,lm,lmp,lp,lv,m, mp,mv,na,natom,nb,nn,ns,nt,lphi,lplow
50 :
51 0 : DO ns=1,sym%nsymt
52 : !$OMP parallel do default(none) &
53 : !$OMP private(lh,lp,l,lv,mp,m,mv,lm,lmp,llp,llpmax,lphi,lplow) &
54 : !$OMP private(cil,jmem,coef1,coef,temp,na,nt,nn,natom) &
55 : !$OMP shared(sym,we,ne,ns,uunmt21,udnmt21,dunmt21,ddnmt21,atoms,sphhar,eigVecCoeffs) &
56 0 : !$OMP collapse(2)
57 : DO lh = 1,sphhar%nlh(ns)
58 : DO l = 0,atoms%lmaxd
59 : lv = sphhar%llh(lh,ns)
60 : DO jmem = 1,sphhar%nmem(lh,ns)
61 : mv = sphhar%mlh(jmem,lh,ns)
62 : m_loop: DO m = -l,l
63 : lm= l*(l+1) + m
64 : mp = m - mv
65 :
66 : !maximum value of lp
67 : lphi = l + lv
68 : !---> check that lphi is smaller than the max l of the
69 : !---> wavefunction expansion
70 : lphi = MIN(lphi,atoms%lmaxd)
71 : !---> make sure that l + l'' + lphi is even
72 : lphi = lphi - MOD(l+lv+lphi,2)
73 :
74 : lplow = abs(l-lv)
75 : lplow = MAX(lplow,ABS(mp))
76 : !---> make sure that l + l'' + lplow is even
77 : lplow = lplow + MOD(ABS(lphi-lplow),2)
78 :
79 : IF (lplow.GT.lphi) CYCLE m_loop
80 :
81 : DO lp = lplow, lphi,2
82 : cil = ImagUnit**(lp-l)
83 : coef1 = cil * sphhar%clnu(jmem,lh,ns)
84 : lmp = lp*(lp+1) + mp
85 :
86 : coef= CONJG(coef1 * gaunt1(l,lv,lp,m,mv,mp,atoms%lmaxd))
87 : IF (ABS(coef) .LT. 1e-12 ) CYCLE
88 : DO nn=1,atoms%ntype
89 : natom = atoms%firstAtom(nn) - 1
90 : llp= lp*(atoms%lmax(nn)+1)+l+1
91 : llpmax = (atoms%lmax(nn)+1)**2
92 : IF(llp.GT.llpmax) CYCLE
93 : nt= natom
94 : DO na= 1,atoms%neq(nn)
95 : nt= nt+1
96 : IF (sym%ntypsy(nt)==ns) THEN
97 : temp(:) = coef * we(:) * eigVecCoeffs%abcof(:,lm,0,nt,1)
98 : !uunmt21(llp,lh,nn) = uunmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%acof(:,lmp,nt,2),1,temp,1)
99 : !dunmt21(llp,lh,nn) = dunmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%bcof(:,lmp,nt,2),1,temp,1)
100 :
101 : uunmt21(llp,lh,nn) = uunmt21(llp,lh,nn) + dot_product(eigVecCoeffs%abcof(:ne,lmp,0,nt,2),temp(:ne))
102 : dunmt21(llp,lh,nn) = dunmt21(llp,lh,nn) + dot_product(eigVecCoeffs%abcof(:ne,lmp,1,nt,2),temp(:ne))
103 :
104 : temp(:) = coef * we(:) * eigVecCoeffs%abcof(:,lm,1,nt,1)
105 : !udnmt21(llp,lh,nn) = udnmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%acof(:,lmp,nt,2),1,temp,1)
106 : !ddnmt21(llp,lh,nn) = ddnmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%bcof(:,lmp,nt,2),1,temp,1)
107 :
108 : udnmt21(llp,lh,nn) = udnmt21(llp,lh,nn) + dot_product(eigVecCoeffs%abcof(:ne,lmp,0,nt,2),temp(:ne))
109 : ddnmt21(llp,lh,nn) = ddnmt21(llp,lh,nn) + dot_product(eigVecCoeffs%abcof(:ne,lmp,1,nt,2),temp(:ne))
110 : ENDIF ! (sym%ntypsy(nt)==ns)
111 : ENDDO ! na
112 : ENDDO ! nn
113 : ENDDO
114 : ENDDO m_loop ! m
115 : ENDDO ! jmem
116 : ENDDO ! l
117 : ENDDO ! lh
118 : !$OMP end parallel do
119 : ENDDO ! ns
120 :
121 0 : END SUBROUTINE rhonmt21
122 : END MODULE m_rhonmt21
|
