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 : MODULE qs_basis_rotation_methods
10 : USE basis_set_types, ONLY: get_gto_basis_set,&
11 : gto_basis_set_type
12 : USE cell_types, ONLY: cell_type
13 : USE cp_control_types, ONLY: dft_control_type
14 : USE input_constants, ONLY: do_method_dftb
15 : USE kinds, ONLY: dp
16 : USE kpoint_types, ONLY: kind_rotmat_type,&
17 : kpoint_sym_type,&
18 : kpoint_type
19 : USE orbital_pointers, ONLY: nso
20 : USE orbital_transformation_matrices, ONLY: calculate_rotmat,&
21 : orbrotmat_type,&
22 : release_rotmat
23 : USE qs_dftb_types, ONLY: qs_dftb_atom_type
24 : USE qs_dftb_utils, ONLY: get_dftb_atom_param
25 : USE qs_environment_types, ONLY: get_qs_env,&
26 : qs_environment_type
27 : USE qs_kind_types, ONLY: get_qs_kind,&
28 : get_qs_kind_set,&
29 : qs_kind_type
30 : #include "./base/base_uses.f90"
31 :
32 : IMPLICIT NONE
33 :
34 : PRIVATE
35 :
36 : ! Global parameters (only in this module)
37 :
38 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_basis_rotation_methods'
39 :
40 : ! Public subroutines
41 :
42 : PUBLIC :: qs_basis_rotation
43 :
44 : CONTAINS
45 :
46 : ! **************************************************************************************************
47 : !> \brief Construct basis set rotation matrices
48 : !> \param qs_env ...
49 : !> \param kpoints ...
50 : !> \param basis_type ...
51 : !> \param storage_type ...
52 : ! **************************************************************************************************
53 3256 : SUBROUTINE qs_basis_rotation(qs_env, kpoints, basis_type, storage_type)
54 :
55 : TYPE(qs_environment_type), POINTER :: qs_env
56 : TYPE(kpoint_type), POINTER :: kpoints
57 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: basis_type, storage_type
58 :
59 : CHARACTER(LEN=12) :: my_basis, my_storage
60 : INTEGER :: ik, ikind, ir, ira, irot, jr, lval, &
61 : nkind, nrot
62 : REAL(KIND=dp), DIMENSION(3, 3) :: rotmat
63 : TYPE(cell_type), POINTER :: cell
64 : TYPE(dft_control_type), POINTER :: dft_control
65 : TYPE(gto_basis_set_type), POINTER :: orb_basis
66 3256 : TYPE(kind_rotmat_type), DIMENSION(:, :), POINTER :: rotmat_store
67 : TYPE(kpoint_sym_type), POINTER :: kpsym
68 3256 : TYPE(orbrotmat_type), DIMENSION(:), POINTER :: orbrot
69 : TYPE(qs_dftb_atom_type), POINTER :: dftb_parameter
70 3256 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
71 :
72 0 : CPASSERT(ASSOCIATED(qs_env))
73 3256 : CPASSERT(ASSOCIATED(kpoints))
74 3256 : IF (PRESENT(basis_type)) THEN
75 50 : my_basis = basis_type
76 : ELSE
77 3206 : my_basis = "ORB"
78 : END IF
79 3256 : IF (PRESENT(storage_type)) THEN
80 36 : my_storage = storage_type
81 : ELSE
82 3220 : my_storage = "ORB"
83 : END IF
84 3256 : IF (TRIM(my_storage) == "AUX_FIT") THEN
85 36 : rotmat_store => kpoints%kind_rotmat_aux
86 : ELSE
87 3220 : rotmat_store => kpoints%kind_rotmat
88 : END IF
89 3256 : IF (ASSOCIATED(rotmat_store)) THEN
90 2946 : CALL get_qs_env(qs_env, cell=cell)
91 2946 : CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set)
92 2946 : CALL get_qs_kind_set(qs_kind_set, maxlgto=lval, basis_type=my_basis)
93 2946 : nrot = SIZE(rotmat_store, 1)
94 2946 : nkind = SIZE(rotmat_store, 2)
95 : ! remove possible old rotation matrices
96 20252 : DO irot = 1, nrot
97 39404 : DO ikind = 1, nkind
98 36458 : IF (ASSOCIATED(rotmat_store(irot, ikind)%rmat)) THEN
99 0 : DEALLOCATE (rotmat_store(irot, ikind)%rmat)
100 : END IF
101 : END DO
102 : END DO
103 : ! check all rotations needed
104 2946 : NULLIFY (orbrot)
105 2946 : CALL get_qs_env(qs_env, dft_control=dft_control)
106 11846 : DO ik = 1, kpoints%nkp
107 8900 : kpsym => kpoints%kp_sym(ik)%kpoint_sym
108 11846 : IF (kpsym%apply_symmetry) THEN
109 69052 : DO irot = 1, SIZE(kpsym%rotp)
110 66048 : ir = ABS(kpsym%rotp(irot))
111 66048 : ira = 0
112 2590536 : DO jr = 1, SIZE(kpoints%ibrot)
113 2590536 : IF (ir == kpoints%ibrot(jr)) ira = jr
114 : END DO
115 69052 : IF (ira > 0) THEN
116 66048 : IF (.NOT. ASSOCIATED(rotmat_store(ira, 1)%rmat)) THEN
117 193414 : rotmat(1:3, 1:3) = kpsym%rot(1:3, 1:3, irot)
118 14878 : CALL calculate_rotmat(orbrot, rotmat, lval)
119 14878 : IF (dft_control%qs_control%method_id == do_method_dftb) THEN
120 4368 : DO ikind = 1, nkind
121 2576 : CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_parameter)
122 2576 : NULLIFY (rotmat_store(ira, ikind)%rmat)
123 : CALL set_rotmat_dftb(rotmat_store(ira, ikind)%rmat, &
124 4368 : orbrot, dftb_parameter)
125 : END DO
126 : ELSE
127 27202 : DO ikind = 1, nkind
128 14116 : CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis, basis_type=my_basis)
129 14116 : NULLIFY (rotmat_store(ira, ikind)%rmat)
130 27202 : CALL set_rotmat_basis(rotmat_store(ira, ikind)%rmat, orbrot, orb_basis)
131 : END DO
132 : END IF
133 : END IF
134 : END IF
135 : END DO
136 : END IF
137 : END DO
138 2946 : CALL release_rotmat(orbrot)
139 : END IF
140 :
141 3256 : END SUBROUTINE qs_basis_rotation
142 :
143 : ! **************************************************************************************************
144 : !> \brief Construct DFTB basis-set rotation matrices
145 : !> \param rmat ...
146 : !> \param orbrot ...
147 : !> \param dftb_parameter ...
148 : ! **************************************************************************************************
149 2576 : SUBROUTINE set_rotmat_dftb(rmat, orbrot, dftb_parameter)
150 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rmat
151 : TYPE(orbrotmat_type), DIMENSION(:), POINTER :: orbrot
152 : TYPE(qs_dftb_atom_type), POINTER :: dftb_parameter
153 :
154 : INTEGER :: first, i, j, l, lmax, n, natorb
155 : INTEGER, DIMENSION(5) :: perm
156 : LOGICAL :: defined
157 :
158 2576 : CALL get_dftb_atom_param(dftb_parameter, defined=defined, lmax=lmax, natorb=natorb)
159 2576 : CPASSERT(defined)
160 :
161 10304 : ALLOCATE (rmat(natorb, natorb))
162 79696 : rmat = 0.0_dp
163 :
164 2576 : first = 1
165 7648 : DO l = 0, lmax
166 5072 : n = nso(l)
167 2576 : SELECT CASE (l)
168 : CASE (0)
169 2576 : perm(1) = 1
170 : CASE (1)
171 7904 : perm(1:3) = [3, 1, 2]
172 : CASE (2)
173 520 : perm(1:5) = [1, 2, 4, 5, 3]
174 : CASE DEFAULT
175 : CALL cp_abort(__LOCATION__, &
176 5072 : "DFTB k-point symmetry is implemented for basis functions up to d orbitals")
177 : END SELECT
178 16176 : DO i = 1, n
179 49536 : DO j = 1, n
180 44464 : rmat(first + i - 1, first + j - 1) = orbrot(l)%mat(perm(i), perm(j))
181 : END DO
182 : END DO
183 7648 : first = first + n
184 : END DO
185 2576 : CPASSERT(first == natorb + 1)
186 :
187 2576 : END SUBROUTINE set_rotmat_dftb
188 :
189 : ! **************************************************************************************************
190 : !> \brief ...
191 : !> \param rmat ...
192 : !> \param orbrot ...
193 : !> \param basis ...
194 : ! **************************************************************************************************
195 14116 : SUBROUTINE set_rotmat_basis(rmat, orbrot, basis)
196 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rmat
197 : TYPE(orbrotmat_type), DIMENSION(:), POINTER :: orbrot
198 : TYPE(gto_basis_set_type), POINTER :: basis
199 :
200 : INTEGER :: fs1, fs2, iset, ishell, l, nset, nsgf
201 14116 : INTEGER, DIMENSION(:), POINTER :: nshell
202 14116 : INTEGER, DIMENSION(:, :), POINTER :: first_sgf, lshell
203 :
204 14116 : CALL get_gto_basis_set(gto_basis_set=basis, nsgf=nsgf)
205 56464 : ALLOCATE (rmat(nsgf, nsgf))
206 870632 : rmat = 0.0_dp
207 :
208 : CALL get_gto_basis_set(gto_basis_set=basis, nset=nset, nshell=nshell, l=lshell, &
209 14116 : first_sgf=first_sgf)
210 43014 : DO iset = 1, nset
211 84860 : DO ishell = 1, nshell(iset)
212 41846 : l = lshell(ishell, iset)
213 41846 : fs1 = first_sgf(ishell, iset)
214 41846 : fs2 = fs1 + nso(l) - 1
215 446772 : rmat(fs1:fs2, fs1:fs2) = orbrot(l)%mat(1:nso(l), 1:nso(l))
216 : END DO
217 : END DO
218 :
219 28232 : END SUBROUTINE set_rotmat_basis
220 :
221 : END MODULE qs_basis_rotation_methods
|
