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
23 #include "./base/base_uses.f90"
29 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'mscfg_types'
34 PUBLIC :: molecular_scf_guess_env_type
42 TYPE molecular_scf_guess_env_type
45 LOGICAL :: is_fast_dirty, &
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
68 TYPE(molecular_scf_guess_env_type) :: env
69 INTEGER,
INTENT(IN) :: nfrags
79 IF (nfrags .GT. 0)
THEN
80 ALLOCATE (env%energy_of_frag(nfrags))
81 ALLOCATE (env%nmosets_of_frag(nfrags))
96 TYPE(molecular_scf_guess_env_type) :: env
98 INTEGER :: ifrag, jfrag
100 IF (
ALLOCATED(env%mos_of_frag))
THEN
101 DO ifrag = 1,
SIZE(env%mos_of_frag, 1)
102 DO jfrag = 1, env%nmosets_of_frag(ifrag)
103 CALL dbcsr_release(env%mos_of_frag(ifrag, jfrag))
106 DEALLOCATE (env%mos_of_frag)
108 IF (
ALLOCATED(env%energy_of_frag))
DEALLOCATE (env%energy_of_frag)
109 IF (
ALLOCATED(env%nmosets_of_frag))
DEALLOCATE (env%nmosets_of_frag)
126 TYPE(molecular_scf_guess_env_type),
INTENT(IN) :: mscfg_env
127 TYPE(dbcsr_type),
INTENT(INOUT) :: matrix_out
128 INTEGER,
INTENT(IN) :: iset
130 CHARACTER(len=*),
PARAMETER :: routinen =
'get_matrix_from_submatrices'
132 INTEGER :: handle, ifrag
133 INTEGER,
DIMENSION(2) :: matrix_size, offset, submatrix_size
134 TYPE(dbcsr_type) :: matrix_temp
136 CALL timeset(routinen, handle)
140 CALL dbcsr_create(matrix_temp, &
141 template=matrix_out, &
142 matrix_type=dbcsr_type_no_symmetry)
143 CALL dbcsr_set(matrix_out, 0.0_dp)
145 matrix_size(1) = dbcsr_nfullrows_total(matrix_out)
146 matrix_size(2) = dbcsr_nfullcols_total(matrix_out)
152 DO ifrag = 1, mscfg_env%nfrags
154 cpassert(iset .LE. mscfg_env%nmosets_of_frag(ifrag))
156 submatrix_size(1) = dbcsr_nfullrows_total(mscfg_env%mos_of_frag(ifrag, iset))
157 submatrix_size(2) = dbcsr_nfullcols_total(mscfg_env%mos_of_frag(ifrag, iset))
159 CALL copy_submatrix_into_matrix(mscfg_env%mos_of_frag(ifrag, iset), &
160 matrix_temp, offset, submatrix_size, matrix_size)
162 CALL dbcsr_add(matrix_out, matrix_temp, 1.0_dp, 1.0_dp)
164 offset(1) = offset(1) + submatrix_size(1)
165 offset(2) = offset(2) + submatrix_size(2)
173 cpassert(offset(1) .EQ. matrix_size(1))
174 cpassert(offset(2) .EQ. matrix_size(2))
176 CALL dbcsr_release(matrix_temp)
178 CALL timestop(handle)
193 SUBROUTINE copy_submatrix_into_matrix(submatrix_in, matrix_out, &
194 offset, submatrix_size, matrix_size)
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
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 INTEGER,
DIMENSION(:),
POINTER :: blk_distr, blk_sizes, block_sizes_new, col_distr_new, &
205 col_sizes_new, distr_new_array, row_distr_new, row_sizes_new
206 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
213 CALL dbcsr_get_info(submatrix_in, distribution=dist_qs)
217 add_blocks_before(dimen) = 0
220 trailing_size = matrix_size(dimen) - offset(dimen) - submatrix_size(dimen)
221 IF (offset(dimen) .GT. 0)
THEN
222 add_blocks_before(dimen) = add_blocks_before(dimen) + 1
225 IF (trailing_size .GT. 0)
THEN
226 add_blocks_after = add_blocks_after + 1
230 CALL dbcsr_distribution_get(dist_qs, row_dist=blk_distr)
231 CALL dbcsr_get_info(submatrix_in, row_blk_size=blk_sizes)
233 CALL dbcsr_distribution_get(dist_qs, col_dist=blk_distr)
234 CALL dbcsr_get_info(submatrix_in, col_blk_size=blk_sizes)
236 nblocks =
SIZE(blk_sizes)
238 nblocks_new = nblocks + add_blocks_before(dimen) + add_blocks_after
239 ALLOCATE (block_sizes_new(nblocks_new))
240 ALLOCATE (distr_new_array(nblocks_new))
244 IF (add_blocks_before(dimen) .GT. 0)
THEN
245 block_sizes_new(1) = offset(dimen)
246 distr_new_array(1) = 0
251 block_sizes_new(start_index:nblocks + start_index - 1) = blk_sizes(1:nblocks)
252 distr_new_array(start_index:nblocks + start_index - 1) = blk_distr(1:nblocks)
256 IF (add_blocks_after .GT. 0)
THEN
257 block_sizes_new(nblocks_new) = trailing_size
258 distr_new_array(nblocks_new) = 0
266 row_sizes_new => block_sizes_new
267 row_distr_new => distr_new_array
270 col_sizes_new => block_sizes_new
271 col_distr_new => distr_new_array
277 CALL dbcsr_distribution_new(dist_new, template=dist_qs, &
278 row_dist=row_distr_new, col_dist=col_distr_new, &
283 CALL dbcsr_create(matrix_new,
"BIG_AND_FAKE", &
284 dist_new, dbcsr_type_no_symmetry, &
285 row_sizes_new, col_sizes_new, &
287 CALL dbcsr_distribution_release(dist_new)
293 CALL dbcsr_work_create(matrix_new, work_mutable=.true.)
296 CALL dbcsr_iterator_start(iter, submatrix_in)
298 DO WHILE (dbcsr_iterator_blocks_left(iter))
300 CALL dbcsr_iterator_next_block(iter, iblock_row, iblock_col, data_p, row_size=iblock_size)
306 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), &
312 cpassert(
ASSOCIATED(p_new_block))
313 cpassert(
SIZE(p_new_block, 1) .EQ.
SIZE(data_p, 1))
314 cpassert(
SIZE(p_new_block, 2) .EQ.
SIZE(data_p, 2))
316 p_new_block(:, :) = data_p(:, :)
319 CALL dbcsr_iterator_stop(iter)
321 CALL dbcsr_finalize(matrix_new)
324 CALL dbcsr_set(matrix_out, 0.0_dp)
325 CALL dbcsr_complete_redistribute(matrix_new, matrix_out)
326 CALL dbcsr_release(matrix_new)
328 END SUBROUTINE copy_submatrix_into_matrix
Defines the basic variable types.
integer, parameter, public dp
Types used to generate the molecular SCF guess.
integer, parameter, public mscfg_max_moset_size
subroutine, public get_matrix_from_submatrices(mscfg_env, matrix_out, iset)
Creates a distributed matrix from MOs on fragments.
subroutine, public molecular_scf_guess_env_destroy(env)
Destroyes both data and environment.
subroutine, public molecular_scf_guess_env_init(env, nfrags)
Allocates data.