Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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
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 10 : 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 10 : env%nfrags = nfrags
78 10 : IF (nfrags .GT. 0) THEN
79 30 : ALLOCATE (env%energy_of_frag(nfrags))
80 30 : ALLOCATE (env%nmosets_of_frag(nfrags))
81 114 : ALLOCATE (env%mos_of_frag(nfrags, mscfg_max_moset_size))
82 : END IF
83 :
84 10 : 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 7320 : SUBROUTINE molecular_scf_guess_env_destroy(env)
94 :
95 : TYPE(molecular_scf_guess_env_type) :: env
96 :
97 : INTEGER :: ifrag, jfrag
98 :
99 7320 : IF (ALLOCATED(env%mos_of_frag)) THEN
100 42 : DO ifrag = 1, SIZE(env%mos_of_frag, 1)
101 74 : DO jfrag = 1, env%nmosets_of_frag(ifrag)
102 64 : CALL dbcsr_release(env%mos_of_frag(ifrag, jfrag))
103 : END DO
104 : END DO
105 10 : DEALLOCATE (env%mos_of_frag)
106 : END IF
107 7320 : IF (ALLOCATED(env%energy_of_frag)) DEALLOCATE (env%energy_of_frag)
108 7320 : IF (ALLOCATED(env%nmosets_of_frag)) DEALLOCATE (env%nmosets_of_frag)
109 :
110 7320 : env%nfrags = 0
111 :
112 7320 : 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 10 : 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 10 : CALL timeset(routineN, handle)
136 :
137 10 : CPASSERT(iset .LE. mscfg_max_moset_size)
138 :
139 : CALL dbcsr_create(matrix_temp, &
140 : template=matrix_out, &
141 10 : matrix_type=dbcsr_type_no_symmetry)
142 10 : CALL dbcsr_set(matrix_out, 0.0_dp)
143 10 : 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 10 : offset(1) = 0
147 10 : offset(2) = 0
148 :
149 42 : DO ifrag = 1, mscfg_env%nfrags
150 :
151 32 : CPASSERT(iset .LE. mscfg_env%nmosets_of_frag(ifrag))
152 :
153 : CALL dbcsr_get_info(mscfg_env%mos_of_frag(ifrag, iset), &
154 32 : nfullrows_total=submatrix_size(1), nfullcols_total=submatrix_size(2))
155 : CALL copy_submatrix_into_matrix(mscfg_env%mos_of_frag(ifrag, iset), &
156 32 : matrix_temp, offset, submatrix_size, matrix_size)
157 :
158 32 : CALL dbcsr_add(matrix_out, matrix_temp, 1.0_dp, 1.0_dp)
159 :
160 32 : offset(1) = offset(1) + submatrix_size(1)
161 42 : offset(2) = offset(2) + submatrix_size(2)
162 :
163 : END DO
164 :
165 : ! Check that the accumulated size of submatrices
166 : ! is exactly the same as the size of the big matrix
167 : ! This is to prevent unexpected conversion errors
168 : ! If however such conversion is intended - remove these safeguards
169 10 : CPASSERT(offset(1) .EQ. matrix_size(1))
170 10 : CPASSERT(offset(2) .EQ. matrix_size(2))
171 :
172 10 : CALL dbcsr_release(matrix_temp)
173 :
174 10 : CALL timestop(handle)
175 :
176 10 : END SUBROUTINE get_matrix_from_submatrices
177 :
178 : ! **************************************************************************************************
179 : !> \brief Copies a distributed dbcsr submatrix into a distributed dbcsr matrix
180 : !> \param submatrix_in ...
181 : !> \param matrix_out all existing blocks will be deleted!
182 : !> \param offset ...
183 : !> \param submatrix_size ...
184 : !> \param matrix_size ...
185 : !> \par History
186 : !> 10.2014 created [Rustam Z Khaliullin]
187 : !> \author Rustam Z Khaliullin
188 : ! **************************************************************************************************
189 64 : SUBROUTINE copy_submatrix_into_matrix(submatrix_in, matrix_out, &
190 : offset, submatrix_size, matrix_size)
191 :
192 : TYPE(dbcsr_type), INTENT(IN) :: submatrix_in
193 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_out
194 : INTEGER, DIMENSION(2), INTENT(IN) :: offset, submatrix_size, matrix_size
195 :
196 : INTEGER :: add_blocks_after, dimen, iblock_col, &
197 : iblock_row, iblock_size, nblocks, &
198 : nblocks_new, start_index, trailing_size
199 : INTEGER, DIMENSION(2) :: add_blocks_before
200 32 : INTEGER, DIMENSION(:), POINTER :: blk_distr, blk_sizes, block_sizes_new, col_distr_new, &
201 32 : col_sizes_new, distr_new_array, row_distr_new, row_sizes_new
202 32 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: data_p
203 : TYPE(dbcsr_distribution_type) :: dist_new, dist_qs
204 : TYPE(dbcsr_iterator_type) :: iter
205 : TYPE(dbcsr_type) :: matrix_new
206 :
207 : ! obtain distribution of the submatrix
208 :
209 32 : CALL dbcsr_get_info(submatrix_in, distribution=dist_qs)
210 :
211 96 : DO dimen = 1, 2 ! 1 - row, 2 - column dimension
212 :
213 64 : add_blocks_before(dimen) = 0
214 64 : add_blocks_after = 0
215 64 : start_index = 1
216 64 : trailing_size = matrix_size(dimen) - offset(dimen) - submatrix_size(dimen)
217 64 : IF (offset(dimen) .GT. 0) THEN
218 44 : add_blocks_before(dimen) = add_blocks_before(dimen) + 1
219 44 : start_index = 2
220 : END IF
221 64 : IF (trailing_size .GT. 0) THEN
222 44 : add_blocks_after = add_blocks_after + 1
223 : END IF
224 :
225 64 : IF (dimen == 1) THEN !rows
226 32 : CALL dbcsr_distribution_get(dist_qs, row_dist=blk_distr)
227 32 : CALL dbcsr_get_info(submatrix_in, row_blk_size=blk_sizes)
228 : ELSE !columns
229 32 : CALL dbcsr_distribution_get(dist_qs, col_dist=blk_distr)
230 32 : CALL dbcsr_get_info(submatrix_in, col_blk_size=blk_sizes)
231 : END IF
232 64 : nblocks = SIZE(blk_sizes) ! number of blocks in the small matrix
233 :
234 64 : nblocks_new = nblocks + add_blocks_before(dimen) + add_blocks_after
235 192 : ALLOCATE (block_sizes_new(nblocks_new))
236 192 : ALLOCATE (distr_new_array(nblocks_new))
237 : !IF (ASSOCIATED(cluster_distr)) THEN
238 : !ALLOCATE (cluster_distr_new(nblocks_new))
239 : !END IF
240 64 : IF (add_blocks_before(dimen) .GT. 0) THEN
241 44 : block_sizes_new(1) = offset(dimen)
242 44 : distr_new_array(1) = 0
243 : !IF (ASSOCIATED(cluster_distr)) THEN
244 : !cluster_distr_new(1) = 0
245 : !END IF
246 : END IF
247 480 : block_sizes_new(start_index:nblocks + start_index - 1) = blk_sizes(1:nblocks)
248 544 : distr_new_array(start_index:nblocks + start_index - 1) = blk_distr(1:nblocks)
249 : !IF (ASSOCIATED(cluster_distr)) THEN
250 : !cluster_distr_new(start_index:nblocks+start_index-1) = cluster_distr(1:nblocks)
251 : !END IF
252 64 : IF (add_blocks_after .GT. 0) THEN
253 44 : block_sizes_new(nblocks_new) = trailing_size
254 44 : distr_new_array(nblocks_new) = 0
255 : !IF (ASSOCIATED(cluster_distr)) THEN
256 : !cluster_distr_new(nblocks_new) = 0
257 : !END IF
258 : END IF
259 :
260 : ! create final arrays
261 96 : IF (dimen == 1) THEN !rows
262 32 : row_sizes_new => block_sizes_new
263 32 : row_distr_new => distr_new_array
264 : !row_cluster_new => cluster_distr_new
265 : ELSE !columns
266 32 : col_sizes_new => block_sizes_new
267 32 : col_distr_new => distr_new_array
268 : !col_cluster_new => cluster_distr_new
269 : END IF
270 : END DO ! both rows and columns are done
271 :
272 : ! Create the distribution
273 : CALL dbcsr_distribution_new(dist_new, template=dist_qs, &
274 : row_dist=row_distr_new, col_dist=col_distr_new, &
275 : !row_cluster=row_cluster_new, col_cluster=col_cluster_new, &
276 32 : reuse_arrays=.TRUE.)
277 :
278 : ! Create big the matrix
279 : CALL dbcsr_create(matrix_new, "BIG_AND_FAKE", &
280 : dist_new, dbcsr_type_no_symmetry, &
281 : row_sizes_new, col_sizes_new, &
282 32 : reuse_arrays=.TRUE.)
283 32 : CALL dbcsr_distribution_release(dist_new)
284 :
285 : !CALL dbcsr_finalize(matrix_new)
286 :
287 : ! copy blocks of the small matrix to the big matrix
288 : !mynode = dbcsr_mp_mynode(dbcsr_distribution_mp(dbcsr_distribution(matrix_new)))
289 32 : CALL dbcsr_work_create(matrix_new, work_mutable=.TRUE.)
290 :
291 : ! iterate over local blocks of the small matrix
292 32 : CALL dbcsr_iterator_readonly_start(iter, submatrix_in)
293 :
294 104 : DO WHILE (dbcsr_iterator_blocks_left(iter))
295 :
296 72 : CALL dbcsr_iterator_next_block(iter, iblock_row, iblock_col, data_p, row_size=iblock_size)
297 :
298 : ! it is important that distribution of the big matrix is the same as
299 : ! that of the small matrix but has the same number of columns and rows
300 : ! as the super-system matrix. this is necessary for complete redistribute
301 : ! to work
302 : CALL dbcsr_put_block(matrix_new, &
303 : row=iblock_row + add_blocks_before(1), &
304 : col=iblock_col + add_blocks_before(2), &
305 104 : block=data_p)
306 :
307 : END DO
308 32 : CALL dbcsr_iterator_stop(iter)
309 :
310 32 : CALL dbcsr_finalize(matrix_new)
311 :
312 : ! finally call complete redistribute to get the matrix of the entire system
313 32 : CALL dbcsr_set(matrix_out, 0.0_dp)
314 32 : CALL dbcsr_complete_redistribute(matrix_new, matrix_out)
315 32 : CALL dbcsr_release(matrix_new)
316 :
317 32 : END SUBROUTINE copy_submatrix_into_matrix
318 :
319 0 : END MODULE mscfg_types
320 :
|
