...
 
Commits (60)
cmd: "make"
cwd: "$HOME/eclipse/fleur/build.debug"
...@@ -18,7 +18,7 @@ include("cmake/filespecific.cmake") ...@@ -18,7 +18,7 @@ include("cmake/filespecific.cmake")
include("cmake/ReportConfig.txt") include("cmake/ReportConfig.txt")
add_subdirectory("inpgen2")
#install(TARGETS fleur inpgen DESTINATION bin) #install(TARGETS fleur inpgen DESTINATION bin)
......
...@@ -12,7 +12,7 @@ ...@@ -12,7 +12,7 @@
CONTAINS CONTAINS
SUBROUTINE cdnovlp(mpi,& SUBROUTINE cdnovlp(mpi,&
& sphhar,stars,atoms,sym,& & sphhar,stars,atoms,sym,&
& DIMENSION,vacuum,cell,& & vacuum,cell,&
& input,oneD,l_st,& & input,oneD,l_st,&
& jspin,rh,& & jspin,rh,&
& qpw,rhtxy,rho,rht) & qpw,rhtxy,rho,rht)
...@@ -96,7 +96,7 @@ ...@@ -96,7 +96,7 @@
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_dimension),INTENT(IN)::DIMENSION
TYPE(t_vacuum),INTENT(in):: vacuum TYPE(t_vacuum),INTENT(in):: vacuum
TYPE(t_input),INTENT(in)::input TYPE(t_input),INTENT(in)::input
...@@ -113,7 +113,7 @@ ...@@ -113,7 +113,7 @@
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins) COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins) REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,input%jspins) REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,input%jspins)
REAL, INTENT (INOUT) :: rh(DIMENSION%msh,atoms%ntype) REAL, INTENT (INOUT) :: rh(atoms%msh,atoms%ntype)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
COMPLEX czero,carg,VALUE,slope,c_ph COMPLEX czero,carg,VALUE,slope,c_ph
...@@ -127,7 +127,7 @@ ...@@ -127,7 +127,7 @@
! .. Local Arrays .. ! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: qpwc(:) COMPLEX, ALLOCATABLE :: qpwc(:)
REAL acoff(atoms%ntype),alpha(atoms%ntype),rho_out(2) REAL acoff(atoms%ntype),alpha(atoms%ntype),rho_out(2)
REAL rat(DIMENSION%msh,atoms%ntype) REAL rat(atoms%msh,atoms%ntype)
INTEGER mshc(atoms%ntype) INTEGER mshc(atoms%ntype)
REAL fJ(-oneD%odi%M:oneD%odi%M),dfJ(-oneD%odi%M:oneD%odi%M) REAL fJ(-oneD%odi%M:oneD%odi%M),dfJ(-oneD%odi%M:oneD%odi%M)
! .. ! ..
...@@ -174,21 +174,21 @@ ...@@ -174,21 +174,21 @@
! (2) cut_off core tails from noise ! (2) cut_off core tails from noise
! !
#ifdef CPP_MPI #ifdef CPP_MPI
CALL MPI_BCAST(rh,DIMENSION%msh*atoms%ntype,CPP_MPI_REAL,0,mpi%mpi_comm,ierr) CALL MPI_BCAST(rh,atoms%msh*atoms%ntype,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
#endif #endif
nloop: DO n = 1 , atoms%ntype nloop: DO n = 1 , atoms%ntype
IF ((atoms%ncst(n).GT.0).OR.l_st) THEN IF ((atoms%econf(n)%num_core_states.GT.0).OR.l_st) THEN
DO j = 1 , atoms%jri(n) DO j = 1 , atoms%jri(n)
rat(j,n) = atoms%rmsh(j,n) rat(j,n) = atoms%rmsh(j,n)
ENDDO ENDDO
dxx = EXP(atoms%dx(n)) dxx = EXP(atoms%dx(n))
DO j = atoms%jri(n) + 1 , DIMENSION%msh DO j = atoms%jri(n) + 1 , atoms%msh
rat(j,n) = rat(j-1,n)*dxx rat(j,n) = rat(j-1,n)*dxx
ENDDO ENDDO
DO j = atoms%jri(n) - 1 , DIMENSION%msh DO j = atoms%jri(n) - 1 , atoms%msh
rh(j,n) = rh(j,n)/ (fpi_const*rat(j,n)*rat(j,n)) rh(j,n) = rh(j,n)/ (fpi_const*rat(j,n)*rat(j,n))
ENDDO ENDDO
DO j = DIMENSION%msh , atoms%jri(n) , -1 DO j = atoms%msh , atoms%jri(n) , -1
IF ( rh(j,n) .GT. tol_14 ) THEN IF ( rh(j,n) .GT. tol_14 ) THEN
mshc(n) = j mshc(n) = j
CYCLE nloop CYCLE nloop
...@@ -205,7 +205,7 @@ ...@@ -205,7 +205,7 @@
! IF mshc = jri either core tail too small or no core (i.e. H) ! IF mshc = jri either core tail too small or no core (i.e. H)
! !
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
IF ((mshc(n).GT.atoms%jri(n)).AND.((atoms%ncst(n).GT.0).OR.l_st)) THEN IF ((mshc(n).GT.atoms%jri(n)).AND.((atoms%econf(n)%num_core_states.GT.0).OR.l_st)) THEN
j1 = atoms%jri(n) - 1 j1 = atoms%jri(n) - 1
IF ( method1 .EQ. 1) THEN IF ( method1 .EQ. 1) THEN
...@@ -241,7 +241,7 @@ ...@@ -241,7 +241,7 @@
! !
!=====> calculate the fourier transform of the core-pseudocharge !=====> calculate the fourier transform of the core-pseudocharge
CALL ft_of_CorePseudocharge(mpi,DIMENSION,atoms,mshc,alpha,tol_14,rh, & CALL ft_of_CorePseudocharge(mpi,atoms,mshc,alpha,tol_14,rh, &
acoff,stars,method2,rat,cell,oneD,sym,qpwc) acoff,stars,method2,rat,cell,oneD,sym,qpwc)
DO k = 1 , stars%ng3 DO k = 1 , stars%ng3
...@@ -440,7 +440,7 @@ ...@@ -440,7 +440,7 @@
! they are contained in the plane wave part ! they are contained in the plane wave part
! !
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
IF ((mshc(n).GT.atoms%jri(n)).AND.((atoms%ncst(n).GT.0).OR.l_st)) THEN IF ((mshc(n).GT.atoms%jri(n)).AND.((atoms%econf(n)%num_core_states.GT.0).OR.l_st)) THEN
DO j = 1,atoms%jri(n) DO j = 1,atoms%jri(n)
rho(j,0,n,jspin) = rho(j,0,n,jspin)& rho(j,0,n,jspin) = rho(j,0,n,jspin)&
& - sfp_const*rat(j,n)*rat(j,n)*rh(j,n) & - sfp_const*rat(j,n)*rat(j,n)*rh(j,n)
...@@ -476,7 +476,7 @@ ...@@ -476,7 +476,7 @@
! INTERNAL SUBROUTINES ! INTERNAL SUBROUTINES
!*********************************************************************** !***********************************************************************
subroutine ft_of_CorePseudocharge(mpi,DIMENSION,atoms,mshc,alpha,& subroutine ft_of_CorePseudocharge(mpi,atoms,mshc,alpha,&
tol_14,rh,acoff,stars,method2,rat,cell,oneD,sym,qpwc) tol_14,rh,acoff,stars,method2,rat,cell,oneD,sym,qpwc)
!=====> calculate the fourier transform of the core-pseudocharge !=====> calculate the fourier transform of the core-pseudocharge
...@@ -489,15 +489,15 @@ ...@@ -489,15 +489,15 @@
USE m_types USE m_types
type(t_mpi) ,intent(in) :: mpi type(t_mpi) ,intent(in) :: mpi
type(t_dimension),intent(in) :: DIMENSION
type(t_atoms) ,intent(in) :: atoms type(t_atoms) ,intent(in) :: atoms
integer ,intent(in) :: mshc(atoms%ntype) integer ,intent(in) :: mshc(atoms%ntype)
real ,intent(in) :: alpha(atoms%ntype), tol_14 real ,intent(in) :: alpha(atoms%ntype), tol_14
real ,intent(in) :: rh(DIMENSION%msh,atoms%ntype) real ,intent(in) :: rh(atoms%msh,atoms%ntype)
real ,intent(in) :: acoff(atoms%ntype) real ,intent(in) :: acoff(atoms%ntype)
type(t_stars) ,intent(in) :: stars type(t_stars) ,intent(in) :: stars
integer ,intent(in) :: method2 integer ,intent(in) :: method2
real ,intent(in) :: rat(DIMENSION%msh,atoms%ntype) real ,intent(in) :: rat(atoms%msh,atoms%ntype)
type(t_cell) ,intent(in) :: cell type(t_cell) ,intent(in) :: cell
type(t_oneD) ,intent(in) :: oneD type(t_oneD) ,intent(in) :: oneD
type(t_sym) ,intent(in) :: sym type(t_sym) ,intent(in) :: sym
...@@ -539,7 +539,7 @@ ...@@ -539,7 +539,7 @@
! (1) Form factor for each atom type ! (1) Form factor for each atom type
CALL FormFactor_forAtomType(DIMENSION,method2,n_out_p,& CALL FormFactor_forAtomType(atoms%msh,method2,n_out_p,&
atoms%rmt(n),atoms%jri(n),atoms%dx(n),mshc(n),rat(:,n), & atoms%rmt(n),atoms%jri(n),atoms%dx(n),mshc(n),rat(:,n), &
rh(:,n),alpha(n),stars,cell,acoff(n),qf) rh(:,n),alpha(n),stars,cell,acoff(n),qf)
...@@ -668,7 +668,7 @@ ...@@ -668,7 +668,7 @@
end subroutine StructureConst_forAtom end subroutine StructureConst_forAtom
!---------------------------------------------------------------------- !----------------------------------------------------------------------
subroutine FormFactor_forAtomType(DIMENSION,method2,n_out_p,& subroutine FormFactor_forAtomType(msh,method2,n_out_p,&
rmt,jri,dx,mshc,rat,& rmt,jri,dx,mshc,rat,&
rh,alpha,stars,cell,acoff,qf) rh,alpha,stars,cell,acoff,qf)
...@@ -677,14 +677,14 @@ ...@@ -677,14 +677,14 @@
USE m_rcerf USE m_rcerf
USE m_intgr, ONLY : intgr3,intgz0 USE m_intgr, ONLY : intgr3,intgz0
type(t_dimension),intent(in) :: DIMENSION
integer ,intent(in) :: method2, n_out_p integer ,intent(in) :: msh,method2, n_out_p
real ,intent(in) :: rmt real ,intent(in) :: rmt
integer ,intent(in) :: jri integer ,intent(in) :: jri
real ,intent(in) :: dx real ,intent(in) :: dx
integer ,intent(in) :: mshc integer ,intent(in) :: mshc
real ,intent(in) :: rat(DIMENSION%msh) real ,intent(in) :: rat(msh)
real ,intent(in) :: rh(DIMENSION%msh) real ,intent(in) :: rh(msh)
real ,intent(in) :: alpha real ,intent(in) :: alpha
type(t_stars) ,intent(in) :: stars type(t_stars) ,intent(in) :: stars
type(t_cell) ,intent(in) :: cell type(t_cell) ,intent(in) :: cell
...@@ -698,7 +698,7 @@ ...@@ -698,7 +698,7 @@
logical tail logical tail
! ..Local arrays ! ..Local arrays
real rhohelp(DIMENSION%msh) real rhohelp(msh)
zero = 0.0 zero = 0.0
DO k = 1,stars%ng3 DO k = 1,stars%ng3
......
...@@ -27,7 +27,7 @@ CONTAINS ...@@ -27,7 +27,7 @@ CONTAINS
INTEGER :: jsp, j, ivac, nz, n INTEGER :: jsp, j, ivac, nz, n
REAL :: q2(vacuum%nmz), w, rht1(vacuum%nmzd,2,input%jspins) REAL :: q2(vacuum%nmz), w, rht1(vacuum%nmzd,2,input%jspins)
COMPLEX :: x(stars%ng3) COMPLEX :: x(stars%ng3)
qtot = 0.0 qtot = 0.0
qistot = 0.0 qistot = 0.0
DO jsp = 1,input%jspins DO jsp = 1,input%jspins
...@@ -103,7 +103,7 @@ CONTAINS ...@@ -103,7 +103,7 @@ CONTAINS
call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN) call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot%needs_grad(), sym) call init_mt_grid(input%jspins, atoms, sphhar, xcpot%needs_grad(), sym)
do n_atm =1,atoms%ntype do n_atm =1,atoms%ntype
call mt_from_grid(atoms, sphhar, n_atm, input%jspins, mt(:,:,n_atm), & call mt_from_grid(atoms, sym, sphhar, n_atm, input%jspins, mt(:,:,n_atm), &
tmp_potden%mt(:,0:,n_atm,:)) tmp_potden%mt(:,0:,n_atm,:))
do i=1,atoms%jri(n_atm) do i=1,atoms%jri(n_atm)
...@@ -156,11 +156,11 @@ CONTAINS ...@@ -156,11 +156,11 @@ CONTAINS
REAL qmt(atoms%ntype,input%jspins),qvac(2,input%jspins) REAL qmt(atoms%ntype,input%jspins),qvac(2,input%jspins)
INTEGER, ALLOCATABLE :: lengths(:,:) INTEGER, ALLOCATABLE :: lengths(:,:)
CHARACTER(LEN=20) :: attributes(6), names(6) CHARACTER(LEN=20) :: attributes(6), names(6)
CALL timestart("cdntot") CALL timestart("cdntot")
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, den, & call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, den, &
q, qis, qmt, qvac, qtot, qistot) q, qis, qmt, qvac, qtot, qistot)
IF (input%film) THEN IF (input%film) THEN
ALLOCATE(lengths(4+vacuum%nvac,2)) ALLOCATE(lengths(4+vacuum%nvac,2))
ELSE ELSE
...@@ -209,7 +209,7 @@ CONTAINS ...@@ -209,7 +209,7 @@ CONTAINS
REAL, INTENT(in) :: q(:), qis(:), qmt(:,:), qvac(:,:), qtot, qistot REAL, INTENT(in) :: q(:), qis(:), qmt(:,:), qvac(:,:), qtot, qistot
character(len=*), intent(in), optional :: hint character(len=*), intent(in), optional :: hint
integer :: n_mt integer :: n_mt
if(present(hint)) write (*,*) "DEN of ", hint if(present(hint)) write (*,*) "DEN of ", hint
write (*,*) "q = ", q write (*,*) "q = ", q
......
...@@ -11,7 +11,7 @@ USE m_juDFT ...@@ -11,7 +11,7 @@ USE m_juDFT
CONTAINS CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,& SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,vTot,oneD,cdnvalJob,den,regCharges,dos,results,& vacuum,sphhar,sym,vTot,oneD,cdnvalJob,den,regCharges,dos,results,&
moments,coreSpecInput,mcd,slab,orbcomp) moments,coreSpecInput,mcd,slab,orbcomp)
!************************************************************************************ !************************************************************************************
...@@ -56,7 +56,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -56,7 +56,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
TYPE(t_results), INTENT(INOUT) :: results TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_mpi), INTENT(IN) :: mpi TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_oneD), INTENT(IN) :: oneD TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_enpara), INTENT(IN) :: enpara TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_banddos), INTENT(IN) :: banddos TYPE(t_banddos), INTENT(IN) :: banddos
...@@ -163,9 +163,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -163,9 +163,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
CALL genMTBasis(atoms,enpara,vTot,mpi,iType,ispin,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin)) CALL genMTBasis(atoms,enpara,vTot,mpi,iType,ispin,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin))
END DO END DO
IF (noco%l_mperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType) IF (noco%l_mperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType)
IF (banddos%l_mcd) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin) IF (banddos%l_mcd) CALL mcd_init(atoms,input,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin)
IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,dimension%nstd,input%jspins,jspin,results%ef,& IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,29,input%jspins,jspin,results%ef,&
dimension%msh,vTot%mt(:,0,:,:),f,g) atoms%msh,vTot%mt(:,0,:,:),f,g)
END DO END DO
DEALLOCATE (f,g,flo) DEALLOCATE (f,g,flo)
...@@ -199,7 +199,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -199,7 +199,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (noccbd.LE.0) CYCLE ! Note: This jump has to be after the MPI_BARRIER is called IF (noccbd.LE.0) CYCLE ! Note: This jump has to be after the MPI_BARRIER is called
CALL gVacMap%init(dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin) CALL gVacMap%init(sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)
! valence density in the interstitial and vacuum region has to be called only once (if jspin=1) in the non-collinear case ! valence density in the interstitial and vacuum region has to be called only once (if jspin=1) in the non-collinear case
IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN
...@@ -210,14 +210,14 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -210,14 +210,14 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (l_dosNdir.AND.PRESENT(slab)) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,ev_list,lapw,slab,oneD,zMat) IF (l_dosNdir.AND.PRESENT(slab)) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,ev_list,lapw,slab,oneD,zMat)
! valence density in the vacuum region ! valence density in the vacuum region
IF (input%film) THEN IF (input%film) THEN
CALL vacden(vacuum,dimension,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,& CALL vacden(vacuum,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,&
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,ev_list,lapw,enpara%evac,eig,den,zMat,dos) gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,ev_list,lapw,enpara%evac,eig,den,zMat,dos)
END IF END IF
END IF END IF
IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we) IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
! valence density in the atomic spheres ! valence density in the atomic spheres
CALL eigVecCoeffs%init(input,DIMENSION,atoms,noco,jspin,noccbd) CALL eigVecCoeffs%init(input,atoms,noco,jspin,noccbd)
DO ispin = jsp_start, jsp_end DO ispin = jsp_start, jsp_end
IF (input%l_f) CALL force%init2(noccbd,input,atoms) IF (input%l_f) CALL force%init2(noccbd,input,atoms)
CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,ispin,oneD,& CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,ispin,oneD,&
...@@ -230,11 +230,11 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -230,11 +230,11 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
CALL eparas(ispin,atoms,noccbd,ev_list,mpi,ikpt,noccbd,we,eig,& CALL eparas(ispin,atoms,noccbd,ev_list,mpi,ikpt,noccbd,we,eig,&
skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd) skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos) IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film ! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
IF (l_dosNdir) THEN IF (l_dosNdir) THEN
IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,noccbd,ev_list,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab) IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,sym,noccbd,ev_list,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
IF (banddos%l_orb.AND.ANY((/banddos%alpha,banddos%beta,banddos%gamma/).NE.0.0)) THEN IF (banddos%l_orb.AND.ANY((/banddos%alpha,banddos%beta,banddos%gamma/).NE.0.0)) THEN
CALL abcrot2(atoms,banddos,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs CALL abcrot2(atoms,banddos,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
...@@ -244,16 +244,16 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -244,16 +244,16 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs) CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs)
IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb) IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
IF (input%l_f) CALL force%addContribsA21A12(input,atoms,dimension,sym,cell,oneD,enpara,& IF (input%l_f) CALL force%addContribsA21A12(input,atoms,sym,cell,oneD,enpara,&
usdus,eigVecCoeffs,noccbd,ispin,eig,we,results) usdus,eigVecCoeffs,noccbd,ispin,eig,we,results)
IF(l_coreSpec) CALL corespec_dos(atoms,usdus,ispin,dimension%lmd,kpts%nkpt,ikpt,dimension%neigd,& IF(l_coreSpec) CALL corespec_dos(atoms,usdus,ispin,atoms%lmaxd*(atoms%lmaxd+2),kpts%nkpt,ikpt,input%neig,&
noccbd,results%ef,banddos%sig_dos,eig,we,eigVecCoeffs) noccbd,results%ef,banddos%sig_dos,eig,we,eigVecCoeffs)
END DO ! end loop over ispin END DO ! end loop over ispin
IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd) IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd)
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf).AND.(banddos%ndir.GT.0)) THEN IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf).AND.(banddos%ndir.GT.0)) THEN
! since z is no longer an argument of cdninf sympsi has to be called here! ! since z is no longer an argument of cdninf sympsi has to be called here!
CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat) CALL sympsi(lapw,jspin,sym,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat)
END IF END IF
END DO ! end of k-point loop END DO ! end of k-point loop
...@@ -264,7 +264,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -264,7 +264,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
END DO END DO
#endif #endif
CALL cdnmt(mpi,input%jspins,atoms,sphhar,noco,jsp_start,jsp_end,& CALL cdnmt(mpi,input%jspins,atoms,sym,sphhar,noco,jsp_start,jsp_end,&
enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt) enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt)
IF (mpi%irank==0) THEN IF (mpi%irank==0) THEN
IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins) IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
...@@ -272,9 +272,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -272,9 +272,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (input%cdinf) THEN IF (input%cdinf) THEN
WRITE (6,FMT=8210) ispin WRITE (6,FMT=8210) ispin
8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2) 8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2)
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,cell,den,ispin) CALL checkDOPAll(input,sphhar,stars,atoms,sym,vacuum,oneD,cell,den,ispin)
END IF END IF
IF (input%l_f) CALL force_a8(input,atoms,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,results) IF (input%l_f) CALL force_a8(input,atoms,sym,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,results)
END DO END DO
CALL closeXMLElement('mtCharges') CALL closeXMLElement('mtCharges')
END IF END IF
......
...@@ -42,7 +42,7 @@ CONTAINS ...@@ -42,7 +42,7 @@ CONTAINS
INTEGER, INTENT (IN) :: ev_list(noccbd) INTEGER, INTENT (IN) :: ev_list(noccbd)
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT (IN) :: eig(:)!(dimension%neigd), REAL, INTENT (IN) :: eig(:)!(input%neig),
REAL, INTENT (IN) :: we(noccbd) REAL, INTENT (IN) :: we(noccbd)
! .. ! ..
......
...@@ -13,7 +13,7 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new) ...@@ -13,7 +13,7 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
USE m_juDFT USE m_juDFT
USE m_types USE m_types
USE m_constants USE m_constants
USE m_rwnoco !USE m_rwnoco
IMPLICIT NONE IMPLICIT NONE
...@@ -47,9 +47,10 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new) ...@@ -47,9 +47,10 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
iatom= iatom + atoms%neq(iType) iatom= iatom + atoms%neq(iType)
END DO END DO
CALL judft_error("BUG:noco-write feature not implemented at present")
OPEN (24,file='nocoinp',form='formatted', status='unknown') OPEN (24,file='nocoinp',form='formatted', status='unknown')
REWIND (24) REWIND (24)
CALL rw_noco_write(atoms,noco_new, input) !CALL rw_noco_write(atoms,noco_new, input)
CLOSE (24) CLOSE (24)
END SUBROUTINE genNewNocoInp END SUBROUTINE genNewNocoInp
......
...@@ -29,7 +29,7 @@ CONTAINS ...@@ -29,7 +29,7 @@ CONTAINS
INTEGER, INTENT (IN) :: ne,jspin INTEGER, INTENT (IN) :: ne,jspin
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT (IN) :: we(:)!(dimension%neigd) REAL, INTENT (IN) :: we(:)!(input%neig)
COMPLEX, INTENT (INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u) COMPLEX, INTENT (INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
......
...@@ -7,23 +7,23 @@ ...@@ -7,23 +7,23 @@
MODULE m_od_abvac MODULE m_od_abvac
CONTAINS CONTAINS
SUBROUTINE od_abvac(& SUBROUTINE od_abvac(&
& cell,vacuum,DIMENSION,stars,& & cell,vacuum,stars,&
& oneD,qssbti,& & oneD,qssbti,&
& n2d_1,& & n2d_1,&
& wronk,evac,bkpt,MM,vM,& & wronk,evac,bkpt,MM,vM,&
& vz,kvac3,nv2,& & vz,kvac3,nv2,&
& uz,duz,u,udz,dudz,ddnv,ud) & uz,duz,u,udz,dudz,ddnv,ud)
!************************************************************** !**************************************************************
! determines the nesessary values and derivatives on the ! determines the nesessary values and derivatives on the
! vacuum cylindrical boundary for finding a and b coefficients ! vacuum cylindrical boundary for finding a and b coefficients
! for the construcing vacuum charge density in vacden.F ! for the construcing vacuum charge density in vacden.F
! Y.Mokrousov, 7th of october 2002 ! Y.Mokrousov, 7th of october 2002
!*************************************************************** !***************************************************************
USE m_vacuz USE m_vacuz
USE m_vacudz USE m_vacudz
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
...@@ -36,26 +36,26 @@ CONTAINS ...@@ -36,26 +36,26 @@ CONTAINS
REAL, INTENT (in) :: evac REAL, INTENT (in) :: evac
! ..array arguments.. ! ..array arguments..
INTEGER, INTENT (in) :: kvac3(DIMENSION%nv2d) INTEGER, INTENT (in) :: kvac3(:)
REAL, INTENT (in) :: bkpt(3),qssbti REAL, INTENT (in) :: bkpt(3),qssbti
REAL, INTENT (in) :: vz(vacuum%nmzd) REAL, INTENT (in) :: vz(vacuum%nmzd)
REAL, INTENT (out):: udz(DIMENSION%nv2d,-vM:vM) REAL, INTENT (out):: udz(:,-vM:)
REAL, INTENT (out):: uz(DIMENSION%nv2d,-vM:vM) REAL, INTENT (out):: uz(:,-vM:)
REAL, INTENT (out):: dudz(DIMENSION%nv2d,-vM:vM) REAL, INTENT (out):: dudz(:,-vM:)
REAL, INTENT (out):: duz(DIMENSION%nv2d,-vM:vM) REAL, INTENT (out):: duz(:,-vM:)
REAL, INTENT (out):: u(vacuum%nmzd,DIMENSION%nv2d,-vM:vM) REAL, INTENT (out):: u(:,:,-vM:)
REAL, INTENT (out):: ud(vacuum%nmzd,DIMENSION%nv2d,-vM:vM) REAL, INTENT (out):: ud(:,:,-vM:)
REAL, INTENT (out):: ddnv(DIMENSION%nv2d,-vM:vM) REAL, INTENT (out):: ddnv(:,-vM:)
! ..local scalars.. ! ..local scalars..
REAL ev,scale,xv,yv,vzero,v1 REAL ev,scale,xv,yv,vzero,v1
INTEGER i,ik,jk,jspin,jsp1,jsp2 ,l,m INTEGER i,ik,jk,jspin,jsp1,jsp2 ,l,m
INTEGER i1,i2,i3,ind1,ind3 INTEGER i1,i2,i3,ind1,ind3
! .. local arrays.. ! .. local arrays..
REAL wdz(DIMENSION%nv2d,-vM:vM),wz(DIMENSION%nv2d,-vM:vM) REAL wdz(lapw_dim_nv2d,-vM:vM),wz(lapw_dim_nv2d,-vM:vM)
REAL dwdz(DIMENSION%nv2d,-vM:vM),dwz(DIMENSION%nv2d,-vM:vM) REAL dwdz(lapw_dim_nv2d,-vM:vM),dwz(lapw_dim_nv2d,-vM:vM)
REAL v(3),x(vacuum%nmzd) REAL v(3),x(vacuum%nmzd)
REAL vr0(vacuum%nmzd) REAL vr0(vacuum%nmzd)
REAL w(vacuum%nmzd,DIMENSION%nv2d,-vM:vM),wd(vacuum%nmzd,DIMENSION%nv2d,-vM:vM) REAL w(vacuum%nmzd,lapw_dim_nv2d,-vM:vM),wd(vacuum%nmzd,lapw_dim_nv2d,-vM:vM)
! wronksian for the schrodinger equation given by an identity ! wronksian for the schrodinger equation given by an identity
......
...@@ -97,7 +97,7 @@ CONTAINS ...@@ -97,7 +97,7 @@ CONTAINS
TYPE(t_dos), INTENT(INOUT) :: dos TYPE(t_dos), INTENT(INOUT) :: dos
REAL,INTENT(IN) :: we(:) !(nobd) REAL,INTENT(IN) :: we(:) !(nobd)
REAL,INTENT(IN) :: eig(:)!(dimension%neigd) REAL,INTENT(IN) :: eig(:)!(input%neig)
INTEGER, INTENT(IN) :: ev_list(ne) INTEGER, INTENT(IN) :: ev_list(ne)
!-----> BASIS FUNCTION INFORMATION !-----> BASIS FUNCTION INFORMATION
INTEGER,INTENT(IN):: ne INTEGER,INTENT(IN):: ne
......
MODULE m_qmtsl MODULE m_qmtsl
CONTAINS CONTAINS
!*********************************************************************** !***********************************************************************
! Calculates the mt-spheres contribution to the layer charge for states ! Calculates the mt-spheres contribution to the layer charge for states
! {En} at the current k-point. ! {En} at the current k-point.
! Yury Koroteev 2003 ! Yury Koroteev 2003
! from eparas.F by Philipp Kurz 99/04 ! from eparas.F by Philipp Kurz 99/04
! !
!*********************************************************************** !***********************************************************************
! !
SUBROUTINE q_mt_sl(jsp,atoms,nobd,ev_list,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab) SUBROUTINE q_mt_sl(jsp,atoms,sym,nobd,ev_list,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
USE m_types_setup USE m_types_setup
USE m_types_usdus USE m_types_usdus
USE m_types_cdnval, ONLY: t_eigVecCoeffs, t_slab USE m_types_cdnval, ONLY: t_eigVecCoeffs, t_slab
IMPLICIT NONE IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
TYPE(t_slab), INTENT(INOUT) :: slab TYPE(t_slab), INTENT(INOUT) :: slab
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd,jsp INTEGER, INTENT (IN) :: nobd,jsp
INTEGER, INTENT (IN) :: ne,ikpt ,skip_t,noccbd INTEGER, INTENT (IN) :: ne,ikpt ,skip_t,noccbd
INTEGER, INTENT (IN) :: ev_list(nobd) INTEGER, INTENT (IN) :: ev_list(nobd)
...@@ -70,7 +71,7 @@ CONTAINS ...@@ -70,7 +71,7 @@ CONTAINS
nt1 = nt1 + atoms%neq(n) nt1 = nt1 + atoms%neq(n)
enddo enddo
enddo enddo
! !
!---> initialize qlo !---> initialize qlo
! !
qlo=0.0 qlo=0.0
...@@ -104,7 +105,7 @@ CONTAINS ...@@ -104,7 +105,7 @@ CONTAINS
ENDDO ENDDO
natom = 1 natom = 1
DO ntyp = 1,atoms%ntype DO ntyp = 1,atoms%ntype
IF (atoms%invsat(natom).EQ.1) THEN IF (sym%invsat(natom).EQ.1) THEN
DO lo = 1,atoms%nlo(ntyp) DO lo = 1,atoms%nlo(ntyp)
DO i = 1,ne DO i = 1,ne
qlo(i,lo,ntyp) = 2*qlo(i,lo,ntyp) qlo(i,lo,ntyp) = 2*qlo(i,lo,ntyp)
...@@ -126,7 +127,7 @@ CONTAINS ...@@ -126,7 +127,7 @@ CONTAINS
DO lo = 1,atoms%nlo(ntyp) DO lo = 1,atoms%nlo(ntyp)
qq = qq + qlo(i,lo,ntyp)*usdus%uloulopn(lo,lo,ntyp,jsp) +& qq = qq + qlo(i,lo,ntyp)*usdus%uloulopn(lo,lo,ntyp,jsp) +&
qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp) +& qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp) +&
qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp) qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp)
ENDDO ENDDO
qmtlo(ntyp,i) = qq*fac qmtlo(ntyp,i) = qq*fac
qmttot(ntyp,i) = qmt(ntyp,i) + qmtlo(ntyp,i) qmttot(ntyp,i) = qmt(ntyp,i) + qmtlo(ntyp,i)
......
...@@ -5,7 +5,7 @@ MODULE m_qal21 ...@@ -5,7 +5,7 @@ MODULE m_qal21
!*********************************************************************** !***********************************************************************
! !
CONTAINS CONTAINS
SUBROUTINE qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos) SUBROUTINE qal_21(atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
USE m_types_setup USE m_types_setup
USE m_types_dos USE m_types_dos
...@@ -14,7 +14,7 @@ CONTAINS ...@@ -14,7 +14,7 @@ CONTAINS
USE m_rotdenmat USE m_rotdenmat
use m_constants use m_constants
IMPLICIT NONE IMPLICIT NONE
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input TYPE(t_input), INTENT(IN) :: input
TYPE(t_noco), INTENT(IN) :: noco TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
...@@ -37,9 +37,9 @@ CONTAINS ...@@ -37,9 +37,9 @@ CONTAINS
COMPLEX qlo(noccbd,atoms%nlod,atoms%nlod,atoms%ntype) COMPLEX qlo(noccbd,atoms%nlod,atoms%nlod,atoms%ntype)
COMPLEX qaclo(noccbd,atoms%nlod,atoms%ntype),qbclo(noccbd,atoms%nlod,atoms%ntype) COMPLEX qaclo(noccbd,atoms%nlod,atoms%ntype),qbclo(noccbd,atoms%nlod,atoms%ntype)
COMPLEX qcloa(noccbd,atoms%nlod,atoms%ntype),qclob(noccbd,atoms%nlod,atoms%ntype) COMPLEX qcloa(noccbd,atoms%nlod,atoms%ntype),qclob(noccbd,atoms%nlod,atoms%ntype)
COMPLEX qal21(0:3,atoms%ntype,dimension%neigd) COMPLEX qal21(0:3,atoms%ntype,input%neig)
COMPLEX q_loc(2,2),q_hlp(2,2),chi(2,2) COMPLEX q_loc(2,2),q_hlp(2,2),chi(2,2)
REAL qmat(0:3,atoms%ntype,dimension%neigd,4) REAL qmat(0:3,atoms%ntype,input%neig,4)
! .. Intrinsic Functions .. ! .. Intrinsic Functions ..
INTRINSIC conjg INTRINSIC conjg
......
...@@ -64,7 +64,7 @@ CONTAINS ...@@ -64,7 +64,7 @@ CONTAINS
na = 1 na = 1
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
lmx(n) = MIN( atoms%lmax(n) , l_cutoff ) lmx(n) = MIN( atoms%lmax(n) , l_cutoff )
ntypsy_o(n) = atoms%ntypsy(na) ntypsy_o(n) = sym%ntypsy(na)
na = na + atoms%neq(n) na = na + atoms%neq(n)
END DO END DO
! !
......
This diff is collapsed.
...@@ -12,7 +12,7 @@ MODULE m_abccoflo ...@@ -12,7 +12,7 @@ MODULE m_abccoflo
! Philipp Kurz 99/04 ! Philipp Kurz 99/04
!********************************************************************* !*********************************************************************
CONTAINS CONTAINS
SUBROUTINE abccoflo(atoms, con1,rph,cph,ylm,ntyp,na,k,nv, l_lo1,alo1,blo1,& SUBROUTINE abccoflo(atoms,sym, con1,rph,cph,ylm,ntyp,na,k,nv, l_lo1,alo1,blo1,&
clo1, nkvec, enough,alo,blo,clo,kvec) clo1, nkvec, enough,alo,blo,clo,kvec)
! !
!*************** ABBREVIATIONS *************************************** !*************** ABBREVIATIONS ***************************************
...@@ -33,6 +33,7 @@ CONTAINS ...@@ -33,6 +33,7 @@ CONTAINS
IMPLICIT NONE IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
REAL, INTENT (IN) :: con1,cph ,rph REAL, INTENT (IN) :: con1,cph ,rph
...@@ -81,7 +82,7 @@ CONTAINS ...@@ -81,7 +82,7 @@ CONTAINS
enough = .TRUE. enough = .TRUE.
term1 = con1* ((atoms%rmt(ntyp)**2)/2)*CMPLX(rph,cph) term1 = con1* ((atoms%rmt(ntyp)**2)/2)*CMPLX(rph,cph)
DO lo = 1,atoms%nlo(ntyp) DO lo = 1,atoms%nlo(ntyp)
IF (atoms%invsat(na).EQ.0) THEN IF (sym%invsat(na).EQ.0) THEN
IF ((nkvec(lo)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN IF ((nkvec(lo)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
enough = .FALSE. enough = .FALSE.
nkvec(lo) = nkvec(lo) + 1 nkvec(lo) = nkvec(lo) + 1
...@@ -105,7 +106,7 @@ CONTAINS ...@@ -105,7 +106,7 @@ CONTAINS
ENDIF ENDIF
ENDIF ENDIF
ELSE ELSE
IF ((atoms%invsat(na).EQ.1) .OR. (atoms%invsat(na).EQ.2)) THEN IF ((sym%invsat(na).EQ.1) .OR. (sym%invsat(na).EQ.2)) THEN
! only invsat=1 is needed invsat=2 for testing ! only invsat=1 is needed invsat=2 for testing
IF ((nkvec(lo)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN IF ((nkvec(lo)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
enough = .FALSE. enough = .FALSE.
......
...@@ -46,8 +46,8 @@ CONTAINS ...@@ -46,8 +46,8 @@ CONTAINS
REAL, INTENT (IN) :: alo1(:),blo1(:),clo1(:) REAL, INTENT (IN) :: alo1(:),blo1(:),clo1(:)
COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 ) COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
COMPLEX, INTENT (IN) :: ccchi(2) COMPLEX, INTENT (IN) :: ccchi(2)
COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat) COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),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) REAL, OPTIONAL, INTENT (IN) :: fgp(3)
...@@ -84,7 +84,7 @@ CONTAINS ...@@ -84,7 +84,7 @@ CONTAINS
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 (atoms%invsat(na)==1.AND.noco%l_soc.AND.sym%invs) THEN IF (sym%invsat(na)==1.AND.noco%l_soc.AND.sym%invs) THEN
ctmp = zMat%data_c(nbasf,i)*CONJG(term1)*ylm(ll1+m+1)*(-1)**(l-m) ctmp = zMat%data_c(nbasf,i)*CONJG(term1)*ylm(ll1+m+1)*(-1)**(l-m)
na2 = sym%invsatnr(na) na2 = sym%invsatnr(na)
lmp = ll1 - m lmp = ll1 - m
......
...@@ -59,7 +59,7 @@ CONTAINS ...@@ -59,7 +59,7 @@ CONTAINS
DO lo = 1,atoms%nlo(ntyp) DO lo = 1,atoms%nlo(ntyp)
l = atoms%llo(lo,ntyp) l = atoms%llo(lo,ntyp)
IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN
IF (atoms%invsat(na).EQ.0) THEN IF (sym%invsat(na).EQ.0) THEN
IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
enough(na) = .FALSE. enough(na) = .FALSE.
...@@ -86,7 +86,7 @@ CONTAINS ...@@ -86,7 +86,7 @@ CONTAINS
ENDIF ! linind