make_m2s Subroutine

   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