... 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