Skip to content

GitLab

fleur
fleur
Commit ad08f475 authored by Daniel Wortmann's avatar Daniel Wortmann
1 Browse files
Options

ATTENTION, HUGE COMMIT! Spitted noco type into noco&nococonv type. Made many types more INTENT(IN).

parent 078fc1c4
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1369 additions and 1219 deletions
cdn/cdnval.F90
View file @ ad08f475
......@@ -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
......
cdn/genNewNocoInp.f90
View file @ ad08f475
......@@ -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
......
cdn/m_perp.f90
View file @ ad08f475
......@@ -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,&
......
cdn/qal_21.f90
View file @ ad08f475
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,:)
......
cdn/vacden.F90
View file @ ad08f475
......@@ -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
......
cdn_mt/abcof.F90
View file @ ad08f475
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
......@@ -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
......@@ -289,7 +290,7 @@ CONTAINS
ENDDO ! loop over LAPWs
IF (zmat%l_real) THEN
DEALLOCATE(work_r)
ELSE
ELSE
DEALLOCATE(work_c)
ENDIF
ENDIF ! invsatom == ( 0 v 1 )
......
cdn_mt/alignSpinAxisMagn.f90
View file @ ad08f475
......@@ -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
......@@ -36,12 +37,12 @@ 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
phiTemp=nococonv%alph
thetaTemp=nococonv%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
......@@ -67,33 +68,34 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
!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())
nococonv%alph=mod(nococonv%alph+phiTemp,2*pimach())
nococonv%beta=mod(nococonv%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
! IF(nococonv%alph(i)<0) nococonv%alph(i)=nococonv%alph(i)+2*pi
! IF(nococonv%beta(i)<0) THEN
! nococonv%beta(i)=-nococonv%beta(i)
! nococonv%alph=nococonv%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
! IF(nococonv%beta(i)>pi) THEN
! nococonv%beta(i)=pi-mod(nococonv%beta(i),pi)
! nococonv%alph(i)=nococonv%alph(i)+pi
! END IF
! noco%alph=mod(noco%alph,2*pi)
! nococonv%alph=mod(nococonv%alph,2*pi)
!End Do
write(*,*) "Noco Phi"
write(*,*) noco%alph
write(*,*) nococonv%alph
write(*,*) "Noco Theta"
write(*,*) noco%beta
write(*,*) nococonv%beta
END SUBROUTINE rotateMagnetToSpinAxis
SUBROUTINE rotateMagnetFromSpinAxis(noco,vacuum,sphhar,stars&
SUBROUTINE rotateMagnetFromSpinAxis(noco,nococonv,vacuum,sphhar,stars&
,sym,oneD,cell,input,atoms,den,inDen)
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_stars),INTENT(IN) :: stars
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
TYPE(t_sym),INTENT(IN) :: sym
......@@ -102,11 +104,11 @@ SUBROUTINE rotateMagnetFromSpinAxis(noco,vacuum,sphhar,stars&
TYPE(t_potden), INTENT(INOUT) :: den, inDen
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,noco%alph,noco%beta,den)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,noco%alph,noco%beta,inDen)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,nococonv%alph,nococonv%beta,den)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,nococonv%alph,nococonv%beta,inDen)
noco%alph=0
noco%beta=0
nococonv%alph=0
nococonv%beta=0
END SUBROUTINE rotateMagnetFromSpinAxis
......
cdn_mt/cdncore.F90
View file @ ad08f475
......@@ -8,7 +8,7 @@ MODULE m_cdncore
CONTAINS
SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,sym,&
SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,nococonv,sym,&
stars,cell,sphhar,atoms,vTot,outDen,moments,results, EnergyDen)
USE m_constants
......@@ -29,11 +29,12 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,sym,&
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_oneD), INTENT(IN) :: oneD
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
......@@ -121,13 +122,13 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,sym,&
rhoint = (qint(iType,1) + qint(iType,2)) /(cell%volint * input%jspins * 2.0)
momint = (qint(iType,1) - qint(iType,2)) /(cell%volint * input%jspins * 2.0)
!rho_11
outDen%pw(1,1) = outDen%pw(1,1) + rhoint + momint*cos(noco%beta(iType))
outDen%pw(1,1) = outDen%pw(1,1) + rhoint + momint*cos(nococonv%beta(iType))
!rho_22
outDen%pw(1,2) = outDen%pw(1,2) + rhoint - momint*cos(noco%beta(iType))
outDen%pw(1,2) = outDen%pw(1,2) + rhoint - momint*cos(nococonv%beta(iType))
!real part rho_21
outDen%pw(1,3) = outDen%pw(1,3) + cmplx( 0.5*momint *cos(noco%alph(iType))*sin(noco%beta(iType)),&
outDen%pw(1,3) = outDen%pw(1,3) + cmplx( 0.5*momint *cos(nococonv%alph(iType))*sin(nococonv%beta(iType)),&
!imaginary part rho_21
-0.5*momint *sin(noco%alph(iType))*sin(noco%beta(iType)))
-0.5*momint *sin(nococonv%alph(iType))*sin(nococonv%beta(iType)))
END DO
!pk non-collinear (end)
END IF
......
cdn_mt/magDiMom.f90
View file @ ad08f475
......@@ -15,7 +15,7 @@ CONTAINS
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE magDiMom(sym,input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles)
SUBROUTINE magDiMom(sym,input,atoms,sphhar,noco,nococonv,l_fmpl2,rho,magDipoles,elecDipoles)
USE m_constants
USE m_types
......@@ -31,6 +31,7 @@ SUBROUTINE magDiMom(sym,input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipol
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_nococonv), INTENT(IN) :: nococonv
REAL, INTENT(IN) :: rho(:,0:,:,:) ! if l_fmpl last dimension is 4, otherwise 2.
LOGICAL, INTENT(IN) :: l_fmpl2
......@@ -56,8 +57,8 @@ SUBROUTINE magDiMom(sym,input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipol
ALLOCATE(inRho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,4))
DO iType = 1,atoms%ntype
IF (.NOT.l_fmpl2) THEN
theta = noco%beta(iType)
phi = noco%alph(iType)
theta = nococonv%beta(iType)
phi = nococonv%alph(iType)
inRho(:,:,iType,1) = rho(:,:,iType,1) + rho(:,:,iType,2)
inRho(:,:,iType,2) = rho(:,:,iType,1) - rho(:,:,iType,2)