diff --git a/sktools/src/sktools/calculators/slateratom.py b/sktools/src/sktools/calculators/slateratom.py index 5659ddb6..f429d284 100644 --- a/sktools/src/sktools/calculators/slateratom.py +++ b/sktools/src/sktools/calculators/slateratom.py @@ -10,8 +10,9 @@ import sktools.hsd.converter as conv import sktools.common as sc from sktools.taggedfile import TaggedFile -import sktools.compressions +import sktools.compressions as skcomp import sktools.radial_grid as oc +import sktools.xcfunctionals as xc LOGGER = logging.getLogger('slateratom') @@ -134,7 +135,7 @@ class SlateratomInput: functional : str DFT functional type ('lda', 'pbe', 'blyp', 'lcpbe', 'lcbnl') compressions : list - List of PowerCompression objects. Either empty (no compression applied) + List of Compression objects. Either empty (no compression applied) or has a compression object for every angular momentum of the atom. settings : SlaterAtom Further detailed settings of the program. @@ -193,16 +194,26 @@ def __init__(self, settings, atomconfig, functional, compressions): if compressions is None: compressions = [] for comp in compressions: - if not isinstance(comp, sktools.compressions.PowerCompression): - msg = "Invalid compressiont type {} for slateratom".format( + if not isinstance(comp, (skcomp.PowerCompression, + skcomp.WoodsSaxonCompression)): + msg = "Invalid compression type {} for slateratom".format( comp.__class__.__name__) raise sc.SkgenException(msg) maxang = atomconfig.maxang ncompr = len(compressions) - if ncompr and ncompr != maxang + 1: + if ncompr > 0 and ncompr != maxang + 1: msg = "Invalid number of compressions" \ "(expected {:d}, got {:d})".format(maxang + 1, ncompr) raise sc.SkgenException(msg) + + # block different compression types of different shells for now + if ncompr > 0: + compids = [comp.compid for comp in compressions] + if not len(set(compids)) == 1: + msg = "At the moment, shells may only be compressed by the " \ + + "same type of potential." + raise sc.SkgenException(msg) + self._compressions = compressions myrelativistics = sc.RELATIVISTICS_NONE, sc.RELATIVISTICS_ZORA if atomconfig.relativistics not in myrelativistics: @@ -213,7 +224,7 @@ def __init__(self, settings, atomconfig, functional, compressions): def isXCFunctionalSupported(self, functional): '''Checks if the given xc-functional is supported by the calculator, in particular: checks if AVAILABLE_FUNCTIONALS intersect with - sktools.xcfunctionals.XCFUNCTIONALS + xc.XCFUNCTIONALS Args: functional: xc-functional, defined in xcfunctionals.py @@ -224,8 +235,8 @@ def isXCFunctionalSupported(self, functional): tmp = [] for xx in SUPPORTED_FUNCTIONALS: - if xx in sktools.xcfunctionals.XCFUNCTIONALS: - tmp.append(sktools.xcfunctionals.XCFUNCTIONALS[xx]) + if xx in xc.XCFUNCTIONALS: + tmp.append(xc.XCFUNCTIONALS[xx]) return bool(functional.__class__ in tmp) @@ -297,14 +308,42 @@ def write(self, workdir): # Compressions if len(self._compressions) == 0: - out += ["{:g} {:d} \t\t{:s} Compr. radius and power ({:s})".format( - 1e30, 0, self._COMMENT, sc.ANGMOM_TO_SHELL[ll]) + # no compression for all shells + out += ["{:d} \t\t\t{:s} Compression ID".format( + skcomp.SUPPORTED_COMPRESSIONS['nocompression'], + self._COMMENT) + " ({:s})".format(sc.ANGMOM_TO_SHELL[ll]) for ll in range(maxang + 1)] else: - out += ["{:g} {:g} \t\t{:s} Compr. radius and power ({:s})".format( - compr.radius, compr.power, self._COMMENT, - sc.ANGMOM_TO_SHELL[ll]) - for ll, compr in enumerate(self._compressions)] + # define the type of compression for each shell + for ll, compr in enumerate(self._compressions): + if compr.compid == \ + skcomp.SUPPORTED_COMPRESSIONS['powercompression']: + out += ["{:d} \t\t{:s} Compression ID".format( + skcomp.SUPPORTED_COMPRESSIONS['powercompression'], + self._COMMENT) \ + + " ({:s})".format(sc.ANGMOM_TO_SHELL[ll])] + elif compr.compid == \ + skcomp.SUPPORTED_COMPRESSIONS['woodssaxoncompression']: + out += ["{:d} \t\t{:s} Compression ID".format( + skcomp.SUPPORTED_COMPRESSIONS['woodssaxoncompression'], + self._COMMENT) \ + + " ({:s})".format(sc.ANGMOM_TO_SHELL[ll])] + else: + msg = 'Invalid compression type.' + raise sc.SkgenException(msg) + # provide the compression parametrization for each shell + for ll, compr in enumerate(self._compressions): + if compr.compid == \ + skcomp.SUPPORTED_COMPRESSIONS['powercompression']: + out += ["{:g} {:g} \t\t{:s} Compr. radius and power ({:s})" + .format(compr.radius, compr.power, self._COMMENT, + sc.ANGMOM_TO_SHELL[ll])] + elif compr.compid == \ + skcomp.SUPPORTED_COMPRESSIONS['woodssaxoncompression']: + out += ["{:g} {:g} {:g} \t\t{:s}".format( + compr.onset, compr.cutoff, compr.vmax, self._COMMENT) \ + + " Compr. onset, cutoff and vmax ({:s})" + .format(sc.ANGMOM_TO_SHELL[ll])] out += ["{:d} \t\t\t{:s} nr. of occupied shells ({:s})".format( len(occ), self._COMMENT, sc.ANGMOM_TO_SHELL[ll]) @@ -313,9 +352,9 @@ def write(self, workdir): # STO powers and exponents exponents = self._settings.exponents maxpowers = self._settings.maxpowers - out += ["{:d} {:d} \t\t\t{:s} nr. of exponents, max. power ({:s})".format( - len(exponents[ll]), maxpowers[ll], self._COMMENT, - sc.ANGMOM_TO_SHELL[ll]) + out += ["{:d} {:d} \t\t\t{:s} nr. of exponents, max. power ({:s})" + .format(len(exponents[ll]), maxpowers[ll], self._COMMENT, + sc.ANGMOM_TO_SHELL[ll]) for ll in range(maxang + 1)] out.append("{:s} \t\t{:s} automatic exponent generation".format( self._LOGICALSTRS[False], self._COMMENT)) @@ -326,7 +365,7 @@ def write(self, workdir): out.append("{:s} \t\t{:s} write eigenvectors".format( self._LOGICALSTRS[False], self._COMMENT)) - out.append("{} {:g} \t\t{:s} broyden mixer, mixing factor".format( + out.append("{} {:g} \t\t\t{:s} broyden mixer, mixing factor".format( 2, 0.1, self._COMMENT)) # Occupations diff --git a/sktools/src/sktools/common.py b/sktools/src/sktools/common.py index 7c97d78d..8e3aa313 100644 --- a/sktools/src/sktools/common.py +++ b/sktools/src/sktools/common.py @@ -528,6 +528,8 @@ def is_shelf_file_matching(shelf_file, mydict): db = shelve.open(shelf_file, 'r') except dbm.error: return False + if not type(db) is type(mydict): + return False match = True for key in mydict: match = key in db and db[key] == mydict[key] diff --git a/sktools/src/sktools/compressions.py b/sktools/src/sktools/compressions.py index 62a1eb05..ec54c48b 100644 --- a/sktools/src/sktools/compressions.py +++ b/sktools/src/sktools/compressions.py @@ -39,6 +39,8 @@ def fromhsd(cls, root, query): node=child) myself = cls() + myself.compid = SUPPORTED_COMPRESSIONS[ + myself.__class__.__name__.lower()] myself.power = power myself.radius = radius @@ -62,9 +64,80 @@ def __eq__(self, other): return power_ok and radius_ok +class WoodsSaxonCompression(sc.ClassDict): + '''Compression by the Woods Saxon potential. + + Attributes + ---------- + onset : float + Onset radius of the compression + cutoff : float + Cutoff radius of the compression + vmax : float + Potential well depth/height + ''' + + @classmethod + def fromhsd(cls, root, query): + '''Creates instance from a HSD-node and with given query object.''' + + onset, child = query.getvalue(root, 'onset', conv.float0, + returnchild=True) + if onset < 0.0: + msg = 'Invalid onset radius {:f}'.format(onset) + raise hsd.HSDInvalidTagValueException(msg=msg, node=child) + + cutoff, child = query.getvalue(root, 'cutoff', conv.float0, + returnchild=True) + if cutoff <= onset: + msg = 'Invalid cutoff radius {:f}'.format(cutoff) + raise hsd.HSDInvalidTagValueException(msg=msg, node=child) + + vmax, child = query.getvalue( + root, 'vmax', conv.float0, defvalue=100.0, returnchild=True) + if vmax <= 0.0: + msg = 'Invalid potential well height {:f}'.format(vmax) + raise hsd.HSDInvalidTagValueException(msg=msg, node=child) + + myself = cls() + myself.compid = SUPPORTED_COMPRESSIONS[ + myself.__class__.__name__.lower()] + myself.onset = onset + myself.cutoff = cutoff + myself.vmax = vmax + + return myself + + + def tohsd(self, root, query, parentname=None): + '''''' + + if parentname is None: + mynode = root + else: + mynode = query.setchild(root, 'WoodsSaxonCompression') + + query.setchildvalue(mynode, 'onset', conv.float0, self.onset) + query.setchildvalue(mynode, 'cutoff', conv.float0, self.cutoff) + query.setchildvalue(mynode, 'vmax', conv.float0, self.vmax) + + + def __eq__(self, other): + onset_ok = abs(self.onset - other.onset) < 1e-8 + cutoff_ok = abs(self.cutoff - other.cutoff) < 1e-8 + vmax_ok = abs(self.vmax - other.vmax) < 1e-8 + return onset_ok and cutoff_ok and vmax_ok + + # Registered compressions with corresponding hsd name as key COMPRESSIONS = { 'powercompression': PowerCompression, + 'woodssaxoncompression': WoodsSaxonCompression, +} +SUPPORTED_COMPRESSIONS = { + 'nocompression': 0, + 'powercompression': 1, + 'woodssaxoncompression': 2, } diff --git a/slateratom/lib/CMakeLists.txt b/slateratom/lib/CMakeLists.txt index 78399778..c23d9ad2 100644 --- a/slateratom/lib/CMakeLists.txt +++ b/slateratom/lib/CMakeLists.txt @@ -32,6 +32,7 @@ set(sources-f90 set(sources-fpp blasroutines.F90 broydenmixer.F90 + confinement.F90 lapackroutines.F90 simplemixer.F90) diff --git a/slateratom/lib/confinement.F90 b/slateratom/lib/confinement.F90 new file mode 100644 index 00000000..777dcfaf --- /dev/null +++ b/slateratom/lib/confinement.F90 @@ -0,0 +1,606 @@ +#:include 'common.fypp' + +!> Module that builds up various supervectors. +module confinement + + use common_accuracy, only : dp + use utilities, only : fak + use core_overlap, only : v + use density, only : basis_times_basis_times_r2 + + implicit none + private + + public :: TConf, TConfInp, confType + public :: TPowerConf, TPowerConf_init + public :: TWsConf, TWsConf_init + + + !> Generic wrapper for confinement potentials. + type, abstract :: TConf + contains + + procedure(getPotOnGrid), deferred :: getPotOnGrid + procedure(getSupervec), deferred :: getSupervec + + end type TConf + + + abstract interface + + !> Tabulates the (shell-resolved) confinement potential on a given grid. + subroutine getPotOnGrid(this, max_l, num_mesh_points, abcissa, vconf) + import :: TConf, dp + implicit none + + !> instance + class(TConf), intent(in) :: this + + !> maximum angular momentum + integer, intent(in) :: max_l + + !> number of numerical integration points + integer, intent(in) :: num_mesh_points + + !> numerical integration abcissas + real(dp), intent(in) :: abcissa(:) + + !> confinement potential on grid + real(dp), intent(out) :: vconf(:, 0:) + + end subroutine getPotOnGrid + + + !> Calculates supervector matrix elements of the confining potential. + subroutine getSupervec(this, max_l, num_mesh_points, abcissa, weight, num_alpha, alpha,& + & poly_order, vconf, vconf_matrix) + import :: TConf, dp + implicit none + + !> instance + class(TConf), intent(in) :: this + + !> maximum angular momentum + integer, intent(in) :: max_l + + !> number of numerical integration points + integer, intent(in) :: num_mesh_points + + !> numerical integration abcissas + real(dp), intent(in) :: abcissa(:) + + !> numerical integration weights + real(dp), intent(in) :: weight(:) + + !> number of exponents in each shell + integer, intent(in) :: num_alpha(0:) + + !> basis exponents + real(dp), intent(in) :: alpha(0:,:) + + !> highest polynomial order + l in each shell + integer, intent(in) :: poly_order(0:) + + !> Woods-Saxon potential on grid + real(dp), intent(in) :: vconf(:, 0:) + + !> Woods-Saxon confinement supervector + real(dp), intent(out) :: vconf_matrix(0:,:,:) + + end subroutine getSupervec + + end interface + + + !> Input for the Power confinement. + type :: TPowerConfInp + + !> confinement radii (power compression) + real(dp) :: r0(0:4) + + !> power of confinement (power compression) + real(dp) :: power(0:4) + + end type TPowerConfInp + + + !> Input for the Woods-Saxon confinement. + type :: TWsConfInp + + !> onset radii (Woods-Saxon compression) + real(dp) :: rOnset(0:4) + + !> cutoff of confinement (Woods-Saxon compression) + real(dp) :: rCut(0:4) + + !> potential well height of confinement (Woods-Saxon compression) + real(dp) :: vMax(0:4) + + end type TWsConfInp + + + !> Input for the Power confinement. + type :: TConfInp + + !> Power confinement input structure + type(TPowerConfInp) :: power + + !> Woods-Saxon confinement input structure + type(TWsConfInp) :: ws + + end type TConfInp + + + !> Power confinement. + type, extends(TConf) :: TPowerConf + private + + !> confinement radii (power compression) + real(dp) :: r0(0:4) + + !> power of confinement (power compression) + real(dp) :: power(0:4) + + contains + + procedure :: getPotOnGrid => TPowerConf_getPotOnGrid + procedure :: getSupervec => TPowerConf_getSupervec + + end type TPowerConf + + + !> Woods-Saxon confinement. + type, extends(TConf) :: TWsConf + private + + !> onset radii (Woods-Saxon compression) + real(dp) :: rOnset(0:4) + + !> cutoff of confinement (Woods-Saxon compression) + real(dp) :: rCut(0:4) + + !> potential well height of confinement (Woods-Saxon compression) + real(dp) :: vMax(0:4) + + contains + + procedure :: getPotOnGrid => TWsConf_getPotOnGrid + procedure :: getSupervec => TWsConf_getSupervec + + end type TWsConf + + + !> Enumerator for type of confinement potential. + type :: TConfEnum + + !> no compression + integer :: none = 0 + + !> power compression + integer :: power = 1 + + !> Woods-Saxon compression + integer :: ws = 2 + + end type TConfEnum + + !> Container for enumerated types of confinement potentials. + type(TConfEnum), parameter :: confType = TConfEnum() + + +contains + + !> Initializes a TPowerConf instance. + subroutine TPowerConf_init(this, input) + + !> instance + type(TPowerConf), intent(out) :: this + + !> input data + type(TPowerConfInp), intent(inout) :: input + + this%r0(0:) = input%r0 + this%power(0:) = input%power + + end subroutine TPowerConf_init + + + !> Initializes a TWsConf instance. + subroutine TWsConf_init(this, input) + + !> instance + type(TWsConf), intent(out) :: this + + !> input data + type(TWsConfInp), intent(inout) :: input + + this%rOnset(0:) = input%rOnset + this%rCut(0:) = input%rCut + this%vMax(0:) = input%vMax + + end subroutine TWsConf_init + + + !> Tabulates the (shell-resolved) Power confinement potential on the grid. + subroutine TPowerConf_getPotOnGrid(this, max_l, num_mesh_points, abcissa, vconf) + + !> instance + class(TPowerConf), intent(in) :: this + + !> maximum angular momentum + integer, intent(in) :: max_l + + !> number of numerical integration points + integer, intent(in) :: num_mesh_points + + !> numerical integration abcissas + real(dp), intent(in) :: abcissa(:) + + !> Woods-Saxon potential on grid + real(dp), intent(out) :: vconf(:, 0:) + + !! auxiliary variables + integer :: ii, ll + + @:ASSERT(size(vconf, dim=1) == num_mesh_points) + @:ASSERT(size(vconf, dim=2) == max_l + 1) + + do ll = 0, max_l + do ii = 1, num_mesh_points + vconf(ii, ll) = getPowerPotential(abcissa(ii), this%r0(ll), this%power(ll)) + end do + end do + + end subroutine TPowerConf_getPotOnGrid + + + !> Tabulates the (shell-resolved) Woods-Saxon confinement potential on the grid. + subroutine TWsConf_getPotOnGrid(this, max_l, num_mesh_points, abcissa, vconf) + + !> instance + class(TWsConf), intent(in) :: this + + !> maximum angular momentum + integer, intent(in) :: max_l + + !> number of numerical integration points + integer, intent(in) :: num_mesh_points + + !> numerical integration abcissas + real(dp), intent(in) :: abcissa(:) + + !> Woods-Saxon potential on grid + real(dp), intent(out) :: vconf(:, 0:) + + !! auxiliary variables + integer :: ii, ll + + @:ASSERT(size(vconf, dim=1) == num_mesh_points) + @:ASSERT(size(vconf, dim=2) == max_l + 1) + + do ll = 0, max_l + do ii = 1, num_mesh_points + vconf(ii, ll) = getWSPotential(abcissa(ii), this%rOnset(ll), this%rCut(ll), this%vMax(ll)) + end do + end do + + end subroutine TWsConf_getPotOnGrid + + + !> Tabulates the (shell-resolved) Power confinement potential on the grid. + subroutine TPowerConf_getSupervec(this, max_l, num_mesh_points, abcissa, weight, num_alpha,& + & alpha, poly_order, vconf, vconf_matrix) + + !> instance + class(TPowerConf), intent(in) :: this + + !> maximum angular momentum + integer, intent(in) :: max_l + + !> number of numerical integration points + integer, intent(in) :: num_mesh_points + + !> numerical integration abcissas + real(dp), intent(in) :: abcissa(:) + + !> numerical integration weights + real(dp), intent(in) :: weight(:) + + !> number of exponents in each shell + integer, intent(in) :: num_alpha(0:) + + !> basis exponents + real(dp), intent(in) :: alpha(0:,:) + + !> highest polynomial order + l in each shell + integer, intent(in) :: poly_order(0:) + + !> Power potential on grid + real(dp), intent(in) :: vconf(:, 0:) + + !> Power confinement supervector + real(dp), intent(out) :: vconf_matrix(0:,:,:) + + @:ASSERT(size(vconf, dim=1) == num_mesh_points) + @:ASSERT(size(vconf, dim=2) == max_l + 1) + + @:ASSERT(size(vconf_matrix, dim=1) == max_l + 1) + + call build_dft_conf_matrix(max_l, num_alpha, poly_order, alpha, num_mesh_points, abcissa,& + & weight, vconf, vconf_matrix) + + end subroutine TPowerConf_getSupervec + + + !> Tabulates the (shell-resolved) Woods-Saxon confinement potential on the grid. + subroutine TWsConf_getSupervec(this, max_l, num_mesh_points, abcissa, weight, num_alpha, alpha,& + & poly_order, vconf, vconf_matrix) + + !> instance + class(TWsConf), intent(in) :: this + + !> maximum angular momentum + integer, intent(in) :: max_l + + !> number of numerical integration points + integer, intent(in) :: num_mesh_points + + !> numerical integration abcissas + real(dp), intent(in) :: abcissa(:) + + !> numerical integration weights + real(dp), intent(in) :: weight(:) + + !> number of exponents in each shell + integer, intent(in) :: num_alpha(0:) + + !> basis exponents + real(dp), intent(in) :: alpha(0:,:) + + !> highest polynomial order + l in each shell + integer, intent(in) :: poly_order(0:) + + !> Woods-Saxon potential on grid + real(dp), intent(in) :: vconf(:, 0:) + + !> Woods-Saxon confinement supervector + real(dp), intent(out) :: vconf_matrix(0:,:,:) + + @:ASSERT(size(vconf, dim=1) == num_mesh_points) + @:ASSERT(size(vconf, dim=2) == max_l + 1) + + @:ASSERT(size(vconf_matrix, dim=1) == max_l + 1) + + call build_dft_conf_matrix(max_l, num_alpha, poly_order, alpha, num_mesh_points, abcissa,& + & weight, vconf, vconf_matrix) + + end subroutine TWsConf_getSupervec + + + !> Builds DFT confinement matrix to be added to the Fock matrix by calculating the single matrix + !! elements and putting them together. + subroutine build_dft_conf_matrix(max_l, num_alpha, poly_order, alpha, num_mesh_points, abcissa,& + & weight, vconf, conf_matrix) + + !> maximum angular momentum + integer, intent(in) :: max_l + + !> number of exponents in each shell + integer, intent(in) :: num_alpha(0:) + + !> highest polynomial order + l in each shell + integer, intent(in) :: poly_order(0:) + + !> basis exponents + real(dp), intent(in) :: alpha(0:,:) + + !> number of numerical integration points + integer, intent(in) :: num_mesh_points + + !> numerical integration abcissas + real(dp), intent(in) :: abcissa(:) + + !> numerical integration weights + real(dp), intent(in) :: weight(:) + + !> confinement potential on grid + real(dp), intent(in) :: vconf(:, 0:) + + !> DFT confinement matrix + real(dp), intent(out) :: conf_matrix(0:,:,:) + + !> single matrix element of the confinement potential + real(dp) :: conf_matrixelement + + !> auxiliary variables + integer :: ii, jj, kk, ll, mm, ss, tt, start + + conf_matrix(:,:,:) = 0.0_dp + conf_matrixelement = 0.0_dp + + do ii = 0, max_l + ss = 0 + do jj = 1, num_alpha(ii) + do kk = 1, poly_order(ii) + ss = ss + 1 + + tt = ss - 1 + do ll = jj, num_alpha(ii) + + start = 1 + if (ll == jj) start = kk + + do mm = start, poly_order(ii) + tt = tt + 1 + + call dft_conf_matrixelement(num_mesh_points, weight, abcissa, vconf(:, ii),& + & alpha(ii, jj), kk, alpha(ii, ll), mm, ii, conf_matrixelement) + + conf_matrix(ii, ss, tt) = conf_matrixelement + conf_matrix(ii, tt, ss) = conf_matrixelement + + end do + end do + end do + end do + end do + + end subroutine build_dft_conf_matrix + + + !> Calculates a single matrix element of the exchange correlation potential. + pure subroutine dft_conf_matrixelement(num_mesh_points, weight, abcissa, vconf, alpha1, poly1,& + & alpha2, poly2, ll, conf_matrixelement) + + !> number of numerical integration points + integer, intent(in) :: num_mesh_points + + !> numerical integration weights + real(dp), intent(in) :: weight(:) + + !> numerical integration abcissas + real(dp), intent(in) :: abcissa(:) + + !> confinement potential on grid + real(dp), intent(in) :: vconf(:) + + !> basis exponent of 1st basis + real(dp), intent(in) :: alpha1 + + !> highest polynomial order in 1st basis shell + integer, intent(in) :: poly1 + + !> basis exponent of 2nd basis + real(dp), intent(in) :: alpha2 + + !> highest polynomial order in 2nd basis shell + integer, intent(in) :: poly2 + + !> angular momentum + integer, intent(in) :: ll + + !> single matrix element of the exchange correlation potential + real(dp), intent(out) :: conf_matrixelement + + !> stores product of two basis functions and r^2 + real(dp) :: basis + + !> auxiliary variable + integer :: ii + + conf_matrixelement = 0.0_dp + + do ii = 1, num_mesh_points + basis = basis_times_basis_times_r2(alpha1, poly1, alpha2, poly2, ll, abcissa(ii)) + conf_matrixelement = conf_matrixelement + weight(ii) * vconf(ii) * basis + end do + + end subroutine dft_conf_matrixelement + + + !> Returns the Power potential for a given radial distance. + pure function getPowerPotential(rr, r0, power) result(pot) + + !> radial distance + real(dp), intent(in) :: rr + + !> confinement radius + real(dp), intent(in) :: r0 + + !> confinement power + real(dp), intent(in) :: power + + !> Power potential at evaluation point + real(dp) :: pot + + pot = (rr / r0)**power + + end function getPowerPotential + + + !> Returns the Woods-Saxon potential for a given radial distance. + pure function getWSPotential(rr, rOnset, rCut, vMax) result(pot) + + !> radial distance + real(dp), intent(in) :: rr + + !> onset radius + real(dp), intent(in) :: rOnset + + !> cutoff radius + real(dp), intent(in) :: rCut + + !> potential well height + real(dp), intent(in) :: vMax + + !> Woods-Saxon potential at evaluation point + real(dp) :: pot + + ! case: rr <= rOnset + pot = 0.0_dp + + if (rr > rOnset .and. rr < rCut) then + pot = vMax / (rCut - rOnset) * (rr - rOnset) + elseif (rr >= rCut) then + pot = vMax + end if + + end function getWSPotential + + + ! !> Calculates analytic matrix elements of confining potential. + ! !! No checking for power, e.g. power==0 or power<0 etc. ! + ! subroutine getConfPower_analytical(this, max_l, num_alpha, alpha, poly_order, vconf_matrix) + + ! !> instance + ! class(TPowerConf), intent(in) :: this + + ! !> maximum angular momentum + ! integer, intent(in) :: max_l + + ! !> number of exponents in each shell + ! integer, intent(in) :: num_alpha(0:) + + ! !> basis exponents + ! real(dp), intent(in) :: alpha(0:,:) + + ! !> highest polynomial order + l in each shell + ! integer, intent(in) :: poly_order(0:) + + ! !> confinement supervector + ! real(dp), intent(out) :: vconf_matrix(0:,:,:) + + ! !! temporary storage + ! real(dp) :: alpha1 + + ! !! auxiliary variables + ! integer :: ii, jj, kk, ll, mm, nn, oo, nlp, nlq + + ! vconf_matrix(:,:,:) = 0.0_dp + + ! do ii = 0, max_l + ! if (this%power(ii) > 1.0e-06_dp) then + ! nn = 0 + ! do jj = 1, num_alpha(ii) + ! do ll = 1, poly_order(ii) + ! nn = nn + 1 + ! oo = 0 + ! nlp = ll + ii + ! do kk = 1, num_alpha(ii) + ! alpha1 = 0.5_dp * (alpha(ii, jj) + alpha(ii, kk)) + ! do mm = 1, poly_order(ii) + ! oo = oo + 1 + ! nlq = mm + ii + ! vconf_matrix(ii, nn, oo) = 1.0_dp / sqrt(v(alpha(ii, jj), 2 * nlp)& + ! & * v(alpha(ii, kk), 2 * nlq)) / (this%r0(ii) * 2.0_dp)**this%power(ii)& + ! & * v(alpha1, nlp + nlq + this%power(ii)) + ! end do + ! end do + ! end do + ! end do + ! end if + ! end do + + ! end subroutine TConf_getConfPower_analytical + +end module confinement diff --git a/slateratom/lib/core_overlap.f90 b/slateratom/lib/core_overlap.f90 index 258386c6..91e9d523 100644 --- a/slateratom/lib/core_overlap.f90 +++ b/slateratom/lib/core_overlap.f90 @@ -7,7 +7,7 @@ module core_overlap implicit none private - public :: overlap, kinetic, nuclear, moments, v, confinement + public :: overlap, kinetic, nuclear, moments, v interface v @@ -192,65 +192,6 @@ pure subroutine kinetic(tt, max_l, num_alpha, alpha, poly_order) end subroutine kinetic - !> Calculates analytic matrix elements of confining potential. - !! No checking for power, e.g. power==0 or power<0 etc. ! - pure subroutine confinement(vconf, max_l, num_alpha, alpha, poly_order, conf_r0, conf_power) - - !> confinement supervector - real(dp), intent(out) :: vconf(0:,:,:) - - !> maximum angular momentum - integer, intent(in) :: max_l - - !> number of exponents in each shell - integer, intent(in) :: num_alpha(0:) - - !> basis exponents - real(dp), intent(in) :: alpha(0:,:) - - !> highest polynomial order + l in each shell - integer, intent(in) :: poly_order(0:) - - !> confinement radii - real(dp), intent(in) :: conf_r0(0:) - - !> power of confinement - real(dp), intent(in) :: conf_power(0:) - - !> temporary storage - real(dp) :: alpha1 - - !> auxiliary variables - integer :: ii, jj, kk, ll, mm, nn, oo, nlp, nlq - - vconf(:,:,:) = 0.0_dp - - do ii = 0, max_l - if (conf_power(ii) > 1.0e-06_dp) then - nn = 0 - do jj = 1, num_alpha(ii) - do ll = 1, poly_order(ii) - nn = nn + 1 - oo = 0 - nlp = ll + ii - do kk = 1, num_alpha(ii) - alpha1 = 0.5_dp * (alpha(ii, jj) + alpha(ii, kk)) - do mm = 1, poly_order(ii) - oo = oo + 1 - nlq = mm + ii - vconf(ii, nn, oo) = 1.0_dp / sqrt(v(alpha(ii, jj), 2 * nlp)& - & * v(alpha(ii, kk), 2 * nlq)) / (conf_r0(ii) * 2.0_dp)**conf_power(ii)& - & * v(alpha1, nlp + nlq + conf_power(ii)) - end do - end do - end do - end do - end if - end do - - end subroutine confinement - - !> Calculates arbitrary moments of electron distribution, e.g. expectation values of , !! etc.; this is implemented analytically for arbitrary powers. pure subroutine moments(moment, max_l, num_alpha, alpha, poly_order, cof, power) diff --git a/slateratom/lib/globals.f90 b/slateratom/lib/globals.f90 index 6687874d..92e50a35 100644 --- a/slateratom/lib/globals.f90 +++ b/slateratom/lib/globals.f90 @@ -5,14 +5,16 @@ module globals use mixer, only : TMixer, TMixer_init, TMixer_reset, mixerTypes use broydenmixer, only : TBroydenMixer, TBroydenMixer_init use simplemixer, only : TSimpleMixer, TSimpleMixer_init + use confinement, only : TConfInp implicit none - !> confinement radii - real(dp) :: conf_r0(0:4) - !> power of confinement - real(dp) :: conf_power(0:4) + !> type of confinement potential + integer :: conf_type = 0 + + !> confinement potential input + type(TConfInp) :: confInp !> basis exponents real(dp) :: alpha(0:4, 10) @@ -65,8 +67,11 @@ module globals !> kinetic supervector real(dp), allocatable :: tt(:,:,:) + !> confinement potential on grid + real(dp), allocatable :: vconf(:,:) + !> confinement supervector - real(dp), allocatable :: vconf(:,:,:) + real(dp), allocatable :: vconf_matrix(:,:,:) !> coulomb supermatrix real(dp), allocatable :: jj(:,:,:,:,:,:) @@ -218,7 +223,8 @@ subroutine allocate_globals() allocate(uu(0:max_l, problemsize, problemsize)) allocate(tt(0:max_l, problemsize, problemsize)) - allocate(vconf(0:max_l, problemsize, problemsize)) + allocate(vconf(num_mesh_points, 0:max_l)) + allocate(vconf_matrix(0:max_l, problemsize, problemsize)) allocate(ff(2, 0:max_l, problemsize, problemsize)) allocate(pot_old(2, 0:max_l, problemsize, problemsize)) allocate(pot_new(2, 0:max_l, problemsize, problemsize)) diff --git a/slateratom/lib/input.f90 b/slateratom/lib/input.f90 index 51104403..16e9b994 100644 --- a/slateratom/lib/input.f90 +++ b/slateratom/lib/input.f90 @@ -4,6 +4,7 @@ module input use common_accuracy, only : dp use common_poisson, only : TBeckeGridParams + use confinement, only : TConfInp, confType use xcfunctionals, only : xcFunctional implicit none @@ -16,7 +17,7 @@ module input !> Reads in all properties, except for occupation numbers. subroutine read_input_1(nuc, max_l, occ_shells, maxiter, scftol, poly_order, min_alpha,& - & max_alpha, num_alpha, tAutoAlphas, alpha, conf_r0, conf_power, num_occ, num_power,& + & max_alpha, num_alpha, tAutoAlphas, alpha, conf_type, confInp, num_occ, num_power,& & num_alphas, xcnr, tPrintEigvecs, tZora, mixnr, mixing_factor, xalpha_const, omega,& & camAlpha, camBeta, grid_params) @@ -53,11 +54,11 @@ subroutine read_input_1(nuc, max_l, occ_shells, maxiter, scftol, poly_order, min !> basis exponents real(dp), intent(out) :: alpha(0:4, 10) - !> confinement radii - real(dp), intent(out) :: conf_r0(0:4) + !> type of confinement potential + integer, intent(out) :: conf_type - !> power of confinement - real(dp), intent(out) :: conf_power(0:4) + !> confinement potential input + type(TConfInp), intent(out) :: confInp !> maximal occupied shell integer, intent(out) :: num_occ @@ -98,6 +99,9 @@ subroutine read_input_1(nuc, max_l, occ_shells, maxiter, scftol, poly_order, min !> holds parameters, defining a Becke integration grid type(TBeckeGridParams), intent(out) :: grid_params + !! confinement type of last query + integer :: last_conf_type + !! auxiliary variables integer :: ii, jj @@ -153,12 +157,38 @@ subroutine read_input_1(nuc, max_l, occ_shells, maxiter, scftol, poly_order, min stop end if - write(*, '(A)') 'Enter Confinement: r_0 and integer power, power=0.0 -> off' + last_conf_type = 0 do ii = 0, max_l - write(*, '(A,I3)') 'l=', ii - read(*,*) conf_r0(ii), conf_power(ii) + write(*, '(A,I3)') 'Enter confinement ID (0: none, 1: power, 2: WS) for l=', ii + read(*,*) conf_type + if (ii > 0) then + if (conf_type /= last_conf_type) then + error stop 'At the moment different shells are supposed to be compressed with the same& + & type of potential' + end if + end if + last_conf_type = conf_type end do + select case (conf_type) + case(confType%none) + continue + case(confType%power) + write(*, '(A)') 'Enter parameters r_0 and power' + do ii = 0, max_l + write(*, '(A,I3)') 'l=', ii + read(*,*) confInp%power%r0(ii), confInp%power%power(ii) + end do + case(confType%ws) + write(*, '(A)') 'Enter parameters Ronset, Rcut and Vmax' + do ii = 0, max_l + write(*, '(A,I3)') 'l=', ii + read(*,*) confInp%ws%rOnset(ii), confInp%ws%rCut(ii), confInp%ws%vMax(ii) + end do + case default + error stop 'Invalid confinement potential.' + end select + write(*, '(A)') 'Enter number of occupied shells for each angular momentum.' do ii = 0, max_l write(*, '(A,I3)') 'l=', ii @@ -188,7 +218,8 @@ subroutine read_input_1(nuc, max_l, occ_shells, maxiter, scftol, poly_order, min end do else do ii = 0, max_l - write(*, '(A,I3,A,I3,A)') 'Enter ', num_alpha(ii), 'exponents for l=', ii, ', one per line.' + write(*, '(A,I3,A,I3,A)') 'Enter ', num_alpha(ii),& + & ' exponents for l=', ii, ', one per line.' do jj = 1, num_alpha(ii) read(*,*) alpha(ii, jj) end do @@ -265,7 +296,7 @@ end subroutine read_input_2 !> Echos gathered input to stdout. subroutine echo_input(nuc, max_l, occ_shells, maxiter, scftol, poly_order, num_alpha, alpha,& - & conf_r0, conf_power, occ, num_occ, num_power, num_alphas, xcnr, tZora, num_mesh_points,& + & conf_type, confInp, occ, num_occ, num_power, num_alphas, xcnr, tZora, num_mesh_points,& & xalpha_const) !> nuclear charge, i.e. atomic number @@ -292,11 +323,11 @@ subroutine echo_input(nuc, max_l, occ_shells, maxiter, scftol, poly_order, num_a !> basis exponents real(dp), intent(in) :: alpha(0:,:) - !> confinement radii - real(dp), intent(in) :: conf_r0(0:) + !> type of confinement potential + integer, intent(in) :: conf_type - !> power of confinement - real(dp), intent(in) :: conf_power(0:) + !> confinement potential input + type(TConfInp), intent(in) :: confInp !> occupation numbers real(dp), intent(in) :: occ(:,0:,:) @@ -391,12 +422,16 @@ subroutine echo_input(nuc, max_l, occ_shells, maxiter, scftol, poly_order, num_a write(*, '(A)') ' ' do ii = 0, max_l - if (conf_power(ii) > 1.0e-06_dp) then - write(*, '(A,I3,A,E15.7,A,E15.7)') 'l= ', ii, ', r0= ', conf_r0(ii), ' power= ',& - & conf_power(ii) - else - write(*, '(A,I3,A)') 'l= ', ii, ' no confinement ' - end if + select case (conf_type) + case(confType%none) + write(*, '(A,I3,A)') 'l= ', ii, ' no confinement' + case(confType%power) + write(*, '(A,I3,A,E15.7,A,E15.7)') 'l= ', ii, ', r0= ', confInp%power%r0(ii),& + & ' power= ', confInp%power%power(ii) + case(confType%ws) + write(*, '(A,I3,A,E15.7,A,E15.7,A,E15.7)') 'l= ', ii, ', Ronset= ', confInp%ws%rOnset(ii),& + & ' Rcutoff= ', confInp%ws%rCut(ii), ' Vmax= ', confInp%ws%vMax(ii) + end select end do write(*, '(A)') ' ' diff --git a/slateratom/prog/CMakeLists.txt b/slateratom/prog/CMakeLists.txt index 5693fe3d..945ddd4a 100644 --- a/slateratom/prog/CMakeLists.txt +++ b/slateratom/prog/CMakeLists.txt @@ -1,9 +1,21 @@ +set(projectdir ${PROJECT_SOURCE_DIR}) + +# +# General options for all targets +# +set(fypp_flags ${FYPP_BUILD_FLAGS} ${FYPP_CONFIG_FLAGS}) +list(APPEND fypp_flags -I${projectdir}/common/include -DRELEASE="'${RELEASE}'") + set(sources-f90 - cmdargs.f90 - main.f90) + cmdargs.f90) + +set(sources-fpp + main.F90) -add_executable(slateratom ${sources-f90}) +skprogs_preprocess("${FYPP}" "${fypp_flags}" "F90" "f90" "${sources-fpp}" sources-f90-preproc) + +add_executable(slateratom ${sources-f90} ${sources-f90-preproc}) target_link_libraries(slateratom skprogs-slateratom) - + install(TARGETS slateratom EXPORT skprogs-targets DESTINATION ${CMAKE_INSTALL_BINDIR}) diff --git a/slateratom/prog/main.f90 b/slateratom/prog/main.F90 similarity index 78% rename from slateratom/prog/main.f90 rename to slateratom/prog/main.F90 index a4143149..9ac24388 100644 --- a/slateratom/prog/main.f90 +++ b/slateratom/prog/main.F90 @@ -1,10 +1,13 @@ +#:include 'common.fypp' + program HFAtom use common_accuracy, only : dp use common_message, only : error use integration, only : gauss_chebyshev_becke_mesh use input, only : read_input_1, read_input_2, echo_input - use core_overlap, only : overlap, nuclear, kinetic, confinement + use core_overlap, only : overlap, nuclear, kinetic + use confinement, only : TConf, confType, TPowerConf, TPowerConf_init, TWsConf, TWsConf_init use coulomb_hfex, only : coulomb, hfex, hfex_lr use densitymatrix, only : densmatrix use hamiltonian, only : build_hamiltonian @@ -49,12 +52,15 @@ program HFAtom !! holds parameters, defining a Becke integration grid type(TBeckeGridParams) :: grid_params + !! general confinement potential + class(TConf), allocatable :: conf + ! deactivate average potential calculation for now isAvgPotNeeded = .false. call parse_command_arguments() call read_input_1(nuc, max_l, occ_shells, maxiter, scftol, poly_order, min_alpha, max_alpha,& - & num_alpha, tAutoAlphas, alpha, conf_r0, conf_power, num_occ, num_power, num_alphas, xcnr,& + & num_alpha, tAutoAlphas, alpha, conf_type, confInp, num_occ, num_power, num_alphas, xcnr,& & tPrintEigvecs, tZora, mixnr, mixing_factor, xalpha_const, omega, camAlpha, camBeta,& & grid_params) @@ -73,8 +79,8 @@ program HFAtom if (nuc > 36) num_mesh_points = 1250 if (nuc > 54) num_mesh_points = 1500 - call echo_input(nuc, max_l, occ_shells, maxiter, scftol, poly_order, num_alpha, alpha, conf_r0,& - & conf_power, occ, num_occ, num_power, num_alphas, xcnr, tZora, num_mesh_points, xalpha_const) + call echo_input(nuc, max_l, occ_shells, maxiter, scftol, poly_order, num_alpha, alpha, conf_type,& + & confInp, occ, num_occ, num_power, num_alphas, xcnr, tZora, num_mesh_points, xalpha_const) ! allocate global stuff and zero out call allocate_globals() @@ -90,7 +96,21 @@ program HFAtom call overlap(ss, max_l, num_alpha, alpha, poly_order) call nuclear(uu, max_l, num_alpha, alpha, poly_order) call kinetic(tt, max_l, num_alpha, alpha, poly_order) - call confinement(vconf, max_l, num_alpha, alpha, poly_order, conf_r0, conf_power) + + select case (conf_type) + case(confType%power) + @:CREATE_CLASS(conf, TPowerConf, TPowerConf_init, confInp%power) + case(confType%ws) + @:CREATE_CLASS(conf, TWsConf, TWsConf_init, confInp%ws) + end select + + if (allocated(conf)) then + call conf%getPotOnGrid(max_l, num_mesh_points, abcissa, vconf) + call conf%getSupervec(max_l, num_mesh_points, abcissa, weight, num_alpha, alpha, poly_order,& + & vconf, vconf_matrix) + else + vconf_matrix(0:,:,:) = 0.0_dp + end if ! test for linear dependency call diagonalize_overlap(max_l, num_alpha, poly_order, ss) @@ -125,7 +145,7 @@ program HFAtom pot_old(:,:,:,:) = 0.0_dp ! kinetic energy, nuclear-electron, and confinement matrix elements which are constant during SCF - call build_hamiltonian(pMixer, 0, tt, uu, nuc, vconf, jj, kk, kk_lr, pp, max_l, num_alpha,& + call build_hamiltonian(pMixer, 0, tt, uu, nuc, vconf_matrix, jj, kk, kk_lr, pp, max_l, num_alpha,& & poly_order, problemsize, xcnr, num_mesh_points, weight, abcissa, vxc, alpha, pot_old,& & pot_new, tZora, ff, camAlpha, camBeta) @@ -149,19 +169,20 @@ program HFAtom & dz, xcnr, omega, camAlpha, camBeta, rho, drho, ddrho, vxc, exc, xalpha_const) ! build Fock matrix and get total energy during SCF - call build_hamiltonian(pMixer, iScf, tt, uu, nuc, vconf, jj, kk, kk_lr, pp, max_l, num_alpha,& - & poly_order, problemsize, xcnr, num_mesh_points, weight, abcissa, vxc, alpha, pot_old,& - & pot_new, tZora, ff, camAlpha, camBeta) + call build_hamiltonian(pMixer, iScf, tt, uu, nuc, vconf_matrix, jj, kk, kk_lr, pp, max_l,& + & num_alpha, poly_order, problemsize, xcnr, num_mesh_points, weight, abcissa, vxc, alpha,& + & pot_old, pot_new, tZora, ff, camAlpha, camBeta) if (tZora) then - call getTotalEnergyZora(tt, uu, nuc, vconf, jj, kk, kk_lr, pp, max_l, num_alpha, poly_order,& - & problemsize, xcnr, num_mesh_points, weight, abcissa, rho, exc, vxc, eigval_scaled, occ,& - & camAlpha, camBeta, kinetic_energy, nuclear_energy, coulomb_energy, exchange_energy,& - & x_en_2, conf_energy, total_ene) + call getTotalEnergyZora(tt, uu, nuc, vconf_matrix, jj, kk, kk_lr, pp, max_l, num_alpha,& + & poly_order, problemsize, xcnr, num_mesh_points, weight, abcissa, rho, exc, vxc,& + & eigval_scaled, occ, camAlpha, camBeta, kinetic_energy, nuclear_energy, coulomb_energy,& + & exchange_energy, x_en_2, conf_energy, total_ene) else - call getTotalEnergy(tt, uu, nuc, vconf, jj, kk, kk_lr, pp, max_l, num_alpha, poly_order,& - & xcnr, num_mesh_points, weight, abcissa, rho, exc, camAlpha, camBeta, kinetic_energy,& - & nuclear_energy, coulomb_energy, exchange_energy, x_en_2, conf_energy, total_ene) + call getTotalEnergy(tt, uu, nuc, vconf_matrix, jj, kk, kk_lr, pp, max_l, num_alpha,& + & poly_order, xcnr, num_mesh_points, weight, abcissa, rho, exc, camAlpha, camBeta,& + & kinetic_energy, nuclear_energy, coulomb_energy, exchange_energy, x_en_2, conf_energy,& + & total_ene) end if call check_convergence(pot_old, pot_new, max_l, problemsize, scftol, iScf, change_max,& @@ -206,10 +227,10 @@ program HFAtom end if if (tZora) then - call getTotalEnergyZora(tt, uu, nuc, vconf, jj, kk, kk_lr, pp, max_l, num_alpha, poly_order,& - & problemsize, xcnr, num_mesh_points, weight, abcissa, rho, exc, vxc, eigval_scaled, occ,& - & camAlpha, camBeta, zora_ekin, nuclear_energy, coulomb_energy, exchange_energy, x_en_2,& - & conf_energy, total_ene) + call getTotalEnergyZora(tt, uu, nuc, vconf_matrix, jj, kk, kk_lr, pp, max_l, num_alpha,& + & poly_order, problemsize, xcnr, num_mesh_points, weight, abcissa, rho, exc, vxc,& + & eigval_scaled, occ, camAlpha, camBeta, zora_ekin, nuclear_energy, coulomb_energy,& + & exchange_energy, x_en_2, conf_energy, total_ene) end if write(*, '(A,E20.12)') 'Potential Matrix Elements converged to ', change_max