test_local_redistribute Subroutine

subroutine test_local_redistribute()

Test the local copy, nonempty-target fallback and independent data ownership.

Arguments

None

Source Code

   SUBROUTINE test_local_redistribute()
      !! Test the local copy, nonempty-target fallback and independent data ownership.
      INTEGER, PARAMETER :: types(2) = [dbcsr_type_real_8, dbcsr_type_complex_8]
      CHARACTER, PARAMETER :: syms(2) = [dbcsr_type_no_symmetry, dbcsr_type_hermitian]
      INTEGER, POINTER, CONTIGUOUS :: sizes(:), row_dist(:), col_dist(:)
      TYPE(dbcsr_distribution_obj) :: dist
      TYPE(dbcsr_type) :: source, target
      INTEGER :: i, itype
      REAL(dp) :: reference

      ALLOCATE (sizes(4), row_dist(4), col_dist(4))
      sizes = [1, 3, 2, 4]
      row_dist = [(MOD(i - 1, npdims(1)), i=1, 4)]
      col_dist = [(MOD(i - 1, npdims(2)), i=1, 4)]
      CALL dbcsr_distribution_new(dist, mp_env, row_dist, col_dist)

      DO itype = 1, SIZE(types)
         CALL dbcsr_make_random_matrix(source, sizes, sizes, "source", 0.3_dp, group, &
                                       data_type=types(itype), symmetry=syms(itype))
         CALL dbcsr_create(target, "target", dist, syms(itype), &
                           row_blk_size=sizes, col_blk_size=sizes, data_type=types(itype))
         reference = dbcsr_checksum(source, pos=.TRUE.)

         CALL dbcsr_redistribute(source, target)
         CALL check_copy(target, dist, reference)
         ! Populated targets follow the existing, general redistribution path.
         CALL dbcsr_redistribute(source, target)
         CALL check_copy(target, dist, reference)
         CALL dbcsr_data_clear(source%data_area)
         CALL dbcsr_release(source)
         CALL check_copy(target, dist, reference)

         CALL dbcsr_release(target)
      END DO
      CALL dbcsr_distribution_release(dist)
      DEALLOCATE (sizes, row_dist, col_dist)

   END SUBROUTINE test_local_redistribute