Makes dense matrices for the image matrices.
Note
Used for making matrices dense/undense
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_2d_array_type), | intent(inout) | :: | images |
current (undense) matrix images, output is the dense matrix images |
||
type(dbcsr_imagedistribution_obj), | intent(inout) | :: | new_rdist |
the new image distribution for dense matrices |
||
type(array_i1d_obj), | intent(in) | :: | row_map |
mapping of current (undense) rows to dense rows mapping of current (undense) columns to dense columns |
||
type(array_i1d_obj), | intent(in) | :: | col_map |
mapping of current (undense) rows to dense rows mapping of current (undense) columns to dense columns |
||
logical, | intent(in) | :: | join_cols |
make columns dense, default is yes make rows dense, default is yes |
||
logical, | intent(in) | :: | join_rows |
make columns dense, default is yes make rows dense, default is yes |
||
type(dbcsr_type), | intent(in) | :: | new_template |
template dense matrix for creating image matrices |
SUBROUTINE dbcsr_make_images_dense(images, new_rdist, & row_map, col_map, join_cols, join_rows, new_template) !! Makes dense matrices for the image matrices. !! @note Used for making matrices dense/undense TYPE(dbcsr_2d_array_type), INTENT(INOUT) :: images !! current (undense) matrix images, output is the dense matrix images TYPE(dbcsr_imagedistribution_obj), INTENT(INOUT) :: new_rdist !! the new image distribution for dense matrices TYPE(array_i1d_obj), INTENT(IN) :: row_map, col_map !! mapping of current (undense) rows to dense rows !! mapping of current (undense) columns to dense columns LOGICAL, INTENT(IN) :: join_cols, join_rows !! make columns dense, default is yes !! make rows dense, default is yes TYPE(dbcsr_type), INTENT(IN) :: new_template !! template dense matrix for creating image matrices CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_make_images_dense' LOGICAL, PARAMETER :: dbg = .FALSE. INTEGER :: handle, mat_col, mat_row, mat_vpcol, & mat_vprow INTEGER, DIMENSION(:), CONTIGUOUS, POINTER :: und_col_blk_offsets, und_row_blk_offsets INTEGER, DIMENSION(dbcsr_meta_size) :: old_meta REAL(kind=dp) :: cs TYPE(array_i1d_obj) :: dense_local_vcols, dense_local_vrows, & und_local_vcols, und_local_vrows TYPE(dbcsr_imagedistribution_obj) :: old_rdist TYPE(dbcsr_type) :: tmp_mat ! --------------------------------------------------------------------------- CALL timeset(routineN, handle) old_rdist = images%image_dist ! DO mat_row = 1, images%image_dist%i%row_decimation DO mat_col = 1, images%image_dist%i%col_decimation IF (dbg) THEN cs = dbcsr_checksum(images%mats(mat_row, mat_col)) WRITE (*, *) routineN//" cs pre", cs END IF mat_vprow = images%mats(mat_row, mat_col)%index(dbcsr_slot_home_vprow) mat_vpcol = images%mats(mat_row, mat_col)%index(dbcsr_slot_home_vpcol) und_row_blk_offsets => array_data(images%mats(mat_row, mat_col)%row_blk_offset) und_col_blk_offsets => array_data(images%mats(mat_row, mat_col)%col_blk_offset) CALL dbcsr_get_local_vrows(old_rdist, und_local_vrows, mat_vprow) CALL dbcsr_get_local_vcols(old_rdist, und_local_vcols, mat_vpcol) CALL dbcsr_get_local_vrows(new_rdist, dense_local_vrows, mat_vprow) CALL dbcsr_get_local_vcols(new_rdist, dense_local_vcols, mat_vpcol) ! The old matrix has to be remembered so it is copied to ! tmp_mat. old_meta(:) = images%mats(mat_row, mat_col)%index(1:dbcsr_meta_size) tmp_mat = dbcsr_type() tmp_mat = images%mats(mat_row, mat_col) images%mats(mat_row, mat_col) = dbcsr_type() CALL dbcsr_create(images%mats(mat_row, mat_col), template=new_template) images%mats(mat_row, mat_col)%index(dbcsr_slot_home_prow & :dbcsr_slot_home_vpcol) = & old_meta(dbcsr_slot_home_prow:dbcsr_slot_home_vpcol) CALL dbcsr_make_dense_low(tmp_mat, images%mats(mat_row, mat_col), & array_data(und_local_vrows), array_data(und_local_vcols), & und_row_blk_offsets, und_col_blk_offsets, & array_data(dense_local_vrows), & array_data(dense_local_vcols), & array_data(new_template%row_blk_offset), & array_data(new_template%col_blk_offset), & array_data(row_map), array_data(col_map), join_rows, join_cols) ! CALL dbcsr_index_prune_deleted(images%mats(mat_row, mat_col)) ! CALL dbcsr_release(tmp_mat) IF (dbg) THEN cs = dbcsr_checksum(images%mats(mat_row, mat_col)) WRITE (*, *) routineN//" cs pst", cs END IF END DO END DO CALL dbcsr_image_dist_release(images%image_dist) images%image_dist = new_rdist CALL dbcsr_image_dist_hold(images%image_dist) CALL timestop(handle) END SUBROUTINE dbcsr_make_images_dense