Commit 2bf81a97 authored by Uliana  Alekseeva's avatar Uliana Alekseeva

hsmt_sph a bit optimized

parent 62febca6
...@@ -466,11 +466,11 @@ CONTAINS ...@@ -466,11 +466,11 @@ CONTAINS
REAL, INTENT (IN) :: fj(:,0:,:),gj(:,0:,:) REAL, INTENT (IN) :: fj(:,0:,:),gj(:,0:,:)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
REAL tnn(3), elall,fct,fjkiln,gjkiln,ddnln,ski(3) REAL tnn(3), elall,fct,fct2,fjkiln,gjkiln,ddnln,ski(3)
REAL apw_lo1,apw_lo2,apw1,w1 REAL apw_lo1,apw_lo2,apw1,w1
COMPLEX capw1 COMPLEX capw1
INTEGER kii,ki,kj,l,nn INTEGER kii,ki,kj,l,nn,kj_end
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
...@@ -478,6 +478,7 @@ CONTAINS ...@@ -478,6 +478,7 @@ CONTAINS
REAL fl2p1bt(0:atoms%lmaxd) REAL fl2p1bt(0:atoms%lmaxd)
REAL qssbti(3),qssbtj(3) REAL qssbti(3),qssbtj(3)
REAL, ALLOCATABLE :: plegend(:,:) REAL, ALLOCATABLE :: plegend(:,:)
REAL, ALLOCATABLE :: VecHelpS(:),VecHelpH(:)
COMPLEX, ALLOCATABLE :: cph(:) COMPLEX, ALLOCATABLE :: cph(:)
LOGICAL apw(0:atoms%lmaxd) LOGICAL apw(0:atoms%lmaxd)
...@@ -490,12 +491,13 @@ CONTAINS ...@@ -490,12 +491,13 @@ CONTAINS
fl2p1bt(l) = fl2p1(l)*0.5 fl2p1bt(l) = fl2p1(l)*0.5
END DO END DO
!$OMP PARALLEL DEFAULT(SHARED)& !$OMP PARALLEL DEFAULT(SHARED)&
!$OMP PRIVATE(kii,ki,ski,kj,plegend,l)& !$OMP PRIVATE(kii,ki,ski,kj,plegend,l,kj_end)&
!$OMP PRIVATE(cph,nn,tnn,fjkiln,gjkiln)& !$OMP PRIVATE(cph,nn,tnn,fjkiln,gjkiln)&
!$OMP PRIVATE(w1,apw_lo1,apw_lo2,ddnln,elall,fct,apw1)& !$OMP PRIVATE(w1,apw_lo1,apw_lo2,ddnln,elall,fct,apw1)&
!$OMP PRIVATE(capw1) !$OMP PRIVATE(capw1,VecHelpS,VecHelpH)
ALLOCATE(cph(MAXVAL(lapw%nv))) ALLOCATE(cph(MAXVAL(lapw%nv)))
ALLOCATE(plegend(MAXVAL(lapw%nv),0:atoms%lmaxd)) ALLOCATE(plegend(MAXVAL(lapw%nv),0:atoms%lmaxd))
ALLOCATE(VecHelpS(MAXVAL(lapw%nv)),VecHelpH(MAXVAL(lapw%nv)))
plegend=0.0 plegend=0.0
plegend(:,0)=1.0 plegend(:,0)=1.0
qssbti=MERGE(- noco%qss/2,+ noco%qss/2,jintsp.EQ.1) qssbti=MERGE(- noco%qss/2,+ noco%qss/2,jintsp.EQ.1)
...@@ -524,6 +526,9 @@ CONTAINS ...@@ -524,6 +526,9 @@ CONTAINS
END DO END DO
!---> update overlap and l-diagonal hamiltonian matrix !---> update overlap and l-diagonal hamiltonian matrix
kj_end = MIN(ki,lapw%nv(iintsp))
VecHelpS = 0.d0
VecHelpH = 0.d0
DO l = 0,atoms%lmax(n) DO l = 0,atoms%lmax(n)
fjkiln = fj(ki,l,jintsp) fjkiln = fj(ki,l,jintsp)
gjkiln = gj(ki,l,jintsp) gjkiln = gj(ki,l,jintsp)
...@@ -544,10 +549,10 @@ CONTAINS ...@@ -544,10 +549,10 @@ CONTAINS
DO kj = 1,ki DO kj = 1,ki
fct = plegend(kj,l)*fl2p1(l)*& fct = plegend(kj,l)*fl2p1(l)*&
( fjkiln*fj(kj,l,iintsp) + gjkiln*gj(kj,l,iintsp)*ddnln ) ( fjkiln*fj(kj,l,iintsp) + gjkiln*gj(kj,l,iintsp)*ddnln )
fct2 = plegend(kj,l)*fl2p1bt(l) * ( fjkiln*gj(kj,l,iintsp) + gjkiln*fj(kj,l,iintsp) )
smat%data_r(kj,kii)=smat%data_r(kj,kii)+REAL(cph(kj))*fct smat%data_r(kj,kii)=smat%data_r(kj,kii)+REAL(cph(kj))*fct
hmat%data_r(kj,kii)=hmat%data_r(kj,kii) + REAL(cph(kj)) * & hmat%data_r(kj,kii)=hmat%data_r(kj,kii) + REAL(cph(kj)) * ( fct * elall + fct2)
( fct * elall + plegend(kj,l) * fl2p1bt(l) *&
( fjkiln*gj(kj,l,iintsp) + gjkiln*fj(kj,l,iintsp) ) )
!+APW !+APW
IF (input%l_useapw) THEN IF (input%l_useapw) THEN
apw1 = REAL(cph(kj)) * plegend(kj,l) * & apw1 = REAL(cph(kj)) * plegend(kj,l) * &
...@@ -557,13 +562,13 @@ CONTAINS ...@@ -557,13 +562,13 @@ CONTAINS
!-APW !-APW
ENDDO ENDDO
ELSE ELSE
DO kj = 1,MIN(ki,lapw%nv(iintsp)) DO kj = 1,kj_end
fct = chi*plegend(kj,l)*fl2p1(l)*& fct = plegend(kj,l)*fl2p1(l)*&
( fjkiln*fj(kj,l,iintsp) + gjkiln*gj(kj,l,iintsp)*ddnln ) ( fjkiln*fj(kj,l,iintsp) + gjkiln*gj(kj,l,iintsp)*ddnln )
fct2 = plegend(kj,l)*fl2p1bt(l) * ( fjkiln*gj(kj,l,iintsp) + gjkiln*fj(kj,l,iintsp) )
smat%data_c(kj,kii)=smat%data_c(kj,kii) + cph(kj)*fct
hmat%data_c(kj,kii)=hmat%data_c(kj,kii) + cph(kj) * ( fct*elall & VecHelpS(kj) = VecHelpS(kj) + fct
+ chi*plegend(kj,l)*fl2p1bt(l) * ( fjkiln*gj(kj,l,iintsp) + gjkiln*fj(kj,l,iintsp) ) ) VecHelpH(kj) = VecHelpH(kj) + fct*elall + fct2
IF (input%l_useapw) THEN IF (input%l_useapw) THEN
capw1 = cph(kj)*plegend(kj,l)& capw1 = cph(kj)*plegend(kj,l)&
...@@ -575,6 +580,10 @@ CONTAINS ...@@ -575,6 +580,10 @@ CONTAINS
ENDIF ENDIF
!---> end loop over l !---> end loop over l
ENDDO ENDDO
IF (.not.smat%l_real) THEN
smat%data_c(:kj_end,kii)=smat%data_c(:kj_end,kii) + chi*cph(:kj_end) * VecHelpS(:kj_end)
hmat%data_c(:kj_end,kii)=hmat%data_c(:kj_end,kii) + chi*cph(:kj_end) * VecHelpH(:kj_end)
ENDIF
!---> end loop over ki !---> end loop over ki
ENDDO ENDDO
!$OMP END DO !$OMP END DO
......
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