Dispatcher_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 dispatcher_module
 
    use precisn,                          only: longint, wp
    use const_gbl,                        only: stdout
    use mpi_gbl,                          only: nprocs, mpi_xermsg
    use consts_mpi_ci
    use options_module,                   only: options
    use basematrix_module,                only: basematrix
    use writermatrix_module,              only: writermatrix
    use diagonalizer_module,              only: basediagonalizer
    use lapackdiagonalizer_module,        only: lapackdiagonalizer
    use davidsondiagonalizer_module,      only: davidsondiagonalizer
#ifdef arpack
    use arpackdiagonalizer_module,        only: arpackdiagonalizer
#endif
    use matrixelement_module,             only: matrixelementvector
    use timing_module,                    only: master_timer
    use baseintegral_module,              only: baseintegral
    use sweden_module,                    only: swedenintegral
    use alchemy_module,                   only: alchemyintegral
    use ukrmol_module,                    only: ukrmolintegral
   !use BaseCorePotential_module,         only: BaseCorePotential
   !use MOLPROCorePotential_module,       only: MOLPROCorePotential
#ifdef usempi
#ifdef slepc
    use slepcmatrix_module,               only: slepcmatrix, initialize_slepc
    use slepcdiagonalizer_module,         only: slepcdiagonalizer
   !use SLEPCDavidsonDiagonalizer_module, only: SLEPCDavidsonDiagonalizer
#endif
#ifdef scalapack
    use scalapackmatrix_module,           only: scalapackmatrix
    use scalapackdiagonalizer_module,     only: scalapackdiagonalizer
#ifdef elpa
    use elpamatrix_module,                only: elpamatrix
    use elpadiagonalizer_module,          only: elpadiagonalizer, initialize_elpa
#endif
#endif
#endif
 
    implicit none
 
    public dispatchmatrixanddiagonalizer, dispatchintegral, initialize_libraries
 
    private
 
contains
 
    subroutine initialize_libraries
#if defined(usempi) && defined(slepc)
        call initialize_slepc
#endif
#if defined(usempi) && defined(scalapack) && defined(elpa)
        call initialize_elpa
#endif
    end subroutine initialize_libraries
 
 
    subroutine dispatchmatrixanddiagonalizer (diag_choice, force_serial, matrix_size, number_of_eigenpairs, matrix, diagonalizer, &
                                              integral, matrix_io)
        class(basematrix),       pointer, intent(out) :: matrix
        class(basediagonalizer), pointer, intent(out) :: diagonalizer
        class(baseintegral),              intent(in)  :: integral
 
        integer, intent(in) :: diag_choice, force_serial
        integer, intent(in) :: matrix_size, number_of_eigenpairs
        integer, intent(in) :: matrix_io
        integer             :: final_choice
 
        !Now if we forced a diagonalizer then use that, other wise use the rules
        if (diag_choice /= scatci_decide) then
            final_choice = diag_choice
        else
            if (number_of_eigenpairs > real(matrix_size) * 0.2) then ! More the 20% of eigenvectors requires a dense diagonalizer
                final_choice = dense_diag
            else if (number_of_eigenpairs <= 3) then ! Less than three, we use davidson
                final_choice = davidson_diag
            else !Inbetween we use an iterative library like ARPACK or SLEPC
                final_choice = iterative_diag
            end if
        end if
 
#ifdef usempi
        !If we are dealing with an MPI diagonalization then we select the appropriate version of the diagonalizer
        if (nprocs > 1 .and. force_serial == 0) then
            select case (final_choice)
                case (dense_diag)                ! The MPI DENSE diagonalization is SCALAPACK
#ifdef scalapack
#ifdef elpa
                    write (stdout, "('ELPA chosen as diagonalizer of choice. Hohoho!')")
                    allocate(elpamatrix::matrix)
                    allocate(elpadiagonalizer::diagonalizer)
#else
                    write (stdout, "('ScaLAPACK chosen as diagonalizer of choice. Nice!')")
                    allocate(scalapackmatrix::matrix)
                    allocate(scalapackdiagonalizer::diagonalizer)
#endif
#else
                    call mpi_xermsg('Dispatcher_module', 'DispatchMatrixAndDiagonalizer', &
                                    'ScaLAPACK needed for dense diagonalization!', 1, 1)
#endif
                case (davidson_diag) !Use the SCATCI Davidson diagonalizer
                    write (stdout, "('Davidson chosen as diagonalizer of choice. Sweet!')")
#ifdef slepc
                    write (stdout, "('SLEPc chosen as diagonalizer of choice. Amazing!')")
                    allocate(slepcmatrix::matrix)
                    allocate(slepcdiagonalizer::diagonalizer)
#elif defined(scalapack)
#ifdef elpa
                    write (stdout, "('Compiled without SLEPc, defaulting to ELPA')")
                    allocate(elpamatrix::matrix)
                    allocate(elpadiagonalizer::diagonalizer)
#else
                    write (stdout, "('Compiled without SLEPc, defaulting to ScaLAPACK')")
                    allocate(scalapackmatrix::matrix)
                    allocate(scalapackdiagonalizer::diagonalizer)
