Commit ee565ef8 authored by Matthias Redies's avatar Matthias Redies

Merge branch 'develop' into hybrid_io_overhaul

parents 43525d6a 76041041
......@@ -10,7 +10,7 @@ USE m_juDFT
CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,&
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,enpara,stars,&
vacuum,sphhar,sym,vTot,oneD,cdnvalJob,den,regCharges,dos,results,&
moments,gfinp,hub1inp,hub1data,coreSpecInput,mcd,slab,orbcomp,greensfCoeffs)
......@@ -67,6 +67,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
TYPE(t_input), INTENT(IN) :: input
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_nococonv), INTENT(IN) :: nococonv
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_cell), INTENT(IN) :: cell
......@@ -191,7 +192,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
DO ikpt_i = 1,size(cdnvalJob%k_list)
ikpt=cdnvalJob%k_list(ikpt_i)
CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi)
CALL lapw%init(input,noco,nococonv, kpts,atoms,sym,ikpt,cell,.false., mpi)
skip_t = skip_tt
ev_list=cdnvaljob%compact_ev_list(ikpt_i,banddos%dos.OR.gfinp%n>0)
noccbd = SIZE(ev_list)
......@@ -224,7 +225,7 @@ 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)
! valence density in the vacuum region
IF (input%film) THEN
CALL vacden(vacuum,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,&
CALL vacden(vacuum,stars,oneD, kpts,input,sym,cell,atoms,noco,nococonv,banddos,&
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,ev_list,lapw,enpara%evac,eig,den,zMat,dos)
END IF
END IF
......@@ -244,7 +245,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
ENDIF
DO ispin = jsp_start, jsp_end
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,nococonv,ispin,oneD,&
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
......@@ -260,7 +261,7 @@ 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,&
skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(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,nococonv,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
......
......@@ -8,7 +8,7 @@ MODULE m_genNewNocoInp
CONTAINS
SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
SUBROUTINE genNewNocoInp(input,atoms,noco,nococonv,nococonv_new)
USE m_juDFT
USE m_types
......@@ -20,7 +20,8 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_noco),INTENT(INOUT) :: noco_new
TYPE(t_nococonv),INTENT(IN) :: nococonv
TYPE(t_nococonv),INTENT(INOUT) :: nococonv_new
INTEGER :: iAtom, iType
REAL :: alphdiff
......@@ -31,18 +32,18 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
iAtom = 1
DO iType = 1, atoms%ntype
IF (noco%l_ss) THEN
alphdiff = 2.0*pi_const*(noco%qss(1)*atoms%taual(1,iAtom) + &
noco%qss(2)*atoms%taual(2,iAtom) + &
noco%qss(3)*atoms%taual(3,iAtom) )
noco_new%alph(iType) = noco_new%alph(iType) - alphdiff
DO WHILE (noco_new%alph(iType) > +pi_const)
noco_new%alph(iType)= noco_new%alph(iType) - 2.0*pi_const
alphdiff = 2.0*pi_const*(nococonv%qss(1)*atoms%taual(1,iAtom) + &
nococonv%qss(2)*atoms%taual(2,iAtom) + &
nococonv%qss(3)*atoms%taual(3,iAtom) )
nococonv_new%alph(iType) = nococonv_new%alph(iType) - alphdiff
DO WHILE (nococonv_new%alph(iType) > +pi_const)
nococonv_new%alph(iType)= nococonv_new%alph(iType) - 2.0*pi_const
END DO
DO WHILE (noco_new%alph(iType) < -pi_const)
noco_new%alph(iType)= noco_new%alph(iType) + 2.0*pi_const
DO WHILE (nococonv_new%alph(iType) < -pi_const)
nococonv_new%alph(iType)= nococonv_new%alph(iType) + 2.0*pi_const
END DO
ELSE
noco_new%alph(iType) = noco_new%alph(iType)
nococonv_new%alph(iType) = nococonv_new%alph(iType)
END IF
iatom= iatom + atoms%neq(iType)
END DO
......
......@@ -5,8 +5,8 @@
!--------------------------------------------------------------------------------
MODULE m_m_perp
CONTAINS
SUBROUTINE m_perp(atoms,itype,iRepAtom,noco,vr0, chmom,qa21)
CONTAINS
SUBROUTINE m_perp(atoms,itype,iRepAtom,noco,nococonv,vr0, chmom,qa21)
!***********************************************************************
! calculates the perpendicular part of the local moment.
! if l_relax is true the angle of the output local moment is calculated
......@@ -22,8 +22,9 @@ CONTAINS
USE m_rotdenmat
USE m_types
IMPLICIT NONE
TYPE(t_noco),INTENT(INOUT) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_nococonv),INTENT(INOUT) :: nococonv
TYPE(t_atoms),INTENT(IN) :: atoms
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: itype, iRepAtom
......@@ -45,9 +46,9 @@ CONTAINS
! angles in nocoinp file are (alph-alphdiff)
IF (noco%l_ss) THEN
alphdiff = 2.0*pi_const*(noco%qss(1)*atoms%taual(1,iRepAtom) + &
noco%qss(2)*atoms%taual(2,iRepAtom) + &
noco%qss(3)*atoms%taual(3,iRepAtom) )
alphdiff = 2.0*pi_const*(nococonv%qss(1)*atoms%taual(1,iRepAtom) + &
nococonv%qss(2)*atoms%taual(2,iRepAtom) + &
nococonv%qss(3)*atoms%taual(3,iRepAtom) )
ELSE
alphdiff = 0.0
END IF
......@@ -71,23 +72,23 @@ CONTAINS
rho11 = chmom(itype,1)
rho22 = chmom(itype,2)
rho21 = qa21(itype)
CALL rot_den_mat(noco%alph(itype),noco%beta(itype), rho11,rho22,rho21)
CALL rot_den_mat(nococonv%alph(itype),nococonv%beta(itype), rho11,rho22,rho21)
!---> determine the polar angles of the mom. vec. in the global frame
mx = 2*REAL(rho21)
my = 2*AIMAG(rho21)
mz = rho11 - rho22
CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8027) noco%beta(itype),noco%alph(itype)-alphdiff
WRITE (6,8027) nococonv%beta(itype),nococonv%alph(itype)-alphdiff
WRITE (6,8028) betah,alphh-alphdiff
8027 FORMAT(2x,'-->',10x,' input noco%beta=',f9.5, ' input noco%alpha=',f9.5)
8028 FORMAT(2x,'-->',10x,'output noco%beta=',f9.5, ' output noco%alpha=',f9.5)
8027 FORMAT(2x,'-->',10x,' input nococonv%beta=',f9.5, ' input nococonv%alpha=',f9.5)
8028 FORMAT(2x,'-->',10x,'output nococonv%beta=',f9.5, ' output nococonv%alpha=',f9.5)
! ff do the same for mixed density: rho21 = mix_b * rho21
rho11 = chmom(itype,1)
rho22 = chmom(itype,2)
rho21 = qa21(itype)
rho21 = noco%mix_b * rho21
CALL rot_den_mat(noco%alph(itype),noco%beta(itype), rho11,rho22,rho21)
CALL rot_den_mat(nococonv%alph(itype),nococonv%beta(itype), rho11,rho22,rho21)
!---> determine the polar angles of the mom. vec. in the global frame
mx_mix = 2*REAL(rho21)
my_mix = 2*AIMAG(rho21)
......@@ -95,8 +96,8 @@ CONTAINS
WRITE (6,8031) mx_mix,my_mix
8031 FORMAT(2x,'--> global frame: ','mixed mx=',f9.5,' mixed my=',f9.5)
! if magnetic moment (in local frame!) is negative, direction of quantization
! has to be antiparallel!
mz_tmp = chmom(itype,1) - chmom(itype,2)
! has to be antiparallel!
mz_tmp = chmom(itype,1) - chmom(itype,2)
IF ( mz_tmp .LT. 0.0 ) THEN
mx_mix = (-1.0) * mx_mix
my_mix = (-1.0) * my_mix
......@@ -105,9 +106,9 @@ CONTAINS
! calculate angles alpha and beta in global frame
CALL pol_angle(mx_mix,my_mix,mz_mix,betah,alphh)
WRITE (6,8029) betah,alphh-alphdiff
8029 FORMAT(2x,'-->',10x,' new noco%beta =',f9.5, ' new noco%alpha =',f9.5)
noco%alph(itype) = alphh
noco%beta(itype) = betah
8029 FORMAT(2x,'-->',10x,' new nococonv%beta =',f9.5, ' new nococonv%alpha =',f9.5)
nococonv%alph(itype) = alphh
nococonv%beta(itype) = betah
ENDIF
IF (noco%l_constr) THEN
......@@ -123,10 +124,10 @@ CONTAINS
b_con_outx = scale*mx
b_con_outy = scale*my
!---> mix input and output constraint fields
WRITE (6,8100) noco%b_con(1,itype),noco%b_con(2,itype)
WRITE (6,8100) nococonv%b_con(1,itype),nococonv%b_con(2,itype)
WRITE (6,8200) b_con_outx,b_con_outy
noco%b_con(1,itype) = noco%b_con(1,itype) + noco%mix_b*b_con_outx
noco%b_con(2,itype) = noco%b_con(2,itype) + noco%mix_b*b_con_outy
nococonv%b_con(1,itype) = nococonv%b_con(1,itype) + noco%mix_b*b_con_outx
nococonv%b_con(2,itype) = nococonv%b_con(2,itype) + noco%mix_b*b_con_outy
ENDIF
8100 FORMAT (2x,'-->',10x,' input B_con_x=',f12.6,&
......
......@@ -100,25 +100,32 @@ MODULE m_nmat21
!
! n_mmp should be rotated by D_mm' ; compare force_a21
!
!Note: This can be done only if the correct magnetic symmetries are
!present. This is not the case at the moment (Jan 2020).
!Symmetries are ignored if the user forces this calculation
!DO it = 1, sym%invarind(natomTemp)
DO it = 1, sym%invarind(natomTemp)
fac = 1.0 / ( sym%invarind(natomTemp) * atoms%neq(n) )
is = sym%invarop(natomTemp,it)
isi = sym%invtab(is)
d_tmp(:,:) = cmplx_0
DO m = -l,l
DO mp = -l,l
d_tmp(m,mp) = sym%d_wgn(m,mp,l,isi)
ENDDO
ENDDO
nr_tmp = matmul( transpose( conjg(d_tmp) ) , n_tmp)
n1_tmp = matmul( nr_tmp, d_tmp )
phase = exp(ImagUnit*sym%phase(isi))
DO m = -l,l
DO mp = -l,l
n_mmp(m,mp,i_u) = n_mmp(m,mp,i_u) + conjg(n1_tmp(m,mp)) * fac * phase
ENDDO
! fac = 1.0 / ( sym%invarind(natomTemp) * atoms%neq(n) )
! is = sym%invarop(natomTemp,it)
! isi = sym%invtab(is)
! d_tmp(:,:) = cmplx_0
! DO m = -l,l
! DO mp = -l,l
! d_tmp(m,mp) = sym%d_wgn(m,mp,l,isi)
! ENDDO
! ENDDO
! nr_tmp = matmul( transpose( conjg(d_tmp) ) , n_tmp)
! n1_tmp = matmul( nr_tmp, d_tmp )
! phase = exp(ImagUnit*sym%phase(isi))
! DO m = -l,l
! DO mp = -l,l
! n_mmp(m,mp,i_u) = n_mmp(m,mp,i_u) + conjg(n1_tmp(m,mp)) * fac * phase
! ENDDO
! ENDDO
!ENDDO
DO m = -l,l
DO mp = -l,l
n_mmp(m,mp,i_u) = n_mmp(m,mp,i_u) + conjg(n_tmp(m,mp))
ENDDO
ENDDO
......
MODULE m_qal21
MODULE m_qal21
!***********************************************************************
! Calculates qal21 needed to determine the off-diagonal parts of the
! Calculates qal21 needed to determine the off-diagonal parts of the
! DOS
!***********************************************************************
!
CONTAINS
SUBROUTINE qal_21(atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
SUBROUTINE qal_21(atoms,input,noccbd,ev_list,nococonv,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
use m_types_nococonv
USE m_types_setup
USE m_types_dos
USE m_types_cdnval, ONLY: t_eigVecCoeffs
USE m_types_cdnval, ONLY: t_eigVecCoeffs
USE m_types_denCoeffsOffdiag
USE m_rotdenmat
use m_constants
IMPLICIT NONE
TYPE(t_input), INTENT(IN) :: input
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_nococonv), INTENT(IN) :: nococonv
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag
......@@ -52,7 +52,7 @@ CONTAINS
ls : DO l = 0,3
IF (i==1) THEN
ENDIF
sumaa = CMPLX(0.,0.) ; sumab = CMPLX(0.,0.)
sumaa = CMPLX(0.,0.) ; sumab = CMPLX(0.,0.)
sumbb = CMPLX(0.,0.) ; sumba = CMPLX(0.,0.)
ll1 = l* (l+1)
ms : DO m = -l,l
......@@ -65,7 +65,7 @@ CONTAINS
ENDDO atoms_loop
ENDDO ms
qal21(l,n,i) = sumaa * denCoeffsOffdiag%uu21n(l,n) + sumbb * denCoeffsOffdiag%dd21n(l,n) +&
sumba * denCoeffsOffdiag%du21n(l,n) + sumab * denCoeffsOffdiag%ud21n(l,n)
sumba * denCoeffsOffdiag%du21n(l,n) + sumab * denCoeffsOffdiag%ud21n(l,n)
ENDDO ls
nt1 = nt1 + atoms%neq(n)
ENDDO types_loop
......@@ -92,13 +92,13 @@ CONTAINS
lm = ll1 + m
DO i = 1, noccbd
qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) + &
eigVecCoeffs%bcof(i,lm,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))
eigVecCoeffs%bcof(i,lm,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))
qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) + &
eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins))
eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins))
qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) + &
eigVecCoeffs%acof(i,lm,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))
eigVecCoeffs%acof(i,lm,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))
qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) + &
eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins))
eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins))
ENDDO
ENDDO
DO lop = 1,atoms%nlo(ntyp)
......@@ -146,14 +146,14 @@ CONTAINS
!
! rotate into global frame
!
TYPE_loop : DO n = 1,atoms%ntype
chi(1,1) = EXP(-ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
chi(1,2) = -EXP(-ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
chi(2,1) = EXP( ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
chi(2,2) = EXP( ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
TYPE_loop : DO n = 1,atoms%ntype
chi(1,1) = EXP(-ImagUnit*nococonv%alph(n)/2)*COS(nococonv%beta(n)/2)
chi(1,2) = -EXP(-ImagUnit*nococonv%alph(n)/2)*SIN(nococonv%beta(n)/2)
chi(2,1) = EXP( ImagUnit*nococonv%alph(n)/2)*SIN(nococonv%beta(n)/2)
chi(2,2) = EXP( ImagUnit*nococonv%alph(n)/2)*COS(nococonv%beta(n)/2)
state : DO i = 1, noccbd
lls : DO l = 0,3
CALL rot_den_mat(noco%alph(n),noco%beta(n),&
CALL rot_den_mat(nococonv%alph(n),nococonv%beta(n),&
dos%qal(l,n,ev_list(i),ikpt,1),dos%qal(l,n,ev_list(i),ikpt,2),qal21(l,n,i))
IF (.FALSE.) THEN
IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,ev_list(i),ikpt,:)
......
......@@ -44,8 +44,8 @@ C ..
+ 0.5*(1.0-cos(beta))*rho22
r22n = 0.5*(1.0-cos(beta))*rho11 + sin(beta)*real(rho21) +
+ 0.5*(1.0+cos(beta))*rho22
r21n = CMPLX(cos(alph),-sin(alph))*(sin(beta)*(rho11-rho22) +
+ 2.0*(cos(beta)*real(rho21)-cmplx(0.0,aimag(rho21))))*0.5
r21n = CMPLX(cos(alph),+sin(alph))*(sin(beta)*(rho11-rho22) +
+ 2.0*(cos(beta)*real(rho21)+cmplx(0.0,aimag(rho21))))*0.5
rho11 = r11n
rho22 = r22n
......
......@@ -5,7 +5,7 @@ MODULE m_vacden
! vacuum charge density. speed up by r. wu 1992
! *************************************************************
CONTAINS
SUBROUTINE vacden(vacuum,stars,oneD,kpts,input,sym,cell,atoms,noco,banddos,&
SUBROUTINE vacden(vacuum,stars,oneD,kpts,input,sym,cell,atoms,noco,nococonv,banddos,&
gVacMap,we,ikpt,jspin,vz,ne,ev_list,lapw,evac,eig,den,zMat,dos)
!***********************************************************************
......@@ -54,6 +54,7 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_nococonv),INTENT(IN) :: nococonv
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
......@@ -262,12 +263,12 @@ CONTAINS
!---> Thus, the vaccum wavefunctions and the A- and B-coeff. (ac bc)
!---> have to be calculated for both spins on that call.
!---> setup the spin-spiral q-vector
qssbti(1,1) = - noco%qss(1)/2
qssbti(2,1) = - noco%qss(2)/2
qssbti(1,2) = + noco%qss(1)/2
qssbti(2,2) = + noco%qss(2)/2
qssbti(3,1) = - noco%qss(3)/2
qssbti(3,2) = + noco%qss(3)/2
qssbti(1,1) = - nococonv%qss(1)/2
qssbti(2,1) = - nococonv%qss(2)/2
qssbti(1,2) = + nococonv%qss(1)/2
qssbti(2,2) = + nococonv%qss(2)/2
qssbti(3,1) = - nococonv%qss(3)/2
qssbti(3,2) = + nococonv%qss(3)/2
DO ispin = 1,input%jspins
! -----> set up vacuum wave functions
IF (oneD%odi%d1) THEN
......
......@@ -29,4 +29,5 @@ cdn_mt/setabc1locdn1.f90
cdn_mt/calcDenCoeffs.f90
cdn_mt/magnMomFromDen.f90
cdn_mt/alignSpinAxisMagn.f90
cdn_mt/magMultipoles.F90
)
MODULE m_abcof
CONTAINS
SUBROUTINE abcof(input,atoms,sym, cell,lapw,ne,usdus,&
noco,jspin,oneD, acof,bcof,ccof,zMat,eig,force)
noco,nococonv,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
......@@ -22,6 +22,7 @@ CONTAINS
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_nococonv),INTENT(IN):: nococonv
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
......@@ -49,7 +50,7 @@ CONTAINS
! .. Local Arrays ..
INTEGER nbasf0(atoms%nlod,atoms%nat)
REAL dfj(0:atoms%lmaxd),fj(0:atoms%lmaxd),fg(3),fgp(3),fgr(3),fk(3),fkp(3),fkr(3)
REAL alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod)
REAL alo1(atoms%nlod,input%jspins),blo1(atoms%nlod,input%jspins),clo1(atoms%nlod,input%jspins)
COMPLEX ylm( (atoms%lmaxd+1)**2 )
COMPLEX ccchi(2,2)
LOGICAL enough(atoms%nat),apw(0:atoms%lmaxd,atoms%ntype)
......@@ -105,9 +106,9 @@ CONTAINS
nvmax=lapw%nv(jspin)
IF (noco%l_ss) nvmax=lapw%nv(iintsp)
IF (iintsp .EQ. 1) THEN
qss= - noco%qss/2
qss= - nococonv%qss/2
ELSE
qss= + noco%qss/2
qss= + nococonv%qss/2
ENDIF
!---> loop over atom types
......@@ -115,11 +116,11 @@ 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,iintsp,eig,l_force,&
!$OMP& SHARED(noco,nococonv,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,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)
! ----> loop over equivalent atoms
DO nn = 1,atoms%neq(n)
natom = 0
......@@ -145,10 +146,10 @@ CONTAINS
IF (noco%l_noco) THEN
!---> generate the spinors (chi)
ccchi(1,1) = EXP(ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
ccchi(1,2) = -EXP(ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
ccchi(2,1) = EXP(-ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
ccchi(2,2) = EXP(-ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
ccchi(1,1) = EXP(ImagUnit*nococonv%alph(n)/2)*COS(nococonv%beta(n)/2)
ccchi(1,2) = -EXP(ImagUnit*nococonv%alph(n)/2)*SIN(nococonv%beta(n)/2)
ccchi(2,1) = EXP(-ImagUnit*nococonv%alph(n)/2)*SIN(nococonv%beta(n)/2)
ccchi(2,2) = EXP(-ImagUnit*nococonv%alph(n)/2)*COS(nococonv%beta(n)/2)
IF (noco%l_ss) THEN
!---> the coefficients of the spin-down basis functions are
!---> stored in the second half of the eigenvector
......@@ -282,14 +283,14 @@ CONTAINS
DO nkvec=1,lapw%nkvec(lo,natom)
IF (k==lapw%kvec(nkvec,lo,natom)) THEN !check if this k-vector has LO attached
CALL abclocdn(atoms,sym,noco,lapw,cell,ccchi(:,jspin),iintsp,phase,ylm,&
n,natom,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,l_force,fgp,force)
n,natom,k,nkvec,lo,ne,alo1(:,jspin),blo1(:,jspin),clo1(:,jspin),acof,bcof,ccof,zMat,l_force,fgp,force)
ENDIF
ENDDO
END DO
ENDDO ! loop over LAPWs
IF (zmat%l_real) THEN
DEALLOCATE(work_r)
ELSE
ELSE
DEALLOCATE(work_c)
ENDIF
ENDIF ! invsatom == ( 0 v 1 )
......
......@@ -21,10 +21,11 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
,sym,oneD,cell,noco,input,atoms,den)
,sym,oneD,cell,noco,nococonv,input,atoms,den)
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_nococonv),INTENT(INOUT):: nococonv
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_sphhar),INTENT(IN) :: sphhar
......@@ -35,65 +36,25 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
REAL :: moments(3,atoms%ntype)
REAL :: phiTemp(atoms%ntype),thetaTemp(atoms%ntype)
INTEGER :: i
!!TEMP
! REAL :: x,y,z
phiTemp=noco%alph
thetaTemp=noco%beta
CALL magnMomFromDen(input,atoms,noco,den,moments,thetaTemp,phiTemp)
!DO i=1, atoms%ntype
! IF (abs(atoms%theta_mt_avg(i)).LE. 0.0001) 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,-phiTemp,-thetaTemp,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(noco%alph+phiTemp,2*pimach())
noco%beta=mod(noco%beta+thetaTemp,pimach())
!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