Target_RMat_CI_module.f90

Go to the documentation of this file.

! Copyright 2019
!
! For a comprehensive list of the developers that contributed to these codes
! see the UK-AMOR website.
!
! This file is part of UKRmol-in (UKRmol+ suite).
!
!     UKRmol-in is free software: you can redistribute it and/or modify
!     it under the terms of the GNU General Public License as published by
!     the Free Software Foundation, either version 3 of the License, or
!     (at your option) any later version.
!
!     UKRmol-in is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with  UKRmol-in (in source/COPYING). Alternatively, you can also visit
!     <https://www.gnu.org/licenses/>.
 
module target_rmat_ci_module
 
    use precisn,                   only: wp
    use const_gbl,                 only: stdout
    use consts_mpi_ci,             only: symtype_d2h
    use scatci_routines,           only: cirmat
    use options_module,            only: options, phase
    use memorymanager_module,      only: master_memory
    use diagonalizerresult_module, only: diagonalizerresult
   !use BaseCorePotential_module
 
    implicit none
 
    public target_rmat_ci, read_ci_mat
 
    private
 
    type, extends(diagonalizerresult) :: target_rmat_ci
        integer  :: set
        integer  :: nstat
        integer  :: num_csfs
        real(wp) :: core_energy
        integer  :: current_eigenvector = 0
 
        real(wp), allocatable :: eigenvectors(:,:)
        real(wp), allocatable :: eigenvalues(:)
        type(phase), pointer  :: phase
 
       !class(BaseCorePotential), pointer :: effective_core_potential => null()
    contains
        procedure, public  :: initialize      => initialize_cirmat
        procedure, public  :: print           => print_cirmat
        procedure, public  :: get_coefficient => get_coefficient_ci
        procedure, public  :: print_vecs
        procedure, public  :: export_eigenvalues
        procedure, public  :: handle_eigenvalues => store_eigenvalues
        procedure, public  :: handle_eigenvector => store_eigenvector
        procedure, public  :: modify_diagonal
        procedure, public  :: modify_l2_diagonal
    end type target_rmat_ci
 
