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
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 ((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-
CALL corespec_init(input,atoms,coreSpecInput)
......@@ -229,11 +230,6 @@ CONTAINS
END DO
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
IF (kpts%nkpt < mpi%isize) THEN
l_evp = .true.
......@@ -332,7 +328,7 @@ CONTAINS
END IF
IF (noccbd.EQ.0) GO TO 199
!
!---> if slice, only a certain bands are taken into account
!---> in order to do this the coresponding eigenvalues, eigenvectors
!---> and weights have to be copied to the beginning of the arrays
......@@ -447,21 +443,14 @@ CONTAINS
DO ispin = jsp_start,jsp_end
IF (input%l_f) THEN
CALL timestart("cdnval: to_pulay")
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
END IF
CALL timestart("cdnval: abcof")
CALL abcof(input,atoms,sym, cell,lapw,noccbd,usdus, noco,ispin,oneD,&
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)
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
CALL timestop("cdnval: abcof")
END IF
IF (atoms%n_u.GT.0) THEN
CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,eigVecCoeffs,den%mmpMat(:,:,:,jspin))
END IF
......
MODULE m_abcof
CONTAINS
SUBROUTINE abcof(input,atoms,sym, cell,lapw,ne,usdus,&
noco,jspin,oneD, acof,bcof,ccof,zMat,&
eig,force)
noco,jspin,oneD, acof,bcof,ccof,zMat,eig,force)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! m.t. wavefunctions for each band and atom. c.l. fu
......@@ -44,6 +43,7 @@ CONTAINS
REAL s2h, s2h_e(ne)
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
LOGICAL l_force
! ..
! .. Local Arrays ..
INTEGER nbasf0(atoms%nlod,atoms%nat)
......@@ -55,20 +55,22 @@ CONTAINS
REAL, ALLOCATABLE :: work_r(:)
COMPLEX, ALLOCATABLE :: work_c(:)
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_noco) CALL judft_error("BUG in abcof, l_noco but real?")
ENDIF
! ..
ci = CMPLX(0.0,1.0)
const = 2 * tpi_const/SQRT(cell%omtil)
!
acof(:,:,:) = CMPLX(0.0,0.0)
bcof(:,:,:) = 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%bcoflo = CMPLX(0.0,0.0)
force%e1cof = CMPLX(0.0,0.0)
......@@ -77,7 +79,7 @@ CONTAINS
force%bveccof = CMPLX(0.0,0.0)
force%cveccof = CMPLX(0.0,0.0)
END IF
! ..
!+APW_LO
DO n = 1, atoms%ntype
DO l = 0,atoms%lmax(n)
......@@ -111,11 +113,8 @@ CONTAINS
!$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& 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& jspin,qss,&
!$OMP& apw,const,&
!$OMP& nbasf0,enough,&
!$OMP& acof,bcof,ccof,force)
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,l_force,&
!$OMP& jspin,qss,apw,const,nbasf0,enough,acof,bcof,ccof,force)
DO n = 1,atoms%ntype
CALL setabc1lo(atoms,n,usdus,jspin,alo1,blo1,clo1)
......@@ -173,7 +172,7 @@ CONTAINS
ENDIF ! (noco%l_ss)
fk = lapw%bkpt + fg
s = DOT_PRODUCT(fk,MATMUL(cell%bbmat,fk))
IF(PRESENT(eig)) THEN
IF(l_force) THEN
s2h = 0.5*s
s2h_e(:ne) = s2h-eig(:ne)
END IF
......@@ -238,7 +237,7 @@ CONTAINS
bcof(:ne,lm,natom) = bcof(:ne,lm,natom) + c_2 * work_c(:ne)
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
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)
......@@ -265,7 +264,7 @@ CONTAINS
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_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_2,work_c*s2h_e,1, force%e2cof(1,lmp,jatom),1)
DO i = 1,3
......@@ -326,7 +325,7 @@ CONTAINS
inv_f = (-1.0)**(m+l)
DO ie = 1,ne
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%bcoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(force%bcoflo(-m,ie,ilo,iatom))
DO i = 1,3
......@@ -346,7 +345,7 @@ CONTAINS
acof(ie,lm,jatom) = inv_f * cexp * CONJG(acof(ie,lmp,iatom))
bcof(ie,lm,jatom) = inv_f * cexp * CONJG(bcof(ie,lmp,iatom))
END DO
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN
IF (atoms%l_geo(n).AND.l_force) THEN
DO ie = 1,ne
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))
......
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