make_random_dbcsr_matrix Subroutine

subroutine make_random_dbcsr_matrix(matrix_a, group, col_blk_sizes, row_blk_sizes, col_dist, row_dist, sparsity)

Create a DBCSR matrix with random values and random blocks

Arguments

Type IntentOptional Attributes Name
type(dbcsr_type), intent(out) :: matrix_a
type(mp_comm_type), intent(in) :: group
integer, DIMENSION(:), POINTER :: col_blk_sizes
integer, DIMENSION(:), POINTER :: row_blk_sizes
integer, DIMENSION(:), POINTER :: col_dist
integer, DIMENSION(:), POINTER :: row_dist
real(kind=real_8), intent(in) :: sparsity

Source Code

   SUBROUTINE make_random_dbcsr_matrix(matrix_a, group, &
      !! Create a DBCSR matrix with random values and random blocks
                                       col_blk_sizes, row_blk_sizes, col_dist, row_dist, sparsity)
      TYPE(dbcsr_type), INTENT(OUT)                      :: matrix_a
      TYPE(mp_comm_type), INTENT(IN)                                :: group
      INTEGER, DIMENSION(:), POINTER                     :: col_blk_sizes, row_blk_sizes, col_dist, &
                                                            row_dist
      REAL(real_8), INTENT(IN)                           :: sparsity

      INTEGER                                            :: col, col_s, max_col_size, max_nze, &
                                                            max_row_size, node_holds_blk, nze, &
                                                            row, row_s
      LOGICAL                                            :: tr
      REAL(real_8)                                       :: rn
      REAL(real_8), ALLOCATABLE, DIMENSION(:)            :: values
      TYPE(dbcsr_distribution_type)                      :: dist

      CALL dbcsr_distribution_new(dist, group=group%get_handle(), row_dist=row_dist, col_dist=col_dist, reuse_arrays=.TRUE.)

      CALL dbcsr_create(matrix=matrix_a, &
                        name="this is my matrix a", &
                        dist=dist, &
                        matrix_type=dbcsr_type_no_symmetry, &
                        row_blk_size=row_blk_sizes, &
                        col_blk_size=col_blk_sizes, &
                        data_type=dbcsr_type_real_8)

      CALL dbcsr_distribution_get(dist, mynode=mynode)

      ! get the maximum block size of the matrix
      max_row_size = MAXVAL(row_blk_sizes)
      max_col_size = MAXVAL(col_blk_sizes)
      max_nze = max_row_size*max_col_size

      ALLOCATE (values(max_nze))

      DO row = 1, dbcsr_nblkrows_total(matrix_a)
         DO col = 1, dbcsr_nblkcols_total(matrix_a)
            CALL RANDOM_NUMBER(rn)
            IF (rn .GT. sparsity) THEN
               tr = .FALSE.
               row_s = row; col_s = col
               CALL dbcsr_get_stored_coordinates(matrix_a, row_s, col_s, node_holds_blk)
               IF (node_holds_blk .EQ. mynode) THEN
                  nze = row_blk_sizes(row_s)*col_blk_sizes(col_s)
                  CALL RANDOM_NUMBER(values(1:nze))
                  CALL dbcsr_put_block(matrix_a, row_s, col_s, values(1:nze))
               END IF
            END IF
         END DO
      END DO
      DEALLOCATE (values)

      CALL dbcsr_finalize(matrix_a)
      CALL dbcsr_distribution_release(dist)
      DEALLOCATE (row_blk_sizes, col_blk_sizes)

   END SUBROUTINE make_random_dbcsr_matrix