contains
 
    subroutine initialize_cirmat (this, set, nstat, num_csfs, phase_, core_energy)
        class(target_rmat_ci)    :: this
        integer,     intent(in)  :: set, nstat, num_csfs
        real(wp),    intent(in)  :: core_energy
        type(phase), intent(in),  target   :: phase_
       !class(BaseCorePotential), pointer  :: ecp
 
        integer :: ifail
 
        !Set relevant values
        this % set = set
        this % nstat = nstat
        this % num_csfs = num_csfs
        this % core_energy = core_energy
        this % phase => phase_
 
       !if (associated(ecp)) then
       !    this % effective_core_potential => ecp
       !end if
 
        !allocate the necessary arrays and track the memory usage
        allocate(this % eigenvectors(this % num_csfs, this % nstat), this % eigenvalues(this % nstat), stat = ifail)
        call master_memory % track_memory(kind(this % eigenvectors), &
                                          size(this % eigenvectors), ifail, 'TARGET_RMAT_CI::EIGENVECTORS')
        call master_memory % track_memory(kind(this % eigenvalues),  &
                                          size(this % eigenvalues),  ifail, 'TARGET_RMAT_CI::EIGENVALUES')
 
        !Zero the arrays
        this % eigenvectors(:,:) = 0.0_wp
        this % eigenvalues(:) = 0.0_wp
 
    end subroutine initialize_cirmat
 
 
    subroutine print_cirmat (this)
        class(target_rmat_ci) :: this
        integer               :: I, J
 
        write (stdout, '(/," SET",I4,4x,A)') &
            this % set
        write (stdout, '(/," NOCSF=",I5,4x,"NSTAT=",I5,4x,"EN   =",F20.10)') &
            this % num_csfs, this % nstat, this % core_energy
        write (stdout, '(/," EIGEN-ENERGIES",/,(16X,5F20.10))') &
            (this % eigenvalues(i) + this % core_energy, i = 1, this % nstat)
        write (stdout, '(  " STATE",I3,":",I3," transformation vectors selected")') &
            this % set, this % nstat
 
    end subroutine print_cirmat
 
 
    subroutine print_vecs (this)
        class(target_rmat_ci) :: this
        integer               :: ido, jdo
 
        do ido = 1, this % nstat
            write (stdout, *) ' Target state ', this % set, ido
            do jdo = 1, this % num_csfs
                write (stdout, *) this % eigenvectors(jdo, ido)
            end do
        end do
 
    end subroutine print_vecs
 
 
    real(wp) function get_coefficient_ci (this, target_state, configuration_idx)
        class(target_rmat_ci) :: this
        integer, intent(in)   :: target_state, configuration_idx
 
        get_coefficient_ci = this % eigenvectors(configuration_idx, target_state)
 
    end function  get_coefficient_ci
 
 
    subroutine read_ci_mat (option, cirmats)
        class(options),        intent(in)    :: option
        class(target_rmat_ci), intent(inout) :: cirmats(:)
 
        real(wp), allocatable :: eigenvectors(:)
        real(wp), allocatable :: eigenvalues(:)
 
        integer :: ido, jdo, kdo, ii, jj, ci_size, nstat, ifail
 
        !Allocate the temporary arrays for eigenvalues and eienvectors
        allocate(eigenvalues(option % total_num_tgt_states), eigenvectors(option % total_num_ci_target), stat = ifail)
        call master_memory % track_memory(kind(eigenvectors), size(eigenvectors), ifail, 'TARGET_RMAT_CI::READ::EIGENVECTORS')
        call master_memory % track_memory(kind(eigenvalues),  size(eigenvalues),  ifail, 'TARGET_RMAT_CI::READ::EIGENVALUES')
 
        !Use SCATCI to read them
        call cirmat(option % num_target_sym,        &
                    option % ci_target_switch,      &
                    option % ci_set_number,         &
                    eigenvectors,                   &
                    eigenvalues,                    &
                    option % ci_sequence_number,    &
                    option % num_ci_target_sym,     &
                    stdout,                         &
                    option % num_target_state_sym,  &
                    option % phase_index,           &
                    option % num_continuum,         &
                    option % sym_group_flag)
 
        ii = 0
        jj = 0
 
        !Seperate out all the eigenvectors and values into distinct target symmetries and states.
        do ido = 1, option % num_target_sym
            ci_size = cirmats(ido) % num_csfs
            nstat   = cirmats(ido) % nstat
            do jdo = 1, nstat
                jj = jj + 1
                cirmats(ido) % eigenvalues(jdo) = eigenvalues(jj)
                cirmats(ido) % eigenvectors(1:ci_size,jdo) = eigenvectors(ii+1:ii+ci_size)
                ii = ii + ci_size
            end do
        end do
 
        !Stop tracking this memory
        call master_memory % free_memory(kind(eigenvectors), size(eigenvectors))
        call master_memory % free_memory(kind(eigenvalues),  size(eigenvalues))
 
        !Cleanup
        deallocate(eigenvalues)
        deallocate(eigenvectors)
 
    end subroutine read_ci_mat
 
 
    subroutine store_eigenvalues (this, eigenvalues, diagonals, num_eigenpairs, vec_dimen)
        class(target_rmat_ci) :: this
        integer,  intent(in)  :: num_eigenpairs, vec_dimen
        real(wp), intent(in)  :: eigenvalues(num_eigenpairs), diagonals(vec_dimen)
 
        this % eigenvalues = eigenvalues
 
       !if (associated(this % effective_core_potential)) then
       !       call this % effective_core_potential % modify_target_energies(this % set, this % eigenvalues)
       !end if
 
    end subroutine store_eigenvalues
 
 
    subroutine store_eigenvector (this, eigenvector, vec_dimen)
        class(target_rmat_ci) :: this
        integer,  intent(in)  :: vec_dimen
        real(wp), intent(in)  :: eigenvector(vec_dimen)
 
        this % current_eigenvector = this % current_eigenvector + 1
        this % eigenvectors(:, this % current_eigenvector) = eigenvector(:)
 
    end subroutine store_eigenvector
 
 
    subroutine export_eigenvalues (this, eigenvalues, diagonals, num_eigenpairs, vec_dimen, ei, iphz)
        use precisn, only: wp
        class(target_rmat_ci)  :: this
        integer,  intent(in)   :: num_eigenpairs, vec_dimen
        real(wp), intent(in)   :: eigenvalues(num_eigenpairs), diagonals(vec_dimen)
        real(wp), allocatable  :: ei(:)
        integer,  allocatable  :: iphz(:)
    end subroutine export_eigenvalues
 
 
    subroutine modify_diagonal (this, value)
        class(target_rmat_ci), intent(in)    :: this
        real(wp),              intent(inout) :: value
 
       !if (associated(this % effective_core_potential)) then
       !    call this % effective_core_potential % modify_ecp_diagonal(value)
       !end if
 
    end subroutine modify_diagonal
 
 
    subroutine modify_l2_diagonal (this, value)
        class(target_rmat_ci), intent(in)    :: this
        real(wp),              intent(inout) :: value
 
       !if (associated(this % effective_core_potential)) then
       !       call this % effective_core_potential % modify_ecp_diagonal_L2(value)
       !end if
 
    end subroutine modify_l2_diagonal
 
end module target_rmat_ci_module