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