Makes dense matrices for the image matrices.
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