Commit 7ba2c7f0 authored by Gregor Michalicek's avatar Gregor Michalicek

Perform a single unified abcof call in cdn/cdnval.F90

parent 1931e8c5
...@@ -181,6 +181,7 @@ CONTAINS ...@@ -181,6 +181,7 @@ CONTAINS
CALL orbcomp%init(banddos,dimension,atoms) CALL orbcomp%init(banddos,dimension,atoms)
IF ((l_fmpl).AND.(.not.noco%l_mperp)) CALL juDFT_error("for fmpl set noco%l_mperp = T!" ,calledby ="cdnval") IF ((l_fmpl).AND.(.not.noco%l_mperp)) CALL juDFT_error("for fmpl set noco%l_mperp = T!" ,calledby ="cdnval")
IF ((banddos%ndir.EQ.-3).AND.banddos%dos.AND.oneD%odi%d1) CALL juDFT_error("layer-resolved feature does not work with 1D",calledby ="cdnval")
! calculation of core spectra (EELS) initializations -start- ! calculation of core spectra (EELS) initializations -start-
CALL corespec_init(input,atoms,coreSpecInput) CALL corespec_init(input,atoms,coreSpecInput)
...@@ -229,11 +230,6 @@ CONTAINS ...@@ -229,11 +230,6 @@ CONTAINS
END DO END DO
DEALLOCATE (f,g,flo) DEALLOCATE (f,g,flo)
IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
IF (oneD%odi%d1) CALL juDFT_error("layer-resolved feature does not work with 1D",calledby ="cdnval")
END IF
!--> loop over k-points: each can be a separate task !--> loop over k-points: each can be a separate task
IF (kpts%nkpt < mpi%isize) THEN IF (kpts%nkpt < mpi%isize) THEN
l_evp = .true. l_evp = .true.
...@@ -332,7 +328,7 @@ CONTAINS ...@@ -332,7 +328,7 @@ CONTAINS
END IF END IF
IF (noccbd.EQ.0) GO TO 199 IF (noccbd.EQ.0) GO TO 199
!
!---> if slice, only a certain bands are taken into account !---> if slice, only a certain bands are taken into account
!---> in order to do this the coresponding eigenvalues, eigenvectors !---> in order to do this the coresponding eigenvalues, eigenvectors
!---> and weights have to be copied to the beginning of the arrays !---> and weights have to be copied to the beginning of the arrays
...@@ -447,20 +443,13 @@ CONTAINS ...@@ -447,20 +443,13 @@ CONTAINS
DO ispin = jsp_start,jsp_end DO ispin = jsp_start,jsp_end
IF (input%l_f) THEN IF (input%l_f) THEN
CALL timestart("cdnval: to_pulay")
CALL force%init2(noccbd,input,atoms) CALL force%init2(noccbd,input,atoms)
CALL abcof(input,atoms,sym, cell,lapw,noccbd,usdus, noco,ispin,oneD,&
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
CALL timestop("cdnval: to_pulay")
ELSE
CALL timestart("cdnval: abcof")
CALL abcof(input,atoms,sym, cell,lapw,noccbd,usdus, noco,ispin,oneD,&
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat)
CALL timestop("cdnval: abcof")
END IF END IF
CALL timestart("cdnval: abcof")
CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,ispin,oneD,&
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
CALL timestop("cdnval: abcof")
IF (atoms%n_u.GT.0) THEN IF (atoms%n_u.GT.0) THEN
CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,eigVecCoeffs,den%mmpMat(:,:,:,jspin)) CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,eigVecCoeffs,den%mmpMat(:,:,:,jspin))
......
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,force)
eig,force)
! ************************************************************ ! ************************************************************
! 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
...@@ -36,7 +35,7 @@ CONTAINS ...@@ -36,7 +35,7 @@ CONTAINS
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) REAL, OPTIONAL, INTENT (IN) :: eig(:)!(dimension%neigd)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
COMPLEX cexp,phase,c_0,c_1,c_2,ci COMPLEX cexp,phase,c_0,c_1,c_2,ci
...@@ -44,6 +43,7 @@ CONTAINS ...@@ -44,6 +43,7 @@ CONTAINS
REAL s2h, s2h_e(ne) 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
LOGICAL l_force
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
INTEGER nbasf0(atoms%nlod,atoms%nat) INTEGER nbasf0(atoms%nlod,atoms%nat)
...@@ -55,20 +55,22 @@ CONTAINS ...@@ -55,20 +55,22 @@ CONTAINS
REAL, ALLOCATABLE :: work_r(:) REAL, ALLOCATABLE :: work_r(:)
COMPLEX, ALLOCATABLE :: work_c(:) COMPLEX, ALLOCATABLE :: work_c(:)
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
IF (noco%l_soc.AND.sym%invs) CALL judft_error("BUG in abcof, SOC&INVS but real?") IF (noco%l_soc.AND.sym%invs) CALL judft_error("BUG in abcof, SOC&INVS but real?")
IF (noco%l_noco) CALL judft_error("BUG in abcof, l_noco but real?") IF (noco%l_noco) CALL judft_error("BUG in abcof, l_noco but real?")
ENDIF ENDIF
! ..
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,0.0) ccof(:,:,:,:) = CMPLX(0.0,0.0)
IF(PRESENT(eig)) THEN l_force = .FALSE.
IF(PRESENT(eig).AND.input%l_f) THEN
l_force = .TRUE.
END IF
IF(l_force) THEN
force%acoflo = CMPLX(0.0,0.0) force%acoflo = CMPLX(0.0,0.0)
force%bcoflo = CMPLX(0.0,0.0) force%bcoflo = CMPLX(0.0,0.0)
force%e1cof = CMPLX(0.0,0.0) force%e1cof = CMPLX(0.0,0.0)
...@@ -77,7 +79,7 @@ CONTAINS ...@@ -77,7 +79,7 @@ CONTAINS
force%bveccof = CMPLX(0.0,0.0) force%bveccof = CMPLX(0.0,0.0)
force%cveccof = CMPLX(0.0,0.0) force%cveccof = CMPLX(0.0,0.0)
END IF END IF
! ..
!+APW_LO !+APW_LO
DO n = 1, atoms%ntype DO n = 1, atoms%ntype
DO l = 0,atoms%lmax(n) DO l = 0,atoms%lmax(n)
...@@ -111,11 +113,8 @@ CONTAINS ...@@ -111,11 +113,8 @@ CONTAINS
!$OMP& DEFAULT(none)& !$OMP& DEFAULT(none)&
!$OMP& PRIVATE(n,nn,natom,k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,& !$OMP& PRIVATE(n,nn,natom,k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,&
!$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& 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,eig,& !$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,l_force,&
!$OMP& jspin,qss,& !$OMP& jspin,qss,apw,const,nbasf0,enough,acof,bcof,ccof,force)
!$OMP& apw,const,&
!$OMP& nbasf0,enough,&
!$OMP& acof,bcof,ccof,force)
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)
...@@ -173,7 +172,7 @@ CONTAINS ...@@ -173,7 +172,7 @@ CONTAINS
ENDIF ! (noco%l_ss) ENDIF ! (noco%l_ss)
fk = lapw%bkpt + fg fk = lapw%bkpt + fg
s = DOT_PRODUCT(fk,MATMUL(cell%bbmat,fk)) s = DOT_PRODUCT(fk,MATMUL(cell%bbmat,fk))
IF(PRESENT(eig)) THEN IF(l_force) THEN
s2h = 0.5*s s2h = 0.5*s
s2h_e(:ne) = s2h-eig(:ne) s2h_e(:ne) = s2h-eig(:ne)
END IF END IF
...@@ -238,7 +237,7 @@ CONTAINS ...@@ -238,7 +237,7 @@ CONTAINS
bcof(:ne,lm,natom) = bcof(:ne,lm,natom) + c_2 * work_c(:ne) bcof(:ne,lm,natom) = bcof(:ne,lm,natom) + c_2 * work_c(:ne)
END IF END IF
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN IF (atoms%l_geo(n).AND.l_force) THEN
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
force%e1cof(:ne,lm,natom) = force%e1cof(:ne,lm,natom) + c_1 * work_r(:ne) * s2h_e(:ne) force%e1cof(:ne,lm,natom) = force%e1cof(:ne,lm,natom) + c_1 * work_r(:ne) * s2h_e(:ne)
force%e2cof(:ne,lm,natom) = force%e2cof(:ne,lm,natom) + c_2 * work_r(:ne) * s2h_e(:ne) force%e2cof(:ne,lm,natom) = force%e2cof(:ne,lm,natom) + c_2 * work_r(:ne) * s2h_e(:ne)
...@@ -265,7 +264,7 @@ CONTAINS ...@@ -265,7 +264,7 @@ 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 IF (atoms%l_geo(n).AND.l_force) THEN
CALL CPP_BLAS_caxpy(ne,c_1,work_c*s2h_e,1, force%e1cof(1,lmp,jatom),1) CALL CPP_BLAS_caxpy(ne,c_1,work_c*s2h_e,1, force%e1cof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_2,work_c*s2h_e,1, force%e2cof(1,lmp,jatom),1) CALL CPP_BLAS_caxpy(ne,c_2,work_c*s2h_e,1, force%e2cof(1,lmp,jatom),1)
DO i = 1,3 DO i = 1,3
...@@ -326,7 +325,7 @@ CONTAINS ...@@ -326,7 +325,7 @@ CONTAINS
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 IF(l_force) THEN
force%acoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(force%acoflo(-m,ie,ilo,iatom)) force%acoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(force%acoflo(-m,ie,ilo,iatom))
force%bcoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(force%bcoflo(-m,ie,ilo,iatom)) force%bcoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(force%bcoflo(-m,ie,ilo,iatom))
DO i = 1,3 DO i = 1,3
...@@ -346,7 +345,7 @@ CONTAINS ...@@ -346,7 +345,7 @@ CONTAINS
acof(ie,lm,jatom) = inv_f * cexp * CONJG(acof(ie,lmp,iatom)) acof(ie,lm,jatom) = inv_f * cexp * CONJG(acof(ie,lmp,iatom))
bcof(ie,lm,jatom) = inv_f * cexp * CONJG(bcof(ie,lmp,iatom)) bcof(ie,lm,jatom) = inv_f * cexp * CONJG(bcof(ie,lmp,iatom))
END DO END DO
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN IF (atoms%l_geo(n).AND.l_force) THEN
DO ie = 1,ne DO ie = 1,ne
force%e1cof(ie,lm,jatom) = inv_f * cexp * CONJG(force%e1cof(ie,lmp,iatom)) force%e1cof(ie,lm,jatom) = inv_f * cexp * CONJG(force%e1cof(ie,lmp,iatom))
force%e2cof(ie,lm,jatom) = inv_f * cexp * CONJG(force%e2cof(ie,lmp,iatom)) force%e2cof(ie,lm,jatom) = inv_f * cexp * CONJG(force%e2cof(ie,lmp,iatom))
......
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