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 type for berry phase efield matrices. At the moment only used for
      10             : !>        cosmat and sinmat
      11             : !> \par History
      12             : !>      none
      13             : !> \author fschiff (06.2010)
      14             : ! **************************************************************************************************
      15             : 
      16             : MODULE qs_period_efield_types
      17             : 
      18             :    USE cp_dbcsr_api,                    ONLY: dbcsr_p_type
      19             :    USE cp_dbcsr_operations,             ONLY: dbcsr_deallocate_matrix_set
      20             :    USE kinds,                           ONLY: dp
      21             : #include "./base/base_uses.f90"
      22             : 
      23             :    IMPLICIT NONE
      24             : 
      25             :    PRIVATE
      26             : 
      27             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_period_efield_types'
      28             : 
      29             :    PUBLIC :: efield_berry_type, efield_berry_release, init_efield_matrices, &
      30             :              set_efield_matrices
      31             : 
      32             :    TYPE efield_berry_type
      33             :       REAL(KIND=dp)                                          :: field_energy = -1.0_dp
      34             :       REAL(KIND=dp), DIMENSION(3)                            :: polarisation = -1.0_dp
      35             :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER           :: cosmat => NULL()
      36             :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER           :: sinmat => NULL()
      37             :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER           :: dipmat => NULL()
      38             :    END TYPE efield_berry_type
      39             : 
      40             : CONTAINS
      41             : 
      42             : ! **************************************************************************************************
      43             : !> \brief ...
      44             : !> \param efield ...
      45             : ! **************************************************************************************************
      46        1274 :    SUBROUTINE init_efield_matrices(efield)
      47             :       TYPE(efield_berry_type), POINTER                   :: efield
      48             : 
      49             :       REAL(KIND=dp)                                      :: field_energy
      50             :       REAL(KIND=dp), DIMENSION(3)                        :: polarisation
      51             : 
      52             : ! retain possible values for energy and polarisation
      53             : 
      54        1274 :       IF (ASSOCIATED(efield)) THEN
      55        1026 :          field_energy = efield%field_energy
      56        4104 :          polarisation = efield%polarisation
      57        1026 :          CALL efield_berry_release(efield)
      58             :       ELSE
      59         248 :          field_energy = 0.0_dp
      60         248 :          polarisation = 0.0_dp
      61             :       END IF
      62             : 
      63        6370 :       ALLOCATE (efield)
      64             :       NULLIFY (efield%cosmat)
      65             :       NULLIFY (efield%sinmat)
      66             :       NULLIFY (efield%dipmat)
      67             : 
      68        1274 :       efield%field_energy = field_energy
      69        5096 :       efield%polarisation = polarisation
      70             : 
      71        1274 :    END SUBROUTINE init_efield_matrices
      72             : 
      73             : ! **************************************************************************************************
      74             : !> \brief ...
      75             : !> \param efield ...
      76             : !> \param sinmat ...
      77             : !> \param cosmat ...
      78             : !> \param dipmat ...
      79             : ! **************************************************************************************************
      80         942 :    SUBROUTINE set_efield_matrices(efield, sinmat, cosmat, dipmat)
      81             : 
      82             :       TYPE(efield_berry_type), POINTER                   :: efield
      83             :       TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
      84             :          POINTER                                         :: sinmat, cosmat, dipmat
      85             : 
      86         942 :       IF (PRESENT(cosmat)) efield%cosmat => cosmat
      87         942 :       IF (PRESENT(sinmat)) efield%sinmat => sinmat
      88         942 :       IF (PRESENT(dipmat)) efield%dipmat => dipmat
      89             : 
      90         942 :    END SUBROUTINE set_efield_matrices
      91             : 
      92             : ! **************************************************************************************************
      93             : !> \brief ...
      94             : !> \param efield ...
      95             : ! **************************************************************************************************
      96       14407 :    SUBROUTINE efield_berry_release(efield)
      97             :       TYPE(efield_berry_type), POINTER                   :: efield
      98             : 
      99       14407 :       IF (ASSOCIATED(efield)) THEN
     100        1274 :          IF (ASSOCIATED(efield%sinmat) .AND. ASSOCIATED(efield%cosmat)) THEN
     101         144 :             CALL dbcsr_deallocate_matrix_set(efield%cosmat)
     102         144 :             CALL dbcsr_deallocate_matrix_set(efield%sinmat)
     103             :          END IF
     104        1274 :          IF (ASSOCIATED(efield%dipmat)) THEN
     105         798 :             CALL dbcsr_deallocate_matrix_set(efield%dipmat)
     106             :          END IF
     107        1274 :          DEALLOCATE (efield)
     108             :       END IF
     109       14407 :    END SUBROUTINE efield_berry_release
     110             : 
     111           0 : END MODULE qs_period_efield_types