Commit 3de2d55f authored by Henning Janssen's avatar Henning Janssen

rhonmt21: Move atom loops further inside

-Reduces number of gaunt calls
-Have to introduce llpmax to avoid wrong llp indices
parent 2140c484
......@@ -48,54 +48,56 @@ MODULE m_rhonmt21
COMPLEX CPP_BLAS_cdotc
EXTERNAL CPP_BLAS_cdotc
INTEGER jmem,l,lh,llp,lm,lmp,lp,lv,m, mp,mv,na,natom,nb,nn,ns,nt!,lplow0,lphi,lplow,lcond
INTEGER jmem,l,lh,llp,llpmax,lm,lmp,lp,lv,m, mp,mv,na,natom,nb,nn,ns,nt!,lplow0,lphi,lplow,lcond
DO ns=1,sym%nsymt
natom= 0
DO nn=1,atoms%ntype
nt= natom
DO na= 1,atoms%neq(nn)
nt= nt+1
IF (sym%ntypsy(nt)==ns) THEN
!$OMP parallel do default(none) &
!$OMP private(lh,lp,l,lv,cil,llp,jmem,coef1,mp,lmp,m,lm,coef,mv,temp) &
!$OMP shared(we,ne,na,nt,nn,ns,uunmt21,udnmt21,dunmt21,ddnmt21,atoms,sphhar,eigVecCoeffs) &
!$OMP collapse(3)
DO lh = 1,sphhar%nlh(ns)
DO lp = 0,atoms%lmax(nn)
DO l = 0,atoms%lmax(nn)
lv = sphhar%llh(lh,ns)
IF ( MOD(lv+l+lp,2) .EQ. 0 ) THEN
cil = mi**(l-lp)
llp= lp*(atoms%lmax(nn)+1)+l+1
DO jmem = 1,sphhar%nmem(lh,ns)
mv = sphhar%mlh(jmem,lh,ns)
coef1 = cil * sphhar%clnu(jmem,lh,ns)
mp_loop: DO mp = -lp,lp
lmp = lp*(lp+1) + mp
m_loop: DO m = -l,l
coef= CONJG(coef1 * gaunt1(l,lv,lp,m,mv,mp,atoms%lmaxd))
IF (ABS(coef) .GT. 1e-12 ) THEN
lm= l*(l+1) + m
!$OMP parallel do default(none) &
!$OMP private(lh,lp,l,lv,cil,llp,jmem,coef1,mp,lmp,m,lm,coef,mv,temp,na,nt,nn,natom,llpmax) &
!$OMP shared(sym,we,ne,ns,uunmt21,udnmt21,dunmt21,ddnmt21,atoms,sphhar,eigVecCoeffs) &
!$OMP collapse(3)
DO lh = 1,sphhar%nlh(ns)
DO lp = 0,atoms%lmaxd
DO l = 0,atoms%lmaxd
lv = sphhar%llh(lh,ns)
IF ( MOD(lv+l+lp,2) .EQ. 0 ) THEN
cil = mi**(l-lp)
DO jmem = 1,sphhar%nmem(lh,ns)
mv = sphhar%mlh(jmem,lh,ns)
coef1 = cil * sphhar%clnu(jmem,lh,ns)
mp_loop: DO mp = -lp,lp
lmp = lp*(lp+1) + mp
m_loop: DO m = -l,l
coef= CONJG(coef1 * gaunt1(l,lv,lp,m,mv,mp,atoms%lmaxd))
IF (ABS(coef) .GT. 1e-12 ) THEN
lm= l*(l+1) + m
natom= 0
DO nn=1,atoms%ntype
llp= lp*(atoms%lmax(nn)+1)+l+1
llpmax = (atoms%lmax(nn)+1)**2
IF(llp.GT.llpmax) CYCLE
nt= natom
DO na= 1,atoms%neq(nn)
nt= nt+1
IF (sym%ntypsy(nt)==ns) THEN
temp(:) = coef * we(:) * eigVecCoeffs%acof(:,lm,nt,1)
uunmt21(llp,lh,nn) = uunmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%acof(:,lmp,nt,2),1,temp,1)
dunmt21(llp,lh,nn) = dunmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%bcof(:,lmp,nt,2),1,temp,1)
temp(:) = coef * we(:) * eigVecCoeffs%bcof(:,lm,nt,1)
udnmt21(llp,lh,nn) = udnmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%acof(:,lmp,nt,2),1,temp,1)
ddnmt21(llp,lh,nn) = ddnmt21(llp,lh,nn) + CPP_BLAS_cdotc(ne,eigVecCoeffs%bcof(:,lmp,nt,2),1,temp,1)
ENDIF ! (coef >= 0)
ENDDO m_loop ! m
ENDDO mp_loop
ENDDO ! jmem
ENDIF ! ( MOD(lv+l+lp),2) == 0 )
ENDDO ! lp
ENDDO ! l
ENDDO ! lh
!$OMP end parallel do
ENDIF ! (sym%ntypsy(nt)==ns)
ENDDO ! na
natom= natom + atoms%neq(nn)
ENDDO ! nn
ENDIF ! (sym%ntypsy(nt)==ns)
ENDDO ! na
natom= natom + atoms%neq(nn)
ENDDO ! nn
ENDIF ! (coef >= 0)
ENDDO m_loop ! m
ENDDO mp_loop
ENDDO ! jmem
ENDIF ! ( MOD(lv+l+lp),2) == 0 )
ENDDO ! lp
ENDDO ! l
ENDDO ! lh
!$OMP end parallel do
ENDDO ! ns
END SUBROUTINE rhonmt21
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment