Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Calculation of commutator [H,r] matrices
10 : !> \par History
11 : !> JGH: [7.2016]
12 : !> \author Juerg Hutter
13 : ! **************************************************************************************************
14 : MODULE qs_commutators
15 : USE cell_types, ONLY: cell_type
16 : USE commutator_rkinetic, ONLY: build_com_tr_matrix
17 : USE commutator_rpnl, ONLY: build_com_mom_nl
18 : USE cp_control_types, ONLY: dft_control_type
19 : USE cp_dbcsr_api, ONLY: dbcsr_add,&
20 : dbcsr_create,&
21 : dbcsr_p_type,&
22 : dbcsr_scale,&
23 : dbcsr_set
24 : USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
25 : USE cp_dbcsr_operations, ONLY: dbcsr_allocate_matrix_set,&
26 : dbcsr_deallocate_matrix_set
27 : USE kinds, ONLY: dp
28 : USE particle_types, ONLY: particle_type
29 : USE qs_environment_types, ONLY: get_qs_env,&
30 : qs_environment_type
31 : USE qs_kind_types, ONLY: qs_kind_type
32 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
33 :
34 : !$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num
35 : #include "./base/base_uses.f90"
36 :
37 : IMPLICIT NONE
38 :
39 : PRIVATE
40 :
41 : ! *** Global parameters ***
42 :
43 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_commutators'
44 :
45 : ! *** Public subroutines ***
46 :
47 : PUBLIC :: build_com_hr_matrix
48 :
49 : CONTAINS
50 :
51 : ! **************************************************************************************************
52 : !> \brief Calculation of the [H,r] commutators matrices over Cartesian Gaussian functions.
53 : !> \param qs_env ...
54 : !> \param matrix_hr ...
55 : !> \date 26.07.2016
56 : !> \par History
57 : !> \author JGH
58 : !> \version 1.0
59 : ! **************************************************************************************************
60 0 : SUBROUTINE build_com_hr_matrix(qs_env, matrix_hr)
61 :
62 : TYPE(qs_environment_type), POINTER :: qs_env
63 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
64 : POINTER :: matrix_hr
65 :
66 : CHARACTER(len=*), PARAMETER :: routineN = 'build_com_hr_matrix'
67 :
68 : INTEGER :: handle, ir
69 : REAL(KIND=dp) :: eps_ppnl
70 : TYPE(cell_type), POINTER :: cell
71 0 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_nl
72 0 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s
73 : TYPE(dft_control_type), POINTER :: dft_control
74 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
75 0 : POINTER :: sab_orb, sap_ppnl
76 0 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
77 0 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
78 :
79 0 : CALL timeset(routineN, handle)
80 :
81 0 : NULLIFY (cell, matrix_nl, particle_set, sab_orb, sap_ppnl)
82 : CALL get_qs_env(qs_env=qs_env, sab_orb=sab_orb, sap_ppnl=sap_ppnl, cell=cell, &
83 0 : particle_set=particle_set)
84 : !
85 0 : CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set, dft_control=dft_control)
86 0 : eps_ppnl = dft_control%qs_control%eps_ppnl
87 : !
88 0 : CALL get_qs_env(qs_env=qs_env, matrix_s_kp=matrix_s)
89 0 : CPASSERT(.NOT. ASSOCIATED(matrix_hr))
90 0 : CALL dbcsr_allocate_matrix_set(matrix_hr, 3)
91 0 : DO ir = 1, 3
92 0 : ALLOCATE (matrix_hr(ir)%matrix)
93 : CALL dbcsr_create(matrix_hr(ir)%matrix, template=matrix_s(1, 1)%matrix, &
94 0 : name="COMMUTATOR")
95 0 : CALL cp_dbcsr_alloc_block_from_nbl(matrix_hr(ir)%matrix, sab_orb)
96 0 : CALL dbcsr_set(matrix_hr(ir)%matrix, 0.0_dp)
97 : END DO
98 :
99 0 : CALL build_com_tr_matrix(matrix_hr, qs_kind_set, "ORB", sab_orb)
100 0 : IF (ASSOCIATED(sap_ppnl)) THEN
101 0 : CALL dbcsr_allocate_matrix_set(matrix_nl, 3)
102 0 : DO ir = 1, 3
103 0 : ALLOCATE (matrix_nl(ir)%matrix)
104 : CALL dbcsr_create(matrix_nl(ir)%matrix, template=matrix_s(1, 1)%matrix, &
105 0 : name="NONLOCAL COMMUTATOR")
106 0 : CALL cp_dbcsr_alloc_block_from_nbl(matrix_nl(ir)%matrix, sab_orb)
107 0 : CALL dbcsr_set(matrix_nl(ir)%matrix, 0.0_dp)
108 : END DO
109 :
110 : CALL build_com_mom_nl(qs_kind_set, sab_orb, sap_ppnl, eps_ppnl, particle_set, cell, &
111 0 : matrix_rv=matrix_nl)
112 : ! build_com_mom_nl returns [r,Vnl]; [H,r] requires [Vnl,r].
113 0 : DO ir = 1, 3
114 0 : CALL dbcsr_scale(matrix_nl(ir)%matrix, alpha_scalar=-1.0_dp)
115 0 : CALL dbcsr_add(matrix_hr(ir)%matrix, matrix_nl(ir)%matrix, alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
116 : END DO
117 0 : CALL dbcsr_deallocate_matrix_set(matrix_nl)
118 : END IF
119 :
120 0 : CALL timestop(handle)
121 :
122 0 : END SUBROUTINE build_com_hr_matrix
123 :
124 : END MODULE qs_commutators
|
