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 Types used to generate the molecular SCF guess
10 : !> \par History
11 : !> 10.2014 created [Rustam Z Khaliullin]
12 : !> \author Rustam Z Khaliullin
13 : ! **************************************************************************************************
14 : MODULE mscfg_types
15 : USE cp_dbcsr_api, ONLY: &
16 : dbcsr_add, dbcsr_complete_redistribute, dbcsr_create, dbcsr_distribution_get, &
17 : dbcsr_distribution_new, dbcsr_distribution_release, dbcsr_distribution_type, &
18 : dbcsr_finalize, dbcsr_get_info, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, &
19 : dbcsr_iterator_readonly_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_put_block, &
20 : dbcsr_release, dbcsr_set, dbcsr_type, dbcsr_type_no_symmetry, dbcsr_work_create
21 : USE kinds, ONLY: dp
22 : #include "./base/base_uses.f90"
23 :
24 : IMPLICIT NONE
25 :
26 : PRIVATE
27 :
28 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mscfg_types'
29 :
30 : INTEGER, PARAMETER, PUBLIC :: mscfg_max_moset_size = 2
31 :
32 : ! Public types
33 : PUBLIC :: molecular_scf_guess_env_type
34 :
35 : ! Public subroutines
36 : PUBLIC :: molecular_scf_guess_env_init, &
37 : molecular_scf_guess_env_destroy, &
38 : get_matrix_from_submatrices
39 :
40 : ! Contains data pertaining to molecular_scf_guess calculations
41 : TYPE molecular_scf_guess_env_type
42 :
43 : ! Useful flags to pass around
44 : LOGICAL :: is_fast_dirty = .FALSE., &
45 : is_crystal = .FALSE.
46 :
47 : ! Real data
48 : INTEGER :: nfrags = -1
49 : REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: energy_of_frag
50 : INTEGER, DIMENSION(:), ALLOCATABLE :: nmosets_of_frag
51 : TYPE(dbcsr_type), DIMENSION(:, :), ALLOCATABLE :: mos_of_frag
52 :
53 : END TYPE molecular_scf_guess_env_type
54 :
55 : CONTAINS
56 :
57 : ! **************************************************************************************************
58 : !> \brief Allocates data
59 : !> \param env ...
60 : !> \param nfrags number of entries
61 : !> \par History
62 : !> 2014.10 created [Rustam Z Khaliullin]
63 : !> \author Rustam Z Khaliullin
64 : ! **************************************************************************************************
65 16 : SUBROUTINE molecular_scf_guess_env_init(env, nfrags)
66 :
67 : TYPE(molecular_scf_guess_env_type) :: env
68 : INTEGER, INTENT(IN) :: nfrags
69 :
70 : ! check if the number of fragments is already set
71 : !IF (env%nfrags.ne.0) THEN
72 : ! ! do not allow re-initialization
73 : ! ! to prevent recursive calls
74 : ! CPPostcondition(.FALSE.,cp_failure_level,routineP,failure)
75 : !ENDIF
76 :
77 16 : env%nfrags = nfrags
78 16 : IF (nfrags > 0) THEN
79 48 : ALLOCATE (env%energy_of_frag(nfrags))
80 48 : ALLOCATE (env%nmosets_of_frag(nfrags))
81 168 : ALLOCATE (env%mos_of_frag(nfrags, mscfg_max_moset_size))
82 : END IF
83 :
84 16 : END SUBROUTINE molecular_scf_guess_env_init
85 :
86 : ! **************************************************************************************************
87 : !> \brief Destroyes both data and environment
88 : !> \param env ...
89 : !> \par History
90 : !> 2014.10 created [Rustam Z Khaliullin]
91 : !> \author Rustam Z Khaliullin
92 : ! **************************************************************************************************
93 8520 : SUBROUTINE molecular_scf_guess_env_destroy(env)
94 :
95 : TYPE(molecular_scf_guess_env_type) :: env
96 :
97 : INTEGER :: ifrag, jfrag
98 :
99 8520 : IF (ALLOCATED(env%mos_of_frag)) THEN
100 60 : DO ifrag = 1, SIZE(env%mos_of_frag, 1)
101 116 : DO jfrag = 1, env%nmosets_of_frag(ifrag)
102 100 : CALL dbcsr_release(env%mos_of_frag(ifrag, jfrag))
103 : END DO
104 : END DO
105 16 : DEALLOCATE (env%mos_of_frag)
106 : END IF
107 8520 : IF (ALLOCATED(env%energy_of_frag)) DEALLOCATE (env%energy_of_frag)
108 8520 : IF (ALLOCATED(env%nmosets_of_frag)) DEALLOCATE (env%nmosets_of_frag)
109 :
110 8520 : env%nfrags = 0
111 :
112 8520 : END SUBROUTINE molecular_scf_guess_env_destroy
113 :
114 : ! **************************************************************************************************
115 : !> \brief Creates a distributed matrix from MOs on fragments
116 : !> \param mscfg_env env containing MOs of fragments
117 : !> \param matrix_out all existing blocks will be deleted!
118 : !> \param iset which set of MOs in mscfg_env has to be converted (e.g. spin)
119 : !> \par History
120 : !> 10.2014 created [Rustam Z Khaliullin]
121 : !> \author Rustam Z Khaliullin
122 : ! **************************************************************************************************
123 22 : SUBROUTINE get_matrix_from_submatrices(mscfg_env, matrix_out, iset)
124 :
125 : TYPE(molecular_scf_guess_env_type), INTENT(IN) :: mscfg_env
126 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_out
127 : INTEGER, INTENT(IN) :: iset
128 :
129 : CHARACTER(len=*), PARAMETER :: routineN = 'get_matrix_from_submatrices'
130 :
131 : INTEGER :: handle, ifrag
132 : INTEGER, DIMENSION(2) :: matrix_size, offset, submatrix_size
133 : TYPE(dbcsr_type) :: matrix_temp
134 :
135 22 : CALL timeset(routineN, handle)
136 :
137 22 : CPASSERT(iset <= mscfg_max_moset_size)
138 :
139 : CALL dbcsr_create(matrix_temp, &
140 : template=matrix_out, &
141 22 : matrix_type=dbcsr_type_no_symmetry)
142 22 : CALL dbcsr_set(matrix_out, 0.0_dp)
143 22 : CALL dbcsr_get_info(matrix_out, nfullrows_total=matrix_size(1), nfullcols_total=matrix_size(2))
144 :
145 : ! assume that the initial offset is zero
146 22 : offset(1) = 0
147 22 : offset(2) = 0
148 :
149 78 : DO ifrag = 1, mscfg_env%nfrags
150 :
151 56 : CPASSERT(iset <= mscfg_env%nmosets_of_frag(ifrag))
152 :
153 : CALL dbcsr_get_info(mscfg_env%mos_of_frag(ifrag, iset), &
154 : nfullrows_total=submatrix_size(1), &
155 56 : nfullcols_total=submatrix_size(2))
156 :
157 : CALL copy_submatrix_into_matrix(mscfg_env%mos_of_frag(ifrag, iset), &
158 56 : matrix_temp, offset, submatrix_size, matrix_size)
159 :
160 56 : CALL dbcsr_add(matrix_out, matrix_temp, 1.0_dp, 1.0_dp)
161 :
162 56 : offset(1) = offset(1) + submatrix_size(1)
163 :
164 78 : offset(2) = offset(2) + submatrix_size(2)
165 :
166 : END DO
167 :
168 : ! Check that the accumulated size of submatrices
169 : ! is exactly the same as the size of the big matrix
170 : ! This is to prevent unexpected conversion errors
171 : ! If however such conversion is intended - remove these safeguards
172 :
173 22 : CPASSERT(offset(1) == matrix_size(1))
174 22 : CPASSERT(offset(2) == matrix_size(2))
175 :
176 22 : CALL dbcsr_release(matrix_temp)
177 :
178 22 : CALL timestop(handle)
179 :
180 22 : END SUBROUTINE get_matrix_from_submatrices
181 :
182 : ! **************************************************************************************************
183 : !> \brief Copies a distributed dbcsr submatrix into a distributed dbcsr matrix
184 : !> \param submatrix_in ...
185 : !> \param matrix_out all existing blocks will be deleted!
186 : !> \param offset ...
187 : !> \param submatrix_size ...
188 : !> \param matrix_size ...
189 : !> \par History
190 : !> 10.2014 created [Rustam Z Khaliullin]
191 : !> \author Rustam Z Khaliullin
192 : ! **************************************************************************************************
193 112 : SUBROUTINE copy_submatrix_into_matrix(submatrix_in, matrix_out, &
194 : offset, submatrix_size, matrix_size)
195 :
196 : TYPE(dbcsr_type), INTENT(IN) :: submatrix_in
197 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_out
198 : INTEGER, DIMENSION(2), INTENT(IN) :: offset, submatrix_size, matrix_size
199 :
200 : INTEGER :: add_blocks_after, dimen, iblock_col, &
201 : iblock_row, iblock_size, nblocks, &
202 : nblocks_new, start_index, trailing_size
203 : INTEGER, DIMENSION(2) :: add_blocks_before
204 56 : INTEGER, DIMENSION(:), POINTER :: blk_distr, blk_sizes, block_sizes_new, col_distr_new, &
205 56 : col_sizes_new, distr_new_array, row_distr_new, row_sizes_new
206 56 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: data_p
207 : TYPE(dbcsr_distribution_type) :: dist_new, dist_qs
208 : TYPE(dbcsr_iterator_type) :: iter
209 : TYPE(dbcsr_type) :: matrix_new
210 :
211 : ! obtain distribution of the submatrix
212 :
213 56 : CALL dbcsr_get_info(submatrix_in, distribution=dist_qs)
214 :
215 168 : DO dimen = 1, 2 ! 1 - row, 2 - column dimension
216 :
217 112 : add_blocks_before(dimen) = 0
218 112 : add_blocks_after = 0
219 112 : start_index = 1
220 112 : trailing_size = matrix_size(dimen) - offset(dimen) - submatrix_size(dimen)
221 112 : IF (offset(dimen) > 0) THEN
222 68 : add_blocks_before(dimen) = add_blocks_before(dimen) + 1
223 68 : start_index = 2
224 : END IF
225 112 : IF (trailing_size > 0) THEN
226 68 : add_blocks_after = add_blocks_after + 1
227 : END IF
228 :
229 112 : IF (dimen == 1) THEN !rows
230 56 : CALL dbcsr_distribution_get(dist_qs, row_dist=blk_distr)
231 56 : CALL dbcsr_get_info(submatrix_in, row_blk_size=blk_sizes)
232 : ELSE !columns
233 56 : CALL dbcsr_distribution_get(dist_qs, col_dist=blk_distr)
234 56 : CALL dbcsr_get_info(submatrix_in, col_blk_size=blk_sizes)
235 : END IF
236 112 : nblocks = SIZE(blk_sizes) ! number of blocks in the small matrix
237 :
238 112 : nblocks_new = nblocks + add_blocks_before(dimen) + add_blocks_after
239 336 : ALLOCATE (block_sizes_new(nblocks_new))
240 224 : ALLOCATE (distr_new_array(nblocks_new))
241 : !IF (ASSOCIATED(cluster_distr)) THEN
242 : !ALLOCATE (cluster_distr_new(nblocks_new))
243 : !END IF
244 112 : IF (add_blocks_before(dimen) > 0) THEN
245 68 : block_sizes_new(1) = offset(dimen)
246 68 : distr_new_array(1) = 0
247 : !IF (ASSOCIATED(cluster_distr)) THEN
248 : !cluster_distr_new(1) = 0
249 : !END IF
250 : END IF
251 736 : block_sizes_new(start_index:nblocks + start_index - 1) = blk_sizes(1:nblocks)
252 736 : distr_new_array(start_index:nblocks + start_index - 1) = blk_distr(1:nblocks)
253 : !IF (ASSOCIATED(cluster_distr)) THEN
254 : !cluster_distr_new(start_index:nblocks+start_index-1) = cluster_distr(1:nblocks)
255 : !END IF
256 112 : IF (add_blocks_after > 0) THEN
257 68 : block_sizes_new(nblocks_new) = trailing_size
258 68 : distr_new_array(nblocks_new) = 0
259 : !IF (ASSOCIATED(cluster_distr)) THEN
260 : !cluster_distr_new(nblocks_new) = 0
261 : !END IF
262 : END IF
263 :
264 : ! create final arrays
265 168 : IF (dimen == 1) THEN !rows
266 56 : row_sizes_new => block_sizes_new
267 56 : row_distr_new => distr_new_array
268 : !row_cluster_new => cluster_distr_new
269 : ELSE !columns
270 56 : col_sizes_new => block_sizes_new
271 56 : col_distr_new => distr_new_array
272 : !col_cluster_new => cluster_distr_new
273 : END IF
274 : END DO ! both rows and columns are done
275 :
276 : ! Create the distribution
277 : CALL dbcsr_distribution_new(dist_new, template=dist_qs, &
278 : row_dist=row_distr_new, col_dist=col_distr_new, &
279 : !row_cluster=row_cluster_new, col_cluster=col_cluster_new, &
280 56 : reuse_arrays=.TRUE.)
281 :
282 : ! Create big the matrix
283 : CALL dbcsr_create(matrix_new, "BIG_AND_FAKE", &
284 : dist_new, dbcsr_type_no_symmetry, &
285 : row_sizes_new, col_sizes_new, &
286 56 : reuse_arrays=.TRUE.)
287 56 : CALL dbcsr_distribution_release(dist_new)
288 :
289 : !CALL dbcsr_finalize(matrix_new)
290 :
291 : ! copy blocks of the small matrix to the big matrix
292 : !mynode = dbcsr_mp_mynode(dbcsr_distribution_mp(dbcsr_distribution(matrix_new)))
293 56 : CALL dbcsr_work_create(matrix_new, work_mutable=.TRUE.)
294 :
295 : ! iterate over local blocks of the small matrix
296 56 : CALL dbcsr_iterator_readonly_start(iter, submatrix_in)
297 :
298 156 : DO WHILE (dbcsr_iterator_blocks_left(iter))
299 :
300 100 : CALL dbcsr_iterator_next_block(iter, iblock_row, iblock_col, data_p, row_size=iblock_size)
301 :
302 : ! it is important that distribution of the big matrix is the same as
303 : ! that of the small matrix but has the same number of columns and rows
304 : ! as the super-system matrix. this is necessary for complete redistribute
305 : ! to work
306 : CALL dbcsr_put_block(matrix_new, &
307 : row=iblock_row + add_blocks_before(1), &
308 : col=iblock_col + add_blocks_before(2), &
309 156 : block=data_p)
310 :
311 : END DO
312 56 : CALL dbcsr_iterator_stop(iter)
313 :
314 56 : CALL dbcsr_finalize(matrix_new)
315 :
316 : ! finally call complete redistribute to get the matrix of the entire system
317 56 : CALL dbcsr_set(matrix_out, 0.0_dp)
318 56 : CALL dbcsr_complete_redistribute(matrix_new, matrix_out)
319 56 : CALL dbcsr_release(matrix_new)
320 :
321 56 : END SUBROUTINE copy_submatrix_into_matrix
322 :
323 0 : END MODULE mscfg_types
324 :
|
