From e22e4c3db77f0de7158a5911254deb3756e7b066 Mon Sep 17 00:00:00 2001
From: Manuel dos Santos Dias <m.dos.santos.dias@fz-juelich.de>
Date: Fri, 3 Dec 2021 11:04:35 +0100
Subject: [PATCH] KKRhost: added option to switch back to old rllsll
---
source/KKRhost/rhooutnew.f90 | 15 ++---
source/KKRhost/rhovalnew.F90 | 55 +++++++++++--------
source/KKRhost/tmat_newsolver.F90 | 52 ++++++++++--------
source/KKRhost/tmatimp_newsolver.F90 | 7 ++-
.../radial_solver_Chebychev/calcsph.f90 | 20 ++++++-
5 files changed, 91 insertions(+), 58 deletions(-)
diff --git a/source/KKRhost/rhooutnew.f90 b/source/KKRhost/rhooutnew.f90
index e5fbe1153..ea470a7db 100644
--- a/source/KKRhost/rhooutnew.f90
+++ b/source/KKRhost/rhooutnew.f90
@@ -150,6 +150,7 @@ contains
pnsi(lm1, lm2) = rllleft(lm1, lm2, ir)
end do
end do
+ ! MdSD: note that this transpose is followed by another transpose in the next zgemm
call zgemm('N', 'T', lmmaxd, lmmaxd, lmmaxd, alpha, pnsi, lmmaxd, gmatll, lmmaxd, czero, qnsi, lmmaxd)
do lm1 = 1, lmmaxd
do lm2 = 1, lmmaxd
@@ -171,14 +172,14 @@ contains
end do
! CALL ZGEMM('N','N',lmmaxd,lmmaxd,lmmaxd,CONE,PNSI,
! + lmmaxd,GMATLL,lmmaxd,EK,QNSI,lmmaxd)
-! call zgemm('N', 'T', lmmaxd, lmmaxd, lmmaxd, cone, pnsi, lmmaxd, gmatll, lmmaxd, ek, qnsi, lmmaxd)
- call zgemm('N', 'T', lmmaxd, lmmaxd, lmmaxd, ek, pnsi, lmmaxd, qnsi, lmmaxd, cone, wr(1,1,ir), lmmaxd)
- do lm1 = 1, lmmaxd
- do lm2 = 1, lmmaxd
- pnsi(lm1, lm2) = -rllleft(lm1+lmmaxd, lm2, ir)
+! call zgemm('N', 'T', lmmaxd, lmmaxd, lmmaxd, cone, pnsi, lmmaxd, gmatll, lmmaxd, ek, qnsi, lmmaxd)
+ call zgemm('N', 'T', lmmaxd, lmmaxd, lmmaxd, ek, pnsi, lmmaxd, qnsi, lmmaxd, cone, wr(1,1,ir), lmmaxd)
+ do lm1 = 1, lmmaxd
+ do lm2 = 1, lmmaxd
+ pnsi(lm1, lm2) = -rllleft(lm1+lmmaxd, lm2, ir)
+ end do
end do
- end do
- call zgemm('N', 'T', lmmaxd, lmmaxd, lmmaxd, alpha, pnsi, lmmaxd, gmatll, lmmaxd, czero, qnsi, lmmaxd)
+ call zgemm('N', 'T', lmmaxd, lmmaxd, lmmaxd, alpha, pnsi, lmmaxd, gmatll, lmmaxd, czero, qnsi, lmmaxd)
do lm1 = 1, lmmaxd
do lm2 = 1, lmmaxd
pnsi(lm1, lm2) = rll(lm1+lmmaxd, lm2, ir)
diff --git a/source/KKRhost/rhovalnew.F90 b/source/KKRhost/rhovalnew.F90
index d4678a6f8..864896ebf 100644
--- a/source/KKRhost/rhovalnew.F90
+++ b/source/KKRhost/rhovalnew.F90
@@ -41,7 +41,7 @@ contains
use :: mod_save_wavefun, only: t_wavefunctions, read_wavefunc
use :: mod_runoptions, only: calc_exchange_couplings, calc_gmat_lm_full, disable_tmat_sratrick, fix_nonco_angles, &
use_qdos, write_complex_qdos, write_pkkr_operators, write_DOS_lm, set_cheby_nospeedup, &
- decouple_spin_cheby, disable_print_serialnumber, set_gmat_to_zero
+ decouple_spin_cheby, disable_print_serialnumber, set_gmat_to_zero, use_rllsll
use :: mod_version_info, only: version_print_header
use :: global_variables, only: lmmaxd, iemxd, ncleb, lmxspd, irmd, ntotd, nrmaxd, lmpotd, nspotd, nfund, korbit, mmaxd, nspind, angles_cutoff
use :: mod_constants, only: czero, cvlight, cone, pi, ci
@@ -552,11 +552,12 @@ contains
! using spherical potential as reference
if (use_sratrick==1) then
call calcsph(nsra, irmdnew, nrmaxd, lmax, nspin/(nspin-korbit), zat, eryd, lmpotd, lmmaxd, rnew, vins, ncheb, npan_tot, rpan_intervall, jlk_index, hlk(:,:,ith), jlk(:,:,ith), &
- hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, tmatsph(:,ith), alphasph, use_sratrick)
+ hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, tmatsph(:,ith), alphasph, use_sratrick, .true.)
end if
! calculate the tmat and wavefunctions
rll(:, :, :, ith) = czero
+ ull(:, :, :, ith) = czero
sll(:, :, :, ith) = czero
!----------------------------------------------------------------------------
@@ -564,21 +565,24 @@ contains
!----------------------------------------------------------------------------
tmatll = czero
alphall = czero
- ! faster calculation of RLL.
- ! no irregular solutions SLL are needed in self-consistent iterations
- ! because the density depends only on RLL, RLLLEFT and SLLLEFT
- call rll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), ull(:,:,:,ith), rll(:,:,:,ith), tmatll, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
- nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', use_sratrick, alphall)
- ! MdSD: right now it seems that sll is not used for anything
- ! if (set_cheby_nospeedup .or. calc_exchange_couplings .or. write_pkkr_operators) then
- ! call sll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), sll(:,:,:,ith), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
- ! nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', use_sratrick)
+ if (use_rllsll) then
! MdSD: this is the old interface
- ! call rllsll(rpan_intervall, rnew, vnspll(:,:,:,ith), rll(:,:,:,ith), sll(:,:,:,ith), tmatll, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, &
- ! hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', '1', '0', use_sratrick, alphall)
+ call rllsll(rpan_intervall, rnew, vnspll(:,:,:,ith), rll(:,:,:,ith), sll(:,:,:,ith), tmatll, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, &
+ hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', '1', '0', use_sratrick, alphall)
! MdSD: if using the old rllsll this is needed for rhooutnew
- ! ull(:,:,:,ith) = rll(:,:,:,ith)
- ! end if
+ ull(:,:,:,ith) = rll(:,:,:,ith)
+ else
+ ! faster calculation of RLL.
+ ! no irregular solutions SLL are needed in self-consistent iterations
+ ! because the density depends only on RLL, RLLLEFT and SLLLEFT
+ call rll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), ull(:,:,:,ith), rll(:,:,:,ith), tmatll, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
+ nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', use_sratrick, alphall)
+ ! MdSD: right now it seems that sll is not used for anything
+ ! if (set_cheby_nospeedup .or. calc_exchange_couplings .or. write_pkkr_operators) then
+ ! call sll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), sll(:,:,:,ith), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
+ ! nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', use_sratrick)
+ ! end if
+ end if
! MdSD: if using the old rllsll check if this is needed
if (nsra==2) then
ull(lmmaxd+1:nvec*lmmaxd, :, :, ith) = ull(lmmaxd+1:nvec*lmmaxd, :, :, ith)/cvlight
@@ -636,7 +640,7 @@ contains
! notice that exchange the order of left and right hankel/bessel functions
if (use_sratrick==1) then
call calcsph(nsra, irmdnew, nrmaxd, lmax, nspin/(nspin-korbit), zat, eryd, lmpotd, lmmaxd, rnew, vins, ncheb, npan_tot, rpan_intervall, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), &
- hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, alphasph, tmatsph(:,ith), use_sratrick)
+ hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, alphasph, tmatsph(:,ith), use_sratrick, .true.)
end if
! calculate the tmat and wavefunctions
@@ -648,14 +652,17 @@ contains
! notice that exchange the order of left and right hankel/bessel functions
tmattemp = czero
alphall = czero
- ! faster calculation of RLLLEFT and SLLLEFT.
- call rll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), ullleft(:,:,:,ith), rllleft(:,:,:,ith), tmattemp, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
- nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', use_sratrick, alphall)
- call sll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), sllleft(:,:,:,ith), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
- nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', use_sratrick)
- ! MdSD: this is the old interface
- ! call rllsll(rpan_intervall, rnew, vnspll(:,:,:,ith), rllleft(:,:,:,ith), sllleft(:,:,:,ith), tmattemp, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, nsra*(1+korbit)*(lmax+1), irmdnew, nsra, &
- ! jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', '1', '0', use_sratrick, alphall)
+ if (use_rllsll) then
+ ! MdSD: this is the old interface
+ call rllsll(rpan_intervall, rnew, vnspll(:,:,:,ith), rllleft(:,:,:,ith), sllleft(:,:,:,ith), tmattemp, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, nsra*(1+korbit)*(lmax+1), irmdnew, nsra, &
+ jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', '1', '0', use_sratrick, alphall)
+ else
+ ! faster calculation of RLLLEFT and SLLLEFT.
+ call rll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), ullleft(:,:,:,ith), rllleft(:,:,:,ith), tmattemp, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
+ nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', use_sratrick, alphall)
+ call sll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), sllleft(:,:,:,ith), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
+ nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', use_sratrick)
+ end if
! MdSD: if using the old rllsll check if this is needed
if (nsra==2) then
ullleft(lmmaxd+1:nvec*lmmaxd, :, :, ith) = ullleft(lmmaxd+1:nvec*lmmaxd, :, :, ith)/cvlight
diff --git a/source/KKRhost/tmat_newsolver.F90 b/source/KKRhost/tmat_newsolver.F90
index 5a1f7356e..febfd4c06 100644
--- a/source/KKRhost/tmat_newsolver.F90
+++ b/source/KKRhost/tmat_newsolver.F90
@@ -45,7 +45,8 @@ contains
#endif
use :: mod_datatypes, only: dp
use :: mod_runoptions, only: calc_exchange_couplings, disable_tmat_sratrick, formatted_file, stop_1b, &
- write_BdG_tests, write_pkkr_operators, write_rhoq_input, set_cheby_nospeedup, decouple_spin_cheby, calc_wronskian, write_tmat_all
+ write_BdG_tests, write_pkkr_operators, write_rhoq_input, set_cheby_nospeedup, decouple_spin_cheby, &
+ calc_wronskian, write_tmat_all, use_rllsll
use :: mod_constants, only: czero, cone, cvlight
use :: global_variables, only: ntotd, ncleb, nrmaxd, mmaxd, nspind, nspotd, iemxd, lmmaxd, korbit
use :: mod_wunfiles, only: t_params
@@ -445,7 +446,8 @@ contains
use_fullgmat = 1
end if
!RZ
- call rllsllsourceterms(nsra, nvec, eryd, rnew, irmdnew, nrmaxd, lmax, lmmaxd, use_fullgmat, jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor)
+ call rllsllsourceterms(nsra, nvec, eryd, rnew, irmdnew, nrmaxd, lmax, lmmaxd, use_fullgmat, jlk_index, &
+ hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor)
#ifdef CPP_OMP
!$omp critical
@@ -482,7 +484,7 @@ contains
if (use_sratrick==1) then
tmatsph(:, ith) = czero
call calcsph(nsra, irmdnew, nrmaxd, lmax, nspin/(nspin-korbit), zat, eryd, lmpot, lmmaxd, rnew, vins, ncheb, npan_tot, rpan_intervall, jlk_index, hlk(:,:,ith), jlk(:,:,ith), &
- hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, tmatsph(:,ith), alphasph, use_sratrick)
+ hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, tmatsph(:,ith), alphasph, use_sratrick, .true.)
#ifdef CPP_BdG
if (write_BdG_tests) then
write (filename, '(A,I0.3,A,I0.3,A)') 'tmatsph_atom_', i1, '_energ_', ie, '.dat'
@@ -520,19 +522,22 @@ contains
! Right solutions
tmat0 = czero
alpha0 = czero ! LLY
+ if (use_rllsll) then
+ ! MdSD: this is the old interface
+ call rllsll(rpan_intervall, rnew, vnspll(:,:,:,ith), rll(:,:,:,ith), sll(:,:,:,ith), tmat0(:,:), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, nsra*(1+korbit)*(lmax+1), irmdnew, nsra, &
+ jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', '1', '0', use_sratrick, alpha0(:,:))
+ else
! faster calculation of RLL.
! no irregular solutions are needed in self-consistent iterations
! because the t-matrix depends only on RLL
- call rll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), ull(:,:,:,ith), rll(:,:,:,ith), tmatll, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
- nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', use_sratrick, alphall)
- ! MdSD: check if these are actually needed except in rhovalnew
- if (calc_wronskian) then
- call sll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), sll(:,:,:,ith), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
- nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', use_sratrick)
+ call rll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), ull(:,:,:,ith), rll(:,:,:,ith), tmat0(:,:), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
+ nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', use_sratrick, alpha0(:,:))
+ ! MdSD: check if these are actually needed except in rhovalnew
+ if (calc_wronskian) then
+ call sll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), sll(:,:,:,ith), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
+ nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', use_sratrick)
+ end if
end if
- ! MdSD: this is the old interface
- ! call rllsll(rpan_intervall, rnew, vnspll(:,:,:,ith), rll(:,:,:,ith), sll(:,:,:,ith), tmat0(:,:), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, nsra*(1+korbit)*(lmax+1), irmdnew, nsra, &
- ! jlk_index, hlk(:,:,ith), jlk(:,:,ith), hlk2(:,:,ith), jlk2(:,:,ith), gmatprefactor, '1', '1', '0', use_sratrick, alpha0(:,:))
! MdSD: if using the old rllsll check if this is needed
if (nsra==2) then
rll(lmmaxd+1:nvec*lmmaxd, :, :, ith) = rll(lmmaxd+1:nvec*lmmaxd, :, :, ith)/cvlight
@@ -681,7 +686,7 @@ contains
if (use_sratrick==1) then
tmatsph(:, ith) = czero
call calcsph(nsra, irmdnew, nrmaxd, lmax, nspin/(nspin-korbit), zat, eryd, lmpot, lmmaxd, rnew, vins, ncheb, npan_tot, rpan_intervall, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), &
- hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, alphasph, tmatsph(:,ith), use_sratrick)
+ hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, alphasph, tmatsph(:,ith), use_sratrick, .true.)
end if
! Calculate the tmat and wavefunctions
@@ -692,16 +697,19 @@ contains
! notice that exchange the order of left and right hankel/bessel functions
tmat0 = czero
alpha0 = czero ! LLY
- call rll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), ull(:,:,:,ith), rllleft(:,:,:,ith), tmat0, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
- nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', use_sratrick, alpha0)
- ! MdSD: check if these are actually needed except in rhovalnew
- if (calc_wronskian) then
- call sll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), sllleft(:,:,:,ith), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
- nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', use_sratrick)
- end if
+ if (use_rllsll) then
! MdSD: this is the old interface
- ! call rllsll(rpan_intervall, rnew, vnspll(:,:,:,ith), rllleft(:,:,:,ith), sllleft(:,:,:,ith), tmat0, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, nsra*(1+korbit)*(lmax+1), irmdnew, nsra, &
- ! jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', '1', '0', use_sratrick, alpha0)
+ call rllsll(rpan_intervall, rnew, vnspll(:,:,:,ith), rllleft(:,:,:,ith), sllleft(:,:,:,ith), tmat0, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, nsra*(1+korbit)*(lmax+1), irmdnew, nsra, &
+ jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', '1', '0', use_sratrick, alpha0)
+ else
+ call rll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), ull(:,:,:,ith), rllleft(:,:,:,ith), tmat0, ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
+ nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', use_sratrick, alpha0)
+ ! MdSD: check if these are actually needed except in rhovalnew
+ if (calc_wronskian) then
+ call sll_global_solutions(rpan_intervall, rnew, vnspll(:,:,:,ith), sllleft(:,:,:,ith), ncheb, npan_tot, lmmaxd, nvec*lmmaxd, &
+ nsra*(1+korbit)*(lmax+1), irmdnew, nsra, jlk_index, hlk2(:,:,ith), jlk2(:,:,ith), hlk(:,:,ith), jlk(:,:,ith), gmatprefactor, '1', use_sratrick)
+ end if
+ end if
! MdSD: if using the old rllsll check if this is needed
if (nsra==2) then
rllleft(lmmaxd+1:nvec*lmmaxd, :, :, ith) = rllleft(lmmaxd+1:nvec*lmmaxd, :, :, ith)/cvlight
diff --git a/source/KKRhost/tmatimp_newsolver.F90 b/source/KKRhost/tmatimp_newsolver.F90
index 5c1784aab..128506f04 100644
--- a/source/KKRhost/tmatimp_newsolver.F90
+++ b/source/KKRhost/tmatimp_newsolver.F90
@@ -197,6 +197,9 @@ contains
tmatsph = czero
if (myrank==master) then
+ write(*,'("**************************************************************************************************")')
+ write(*,'("*** WARNING: tmatimp_newsolver still uses the old rllsll! ***")')
+ write(*,'("**************************************************************************************************")')
! read angles from nonco_ange files
open (unit=12, file='nonco_angle.dat', form='FORMATTED')
do i1 = 1, natyp
@@ -357,7 +360,7 @@ contains
lmmaxd,rnew(1:irmdnew(i1),i1), &
vinsnew(1:irmdnew(i1),1:lmpot,ipot:ipot+nspin-1),ncheb,npan_tot(i1), &
rpan_intervall(0:ntotd,i1),jlk_index,hlk,jlk,hlk2,jlk2,gmatprefactor, &
- tmatsph,dummy_alpha,use_sratrick)
+ tmatsph,dummy_alpha,use_sratrick,.true.)
end if
! calculate the tmat and wavefunctions
@@ -662,7 +665,7 @@ contains
lmmaxd,rnew(1:irmdnew(i1),i1), &
vinsnew(1:irmdnew(i1),1:lmpot,ipot:ipot+nspin-1),ncheb,npan_tot(i1), &
rpan_intervall(0:ntotd,i1),jlk_index,hlk,jlk,hlk2,jlk2,gmatprefactor, &
- tmatsph,dummy_alpha,use_sratrick)
+ tmatsph,dummy_alpha,use_sratrick,.true.)
end if
! calculate the tmat and wavefunctions
diff --git a/source/common/radial_solver_Chebychev/calcsph.f90 b/source/common/radial_solver_Chebychev/calcsph.f90
index a1245da1d..7f4aabc1d 100644
--- a/source/common/radial_solver_Chebychev/calcsph.f90
+++ b/source/common/radial_solver_Chebychev/calcsph.f90
@@ -21,12 +21,14 @@ contains
!> starting from spherical Bessel and Hankel functions (see PhD D. Bauer)
!-------------------------------------------------------------------------------
subroutine calcsph(nsra, irmdnew, nrmaxd, lmax, nspin, zat, eryd, lmpotd, lmmaxd, rnew, vins, ncheb, npan_tot, rpan_intervall, jlk_index, hlk, jlk, hlk2, jlk2, gmatprefactor, &
- tmat, alpha, use_sratrick)
+ tmat, alpha, use_sratrick, use_rllsll)
use :: global_variables, only: korbit
use :: mod_constants, only: czero
use :: mod_datatypes, only: dp
use :: mod_rllsll, only: rllsll
+ use mod_rll_global_solutions, only: rll_global_solutions
+ use mod_sll_global_solutions, only: sll_global_solutions ! MdSD: TEST
use :: mod_vllmatsra, only: vllmatsra
implicit none
@@ -43,6 +45,7 @@ contains
complex (kind=dp) :: hlk2(1:nsra*(1+korbit)*(lmax+1), irmdnew)
complex (kind=dp) :: jlk2(1:nsra*(1+korbit)*(lmax+1), irmdnew)
integer :: jlk_index(2*lmmaxd)
+ logical, intent(in) :: use_rllsll
! local
integer :: lmsize, lmsize2, nvec, nspintemp
@@ -128,8 +131,19 @@ contains
end if
tmattemp = (0e0_dp, 0e0_dp)
alphatemp = (0e0_dp, 0e0_dp)
- call rllsll(rpan_intervall, rnew, vll, rlltemp, slltemp, tmattemp, ncheb, npan_tot, lmsize, lmsize2, nvec, irmdnew, nvec, jlk_indextemp, hlktemp, jlktemp, hlk2temp, &
- jlk2temp, gmatprefactor, '1', '1', '0', use_sratrick, alphatemp) ! LLY
+ ! MdSD: TEST
+ if (use_rllsll) then
+ call rllsll(rpan_intervall, rnew, vll, rlltemp, slltemp, &
+ tmattemp, ncheb, npan_tot, lmsize, lmsize2, nvec, irmdnew, nvec, &
+ jlk_indextemp, hlktemp, jlktemp, hlk2temp, jlk2temp, gmatprefactor, '1', '1', '0', use_sratrick, alphatemp) ! LLY
+ else
+ call rll_global_solutions(rpan_intervall, rnew, vll, slltemp, rlltemp, &
+ tmattemp, ncheb, npan_tot, lmsize, lmsize2, nvec, irmdnew, nvec, &
+ jlk_indextemp, hlktemp, jlktemp, hlk2temp, jlk2temp, gmatprefactor, '1', use_sratrick, alphatemp)
+ call sll_global_solutions(rpan_intervall, rnew, vll, slltemp, &
+ ncheb, npan_tot, lmsize, lmsize2, nvec, irmdnew, nvec, &
+ jlk_indextemp, hlktemp, jlktemp, hlk2temp, jlk2temp, gmatprefactor, '1', use_sratrick)
+ end if
do ir = 1, irmdnew
hlknew(lspin+lval+1, ir) = slltemp(1, 1, ir)/rnew(ir)
--
GitLab