diff --git a/app/CMakeLists.txt b/app/CMakeLists.txt
index c2aa79733..aadcb4b3f 100644
--- a/app/CMakeLists.txt
+++ b/app/CMakeLists.txt
@@ -17,8 +17,10 @@
add_executable(
"${PROJECT_NAME}-exe"
"main.f90"
+ "argument.f90"
"cli.f90"
"driver.f90"
+ "help.f90"
)
set_target_properties(
"${PROJECT_NAME}-exe"
diff --git a/app/argument.f90 b/app/argument.f90
new file mode 100644
index 000000000..114116317
--- /dev/null
+++ b/app/argument.f90
@@ -0,0 +1,364 @@
+! This file is part of dftd4.
+! SPDX-Identifier: LGPL-3.0-or-later
+!
+! dftd4 is free software: you can redistribute it and/or modify it under
+! the terms of the Lesser GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! dftd4 is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! Lesser GNU General Public License for more details.
+!
+! You should have received a copy of the Lesser GNU General Public License
+! along with dftd4. If not, see .
+
+!> Implementation of the argument list processor.
+module dftd4_argument
+ implicit none
+ private
+
+ public :: argument_list, len
+ public :: argument_count_interface, get_argument_interface
+
+
+ !> Internal representation of the command line arguments
+ type :: argument
+ private
+ !> Actual payload of the argument
+ character(len=:), allocatable :: raw
+ end type argument
+
+ !> Constructor for the argument representation
+ interface argument
+ module procedure :: new_argument
+ end interface argument
+
+
+ !> Argument list class
+ type :: argument_list
+ !> Name of the invoked executable, if available
+ character(len=:), allocatable :: prog
+ !> Number of arguments
+ integer :: nargs = 0
+ !> Array of arguments in this list
+ type(argument), allocatable :: argv(:)
+ contains
+ !> Append a command line argument
+ procedure :: push_back
+ !> Display debug information on this instance
+ procedure :: info
+ !> Get command line argument
+ procedure :: get
+ end type argument_list
+
+ !> Constructor for the argument list
+ interface argument_list
+ module procedure :: new_argument_list
+ end interface argument_list
+
+ interface len
+ module procedure :: get_length
+ end interface len
+
+
+ abstract interface
+ !> Interface of the argument counter
+ function argument_count_interface() result(argument_count)
+ !> Number of available arguments
+ integer :: argument_count
+ end function argument_count_interface
+
+ !> Interface of the argument getter
+ subroutine get_argument_interface(idx, arg)
+ !> Index of the argument to retrieve, range 0 to argument_counter()
+ integer, intent(in) :: idx
+ !> Returned argument payload, allocation status is used to signal errors
+ character(len=:), allocatable, intent(out) :: arg
+ end subroutine get_argument_interface
+ end interface
+
+ !> Token identifyin response files
+ character(len=*), parameter :: response_token = "@"
+
+ !> Initial size for the resizer of the argument list
+ integer, parameter :: initial_size = 20
+
+
+contains
+
+
+!> Create a new argument from a raw payload
+pure function new_argument(raw) result(new)
+ !> Raw argument value
+ character(len=*), intent(in) :: raw
+ !> Representation of the argument
+ type(argument) :: new
+
+ new%raw = raw
+end function new_argument
+
+!> Constructor of the argument list
+function new_argument_list(argument_counter, argument_getter) result(new)
+ !> Argument counter interface
+ procedure(argument_count_interface), optional :: argument_counter
+ !> Argument getter interface
+ procedure(get_argument_interface), optional :: argument_getter
+ !> Newly created argument list
+ type(argument_list) :: new
+
+ intrinsic :: present
+
+ if (present(argument_getter) .and. present(argument_counter)) then
+ call make_argument_list(new, argument_counter, argument_getter)
+ else
+ call make_argument_list(new, default_argument_count, get_default_argument)
+ end if
+end function new_argument_list
+
+!> Internal constructor of the argument list
+subroutine make_argument_list(self, argument_counter, argument_getter)
+ !> Instance of the argument list to be created
+ type(argument_list), intent(out) :: self
+ !> Argument counter interface
+ procedure(argument_count_interface) :: argument_counter
+ !> Argument getter interface
+ procedure(get_argument_interface) :: argument_getter
+
+ integer :: iarg, narg, info
+ character(len=:), allocatable :: arg
+ intrinsic :: allocated
+
+ info = 0
+ narg = argument_counter()
+ self%nargs = 0
+ call resize(self%argv, narg)
+ call argument_getter(0, self%prog)
+ do iarg = 1, narg
+ call argument_getter(iarg, arg)
+ if (.not.allocated(arg)) return
+ if (is_response_file(arg)) then
+ call get_response_file(self, arg(2:), info)
+ if (info == 0) cycle
+ end if
+ call push_back(self, arg)
+ end do
+
+end subroutine make_argument_list
+
+
+!> Check if an argument represents a response file
+pure function is_response_file(arg) result(is_resp)
+ !> Argument of interest
+ character(len=*), intent(in) :: arg
+ !> Whether the argument could be a response file or not
+ logical :: is_resp
+ intrinsic :: len
+
+ if (len(arg) > 1) then
+ is_resp = arg(1:1) == response_token
+ else
+ is_resp = .false.
+ end if
+end function is_response_file
+
+!> Recursively consume a response file and append it to the argument list
+recursive subroutine get_response_file(self, resp, stat)
+ !> Instance of the argument list
+ class(argument_list), intent(inout) :: self
+ !> Name of the response file to be appended
+ character(len=*), intent(in) :: resp
+ !> Status of reading the reponse file
+ integer, intent(out) :: stat
+
+ integer :: unit, info, istat
+ logical :: opened
+ character(len=:), allocatable :: arg
+
+ inquire(file=resp, opened=opened)
+ if (opened) then
+ stat = 1
+ return
+ end if
+
+ open(file=resp, unit=unit, iostat=info, status='old', action='read')
+ do while(info == 0)
+ call getline(unit, arg, info)
+ if (info /= 0) exit
+ if (is_response_file(arg)) then
+ call get_response_file(self, arg(2:), istat)
+ if (istat == 0) cycle
+ end if
+ call push_back(self, arg)
+ end do
+ close(unit, iostat=stat)
+ if (info /= 0) then
+ stat = merge(0, info, is_iostat_end(info))
+ end if
+end subroutine get_response_file
+
+!> Consume a whole line from a formatted unit
+subroutine getline(unit, line, iostat, iomsg)
+ !> Formatted IO unit
+ integer, intent(in) :: unit
+ !> Line to read
+ character(len=:), allocatable, intent(out) :: line
+ !> Status of operation
+ integer, intent(out) :: iostat
+ !> Error message
+ character(len=:), allocatable, optional :: iomsg
+
+ integer, parameter :: bufsize = 512
+ character(len=bufsize) :: buffer, msg
+ integer :: size, stat
+ intrinsic :: is_iostat_eor, present, trim
+
+ allocate(character(len=0) :: line)
+ do
+ read(unit, '(a)', advance='no', iostat=stat, iomsg=msg, size=size) &
+ & buffer
+ if (stat > 0) exit
+ line = line // buffer(:size)
+ if (stat < 0) exit
+ end do
+
+ if (is_iostat_eor(stat)) stat = 0
+
+ if (stat /= 0) then
+ if (present(iomsg)) iomsg = trim(msg)
+ end if
+ iostat = stat
+
+end subroutine getline
+
+
+!> Append a string to the argument list
+subroutine push_back(self, string)
+ !> Instance of the argument list
+ class(argument_list), intent(inout) :: self
+ !> String representing the argument
+ character(len=*), intent(in) :: string
+ intrinsic :: size
+
+ self%nargs = self%nargs + 1
+ if (self%nargs > size(self%argv)) call resize(self%argv)
+ self%argv(self%nargs) = argument(string)
+
+end subroutine push_back
+
+!> Reallocate list of arguments
+pure subroutine resize(list, n)
+ !> Instance of the array to be resized
+ type(argument), allocatable, intent(inout) :: list(:)
+ !> Dimension of the final array size
+ integer, intent(in), optional :: n
+
+ type(argument), allocatable :: tmp(:)
+ integer :: this_size, new_size, iv
+ intrinsic :: allocated, size, move_alloc, present, min
+
+ if (allocated(list)) then
+ this_size = size(list, 1)
+ call move_alloc(list, tmp)
+ else
+ this_size = initial_size
+ end if
+
+ if (present(n)) then
+ new_size = n
+ else
+ new_size = this_size + this_size/2 + 1
+ end if
+
+ allocate(list(new_size))
+
+ if (allocated(tmp)) then
+ this_size = min(size(tmp, 1), size(list, 1))
+ do iv = 1, this_size
+ call move_alloc(tmp(iv)%raw, list(iv)%raw)
+ end do
+ deallocate(tmp)
+ end if
+end subroutine resize
+
+
+!> Display debug information on an argument list instance
+subroutine info(self, unit)
+ !> Instance of the argument list
+ class(argument_list), intent(in) :: self
+ !> Formatted unit for output
+ integer, intent(in) :: unit
+
+ character(len=*), parameter :: fmt = '("#", *(1x, g0))'
+ integer :: iarg
+ intrinsic :: allocated
+
+ if (allocated(self%prog)) then
+ write(unit, fmt) self%prog
+ end if
+
+ if (allocated(self%argv)) then
+ write(unit, fmt) self%nargs, "arguments provided"
+ do iarg = 1, self%nargs
+ write(unit, fmt) iarg, "/", self%nargs, "->", self%argv(iarg)%raw
+ end do
+ end if
+end subroutine info
+
+
+!> Default argument counter using the intrinsic command_argument_count procedure
+function default_argument_count() result(argument_count)
+ !> Number of available arguments
+ integer :: argument_count
+
+ intrinsic :: command_argument_count
+
+ argument_count = command_argument_count()
+end function default_argument_count
+
+!> Default argument getter using the intrinsic get_command_argument procedure
+subroutine get_default_argument(idx, arg)
+ !> Index of the argument to retrieve, range 0 to argument_counter()
+ integer, intent(in) :: idx
+ !> Returned argument payload, allocation status is used to signal errors
+ character(len=:), allocatable, intent(out) :: arg
+
+ integer :: length, stat
+ intrinsic :: get_command_argument
+
+ call get_command_argument(idx, length=length, status=stat)
+ if (stat /= 0) then
+ return
+ endif
+
+ allocate(character(len=length) :: arg, stat=stat)
+ if (stat /= 0) then
+ return
+ endif
+
+ if (length > 0) then
+ call get_command_argument(idx, arg, status=stat)
+ if (stat /= 0) then
+ deallocate(arg)
+ return
+ end if
+ end if
+end subroutine get_default_argument
+
+
+pure subroutine get(self, idx, arg)
+ class(argument_list), intent(in) :: self
+ character(len=:), allocatable, intent(out) :: arg
+ integer, intent(in) :: idx
+
+ if (idx > 0 .and. idx <= self%nargs) arg = self%argv(idx)%raw
+end subroutine get
+
+pure function get_length(self) result(length)
+ class(argument_list), intent(in) :: self
+ integer :: length
+ length = self%nargs
+end function get_length
+
+end module dftd4_argument
diff --git a/app/cli.f90 b/app/cli.f90
index 2b2ff589e..d0db0429c 100644
--- a/app/cli.f90
+++ b/app/cli.f90
@@ -20,14 +20,14 @@ module dftd4_cli
use mctc_env, only : error_type, fatal_error, get_argument, wp
use mctc_io, only : get_filetype
use dftd4, only : rational_damping_param, get_dftd4_version
+ use dftd4_argument, only : argument_list, len
+ use dftd4_help, only : citation, header, help_text, help_text_param, help_text_run, license, prog_name, version
+
implicit none
private
- public :: cli_config, run_config, get_arguments
- public :: prog_name, header
+ public :: cli_config, param_config, run_config, get_arguments
- !> The name of the program
- character(len=*), parameter :: prog_name = "dftd4"
!> Base command line configuration
type, abstract :: cli_config
@@ -57,7 +57,9 @@ module dftd4_cli
real(wp) :: wf = 6.0_wp
logical :: pair_resolved = .false.
end type run_config
-
+ type, extends(cli_config) :: param_config
+ logical :: list = .false.
+ end type param_config
contains
@@ -70,21 +72,71 @@ subroutine get_arguments(config, error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
- block
- type(run_config), allocatable :: tmp
- allocate(tmp)
- call get_run_arguments(tmp, error)
- call move_alloc(tmp, config)
- end block
+ type(argument_list) :: list
+ integer :: iarg, narg
+ character(len=:), allocatable :: arg
+
+ iarg = 0
+ list = argument_list()
+ narg = len(list)
+ do while(iarg < narg)
+ iarg = iarg + 1
+ call list%get(iarg, arg)
+ select case(arg)
+ case("-h", "--help")
+ write(output_unit, '(a)') help_text
+ stop
+ case("--version")
+ call version(output_unit)
+ stop
+ case("--citation")
+ call citation(output_unit)
+ stop
+ case("--license")
+ call license(output_unit)
+ stop
+ case default
+ iarg = iarg - 1
+ allocate(run_config :: config)
+ exit
+ case("run")
+ allocate(run_config :: config)
+ exit
+ case("param")
+ allocate(param_config :: config)
+ exit
+ end select
+ end do
+ if (allocated(error)) return
+
+ if (.not.allocated(config)) then
+ write(output_unit, '(a)') help_text
+ call fatal_error(error, "Insufficient arguments provided")
+ return
+ end if
+
+ select type(config)
+ type is(run_config)
+ call get_run_arguments(config, list, iarg, error)
+ type is(param_config)
+ call get_param_arguments(config, list, iarg, error)
+ end select
+
end subroutine get_arguments
!> Read configuration for the single point driver
-subroutine get_run_arguments(config, error)
+subroutine get_run_arguments(config, list, start, error)
!> Configuation data
type(run_config), intent(out) :: config
+ !> List of command line arguments
+ type(argument_list), intent(in) :: list
+
+ !> First command line argument
+ integer, intent(in) :: start
+
!> Error handling
type(error_type), allocatable, intent(out) :: error
@@ -92,12 +144,12 @@ subroutine get_run_arguments(config, error)
logical :: getopts
character(len=:), allocatable :: arg
- iarg = 0
+ iarg = start
getopts = .true.
- narg = command_argument_count()
+ narg = len(list)
do while(iarg < narg)
iarg = iarg + 1
- call get_argument(iarg, arg)
+ call list%get(iarg, arg)
if (.not.getopts) then
if (.not.allocated(config%input)) then
call move_alloc(arg, config%input)
@@ -110,16 +162,7 @@ subroutine get_run_arguments(config, error)
case("--")
getopts = .false.
case("-h", "--help")
- call help(output_unit)
- stop
- case("--version")
- call version(output_unit)
- stop
- case("--citation")
- call citation(output_unit)
- stop
- case("--license")
- call license(output_unit)
+ write(output_unit, '(a)') help_text_run
stop
case("-v", "--verbose")
config%verbosity = config%verbosity + 1
@@ -237,7 +280,7 @@ subroutine get_run_arguments(config, error)
if (.not.allocated(config%input)) then
if (.not.allocated(error)) then
- call help(output_unit)
+ write(output_unit, '(a)') help_text
error stop
end if
end if
@@ -245,6 +288,50 @@ subroutine get_run_arguments(config, error)
end subroutine get_run_arguments
+subroutine get_param_arguments(config, list, start, error)
+
+ !> Configuation data
+ type(param_config), intent(out) :: config
+
+ !> List of command line arguments
+ type(argument_list), intent(in) :: list
+
+ !> First command line argument
+ integer, intent(in) :: start
+
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+
+ integer :: iarg, narg
+ character(len=:), allocatable :: arg
+
+ iarg = start
+ narg = len(list)
+ do while(iarg < narg)
+ iarg = iarg + 1
+ call list%get(iarg, arg)
+ select case(arg)
+ case("--help")
+ write(output_unit, '(a)') help_text_param
+ stop
+ case("-l", "--list", "--funcs")
+ config%list = .true.
+ case default
+ write(output_unit, '(a)') help_text_param
+ stop
+ end select
+ end do
+ if (allocated(error)) return
+
+ ! check if anything was set
+ if (.not.config%list) then
+ write(output_unit, '(a)') help_text
+ call fatal_error(error, "No arguments provided")
+ end if
+
+end subroutine get_param_arguments
+
+
subroutine get_argument_as_real(iarg, val, error)
!> Index of command line argument, range [0:command_argument_count()]
@@ -273,124 +360,4 @@ subroutine get_argument_as_real(iarg, val, error)
end subroutine get_argument_as_real
-subroutine help(unit)
- integer, intent(in) :: unit
-
- write(unit, '(a, *(1x, a))') &
- "Usage: "//prog_name//" [options] "
-
- write(unit, '(a)') &
- "", &
- "Generally Applicable Atomic-Charge Dependent London Dispersion Correction.", &
- "Takes an geometry input to calculate the D4 dispersion correction.", &
- "Periodic calculations are performed automatically for periodic input formats.", &
- "Reads .CHRG file (if present) from the same directory as the input.", &
- "Specify the functional to select the correct parameters.", &
- ""
-
- write(unit, '(2x, a, t25, a)') &
- "-c, --charge ", "Set charge to molecule, overwrites .CHRG file", &
- "-i, --input ", "Hint for the format of the input file", &
- "-f, --func ", "Use damping parameters for given functional", &
- " --param ", "Specify parameters for rational damping,", &
- "", "expected order is s6, s8, a1, a2 (requires four arguments)", &
- " --mbdscale ", "Use scaled ATM three-body dispersion", &
- " --zeta ", "Adjust charge scaling parameters, takes two reals", &
- "", "expected order is ga, gc (default: 3.0, 2.0)", &
- " --wfactor ", "Adjust weighting factor for interpolation", &
- "", "(default: 6.0)", &
- "-g, --grad [file]", "Evaluate molecular gradient and virial", &
- " --hessian", "Evaluate molecular hessian", &
- "", "write results to file (default: dftd4.txt),", &
- "", "attempts to add to Turbomole gradient and gradlatt files", &
- " --property", "Show dispersion related atomic and system properties", &
- " --pair-resolved", "Calculate pairwise representation of dispersion energy", &
- " --noedisp", "Disable writing of dispersion energy to .EDISP file", &
- " --json [file]", "Dump results to JSON output (default: dftd4.json)", &
- "-v, --verbose", "Show more, can be used multiple times", &
- "-s, --silent", "Show less, use twice to supress all output", &
- " --version", "Print program version and exit", &
- " --citation", "Print citation information and exit", &
- " --license", "Print license header and exit", &
- "-h, --help", "Show this help message"
-
- write(unit, '(a)')
-
-end subroutine help
-
-subroutine header(unit)
- integer, intent(in) :: unit
-
- write(unit,'(a)') &
- " ____ _____ _____ ____ _ _",&
- " -------------| _ \| ___|_ _|---| _ \| || |------------",&
- " | | | | | |_ | | ___ | | | | || |_ |",&
- " | | |_| | _| | ||___|| |_| |__ _| |",&
- " | |____/|_| |_| |____/ |_| |",&
- " | =================================== |",&
- " | E. Caldeweyher, S. Ehlert & S. Grimme |",&
- " | Mulliken Center for Theoretical Chemistry |",&
- " | University of Bonn |",&
- " ----------------------------------------------------------- ",""
-end subroutine header
-
-
-subroutine version(unit)
- integer, intent(in) :: unit
- character(len=:), allocatable :: version_string
-
- call get_dftd4_version(string=version_string)
- write(unit, '(a, *(1x, a))') &
- & prog_name, "version", version_string
-
-end subroutine version
-
-
-subroutine citation(unit)
- integer, intent(in) :: unit
-
- write(unit, '(a)') &
- "Please include the appropriate citations when using DFTD4 in your work.", &
- "", &
- "Original DFTD4 idea:", &
- "Eike Caldeweyher, Christoph Bannwarth and Stefan Grimme,", &
- "J. Chem. Phys., 2017, 147, 034112.", &
- "DOI: 10.1063/1.4993215", &
- "", &
- "DFTD4 model:", &
- "Eike Caldeweyher, Sebastian Ehlert, Andreas Hansen, Hagen Neugebauer,", &
- "Sebastian Spicher, Christoph Bannwarth and Stefan Grimme,", &
- "J. Chem Phys, 2019, 150, 154122.", &
- "DOI: 10.1063/1.5090222", &
- "ChemRxiv: 10.26434/chemrxiv.7430216.v2", &
- "", &
- "Periodic DFTD4 model:", &
- "Eike Caldeweyher, Jan-Michael Mewes, Sebastian Ehlert", &
- "and Stefan Grimme, Phys. Chem. Chem. Phys., 2020, 22, 8499-8512.", &
- "DOI: 10.1039/D0CP00502A", &
- "ChemRxiv: 10.26434/chemrxiv.10299428.v1", &
- ""
-
-end subroutine citation
-
-
-subroutine license(unit)
- integer, intent(in) :: unit
-
- write(unit, '(a)') &
- "dftd4 is free software: you can redistribute it and/or modify it under", &
- "the terms of the Lesser GNU General Public License as published by", &
- "the Free Software Foundation, either version 3 of the License, or", &
- "(at your option) any later version.", &
- "", &
- "dftd4 is distributed in the hope that it will be useful,", &
- "but WITHOUT ANY WARRANTY; without even the implied warranty of", &
- "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the", &
- "Lesser GNU General Public License for more details.", &
- "", &
- "You should have received a copy of the Lesser GNU General Public License", &
- "along with dftd4. If not, see ."
-end subroutine license
-
-
end module dftd4_cli
diff --git a/app/driver.f90 b/app/driver.f90
index 648d9642d..a483b0831 100644
--- a/app/driver.f90
+++ b/app/driver.f90
@@ -26,7 +26,9 @@ module dftd4_driver
use dftd4_charge, only : get_charges
use dftd4_output
use dftd4_utils
- use dftd4_cli, only : cli_config, run_config, header
+ use dftd4_cli, only : cli_config, param_config, run_config
+ use dftd4_help, only : header
+ use dftd4_param, only : functional_group, get_functionals
implicit none
private
@@ -49,6 +51,8 @@ subroutine main(config, error)
call fatal_error(error, "Unknown runtime selected")
type is(run_config)
call run_main(config, error)
+ type is(param_config)
+ call run_param(config, error)
end select
end subroutine main
@@ -235,6 +239,59 @@ subroutine run_main(config, error)
end subroutine run_main
+subroutine run_param(config, error)
+
+ !> Configuration for this driver
+ type(param_config), intent(in) :: config
+
+ !> Error handling
+ type(error_type), allocatable, intent(out) :: error
+
+ if (config%list) then
+ block
+ type(functional_group), allocatable :: funcs(:)
+ character(len=:), allocatable :: temp_names(:)
+
+ integer :: i, j, nfuncs
+
+ call get_functionals(funcs)
+ nfuncs = size(funcs)
+
+ ! Bubble sort based on the first name in each group of funcs
+ do i = 1, nfuncs - 1
+ do j = 1, nfuncs - i
+ if (funcs(j)%names(1) > funcs(j+1)%names(1)) then
+ ! Swap only the names for simplicity
+ temp_names = funcs(j)%names
+ funcs(j)%names = funcs(j+1)%names
+ funcs(j+1)%names = temp_names
+ end if
+ end do
+ end do
+
+ write(output_unit, '(a)') "List of available functionals:"
+
+ do i = 1, nfuncs
+ associate(names => funcs(i)%names)
+ do j = 1, size(names)
+ if (len_trim(names(j)) > 0) then
+ write(output_unit, '(a)', advance='no') trim(names(j)) // " "
+
+ ! new line if last in list
+ if (size(names) == j) then
+ write(output_unit, *)
+ end if
+ end if
+ end do
+ end associate
+ end do
+
+ end block
+ end if
+
+end subroutine run_param
+
+
!> Construct path by joining strings with os file separator
function join(a1, a2) result(path)
use mctc_env_system, only : is_windows
diff --git a/app/help.f90 b/app/help.f90
new file mode 100644
index 000000000..4609e36f5
--- /dev/null
+++ b/app/help.f90
@@ -0,0 +1,182 @@
+! This file is part of dftd4.
+! SPDX-Identifier: LGPL-3.0-or-later
+!
+! dftd4 is free software: you can redistribute it and/or modify it under
+! the terms of the Lesser GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! dftd4 is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! Lesser GNU General Public License for more details.
+!
+! You should have received a copy of the Lesser GNU General Public License
+! along with dftd4. If not, see .
+
+module dftd4_help
+ use dftd4, only : get_dftd4_version
+ implicit none
+ private
+
+ public :: citation, license, header, prog_name, version
+ public :: help_text, help_text_run, help_text_param
+
+
+ !> The name of the program
+ character(len=*), parameter :: prog_name = "dftd4"
+
+ character(len=*), parameter :: nl = new_line('a')
+
+ character(len=*), parameter :: run_options_text = &
+ "-c,--charge Set charge to molecule, overwrites .CHRG file"//nl//&
+ "-i,--input Hint for the format of the input file"//nl//&
+ "-f,--func Use damping parameters for given functional"//nl//&
+ " --param Specify parameters for rational damping,"//nl//&
+ " expected order is s6, s8, a1, a2 (requires four arguments)"//nl//&
+ " --mbdscale Use scaled ATM three-body dispersion"//nl//&
+ " --zeta Adjust charge scaling parameters, takes two reals,"//nl//&
+ " expected order is ga, gc (default: 3.0, 2.0)"//nl//&
+ " --wfactor Adjust weighting factor for interpolation"//nl//&
+ " (default: 6.0)"//nl//&
+ "-g,--grad [file] Evaluate molecular gradient and virial,"//nl//&
+ " write results to file (default: dftd4.txt),"//nl//&
+ " attempts to add to Turbomole gradient and gradlatt files"//nl//&
+ " --hessian Evaluate molecular hessian"//nl//&
+ " --property Show dispersion related atomic and system properties"//nl//&
+ " --pair-resolved Calculate pairwise representation of dispersion energy"//nl//&
+ " --noedisp Disable writing of dispersion energy to .EDISP file"//nl//&
+ " --json [file] Dump results to JSON output (default: dftd4.json)"//nl//&
+ "-v,--verbose Show more, can be used multiple times"//nl//&
+ "-s,--silent Show less, use twice to supress all output"//nl//&
+ " --version Print program version and exit"//nl//&
+ " --citation Print citation information and exit"//nl//&
+ " --license Print license header and exit"//nl//&
+ "-h,--help Show this help message"
+
+ character(len=*), parameter :: help_text_run = &
+ "Usage: "//prog_name//" [run] [options] "//nl//&
+ ""//nl//&
+ "Takes an geometry input to calculate the D4 dispersion correction."//nl//&
+ "Periodic calculations are performed automatically for periodic input formats."//nl//&
+ "Reads .CHRG file (if present) from the same directory as the input."//nl//&
+ "Specify the functional to select the correct parameters."//nl//&
+ ""//nl//&
+ run_options_text//nl//&
+ ""
+
+ character(len=*), parameter :: param_options_text = &
+ "-l,--list,--funcs List all supported functionals"
+
+ character(len=*), parameter :: help_text_param = &
+ "Usage: "//prog_name//" param [options]"//nl//&
+ ""//nl//&
+ "Inspect damping parameters and supported functionals"//nl//&
+ ""//nl//&
+ param_options_text//nl//&
+ ""
+
+ character(len=*), parameter :: help_text = &
+ "Usage: "//prog_name//" [run|param] [options] ..."//nl//&
+ ""//nl//&
+ !
+ "Generally Applicable Atomic-Charge Dependent London Dispersion Correction."//nl//&
+ "Takes an geometry input to calculate the D4 dispersion correction."//nl//&
+ "Periodic calculations are performed automatically for periodic input formats."//nl//&
+ "Reads .CHRG file (if present) from the same directory as the input."//nl//&
+ "Specify the functional to select the correct parameters."//nl//&
+ ""//nl//&
+ !
+ "Commands"//nl//&
+ ""//nl//&
+ " run Evaluate dispersion correction on the provided input structure."//nl//&
+ " Periodic calculations are performed automatically for periodic inputs"//nl//&
+ " If no command is specified run is selected by default."//nl//&
+ ""//nl//&
+ " param Inspect damping parameters."//nl//&
+ ""//nl//&
+ !
+ "Options"//nl//&
+ ""//nl//&
+ run_options_text//nl//&
+ ""
+
+contains
+
+
+subroutine header(unit)
+ integer, intent(in) :: unit
+
+ write(unit,'(a)') &
+ " ____ _____ _____ ____ _ _",&
+ " -------------| _ \| ___|_ _|---| _ \| || |------------",&
+ " | | | | | |_ | | ___ | | | | || |_ |",&
+ " | | |_| | _| | ||___|| |_| |__ _| |",&
+ " | |____/|_| |_| |____/ |_| |",&
+ " | =================================== |",&
+ " | E. Caldeweyher, S. Ehlert & S. Grimme |",&
+ " | Mulliken Center for Theoretical Chemistry |",&
+ " | University of Bonn |",&
+ " ----------------------------------------------------------- ",""
+end subroutine header
+
+
+subroutine version(unit)
+ integer, intent(in) :: unit
+ character(len=:), allocatable :: version_string
+
+ call get_dftd4_version(string=version_string)
+ write(unit, '(a, *(1x, a))') &
+ & prog_name, "version", version_string
+
+end subroutine version
+
+
+subroutine citation(unit)
+ integer, intent(in) :: unit
+
+ write(unit, '(a)') &
+ "Please include the appropriate citations when using DFTD4 in your work.", &
+ "", &
+ "Original DFTD4 idea:", &
+ "Eike Caldeweyher, Christoph Bannwarth and Stefan Grimme,", &
+ "J. Chem. Phys., 2017, 147, 034112.", &
+ "DOI: 10.1063/1.4993215", &
+ "", &
+ "DFTD4 model:", &
+ "Eike Caldeweyher, Sebastian Ehlert, Andreas Hansen, Hagen Neugebauer,", &
+ "Sebastian Spicher, Christoph Bannwarth and Stefan Grimme,", &
+ "J. Chem Phys, 2019, 150, 154122.", &
+ "DOI: 10.1063/1.5090222", &
+ "ChemRxiv: 10.26434/chemrxiv.7430216.v2", &
+ "", &
+ "Periodic DFTD4 model:", &
+ "Eike Caldeweyher, Jan-Michael Mewes, Sebastian Ehlert", &
+ "and Stefan Grimme, Phys. Chem. Chem. Phys., 2020, 22, 8499-8512.", &
+ "DOI: 10.1039/D0CP00502A", &
+ "ChemRxiv: 10.26434/chemrxiv.10299428.v1", &
+ ""
+
+end subroutine citation
+
+
+subroutine license(unit)
+ integer, intent(in) :: unit
+
+ write(unit, '(a)') &
+ "dftd4 is free software: you can redistribute it and/or modify it under", &
+ "the terms of the Lesser GNU General Public License as published by", &
+ "the Free Software Foundation, either version 3 of the License, or", &
+ "(at your option) any later version.", &
+ "", &
+ "dftd4 is distributed in the hope that it will be useful,", &
+ "but WITHOUT ANY WARRANTY; without even the implied warranty of", &
+ "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the", &
+ "Lesser GNU General Public License for more details.", &
+ "", &
+ "You should have received a copy of the Lesser GNU General Public License", &
+ "along with dftd4. If not, see ."
+end subroutine license
+
+
+end module dftd4_help
diff --git a/app/meson.build b/app/meson.build
index 2fc9003ba..eccb5e94e 100644
--- a/app/meson.build
+++ b/app/meson.build
@@ -18,8 +18,10 @@ dftd4_exe = executable(
meson.project_name(),
sources: files(
'main.f90',
+ 'argument.f90',
'cli.f90',
'driver.f90',
+ 'help.f90',
),
dependencies: dftd4_dep,
install: install,
@@ -28,6 +30,9 @@ dftd4_exe = executable(
test('app-version', dftd4_exe, args: '--version')
test('app-help', dftd4_exe, args: '--help')
+test('app-help-run', dftd4_exe, args: ['run', '--help'])
+test('app-help-param', dftd4_exe, args: ['param', '--help'])
+test('app-param-list', dftd4_exe, args: ['param', '--list'])
test('app-license', dftd4_exe, args: '--license')
test('app-citation', dftd4_exe, args: '--citation')
test('app-noargs', dftd4_exe, should_fail: true)
diff --git a/man/dftd4.1.adoc b/man/dftd4.1.adoc
index 8cd2ba98f..ca002b4a8 100644
--- a/man/dftd4.1.adoc
+++ b/man/dftd4.1.adoc
@@ -5,7 +5,7 @@
dftd4 - Generally Applicable Atomic-Charge Dependent London Dispersion Correction.
== Synopsis
-*dftd4* [_options_] _input_
+*dftd4* [run|param] [_options_] _input_
== Description
@@ -16,7 +16,18 @@ Reads .CHRG file (if present) from the same directory as the input.
Specify the functional to select the correct parameters.
-== Options
+== Commands
+
+*run*::
+ Evaluate dispersion correction on the provided input structure.
+ Periodic calculations are performed automatically for periodic inputs
+ If no command is specified run is selected by default.
+
+*param*::
+ Inspect damping parameters.
+
+
+== Options: run
*-c, --charge* _integer_::
Set charge to molecule,
@@ -73,3 +84,9 @@ Specify the functional to select the correct parameters.
*-h, --help*::
Show this message
+
+
+== Options: param
+
+*--list-func*::
+ List all available functionals (keywords for *-f, --func*)
diff --git a/src/dftd4/param.f90 b/src/dftd4/param.f90
index d1a99e38f..a2159da44 100644
--- a/src/dftd4/param.f90
+++ b/src/dftd4/param.f90
@@ -21,7 +21,7 @@ module dftd4_param
implicit none
private
- public :: get_rational_damping
+ public :: get_rational_damping, get_functionals, functional_group
enum, bind(C)
@@ -32,31 +32,170 @@ module dftd4_param
& p_scan, p_rscan, p_r2scan, p_b1lyp, p_b3lyp, p_bhlyp, p_b1p, &
& p_b3p, p_b1pw, p_b3pw, p_o3lyp, p_revpbe0, p_revpbe38, &
& p_pbe0, p_pwp1, p_pw1pw, p_mpw1pw, p_mpw1lyp, p_pw6b95, &
- & p_tpssh, p_tpss0, p_x3lyp, p_m06l, p_m06, p_m062x, p_b97d, &
+ & p_tpssh, p_tpss0, p_x3lyp, p_m06l, p_m06, p_b97d, &
& p_wb97, p_wb97x, p_b97m, p_wb97m, p_camb3lyp, p_lcblyp, &
& p_lh07tsvwn, p_lh07ssvwn, p_lh12ctssirpw92, p_lh12ctssifpw92, &
- & p_lh14tcalpbe, p_lh20t, &
- & p_b2plyp, p_b2gpplyp, p_mpw2plyp, p_pwpb95, &
+ & p_lh14tcalpbe, p_lh20t, p_b2plyp, p_b2gpplyp, p_mpw2plyp, p_pwpb95, &
& p_dsdblyp, p_dsdpbe, p_dsdpbeb95, p_dsdpbep86, p_dsdsvwn, &
& p_dodblyp, p_dodpbe, p_dodpbeb95, p_dodpbep86, p_dodsvwn, &
- & p_pbe0_2, p_pbe0_dh, p_hf3c, p_hf3cv, p_pbeh3c, p_b973c, &
- & p_hsesol, p_pwgga, p_dftb_3ob, p_dftb_mio, p_dftb_ob2, &
- & p_dftb_matsci, p_dftb_pbc, p_hcth120, p_ptpss, p_lcwpbe, &
- & p_bmk, p_b1b95, p_pwb6k, p_otpss, p_ssb, p_revssb, &
- & p_pbesol, p_hse06, p_pbexalpha, p_pbehpbe, p_hcth407, &
- & p_n12, p_pkzb, p_thcth, p_m11l, p_mn15l, p_mpwb1k, &
- & p_mpw1kcis, p_mpwkcis1k, p_pbeh1pbe, p_pbe1kcis, p_b97_1, &
- & p_b97_2, p_b98, p_hiss, p_hse03, p_revtpssh, p_tpss1kcis, &
- & p_m05, p_m052x, p_m08hx, p_lcwhpbe, p_mn12l, p_tauhcthhyb, &
- & p_sogga11x, p_n12sx, p_mn12sx, p_mn15, p_glyp, p_bop, &
- & p_mpw1b95, p_revpbe0dh, p_revtpss0, p_revdsdpbep86, p_revdsdpbe, &
+ & p_pbe0_2, p_pbe0_dh, p_hsesol, p_dftb_3ob, p_dftb_mio, p_dftb_ob2, &
+ & p_dftb_matsci, p_dftb_pbc, p_b1b95, p_pbesol, p_hse06, p_mpwb1k, &
+ & p_hse03, p_revtpssh, p_mn12sx, p_glyp, p_mpw1b95, &
+ & p_revpbe0dh, p_revtpss0, p_revdsdpbep86, p_revdsdpbe, &
& p_revdsdblyp, p_revdodpbep86, p_am05, p_hse12, p_hse12s, &
- & p_r2scanh, p_r2scan0, p_r2scan50
+ & p_r2scanh, p_r2scan0, p_r2scan50, p_last
end enum
integer, parameter :: df_enum = kind(p_invalid)
+
+ ! Group different spellings/names of functionals
+ type functional_group
+ character(len=:), allocatable :: names(:)
+ end type functional_group
+
contains
+
+!> Create a new group of functional names
+function new_funcgroup(input_names) result(group)
+
+ !> List of spellings/names of the functional
+ character(len=*), intent(in) :: input_names(:)
+
+ !> Functional with possibly different spellings
+ type(functional_group) :: group
+
+ integer :: n, i, max_len
+ n = size(input_names)
+
+ ! Determine the length of the longest name
+ max_len = 0
+ do i = 1, n
+ max_len = max(max_len, len_trim(input_names(i)))
+ end do
+
+ ! Allocate based on the longest name's length
+ allocate(character(len=max_len) :: group%names(n))
+ do i = 1, n
+ group%names(i) = trim(input_names(i))
+ end do
+end function new_funcgroup
+
+
+!> Collect all supported functionals
+subroutine get_functionals(funcs)
+ !DEC$ ATTRIBUTES DLLEXPORT :: get_functionals
+
+ !> Collection of functionals with possibly different spellings/names
+ type(functional_group), allocatable, intent(out) :: funcs(:)
+
+ allocate(funcs(p_last - 1))
+
+ funcs(p_hf) = new_funcgroup([character(len=20) :: 'hf'])
+ funcs(p_blyp) = new_funcgroup([character(len=20) :: 'b-lyp', 'blyp'])
+ funcs(p_bpbe) = new_funcgroup([character(len=20) :: 'bpbe'])
+ funcs(p_bp) = new_funcgroup([character(len=20) :: 'b-p', 'bp86', 'bp', 'b-p86'])
+ funcs(p_bpw) = new_funcgroup([character(len=20) :: 'bpw', 'b-pw'])
+ funcs(p_lb94) = new_funcgroup([character(len=20) :: 'lb94'])
+ funcs(p_mpwlyp) = new_funcgroup([character(len=20) :: 'mpwlyp', 'mpw-lyp'])
+ funcs(p_mpwpw) = new_funcgroup([character(len=20) :: 'mpwpw', 'mpw-pw', 'mpwpw91'])
+ funcs(p_olyp) = new_funcgroup([character(len=20) :: 'o-lyp', 'olyp'])
+ funcs(p_opbe) = new_funcgroup([character(len=20) :: 'opbe'])
+ funcs(p_pbe) = new_funcgroup([character(len=20) :: 'pbe'])
+ funcs(p_rpbe) = new_funcgroup([character(len=20) :: 'rpbe'])
+ funcs(p_revpbe) = new_funcgroup([character(len=20) :: 'revpbe'])
+ funcs(p_pw86pbe) = new_funcgroup([character(len=20) :: 'pw86pbe'])
+ funcs(p_rpw86pbe) = new_funcgroup([character(len=20) :: 'rpw86pbe'])
+ funcs(p_pw91) = new_funcgroup([character(len=20) :: 'pw91'])
+ funcs(p_pwp) = new_funcgroup([character(len=20) :: 'pwp', 'pw-p', 'pw91p86'])
+ funcs(p_xlyp) = new_funcgroup([character(len=20) :: 'x-lyp', 'xlyp'])
+ funcs(p_b97) = new_funcgroup([character(len=20) :: 'b97'])
+ funcs(p_tpss) = new_funcgroup([character(len=20) :: 'tpss'])
+ funcs(p_revtpss) = new_funcgroup([character(len=20) :: 'revtpss'])
+ funcs(p_scan) = new_funcgroup([character(len=20) :: 'scan'])
+ funcs(p_rscan) = new_funcgroup([character(len=20) :: 'rscan'])
+ funcs(p_r2scan) = new_funcgroup([character(len=20) :: 'r2scan', 'r²scan'])
+ funcs(p_r2scanh) = new_funcgroup([character(len=20) :: 'r2scanh', 'r²scanh'])
+ funcs(p_r2scan0) = new_funcgroup([character(len=20) :: 'r2scan0', 'r²scan0'])
+ funcs(p_r2scan50) = new_funcgroup([character(len=20) :: 'r2scan50', 'r²scan50'])
+ funcs(p_b1lyp) = new_funcgroup([character(len=20) :: 'b1lyp', 'b1-lyp'])
+ funcs(p_b3lyp) = new_funcgroup([character(len=20) :: 'b3-lyp', 'b3lyp'])
+ funcs(p_bhlyp) = new_funcgroup([character(len=20) :: 'bh-lyp', 'bhlyp'])
+ funcs(p_b1p) = new_funcgroup([character(len=20) :: 'b1p', 'b1-p', 'b1p86'])
+ funcs(p_b3p) = new_funcgroup([character(len=20) :: 'b3p', 'b3-p', 'b3p86'])
+ funcs(p_b1pw) = new_funcgroup([character(len=20) :: 'b1pw', 'b1-pw', 'b1pw91'])
+ funcs(p_b3pw) = new_funcgroup([character(len=20) :: 'b3pw', 'b3-pw', 'b3pw91'])
+ funcs(p_o3lyp) = new_funcgroup([character(len=20) :: 'o3-lyp', 'o3lyp'])
+ funcs(p_revpbe0) = new_funcgroup([character(len=20) :: 'revpbe0'])
+ funcs(p_revpbe38) = new_funcgroup([character(len=20) :: 'revpbe38'])
+ funcs(p_pbe0) = new_funcgroup([character(len=20) :: 'pbe0'])
+ funcs(p_pwp1) = new_funcgroup([character(len=20) :: 'pwp1'])
+ funcs(p_pw1pw) = new_funcgroup([character(len=20) :: 'pw1pw', 'pw1-pw'])
+ funcs(p_mpw1pw) = new_funcgroup([character(len=20) :: 'mpw1pw', 'mpw1-pw', 'mpw1pw91'])
+ funcs(p_mpw1lyp) = new_funcgroup([character(len=20) :: 'mpw1lyp', 'mpw1-lyp'])
+ funcs(p_pw6b95) = new_funcgroup([character(len=20) :: 'pw6b95'])
+ funcs(p_tpssh) = new_funcgroup([character(len=20) :: 'tpssh'])
+ funcs(p_tpss0) = new_funcgroup([character(len=20) :: 'tpss0'])
+ funcs(p_x3lyp) = new_funcgroup([character(len=20) :: 'x3-lyp', 'x3lyp'])
+ funcs(p_m06l) = new_funcgroup([character(len=20) :: 'm06l'])
+ funcs(p_m06) = new_funcgroup([character(len=20) :: 'm06'])
+ funcs(p_b97d) = new_funcgroup([character(len=20) :: 'b97d'])
+ funcs(p_wb97) = new_funcgroup([character(len=20) :: 'wb97', 'ωb97', 'omegab97'])
+ funcs(p_wb97x) = new_funcgroup([character(len=20) :: 'wb97x', 'ωb97x', 'omegab97x'])
+ funcs(p_camb3lyp) = new_funcgroup([character(len=20) :: 'cam-b3lyp'])
+ funcs(p_lcblyp) = new_funcgroup([character(len=20) :: 'lc-blyp'])
+ funcs(p_lh07tsvwn) = new_funcgroup([character(len=20) :: 'lh07tsvwn', 'lh07t-svwn'])
+ funcs(p_lh07ssvwn) = new_funcgroup([character(len=20) :: 'lh07ssvwn', 'lh07s-svwn'])
+ funcs(p_lh12ctssirpw92) = new_funcgroup([character(len=20) :: 'lh12ctssirpw92', 'lh12ct-ssirpw92'])
+ funcs(p_lh12ctssifpw92) = new_funcgroup([character(len=20) :: 'lh12ctssifpw92', 'lh12ct-ssifpw92'])
+ funcs(p_lh14tcalpbe) = new_funcgroup([character(len=20) :: 'lh14tcalpbe', 'lh14t-calpbe'])
+ funcs(p_lh20t) = new_funcgroup([character(len=20) :: 'lh20t'])
+ funcs(p_b2plyp) = new_funcgroup([character(len=20) :: 'b2plyp', 'b2-plyp'])
+ funcs(p_b2gpplyp) = new_funcgroup([character(len=20) :: 'b2gpplyp', 'b2gp-plyp'])
+ funcs(p_mpw2plyp) = new_funcgroup([character(len=20) :: 'mpw2plyp'])
+ funcs(p_pwpb95) = new_funcgroup([character(len=20) :: 'pwpb95'])
+ funcs(p_dsdblyp) = new_funcgroup([character(len=20) :: 'dsdblyp', 'dsd-blyp'])
+ funcs(p_dsdpbe) = new_funcgroup([character(len=20) :: 'dsdpbe', 'dsd-pbe'])
+ funcs(p_dsdpbeb95) = new_funcgroup([character(len=20) :: 'dsdpbeb95', 'dsd-pbeb95'])
+ funcs(p_dsdpbep86) = new_funcgroup([character(len=20) :: 'dsdpbep86', 'dsd-pbep86'])
+ funcs(p_dsdsvwn) = new_funcgroup([character(len=20) :: 'dsdsvwn', 'dsd-svwn'])
+ funcs(p_dodblyp) = new_funcgroup([character(len=20) :: 'dodblyp', 'dod-blyp'])
+ funcs(p_dodpbe) = new_funcgroup([character(len=20) :: 'dodpbe', 'dod-pbe'])
+ funcs(p_dodpbeb95) = new_funcgroup([character(len=20) :: 'dodpbeb95', 'dod-pbeb95'])
+ funcs(p_dodpbep86) = new_funcgroup([character(len=20) :: 'dodpbep86', 'dod-pbep86'])
+ funcs(p_dodsvwn) = new_funcgroup([character(len=20) :: 'dodsvwn', 'dod-svwn'])
+ funcs(p_pbe0_2) = new_funcgroup([character(len=20) :: 'pbe02', 'pbe0-2'])
+ funcs(p_pbe0_dh) = new_funcgroup([character(len=20) :: 'pbe0dh', 'pbe0-dh'])
+ funcs(p_dftb_3ob) = new_funcgroup([character(len=20) :: 'dftb3', 'dftb(3ob)'])
+ funcs(p_dftb_mio) = new_funcgroup([character(len=20) :: 'dftb(mio)'])
+ funcs(p_dftb_pbc) = new_funcgroup([character(len=20) :: 'dftb(pbc)'])
+ funcs(p_dftb_matsci) = new_funcgroup([character(len=20) :: 'dftb(matsci)'])
+ funcs(p_dftb_ob2) = new_funcgroup([character(len=20) :: 'lc-dftb', 'dftb(ob2)'])
+ funcs(p_b1b95) = new_funcgroup([character(len=20) :: 'b1b95'])
+ funcs(p_pbesol) = new_funcgroup([character(len=20) :: 'pbesol'])
+ funcs(p_mpwb1k) = new_funcgroup([character(len=20) :: 'mpwb1k'])
+ funcs(p_mpw1b95) = new_funcgroup([character(len=20) :: 'mpw1b95'])
+ funcs(p_hse03) = new_funcgroup([character(len=20) :: 'hse03'])
+ funcs(p_hse06) = new_funcgroup([character(len=20) :: 'hse06'])
+ funcs(p_hse12) = new_funcgroup([character(len=20) :: 'hse12'])
+ funcs(p_hse12s) = new_funcgroup([character(len=20) :: 'hse12s'])
+ funcs(p_hsesol) = new_funcgroup([character(len=20) :: 'hsesol'])
+ funcs(p_revtpssh) = new_funcgroup([character(len=20) :: 'revtpssh'])
+ funcs(p_mn12sx) = new_funcgroup([character(len=20) :: 'mn12sx'])
+ funcs(p_glyp) = new_funcgroup([character(len=20) :: 'glyp', 'g-lyp'])
+ funcs(p_revpbe0dh) = new_funcgroup([character(len=20) :: 'revpbe0dh', 'revpbe0-dh'])
+ funcs(p_revtpss0) = new_funcgroup([character(len=20) :: 'revtpss0'])
+ funcs(p_revdsdpbep86) = new_funcgroup([character(len=20) :: 'revdsd-pbep86', 'revdsdpbep86'])
+ funcs(p_revdsdpbe) = new_funcgroup([character(len=20) :: 'revdsd-pbe', 'revdsd-pbepbe', 'revdsdpbe', 'revdsdpbepbe'])
+ funcs(p_revdsdblyp) = new_funcgroup([character(len=20) :: 'revdsd-blyp', 'revdsdblyp'])
+ funcs(p_revdodpbep86) = new_funcgroup([character(len=20) :: 'revdod-pbep86', 'revdodpbep86'])
+ funcs(p_b97m) = new_funcgroup([character(len=20) :: 'b97m'])
+ funcs(p_wb97m) = new_funcgroup([character(len=20) :: 'wb97m', 'ωb97m', 'omegab97m'])
+ funcs(p_am05) = new_funcgroup([character(len=20) :: 'am05'])
+
+end subroutine get_functionals
+
+
subroutine get_rational_damping(functional, param, s9)
!DEC$ ATTRIBUTES DLLEXPORT :: get_rational_damping
character(len=*), intent(in) :: functional
@@ -114,10 +253,10 @@ subroutine get_d4eeq_bj_parameter(dfnum, param, s9)
contains
- pure function dftd_param(s6, s8, a1, a2, alp) result(param)
+ pure function dftd_param(s6, s8, a1, a2, alp) result(par)
real(wp), intent(in) :: s8, a1, a2
real(wp), intent(in), optional :: s6, alp
- type(rational_damping_param) :: param
+ type(rational_damping_param) :: par
real(wp) :: s6_, alp_, s9_
s6_ = 1.0_wp
@@ -127,7 +266,7 @@ pure function dftd_param(s6, s8, a1, a2, alp) result(param)
alp_ = 16.0_wp
if (present(alp)) alp_ = alp
- param = rational_damping_param(&
+ par = rational_damping_param(&
& s6=s6_, &
& s8=s8, a1=a1, a2=a2, &
& s9=s9_, &
@@ -530,10 +669,10 @@ subroutine get_d4eeq_bjatm_parameter(dfnum, param, s9)
contains
- pure function dftd_param(s6, s8, a1, a2, alp) result(param)
+ pure function dftd_param(s6, s8, a1, a2, alp) result(par)
real(wp), intent(in) :: s8, a1, a2
real(wp), intent(in), optional :: s6, alp
- type(rational_damping_param) :: param
+ type(rational_damping_param) :: par
real(wp) :: s6_, alp_, s9_
s6_ = 1.0_wp
@@ -543,7 +682,7 @@ pure function dftd_param(s6, s8, a1, a2, alp) result(param)
alp_ = 16.0_wp
if (present(alp)) alp_ = alp
- param = rational_damping_param(&
+ par = rational_damping_param(&
& s6=s6_, &
& s8=s8, a1=a1, a2=a2, &
& s9=s9_, &
@@ -598,6 +737,8 @@ pure function get_functional_id(df) result(num)
num = p_xlyp
case('b97')
num = p_b97
+ case('b97d')
+ num = p_b97d
case('tpss')
num = p_tpss
case('revtpss')
@@ -656,8 +797,6 @@ pure function get_functional_id(df) result(num)
num = p_m06l
case('m06')
num = p_m06
- case('m06-2x', 'm062x')
- num = p_m062x
case('wb97', 'ωb97', 'omegab97')
num = p_wb97
case('wb97x', 'ωb97x', 'omegab97x')
@@ -710,16 +849,6 @@ pure function get_functional_id(df) result(num)
num = p_pbe0_2
case('pbe0dh', 'pbe0-dh')
num = p_pbe0_dh
- case('hf-3c', 'hf3c')
- num = p_hf3c
- case('hf-3cv', 'hf3cv')
- num = p_hf3cv
- case('pbeh3c', 'pbeh-3c')
- num = p_pbeh3c
- case('b973c', 'b97-3c')
- num = p_b973c
- case('pwgga')
- num = p_pwgga
case('dftb3', 'dftb(3ob)')
num = p_dftb_3ob
case('dftb(mio)')
@@ -730,60 +859,12 @@ pure function get_functional_id(df) result(num)
num = p_dftb_matsci
case('lc-dftb', 'dftb(ob2)')
num = p_dftb_ob2
- case('hcth120')
- num = p_hcth120
- case('ptpss')
- num = p_ptpss
- case('lc-wpbe', 'lcwpbe')
- num = p_lcwpbe
- case('bmk')
- num = p_bmk
case('b1b95')
num = p_b1b95
- case('bwb6k')
- num = p_pwb6k
- case('otpss')
- num = p_otpss
- case('ssb')
- num = p_ssb
- case('revssb')
- num = p_revssb
case('pbesol')
num = p_pbesol
- case('pbexalpha')
- num = p_pbexalpha
- case('pbehpbe')
- num = p_pbehpbe
- case('hcth407')
- num = p_hcth407
- case('n12')
- num = p_n12
- case('pkzb')
- num = p_pkzb
- case('thcth', 'tauhctc')
- num = p_thcth
- case('m11l')
- num = p_m11l
- case('mn15l')
- num = p_mn15l
case('mpwb1k')
num = p_mpwb1k
- case('mpw1kcis')
- num = p_mpw1kcis
- case('mpwkcis1k')
- num = p_mpwkcis1k
- case('pbeh1pbe')
- num = p_pbeh1pbe
- case('pbe1kcis')
- num = p_pbe1kcis
- case('b97-1')
- num = p_b97_1
- case('b97-2')
- num = p_b97_2
- case('b98')
- num = p_b98
- case('hiss')
- num = p_hiss
case('hse03')
num = p_hse03
case('hse06')
@@ -796,30 +877,12 @@ pure function get_functional_id(df) result(num)
num = p_hsesol
case('revtpssh')
num = p_revtpssh
- case('tpss1kcis')
- num = p_tpss1kcis
- case('m05')
- num = p_m05
- case('m052x', 'm05-2x')
- num = p_m052x
- case('m08hx', 'm08-hx')
- num = p_m08hx
- case('lcwhpbe', 'lc-whpbe')
- num = p_lcwhpbe
- case('mn12l')
- num = p_mn12l
- case('tauhcthhyb')
- num = p_tauhcthhyb
- case('sogga11x')
- num = p_sogga11x
- case('n12sx')
- num = p_n12sx
case('mn12sx')
num = p_mn12sx
- case('mn15')
- num = p_mn15
case('glyp', 'g-lyp')
num = p_glyp
+ case('mpw1b95')
+ num = p_mpw1b95
case('revpbe0dh', 'revpbe0-dh')
num = p_revpbe0dh
case('revtpss0')