Skip to content

fleur
fleur
Commit 3e24dd1b authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Modified the SOC part. Some routines can still be deleted. theta/phi are arrays now for 

DMI calculations.
parent ebc860cc
Hide whitespace changes
Inline Side-by-side
Showing with 257 additions and 478 deletions
cdn_mt/orbMagMoms.f90
View file @ 3e24dd1b
......@@ -25,8 +25,9 @@ SUBROUTINE orbMagMoms(dimension,atoms,noco,clmom)
REAL :: thetai, phii, slmom, slxmom, slymom
CHARACTER(LEN=20) :: attributes(4)
thetai = noco%theta
phii = noco%phi
thetai = noco%theta(1) !only single spin-qant-axis supported here
phii = noco%phi(1)
WRITE (6,FMT=9020)
WRITE (16,FMT=9020)
CALL openXMLElement('orbitalMagneticMomentsInMTSpheres',(/'units'/),(/'muBohr'/))
......
core/coredr.F90
View file @ 3e24dd1b
......@@ -10,7 +10,6 @@ CONTAINS
USE m_spratm
USE m_ccdnup
USE m_cdn_io
USE m_types
IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: DIMENSION
......
diagonalization/scalapack.F90
View file @ 3e24dd1b
......@@ -93,9 +93,12 @@ CONTAINS
CALL ev_dist%init(hmat%l_real,hmat%global_size1,hmat%global_size2,hmat%mpi_com,.TRUE.)
smat%blacs_desc(2) = hmat%blacs_desc(2)
ev_dist%blacs_desc(2) = hmat%blacs_desc(2)
!smat%blacs_desc(2) = hmat%blacs_desc(2)
!ev_dist%blacs_desc(2) = hmat%blacs_desc(2)
smat%blacs_desc=hmat%blacs_desc
ev_dist%blacs_desc=hmat%blacs_desc
nb=hmat%blacs_desc(5)! Blocking factor
IF (nb.NE.hmat%blacs_desc(6)) CALL judft_error("Different block sizes for rows/columns not supported")
......
eigen/CMakeLists.txt
View file @ 3e24dd1b
......@@ -7,7 +7,6 @@ eigen/hlomat.F90
eigen/hs_int.F90
eigen/hsmt_fjgj.F90
eigen/hsmt_ab.f90
eigen/soc_init.f90
eigen/hsmt_sph.F90
eigen/hsmt_nonsph.F90
eigen/hsmt_spinor.F90
......
eigen/mt_setup.F90
View file @ 3e24dd1b
......@@ -12,7 +12,7 @@ CONTAINS
USE m_tlmplm_cholesky
USE m_tlmplm_store
USE m_types
USE m_socinit
USE m_spnorb
IMPLICIT NONE
TYPE(t_results),INTENT(INOUT):: results
TYPE(t_mpi),INTENT(IN) :: mpi
......@@ -48,7 +48,7 @@ CONTAINS
!Setup of soc parameters for first-variation SOC
IF (noco%l_soc.AND.noco%l_noco.AND..NOT.noco%l_ss) THEN
CALL socinit(mpi,atoms,sphhar,enpara,input,vTot%mt,noco,ud,td%rsoc)
CALL spnorb(atoms,noco,input,mpi,enpara,vTot%mt,ud,td%rsoc,.FALSE.)
END IF
END SUBROUTINE mt_setup
......
eigen_soc/CMakeLists.txt
View file @ 3e24dd1b
......@@ -7,9 +7,9 @@ eigen_soc/eigenso.F90
eigen_soc/hsoham.f90
eigen_soc/hsohelp.F90
eigen_soc/sgml.f90
eigen_soc/soinit.f90
eigen_soc/sointg.f90
eigen_soc/sorad.f90
eigen_soc/spnorb.f90
eigen_soc/vso.f90
eigen_soc/ssomat.F90
)
eigen_soc/alineso.F90
View file @ 3e24dd1b
......@@ -8,12 +8,8 @@ MODULE m_alineso
CONTAINS
SUBROUTINE alineso(eig_id,lapw,&
mpi,DIMENSION,atoms,sym,kpts,&
input,noco,cell,oneD,&
rsopp,rsoppd,rsopdp,rsopdpd,nk,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop,&
usdus,soangl,&
nsize,nmat,&
eig_so,zso)
input,noco,cell,oneD, nk, usdus,rsoc,&
nsize,nmat, eig_so,zso)
#include"cpp_double.h"
USE m_hsohelp
......@@ -32,6 +28,7 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_rsoc),INTENT(IN) :: rsoc
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: eig_id
......@@ -39,16 +36,6 @@ CONTAINS
INTEGER, INTENT (OUT):: nsize,nmat
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: rsopp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (IN) :: rsoppd (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (IN) :: rsopdp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (IN) :: rsopdpd(atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (IN) :: rsoplop (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (IN) :: rsoplopd(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (IN) :: rsopdplo(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (IN) :: rsopplo (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (IN) :: rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2)
COMPLEX, INTENT (IN) :: soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2)
COMPLEX, INTENT (OUT) :: zso(:,:,:)!(dimension%nbasfcn,2*dimension%neigd,wannierspin)
REAL, INTENT (OUT) :: eig_so(2*DIMENSION%neigd)
!-odim
......@@ -167,11 +154,7 @@ CONTAINS
CALL timestart("alineso SOC: -ham")
ALLOCATE ( hsomtx(2,2,DIMENSION%neigd,DIMENSION%neigd) )
CALL hsoham(&
& atoms,noco,input,nsz,chelp,&
& rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop,&
& ahelp,bhelp,rsopp,rsoppd,rsopdp,rsopdpd,soangl,&
& hsomtx)
CALL hsoham(atoms,noco,input,nsz,chelp, rsoc,ahelp,bhelp, hsomtx)
DEALLOCATE ( ahelp,bhelp,chelp )
CALL timestop("alineso SOC: -ham")
!
......
eigen_soc/eigenso.F90
View file @ 3e24dd1b
......@@ -27,6 +27,7 @@ CONTAINS
USE m_spnorb
USE m_alineso
USE m_types
USE m_judft
#ifdef CPP_MPI
USE m_mpi_bc_pot
#endif
......@@ -62,13 +63,9 @@ CONTAINS
! .. Local Arrays..
CHARACTER*3 chntype
REAL, ALLOCATABLE :: rsopdp(:,:,:,:),rsopdpd(:,:,:,:)
REAL, ALLOCATABLE :: rsopp(:,:,:,:),rsoppd(:,:,:,:)
TYPE(t_rsoc) :: rsoc
REAL, ALLOCATABLE :: eig_so(:)
REAL, ALLOCATABLE :: rsoplop(:,:,:,:)
REAL, ALLOCATABLE :: rsoplopd(:,:,:,:),rsopdplo(:,:,:,:)
REAL, ALLOCATABLE :: rsopplo(:,:,:,:),rsoploplop(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: zso(:,:,:),soangl(:,:,:,:,:,:)
COMPLEX, ALLOCATABLE :: zso(:,:,:)
TYPE(t_mat)::zmat
TYPE(t_lapw)::lapw
......@@ -107,88 +104,15 @@ CONTAINS
#endif
CALL timestart("eigenso: spnorb")
! ..
ALLOCATE( rsopdp(atoms%ntype,atoms%lmaxd,2,2),rsopdpd(atoms%ntype,atoms%lmaxd,2,2),&
rsopp(atoms%ntype,atoms%lmaxd,2,2),rsoppd(atoms%ntype,atoms%lmaxd,2,2),&
rsoplop(atoms%ntype,atoms%nlod,2,2),rsoplopd(atoms%ntype,atoms%nlod,2,2),&
rsopdplo(atoms%ntype,atoms%nlod,2,2),rsopplo(atoms%ntype,atoms%nlod,2,2),&
rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2),&
soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2) )
soangl(:,:,:,:,:,:) = CMPLX(0.0,0.0)
CALL spnorb( atoms,noco,input,mpi, enpara,vTot%mt, rsopp,rsoppd,rsopdp,rsopdpd,usdus,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop, soangl)
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.)
!
!Check if SOC is to be scaled for some atom
DO n=1,atoms%ntype
IF (ABS(noco%socscale(n)-1.0)>1.E-7) THEN
IF (mpi%irank==0) WRITE(6,*) "SOC scaled by ",noco%socscale(n)," for atom ",n
rsopp(n,:,:,:) = rsopp(n,:,:,:) * noco%socscale(n)
rsopdp(n,:,:,:) = rsopdp(n,:,:,:)* noco%socscale(n)
rsoppd(n,:,:,:) = rsoppd(n,:,:,:)* noco%socscale(n)
rsopdpd(n,:,:,:) = rsopdpd(n,:,:,:)* noco%socscale(n)
rsoplop(n,:,:,:) = rsoplop(n,:,:,:)* noco%socscale(n)
rsoplopd(n,:,:,:) = rsoplopd(n,:,:,:)* noco%socscale(n)
rsopdplo(n,:,:,:) = rsopdplo(n,:,:,:)* noco%socscale(n)
rsopplo(n,:,:,:) = rsopplo(n,:,:,:)* noco%socscale(n)
rsoploplop(n,:,:,:,:) = rsoploplop(n,:,:,:,:)* noco%socscale(n)
ENDIF
ENDDO
IF (mpi%irank==0) THEN
DO n = 1,atoms%ntype
WRITE (6,FMT=8000)
WRITE (6,FMT=9000)
WRITE (6,FMT=8001) (2*rsopp(n,l,1,1),l=1,3)
WRITE (6,FMT=8001) (2*rsopp(n,l,2,2),l=1,3)
WRITE (6,FMT=8001) (2*rsopp(n,l,2,1),l=1,3)
WRITE (6,FMT=8000)
WRITE (6,FMT=9000)
WRITE (6,FMT=8001) (2*rsoppd(n,l,1,1),l=1,3)
WRITE (6,FMT=8001) (2*rsoppd(n,l,2,2),l=1,3)
WRITE (6,FMT=8001) (2*rsoppd(n,l,2,1),l=1,3)
WRITE (6,FMT=8000)
WRITE (6,FMT=9000)
WRITE (6,FMT=8001) (2*rsopdp(n,l,1,1),l=1,3)
WRITE (6,FMT=8001) (2*rsopdp(n,l,2,2),l=1,3)
WRITE (6,FMT=8001) (2*rsopdp(n,l,2,1),l=1,3)
WRITE (6,FMT=8000)
WRITE (6,FMT=9000)
WRITE (6,FMT=8001) (2*rsopdpd(n,l,1,1),l=1,3)
WRITE (6,FMT=8001) (2*rsopdpd(n,l,2,2),l=1,3)
WRITE (6,FMT=8001) (2*rsopdpd(n,l,2,1),l=1,3)
ENDDO
ENDIF
8000 FORMAT (' spin - orbit parameter HR ')
8001 FORMAT (8f8.4)
9000 FORMAT (5x,' p ',5x,' d ', 5x, ' f ')
IF (mpi%irank==0) THEN
IF (noco%soc_opt(atoms%ntype+1)) THEN ! .OR. l_all) THEN
! IF (l_all) THEN
! WRITE (6,fmt='(A)') 'Only SOC contribution of certain'&
! //' atom types included in Hamiltonian.'
! ELSE
WRITE (chntype,'(i3)') atoms%ntype
WRITE (6,fmt='(A,2x,'//chntype//'l1)') 'SOC contributi'&
//'on of certain atom types included in Hamiltonian:',&
(noco%soc_opt(n),n=1,atoms%ntype)
! ENDIF
ELSE
WRITE(6,fmt='(A,1x,A)') 'SOC contribution of all atom'//&
' types inculded in Hamiltonian.'
ENDIF
IF (noco%soc_opt(atoms%ntype+2)) THEN
WRITE(6,fmt='(A)')&
'SOC Hamiltonian is constructed by neglecting B_xc.'
ENDIF
ENDIF
ALLOCATE( eig_so(2*DIMENSION%neigd) )
soangl(:,:,:,:,:,:) = CONJG(soangl(:,:,:,:,:,:))
rsoc%soangl(:,:,:,:,:,:,1) = CONJG(rsoc%soangl(:,:,:,:,:,:,1))
CALL timestop("eigenso: spnorb")
!
!---> loop over k-points: each can be a separate task
......@@ -207,9 +131,7 @@ CONTAINS
zso(:,:,:) = CMPLX(0.0,0.0)
CALL timestart("eigenso: alineso")
CALL alineso(eig_id,lapw, mpi,DIMENSION,atoms,sym,kpts,&
input,noco,cell,oneD, rsopp,rsoppd,rsopdp,rsopdpd,nk,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop,&
usdus,soangl, nsz,nmat, eig_so,zso)
input,noco,cell,oneD,nk,usdus,rsoc,nsz,nmat, eig_so,zso)
CALL timestop("eigenso: alineso")
IF (mpi%irank.EQ.0) THEN
WRITE (16,FMT=8010) nk,nsz
......@@ -234,11 +156,6 @@ CONTAINS
ENDIF ! (input%eonly) ELSE
deallocate(zso)
ENDDO ! DO nk
DEALLOCATE (eig_so,rsoploplop,rsopplo,rsopdplo,rsoplopd)
DEALLOCATE (rsoplop,rsopdp,rsopdpd,rsopp,rsoppd,soangl)
DEALLOCATE (usdus%us,usdus%dus,usdus%uds,usdus%duds,usdus%ulos,usdus%dulos,usdus%uulon,usdus%dulon,usdus%ddn)
RETURN
END SUBROUTINE eigenso
END MODULE m_eigenso
eigen_soc/hsoham.f90
View file @ 3e24dd1b
......@@ -7,32 +7,22 @@ MODULE m_hsoham
CONTAINS
SUBROUTINE hsoham(&
atoms,noco,input,nsz,chelp,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop,&
ahelp,bhelp,rsopp,rsoppd,rsopdp,rsopdpd,soangl,&
rsoc,ahelp,bhelp,&
hsomtx)
USE m_types
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_rsoc),INTENT(IN) :: rsoc
! ..
! .. Scalar Arguments ..
! ..
! .. Array Arguments ..
INTEGER, INTENT (IN) :: nsz(:)!(dimension%jspd)
REAL, INTENT (IN) :: rsopp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (IN) :: rsoppd (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (IN) :: rsopdp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (IN) :: rsopdpd(atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (IN) :: rsoplop (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (IN) :: rsoplopd(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (IN) :: rsopdplo(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (IN) :: rsopplo (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (IN) :: rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2)
COMPLEX, INTENT (IN) :: ahelp(-atoms%lmaxd:,:,:,:,:)!(-lmaxd:lmaxd,lmaxd,atoms%nat,dimension%neigd,dimension%jspd)
COMPLEX, INTENT (IN) :: bhelp(-atoms%lmaxd:,:,:,:,:)!(-lmaxd:lmaxd,lmaxd,atoms%nat,dimension%neigd,dimension%jspd)
COMPLEX, INTENT (IN) :: chelp(-atoms%llod :,:,:,:,:)!(-llod:llod ,dimension%neigd,atoms%nlod,atoms%nat ,dimension%jspd)
COMPLEX, INTENT (IN) :: soangl(:,-atoms%lmaxd:,:,:,-atoms%lmaxd:,:)!(lmaxd,-lmaxd:lmaxd,2,lmaxd,-lmaxd:lmaxd,2)
COMPLEX, INTENT (OUT):: hsomtx(:,:,:,:)!(2,2,dimension%neigd,neigd)
! ..
! .. Local Scalars ..
......@@ -64,10 +54,9 @@ CONTAINS
!$OMP PARALLEL DEFAULT(none)&
!$OMP PRIVATE(j,na,n,nn,l,m,m1,ilo,i,lwn,ilop)&
!$OMP PRIVATE(c_a,c_b,c_c,c_1,c_2,c_3,c_4,c_5) &
!$OMP SHARED(hsomtx,i1,jsp,j1,jsp1,nsz,atoms,soangl)&
!$OMP SHARED(hsomtx,i1,jsp,j1,jsp1,nsz,atoms)&
!$OMP SHARED(ahelp,bhelp,chelp,noco)&
!$OMP SHARED(rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop)&
!$OMP SHARED(rsopp,rsoppd,rsopdp,rsopdpd)
!$OMP SHARED(rsoc)
ALLOCATE ( c_b(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat),&
c_a(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat),&
......@@ -89,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) + soangl(l,m,i1,l,m1,j1)&
c_a(m,l,na) = c_a(m,l,na) + rsoc%soangl(l,m,i1,l,m1,j1,1)&
*CONJG(ahelp(m1,l,na,j,jsp1))
c_b(m,l,na) = c_b(m,l,na) + soangl(l,m,i1,l,m1,j1)&
c_b(m,l,na) = c_b(m,l,na) + rsoc%soangl(l,m,i1,l,m1,j1,1)&
*CONJG(bhelp(m1,l,na,j,jsp1))
ENDDO
ENDDO
......@@ -104,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))*soangl(l,m,i1,l,m1,j1)
chelp(m1,j,ilo,na,jsp1))*rsoc%soangl(l,m,i1,l,m1,j1,1)
ENDDO
ENDDO
ENDIF
......@@ -122,8 +111,6 @@ CONTAINS
!---> loop over each atom type
!
DO n = 1,atoms%ntype
IF ( (.NOT. noco%soc_opt(atoms%ntype+1)) .OR. noco%soc_opt(n) ) THEN
lwn = atoms%lmax(n)
!
!---> loop over equivalent atoms
......@@ -133,10 +120,10 @@ CONTAINS
DO l = 1,lwn
!
DO m = -l,l
c_1 = rsopp(n,l,i1,j1) * ahelp(m,l,na,i,jsp) +&
rsopdp(n,l,i1,j1) * bhelp(m,l,na,i,jsp)
c_2 = rsoppd(n,l,i1,j1) * ahelp(m,l,na,i,jsp) +&
rsopdpd(n,l,i1,j1) * bhelp(m,l,na,i,jsp)
c_1 = rsoc%rsopp(n,l,i1,j1) * ahelp(m,l,na,i,jsp) +&
rsoc%rsopdp(n,l,i1,j1) * bhelp(m,l,na,i,jsp)
c_2 = rsoc%rsoppd(n,l,i1,j1) * ahelp(m,l,na,i,jsp) +&
rsoc%rsopdpd(n,l,i1,j1) * bhelp(m,l,na,i,jsp)
hsomtx(i1,j1,i,j) = hsomtx(i1,j1,i,j) +&
c_1*c_a(m,l,na) + c_2*c_b(m,l,na)
ENDDO
......@@ -147,10 +134,10 @@ CONTAINS
l = atoms%llo(ilo,n)
IF (l.GT.0) THEN
DO m = -l,l
c_3 = rsopplo(n,ilo,i1,j1) *ahelp(m,l,na,i,jsp) +&
rsopdplo(n,ilo,i1,j1) *bhelp(m,l,na,i,jsp)
c_4 = rsoplop(n,ilo,i1,j1) *chelp(m,i,ilo,na,jsp)
c_5 =rsoplopd(n,ilo,i1,j1) *chelp(m,i,ilo,na,jsp)
c_3 = rsoc%rsopplo(n,ilo,i1,j1) *ahelp(m,l,na,i,jsp) +&
rsoc%rsopdplo(n,ilo,i1,j1) *bhelp(m,l,na,i,jsp)
c_4 = rsoc%rsoplop(n,ilo,i1,j1) *chelp(m,i,ilo,na,jsp)
c_5 =rsoc%rsoplopd(n,ilo,i1,j1) *chelp(m,i,ilo,na,jsp)
hsomtx(i1,j1,i,j) = hsomtx(i1,j1,i,j) + &
c_4*c_a(m,l,na) + c_5*c_b(m,l,na) +&
c_3*c_c(m,ilo,na)
......@@ -159,7 +146,7 @@ CONTAINS
IF (atoms%llo(ilop,n).EQ.l) THEN
DO m = -l,l
hsomtx(i1,j1,i,j) = hsomtx(i1,j1,i,j) + &
rsoploplop(n,ilop,ilo,i1,j1) * &
rsoc%rsoploplop(n,ilop,ilo,i1,j1) * &
chelp(m,i,ilop,na,jsp) * c_c(m,ilo,na)
ENDDO
ENDIF
......@@ -169,12 +156,7 @@ CONTAINS
! end lo's
ENDDO
ELSE
na = na + atoms%neq(n)
ENDIF
ENDDO
ENDDO
!
ENDDO
!!i
......
eigen_soc/soinit.f90
View file @ 3e24dd1b
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_soinit
!
!**********************************************************************
! 1. generates radial spin-orbit matrix elements:sorad
! 2. generates spin-angular spin-orbit matrix :soorb (not implemented)
! generates radial spin-orbit matrix elements:sorad
!**********************************************************************
!
CONTAINS
SUBROUTINE soinit(atoms,input,enpara, vr,spav,&
rsopp,rsoppd,rsopdp,rsopdpd,usdus,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop)
SUBROUTINE soinit(atoms,input,enpara, vr,spav,rsoc,usdus)
USE m_sorad
USE m_types
......@@ -16,7 +18,8 @@ CONTAINS
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(INOUT) :: usdus
TYPE(t_usdus),INTENT(INOUT):: usdus
TYPE(t_rsoc),INTENT(INOUT) :: rsoc
!
! .. Scalar Arguments ..
! ..
......@@ -25,15 +28,6 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
REAL, INTENT (OUT) :: rsopp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (OUT) :: rsoppd (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (OUT) :: rsopdp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (OUT) :: rsopdpd(atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (OUT) :: rsoplop (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (OUT) :: rsoplopd(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (OUT) :: rsopdplo(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (OUT) :: rsopplo (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (OUT) :: rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2)
! ..
! .. Local Scalars ..
INTEGER i,jspin,n
......@@ -41,7 +35,7 @@ CONTAINS
! .. Local Arrays ..
REAL vr0(atoms%jmtd,size(vr,4))
! ..
rsopp =0.0
rsoc%rsopp =0.0
rsoppd =0.0
rsopdp =0.0
rsopdpd=0.0
......
eigen_soc/sorad.f90
View file @ 3e24dd1b
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_sorad
USE m_juDFT
!*********************************************************************
! 1. generates radial spin-orbit matrix elements
! based on m.weinert's radsra and radsrd subroutines
! generates radial spin-orbit matrix elements
!*********************************************************************
CONTAINS
SUBROUTINE sorad(atoms,input,ntyp,vr,enpara,spav,&
rsopp,rsopdpd,rsoppd,rsopdp,usdus,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop)
SUBROUTINE sorad(atoms,input,ntyp,vr,enpara,spav,rsoc,usdus)
USE m_constants, ONLY : c_light
USE m_intgr, ONLY : intgr0
......@@ -18,9 +20,10 @@ CONTAINS
USE m_types
IMPLICIT NONE
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(INOUT) :: usdus
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(INOUT) :: usdus
TYPE(t_rsoc),INTENT(INOUT) :: rsoc
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ntyp
......@@ -28,15 +31,6 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: vr(:,:)!(atoms%jmtd,dimension%jspd),
REAL, INTENT (INOUT) :: rsopp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (INOUT) :: rsoppd (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (INOUT) :: rsopdp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (INOUT) :: rsopdpd(atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (INOUT) :: rsoplop (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (INOUT) :: rsoplopd(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (INOUT) :: rsopdplo(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (INOUT) :: rsopplo (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (INOUT) :: rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2)
! ..
! .. Local Scalars ..
REAL ddn1,e ,ulops,dulops,duds1
......@@ -113,10 +107,10 @@ CONTAINS
IF (l.GT.0) THEN ! there is no spin-orbit for s-states
DO i = 1, 2
DO j = 1, 2
rsopp(ntyp,l,i,j) = radso( p(:atoms%jri(ntyp),i), p(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsopdp(ntyp,l,i,j) = radso(pd(:atoms%jri(ntyp),i), p(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsoppd(ntyp,l,i,j) = radso( p(:atoms%jri(ntyp),i),pd(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsopdpd(ntyp,l,i,j) = radso(pd(:atoms%jri(ntyp),i),pd(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsoc%rsopp(ntyp,l,i,j) = radso( p(:atoms%jri(ntyp),i), p(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsoc%rsopdp(ntyp,l,i,j) = radso(pd(:atoms%jri(ntyp),i), p(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsoc%rsoppd(ntyp,l,i,j) = radso( p(:atoms%jri(ntyp),i),pd(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsoc%rsopdpd(ntyp,l,i,j) = radso(pd(:atoms%jri(ntyp),i),pd(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
ENDDO
ENDDO
ENDIF ! l>0
......@@ -171,10 +165,10 @@ CONTAINS
DO i = 1, 2
DO j = 1, 2
rsoplop (ntyp,ilo,i,j) = radso(plo(:atoms%jri(ntyp),i),p (:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsoplopd(ntyp,ilo,i,j) = radso(plo(:atoms%jri(ntyp),i),pd(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp), atoms%rmsh(1,ntyp))
rsopplo (ntyp,ilo,i,j) = radso(p (:atoms%jri(ntyp),i),plo(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp), atoms%rmsh(1,ntyp))
rsopdplo(ntyp,ilo,i,j) = radso(pd(:atoms%jri(ntyp),i),plo(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp), atoms%rmsh(1,ntyp))
rsoc%rsoplop (ntyp,ilo,i,j) = radso(plo(:atoms%jri(ntyp),i),p (:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsoc%rsoplopd(ntyp,ilo,i,j) = radso(plo(:atoms%jri(ntyp),i),pd(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp), atoms%rmsh(1,ntyp))
rsoc%rsopplo (ntyp,ilo,i,j) = radso(p (:atoms%jri(ntyp),i),plo(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp), atoms%rmsh(1,ntyp))
rsoc%rsopdplo(ntyp,ilo,i,j) = radso(pd(:atoms%jri(ntyp),i),plo(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp), atoms%rmsh(1,ntyp))
ENDDO
ENDDO
......@@ -227,7 +221,7 @@ CONTAINS
DO i = 1, 2
DO j = 1, 2
rsoploplop(ntyp,ilo,ilop,i,j) =&
rsoc%rsoploplop(ntyp,ilo,ilop,i,j) =&
radso(plo(:atoms%jri(ntyp),i),plop(:atoms%jri(ntyp),j),vso(:atoms%jri(ntyp),i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
ENDDO
ENDDO
......
eigen_soc/spnorb.f90
View file @ 3e24dd1b
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_spnorb
!*********************************************************************
! calls soinit to calculate the radial spin-orbit matrix elements:
......@@ -6,40 +12,30 @@ MODULE m_spnorb
! using the functions anglso and sgml.
!*********************************************************************
CONTAINS
SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, rsopp,rsoppd,rsopdp,rsopdpd,&
usdus, rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop, soangl)
SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, usdus, rsoc,l_angles)
USE m_anglso
USE m_sgml
USE m_soinit
USE m_sorad
USE m_types
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(INOUT) :: usdus
TYPE(t_usdus),INTENT(INOUT) :: usdus
TYPE(t_rsoc),INTENT(OUT) :: rsoc
LOGICAL,INTENT(IN) :: l_angles
! ..
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
REAL, INTENT (OUT) :: rsopp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (OUT) :: rsoppd (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (OUT) :: rsopdp (atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (OUT) :: rsopdpd(atoms%ntype,atoms%lmaxd,2,2)
REAL, INTENT (OUT) :: rsoplop (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (OUT) :: rsoplopd(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (OUT) :: rsopdplo(atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (OUT) :: rsopplo (atoms%ntype,atoms%nlod,2,2)
REAL, INTENT (OUT) :: rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2)
COMPLEX, INTENT (OUT) :: soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,&
atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2)
! ..
! .. Local Scalars ..
INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n,nr
LOGICAL, SAVE :: first_k = .TRUE.
! ..
! .. Local Arrays ..
INTEGER ispjsp(2)
......@@ -47,44 +43,69 @@ CONTAINS
! ..
DATA ispjsp/1,-1/
CALL soinit(atoms,input,enpara, vr,noco%soc_opt(atoms%ntype+2), &
rsopp,rsoppd,rsopdp,rsopdpd, usdus,rsoplop,rsoplopd,rsopdplo,&
rsopplo,rsoploplop)
!Allocate space for SOC matrix elements; set to zero at the same time
ALLOCATE(rsoc%rsopp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopp =0.0
ALLOCATE(rsoc%rsoppd (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsoppd=0.0
ALLOCATE(rsoc%rsopdp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdp=0.0
ALLOCATE(rsoc%rsopdpd(atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdpd=0.0
ALLOCATE(rsoc%rsoplop (atoms%ntype,atoms%nlod,2,2));rsoc%rsoplop=0.0
ALLOCATE(rsoc%rsoplopd(atoms%ntype,atoms%nlod,2,2));rsoc%rsoplopd=0.0
ALLOCATE(rsoc%rsopdplo(atoms%ntype,atoms%nlod,2,2));rsoc%rsopdplo=0.0
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)))
!Calculate radial soc-matrix elements
DO n = 1,atoms%ntype
CALL sorad(atoms,input,n,vr(:atoms%jri(n),0,n,:),enpara,noco%l_spav,rsoc,usdus)
END DO
!
IF (mpi%irank.EQ.0) THEN
!Scale SOC
DO n= 1,atoms%ntype
IF (ABS(noco%socscale(n)-1)>1E-5) THEN
IF (mpi%irank==0) WRITE(6,"(a,i0,a,f10.8)") "Scaled SOC for atom ",n," by ",noco%socscale(n)