Commit 0e969444 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'hybrid_purge' into inpgen

Conflicts:
	cdn_mt/cdnmt.F90
	cdn_mt/rhosphnlo.f90
	cmake/Files_and_Targets.txt
	diagonalization/chase_diag.F90
	docs/removed_files/inpgen/set_inp.f90
	eigen/eigen.F90
	eigen/mt_setup.F90
	eigen/tlmplm.F90
	eigen/tlmplm_cholesky.F90
	eigen_soc/eigenso.F90
	hybrid/exchange_core.F90
	hybrid/exchange_val_hf.F90
	hybrid/gen_wavf.F90
	hybrid/hf_setup.F90
	hybrid/hsfock.F90
	hybrid/hyb_abcrot.F90
	hybrid/hybrid.F90
	hybrid/kp_perturbation.F90
	hybrid/olap.F90
	hybrid/read_core.F90
	hybrid/subvxc.F90
	hybrid/symm_hf.F90
	hybrid/symmetrizeh.F90
	hybrid/trafo.F90
	hybrid/wavefproducts.F90
	init/checkInputParams.f90
	init/initParallelProcesses.F90
	init/old_inp/dimens.F90
	init/old_inp/fleur_init_old.F90
	init/postprocessInput.F90
	inpgen2/old_inp/dimen7.F90
	inpgen2/old_inp/inped.F90
	inpgen2/old_inp/rw_inp.f90
	io/io_hybrid.F90
	io/r_inpXML.F90
	io/w_inpXML.f90
	io/xml/FleurInputSchema.xsd
	kpoints/kptgen_hybrid.f
	main/cdngen.F90
	main/fleur.F90
	main/fleur_init.F90
	main/optional.F90
	main/vgen.F90
	math/CMakeLists.txt
	math/util.F
	mix/kerker.F90
	mpi/mpi_bc_all.F90
	optional/cdnsp.f90
	optional/flipcdn.f90
	optional/pldngen.f90
	optional/plotdop.f90
	rdmft/rdmft.F90
	tests/tests/CuBandXML/files/inp.xml
	tests/tests/CuBulkXML/files/inp.xml
	tests/tests/CuDOSXML/files/inp.xml
	tests/tests/Fe_1lXML/files/inp.xml
	tests/tests/Fe_1l_SOCXML/files/inp.xml
	tests/tests/Fe_bctXML/files/inp.xml
	tests/tests/Fe_bct_LOXML/files/inp.xml
	tests/tests/Fe_bct_SOCXML/files/inp.xml
	tests/tests/Fe_fccXML/files/inp.xml
	tests/tests/GaAsMultiUForceXML/files/inp-2.xml
	tests/tests/GaAsMultiUForceXML/files/inp-3.xml
	tests/tests/GaAsMultiUForceXML/files/inp.xml
	tests/tests/PTO-SOCXML/files/inp.xml
	tests/tests/PTOXML/files/inp.xml
	tests/tests/SiLOXML/files/inp.xml
	tests/tests_old.cmake
	types/CMakeLists.txt
	types/types_misc.F90
	types/types_setup.F90
	types/types_xcpot_inbuild.F90
	vgen/divergence.f90
	vgen/mpmom.F90
	vgen/mt_tofrom_grid.F90
	vgen/rotate_mt_den_tofrom_local.f90
	vgen/vgen_coulomb.F90
	vgen/vmt_xc.F90
	wannier/wann_read_inp.F90
	wannier/wannier.F90
	xc-pot/libxc_postprocess_gga.f90
	xc-pot/metagga.F90
parents bd82d386 dad4bb7f
...@@ -13,7 +13,7 @@ build-gfortran-hdf5: ...@@ -13,7 +13,7 @@ build-gfortran-hdf5:
- build - build
expire_in: 1h expire_in: 1h
script: script:
- cd /builds/fleur/fleur; ./configure.sh GITLAB; cd build; make -j 4 - cd /builds/fleur/fleur; FC=gfortran ./configure.sh; cd build; make -j 4
# only: # only:
# - schedules # - schedules
# - triggers # - triggers
......
...@@ -3,16 +3,41 @@ Welcome to the source code of FLEUR ...@@ -3,16 +3,41 @@ Welcome to the source code of FLEUR
Please note that the documentation of the Please note that the documentation of the
code can be found at the [FLEUR Homepage] code can be found at the [FLEUR Homepage]
(http://www.flapw.de/pm/index.php?n=User-Documentation.Documentation). (http://www.flapw.de/).
For further instructions on Installation/Usage, For further instructions on Installation/Usage,
please check the [FLEUR Homepage] please check the [FLEUR Homepage]
(http://www.flapw.de/pm/index.php?n=User-Documentation.Documentation). (http://www.flapw.de/).
The rest of this document summarizes only the
structure of the FLEUR source code. Did
we mention to check the Homepage?
## Bugs in FLEUR
You might experience bugs in FLEUR :-).
If you find a bug you should:
A) Report this bug by generating an Issue. Please describe in
detail the relevant input and what happens. You should consider using
the bug-template for your issue as this will help you providing us with
the relevant information.
or/and
B) Provide a bugfix. If the bug is only present in the development branch/ is due
to a new feature under development simply commit your fix to the development branch.
If you are fixing a bug in a release-version, please:
* check out the git release branch: ```git checkout --track origin/release```
* create a bugfix branch: ```git checkout -b bugfix_SOME_NAME_HERE```
* apply your changes, test them and commit them
* push your bugfix branch to the server: ``` git push -u origin bugfix_SOME_NAME_HERE```
* create a merge request on the gitlab to have you bugfix merged with the release branch
* check out the develop branch: ```git checkout develop```
* merge your fix into the develop branch: ```git merge bugfix_SOME_NAME_HERE```
## Structure of the source code
The source of FLEUR is organized in several The source of FLEUR is organized in several
subdirectories. Some of them collect code subdirectories. Some of them collect code
specific for particular features, others code specific for particular features, others code
......
...@@ -134,7 +134,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -134,7 +134,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
CALL denCoeffs%init(atoms,sphhar,jsp_start,jsp_end) CALL denCoeffs%init(atoms,sphhar,jsp_start,jsp_end)
! The last entry in denCoeffsOffdiag%init is l_fmpl. It is meant as a switch to a plot of the full magnet. ! The last entry in denCoeffsOffdiag%init is l_fmpl. It is meant as a switch to a plot of the full magnet.
! density without the atomic sphere approximation for the magnet. density. It is not completely implemented (lo's missing). ! density without the atomic sphere approximation for the magnet. density. It is not completely implemented (lo's missing).
CALL denCoeffsOffdiag%init(atoms,noco,sphhar,noco%l_mtnocopot) CALL denCoeffsOffdiag%init(atoms,noco,sphhar,noco%l_mtnocopot.OR.noco%l_mperp)
CALL force%init1(input,atoms) CALL force%init1(input,atoms)
CALL orb%init(atoms,noco,jsp_start,jsp_end) CALL orb%init(atoms,noco,jsp_start,jsp_end)
......
...@@ -36,7 +36,7 @@ CONTAINS ...@@ -36,7 +36,7 @@ CONTAINS
! .. Local Scalars .. ! .. Local Scalars ..
INTEGER iri INTEGER iri
REAL b_xavh,scale,b_con_outx,b_con_outy,mx,my,mz,& REAL b_xavh,scale,b_con_outx,b_con_outy,mx,my,mz,&
& alphh,betah,mz_tmp,mx_mix,my_mix,mz_mix & alphh,betah,mz_tmp,mx_mix,my_mix,mz_mix,absmag
REAL rho11,rho22, alphdiff REAL rho11,rho22, alphdiff
COMPLEX rho21 COMPLEX rho21
! .. ! ..
...@@ -56,11 +56,12 @@ CONTAINS ...@@ -56,11 +56,12 @@ CONTAINS
mx = 2*REAL(qa21(itype)) mx = 2*REAL(qa21(itype))
my = 2*AIMAG(qa21(itype)) my = 2*AIMAG(qa21(itype))
mz = chmom(itype,1) - chmom(itype,2) mz = chmom(itype,1) - chmom(itype,2)
WRITE (6,8025) mx,my absmag=SQRT(mx*mx+my*my+mz*mz)
WRITE (6,8025) mx,my,mz,absmag
!---> determine the polar angles of the moment vector in the local frame !---> determine the polar angles of the moment vector in the local frame
CALL pol_angle(mx,my,mz,betah,alphh) CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8026) betah,alphh WRITE (6,8026) betah,alphh
8025 FORMAT(2x,'--> local frame: ','mx=',f9.5,' my=',f9.5) 8025 FORMAT(2x,'--> local frame: ','mx=',f9.5,' my=',f9.5,' mz=',f9.5,' |m|=',f9.5)
8026 FORMAT(2x,'-->',10x,' delta beta=',f9.5,& 8026 FORMAT(2x,'-->',10x,' delta beta=',f9.5,&
& ' delta alpha=',f9.5) & ' delta alpha=',f9.5)
......
...@@ -409,7 +409,7 @@ CONTAINS ...@@ -409,7 +409,7 @@ CONTAINS
length_zfft(1) = stars%kq1_fft length_zfft(1) = stars%kq1_fft
length_zfft(2) = stars%kq2_fft length_zfft(2) = stars%kq2_fft
length_zfft(3) = stars%kq3_fft length_zfft(3) = stars%kq3_fft
call fft_interface(3,length_zfft,zfft,forw) call fft_interface(3,length_zfft,zfft,forw,iv1d(1:lapw%nv(jspin),jspin))
psir = real(zfft) psir = real(zfft)
psii = aimag(zfft) psii = aimag(zfft)
!-------------------------------- !--------------------------------
...@@ -443,7 +443,7 @@ CONTAINS ...@@ -443,7 +443,7 @@ CONTAINS
length_zfft(1) = stars%kq1_fft length_zfft(1) = stars%kq1_fft
length_zfft(2) = stars%kq2_fft length_zfft(2) = stars%kq2_fft
length_zfft(3) = stars%kq3_fft length_zfft(3) = stars%kq3_fft
call fft_interface(3,length_zfft,zfft,forw) call fft_interface(3,length_zfft,zfft,forw,iv1d(1:lapw%nv(jspin),jspin))
kpsir = real(zfft) kpsir = real(zfft)
kpsii = aimag(zfft) kpsii = aimag(zfft)
!-------------------------------- !--------------------------------
......
...@@ -10,10 +10,13 @@ cdn_mt/abcof3.F90 ...@@ -10,10 +10,13 @@ cdn_mt/abcof3.F90
cdn_mt/abcrot2.f90 cdn_mt/abcrot2.f90
cdn_mt/cdnmt.F90 cdn_mt/cdnmt.F90
cdn_mt/cdncore.F90 cdn_mt/cdncore.F90
cdn_mt/denMultipoleExp.f90
cdn_mt/magMoms.f90 cdn_mt/magMoms.f90
cdn_mt/magDiMom.f90
cdn_mt/orbMagMoms.f90 cdn_mt/orbMagMoms.f90
cdn_mt/orb_comp2.f90 cdn_mt/orb_comp2.f90
cdn_mt/radfun.f90 cdn_mt/radfun.f90
cdn_mt/resMoms.f90
cdn_mt/rhomt.f90 cdn_mt/rhomt.f90
cdn_mt/rhomt21.f90 cdn_mt/rhomt21.f90
cdn_mt/rhomtlo.f90 cdn_mt/rhomtlo.f90
...@@ -24,5 +27,7 @@ cdn_mt/rhosphnlo.f90 ...@@ -24,5 +27,7 @@ cdn_mt/rhosphnlo.f90
cdn_mt/setabc1locdn.f90 cdn_mt/setabc1locdn.f90
cdn_mt/setabc1locdn1.f90 cdn_mt/setabc1locdn1.f90
cdn_mt/calcDenCoeffs.f90 cdn_mt/calcDenCoeffs.f90
cdn_mt/magnMomFromDen.f90
cdn_mt/alignSpinAxisMagn.f90
) )
!--------------------------------------------------------------------------------
! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and avhttps://gcc.gnu.org/onlinedocs/gfortran/SQRT.htmlailable as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!------------------------------------------------------------------------------
! This routine allows to rotate the cdn in a way that the direction of magnetization aligns with the direction of the spin quantization axis.
! This routine also allows to reverse the rotation by using the angles stored in atoms (phi_mt_avg,theta_mt_avg) which are generated by the
! routine magnMomFromDen.
!
! Robin Hilgers, Nov '19
MODULE m_alignSpinAxisMagn
USE m_magnMomFromDen
USE m_types
USE m_flipcdn
USE m_constants
USE m_polangle
CONTAINS
SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
,sym,oneD,cell,noco,input,atoms,den)
TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_atoms), INTENT(INOUT) :: atoms
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden), INTENT(INOUT) :: den
REAL :: moments(atoms%ntype,3)
REAL :: phiTemp(atoms%ntype),thetaTemp(atoms%ntype),pi
INTEGER :: i
pi=pimach()
!!TEMP
! REAL :: x,y,z
phiTemp=noco%alph
thetaTemp=noco%beta
CALL magnMomFromDen(input,atoms,noco,den,moments)
! DO i=1, atoms%ntype
! IF (abs(atoms%theta_mt_avg(i)).LE. 0.001) THEN
! atoms%phi_mt_avg(i)=0.0
! atoms%theta_mt_avg(i)=0.0
! END IF
! END DO
!write(*,*) "mx1"
!write(*,*) moments(1,1)
!write(*,*) "mz1"
!write(*,*) moments(1,3)
!write(*,*) "mx2"
!write(*,*) moments(2,1)
!write(*,*) "mz2"
!write(*,*) moments(2,3)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,-atoms%phi_mt_avg,-atoms%theta_mt_avg,den)
!write (*,*)"mx my mz"
!CALL sphericaltocart(SQRT(moments(1,1)**2+moments(1,2)**2+moments(1,3)**2),thetaTemp(1),phiTemp(1),x,y,z)
!write(*,*) x,y,z
!CALL sphericaltocart(SQRT(moments(2,1)**2+moments(2,2)**2+moments(2,3)**2),thetaTemp(2),phiTemp(2),x,y,z)
!write(*,*) x,y,z
!write(*,*) "atoms%phi_mt_avg"
!!write(*,*) atoms%phi_mt_avg
!write(*,*) "atoms%theta_mt_avg"
!write(*,*) atoms%theta_mt_avg
noco%alph=mod(atoms%phi_mt_avg+phiTemp,2*pimach())
noco%beta=mod(atoms%theta_mt_avg+thetaTemp,2*pimach())
atoms%phi_mt_avg=noco%alph
atoms%theta_mt_avg=noco%beta
DO i=1, atoms%ntype
IF(noco%alph(i)<0) noco%alph(i)=noco%alph(i)+2*pi
IF(noco%beta(i)<0) THEN
noco%beta(i)=-noco%beta(i)
noco%alph=noco%alph+pi
END IF
IF(noco%beta(i)>pi) THEN
noco%beta(i)=pi-mod(noco%beta(i),pi)
noco%alph(i)=noco%alph(i)+pi
END IF
noco%alph=mod(noco%alph,2*pi)
End Do
write(*,*) "Noco Phi"
write(*,*) noco%alph
write(*,*) "Noco Theta"
write(*,*) noco%beta
END SUBROUTINE rotateMagnetToSpinAxis
SUBROUTINE rotateMagnetFromSpinAxis(noco,vacuum,sphhar,stars&
,sym,oneD,cell,input,atoms,den,inDen)
TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_atoms), INTENT(INOUT) :: atoms
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden), INTENT(INOUT) :: den, inDen
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,atoms%phi_mt_avg,atoms%theta_mt_avg,den)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,atoms%phi_mt_avg,atoms%theta_mt_avg,inDen)
atoms%flipSpinPhi=0
atoms%flipSpinTheta=0
noco%alph=0
noco%beta=0
END SUBROUTINE rotateMagnetFromSpinAxis
END MODULE m_alignSpinAxisMagn
...@@ -39,7 +39,7 @@ CONTAINS ...@@ -39,7 +39,7 @@ CONTAINS
TYPE (t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag TYPE (t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
INTEGER itype,na,nd,l,lp,llp ,lh,j,ispin,noded,nodeu INTEGER itype,na,nd,l,lp,llp ,lh,j,ispin,noded,nodeu,llpb
INTEGER ilo,ilop,i INTEGER ilo,ilop,i
REAL s,wronk,sumlm,qmtt REAL s,wronk,sumlm,qmtt
COMPLEX cs COMPLEX cs
...@@ -64,11 +64,11 @@ CONTAINS ...@@ -64,11 +64,11 @@ CONTAINS
ENDIF ENDIF
ENDIF ENDIF
!$OMP PARALLEL DEFAULT(none) & ! !$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(usdus,rho,moments,qmtl) & ! !$OMP SHARED(usdus,rho,moments,qmtl) &
!$OMP SHARED(atoms,sym,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)& ! !$OMP SHARED(atoms,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)&
!$OMP SHARED(orb,noco,denCoeffsOffdiag,jspd)& ! !$OMP SHARED(orb,noco,denCoeffsOffdiag,jspd)&
!$OMP PRIVATE(itype,na,ispin,l,rho21,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs) ! !$OMP PRIVATE(itype,na,ispin,l,rho21,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,llpb,cs)
IF (noco%l_mperp) THEN IF (noco%l_mperp) THEN
ALLOCATE ( f(atoms%jmtd,2,0:atoms%lmaxd,jspd),g(atoms%jmtd,2,0:atoms%lmaxd,jspd) ) ALLOCATE ( f(atoms%jmtd,2,0:atoms%lmaxd,jspd),g(atoms%jmtd,2,0:atoms%lmaxd,jspd) )
ELSE ELSE
...@@ -77,8 +77,8 @@ CONTAINS ...@@ -77,8 +77,8 @@ CONTAINS
ENDIF ENDIF
qmtl = 0 qmtl = 0
!$OMP DO ! !$OMP DO
DO itype = 1,atoms%ntype DO itype = 1,atoms%ntype
na = 1 na = 1
DO i = 1, itype - 1 DO i = 1, itype - 1
...@@ -89,11 +89,13 @@ CONTAINS ...@@ -89,11 +89,13 @@ CONTAINS
DO l = 0,atoms%lmax(itype) DO l = 0,atoms%lmax(itype)
CALL radfun(l,itype,ispin,enpara%el0(l,itype,ispin),vr(1,itype,ispin),atoms,& CALL radfun(l,itype,ispin,enpara%el0(l,itype,ispin),vr(1,itype,ispin),atoms,&
f(1,1,l,ispin),g(1,1,l,ispin),usdus, nodeu,noded,wronk) f(1,1,l,ispin),g(1,1,l,ispin),usdus, nodeu,noded,wronk)
llp = (l* (l+1))/2 + l
DO j = 1,atoms%jri(itype) DO j = 1,atoms%jri(itype)
s = denCoeffs%uu(l,itype,ispin)*( f(j,1,l,ispin)*f(j,1,l,ispin)+f(j,2,l,ispin)*f(j,2,l,ispin) )& s = denCoeffs%uu(l,itype,ispin)*( f(j,1,l,ispin)*f(j,1,l,ispin)+f(j,2,l,ispin)*f(j,2,l,ispin) )&
+ denCoeffs%dd(l,itype,ispin)*( g(j,1,l,ispin)*g(j,1,l,ispin)+g(j,2,l,ispin)*g(j,2,l,ispin) )& + denCoeffs%dd(l,itype,ispin)*( g(j,1,l,ispin)*g(j,1,l,ispin)+g(j,2,l,ispin)*g(j,2,l,ispin) )&
+ 2*denCoeffs%du(l,itype,ispin)*( f(j,1,l,ispin)*g(j,1,l,ispin)+f(j,2,l,ispin)*g(j,2,l,ispin) ) + 2*denCoeffs%du(l,itype,ispin)*( f(j,1,l,ispin)*g(j,1,l,ispin)+f(j,2,l,ispin)*g(j,2,l,ispin) )
rho(j,0,itype,ispin) = rho(j,0,itype,ispin)+ s/(atoms%neq(itype)*sfp_const) rho(j,0,itype,ispin) = rho(j,0,itype,ispin)+ s/(atoms%neq(itype)*sfp_const)
moments%rhoLRes(j,0,llp,itype,ispin) = moments%rhoLRes(j,0,llp,itype,ispin)+ s/(atoms%neq(itype)*sfp_const)
ENDDO ENDDO
ENDDO ENDDO
...@@ -111,7 +113,7 @@ CONTAINS ...@@ -111,7 +113,7 @@ CONTAINS
denCoeffs%cclo(1,1,itype,ispin),denCoeffs%acnmt(0,1,1,itype,ispin),& denCoeffs%cclo(1,1,itype,ispin),denCoeffs%acnmt(0,1,1,itype,ispin),&
denCoeffs%bcnmt(0,1,1,itype,ispin),denCoeffs%ccnmt(1,1,1,itype,ispin),& denCoeffs%bcnmt(0,1,1,itype,ispin),denCoeffs%ccnmt(1,1,1,itype,ispin),&
f(1,1,0,ispin),g(1,1,0,ispin),& f(1,1,0,ispin),g(1,1,0,ispin),&
rho(:,0:,itype,ispin),qmtllo) rho(:,0:,itype,ispin),qmtllo,moments%rhoLRes(:,0:,:,itype,ispin))
!---> l-decomposed density for each atom type !---> l-decomposed density for each atom type
...@@ -147,6 +149,7 @@ CONTAINS ...@@ -147,6 +149,7 @@ CONTAINS
+ denCoeffs%dunmt(llp,lh,itype,ispin)*(g(j,1,l,ispin)*f(j,1,lp,ispin)& + denCoeffs%dunmt(llp,lh,itype,ispin)*(g(j,1,l,ispin)*f(j,1,lp,ispin)&
+ g(j,2,l,ispin)*f(j,2,lp,ispin) ) + g(j,2,l,ispin)*f(j,2,lp,ispin) )
rho(j,lh,itype,ispin) = rho(j,lh,itype,ispin)+ s/atoms%neq(itype) rho(j,lh,itype,ispin) = rho(j,lh,itype,ispin)+ s/atoms%neq(itype)
moments%rhoLRes(j,lh,llp,itype,ispin) = moments%rhoLRes(j,lh,llp,itype,ispin)+ s/atoms%neq(itype)
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
...@@ -184,6 +187,7 @@ CONTAINS ...@@ -184,6 +187,7 @@ CONTAINS
!---> calculate off-diagonal part of the density matrix !---> calculate off-diagonal part of the density matrix
!---> spherical component !---> spherical component
DO l = 0,atoms%lmax(itype) DO l = 0,atoms%lmax(itype)
llp = (l* (l+1))/2 + l
DO j = 1,atoms%jri(itype) DO j = 1,atoms%jri(itype)
cs = denCoeffsOffdiag%uu21(l,itype)*( f(j,1,l,2)*f(j,1,l,1) +f(j,2,l,2)*f(j,2,l,1) )& cs = denCoeffsOffdiag%uu21(l,itype)*( f(j,1,l,2)*f(j,1,l,1) +f(j,2,l,2)*f(j,2,l,1) )&
+ denCoeffsOffdiag%ud21(l,itype)*( f(j,1,l,2)*g(j,1,l,1) +f(j,2,l,2)*g(j,2,l,1) )& + denCoeffsOffdiag%ud21(l,itype)*( f(j,1,l,2)*g(j,1,l,1) +f(j,2,l,2)*g(j,2,l,1) )&
...@@ -192,7 +196,9 @@ CONTAINS ...@@ -192,7 +196,9 @@ CONTAINS
!rho21(j,0,itype) = rho21(j,0,itype)+ conjg(cs)/(atoms%neq(itype)*sfp_const) !rho21(j,0,itype) = rho21(j,0,itype)+ conjg(cs)/(atoms%neq(itype)*sfp_const)
rho21=CONJG(cs)/(atoms%neq(itype)*sfp_const) rho21=CONJG(cs)/(atoms%neq(itype)*sfp_const)
rho(j,0,itype,3)=rho(j,0,itype,3)+REAL(rho21) rho(j,0,itype,3)=rho(j,0,itype,3)+REAL(rho21)
rho(j,0,itype,4)=rho(j,0,itype,4)+imag(rho21) rho(j,0,itype,4)=rho(j,0,itype,4)+aimag(rho21)
moments%rhoLRes(j,0,llp,itype,3) = moments%rhoLRes(j,0,llp,itype,3)+ REAL(conjg(cs)/(atoms%neq(itype)*sfp_const))
moments%rhoLRes(j,0,llp,itype,4) = moments%rhoLRes(j,0,llp,itype,4)+ AIMAG(conjg(cs)/(atoms%neq(itype)*sfp_const))
ENDDO ENDDO
ENDDO ENDDO
...@@ -202,6 +208,7 @@ CONTAINS ...@@ -202,6 +208,7 @@ CONTAINS
DO l = 0,atoms%lmax(itype) DO l = 0,atoms%lmax(itype)
DO lp = 0,atoms%lmax(itype) DO lp = 0,atoms%lmax(itype)
llp = lp*(atoms%lmax(itype)+1)+l+1 llp = lp*(atoms%lmax(itype)+1)+l+1
llpb = (MAX(l,lp)* (MAX(l,lp)+1))/2 + MIN(l,lp)
DO j = 1,atoms%jri(itype) DO j = 1,atoms%jri(itype)
cs = denCoeffsOffdiag%uunmt21(llp,lh,itype)*(f(j,1,lp,2)*f(j,1,l,1)& cs = denCoeffsOffdiag%uunmt21(llp,lh,itype)*(f(j,1,lp,2)*f(j,1,l,1)&
+ f(j,2,lp,2)*f(j,2,l,1) )+ denCoeffsOffdiag%udnmt21(llp,lh,itype)*(f(j,1,lp,2)*g(j,1,l,1)& + f(j,2,lp,2)*f(j,2,l,1) )+ denCoeffsOffdiag%udnmt21(llp,lh,itype)*(f(j,1,lp,2)*g(j,1,l,1)&
...@@ -211,7 +218,9 @@ CONTAINS ...@@ -211,7 +218,9 @@ CONTAINS
!rho21(j,lh,itype)= rho21(j,lh,itype)+ CONJG(cs)/atoms%neq(itype) !rho21(j,lh,itype)= rho21(j,lh,itype)+ CONJG(cs)/atoms%neq(itype)
rho21=CONJG(cs)/atoms%neq(itype) rho21=CONJG(cs)/atoms%neq(itype)
rho(j,lh,itype,3)=rho(j,lh,itype,3)+REAL(rho21) rho(j,lh,itype,3)=rho(j,lh,itype,3)+REAL(rho21)
rho(j,lh,itype,4)=rho(j,lh,itype,4)+imag(rho21) rho(j,lh,itype,4)=rho(j,lh,itype,4)+aimag(rho21)
moments%rhoLRes(j,lh,llpb,itype,3)= moments%rhoLRes(j,lh,llpb,itype,3) + REAL(conjg(cs)/atoms%neq(itype))
moments%rhoLRes(j,lh,llpb,itype,4)= moments%rhoLRes(j,lh,llpb,itype,4) + AIMAG(conjg(cs)/atoms%neq(itype))
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
...@@ -221,9 +230,9 @@ CONTAINS ...@@ -221,9 +230,9 @@ CONTAINS
ENDIF ! noco%l_mperp ENDIF ! noco%l_mperp
ENDDO ! end of loop over atom types ENDDO ! end of loop over atom types
!$OMP END DO ! !$OMP END DO
DEALLOCATE ( f,g) DEALLOCATE ( f,g)
!$OMP END PARALLEL ! !$OMP END PARALLEL
WRITE (6,FMT=8000) WRITE (6,FMT=8000)
8000 FORMAT (/,5x,'l-like charge',/,t6,'atom',t15,'s',t24,'p',& 8000 FORMAT (/,5x,'l-like charge',/,t6,'atom',t15,'s',t24,'p',&
...@@ -248,6 +257,6 @@ CONTAINS ...@@ -248,6 +257,6 @@ CONTAINS