dbcsr_make_1dist_dense Subroutine

private subroutine dbcsr_make_1dist_dense(nbins, old_dist, dense_dist, dist_map, nsubdist, subdist)

Makes a 1-D distribution dense.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nbins

Number of bins in the main distribution

type(array_i1d_obj), intent(in) :: old_dist

Current distribution

type(array_i1d_obj), intent(out) :: dense_dist

Dense distribution Map from current to dense distribution

type(array_i1d_obj), intent(out) :: dist_map

Dense distribution Map from current to dense distribution

integer, intent(in) :: nsubdist

Number of bins in the subdistribution

integer, intent(in), optional, DIMENSION(:) :: subdist

Subdistribution


Source Code

   SUBROUTINE dbcsr_make_1dist_dense(nbins, old_dist, dense_dist, dist_map, nsubdist, subdist)
      !! Makes a 1-D distribution dense.

      INTEGER, INTENT(IN)                                :: nbins
         !! Number of bins in the main distribution
      TYPE(array_i1d_obj), INTENT(IN)                    :: old_dist
         !! Current distribution
      TYPE(array_i1d_obj), INTENT(OUT)                   :: dense_dist, dist_map
         !! Dense distribution
         !! Map from current to dense distribution
      INTEGER, INTENT(IN)                                :: nsubdist
         !! Number of bins in the subdistribution
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: subdist
         !! Subdistribution

      INTEGER                                            :: b, i, n_new_bins
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: dense, map, old_d

!   ---------------------------------------------------------------------------

      IF (nsubdist .EQ. 0) THEN
         n_new_bins = nbins
      ELSE
         n_new_bins = nbins*nsubdist
      END IF
      old_d => array_data(old_dist)
      ALLOCATE (dense(n_new_bins))
      ALLOCATE (map(array_size(old_dist)))
      !
      IF (nsubdist .EQ. 0) THEN
         dense(:) = (/(b, b=0, n_new_bins - 1)/)
         map(:) = old_d(:) + 1
      ELSE
         DO i = 1, nbins
            dense((i - 1)*nsubdist + 1:(i)*nsubdist) = i - 1
         END DO
         map(:) = old_d(:)*nsubdist + subdist(:) + 1
      END IF
      !
      CALL array_new(dense_dist, dense, gift=.TRUE.)
      CALL array_new(dist_map, map, gift=.TRUE.)
   END SUBROUTINE dbcsr_make_1dist_dense