Commit 28e66762 authored by Gregor Michalicek's avatar Gregor Michalicek

Replace to_pulay call with abcof call in cdn/cdnval.F90

For this cdn_mt/abcof.F90 and cdn_mt/abclocdn.F90 had to be adapted
to feature the needed functionality. toPulay is still available in
the code but never called.
parent 2dc221f9
...@@ -724,9 +724,12 @@ CONTAINS ...@@ -724,9 +724,12 @@ CONTAINS
aveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat),& aveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat),&
bveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat),& bveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat),&
cveccof(3,-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat) ) cveccof(3,-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat) )
CALL to_pulay(input,atoms,noccbd,sym, lapw, noco,cell,noccbd,eig,usdus,& CALL abcof(input,atoms,sym, cell,lapw,noccbd,usdus, noco,ispin,oneD,&
ispin,oneD, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),& acof(:,0:,:,ispin),bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin),zMat,&
e1cof,e2cof,aveccof,bveccof, ccof(-atoms%llod,1,1,1,ispin),acoflo,bcoflo,cveccof,zMat) eig,acoflo,bcoflo,e1cof,e2cof,aveccof,bveccof,cveccof)
! CALL to_pulay(input,atoms,noccbd,sym, lapw, noco,cell,noccbd,eig,usdus,&
! ispin,oneD, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
! e1cof,e2cof,aveccof,bveccof, ccof(-atoms%llod,1,1,1,ispin),acoflo,bcoflo,cveccof,zMat)
CALL timestop("cdnval: to_pulay") CALL timestop("cdnval: to_pulay")
ELSE ELSE
......
...@@ -21,17 +21,20 @@ MODULE m_abclocdn ...@@ -21,17 +21,20 @@ MODULE m_abclocdn
!********************************************************************* !*********************************************************************
CONTAINS CONTAINS
SUBROUTINE abclocdn(atoms,sym,noco,lapw,cell,ccchi,iintsp,phase,ylm,& SUBROUTINE abclocdn(atoms,sym,noco,lapw,cell,ccchi,iintsp,phase,ylm,&
ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat) ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,&
! fgp,acoflo,bcoflo,aveccof,bveccof,cveccof)
USE m_types USE m_types
USE m_constants USE m_constants
IMPLICIT NONE IMPLICIT NONE
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_lapw),INTENT(IN) :: lapw TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_zMat),INTENT(IN) :: zMat TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_zMat), INTENT(IN) :: zMat
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: iintsp INTEGER, INTENT (IN) :: iintsp
...@@ -45,10 +48,16 @@ CONTAINS ...@@ -45,10 +48,16 @@ CONTAINS
COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat) COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
REAL, OPTIONAL, INTENT (IN) :: fgp(3)
COMPLEX, OPTIONAL, INTENT (INOUT) :: acoflo(-atoms%llod:,:,:,:)
COMPLEX, OPTIONAL, INTENT (INOUT) :: bcoflo(-atoms%llod:,:,:,:)
COMPLEX, OPTIONAL, INTENT (INOUT) :: aveccof(:,:,0:,:)
COMPLEX, OPTIONAL, INTENT (INOUT) :: bveccof(:,:,0:,:)
COMPLEX, OPTIONAL, INTENT (INOUT) :: cveccof(:,-atoms%llod:,:,:,:)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
COMPLEX ctmp,term1 COMPLEX ctmp,term1
INTEGER i,l,ll1,lm,nbasf,m INTEGER i,j,l,ll1,lm,nbasf,m
! .. ! ..
! .. ! ..
term1 = 2 * tpi_const/SQRT(cell%omtil) * ((atoms%rmt(ntyp)**2)/2) * phase term1 = 2 * tpi_const/SQRT(cell%omtil) * ((atoms%rmt(ntyp)**2)/2) * phase
...@@ -76,12 +85,20 @@ CONTAINS ...@@ -76,12 +85,20 @@ CONTAINS
ctmp = zMat%z_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1)) ctmp = zMat%z_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ENDIF ENDIF
ENDIF ENDIF
acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo) acof(i,lm,na) = acof(i,lm,na) + ctmp*alo1(lo)
bcof(i,lm,na) = bcof(i,lm,na) +ctmp*blo1(lo) bcof(i,lm,na) = bcof(i,lm,na) + ctmp*blo1(lo)
ccof(m,i,lo,na) = ccof(m,i,lo,na) +ctmp*clo1(lo) ccof(m,i,lo,na) = ccof(m,i,lo,na) + ctmp*clo1(lo)
IF (PRESENT(aveccof)) THEN
acoflo(m,i,lo,na) = acoflo(m,i,lo,na) + ctmp*alo1(lo)
bcoflo(m,i,lo,na) = bcoflo(m,i,lo,na) + ctmp*blo1(lo)
DO j = 1,3
aveccof(j,i,lm,na) = aveccof(j,i,lm,na) + fgp(j)*ctmp*alo1(lo)
bveccof(j,i,lm,na) = bveccof(j,i,lm,na) + fgp(j)*ctmp*blo1(lo)
cveccof(j,m,i,lo,na) = cveccof(j,m,i,lo,na) + fgp(j)*ctmp*clo1(lo)
END DO
END IF
END DO END DO
END DO END DO
END SUBROUTINE abclocdn END SUBROUTINE abclocdn
END MODULE m_abclocdn END MODULE m_abclocdn
MODULE m_abcof MODULE m_abcof
CONTAINS CONTAINS
SUBROUTINE abcof(input,atoms,sym, cell,lapw,ne,usdus,& SUBROUTINE abcof(input,atoms,sym, cell,lapw,ne,usdus,&
noco,jspin,oneD, acof,bcof,ccof,zMat) noco,jspin,oneD, acof,bcof,ccof,zMat,&
eig,acoflo,bcoflo,e1cof,e2cof,aveccof,bveccof,cveccof)
! ************************************************************ ! ************************************************************
! subroutine constructs the a,b coefficients of the linearized ! subroutine constructs the a,b coefficients of the linearized
! m.t. wavefunctions for each band and atom. c.l. fu ! m.t. wavefunctions for each band and atom. c.l. fu
...@@ -31,19 +32,28 @@ CONTAINS ...@@ -31,19 +32,28 @@ CONTAINS
INTEGER, INTENT (IN) :: jspin INTEGER, INTENT (IN) :: jspin
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
COMPLEX, INTENT (OUT):: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) COMPLEX, INTENT (OUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (OUT):: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) COMPLEX, INTENT (OUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (OUT):: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat) COMPLEX, INTENT (OUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
REAL, OPTIONAL, INTENT (IN) :: eig(:)!(dimension%neigd)
COMPLEX, OPTIONAL, INTENT (OUT) :: acoflo(-atoms%llod:,:,:,:)
COMPLEX, OPTIONAL, INTENT (OUT) :: bcoflo(-atoms%llod:,:,:,:)
COMPLEX, OPTIONAL, INTENT (OUT) :: e1cof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, OPTIONAL, INTENT (OUT) :: e2cof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, OPTIONAL, INTENT (OUT) :: aveccof(:,:,0:,:)!(3,nobd,0:dimension%lmd,atoms%nat)
COMPLEX, OPTIONAL, INTENT (OUT) :: bveccof(:,:,0:,:)!(3,nobd,0:dimension%lmd,atoms%nat)
COMPLEX, OPTIONAL, INTENT (OUT) :: cveccof(:,-atoms%llod:,:,:,:)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
COMPLEX cexp,phase,c_0,c_1,c_2,ci COMPLEX cexp,phase,c_0,c_1,c_2,ci
REAL const,df,r1,s,tmk,wronk,qss(3) REAL const,df,r1,s,tmk,wronk,qss(3)
REAL s2h, s2h_e(ne)
INTEGER i,j,k,l,ll1,lm ,n,nap,natom,nn,iatom,jatom,lmp,m,nkvec INTEGER i,j,k,l,ll1,lm ,n,nap,natom,nn,iatom,jatom,lmp,m,nkvec
INTEGER inv_f,ie,ilo,kspin,iintsp,nintsp,nvmax,lo,inap INTEGER inv_f,ie,ilo,kspin,iintsp,nintsp,nvmax,lo,inap
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
INTEGER nbasf0(atoms%nlod,atoms%nat) INTEGER nbasf0(atoms%nlod,atoms%nat)
REAL dfj(0:atoms%lmaxd),fj(0:atoms%lmaxd),fk(3),fkp(3),fkr(3) REAL dfj(0:atoms%lmaxd),fj(0:atoms%lmaxd),fg(3),fgp(3),fgr(3),fk(3),fkp(3),fkr(3)
REAL alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod) REAL alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod)
COMPLEX ylm( (atoms%lmaxd+1)**2 ) COMPLEX ylm( (atoms%lmaxd+1)**2 )
COMPLEX ccchi(2,2) COMPLEX ccchi(2,2)
...@@ -61,9 +71,18 @@ CONTAINS ...@@ -61,9 +71,18 @@ CONTAINS
ci = CMPLX(0.0,1.0) ci = CMPLX(0.0,1.0)
const = 2 * tpi_const/SQRT(cell%omtil) const = 2 * tpi_const/SQRT(cell%omtil)
! !
acof(:,:,:) = CMPLX(0.0,0.0) acof(:,:,:) = CMPLX(0.0,0.0)
bcof(:,:,:) = CMPLX(0.0,0.0) bcof(:,:,:) = CMPLX(0.0,0.0)
ccof(:,:,:,:)=CMPLX(0.,0.) ccof(:,:,:,:) = CMPLX(0.0,0.0)
IF(PRESENT(eig)) THEN
acoflo(:,:,:,:) = CMPLX(0.0,0.0)
bcoflo(:,:,:,:) = CMPLX(0.0,0.0)
e1cof(:,:,:) = CMPLX(0.0,0.0)
e2cof(:,:,:) = CMPLX(0.0,0.0)
aveccof(:,:,:,:) = CMPLX(0.0,0.0)
bveccof(:,:,:,:) = CMPLX(0.0,0.0)
cveccof(:,:,:,:,:) = CMPLX(0.0,0.0)
END IF
! .. ! ..
!+APW_LO !+APW_LO
DO n = 1, atoms%ntype DO n = 1, atoms%ntype
...@@ -96,13 +115,13 @@ CONTAINS ...@@ -96,13 +115,13 @@ CONTAINS
!---> loop over atom types !---> loop over atom types
!$OMP PARALLEL DO & !$OMP PARALLEL DO &
!$OMP& DEFAULT(none)& !$OMP& DEFAULT(none)&
!$OMP& PRIVATE(n,nn,natom,k,i,work_r,work_c,ccchi,kspin,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,& !$OMP& PRIVATE(n,nn,natom,k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,&
!$OMP& alo1,blo1,clo1,inap,nap,j,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,jatom,lmp,inv_f,lm)& !$OMP& alo1,blo1,clo1,inap,nap,j,fgr,fgp,s2h,s2h_e,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,jatom,lmp,inv_f,lm)&
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,& !$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,&
!$OMP& jspin,qss,& !$OMP& jspin,qss,&
!$OMP& apw,const,& !$OMP& apw,const,&
!$OMP& nbasf0,enough,& !$OMP& nbasf0,enough,&
!$OMP& acof,bcof,ccof) !$OMP& acof,bcof,ccof,e1cof,e2cof,acoflo,bcoflo,aveccof,bveccof,cveccof)
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
CALL setabc1lo(atoms,n,usdus,jspin,alo1,blo1,clo1) CALL setabc1lo(atoms,n,usdus,jspin,alo1,blo1,clo1)
...@@ -154,11 +173,16 @@ CONTAINS ...@@ -154,11 +173,16 @@ CONTAINS
ENDIF ENDIF
ENDIF ! (noco%l_noco) ENDIF ! (noco%l_noco)
IF (noco%l_ss) THEN IF (noco%l_ss) THEN
fk = lapw%bkpt + lapw%gvec(:,k,iintsp) + qss fg = lapw%gvec(:,k,iintsp) + qss
ELSE ELSE
fk = lapw%bkpt + lapw%gvec(:,k,jspin) + qss fg = lapw%gvec(:,k,jspin) + qss
ENDIF ! (noco%l_ss) ENDIF ! (noco%l_ss)
s= DOT_PRODUCT(fk,MATMUL(cell%bbmat,fk)) fk = lapw%bkpt + fg
s = DOT_PRODUCT(fk,MATMUL(cell%bbmat,fk))
IF(PRESENT(eig)) THEN
s2h = 0.5*s
s2h_e(:ne) = s2h-eig(:ne)
END IF
s = SQRT(s) s = SQRT(s)
r1 = atoms%rmt(n)*s r1 = atoms%rmt(n)*s
CALL sphbes(atoms%lmax(n),r1,fj) CALL sphbes(atoms%lmax(n),r1,fj)
...@@ -176,8 +200,8 @@ CONTAINS ...@@ -176,8 +200,8 @@ CONTAINS
ENDIF ENDIF
ENDDO ! loop over l ENDDO ! loop over l
tmk = tpi_const* (fk(1)*atoms%taual(1,natom)+& tmk = tpi_const* (fk(1)*atoms%taual(1,natom)+&
& fk(2)*atoms%taual(2,natom)+& fk(2)*atoms%taual(2,natom)+&
& fk(3)*atoms%taual(3,natom)) fk(3)*atoms%taual(3,natom))
phase = CMPLX(COS(tmk),SIN(tmk)) phase = CMPLX(COS(tmk),SIN(tmk))
IF (oneD%odi%d1) THEN IF (oneD%odi%d1) THEN
inap = oneD%ods%ngopr(natom) inap = oneD%ods%ngopr(natom)
...@@ -186,16 +210,20 @@ CONTAINS ...@@ -186,16 +210,20 @@ CONTAINS
inap = sym%invtab(nap) inap = sym%invtab(nap)
END IF END IF
DO j = 1,3 DO j = 1,3
fkr(j) = 0. fkr(j) = 0.0
fgr(j) = 0.0
DO i = 1,3 DO i = 1,3
IF (oneD%odi%d1) THEN IF (oneD%odi%d1) THEN
fkr(j) = fkr(j) + fk(i)*oneD%ods%mrot(i,j,inap) fkr(j) = fkr(j) + fk(i)*oneD%ods%mrot(i,j,inap)
fgr(j) = fgr(j) + fg(i)*oneD%ods%mrot(i,j,inap)
ELSE ELSE
fkr(j) = fkr(j) + fk(i)*sym%mrot(i,j,inap) fkr(j) = fkr(j) + fk(i)*sym%mrot(i,j,inap)
fgr(j) = fgr(j) + fg(i)*sym%mrot(i,j,inap)
END IF END IF
ENDDO END DO
ENDDO END DO
fkp=MATMUL(fkr,cell%bmat) fkp = MATMUL(fkr,cell%bmat)
fgp = MATMUL(fgr,cell%bmat)
! ----> generate spherical harmonics ! ----> generate spherical harmonics
CALL ylm4(atoms%lmax(n),fkp,ylm) CALL ylm4(atoms%lmax(n),fkp,ylm)
! ----> loop over l ! ----> loop over l
...@@ -225,6 +253,14 @@ CONTAINS ...@@ -225,6 +253,14 @@ CONTAINS
c_2 = CONJG(c_2) * inv_f c_2 = CONJG(c_2) * inv_f
CALL CPP_BLAS_caxpy(ne,c_1,work_c,1, acof(1,lmp,jatom),1) CALL CPP_BLAS_caxpy(ne,c_1,work_c,1, acof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_2,work_c,1, bcof(1,lmp,jatom),1) CALL CPP_BLAS_caxpy(ne,c_2,work_c,1, bcof(1,lmp,jatom),1)
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN
CALL CPP_BLAS_caxpy(ne,c_1,work_c*s2h_e,1, e1cof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_2,work_c*s2h_e,1, e2cof(1,lmp,jatom),1)
DO i = 1,3
CALL CPP_BLAS_caxpy(ne,c_1,work_c*fgp(i),1, aveccof(i,1,lmp,jatom),3)
CALL CPP_BLAS_caxpy(ne,c_2,work_c*fgp(i),1, bveccof(i,1,lmp,jatom),3)
END DO
END IF
ENDIF ENDIF
ENDIF ENDIF
ENDDO ! loop over m ENDDO ! loop over m
...@@ -233,7 +269,8 @@ CONTAINS ...@@ -233,7 +269,8 @@ CONTAINS
DO nkvec=1,lapw%nkvec(lo,natom) DO nkvec=1,lapw%nkvec(lo,natom)
IF (k==lapw%kvec(nkvec,lo,natom)) THEN !check if this k-vector has LO attached IF (k==lapw%kvec(nkvec,lo,natom)) THEN !check if this k-vector has LO attached
CALL abclocdn(atoms,sym,noco,lapw,cell,ccchi(:,jspin),iintsp,phase,ylm,& CALL abclocdn(atoms,sym,noco,lapw,cell,ccchi(:,jspin),iintsp,phase,ylm,&
n,natom,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat) n,natom,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,&
fgp,acoflo,bcoflo,aveccof,bveccof,cveccof)
ENDIF ENDIF
ENDDO ENDDO
END DO END DO
...@@ -277,7 +314,14 @@ CONTAINS ...@@ -277,7 +314,14 @@ CONTAINS
DO m = -l,l DO m = -l,l
inv_f = (-1.0)**(m+l) inv_f = (-1.0)**(m+l)
DO ie = 1,ne DO ie = 1,ne
ccof(m,ie,ilo,jatom) = inv_f * cexp *CONJG( ccof(-m,ie,ilo,iatom)) ccof(m,ie,ilo,jatom) = inv_f * cexp * CONJG( ccof(-m,ie,ilo,iatom))
IF(PRESENT(eig)) THEN
acoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(acoflo(-m,ie,ilo,iatom))
bcoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(bcoflo(-m,ie,ilo,iatom))
DO i = 1,3
cveccof(i,m,ie,ilo,jatom) = -inv_f * cexp * CONJG(cveccof(i,-m,ie,ilo,iatom))
END DO
END IF
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
...@@ -289,10 +333,18 @@ CONTAINS ...@@ -289,10 +333,18 @@ CONTAINS
inv_f = (-1.0)**(m+l) inv_f = (-1.0)**(m+l)
DO ie = 1,ne DO ie = 1,ne
acof(ie,lm,jatom) = inv_f * cexp * CONJG(acof(ie,lmp,iatom)) acof(ie,lm,jatom) = inv_f * cexp * CONJG(acof(ie,lmp,iatom))
ENDDO
DO ie = 1,ne
bcof(ie,lm,jatom) = inv_f * cexp * CONJG(bcof(ie,lmp,iatom)) bcof(ie,lm,jatom) = inv_f * cexp * CONJG(bcof(ie,lmp,iatom))
ENDDO END DO
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN
DO ie = 1,ne
e1cof(ie,lm,jatom) = inv_f * cexp * CONJG(e1cof(ie,lmp,iatom))
e2cof(ie,lm,jatom) = inv_f * cexp * CONJG(e2cof(ie,lmp,iatom))
DO i = 1,3
aveccof(i,ie,lm,jatom) = -inv_f * cexp * CONJG(aveccof(i,ie,lmp,iatom))
bveccof(i,ie,lm,jatom) = -inv_f * cexp * CONJG(bveccof(i,ie,lmp,iatom))
END DO
END DO
END IF
ENDDO ENDDO
ENDDO ENDDO
ENDIF ENDIF
......
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