#endif
#else
                    call mpi_xermsg('Dispatcher_module', 'DispatchMatrixAndDiagonalizer', &
                                    'SLEPc or ScaLAPACK needed for distributed diagonalization!', 1, 1)
#endif
                case (iterative_diag)                ! ITERATIVE uses SLEPC
#ifdef slepc
                    write (stdout, "('SLEPc chosen as diagonalizer of choice. Amazing!')")
                    allocate(slepcmatrix::matrix)
                    allocate(slepcdiagonalizer::diagonalizer)
#elif defined(scalapack)
#ifdef elpa
                    write (stdout, "('Compiled without SLEPc, defaulting to ELPA')")
                    allocate(elpamatrix::matrix)
                    allocate(elpadiagonalizer::diagonalizer)
#else
                    write (stdout, "('Compiled without SLEPc, defaulting to ScaLAPACK')")
                    allocate(scalapackmatrix::matrix)
                    allocate(scalapackdiagonalizer::diagonalizer)
#endif
#else
                    call mpi_xermsg('Dispatcher_module', 'DispatchMatrixAndDiagonalizer', &
                                    'SLEPc or ScaLAPACK needed for distributed diagonalization!', 1, 1)
#endif
                case default
                    write (stdout, "('That is not a diagonalizer I would have chosen tbh, lets not do it')")
                    call mpi_xermsg('Dispatcher_module', 'DispatchMatrixAndDiagonalizer', &
                                    'Invalid diagonalizer flag chosen', 1, 1)
            end select
            return
        end if
#endif
 
        select case (final_choice)
            case (dense_diag)  !Use our rolled LAPACK diagonalizer
                write (stdout, "('LAPACK chosen as diagonalizer of choice. Nice!')")
                !allocate(MatrixElementVector::matrix)
                call integral % write_matrix_header(matrix_io, matrix_size)
                allocate(writermatrix::matrix)
                allocate(lapackdiagonalizer::diagonalizer)
            case (davidson_diag) !Use the SCATCI Davidson diagonalizer
                write (stdout, "('Davidson chosen as diagonalizer of choice. Sweet!')")
                call integral % write_matrix_header(matrix_io, matrix_size)
                allocate(writermatrix::matrix)
                allocate(davidsondiagonalizer::diagonalizer)
            case (iterative_diag) !Use the SCATCI ARPACK diagonalizer
#ifdef arpack
                write (stdout, "('ARPACK chosen as diagonalizer of choice. Amazing!')")
                call integral % write_matrix_header(matrix_io, matrix_size)
                allocate(writermatrix::matrix)
                allocate(arpackdiagonalizer::diagonalizer)
#else
                write (stdout, "('ARPACK not available - using LAPACK. Sorry!')")
                call integral % write_matrix_header(matrix_io, matrix_size)
                allocate(writermatrix::matrix)
                allocate(lapackdiagonalizer::diagonalizer)
#endif
            case default
                write (stdout, "('That is not a diagonalizer I would have chosen tbh, lets not do it')")
                stop "Invalid diagonalizer flag chosen"
        end select
 
    end subroutine dispatchmatrixanddiagonalizer
 
 
    subroutine dispatchintegral (sym_group_flag, ukrmolplus_integrals, integral)
        class(baseintegral), pointer, intent(out) :: integral
        integer, intent(in) :: sym_group_flag
        logical, intent(in) :: ukrmolplus_integrals
 
        if (sym_group_flag /= symtype_d2h) then
            allocate(alchemyintegral::integral)
        else
            if (ukrmolplus_integrals) then
                allocate(ukrmolintegral::integral)
            else
                allocate(swedenintegral::integral)
            end if
        end if
 
    end subroutine dispatchintegral
 
 
    !subroutine DispatchECP(ecp_type,ecp_filename,vals_defined,num_targ_symm,num_targ_states_symm,spatial_symm,spin_symm,ecp)
    !    integer,intent(in)                ::    ecp_type
    !    character(len=line_len),intent(in)        ::    ecp_filename
    !    logical,intent(in)                ::    vals_defined
    !    integer,intent(in)                ::    num_targ_symm,num_targ_states_symm(num_targ_symm),spatial_symm(num_targ_symm),spin_symm(num_targ_symm)
    !    class(BaseCorePotential),pointer,intent(out)    ::    ecp
    !
    !    if(ecp_type == ECP_TYPE_NULL) then
    !        ecp => null()
    !        return
    !    else if(vals_defined == .true.) then
    !        select case(ecp_type)
    !            case(ECP_TYPE_MOLPRO)
    !                allocate(MOLPROCorePotential::ecp)
    !            case default
    !                stop "Unrecognized ECP type"
    !        end select
    !
    !        call ecp%construct(num_targ_symm,num_targ_states_symm,spatial_symm,spin_symm)
    !
    !        call ecp%parse_ecp(ecp_filename)
    !    else
    !        write(stdout,"('TARGET SPATIAL SYMMETRY AND MULTIPLICITY NOT DEFINED IN INPUT')")
    !        stop "TARGET SPATIAL SYMMETRY AND MULTIPLICITY NOT DEFINED IN INPUT"
    !    endif
    !
    !end subroutine DispatchECP
 
end module dispatcher_module