Commit 01e3851b authored by Matthias Redies's avatar Matthias Redies

move filtering to type

parent 62a43f25
...@@ -273,7 +273,7 @@ CONTAINS ...@@ -273,7 +273,7 @@ CONTAINS
! Diagonalize ! Diagonalize
CALL diagonalize(eigv, eig, olap) CALL diagonalize(eigv, eig, olap)
call filter_radbasfn(hybrid, l, itype, n_radbasfn, eig, eigv, mpbasis) call mpbasis%filter_radbasfn(l, itype, n_radbasfn, eig, eigv)
call trafo_to_orthonorm_bas(mpbasis, n_radbasfn, n_grid_pt, l, itype, eig, eigv) call trafo_to_orthonorm_bas(mpbasis, n_radbasfn, n_grid_pt, l, itype, eig, eigv)
nn = mpbasis%num_radbasfn(l, itype) nn = mpbasis%num_radbasfn(l, itype)
...@@ -537,34 +537,6 @@ CONTAINS ...@@ -537,34 +537,6 @@ CONTAINS
end function calc_radbas_norm end function calc_radbas_norm
subroutine filter_radbasfn(hybrid, l, itype, n_radbasfn, eig, eigv, mpbasis)
! Get rid of linear dependencies (eigenvalue <= mpbasis%linear_dep_tol)
use m_types
implicit none
type(t_hybrid), intent(in) :: hybrid
integer, intent(in) :: l, itype, n_radbasfn
real, intent(inout) :: eig(:), eigv(:,:)
type(t_mpbasis), intent(inout) :: mpbasis
integer :: num_radbasfn, i_bas
integer, allocatable :: remaining_basfn(:)
allocate(remaining_basfn(n_radbasfn), source=1)
num_radbasfn = 0
DO i_bas = 1, mpbasis%num_radbasfn(l, itype)
IF (eig(i_bas) > mpbasis%linear_dep_tol) THEN
num_radbasfn = num_radbasfn + 1
remaining_basfn(num_radbasfn) = i_bas
END IF
END DO
mpbasis%num_radbasfn(l, itype) = num_radbasfn
eig = eig(remaining_basfn)
eigv(:,:) = eigv(:,remaining_basfn)
end subroutine filter_radbasfn
subroutine trafo_to_orthonorm_bas(mpbasis, n_radbasfn, n_grid_pt, l, itype, eig, eigv) subroutine trafo_to_orthonorm_bas(mpbasis, n_radbasfn, n_grid_pt, l, itype, eig, eigv)
use m_types use m_types
implicit NONE implicit NONE
......
...@@ -15,6 +15,7 @@ module m_types_mpbasis ...@@ -15,6 +15,7 @@ module m_types_mpbasis
procedure :: check_orthonormality => mpbasis_check_orthonormality procedure :: check_orthonormality => mpbasis_check_orthonormality
procedure :: check_radbasfn => mpbasis_check_radbasfn procedure :: check_radbasfn => mpbasis_check_radbasfn
procedure :: calc_olap_radbasfn => mpbasis_calc_olap_radbasfn procedure :: calc_olap_radbasfn => mpbasis_calc_olap_radbasfn
procedure :: filter_radbasfn => mpbasis_filter_radbasfn
end type t_mpbasis end type t_mpbasis
contains contains
function mpbasis_num_gpts(mpbasis) function mpbasis_num_gpts(mpbasis)
...@@ -265,4 +266,30 @@ contains ...@@ -265,4 +266,30 @@ contains
END DO END DO
END DO END DO
end subroutine mpbasis_calc_olap_radbasfn end subroutine mpbasis_calc_olap_radbasfn
subroutine mpbasis_filter_radbasfn(mpbasis, l, itype, n_radbasfn, eig, eigv)
! Get rid of linear dependencies (eigenvalue <= mpbasis%linear_dep_tol)
use m_types
implicit none
class(t_mpbasis), intent(inout) :: mpbasis
integer, intent(in) :: l, itype, n_radbasfn
real, intent(inout) :: eig(:), eigv(:,:)
integer :: num_radbasfn, i_bas
integer, allocatable :: remaining_basfn(:)
allocate(remaining_basfn(n_radbasfn), source=1)
num_radbasfn = 0
DO i_bas = 1, mpbasis%num_radbasfn(l, itype)
IF (eig(i_bas) > mpbasis%linear_dep_tol) THEN
num_radbasfn = num_radbasfn + 1
remaining_basfn(num_radbasfn) = i_bas
END IF
END DO
mpbasis%num_radbasfn(l, itype) = num_radbasfn
eig = eig(remaining_basfn)
eigv(:,:) = eigv(:,remaining_basfn)
end subroutine mpbasis_filter_radbasfn
end module m_types_mpbasis end module m_types_mpbasis
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