dft_grid_t Derived Type

type, public :: dft_grid_t

@brief Type to store molecular grid information


Inherits

type~~dft_grid_t~~InheritsGraph type~dft_grid_t dft_grid_t type~sorted_grid_t sorted_grid_t type~dft_grid_t->type~sorted_grid_t spherical_grids type~list_grid_3d_t list_grid_3d_t type~sorted_grid_t->type~list_grid_3d_t type~grid_3d_pt grid_3d_pt type~list_grid_3d_t->type~grid_3d_pt elem type~grid_3d_t grid_3d_t type~grid_3d_pt->type~grid_3d_t p

Inherited by

type~~dft_grid_t~~InheritedByGraph type~dft_grid_t dft_grid_t type~xc_options_t xc_options_t type~xc_options_t->type~dft_grid_t molGrid

Components

Type Visibility Attributes Name Initial
integer, public :: nSlices = 0
integer, public :: maxSlices = 0
integer, public :: maxAtomPts = 0
integer, public :: maxSlicePts = 0
integer, public :: maxNRadTimesNAng = 0
integer, public :: nMolPts = 0
type(sorted_grid_t), public :: spherical_grids
integer, public, allocatable :: idAng(:)
integer, public, allocatable :: iAngStart(:)
integer, public, allocatable :: nAngPts(:)
integer, public, allocatable :: iRadStart(:)
integer, public, allocatable :: nRadPts(:)
integer, public, allocatable :: nTotPts(:)
integer, public, allocatable :: idOrigin(:)
integer, public, allocatable :: chunkType(:)
integer, public, allocatable :: wtStart(:)
integer, public, allocatable :: isInner(:)
real(kind=fp), public, allocatable :: rAtm(:)
real(kind=fp), public, allocatable :: rInner(:)
logical, public, allocatable :: dummyAtom(:)
real(kind=fp), public, allocatable :: rad_pts(:)
real(kind=fp), public, allocatable :: rad_wts(:)
real(kind=fp), public, allocatable :: totWts(:,:)

Type-Bound Procedures

procedure, public, pass :: getSliceData

  • private subroutine getSliceData(grid, iSlice, xyzw)

    @brief Get coordinates and weight for quadrature points, which belong to a slice @param[in] iSlice index of a slice @param[out] xyzw coordinates and weights @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t), intent(in) :: grid
    integer, intent(in) :: iSlice
    real(kind=fp), intent(out), contiguous :: xyzw(:,:)

procedure, public, pass :: getSliceNonZero

  • private subroutine getSliceNonZero(grid, cutoff, iSlice, xyzw, nPt)

    @brief Get grid points from a slice, which weights are larger than a cutoff. @param[in] cutoff cutoff to skip small weights @param[in] iSlice index of current slice @param[out] xyzw coordinates and weights of grid points @param[out] nPt number of nonzero point for slice @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t), intent(in) :: grid
    real(kind=fp), intent(in) :: cutoff
    integer, intent(in) :: iSlice
    real(kind=fp), intent(out), contiguous :: xyzw(:,:)
    integer, intent(out) :: nPt

procedure, public, pass :: exportGrid

  • private subroutine exportGrid(grid, xyz, w, kcp, c, npts, cutoff)

    @brief Export grid for use in legacy TD-DFT code @param[out] xyz coordinates of grid points @param[out] w weights of grid points @param[out] kcp atoms, which the points belongs to @param[out] npts number of nonzero point @param[in] cutoff cutoff to skip small weights @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t), intent(in) :: grid
    real(kind=fp), intent(out) :: xyz(3,*)
    real(kind=fp), intent(out) :: w(*)
    integer, intent(out) :: kcp(*)
    real(kind=fp), intent(in) :: c(3,*)
    integer, intent(out) :: npts
    real(kind=fp), intent(in) :: cutoff

procedure, public, pass :: setSlice

  • private subroutine setSlice(grid, iSlice, iRadStart, nRadPts, idAng, iAngStart, nAngPts, wtStart, idAtm, rAtm, chunkType)

    @brief Set slice data @param[in] iSlice index of current slice @param[in] iRadStart index of the first point in radial grid array @param[in] nRadPts number of radial grid points @param[in] idAng index of angular grid @param[in] idAngStart index of the first point in angular grid array @param[in] nAngPts number of angular grid points @param[in] wtStart index of the first point in weights array @param[in] idAtm index of atom which owns the slice @param[in] rAtm effective radius of current atom @param[in] chunkType type of chunk -- used for different processing @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t), intent(inout) :: grid
    integer, intent(in) :: iSlice
    integer, intent(in) :: iRadStart
    integer, intent(in) :: nRadPts
    integer, intent(in) :: idAng
    integer, intent(in) :: iAngStart
    integer, intent(in) :: nAngPts
    integer, intent(in) :: wtStart
    integer, intent(in) :: idAtm
    real(kind=fp), intent(in) :: rAtm
    integer, intent(in) :: chunkType

procedure, public, pass :: reset => reset_dft_grid_t

  • private subroutine reset_dft_grid_t(grid, nAt, maxPtPerAt, nRad)

    @brief Clean up grid dataset and reallocate arrays if needed @param[in] maxSlices guess for maximum number of slices @param[in] nAt number of atoms in a system @param[in] maxPtPerAt maximum number of points per atom @param[in] nRad size of the radial grid @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t), intent(inout) :: grid
    integer, intent(in) :: nAt
    integer, intent(in) :: maxPtPerAt
    integer, intent(in) :: nRad

