tree_to_linear_s Subroutine

private subroutine tree_to_linear_s(wm)

Converts mutable data to linear (array) type.


Type IntentOptional Attributes Name
type(dbcsr_work_type), intent(inout) :: wm

work matrix to convert


Source Code

Source Code

      SUBROUTINE tree_to_linear_s (wm)
     !! Converts mutable data to linear (array) type.

         USE dbcsr_btree, &
            ONLY: btree_2d_data_s => btree_data_sp2d, &
                  btree_destroy_s => btree_delete, &
                  btree_size_s => btree_get_entries
         TYPE(dbcsr_work_type), INTENT(INOUT)     :: wm
        !! work matrix to convert

         CHARACTER(len=*), PARAMETER :: routineN = 'tree_to_linear_s'

         INTEGER                                  :: blk, blk_p, treesize, &
                                                     error_handler, needed_size
         INTEGER(KIND=int_8), ALLOCATABLE, &
            DIMENSION(:)                           :: keys
         REAL(kind=real_4), DIMENSION(:), POINTER, CONTIGUOUS :: target_data
         REAL(kind=real_4), DIMENSION(:, :), POINTER        :: block_2d
         TYPE(btree_2d_data_s), ALLOCATABLE, &
            DIMENSION(:)                           :: values

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

         CALL timeset(routineN, error_handler)
         ! srt = .TRUE. ! Not needed because of the copy
         treesize = btree_size_s (wm%mutable%m%btree_s)
         IF (wm%lastblk .NE. treesize) &
            DBCSR_ABORT("Mismatch in number of blocks")
         ALLOCATE (keys(treesize), values(treesize))
         CALL btree_destroy_s (wm%mutable%m%btree_s, keys, values)
         CALL ensure_array_size(wm%row_i, ub=treesize)
         CALL ensure_array_size(wm%col_i, ub=treesize)
         CALL dbcsr_unpack_i8_2i4(keys, wm%row_i, &
         ! For now we also fill the data, sloooowly, but this should
         ! be avoided and the data should be copied directly from the
         ! source in the subroutine's main loop.
         CALL ensure_array_size(wm%blk_p, ub=treesize)
         needed_size = 0
         DO blk = 1, treesize
            block_2d => values(blk)%p
            needed_size = needed_size + SIZE(block_2d)
         END DO
         wm%datasize = needed_size
         CALL dbcsr_data_ensure_size(wm%data_area, &
         target_data => dbcsr_get_data_p_s (wm%data_area)
         blk_p = 1
         DO blk = 1, treesize
            block_2d => values(blk)%p
            IF (.NOT. values(blk)%tr) THEN
               wm%blk_p(blk) = blk_p
               wm%blk_p(blk) = -blk_p
            END IF
            CALL block_copy_s (target_data, block_2d, &
                                           SIZE(block_2d), blk_p, 1)
            blk_p = blk_p + SIZE(block_2d)
            DEALLOCATE (block_2d)
         END DO
         DEALLOCATE (keys, values)
         CALL dbcsr_mutable_release(wm%mutable)
         CALL timestop(error_handler)
      END SUBROUTINE tree_to_linear_s