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 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 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_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_nfullcols_total, &
20 : dbcsr_nfullrows_total, dbcsr_release, dbcsr_reserve_block2d, dbcsr_set, dbcsr_type, &
21 : dbcsr_type_no_symmetry, dbcsr_work_create
22 : USE kinds, ONLY: dp
23 : #include "./base/base_uses.f90"
24 :
25 : IMPLICIT NONE
26 :
27 : PRIVATE
28 :
29 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mscfg_types'
30 :
31 : INTEGER, PARAMETER, PUBLIC :: mscfg_max_moset_size = 2
32 :
33 : ! Public types
34 : PUBLIC :: molecular_scf_guess_env_type
35 :
36 : ! Public subroutines
37 : PUBLIC :: molecular_scf_guess_env_init, &
38 : molecular_scf_guess_env_destroy, &
39 : get_matrix_from_submatrices
40 :
41 : ! Contains data pertaining to molecular_scf_guess calculations
42 : TYPE molecular_scf_guess_env_type
43 :
44 : ! Useful flags to pass around
45 : LOGICAL :: is_fast_dirty, &
46 : is_crystal
47 :
48 : ! Real data
49 : INTEGER :: nfrags
50 : REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: energy_of_frag
51 : INTEGER, DIMENSION(:), ALLOCATABLE :: nmosets_of_frag
52 : TYPE(dbcsr_type), DIMENSION(:, :), ALLOCATABLE :: mos_of_frag
53 :
54 : END TYPE
55 :
56 : CONTAINS
57 :
58 : ! **************************************************************************************************
59 : !> \brief Allocates data
60 : !> \param env ...
61 : !> \param nfrags number of entries
62 : !> \par History
63 : !> 2014.10 created [Rustam Z Khaliullin]
64 : !> \author Rustam Z Khaliullin
65 : ! **************************************************************************************************
66 10 : SUBROUTINE molecular_scf_guess_env_init(env, nfrags)
67 :
68 : TYPE(molecular_scf_guess_env_type) :: env
69 : INTEGER, INTENT(IN) :: nfrags
70 :
71 : ! check if the number of fragments is already set
72 : !IF (env%nfrags.ne.0) THEN
73 : ! ! do not allow re-initialization
74 : ! ! to prevent recursive calls
75 : ! CPPostcondition(.FALSE.,cp_failure_level,routineP,failure)
76 : !ENDIF
77 :
78 10 : env%nfrags = nfrags
79 10 : IF (nfrags .GT. 0) THEN
80 30 : ALLOCATE (env%energy_of_frag(nfrags))
81 30 : ALLOCATE (env%nmosets_of_frag(nfrags))
82 114 : ALLOCATE (env%mos_of_frag(nfrags, mscfg_max_moset_size))
83 : END IF
84 :
85 10 : END SUBROUTINE molecular_scf_guess_env_init
86 :
87 : ! **************************************************************************************************
88 : !> \brief Destroyes both data and environment
89 : !> \param env ...
90 : !> \par History
91 : !> 2014.10 created [Rustam Z Khaliullin]
92 : !> \author Rustam Z Khaliullin
93 : ! **************************************************************************************************
94 6550 : SUBROUTINE molecular_scf_guess_env_destroy(env)
95 :
96 : TYPE(molecular_scf_guess_env_type) :: env
97 :
98 : INTEGER :: ifrag, jfrag
99 :
100 6550 : IF (ALLOCATED(env%mos_of_frag)) THEN
101 42 : DO ifrag = 1, SIZE(env%mos_of_frag, 1)
102 74 : DO jfrag = 1, env%nmosets_of_frag(ifrag)
103 64 : CALL dbcsr_release(env%mos_of_frag(ifrag, jfrag))
104 : END DO
105 : END DO
106 10 : DEALLOCATE (env%mos_of_frag)
107 : END IF
108 6550 : IF (ALLOCATED(env%energy_of_frag)) DEALLOCATE (env%energy_of_frag)
109 6550 : IF (ALLOCATED(env%nmosets_of_frag)) DEALLOCATE (env%nmosets_of_frag)
110 :
111 6550 : env%nfrags = 0
112 :
113 6550 : END SUBROUTINE molecular_scf_guess_env_destroy
114 :
115 : ! **************************************************************************************************
116 : !> \brief Creates a distributed matrix from MOs on fragments
117 : !> \param mscfg_env env containing MOs of fragments
118 : !> \param matrix_out all existing blocks will be deleted!
119 : !> \param iset which set of MOs in mscfg_env has to be converted (e.g. spin)
120 : !> \par History
121 : !> 10.2014 created [Rustam Z Khaliullin]
122 : !> \author Rustam Z Khaliullin
123 : ! **************************************************************************************************
124 10 : SUBROUTINE get_matrix_from_submatrices(mscfg_env, matrix_out, iset)
125 :
126 : TYPE(molecular_scf_guess_env_type), INTENT(IN) :: mscfg_env
127 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_out
128 : INTEGER, INTENT(IN) :: iset
129 :
130 : CHARACTER(len=*), PARAMETER :: routineN = 'get_matrix_from_submatrices'
131 :
132 : INTEGER :: handle, ifrag
133 : INTEGER, DIMENSION(2) :: matrix_size, offset, submatrix_size
134 : TYPE(dbcsr_type) :: matrix_temp
135 :
136 10 : CALL timeset(routineN, handle)
137 :
138 10 : CPASSERT(iset .LE. mscfg_max_moset_size)
139 :
140 : CALL dbcsr_create(matrix_temp, &
141 : template=matrix_out, &
142 10 : matrix_type=dbcsr_type_no_symmetry)
143 10 : CALL dbcsr_set(matrix_out, 0.0_dp)
144 :
145 10 : matrix_size(1) = dbcsr_nfullrows_total(matrix_out)
146 10 : matrix_size(2) = dbcsr_nfullcols_total(matrix_out)
147 :
148 : ! assume that the initial offset is zero
149 10 : offset(1) = 0
150 10 : offset(2) = 0
151 :
152 42 : DO ifrag = 1, mscfg_env%nfrags
153 :
154 32 : CPASSERT(iset .LE. mscfg_env%nmosets_of_frag(ifrag))
155 :
156 32 : submatrix_size(1) = dbcsr_nfullrows_total(mscfg_env%mos_of_frag(ifrag, iset))
157 32 : submatrix_size(2) = dbcsr_nfullcols_total(mscfg_env%mos_of_frag(ifrag, iset))
158 :
159 : CALL copy_submatrix_into_matrix(mscfg_env%mos_of_frag(ifrag, iset), &
160 32 : matrix_temp, offset, submatrix_size, matrix_size)
161 :
162 32 : CALL dbcsr_add(matrix_out, matrix_temp, 1.0_dp, 1.0_dp)
163 :
164 32 : offset(1) = offset(1) + submatrix_size(1)
165 42 : offset(2) = offset(2) + submatrix_size(2)
166 :
167 : END DO
168 :
169 : ! Check that the accumulated size of submatrices
170 : ! is exactly the same as the size of the big matrix
171 : ! This is to prevent unexpected conversion errors
172 : ! If however such conversion is intended - remove these safeguards
173 10 : CPASSERT(offset(1) .EQ. matrix_size(1))
174 10 : CPASSERT(offset(2) .EQ. matrix_size(2))
175 :
176 10 : CALL dbcsr_release(matrix_temp)
177 :
178 10 : CALL timestop(handle)
179 :
180 10 : 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 32 : 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 32 : INTEGER, DIMENSION(:), POINTER :: blk_distr, blk_sizes, block_sizes_new, col_distr_new, &
205 32 : col_sizes_new, distr_new_array, row_distr_new, row_sizes_new
206 32 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: data_p, p_new_block
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 32 : CALL dbcsr_get_info(submatrix_in, distribution=dist_qs)
214 :
215 96 : DO dimen = 1, 2 ! 1 - row, 2 - column dimension
216 :
217 64 : add_blocks_before(dimen) = 0
218 64 : add_blocks_after = 0
219 64 : start_index = 1
220 64 : trailing_size = matrix_size(dimen) - offset(dimen) - submatrix_size(dimen)
221 64 : IF (offset(dimen) .GT. 0) THEN
222 44 : add_blocks_before(dimen) = add_blocks_before(dimen) + 1
223 44 : start_index = 2
224 : END IF
225 64 : IF (trailing_size .GT. 0) THEN
226 44 : add_blocks_after = add_blocks_after + 1
227 : END IF
228 :
229 64 : IF (dimen == 1) THEN !rows
230 32 : CALL dbcsr_distribution_get(dist_qs, row_dist=blk_distr)
231 32 : CALL dbcsr_get_info(submatrix_in, row_blk_size=blk_sizes)
232 : ELSE !columns
233 32 : CALL dbcsr_distribution_get(dist_qs, col_dist=blk_distr)
234 32 : CALL dbcsr_get_info(submatrix_in, col_blk_size=blk_sizes)
235 : END IF
236 64 : nblocks = SIZE(blk_sizes) ! number of blocks in the small matrix
237 :
238 64 : nblocks_new = nblocks + add_blocks_before(dimen) + add_blocks_after
239 192 : ALLOCATE (block_sizes_new(nblocks_new))
240 192 : ALLOCATE (distr_new_array(nblocks_new))
241 : !IF (ASSOCIATED(cluster_distr)) THEN
242 : !ALLOCATE (cluster_distr_new(nblocks_new))
243 : !END IF
244 64 : IF (add_blocks_before(dimen) .GT. 0) THEN
245 44 : block_sizes_new(1) = offset(dimen)
246 44 : distr_new_array(1) = 0
247 : !IF (ASSOCIATED(cluster_distr)) THEN
248 : !cluster_distr_new(1) = 0
249 : !END IF
250 : END IF
251 416 : block_sizes_new(start_index:nblocks + start_index - 1) = blk_sizes(1:nblocks)
252 416 : 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 64 : IF (add_blocks_after .GT. 0) THEN
257 44 : block_sizes_new(nblocks_new) = trailing_size
258 44 : 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 96 : IF (dimen == 1) THEN !rows
266 32 : row_sizes_new => block_sizes_new
267 32 : row_distr_new => distr_new_array
268 : !row_cluster_new => cluster_distr_new
269 : ELSE !columns
270 32 : col_sizes_new => block_sizes_new
271 32 : 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 32 : 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 32 : reuse_arrays=.TRUE.)
287 32 : 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 32 : CALL dbcsr_work_create(matrix_new, work_mutable=.TRUE.)
294 :
295 : ! iterate over local blocks of the small matrix
296 32 : CALL dbcsr_iterator_start(iter, submatrix_in)
297 :
298 104 : DO WHILE (dbcsr_iterator_blocks_left(iter))
299 :
300 72 : 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 72 : NULLIFY (p_new_block)
307 : CALL dbcsr_reserve_block2d(matrix_new, &
308 : iblock_row + add_blocks_before(1), &
309 : iblock_col + add_blocks_before(2), &
310 72 : p_new_block)
311 :
312 72 : CPASSERT(ASSOCIATED(p_new_block))
313 72 : CPASSERT(SIZE(p_new_block, 1) .EQ. SIZE(data_p, 1))
314 72 : CPASSERT(SIZE(p_new_block, 2) .EQ. SIZE(data_p, 2))
315 :
316 25452 : p_new_block(:, :) = data_p(:, :)
317 :
318 : END DO
319 32 : CALL dbcsr_iterator_stop(iter)
320 :
321 32 : CALL dbcsr_finalize(matrix_new)
322 :
323 : ! finally call complete redistribute to get the matrix of the entire system
324 32 : CALL dbcsr_set(matrix_out, 0.0_dp)
325 32 : CALL dbcsr_complete_redistribute(matrix_new, matrix_out)
326 32 : CALL dbcsr_release(matrix_new)
327 :
328 32 : END SUBROUTINE copy_submatrix_into_matrix
329 :
330 0 : END MODULE mscfg_types
331 :
|