procedure, public, pass :: compress => compress_dft_grid_t

  • private subroutine compress_dft_grid_t(grid)

    @brief Compress the grid for eaach atom

    Note

    This is a very basic implementation and it will be changed in future @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t), intent(inout) :: grid

procedure, public, pass :: extend => extend_dft_grid_t

  • private subroutine extend_dft_grid_t(grid)

    @brief Extend arrays in molecular grid type @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t), intent(inout) :: grid

procedure, public, pass :: add_atomic_grid

  • private subroutine add_atomic_grid(grid, atomic_grid)

    @brief Split atomic 3D grid on spacially localized clusters ("slices") and appended the data to grid dataset @details First, decompose atomic grid on layers, depending on the pruning scheme and the distance from the nuclei. It is done in this procedure. Then, split layers on slices and append their data to the grid dataset. It is done by calling subroutine addSlices. @param[in] idAtm index of current atom @param[in] nGrids number of grids in pruning scheme @param[in] rAtm effective radius of current atom @param[in] pruneRads radii of the pruning scheme @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t) :: grid
    type(atomic_grid_t) :: atomic_grid

procedure, public, pass :: add_slices

  • private subroutine add_slices(grid, idAtm, layers, nLayers, rAtm)

    @brief Append slice data of an atom to grid arrays @param[in] idAtom index of current atom @param[in] layers meta-data for atom grid layers: radial grid, angular grid, and angular grid separation depth @param[in] nLayers number of atom grid layers @param[in] rAtm effective radius of current atom @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t) :: grid
    integer, intent(in) :: idAtm
    integer, intent(in) :: layers(:,:)
    integer, intent(in) :: nLayers
    real(kind=fp), intent(in) :: rAtm

procedure, public, pass :: find_neighbours

  • private subroutine find_neighbours(grid, rij, partFunType)

    @brief Find nearest neghbours of every atom and the corresponding distance The results are stored into grid dataset @details This is needed for screening inner points in SSF variant of Becke's fuzzy cell method @param[in] rij array of interatomic distances @param[in] nAt number of atoms @author Vladimir Mironov

    Arguments

    Type IntentOptional Attributes Name
    class(dft_grid_t) :: grid
    real(kind=fp), intent(in) :: rij(:,:)
    integer, intent(in) :: partFunType

Source Code

  type :: dft_grid_t
    !< current number of slices
    integer :: nSlices = 0
    !< maximum number of slices
    integer :: maxSlices = 0
    !< maximum number of grid points per atom
    integer :: maxAtomPts = 0
    !< maximum number of nonzero grid points per slice
    integer :: maxSlicePts = 0
    !< maximum possible number of grid points per slice
    integer :: maxNRadTimesNAng = 0
    !< total number of nonzero grid points
    integer :: nMolPts = 0

    !< spherical atomic grids used in this molecular grid
    type(sorted_grid_t) :: spherical_grids

    ! Every slice is a spacially localized subgrid of molecular grid:
    ! slice = (few radial points)x(few angular points)
    ! The following arrays contains data for each slice

    !< index of angular grid
    integer, allocatable :: idAng(:)
    !< index of the first point in angular grid array
    integer, allocatable :: iAngStart(:)
    !< number of angular grid points
    integer, allocatable :: nAngPts(:)
    !< index of the first point in radial grid array
    integer, allocatable :: iRadStart(:)
    !< number of radial grid points
    integer, allocatable :: nRadPts(:)
    !< number of grid points with nonzero weight
    integer, allocatable :: nTotPts(:)
    !< index of atom which owns the slice
    integer, allocatable :: idOrigin(:)
    !< type of chunk -- used for different processing
    integer, allocatable :: chunkType(:)
    !< index of the first point in weights array
    integer, allocatable :: wtStart(:)
    !< isInner == 1 means that the slice is 'inner' -- i.e. its weight is not modified and is equal to wtRad*wtAng
    integer, allocatable :: isInner(:)

    ! The following arrays contains information about atoms
    !< effective radii of atoms
    real(KIND=fp), allocatable :: rAtm(:)
    !< max radii for 'inner' points
    real(KIND=fp), allocatable :: rInner(:)
    !< .TRUE. for dummy atoms
    logical, allocatable :: dummyAtom(:)

    ! The following arrays contains information about the radial grid
    !< Radial grid points
    real(KIND=fp), allocatable :: rad_pts(:)
    !< Radial grid weights
    real(KIND=fp), allocatable :: rad_wts(:)

    !< array to store grid point weights
    real(KIND=fp), allocatable :: totWts(:, :)
    !< number of nonzero grid points per atom
    integer, allocatable, private :: wt_top(:)

  contains
    procedure, pass :: getSliceData => getSliceData
    procedure, pass :: getSliceNonZero => getSliceNonZero
    procedure, pass :: exportGrid => exportGrid
    procedure, pass :: setSlice => setSlice
    procedure, pass :: reset => reset_dft_grid_t
    procedure, pass :: compress => compress_dft_grid_t
    procedure, pass :: extend => extend_dft_grid_t
    procedure, pass :: add_atomic_grid => add_atomic_grid
    procedure, pass :: add_slices => add_slices
    procedure, pass :: find_neighbours => find_neighbours
  end type dft_grid_t