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 tblite matrix build
10 : !> \author JVP
11 : !> \history creation 09.2024
12 : ! **************************************************************************************************
13 :
14 : MODULE tblite_ks_matrix
15 :
16 : USE cp_control_types, ONLY: dft_control_type
17 : USE cp_dbcsr_api, ONLY: dbcsr_add,&
18 : dbcsr_copy,&
19 : dbcsr_multiply,&
20 : dbcsr_p_type,&
21 : dbcsr_type
22 : USE cp_dbcsr_contrib, ONLY: dbcsr_dot
23 : USE kinds, ONLY: dp
24 : USE message_passing, ONLY: mp_para_env_type
25 : USE qs_energy_types, ONLY: qs_energy_type
26 : USE qs_environment_types, ONLY: get_qs_env,&
27 : qs_environment_type
28 : USE qs_ks_types, ONLY: qs_ks_env_type
29 : USE qs_mo_types, ONLY: get_mo_set,&
30 : mo_set_type
31 : USE qs_rho_types, ONLY: qs_rho_get,&
32 : qs_rho_type
33 : USE tblite_interface, ONLY: tb_derive_dH_off,&
34 : tb_ham_add_coulomb,&
35 : tb_update_charges
36 : #include "./base/base_uses.f90"
37 :
38 : IMPLICIT NONE
39 :
40 : PRIVATE
41 :
42 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tblite_ks_matrix'
43 :
44 : PUBLIC :: build_tblite_ks_matrix
45 :
46 : CONTAINS
47 :
48 : ! **************************************************************************************************
49 : !> \brief ...
50 : !> \param qs_env ...
51 : !> \param calculate_forces ...
52 : !> \param just_energy ...
53 : !> \param ext_ks_matrix ...
54 : ! **************************************************************************************************
55 29306 : SUBROUTINE build_tblite_ks_matrix(qs_env, calculate_forces, just_energy, ext_ks_matrix)
56 : TYPE(qs_environment_type), POINTER :: qs_env
57 : LOGICAL, INTENT(in) :: calculate_forces, just_energy
58 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
59 : POINTER :: ext_ks_matrix
60 :
61 : CHARACTER(len=*), PARAMETER :: routineN = 'build_tblite_ks_matrix'
62 :
63 : INTEGER :: handle, img, ispin, nimg, ns, nspins
64 : LOGICAL :: do_efield, force_use_rho
65 : REAL(KIND=dp) :: pc_ener, qmmm_el
66 29306 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_p1, mo_derivs
67 29306 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix, matrix_h
68 : TYPE(dbcsr_type), POINTER :: mo_coeff
69 : TYPE(dft_control_type), POINTER :: dft_control
70 : TYPE(mp_para_env_type), POINTER :: para_env
71 : TYPE(qs_energy_type), POINTER :: energy
72 : TYPE(qs_ks_env_type), POINTER :: ks_env
73 : TYPE(qs_rho_type), POINTER :: rho
74 :
75 29306 : CALL timeset(routineN, handle)
76 :
77 29306 : NULLIFY (dft_control, ks_env, ks_matrix, rho, energy)
78 29306 : CPASSERT(ASSOCIATED(qs_env))
79 :
80 : CALL get_qs_env(qs_env, &
81 : dft_control=dft_control, &
82 : matrix_h_kp=matrix_h, &
83 : para_env=para_env, &
84 : ks_env=ks_env, &
85 : matrix_ks_kp=ks_matrix, &
86 : rho=rho, &
87 29306 : energy=energy)
88 :
89 29306 : IF (PRESENT(ext_ks_matrix)) THEN
90 : ! remap pointer to allow for non-kpoint external ks matrix
91 : ! ext_ks_matrix is used in linear response code
92 2 : ns = SIZE(ext_ks_matrix)
93 2 : ks_matrix(1:ns, 1:1) => ext_ks_matrix(1:ns)
94 : END IF
95 :
96 29306 : energy%qmmm_el = 0.0_dp
97 :
98 29306 : nspins = dft_control%nspins
99 29306 : nimg = dft_control%nimages
100 29306 : CPASSERT(ASSOCIATED(matrix_h))
101 29306 : CPASSERT(ASSOCIATED(rho))
102 87918 : CPASSERT(SIZE(ks_matrix) > 0)
103 :
104 61578 : DO ispin = 1, nspins
105 664836 : DO img = 1, nimg
106 : ! copy the core matrix into the fock matrix
107 635530 : CALL dbcsr_copy(ks_matrix(ispin, img)%matrix, matrix_h(1, img)%matrix)
108 : END DO
109 : END DO
110 :
111 29306 : IF (dft_control%apply_period_efield .OR. dft_control%apply_efield .OR. &
112 : dft_control%apply_efield_field) THEN
113 0 : do_efield = .TRUE.
114 0 : CPABORT("Not implemented yet. Use CP2K routines for GFN1")
115 : ELSE
116 29306 : do_efield = .FALSE.
117 : END IF
118 :
119 29306 : force_use_rho = .NOT. (calculate_forces .AND. nspins > 1)
120 29306 : CALL tb_update_charges(qs_env, dft_control, qs_env%tb_tblite, calculate_forces, force_use_rho)
121 :
122 29306 : CALL tb_ham_add_coulomb(qs_env, qs_env%tb_tblite, dft_control)
123 :
124 29306 : IF (qs_env%qmmm) THEN
125 0 : CPASSERT(SIZE(ks_matrix, 2) == 1)
126 0 : DO ispin = 1, nspins
127 : ! If QM/MM sumup the 1el Hamiltonian
128 : CALL dbcsr_add(ks_matrix(ispin, 1)%matrix, qs_env%ks_qmmm_env%matrix_h(1)%matrix, &
129 0 : 1.0_dp, 1.0_dp)
130 0 : CALL qs_rho_get(rho, rho_ao=matrix_p1)
131 : ! Compute QM/MM Energy
132 : CALL dbcsr_dot(qs_env%ks_qmmm_env%matrix_h(1)%matrix, &
133 0 : matrix_p1(ispin)%matrix, qmmm_el)
134 0 : energy%qmmm_el = energy%qmmm_el + qmmm_el
135 : END DO
136 0 : pc_ener = qs_env%ks_qmmm_env%pc_ener
137 0 : energy%qmmm_el = energy%qmmm_el + pc_ener
138 : END IF
139 :
140 29306 : IF (calculate_forces) THEN
141 152 : CALL tb_derive_dH_off(qs_env, force_use_rho, nimg)
142 : END IF
143 :
144 : ! here we compute dE/dC if needed. Assumes dE/dC is H_{ks}C
145 29306 : IF (qs_env%requires_mo_derivs .AND. .NOT. just_energy) THEN
146 68 : CPASSERT(SIZE(ks_matrix, 2) == 1)
147 : BLOCK
148 68 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mo_array
149 68 : CALL get_qs_env(qs_env, mo_derivs=mo_derivs, mos=mo_array)
150 146 : DO ispin = 1, SIZE(mo_derivs)
151 78 : CALL get_mo_set(mo_set=mo_array(ispin), mo_coeff_b=mo_coeff)
152 78 : CPASSERT(mo_array(ispin)%use_mo_coeff_b)
153 : CALL dbcsr_multiply('n', 'n', 1.0_dp, ks_matrix(ispin, 1)%matrix, mo_coeff, &
154 146 : 0.0_dp, mo_derivs(ispin)%matrix)
155 : END DO
156 : END BLOCK
157 : END IF
158 :
159 29306 : CALL timestop(handle)
160 :
161 29306 : END SUBROUTINE build_tblite_ks_matrix
162 :
163 : END MODULE tblite_ks_matrix
|
