Line data    Source code

       1              : !--------------------------------------------------------------------------------
       2              : ! Copyright (c) 2025 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3              : ! This file is part of FLEUR and available as free software under the conditions 
       4              : ! of the MIT license as expressed in the LICENSE file in more detail.
       5              : !--------------------------------------------------------------------------------
       6              : ! Added MPI implementation, DW 2018
       7              : !--------------------------------------------------------------------------------
       8              : module m_dummy_diag
       9              :    use m_judft
      10              :    use m_constants
      11              :    use m_types_solver
      12              :    implicit none
      13              :    private
      14              :    type, extends(t_solver):: t_solver_dummy
      15              :    contains
      16              :       procedure        :: solve_gev => dummy_diag  !solver for generalized eigenvalue problem
      17              :    end type
      18              : 
      19              :    public t_solver_dummy, get_solver_dummy
      20              : 
      21              : contains
      22              : 
      23          104 :    function get_solver_dummy() result(solver)
      24              :       class(t_solver), allocatable :: solver
      25          104 :       allocate(t_solver_dummy :: solver)
      26          104 :       solver%name = "dummy"
      27          104 :       solver%available = .true.
      28          104 :       solver%parallel = .false.
      29          104 :       solver%serial = .true.
      30          104 :       solver%generalized = .true.
      31          104 :       solver%standard = .false.
      32          104 :       solver%single_precision = .false.
      33          104 :       solver%transform = .false.
      34          104 :       solver%GPU = .true.
      35          104 :       solver%use_sp = .false.
      36          104 :    end function
      37              : 
      38            0 :    subroutine dummy_diag(self, hmat, smat, ne, eig, zmat, ikpt)
      39              :       !Dummy diver: does not solve actual eigenvalue problem but simply returns a set of orthogonal vectors.
      40              :       !Could be useful for performance testing workloads in which we do not want to look at the diagonalization.
      41              :       ! A Cholesky decomp is still done to be able to do a back transform so that the resulting vector are orthonormal
      42              :       ! with respect to overlapp matrix.
      43              : 
      44              :       use m_types_mat
      45              :       use m_judft
      46              : 
      47              :       implicit none
      48              :       class(t_solver_dummy)                  :: self
      49              :       class(t_mat), intent(INOUT) :: hmat, smat
      50              :       integer, intent(INOUT) :: ne
      51              :       class(t_mat), allocatable, intent(OUT)   :: zmat
      52              :       real, intent(OUT)   :: eig(:)
      53              :       integer, intent(IN) :: ikpt
      54              : 
      55              :       integer            :: nev, lwork, liwork, n
      56              :       integer            :: info
      57              : 
      58            0 :       call timestart("DUMMY DIAG")
      59              : 
      60            0 :       allocate (t_mat::zmat)
      61            0 :       call zmat%alloc(hmat%l_real, hmat%matsize1, ne)
      62              : 
      63            0 :       if (hmat%l_real) then
      64              :          ! --> start with Cholesky factorization of b ( so that b = l * l^t)
      65              :          ! --> b is overwritten by l
      66            0 :          call dpotrf('U', smat%matsize1, smat%data_r, size(smat%data_r, 1), info)
      67            0 :          if (info .ne. 0) then
      68            0 :             write (*, *) 'Error in dpotrf: info =', info
      69            0 :             call juDFT_error("Diagonalization failed", calledby="lapack_singlePrec_diag")
      70              :          end if
      71              : 
      72              :          ! --> solve a' * z' = eig * z' for eigenvalues eig between lb und ub
      73            0 :          zmat%data_r = 0.0
      74            0 :          do n = 1, ne
      75            0 :             eig(ne) = -0.1 + ne*1e-5
      76            0 :             zmat%data_r(ne, ne) = 1.0
      77              :          end do
      78              :          ! --> recover the generalized eigenvectors z by solving z' = l^t * z
      79            0 :          call dtrtrs('U', 'N', 'N', hmat%matsize1, nev, smat%data_r, smat%matsize1, zMat%data_r, zmat%matsize1, info)
      80            0 :          if (info .ne. 0) then
      81            0 :             write (oUnit, *) 'Error in dtrtrs: info =', info
      82            0 :             call juDFT_error("Diagonalization failed", calledby="lapack_singlePrec_diag")
      83              :          end if
      84              : 
      85              :       else
      86              : 
      87              :          ! --> start with Cholesky factorization of b ( so that b = l * l^t)
      88              :          ! --> b is overwritten by l
      89            0 :          call zpotrf('U', smat%matsize1, smat%data_c, size(smat%data_c, 1), info)
      90            0 :          if (info .ne. 0) then
      91            0 :             write (*, *) 'Error in zpotrf: info =', info
      92            0 :             call juDFT_error("Diagonalization failed", calledby="chase_diag")
      93              :          end if
      94              : 
      95              :          ! --> solve a' * z' = eig * z' for eigenvalues eig between lb und ub
      96            0 :          zmat%data_c = 0.0
      97            0 :          do n = 1, ne
      98            0 :             eig(ne) = -0.1 + ne*1e-5
      99            0 :             zmat%data_c(ne, ne) = 1.0
     100              :          end do
     101              : 
     102              :          ! --> recover the generalized eigenvectors z by solving z' = l^t * z
     103            0 :          call ztrtrs('U', 'N', 'N', hmat%matsize1, nev, smat%data_c, smat%matsize1, zMat%data_c, zmat%matsize1, info)
     104            0 :          if (info .ne. 0) then
     105            0 :             write (oUnit, *) 'Error in ztrtrs: info =', info
     106            0 :             call juDFT_error("Diagonalization failed", calledby="chase_diag")
     107              :          end if
     108              : 
     109              :       end if
     110            0 :       call timestop("DUMMY DIAG")
     111            0 :    end subroutine dummy_diag
     112              : 
     113          208 : end module m_dummy_diag