Commit f9e91577 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce calcDenCoeffs subroutine to cdn/cdnval.F90

parent 0865b1d2
...@@ -47,10 +47,7 @@ CONTAINS ...@@ -47,10 +47,7 @@ CONTAINS
USE m_constants USE m_constants
USE m_eig66_io,ONLY: write_dos USE m_eig66_io,ONLY: write_dos
USE m_genMTBasis USE m_genMTBasis
USE m_rhomt USE m_calcDenCoeffs
USE m_rhonmt
USE m_rhomtlo
USE m_rhonmtlo
USE m_mcdinit USE m_mcdinit
USE m_sympsi USE m_sympsi
USE m_eparas ! energy parameters and partial charges USE m_eparas ! energy parameters and partial charges
...@@ -218,8 +215,7 @@ CONTAINS ...@@ -218,8 +215,7 @@ CONTAINS
IF (banddos%l_mcd) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,n,jspin) IF (banddos%l_mcd) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,n,jspin)
IF(l_cs) CALL corespec_rme(atoms,input,n,dimension%nstd,& IF(l_cs) CALL corespec_rme(atoms,input,n,dimension%nstd,input%jspins,jspin,results%ef,&
input%jspins,jspin,results%ef,&
dimension%msh,vTot%mt(:,0,:,:),f,g) dimension%msh,vTot%mt(:,0,:,:),f,g)
END DO END DO
DEALLOCATE (f,g,flo) DEALLOCATE (f,g,flo)
...@@ -238,9 +234,6 @@ CONTAINS ...@@ -238,9 +234,6 @@ CONTAINS
EXIT EXIT
END IF END IF
! uncomment this so that cdinf plots works for all states
! noccbd = neigd
! -> Gu test: distribute ev's among the processors... ! -> Gu test: distribute ev's among the processors...
CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi) CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi)
skip_t = skip_tt skip_t = skip_tt
...@@ -327,18 +320,15 @@ CONTAINS ...@@ -327,18 +320,15 @@ CONTAINS
CALL eigVecCoeffs%init(dimension,atoms,noco,jspin,noccbd) CALL eigVecCoeffs%init(dimension,atoms,noco,jspin,noccbd)
DO ispin = jsp_start,jsp_end DO ispin = jsp_start,jsp_end
IF (input%l_f) THEN IF (input%l_f) CALL force%init2(noccbd,input,atoms)
CALL force%init2(noccbd,input,atoms)
END IF
CALL timestart("cdnval: abcof") 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%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force) eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
CALL timestop("cdnval: abcof") CALL timestop("cdnval: abcof")
IF (atoms%n_u.GT.0) THEN IF (atoms%n_u.GT.0) 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))
END IF
!---> perform Brillouin zone integration and summation over the !---> perform Brillouin zone integration and summation over the
!---> bands in order to determine the energy parameters for each !---> bands in order to determine the energy parameters for each
...@@ -358,32 +348,14 @@ CONTAINS ...@@ -358,32 +348,14 @@ CONTAINS
CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab) CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
INQUIRE (file='orbcomprot',exist=l_orbcomprot) INQUIRE (file='orbcomprot',exist=l_orbcomprot)
IF (l_orbcomprot) THEN ! rotate ab-coeffs IF (l_orbcomprot) CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin)
END IF
CALL orb_comp(ispin,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp) CALL orb_comp(ispin,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
END IF END IF
!-new
!---> set up coefficients for the spherical and CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs)
CALL timestart("cdnval: rhomt")
CALL rhomt(atoms,we,noccbd,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rhomt")
IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb) IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
!---> non-spherical m.t. density
CALL timestart("cdnval: rhonmt")
CALL rhonmt(atoms,sphhar,we,noccbd,sym,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rhonmt")
!---> set up coefficients of the local orbitals and the
!---> flapw - lo cross terms for the spherical and
!---> non-spherical mt density
CALL timestart("cdnval: rho(n)mtlo")
CALL rhomtlo(atoms,noccbd,we,eigVecCoeffs,denCoeffs,ispin)
CALL rhonmtlo(atoms,sphhar,noccbd,we,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rho(n)mtlo")
IF (input%l_f) THEN IF (input%l_f) THEN
CALL timestart("cdnval: force_a12/21") CALL timestart("cdnval: force_a12/21")
......
...@@ -21,4 +21,6 @@ cdn_mt/rhonmt.f90 ...@@ -21,4 +21,6 @@ cdn_mt/rhonmt.f90
cdn_mt/rhonmt21.f90 cdn_mt/rhonmt21.f90
cdn_mt/rhonmtlo.f90 cdn_mt/rhonmtlo.f90
cdn_mt/rhosphnlo.f90 cdn_mt/rhosphnlo.f90
cdn_mt/calcDenCoeffs.f90
) )
MODULE m_calcDenCoeffs
CONTAINS
SUBROUTINE calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs)
USE m_juDFT
USE m_types
USE m_rhomt
USE m_rhonmt
USE m_rhomtlo
USE m_rhonmtlo
IMPLICIT NONE
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffs), INTENT(INOUT) :: denCoeffs
REAL, INTENT(IN) :: we(noccbd)
INTEGER, INTENT(IN) :: noccbd
INTEGER, INTENT(IN) :: ispin
!---> set up coefficients for the spherical and
CALL timestart("cdnval: rhomt")
CALL rhomt(atoms,we,noccbd,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rhomt")
!---> non-spherical m.t. density
CALL timestart("cdnval: rhonmt")
CALL rhonmt(atoms,sphhar,we,noccbd,sym,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rhonmt")
!---> set up coefficients of the local orbitals and the
!---> flapw - lo cross terms for the spherical and
!---> non-spherical mt density
CALL timestart("cdnval: rho(n)mtlo")
CALL rhomtlo(atoms,noccbd,we,eigVecCoeffs,denCoeffs,ispin)
CALL rhonmtlo(atoms,sphhar,noccbd,we,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rho(n)mtlo")
END SUBROUTINE calcDenCoeffs
END MODULE m_calcDenCoeffs
...@@ -75,48 +75,32 @@ c ...@@ -75,48 +75,32 @@ c
REAL, INTENT (OUT) :: eig(:) !bkpt(3),eig(neigd) REAL, INTENT (OUT) :: eig(:) !bkpt(3),eig(neigd)
TYPE(t_zmat), INTENT (INOUT) :: zmat !z(nbasfcn,noccbd) !can be real/complex TYPE(t_zmat), INTENT (INOUT) :: zmat !z(nbasfcn,noccbd) !can be real/complex
!
! Local variables ... ! Local variables ...
! INTEGER :: isp
INTEGER :: iv,j,isp,nmat
#ifdef CPP_MPI #ifdef CPP_MPI
INCLUDE 'mpif.h' INCLUDE 'mpif.h'
INTEGER mpiierr INTEGER mpiierr
#endif #endif
! isp = MERGE(1,jspin,l_noco.OR.l_ss)
! For Spin-Spirals
! ! For Non-Collinear, Spin-Spirals
CALL timestart("cdn_read") CALL timestart("cdn_read")
IF (l_ss) THEN IF (l_ss.OR.l_noco) THEN
CALL read_eig(eig_id,ikpt,1, neig=nbands) CALL read_eig(eig_id,ikpt,isp, neig=nbands)
CALL read_eig(eig_id,ikpt,1,n_start=n_start,n_end=n_end, CALL read_eig(eig_id,ikpt,isp,n_start=n_start,n_end=n_end,
< eig=eig,zmat=zmat) < eig=eig,zmat=zmat)
!
! For Non-Collinear, but no Spin-Spirals
!
ELSEIF (l_noco) THEN
CALL read_eig(
> eig_id,ikpt,1, neig=nbands)
CALL read_eig(
> eig_id,ikpt,1,n_start=n_start,n_end=n_end,
< eig=eig,zmat=zmat)
!
! For Collinear ! For Collinear
!
ELSE ELSE
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
zmat%z_r=0 zmat%z_r=0
ELSE ELSE
zmat%z_c=0 zmat%z_c=0
ENDIF ENDIF
CALL read_eig(eig_id,ikpt,isp,n_start=n_start,n_end=n_end,
CALL read_eig( < neig=nbands,eig=eig,zmat=zmat)
> eig_id,ikpt,jspin,n_start=n_start,n_end=n_end,
< neig=nbands,eig=eig,
< zmat=zmat)
ENDIF ENDIF
CALL timestop("cdn_read") CALL timestop("cdn_read")
......
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