Creates an image distribution given the other compatibility images
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_imagedistribution_obj), | intent(out) | :: | imgdist |
distribution repetition |
||
type(dbcsr_distribution_obj), | intent(in) | :: | dist |
distribution for which to form the image distribution |
||
integer, | intent(in), | optional, | DIMENSION(:) | :: | match_row_pdist |
match the new row distribution to this row distribution match the row distribution to these row images |
integer, | intent(in), | optional, | DIMENSION(:) | :: | match_row_idist |
match the new row distribution to this row distribution match the row distribution to these row images |
integer, | intent(in) | :: | match_row_nbins |
number of bins in the distribution to match the local rows |
||
integer, | intent(in), | optional, | DIMENSION(:) | :: | match_col_pdist |
match the new column distribution to this column distribution match the new column distribution to these column images |
integer, | intent(in), | optional, | DIMENSION(:) | :: | match_col_idist |
match the new column distribution to this column distribution match the new column distribution to these column images |
integer, | intent(in) | :: | match_col_nbins |
number of bins in the distribution to match the local columns |
||
integer, | intent(in) | :: | nimages_rows |
number of bins in the distribution to match the local columns |
||
integer, | intent(in) | :: | nimages_cols |
number of bins in the distribution to match the local columns |
SUBROUTINE dbcsr_create_image_dist(imgdist, dist, &
match_row_pdist, match_row_idist, match_row_nbins, &
match_col_pdist, match_col_idist, match_col_nbins, &
nimages_rows, nimages_cols)
!! Creates an image distribution given the other compatibility images
TYPE(dbcsr_imagedistribution_obj), INTENT(OUT) :: imgdist
!! distribution repetition
TYPE(dbcsr_distribution_obj), INTENT(IN) :: dist
!! distribution for which to form the image distribution
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: match_row_pdist, match_row_idist
!! match the new row distribution to this row distribution
!! match the row distribution to these row images
INTEGER, INTENT(IN) :: match_row_nbins
!! number of bins in the distribution to match the local rows
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: match_col_pdist, match_col_idist
!! match the new column distribution to this column distribution
!! match the new column distribution to these column images
INTEGER, INTENT(IN) :: match_col_nbins, nimages_rows, &
nimages_cols
!! number of bins in the distribution to match the local columns
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_create_image_dist'
INTEGER :: ncols, npcols, nprows, nrows
INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: col_dist_data, col_img_data, col_vdist, &
row_dist_data, row_img_data, row_vdist
LOGICAL :: new_col_dist, new_row_dist
TYPE(dbcsr_distribution_obj) :: new_dist
TYPE(dbcsr_mp_obj) :: mp_env
! ---------------------------------------------------------------------------
idid = idid + 1
ALLOCATE (imgdist%i)
imgdist%i%refcount = 1
imgdist%i%id = idid
mp_env = dbcsr_distribution_mp(dist)
! Determine the factors.
nrows = dbcsr_distribution_nrows(dist)
ncols = dbcsr_distribution_ncols(dist)
nprows = dbcsr_mp_nprows(mp_env)
npcols = dbcsr_mp_npcols(mp_env)
IF (debug_mod) WRITE (*, '(1X,A,I5,"x",I5)') routineN//"pgrid", &
nprows, npcols
!
! Create the new row distribution and row image distribution
imgdist%i%row_decimation = nimages_rows/nprows
imgdist%i%row_multiplicity = nimages_rows/gcd(nimages_rows, match_row_nbins)
new_row_dist = .FALSE.
!
IF (debug_mod) WRITE (*, *) routineN//'row decimation, multiplicity', &
imgdist%i%row_decimation, imgdist%i%row_multiplicity
IF (debug_mod) WRITE (*, *) routineN//" nprows, match prows", nprows, match_row_nbins
ALLOCATE (row_img_data(nrows))
ALLOCATE (row_vdist(nrows))
!
IF (imgdist%i%row_decimation .EQ. 1 .AND. imgdist%i%row_multiplicity .EQ. 1 .AND. &
.NOT. PRESENT(match_row_pdist)) THEN
row_dist_data => dbcsr_distribution_row_dist(dist)
row_img_data(:) = 1
ELSE
IF (PRESENT(match_row_pdist)) THEN
ALLOCATE (row_dist_data(nrows))
new_row_dist = .TRUE.
IF (PRESENT(match_row_idist)) THEN
CALL rebin_imaged_distribution(row_dist_data, row_img_data, &
match_row_pdist, match_row_idist, &
nprows, &
imgdist%i%row_multiplicity, imgdist%i%row_decimation)
ELSE
CALL rebin_distribution(row_dist_data, row_img_data, &
match_row_pdist, &
nprows, &
imgdist%i%row_multiplicity, imgdist%i%row_decimation)
END IF
ELSE
row_dist_data => dbcsr_distribution_row_dist(dist)
CALL reimage_distribution(row_img_data, &
row_dist_data, nprows, imgdist%i%row_decimation)
END IF
END IF
CALL make_vdistribution(nrows, row_vdist, row_dist_data, &
imgdist%i%row_decimation, row_img_data)
CALL array_new(imgdist%i%vrow_dist, row_vdist, gift=.TRUE.)
!
! Create the new column distribution and column image distribution
imgdist%i%col_decimation = nimages_cols/npcols
imgdist%i%col_multiplicity = nimages_cols/gcd(nimages_cols, match_col_nbins)
new_col_dist = .FALSE.
!
IF (debug_mod) WRITE (*, *) routineN//'col decimation, multiplicity', &
imgdist%i%col_decimation, imgdist%i%col_multiplicity
IF (debug_mod) WRITE (*, *) routineN//" npcols, match pcols", npcols, match_col_nbins
ALLOCATE (col_img_data(ncols))
ALLOCATE (col_vdist(ncols))
!
IF (imgdist%i%col_decimation .EQ. 1 .AND. imgdist%i%col_multiplicity .EQ. 1 .AND. &
.NOT. PRESENT(match_col_pdist)) THEN
col_dist_data => dbcsr_distribution_col_dist(dist)
col_img_data(:) = 1
ELSE
IF (PRESENT(match_col_pdist)) THEN
ALLOCATE (col_dist_data(ncols))
new_col_dist = .TRUE.
IF (PRESENT(match_col_idist)) THEN
CALL rebin_imaged_distribution(col_dist_data, col_img_data, &
match_col_pdist, match_col_idist, &
npcols, &
imgdist%i%col_multiplicity, imgdist%i%col_decimation)
ELSE
CALL rebin_distribution(col_dist_data, col_img_data, &
match_col_pdist, &
npcols, &
imgdist%i%col_multiplicity, imgdist%i%col_decimation)
END IF
ELSE
col_dist_data => dbcsr_distribution_col_dist(dist)
CALL reimage_distribution(col_img_data, &
col_dist_data, &
npcols, imgdist%i%col_decimation)
END IF
END IF
CALL make_vdistribution(ncols, col_vdist, col_dist_data, &
imgdist%i%col_decimation, col_img_data)
CALL array_new(imgdist%i%vcol_dist, col_vdist, gift=.TRUE.)
!
! Copy the row & column distribution from old distribution
IF (new_row_dist .AND. new_col_dist) THEN
CALL dbcsr_distribution_new(new_dist, &
mp_env, &
row_dist_data, col_dist_data, &
reuse_arrays=.TRUE.)
ELSE
CALL dbcsr_distribution_new(new_dist, &
mp_env, &
row_dist_data, col_dist_data)
IF (new_row_dist) DEALLOCATE (row_dist_data)
IF (new_col_dist) DEALLOCATE (col_dist_data)
END IF
! Now finish the distribution image.
imgdist%i%main = new_dist
CALL array_new(imgdist%i%col_image, col_img_data, gift=.TRUE.)
CALL array_new(imgdist%i%row_image, row_img_data, gift=.TRUE.)
!
imgdist%i%has_other_vl_rows = .FALSE.
imgdist%i%has_other_vl_cols = .FALSE.
imgdist%i%has_global_vrow_map = .FALSE.
imgdist%i%has_global_vcol_map = .FALSE.
!
!$ IF (dbcsr_distribution_has_threads(dist)) THEN
!$ imgdist%i%main%d%num_threads = dist%d%num_threads
!$ imgdist%i%main%d%has_thread_dist = .TRUE.
!$ imgdist%i%main%d%thread_dist = dist%d%thread_dist
!$ CALL array_hold(imgdist%i%main%d%thread_dist)
!$ END IF
END SUBROUTINE dbcsr_create_image_dist