dbcsr_make_undense Subroutine

   SUBROUTINE dbcsr_make_undense(matrix, undense_matrix, distribution, &
                                 row_blk_offsets, col_blk_offsets, row_blk_sizes, col_blk_sizes, &
                                 row_map, col_map)
      !! Makes a blocked matrix from a dense matrix, inplace
      !! @note Used for making matrices dense/undense

      TYPE(dbcsr_type), INTENT(IN)                       :: matrix
         !! dense matrix
      TYPE(dbcsr_type), INTENT(INOUT)                    :: undense_matrix
         !! matrix to make undense
      TYPE(dbcsr_distribution_obj), INTENT(IN)           :: distribution
         !! distribution of non-dense rows and columns
      TYPE(array_i1d_obj), INTENT(IN)                    :: row_blk_offsets, col_blk_offsets, &
                                                            row_blk_sizes, col_blk_sizes, row_map, &
                                                            col_map
         !! non-dense row block offsets
         !! non-dense column block offsets
         !! non-dense row block sizes
         !! non-dense column block sizes
         !! mapping from non-dense rows
         !! mapping from non-dense columns

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_make_undense'
      LOGICAL, PARAMETER                                 :: dbg = .FALSE.

      INTEGER                                            :: handle, nblkcols_local, nblkcols_total, &
                                                            nblkrows_local, nblkrows_total, &
                                                            nfullcols_local, nfullrows_local
      INTEGER, ALLOCATABLE, DIMENSION(:) :: col_internal_offsets, dense_local_col_blk_offsets, &
                                            dense_local_row_blk_offsets, local_col_blk_offsets, local_row_blk_offsets, &
                                            row_internal_offsets
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: local_cols, local_rows, meta
      REAL(kind=dp)                                      :: cs
      TYPE(dbcsr_data_obj)                               :: blocked_data, dense_data
      TYPE(dbcsr_distribution_obj)                       :: dense_distribution

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)
      IF (dbg) THEN
         cs = dbcsr_checksum(matrix)
         WRITE (*, *) routineN//" prod cs pre", cs
      END IF
      dense_distribution = dbcsr_distribution(matrix)
      nfullrows_local = matrix%nfullrows_local
      nfullcols_local = matrix%nfullcols_local
      nblkrows_local = dbcsr_distribution_nlocal_rows(distribution)
      nblkcols_local = dbcsr_distribution_nlocal_cols(distribution)
      nblkrows_total = dbcsr_distribution_nrows(distribution)
      nblkcols_total = dbcsr_distribution_ncols(distribution)
      local_rows => dbcsr_distribution_local_rows(distribution)
      local_cols => dbcsr_distribution_local_cols(distribution)
      CALL dbcsr_create(undense_matrix, template=matrix, &
                        dist=distribution, &
                        row_blk_size_obj=row_blk_sizes, &
                        col_blk_size_obj=col_blk_sizes)
      ! Restore previous offsets, just to try to keep the same memory.
      CALL array_release(undense_matrix%row_blk_offset)
      CALL array_release(undense_matrix%col_blk_offset)
      undense_matrix%row_blk_offset = row_blk_offsets
      undense_matrix%col_blk_offset = col_blk_offsets
      CALL array_hold(undense_matrix%row_blk_offset)
      CALL array_hold(undense_matrix%col_blk_offset)
      !
      ALLOCATE (local_row_blk_offsets(nblkrows_total + 1))
      ALLOCATE (local_col_blk_offsets(nblkcols_total + 1))
      CALL dbcsr_clearfrom_index_array(undense_matrix, dbcsr_slot_row_p)
      CALL dbcsr_clearfrom_index_array(undense_matrix, dbcsr_slot_col_i)
      CALL dbcsr_clearfrom_index_array(undense_matrix, dbcsr_slot_blk_p)
      CALL dbcsr_addto_index_array(undense_matrix, dbcsr_slot_row_p, &
                                   reservation=nblkrows_total + 1, extra=nblkrows_local*nblkcols_local*2)
      CALL dbcsr_addto_index_array(undense_matrix, dbcsr_slot_col_i, &
                                   reservation=nblkrows_local*nblkcols_local)
      CALL dbcsr_addto_index_array(undense_matrix, dbcsr_slot_blk_p, &
                                   reservation=nblkrows_local*nblkcols_local)
      meta => undense_matrix%index(1:dbcsr_meta_size)
      CALL dbcsr_pack_meta(undense_matrix, meta)
      meta(dbcsr_slot_nblks) = nblkrows_local*nblkcols_local
      meta(dbcsr_slot_nze) = nfullrows_local*nfullcols_local
      CALL global_offsets_to_local(array_data(row_blk_offsets), &
                                   local_rows, local_row_blk_offsets(1:nblkrows_local + 1))
      CALL global_offsets_to_local(array_data(col_blk_offsets), &
                                   local_cols, local_col_blk_offsets(1:nblkcols_local + 1))
      CALL make_undense_index(undense_matrix%row_p, undense_matrix%col_i, undense_matrix%blk_p, &
                              distribution, &
                              local_row_blk_offsets(1:nblkrows_local + 1), &
                              local_col_blk_offsets(1:nblkcols_local + 1), &
                              meta)
      CALL dbcsr_unpack_meta(undense_matrix, meta)
      !
      CALL global_offsets_to_local(array_data(row_blk_offsets), &
                                   local_rows, local_row_blk_offsets)
      CALL global_offsets_to_local(array_data(col_blk_offsets), &
                                   local_cols, local_col_blk_offsets)
      !
      ALLOCATE (dense_local_row_blk_offsets(1 + dbcsr_distribution_nrows(dense_distribution)))
      ALLOCATE (dense_local_col_blk_offsets(1 + dbcsr_distribution_ncols(dense_distribution)))
      CALL global_offsets_to_local(array_data(matrix%row_blk_offset), &
                                   dbcsr_distribution_local_rows(dense_distribution), &
                                   dense_local_row_blk_offsets)
      CALL global_offsets_to_local(array_data(matrix%col_blk_offset), &
                                   dbcsr_distribution_local_cols(dense_distribution), &
                                   dense_local_col_blk_offsets)
      ! Find the offset of blocks within dense rows/columns.  This is needed
      ! since the blocked rows/columns are not necessarily in the same order.
      ALLOCATE (row_internal_offsets(nblkrows_total))
      ALLOCATE (col_internal_offsets(nblkcols_total))
      CALL get_internal_offsets( &
         local_rows, array_data(row_map), &
         local_row_blk_offsets, &
         dense_local_row_blk_offsets, &
         row_internal_offsets)
      CALL get_internal_offsets( &
         local_cols, array_data(col_map), &
         local_col_blk_offsets, &
         dense_local_col_blk_offsets, &
         col_internal_offsets)
      !
      dense_data = matrix%data_area
      CALL dbcsr_data_hold(dense_data)
      CALL dbcsr_data_init(blocked_data)
      CALL dbcsr_data_new(blocked_data, dbcsr_data_get_type(dense_data), &
                          data_size=nfullrows_local*nfullcols_local, &
                          memory_type=dbcsr_data_get_memory_type(dense_data))
      CALL dbcsr_switch_data_area(undense_matrix, blocked_data)
      CALL dbcsr_data_release(blocked_data)
      ! Reshuffle the data
      CALL make_undense_data(undense_matrix, dense_data, &
                             nfullrows_local, nfullcols_local, &
                             dense_local_row_blk_offsets, dense_local_col_blk_offsets, &
                             array_data(row_map), array_data(col_map), &
                             row_internal_offsets, col_internal_offsets)
      CALL dbcsr_data_release(dense_data)
      IF (dbg) THEN
         cs = dbcsr_checksum(matrix)
         WRITE (*, *) routineN//" prod cs pst", cs
      END IF
      DEALLOCATE (local_row_blk_offsets)
      DEALLOCATE (local_col_blk_offsets)
      DEALLOCATE (dense_local_row_blk_offsets)
      DEALLOCATE (dense_local_col_blk_offsets)
      DEALLOCATE (row_internal_offsets)
      DEALLOCATE (col_internal_offsets)
      CALL timestop(handle)
   END SUBROUTINE dbcsr_make_undense