... TODO : unify with other version which is generic in the data_type
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix | |||
logical, | optional | :: | keep_sparsity | |||
integer, | intent(in), | optional | :: | mini_seed |
SUBROUTINE dbcsr_init_random(matrix, keep_sparsity, mini_seed)
!! ... TODO : unify with other version which is generic in the data_type
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
LOGICAL, OPTIONAL :: keep_sparsity
INTEGER, INTENT(IN), OPTIONAL :: mini_seed
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_init_random'
INTEGER :: col, col_size, handle, hold, iseed(4), &
mynode, ncol, nrow, row, row_size, &
stored_col, stored_row, my_mini_seed
INTEGER, DIMENSION(:), POINTER :: col_blk_size, row_blk_size
LOGICAL :: found, my_keep_sparsity, tr
REAL(real_8), ALLOCATABLE, DIMENSION(:) :: rnd
REAL(real_8), DIMENSION(:, :), POINTER :: buff, data_d
! ---------------------------------------------------------------------------
my_keep_sparsity = .FALSE.
IF (PRESENT(keep_sparsity)) my_keep_sparsity = keep_sparsity
my_mini_seed = 1
IF (PRESENT(mini_seed)) my_mini_seed = mini_seed
CALL timeset(routineN, handle)
row_blk_size => array_data(matrix%row_blk_size)
col_blk_size => array_data(matrix%col_blk_size)
mynode = dbcsr_mp_mynode(dbcsr_distribution_mp(dbcsr_distribution(matrix)))
CALL dbcsr_work_create(matrix, work_mutable=.TRUE.)
ALLOCATE (rnd(MAXVAL(row_blk_size)*MAXVAL(col_blk_size)))
nrow = dbcsr_nblkrows_total(matrix)
ncol = dbcsr_nblkcols_total(matrix)
DO row = 1, nrow
DO col = 1, ncol
row_size = row_blk_size(row)
col_size = col_blk_size(col)
tr = .FALSE.
stored_row = row
stored_col = col
CALL dbcsr_get_stored_coordinates(matrix, stored_row, stored_col, hold)
IF (hold .EQ. mynode) THEN
CALL dbcsr_get_block_p(matrix, stored_row, stored_col, data_d, tr, found)
IF (found .OR. (.NOT. my_keep_sparsity)) THEN
! set the seed for dlarnv, is here to guarantee same value of the random numbers
! for all layouts (and block distributions)
CALL set_larnv_seed(row, nrow, col, ncol, my_mini_seed, iseed)
CALL dlarnv(1, iseed, row_size*col_size, rnd(1))
END IF
IF (found) THEN
CALL dcopy(row_size*col_size, rnd, 1, data_d, 1)
ELSE
IF (.NOT. my_keep_sparsity) THEN
ALLOCATE (buff(row_size, col_size))
CALL dcopy(row_size*col_size, rnd, 1, buff, 1)
CALL dbcsr_put_block(matrix, stored_row, stored_col, buff)
DEALLOCATE (buff)
END IF
END IF
END IF
END DO
END DO
DEALLOCATE (rnd)
CALL dbcsr_finalize(matrix)
CALL timestop(handle)
END SUBROUTINE dbcsr_init_random