Commit 56f2806b authored by Daniel Wortmann's avatar Daniel Wortmann

Made phi/theta scalars again. Was a bad idea before...

parent 5ac85144
......@@ -26,8 +26,8 @@ SUBROUTINE orbMagMoms(dimension,atoms,noco,clmom)
CHARACTER(LEN=20) :: attributes(4)
thetai = noco%theta(1) !only single spin-qant-axis supported here
phii = noco%phi(1)
thetai = noco%theta
phii = noco%phi
WRITE (6,FMT=9020)
WRITE (16,FMT=9020)
CALL openXMLElement('orbitalMagneticMomentsInMTSpheres',(/'units'/),(/'muBohr'/))
......
......@@ -105,14 +105,13 @@ CONTAINS
CALL timestart("eigenso: spnorb")
! ..
IF (SIZE(noco%theta)>1) CALL judft_warn("only first SOC-angle used in second variation")
!Get spin-orbit coupling matrix elements
CALL spnorb( atoms,noco,input,mpi, enpara,vTot%mt,usdus,rsoc,.TRUE.)
!
ALLOCATE( eig_so(2*DIMENSION%neigd) )
rsoc%soangl(:,:,:,:,:,:,1) = CONJG(rsoc%soangl(:,:,:,:,:,:,1))
rsoc%soangl(:,:,:,:,:,:) = CONJG(rsoc%soangl(:,:,:,:,:,:))
CALL timestop("eigenso: spnorb")
!
!---> loop over k-points: each can be a separate task
......
......@@ -78,9 +78,9 @@ CONTAINS
c_a(m,l,na) = CMPLX(0.,0.)
c_b(m,l,na) = CMPLX(0.,0.)
DO m1 = -l,l
c_a(m,l,na) = c_a(m,l,na) + rsoc%soangl(l,m,i1,l,m1,j1,1)&
c_a(m,l,na) = c_a(m,l,na) + rsoc%soangl(l,m,i1,l,m1,j1)&
*CONJG(ahelp(m1,l,na,j,jsp1))
c_b(m,l,na) = c_b(m,l,na) + rsoc%soangl(l,m,i1,l,m1,j1,1)&
c_b(m,l,na) = c_b(m,l,na) + rsoc%soangl(l,m,i1,l,m1,j1)&
*CONJG(bhelp(m1,l,na,j,jsp1))
ENDDO
ENDDO
......@@ -93,7 +93,7 @@ CONTAINS
c_c(m,ilo,na) = CMPLX(0.,0.)
DO m1 = -l,l
c_c(m,ilo,na) = c_c(m,ilo,na) + CONJG(&
chelp(m1,j,ilo,na,jsp1))*rsoc%soangl(l,m,i1,l,m1,j1,1)
chelp(m1,j,ilo,na,jsp1))*rsoc%soangl(l,m,i1,l,m1,j1)
ENDDO
ENDDO
ENDIF
......
......@@ -34,7 +34,7 @@ CONTAINS
REAL, INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
! ..
! .. Local Scalars ..
INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n,nr
INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
LOGICAL, SAVE :: first_k = .TRUE.
! ..
! .. Local Arrays ..
......@@ -54,7 +54,7 @@ CONTAINS
ALLOCATE(rsoc%rsopplo (atoms%ntype,atoms%nlod,2,2));rsoc%rsopplo=0.0
ALLOCATE(rsoc%rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2));rsoc%rsoploplop=0.0
IF (l_angles) ALLOCATE(rsoc%soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,&
atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,SIZE(noco%theta)))
atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2))
!Calculate radial soc-matrix elements
DO n = 1,atoms%ntype
......@@ -99,13 +99,12 @@ CONTAINS
IF (.NOT.l_angles) RETURN
DO nr=1,SIZE(noco%theta)
IF ((ABS(noco%theta(nr)).LT.0.00001).AND.(ABS(noco%phi(nr)).LT.0.00001)) THEN
!
! TEST for real function sgml(l1,m1,is1,l2,m2,is2)
!
DO l1 = 1,atoms%lmaxd
IF ((ABS(noco%theta).LT.0.00001).AND.(ABS(noco%phi).LT.0.00001)) THEN
!
! TEST for real function sgml(l1,m1,is1,l2,m2,is2)
!
DO l1 = 1,atoms%lmaxd
DO l2 = 1,atoms%lmaxd
DO jspin1 = 1,2
DO jspin2 = 1,2
......@@ -113,7 +112,7 @@ CONTAINS
is2=ispjsp(jspin2)
DO m1 = -l1,l1,1
DO m2 = -l2,l2,1
rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2,nr) =&
rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2) =&
CMPLX(sgml(l1,m1,is1,l2,m2,is2),0.0)
ENDDO
ENDDO
......@@ -121,7 +120,7 @@ CONTAINS
ENDDO
ENDDO
ENDDO
ELSE
!
! TEST for complex function anglso(teta,phi,l1,m1,is1,l2,m2,is2)
......@@ -135,8 +134,8 @@ CONTAINS
!
DO m1 = -l1,l1,1
DO m2 = -l2,l2,1
rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2,nr) =&
anglso(noco%theta(nr),noco%phi(nr),l1,m1,is1,l2,m2,is2)
rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2) =&
anglso(noco%theta,noco%phi,l1,m1,is1,l2,m2,is2)
ENDDO
ENDDO
!
......@@ -146,20 +145,19 @@ CONTAINS
ENDDO
!
ENDIF
IF (mpi%irank.EQ.0) THEN
WRITE (6,FMT=8002) nr
WRITE (6,FMT=8002)
DO jspin1 = 1,2
DO jspin2 = 1,2
WRITE (6,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2
WRITE (6,FMT='(7x,7i8)') (m1,m1=-3,3,1)
WRITE (6,FMT=8003) (m2, (rsoc%soangl(3,m1,jspin1,3,m2,jspin2,nr),&
WRITE (6,FMT=8003) (m2, (rsoc%soangl(3,m1,jspin1,3,m2,jspin2),&
m1=-3,3,1),m2=-3,3,1)
ENDDO
ENDDO
ENDIF
ENDDO
8002 FORMAT (' so - angular matrix elements for config No:',i0)
8002 FORMAT (' so - angular matrix elements')
8003 FORMAT (i8,14f8.4)
END SUBROUTINE spnorb
......
......@@ -89,7 +89,7 @@ CONTAINS
CHARACTER(LEN=12):: attributes(3)
!Now output the results
call closeXMLElement('Forcetheorem_Loop_MAE')
CALL openXMLElementPoly('Forcetheorem_MAE',(/'Angles'/),(/SIZE(this.evsum)/))
CALL openXMLElementPoly('Forcetheorem_MAE',(/'Angles'/),(/SIZE(this%evsum)/))
DO n=1,SIZE(this%evsum)
WRITE(attributes(1),'(f12.7)') this%theta(n)
WRITE(attributes(2),'(f12.7)') this%phi(n)
......
......@@ -104,7 +104,7 @@
& noel(atoms%ntype),vacuum%izlay(vacuum%layerd,2),atoms%ncst(atoms%ntype),atoms%lnonsph(atoms%ntype),&
& atoms%taual(3,atoms%nat),atoms%pos(3,atoms%nat),&
& atoms%nz(atoms%ntype),atoms%relax(3,atoms%ntype),&
& atoms%l_geo(atoms%ntype),noco%theta(1),noco%phi(1),noco%alph(atoms%ntype),noco%beta(atoms%ntype),&
& atoms%l_geo(atoms%ntype),noco%alph(atoms%ntype),noco%beta(atoms%ntype),&
& atoms%lda_u(atoms%ntype),noco%l_relax(atoms%ntype),jij%l_magn(atoms%ntype),jij%M(atoms%ntype),&
& jij%magtype(atoms%ntype),jij%nmagtype(atoms%ntype),noco%b_con(2,atoms%ntype),&
& sphhar%clnu(1,1,1),sphhar%nlh(1),sphhar%llh(1,1),sphhar%nmem(1,1),sphhar%mlh(1,1,1),&
......@@ -256,7 +256,7 @@
IF (noco%l_soc .and. (.not.noco%l_noco)) THEN
! test symmetry for spin-orbit coupling
ALLOCATE ( error(sym%nop) )
CALL soc_sym(sym%nop,sym%mrot,noco%theta(1),noco%phi(1),cell%amat,error)
CALL soc_sym(sym%nop,sym%mrot,noco%theta,noco%phi,cell%amat,error)
IF ( ANY(error(:)) ) THEN
WRITE(*,fmt='(1x)')
WRITE(*,fmt='(A)') 'Symmetry incompatible with SOC spin-quantization axis ,'
......
......@@ -58,7 +58,7 @@
IF (noco%l_soc) THEN ! check once more here...
CALL soc_sym(&
& sym%nop,sym%mrot,noco%theta(1),noco%phi(1),cell%amat,&
& sym%nop,sym%mrot,noco%theta,noco%phi,cell%amat,&
& error)
ELSE
error(:) = .false.
......
......@@ -227,7 +227,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
na = 1
DO iType = 1,atoms%ntype
noco%phi = tpi_const*dot_product(noco%qss,atoms%taual(:,na))
noco%alph(iType) = noco%alphInit(iType) + noco%phi(1)
noco%alph(iType) = noco%alphInit(iType) + noco%phi
na = na + atoms%neq(iType)
END DO
END IF
......
......@@ -89,7 +89,6 @@ PROGRAM inpgen
OPEN (bfh,file='bfh.txt',form='formatted',status='unknown')
noco%l_ss = .FALSE.
ALLOCATE(noco%theta(1),noco%phi(1)) !here we support only a single set of angles
CALL struct_input(&
& infh,errfh,warnfh,symfh,symfn,bfh,&
& natmax,nop48,&
......@@ -97,7 +96,7 @@ PROGRAM inpgen
& title,input%film,cal_symm,checkinp,sym%symor,&
& cartesian,oldfleur,a1,a2,a3,vacuum%dvac,aa,scale,i_c,&
& factor,natin,atomid,atompos,ngen,mmrot,ttr,atomLabel,&
& l_hyb,noco%l_soc,noco%l_ss,noco%theta(1),noco%phi(1),noco%qss,inistop)!keep
& l_hyb,noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,inistop)!keep
! CLOSE (5)
......@@ -126,7 +125,7 @@ PROGRAM inpgen
WRITE (6,'(3i5,f8.3)') (mmrot(2,j,i),j=1,3),ttr(2,i)
WRITE (6,'(3i5,f8.3)') (mmrot(3,j,i),j=1,3),ttr(3,i)
ENDDO
IF (noco%l_soc) WRITE(6,'(a4,2f10.5)') 'soc:',noco%theta(1),noco%phi(1)
IF (noco%l_soc) WRITE(6,'(a4,2f10.5)') 'soc:',noco%theta,noco%phi
IF (noco%l_ss) WRITE(6,'(a4,3f10.5)') 'qss:',noco%qss(:)
!
! --> generate symmetry from input (atomic positions, generators or whatever)
......@@ -143,7 +142,7 @@ PROGRAM inpgen
IF (noco%l_ss.OR.noco%l_soc) THEN
CALL soc_or_ssdw(&
& noco%l_soc,noco%l_ss,noco%theta(1),noco%phi(1),noco%qss,cell%amat,&
& noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,cell%amat,&
& sym%mrot,sym%tau,sym%nop,sym%nop2,atoms%nat,atomid,atompos,&
& mmrot,ttr,no3,no2,atoms%ntype,atoms%neq,natmap,&
& ntyrep,natype,natrep,atoms%zatom,atoms%pos)
......
......@@ -56,7 +56,7 @@
iatom = 1
DO itype = 1,atoms%ntype
noco%phi = tpi_const*dot_product(noco%qss,atoms%taual(:,iatom))
noco%alph(itype) = noco%alph(itype) + noco%phi(1)
noco%alph(itype) = noco%alph(itype) + noco%phi
iatom = iatom + atoms%neq(itype)
ENDDO
ENDIF
......
......@@ -509,13 +509,10 @@ SUBROUTINE r_inpXML(&
noco%phi = 0.0
IF (numberNodes.EQ.1) THEN
valueString=xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@theta')
CALL evaluateList(noco%theta,valueString)
valueString=xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@phi')
CALL evaluateList(noco%phi,valueString)
noco%theta=evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@theta'))
noco%phi=evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@phi'))
noco%l_soc = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@l_soc'))
noco%l_spav = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@spav'))
IF (SIZE(noco%theta).NE.SIZE(noco%phi)) CALL judft_error("Inequal length of list for soc-angles")
END IF
! Read in optional noco parameters if present
......@@ -577,8 +574,6 @@ SUBROUTINE r_inpXML(&
END IF
END IF
IF (SIZE(noco%theta)>1.AND..NOT.(noco%l_ss.AND.noco%l_soc)) CALL judft_warn("Multiple soc-angles only for l_soc&l_ss implemented")
! Read in optional 1D parameters if present
xPathA = '/fleurInput/calculationSetup/oneDParams'
......
......@@ -523,17 +523,17 @@
READ(5,fmt='(A)',END=99,ERR=99) line
BACKSPACE(5)
IF (line(9:10)=='pi') THEN
READ(5,fmt='(f8.4)') noco%theta(1)
READ(5,fmt='(f8.4)') noco%theta
noco%theta= noco%theta*4.*ATAN(1.)
ELSE
READ(5,fmt='(f10.6)',END=99,ERR=99) noco%theta(1)
READ(5,fmt='(f10.6)',END=99,ERR=99) noco%theta
ENDIF
BACKSPACE(5)
IF (line(19:20)=='pi') THEN
READ(5,fmt='(10x,f8.4)',END=99,ERR=99) noco%phi(1)
READ(5,fmt='(10x,f8.4)',END=99,ERR=99) noco%phi
noco%phi= noco%phi*4.*ATAN(1.)
ELSE
READ(5,fmt='(10x,f10.6)',END=99,ERR=99) noco%phi(1)
READ(5,fmt='(10x,f10.6)',END=99,ERR=99) noco%phi
ENDIF
IF ( line(30:34)=='spav=' ) THEN
BACKSPACE(5)
......
......@@ -193,21 +193,10 @@ SUBROUTINE w_inpXML(&
140 FORMAT(' <magnetism jspins="',i0,'" l_noco="',l1,'" l_J="',l1,'" swsp="',l1,'" lflip="',l1,'"/>')
WRITE (fileNum,140) input%jspins,noco%l_noco,jij%l_J,input%swsp,input%lflip
! <soc theta="0.00000" phi="0.00000" l_soc="F" spav="F" off="F" soc66="F"/>
150 FORMAT(' <soc theta="')
151 FORMAT('" phi="')
152 FORMAT('" l_soc="',l1,'" spav="',l1'"/>')
WRITE (fileNum,150,advance="NO")
DO i=1,SIZE(noco%theta)
WRITE(fileNum,"(f0.8)",advance="NO") noco%theta(i)
IF (i<size(noco%theta)) WRITE(fileNum,"(a1)",advance="NO") " "
ENDDO
WRITE (fileNum,151,advance="NO")
DO i=1,SIZE(noco%phi)
WRITE(fileNum,"(f0.8)",advance="NO") noco%phi(i)
IF (i<size(noco%theta)) WRITE(fileNum,"(a1)",advance="NO") " "
ENDDO
WRITE (fileNum,152) noco%l_soc,noco%l_spav
! <soc theta="0.00000" phi="0.00000" l_soc="F" spav="F" off="F" soc66="F"/>
150 FORMAT(' <soc theta="',f0.8,'" phi="',f0.8,'" l_soc="',l1,'" spav="',l1,'"/>')
WRITE (fileNum,150) noco%theta,noco%phi,noco%l_soc,noco%l_spav
IF (l_nocoOpt.OR.l_explicit) THEN
160 FORMAT(' <nocoParams l_ss="',l1,'" l_mperp="',l1,'" l_constr="',l1,'" l_disp="',l1,&
......
......@@ -162,7 +162,6 @@
sliceplot%nnne = 0
IF (input%l_inpXML) THEN
ALLOCATE(noco%theta(1),noco%phi(1))
ALLOCATE(noel(1))
IF (mpi%irank.EQ.0) THEN
......@@ -226,7 +225,6 @@
jij%nmagn=1
jij%mtypes=1
jij%phnd=1
ALLOCATE(noco%theta(1),noco%phi(1))
!--- J>
CALL dimens(mpi,input,sym,stars,atoms,sphhar,DIMENSION,vacuum,&
......
......@@ -394,8 +394,8 @@ MODULE m_types_setup
REAL, ALLOCATABLE :: b_con(:,:)
LOGICAL :: l_soc
LOGICAL :: l_spav
REAL, ALLOCATABLE :: theta(:)
REAL, ALLOCATABLE :: phi(:)
REAL :: theta
REAL :: phi
REAL,ALLOCATABLE :: socscale(:)
END TYPE t_noco
......
......@@ -11,7 +11,7 @@ MODULE m_types_tlmplm
REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: rsopp,rsoppd,rsopdp,rsopdpd !(atoms%ntype,atoms%lmaxd,2,2)
REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: rsoplop,rsoplopd,rsopdplo,rsopplo!(atoms%ntype,atoms%nlod,2,2)
REAL,ALLOCATABLE,DIMENSION(:,:,:,:,:) :: rsoploplop !(atoms%ntype,atoms%nlod,nlod,2,2)
COMPLEX,ALLOCATABLE,DIMENSION(:,:,:,:,:,:,:)::soangl
COMPLEX,ALLOCATABLE,DIMENSION(:,:,:,:,:,:)::soangl
END TYPE t_rsoc
TYPE t_tlmplm
......
......@@ -102,7 +102,7 @@ c ..scalar arguments..
integer, intent (in) :: irank,isize,nv2d,nmzxy,nmz
integer, intent (in) :: memd,lmplmd,nparampts
real, intent (in) :: omtil,e1s,e2s,delz,area,z1,volint
real, intent (in) :: ef,theta(:),phi(:),aux_latt_const
real, intent (in) :: ef,theta,phi,aux_latt_const
c ..array arguments..
logical, intent (in) :: l_dulo(nlod,ntypd)
......@@ -652,8 +652,8 @@ c*****************************************************************c
qpt_i = qss
alph_i = alph
beta_i = beta
theta_i = theta(1)
phi_i = phi(1)
theta_i = theta
phi_i = phi
if(l_sgwf.or.l_ms) then
qpt_i(:) = param_vec(:,qptibz)
alph_i(:) = param_alpha(:,qptibz)
......
......@@ -103,7 +103,7 @@ c ..scalar arguments..
integer, intent (in) :: irank,isize,nv2d,nmzxy,nmz
integer, intent (in) :: memd,lmplmd,nparampts
real, intent (in) :: omtil,e1s,e2s,delz,area,z1,volint
real, intent (in) :: ef,theta(:),phi(:),aux_latt_const
real, intent (in) :: ef,theta,phi,aux_latt_const
c ..array arguments..
logical, intent (in) :: l_dulo(nlod,ntypd)
......@@ -650,8 +650,8 @@ c*****************************************************************c
qpt_i = qss
alph_i = alph
beta_i = beta
theta_i = theta(1)
phi_i = phi(1)
theta_i = theta
phi_i = phi
if(l_sgwf.or.l_ms) then
qpt_i(:) = param_vec(:,qptibz)
alph_i(:) = param_alpha(:,qptibz)
......@@ -1090,8 +1090,8 @@ c***********************************************************
qptb_i = qss
alphb_i = alph
betab_i = beta
thetab_i = theta(1)
phib_i = phi(1)
thetab_i = theta
phib_i = phi
if(l_dim(2)) phib_i = tpi*param_vec(2,qptibz_b)
if(l_dim(3)) thetab_i = tpi*param_vec(3,qptibz_b)
......
......@@ -421,7 +421,7 @@ c-----input file for orbital decomposition
> cell%volint,sym%symor,atoms%pos,results%ef,noco%l_soc,
> sphhar%memd,atoms%lnonsph,sphhar%clnu,DIMENSION%lmplmd,
> sphhar%mlh,sphhar%nmem,sphhar%llh,atoms%lo1l,
> noco%theta(1),noco%phi(1))
> noco%theta,noco%phi)
DO pc = 1, wann%nparampts
CALL close_eig(eig_idList(pc))
......@@ -818,8 +818,8 @@ c*****************************************************************c
qpt_i = noco%qss
alph_i = noco%alph
beta_i = noco%beta
theta_i = noco%theta(1)
phi_i = noco%phi(1)
theta_i = noco%theta
phi_i = noco%phi
if(wann%l_sgwf.or.wann%l_ms) then
qpt_i(:) = wann%param_vec(:,qptibz)
alph_i(:) = wann%param_alpha(:,qptibz)
......@@ -1962,8 +1962,8 @@ c*******************************************c
qptb_i = noco%qss
alphb_i = noco%alph
betab_i = noco%beta
thetab_i = noco%theta(1)
phib_i = noco%phi(1)
thetab_i = noco%theta
phib_i = noco%phi
if(wann%l_sgwf) then
qptb_i(:) = wann%param_vec(:,qptibz_b)
alphb_i(:) = wann%param_alpha(:,qptibz_b)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment