dbcsr_make_images_dense Subroutine

private 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

Arguments

Type IntentOptional 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


Source Code

   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