Skip to content
Snippets Groups Projects
Commit b5795749 authored by Jonathan Chico's avatar Jonathan Chico
Browse files

changes to unify spin orbit calls

parent a18e9d8b
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
cmake/source_list_KKRhost.txt
+ 2
− 2
View file @ b5795749
......@@ -304,8 +304,8 @@ add_executable(
source/KKRhost/spher.f90
source/KKRhost/sphere_gga.f90
source/KKRhost/sphere_nogga.f90
source/KKRhost/spin_orbit.f90
source/KKRhost/spin_orbit_compl.f90
source/common/spin_orbit.f90
source/common/spin_orbit_compl.f90
source/KKRhost/spinorbit_ham.f90
source/KKRhost/ssite.f90
source/KKRhost/ssum.f90
......
cmake/source_list_KKRimp.txt
+ 3
− 1
View file @ b5795749
# the executable is built from this list of files
add_executable(
kkrflex.exe
source/common/spin_orbit.f90
source/common/spin_orbit_compl.f90
source/common/version.F90
source/common/version_info.F90
source/common/rotatespinframe.f90
source/common/DataTypes.f90
source/common/constants.f90
source/common/cinit.f90
source/voronoi/test.f
source/KKRimp/nrtype.f90
source/KKRimp/type_gmatbulk.f90
......@@ -63,7 +66,6 @@ add_executable(
source/KKRimp/vinters2010.f90
source/KKRimp/timing.F90
source/KKRimp/arrayparams.f90
source/KKRimp/cinit.f
source/KKRimp/dsort.f90
source/KKRimp/clustcomp.f90
source/KKRimp/gauntshape.f90
......
source/KKRimp/spinorbit.f90
+ 1
− 348
View file @ b5795749
......@@ -26,6 +26,7 @@ module mod_spinorbit
use mod_chebyshev, only: getclambdacinv
use mod_physic_params, only: cvlight
use mod_config, only: config_testflag
use mod_spin_orbit_compl, only: spin_orbit_compl
implicit none
!interface
integer :: lmax
......@@ -207,354 +208,6 @@ module mod_spinorbit
end subroutine rel_mass
!-------------------------------------------------------------------------------
!> Summary: Claculate the matrix L*s in the basis of real spherical harmonics
!> Author:
!> Category: KKRimp, special-functions, physical-observables
!> Deprecated: false ! this needs to be set to true for deprecated subroutines
!>
!-------------------------------------------------------------------------------
subroutine spin_orbit_compl(lmax,lmmaxd,l_s)
implicit none
integer, intent(in) :: lmax,lmmaxd
double complex, intent(out) :: l_s(lmmaxd*2,lmmaxd*2)
! local variables
integer :: rl,lm1,lm2
double complex :: icompl
double complex,allocatable :: ls_l(:,:)
icompl=(0d0,1d0)
l_s=(0.0d0,0.0d0)
do rl=0,lmax
allocate(ls_l((2*rl+1)*2,(2*rl+1)*2))
ls_l=(0.0d0,0.0d0)
call spin_orbit_one_l(rl,ls_l)
do lm1=1,(2*rl+1)*2
if (lm1 <= 2*rl+1 ) then
do lm2=1,(2*rl+1)
l_s(rl**2+lm1,rl**2+lm2)=0.5d0*ls_l(lm1,lm2)
end do
do lm2=(2*rl+1)+1,(2*rl+1)*2
l_s(rl**2+lm1,lmmaxd+rl**2-(2*rl+1)+lm2)= 0.5d0*ls_l(lm1,lm2)
end do
else
do lm2=1,(2*rl+1)
l_s(lmmaxd+rl**2-(2*rl+1)+lm1,rl**2+lm2)= 0.5d0*ls_l(lm1,lm2)
end do
do lm2=(2*rl+1)+1,(2*rl+1)*2
l_s(lmmaxd+rl**2-(2*rl+1)+lm1,lmmaxd+rl**2-(2*rl+1)+lm2)= 0.5d0*ls_l(lm1,lm2)
end do
end if
end do !lm1
deallocate(ls_l)
end do !rl=0,lmax
end subroutine
!-------------------------------------------------------------------------------
!> Summary: Calculate the matrix l*s is calculated for the basis of real spherical harmonics for a single l channel
!> Author:
!> Category: KKRimp, spin-orbit-coupling
!> Deprecated: false ! this needs to be set to true for deprecated subroutines
!>
!> schematically the matrix has the form
!> ( -l_z l_+ )
!> ( l_- l_z )
!-------------------------------------------------------------------------------
subroutine spin_orbit_one_l(lmax,l_s)
implicit none
! i
integer, intent(in) :: lmax
double complex, intent(out) :: l_s((2*lmax+1)*2,(2*lmax+1)*2)
! c local variables
integer :: i1,i2,i1l
double complex :: icompl
double complex,allocatable :: l_min(:,:)
double complex,allocatable :: l_up(:,:)
double precision :: lfac
icompl=(0d0,1d0)
allocate(l_min(-lmax:lmax,-lmax:lmax))
allocate(l_up(-lmax:lmax,-lmax:lmax))
! initialize the matrix
do i1=1,(2*lmax+1)*2
do i2=1,(2*lmax+1)*2
l_s(i2,i1)=0d0
end do
end do
do i1=-lmax,lmax
do i2=-lmax,lmax
l_min(i2,i1)=0d0
l_up(i2,i1)=0d0
end do
end do
! fill the second and the forth quadrant with l_z
! (-l_z,respectively)
do i1=1,2*lmax+1
i1l=i1-lmax-1 ! the value of m (varies from -l to +l)
i2=2*lmax+1-(i1-1)
l_s(i2,i1)=-icompl*i1l
end do
do i1=2*lmax+2,(2*lmax+1)*2
i1l=i1-lmax-1-(2*lmax+1) ! the value of m (varies from -l to +l)
i2=(2*lmax+1)*2-(i1-(2*lmax+2))
l_s(i2,i1)=icompl*i1l
end do
! implement now l_- in the third quadrant
if (lmax>0) then
lfac=sqrt(lmax*(lmax+1d0))/sqrt(2d0)
l_min(0,-1)=-icompl*lfac
! l_min(0,-1)=icompl*lfac
l_min(0,1)=lfac
l_min(-1,0)=icompl*lfac
l_min(1,0)=-lfac
if (lmax > 1) then
do i1=2,lmax
lfac=0.5d0*sqrt(lmax*(lmax+1d0)-i1*(i1-1d0))
l_min(-i1,-i1+1)=-lfac
l_min(-i1,i1-1)=icompl*lfac
l_min(i1,-i1+1)=-icompl*lfac
l_min(i1,i1-1)=-lfac
lfac=0.5d0*sqrt(lmax*(lmax+1d0)-(i1-1d0)*i1)
l_min(-i1+1,-i1)=lfac
l_min(-i1+1,i1)=icompl*lfac
l_min(i1-1,-i1)=-icompl*lfac
l_min(i1-1,i1)=lfac
end do
end if
end if
do i1=-lmax,lmax
do i2=-lmax,lmax
! l_s(i2+lmax+1,i1+3*lmax+2)=l_min(i2,i1)
! transpose l_min
! l_s(i2+lmax+1,i1+3*lmax+2)=l_min(i1,i2)
l_s(i2+3*lmax+2,i1+lmax+1)=l_min(i1,i2)
end do
end do
! implement now l_+ in the quadrant
if (lmax>0) then
lfac=sqrt(lmax*(lmax+1d0))/sqrt(2d0)
l_up(0,-1)=-icompl*lfac
l_up(0,1)=-lfac
l_up(-1,0)=icompl*lfac
l_up(1,0)=lfac
if (lmax > 1) then
do i1=2,lmax
lfac=0.5d0*sqrt(lmax*(lmax+1d0)-i1*(i1-1d0))
l_up(-i1,-i1+1)=lfac
l_up(-i1,i1-1)=icompl*lfac
l_up(i1,-i1+1)=-icompl*lfac
l_up(i1,i1-1)=lfac
lfac=0.5d0*sqrt(lmax*(lmax+1d0)-(i1-1d0)*i1)
l_up(-i1+1,-i1)=-lfac
l_up(-i1+1,i1)=icompl*lfac
l_up(i1-1,-i1)=-icompl*lfac
l_up(i1-1,i1)=-lfac
end do
end if
end if
do i1=-lmax,lmax
do i2=-lmax,lmax
! l_s(i2+3*lmax+2,i1+lmax+1)=l_up(i2,i1)
! transpose l_up
l_s(i2+lmax+1,i1+3*lmax+2)=l_up(i1,i2)
! l_s(i2+3*lmax+2,i1+lmax+1)=l_up(i1,i2)
end do
end do
deallocate(l_min)
deallocate(l_up)
end subroutine
!-------------------------------------------------------------------------------
!> Summary: Old form of spinorbit matrix (unused)
!> Author:
!> Category: KKRimp, spin-orbit-coupling
!> Deprecated: True ! this needs to be set to true for deprecated subroutines
!>
!-------------------------------------------------------------------------------
subroutine spin_orbit_one_l_old(lmax,l_s)
! here the 1x1 block is still spin up
! and the 2x2 block is spin down ( swantje's convention )
! not used anymore
implicit none
! ************************************************************************
! in this subroutine the matrix l*s is calculated for the basis of
! real spherical harmonics
!
! schematically it has the form
! ( l_z l_- )
! ( l_+ -l_z )
!
integer, intent(in) :: lmax
double complex, intent(out) :: l_s((2*lmax+1)*2,(2*lmax+1)*2)
! c local variables
integer :: i1,i2,i1l
double complex :: icompl
double complex,allocatable :: l_min(:,:)
double complex,allocatable :: l_up(:,:)
double precision :: lfac
icompl=(0d0,1d0)
allocate(l_min(-lmax:lmax,-lmax:lmax))
allocate(l_up(-lmax:lmax,-lmax:lmax))
! initialize the matrix
do i1=1,(2*lmax+1)*2
do i2=1,(2*lmax+1)*2
l_s(i2,i1)=0d0
end do
end do
do i1=-lmax,lmax
do i2=-lmax,lmax
l_min(i2,i1)=0d0
l_up(i2,i1)=0d0
end do
end do
! fill the second and the forth quadrant with l_z
! (-l_z,respectively)
do i1=1,2*lmax+1
i1l=i1-lmax-1 ! the value of m (varies from -l to +l)
i2=2*lmax+1-(i1-1)
l_s(i2,i1)=icompl*i1l
end do
do i1=2*lmax+2,(2*lmax+1)*2
i1l=i1-lmax-1-(2*lmax+1) ! the value of m (varies from -l to +l)
i2=(2*lmax+1)*2-(i1-(2*lmax+2))
l_s(i2,i1)=-icompl*i1l
end do
! implement now l_- in the third quadrant
if (lmax>0) then
lfac=sqrt(lmax*(lmax+1d0))/sqrt(2d0)
l_min(0,-1)=-icompl*lfac
! l_min(0,-1)=icompl*lfac
l_min(0,1)=lfac
l_min(-1,0)=icompl*lfac
l_min(1,0)=-lfac
if (lmax > 1) then
do i1=2,lmax
lfac=0.5d0*sqrt(lmax*(lmax+1d0)-i1*(i1-1d0))
l_min(-i1,-i1+1)=-lfac
l_min(-i1,i1-1)=icompl*lfac
l_min(i1,-i1+1)=-icompl*lfac
l_min(i1,i1-1)=-lfac
lfac=0.5d0*sqrt(lmax*(lmax+1d0)-(i1-1)*(i1))
l_min(-i1+1,-i1)=lfac
l_min(-i1+1,i1)=icompl*lfac
l_min(i1-1,-i1)=-icompl*lfac
l_min(i1-1,i1)=lfac
end do
end if
end if
do i1=-lmax,lmax
do i2=-lmax,lmax
! l_s(i2+lmax+1,i1+3*lmax+2)=l_min(i2,i1)
! transpose l_min
l_s(i2+lmax+1,i1+3*lmax+2)=l_min(i1,i2)
end do
end do
! implement now l_+ in the quadrant
if (lmax>0) then
lfac=sqrt(lmax*(lmax+1d0))/sqrt(2d0)
l_up(0,-1)=-icompl*lfac
l_up(0,1)=-lfac
l_up(-1,0)=icompl*lfac
l_up(1,0)=lfac
if (lmax > 1) then
do i1=2,lmax
lfac=0.5d0*sqrt(lmax*(lmax+1d0)-i1*(i1-1d0))
l_up(-i1,-i1+1)=lfac
l_up(-i1,i1-1)=icompl*lfac
l_up(i1,-i1+1)=-icompl*lfac
l_up(i1,i1-1)=lfac
lfac=0.5d0*sqrt(lmax*(lmax+1d0)-(i1-1)*(i1))
l_up(-i1+1,-i1)=-lfac
l_up(-i1+1,i1)=icompl*lfac
l_up(i1-1,-i1)=-icompl*lfac
l_up(i1-1,i1)=-lfac
end do
end if
end if
do i1=-lmax,lmax
do i2=-lmax,lmax
l_s(i2+3*lmax+2,i1+lmax+1)=l_up(i1,i2)
end do
end do
deallocate(l_min)
deallocate(l_up)
end subroutine
!-------------------------------------------------------------------------------
!> Summary: Transpose double complex matrix
!> Author:
......
source/KKRhost/spin_orbit.f90 → source/common/spin_orbit.f90
+ 0
− 0
View file @ b5795749
File moved
source/KKRimp/cinit.f → source/deprecated/from_KKRimp/cinit.f
+ 0
− 0
View file @ b5795749
File moved
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