Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief Utility functions that are needed for RTP/EMD in combination with
      10             : !>        HF or hybrid functionals (needs to deal with imaginary KS and P
      11             : !> \par History
      12             : !>      2014 created [fschiff]
      13             : !> \author Florina Schiffmann
      14             : ! **************************************************************************************************
      15             : MODULE rt_hfx_utils
      16             :    USE admm_types,                      ONLY: get_admm_env,&
      17             :                                               set_admm_env
      18             :    USE cp_control_types,                ONLY: dft_control_type
      19             :    USE cp_dbcsr_cp2k_link,              ONLY: cp_dbcsr_alloc_block_from_nbl
      20             :    USE cp_dbcsr_operations,             ONLY: dbcsr_allocate_matrix_set,&
      21             :                                               dbcsr_deallocate_matrix_set
      22             :    USE dbcsr_api,                       ONLY: dbcsr_create,&
      23             :                                               dbcsr_p_type,&
      24             :                                               dbcsr_set,&
      25             :                                               dbcsr_type_antisymmetric
      26             :    USE kinds,                           ONLY: dp
      27             :    USE qs_environment_types,            ONLY: get_qs_env,&
      28             :                                               qs_environment_type
      29             :    USE qs_neighbor_list_types,          ONLY: neighbor_list_set_p_type
      30             :    USE qs_rho_types,                    ONLY: qs_rho_get,&
      31             :                                               qs_rho_set,&
      32             :                                               qs_rho_type
      33             : #include "../base/base_uses.f90"
      34             : 
      35             :    IMPLICIT NONE
      36             :    PRIVATE
      37             : 
      38             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rt_hfx_utils'
      39             : 
      40             :    PUBLIC :: rtp_hfx_rebuild
      41             : 
      42             : !***
      43             : CONTAINS
      44             : ! **************************************************************************************************
      45             : !> \brief rebuilds the structures of P and KS (imaginary) in case S changed
      46             : !> \param qs_env ...
      47             : !> \author Florian Schiffmann
      48             : ! **************************************************************************************************
      49          32 :    SUBROUTINE rtp_hfx_rebuild(qs_env)
      50             :       TYPE(qs_environment_type), POINTER                 :: qs_env
      51             : 
      52          32 :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: matrix_ks_aux_im, matrix_s_aux, &
      53          32 :                                                             rho_aux_ao_im
      54             :       TYPE(dft_control_type), POINTER                    :: dft_control
      55             :       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
      56          32 :          POINTER                                         :: sab_aux
      57             :       TYPE(qs_rho_type), POINTER                         :: rho_aux
      58             : 
      59          32 :       NULLIFY (dft_control)
      60          32 :       NULLIFY (sab_aux, rho_aux, rho_aux_ao_im, matrix_ks_aux_im, matrix_s_aux)
      61             : 
      62             :       CALL get_qs_env(qs_env, &
      63          32 :                       dft_control=dft_control)
      64             : 
      65          32 :       IF (dft_control%do_admm) THEN
      66             :          CALL get_admm_env(qs_env%admm_env, &
      67             :                            matrix_s_aux_fit=matrix_s_aux, &
      68             :                            sab_aux_fit=sab_aux, &
      69             :                            rho_aux_fit=rho_aux, &
      70           8 :                            matrix_ks_aux_fit_im=matrix_ks_aux_im)
      71           8 :          CALL qs_rho_get(rho_aux, rho_ao_im=rho_aux_ao_im)
      72             :          CALL rebuild_matrices(rho_aux_ao_im, matrix_ks_aux_im, sab_aux, matrix_s_aux, &
      73           8 :                                dft_control%nspins)
      74           8 :          CALL set_admm_env(qs_env%admm_env, matrix_ks_aux_fit_im=matrix_ks_aux_im)
      75           8 :          CALL qs_rho_set(rho_aux, rho_ao_im=rho_aux_ao_im)
      76             :       END IF
      77             : 
      78          32 :    END SUBROUTINE rtp_hfx_rebuild
      79             : 
      80             : ! **************************************************************************************************
      81             : !> \brief does the actual rebuilding of P and KS (imaginary) in case S changed
      82             : !> \param matrix_p ...
      83             : !> \param matrix_ks ...
      84             : !> \param sab_orb ...
      85             : !> \param matrix_s ...
      86             : !> \param nspins ...
      87             : !> \author Florian Schiffmann
      88             : ! **************************************************************************************************
      89             : 
      90           8 :    SUBROUTINE rebuild_matrices(matrix_p, matrix_ks, sab_orb, matrix_s, nspins)
      91             :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: matrix_p, matrix_ks
      92             :       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
      93             :          POINTER                                         :: sab_orb
      94             :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: matrix_s
      95             :       INTEGER, INTENT(in)                                :: nspins
      96             : 
      97             :       INTEGER                                            :: i
      98             : 
      99           8 :       IF (ASSOCIATED(matrix_p)) THEN
     100           0 :          CALL dbcsr_deallocate_matrix_set(matrix_p)
     101             :       END IF
     102             :       ! Create a new density matrix set
     103           8 :       CALL dbcsr_allocate_matrix_set(matrix_p, nspins)
     104          16 :       DO i = 1, nspins
     105           8 :          ALLOCATE (matrix_p(i)%matrix)
     106             :          CALL dbcsr_create(matrix=matrix_p(i)%matrix, template=matrix_s(1)%matrix, &
     107           8 :                            name="Imaginary density matrix", matrix_type=dbcsr_type_antisymmetric, nze=0)
     108           8 :          CALL cp_dbcsr_alloc_block_from_nbl(matrix_p(i)%matrix, sab_orb)
     109          16 :          CALL dbcsr_set(matrix_p(i)%matrix, 0.0_dp)
     110             :       END DO
     111             : 
     112           8 :       IF (ASSOCIATED(matrix_ks)) THEN
     113           0 :          CALL dbcsr_deallocate_matrix_set(matrix_ks)
     114             :       END IF
     115             :       ! Create a new density matrix set
     116           8 :       CALL dbcsr_allocate_matrix_set(matrix_ks, nspins)
     117          16 :       DO i = 1, nspins
     118           8 :          ALLOCATE (matrix_ks(i)%matrix)
     119             :          CALL dbcsr_create(matrix=matrix_ks(i)%matrix, template=matrix_s(1)%matrix, &
     120           8 :                            name="Imaginary Kohn-Sham matrix", matrix_type=dbcsr_type_antisymmetric, nze=0)
     121           8 :          CALL cp_dbcsr_alloc_block_from_nbl(matrix_ks(i)%matrix, sab_orb)
     122          16 :          CALL dbcsr_set(matrix_ks(i)%matrix, 0.0_dp)
     123             :       END DO
     124             : 
     125           8 :    END SUBROUTINE rebuild_matrices
     126             : 
     127             : END MODULE rt_hfx_utils