Make images from the matrix (left or right)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | matrix | |||
type(dbcsr_2d_array_type), | intent(out), | POINTER | :: | m2s | ||
type(dbcsr_imagedistribution_obj), | intent(inout) | :: | rdist | |||
type(dbcsr_imagedistribution_obj), | intent(inout) | :: | dense_rdist | |||
logical, | intent(in) | :: | use_dense_mult | |||
logical, | intent(in) | :: | ab_dense | |||
character, | intent(in) | :: | predistribute | |||
integer, | intent(in) | :: | f_k | |||
integer, | intent(in) | :: | l_k | |||
integer, | intent(in) | :: | f_row | |||
integer, | intent(in) | :: | l_row | |||
integer, | intent(in) | :: | f_col | |||
integer, | intent(in) | :: | l_col | |||
type(array_i1d_obj), | intent(inout) | :: | row_blk_size | |||
type(array_i1d_obj), | intent(inout) | :: | col_blk_size | |||
type(array_i1d_obj), | intent(in) | :: | k_vmap | |||
type(array_i1d_obj), | intent(in) | :: | m_map | |||
type(array_i1d_obj), | intent(in) | :: | n_map | |||
type(dbcsr_scalar_type), | intent(in), | optional | :: | alpha |
SUBROUTINE make_m2s(matrix, m2s, rdist, dense_rdist, &
!! Make images from the matrix (left or right)
use_dense_mult, ab_dense, predistribute, &
f_k, l_k, f_row, l_row, f_col, l_col, &
row_blk_size, col_blk_size, &
k_vmap, m_map, n_map, &
alpha)
TYPE(dbcsr_type), INTENT(IN) :: matrix
TYPE(dbcsr_2d_array_type), INTENT(OUT), POINTER :: m2s
TYPE(dbcsr_imagedistribution_obj), INTENT(INOUT) :: rdist, dense_rdist
LOGICAL, INTENT(IN) :: use_dense_mult, ab_dense
CHARACTER, INTENT(IN) :: predistribute
INTEGER, INTENT(IN) :: f_k, l_k, f_row, l_row, f_col, l_col
TYPE(array_i1d_obj), INTENT(INOUT) :: row_blk_size, col_blk_size
TYPE(array_i1d_obj), INTENT(IN) :: k_vmap, m_map, n_map
TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL :: alpha
CHARACTER(len=*), PARAMETER :: routineN = 'make_m2s'
INTEGER :: handle, i, im, j, jm
INTEGER, DIMENSION(4) :: f_crop
LOGICAL :: do_scale, thread_redist
TYPE(array_i1d_obj) :: col_map, row_map
TYPE(dbcsr_type) :: dense_template, matrix_tmp
CALL timeset(routineN, handle)
ALLOCATE (m2s)
do_scale = .FALSE.
IF (PRESENT(alpha)) THEN
IF (.NOT. dbcsr_scalar_are_equal(alpha, dbcsr_scalar_one(alpha%data_type))) THEN
do_scale = .TRUE.
END IF
END IF
IF (do_scale) THEN
! Copy and scale matrix if alpha is not 1.
CALL dbcsr_make_images(matrix, m2s, rdist, &
predistribute=predistribute, &
no_copy_data=use_dense_mult, scale_value=alpha)
ELSE
CALL dbcsr_make_images(matrix, m2s, rdist, &
predistribute=predistribute, &
no_copy_data=use_dense_mult)
END IF
im = SIZE(m2s%mats, 1)
jm = SIZE(m2s%mats, 2)
SELECT CASE (predistribute)
CASE ('L')
f_crop = (/f_row, l_row, f_k, l_k/)
row_map = m_map
col_map = k_vmap
thread_redist = .TRUE.
CASE default
f_crop = (/f_k, l_k, f_col, l_col/)
row_map = k_vmap
col_map = n_map
thread_redist = .FALSE.
END SELECT
! Post-processing of images.
DO i = 1, im
DO j = 1, jm
CALL dbcsr_reset_vlocals(m2s%mats(i, j), rdist)
! Crop if necessary
IF (ANY(f_crop .NE. 0)) THEN
matrix_tmp = dbcsr_type()
CALL dbcsr_crop_matrix(matrix_tmp, m2s%mats(i, j), &
full_row_bounds=f_crop(1:2), &
full_column_bounds=f_crop(3:4), &
shallow_data=.FALSE.)
CALL dbcsr_release(m2s%mats(i, j))
CALL dbcsr_copy(m2s%mats(i, j), matrix_tmp, shallow_data=.TRUE.)
CALL dbcsr_release(matrix_tmp)
CALL dbcsr_reset_vlocals(m2s%mats(i, j), rdist)
END IF
END DO
END DO
IF (ab_dense) THEN
dense_template = dbcsr_type()
CALL dbcsr_create(dense_template, template=matrix, &
dist=dense_rdist%i%main, &
row_blk_size_obj=row_blk_size, col_blk_size_obj=col_blk_size)
CALL dbcsr_make_images_dense(m2s, dense_rdist, &
row_map=row_map, col_map=col_map, &
join_cols=use_dense_mult, join_rows=ab_dense, &
new_template=dense_template)
CALL dbcsr_image_dist_release(rdist)
rdist = dense_rdist
CALL dbcsr_image_dist_hold(rdist)
DO i = 1, im
DO j = 1, jm
CALL dbcsr_reset_vlocals(m2s%mats(i, j), rdist)
END DO
END DO
END IF
DO i = 1, im
DO j = 1, jm
! Convert to local-row index
CALL dbcsr_make_index_local_row(m2s%mats(i, j))
! Convert to list index
CALL dbcsr_make_index_list(m2s%mats(i, j), thread_redist=thread_redist)
END DO
END DO
IF (ab_dense) THEN
CALL dbcsr_image_dist_release(dense_rdist)
CALL dbcsr_release(dense_template)
END IF
CALL timestop(handle)
END SUBROUTINE make_m2s