LCOV - code coverage report
Current view: top level - src - qs_dispersion_pairpot.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:9dda3dd) Lines: 85.8 % 261 224
Test Date: 2026-06-13 06:49:54 Functions: 100.0 % 2 2

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2026 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief Calculation of dispersion using pair potentials
      10              : !> \author JGH
      11              : ! **************************************************************************************************
      12              : MODULE qs_dispersion_pairpot
      13              : 
      14              :    USE atomic_kind_types,               ONLY: atomic_kind_type,&
      15              :                                               get_atomic_kind,&
      16              :                                               get_atomic_kind_set
      17              :    USE atprop_types,                    ONLY: atprop_array_init,&
      18              :                                               atprop_type
      19              :    USE bibliography,                    ONLY: &
      20              :         Caldeweyher2017, Caldeweyher2019, Caldeweyher2020, Goerigk2017, Wittmann2024, &
      21              :         cite_reference, grimme2006, grimme2010, grimme2011
      22              :    USE cell_types,                      ONLY: cell_type
      23              :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      24              :                                               cp_logger_get_default_io_unit,&
      25              :                                               cp_logger_type
      26              :    USE cp_output_handling,              ONLY: cp_print_key_finished_output,&
      27              :                                               cp_print_key_unit_nr
      28              :    USE cp_parser_methods,               ONLY: parser_get_next_line,&
      29              :                                               parser_get_object
      30              :    USE cp_parser_types,                 ONLY: cp_parser_type,&
      31              :                                               parser_create,&
      32              :                                               parser_release
      33              :    USE eeq_input,                       ONLY: read_eeq_param
      34              :    USE input_constants,                 ONLY: vdw_pairpot_dftd2,&
      35              :                                               vdw_pairpot_dftd3,&
      36              :                                               vdw_pairpot_dftd3bj,&
      37              :                                               vdw_pairpot_dftd4,&
      38              :                                               xc_vdw_fun_pairpot
      39              :    USE input_section_types,             ONLY: section_vals_get_subs_vals,&
      40              :                                               section_vals_type,&
      41              :                                               section_vals_val_get
      42              :    USE kinds,                           ONLY: default_path_length,&
      43              :                                               default_string_length,&
      44              :                                               dp
      45              :    USE message_passing,                 ONLY: mp_para_env_type
      46              :    USE physcon,                         ONLY: bohr,&
      47              :                                               kcalmol,&
      48              :                                               kjmol
      49              :    USE qs_dispersion_cnum,              ONLY: get_cn_radius,&
      50              :                                               setcn,&
      51              :                                               seten,&
      52              :                                               setr0ab,&
      53              :                                               setrcov
      54              :    USE qs_dispersion_d2,                ONLY: calculate_dispersion_d2_pairpot,&
      55              :                                               dftd2_param
      56              :    USE qs_dispersion_d3,                ONLY: calculate_dispersion_d3_pairpot,&
      57              :                                               dftd3_c6_param
      58              :    USE qs_dispersion_d4,                ONLY: calculate_dispersion_d4_pairpot
      59              :    USE qs_dispersion_s_dftd3,           ONLY: dftd3_param_from_library
      60              :    USE qs_dispersion_types,             ONLY: dftd2_pp,&
      61              :                                               dftd3_pp,&
      62              :                                               dftd4_pp,&
      63              :                                               qs_atom_dispersion_type,&
      64              :                                               qs_dispersion_type
      65              :    USE qs_environment_types,            ONLY: get_qs_env,&
      66              :                                               qs_environment_type
      67              :    USE qs_force_types,                  ONLY: qs_force_type
      68              :    USE qs_kind_types,                   ONLY: get_qs_kind,&
      69              :                                               qs_kind_type,&
      70              :                                               set_qs_kind
      71              :    USE virial_types,                    ONLY: virial_type
      72              : #include "./base/base_uses.f90"
      73              : 
      74              :    IMPLICIT NONE
      75              : 
      76              :    PRIVATE
      77              : 
      78              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_dispersion_pairpot'
      79              : 
      80              :    PUBLIC :: qs_dispersion_pairpot_init, calculate_dispersion_pairpot
      81              : 
      82              : ! **************************************************************************************************
      83              : 
      84              : CONTAINS
      85              : 
      86              : ! **************************************************************************************************
      87              : !> \brief ...
      88              : !> \param atomic_kind_set ...
      89              : !> \param qs_kind_set ...
      90              : !> \param dispersion_env ...
      91              : !> \param pp_section ...
      92              : !> \param para_env ...
      93              : ! **************************************************************************************************
      94         1236 :    SUBROUTINE qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_env, pp_section, para_env)
      95              :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      96              :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      97              :       TYPE(qs_dispersion_type), POINTER                  :: dispersion_env
      98              :       TYPE(section_vals_type), OPTIONAL, POINTER         :: pp_section
      99              :       TYPE(mp_para_env_type), POINTER                    :: para_env
     100              : 
     101              :       CHARACTER(len=*), PARAMETER :: routineN = 'qs_dispersion_pairpot_init'
     102              : 
     103              :       CHARACTER(LEN=2)                                   :: symbol
     104              :       CHARACTER(LEN=default_path_length)                 :: filename
     105              :       CHARACTER(LEN=default_string_length)               :: aname, error_msg
     106              :       CHARACTER(LEN=default_string_length), &
     107         1236 :          DIMENSION(:), POINTER                           :: tmpstringlist
     108              :       INTEGER                                            :: elem, handle, i, ikind, j, max_elem, &
     109              :                                                             maxc, n_rep, nkind, nl, vdw_pp_type, &
     110              :                                                             vdw_type
     111         1236 :       INTEGER, DIMENSION(:), POINTER                     :: exlist
     112              :       LOGICAL                                            :: at_end, explicit, found, is_available
     113              :       REAL(KIND=dp)                                      :: dum
     114              :       TYPE(qs_atom_dispersion_type), POINTER             :: disp
     115              :       TYPE(section_vals_type), POINTER                   :: eeq_section
     116              : 
     117         1236 :       CALL timeset(routineN, handle)
     118              : 
     119         1236 :       nkind = SIZE(atomic_kind_set)
     120              : 
     121         1236 :       vdw_type = dispersion_env%type
     122         1236 :       SELECT CASE (vdw_type)
     123              :       CASE DEFAULT
     124              :          ! do nothing
     125              :       CASE (xc_vdw_fun_pairpot)
     126              :          ! setup information on pair potentials
     127         1236 :          vdw_pp_type = dispersion_env%type
     128         1236 :          SELECT CASE (dispersion_env%pp_type)
     129              :          CASE DEFAULT
     130              :             ! do nothing
     131              :          CASE (vdw_pairpot_dftd2)
     132           36 :             CALL cite_reference(Grimme2006)
     133          102 :             DO ikind = 1, nkind
     134           66 :                CALL get_atomic_kind(atomic_kind_set(ikind), element_symbol=symbol, z=elem)
     135           66 :                ALLOCATE (disp)
     136           66 :                disp%type = dftd2_pp
     137              :                ! get filename of parameter file
     138           66 :                filename = dispersion_env%parameter_file_name
     139              :                ! check for local parameters
     140           66 :                found = .FALSE.
     141           66 :                IF (PRESENT(pp_section)) THEN
     142           60 :                   CALL section_vals_val_get(pp_section, "ATOMPARM", n_rep_val=n_rep)
     143           60 :                   DO i = 1, n_rep
     144              :                      CALL section_vals_val_get(pp_section, "ATOMPARM", i_rep_val=i, &
     145            0 :                                                c_vals=tmpstringlist)
     146           60 :                      IF (TRIM(tmpstringlist(1)) == TRIM(symbol)) THEN
     147              :                         ! we assume the parameters are in atomic units!
     148            0 :                         READ (tmpstringlist(2), *) disp%c6
     149            0 :                         READ (tmpstringlist(3), *) disp%vdw_radii
     150            0 :                         found = .TRUE.
     151            0 :                         EXIT
     152              :                      END IF
     153              :                   END DO
     154              :                END IF
     155           66 :                IF (.NOT. found) THEN
     156              :                   ! check for internal parameters
     157           66 :                   CALL dftd2_param(elem, disp%c6, disp%vdw_radii, found)
     158              :                END IF
     159           66 :                IF (.NOT. found) THEN
     160              :                   ! check on file
     161            0 :                   INQUIRE (FILE=filename, EXIST=is_available)
     162            0 :                   IF (is_available) THEN
     163            0 :                      BLOCK
     164              :                         TYPE(cp_parser_type) :: parser
     165            0 :                         CALL parser_create(parser, filename, para_env=para_env)
     166              :                         DO
     167              :                            at_end = .FALSE.
     168            0 :                            CALL parser_get_next_line(parser, 1, at_end)
     169            0 :                            IF (at_end) EXIT
     170            0 :                            CALL parser_get_object(parser, aname)
     171            0 :                            IF (TRIM(aname) == TRIM(symbol)) THEN
     172            0 :                               CALL parser_get_object(parser, disp%c6)
     173              :                               ! we have to change the units J*nm^6*mol^-1 -> Hartree*Bohr^6
     174            0 :                               disp%c6 = disp%c6*1000._dp*bohr**6/kjmol
     175            0 :                               CALL parser_get_object(parser, disp%vdw_radii)
     176            0 :                               disp%vdw_radii = disp%vdw_radii*bohr
     177            0 :                               found = .TRUE.
     178            0 :                               EXIT
     179              :                            END IF
     180              :                         END DO
     181            0 :                         CALL parser_release(parser)
     182              :                      END BLOCK
     183              :                   END IF
     184              :                END IF
     185           66 :                IF (found) THEN
     186           66 :                   disp%defined = .TRUE.
     187              :                ELSE
     188            0 :                   disp%defined = .FALSE.
     189              :                END IF
     190              :                ! Check if the parameter is defined
     191           66 :                IF (.NOT. disp%defined) &
     192              :                   CALL cp_abort(__LOCATION__, &
     193              :                                 "Dispersion parameters for element ("//TRIM(symbol)//") are not defined! "// &
     194              :                                 "Please provide a valid set of parameters through the input section or "// &
     195            0 :                                 "through an external file! ")
     196          168 :                CALL set_qs_kind(qs_kind_set(ikind), dispersion=disp)
     197              :             END DO
     198              :          CASE (vdw_pairpot_dftd3, vdw_pairpot_dftd3bj)
     199              :             !DFT-D3 Method initial setup
     200          518 :             CALL cite_reference(Grimme2010)
     201          518 :             CALL cite_reference(Grimme2011)
     202          518 :             CALL cite_reference(Goerigk2017)
     203          518 :             CALL cite_reference(Wittmann2024)
     204          518 :             max_elem = 103
     205          518 :             maxc = 7
     206          518 :             dispersion_env%max_elem = max_elem
     207          518 :             dispersion_env%maxc = maxc
     208          518 :             ALLOCATE (dispersion_env%maxci(max_elem))
     209          518 :             ALLOCATE (dispersion_env%c6ab(max_elem, max_elem, maxc, maxc, 3))
     210          518 :             ALLOCATE (dispersion_env%r0ab(max_elem, max_elem))
     211          518 :             ALLOCATE (dispersion_env%rcov(max_elem))
     212          518 :             ALLOCATE (dispersion_env%eneg(max_elem))
     213          518 :             ALLOCATE (dispersion_env%r2r4(max_elem))
     214          518 :             ALLOCATE (dispersion_env%cn(max_elem))
     215              : 
     216          518 :             IF (dispersion_env%d3_reference_code) THEN
     217              :                CALL dftd3_param_from_library(dispersion_env%c6ab, dispersion_env%maxci, &
     218              :                                              dispersion_env%r0ab, dispersion_env%rcov, &
     219              :                                              dispersion_env%r2r4, &
     220              :                                              dispersion_env%pp_type, dispersion_env%ref_functional, &
     221              :                                              dispersion_env%s6, dispersion_env%s8, &
     222              :                                              dispersion_env%a1, dispersion_env%a2, &
     223              :                                              dispersion_env%sr6, para_env, error=error_msg, &
     224           52 :                                              calc_scaling=.NOT. dispersion_env%d3_scaling_explicit)
     225           52 :                IF (error_msg /= "") THEN
     226            0 :                   CALL cp_abort(__LOCATION__, error_msg)
     227              :                END IF
     228              :             ELSE
     229          466 :                filename = dispersion_env%parameter_file_name
     230          466 :                CALL dftd3_c6_param(dispersion_env%c6ab, dispersion_env%maxci, filename, para_env)
     231          466 :                CALL setrcov(dispersion_env%rcov)
     232          466 :                CALL setr0ab(dispersion_env%r0ab, dispersion_env%rcov, dispersion_env%r2r4)
     233              :             END IF
     234              :             ! Electronegativity
     235          518 :             CALL seten(dispersion_env%eneg)
     236              :             ! the default coordination numbers
     237          518 :             CALL setcn(dispersion_env%cn)
     238              :             ! scale r4/r2 values of the atoms by sqrt(Z)
     239              :             ! sqrt is also globally close to optimum
     240              :             ! together with the factor 1/2 this yield reasonable
     241              :             ! c8 for he, ne and ar. for larger Z, C8 becomes too large
     242              :             ! which effectively mimics higher R^n terms neglected due
     243              :             ! to stability reasons
     244          518 :             IF (.NOT. dispersion_env%d3_reference_code) THEN
     245        48464 :                DO i = 1, max_elem
     246        47998 :                   dum = 0.5_dp*dispersion_env%r2r4(i)*REAL(i, dp)**0.5_dp
     247              :                   ! store it as sqrt because the geom. av. is taken
     248        48464 :                   dispersion_env%r2r4(i) = SQRT(dum)
     249              :                END DO
     250              :             END IF
     251              :             ! parameters
     252          518 :             dispersion_env%k1 = 16.0_dp
     253          518 :             dispersion_env%k2 = 4._dp/3._dp
     254              :             ! reasonable choices are between 3 and 5
     255              :             ! this gives smoth curves with maxima around the integer values
     256              :             ! k3=3 give for CN=0 a slightly smaller value than computed
     257              :             ! for the free atom. This also yields to larger CN for atoms
     258              :             ! in larger molecules but with the same chem. environment
     259              :             ! which is physically not right
     260              :             ! values >5 might lead to bumps in the potential
     261          518 :             dispersion_env%k3 = -4._dp
     262          518 :             IF (.NOT. dispersion_env%d3_reference_code) THEN
     263        48464 :                dispersion_env%rcov = dispersion_env%k2*dispersion_env%rcov*bohr
     264              :             END IF
     265              :             ! alpha default parameter
     266          518 :             dispersion_env%alp = 14._dp
     267              :             !
     268         1640 :             DO ikind = 1, nkind
     269         1122 :                CALL get_atomic_kind(atomic_kind_set(ikind), element_symbol=symbol, z=elem)
     270         1122 :                ALLOCATE (disp)
     271         1122 :                disp%type = dftd3_pp
     272         1122 :                IF (elem <= max_elem) THEN
     273         1122 :                   disp%defined = .TRUE.
     274              :                ELSE
     275              :                   disp%defined = .FALSE.
     276              :                END IF
     277         1122 :                IF (.NOT. disp%defined) &
     278              :                   CALL cp_abort(__LOCATION__, &
     279              :                                 "Dispersion parameters for element ("//TRIM(symbol)//") are not defined! "// &
     280              :                                 "Please provide a valid set of parameters through the input section or "// &
     281            0 :                                 "through an external file! ")
     282         2762 :                CALL set_qs_kind(qs_kind_set(ikind), dispersion=disp)
     283              :             END DO
     284              : 
     285          518 :             IF (PRESENT(pp_section)) THEN
     286              :                ! Check for coordination numbers
     287          154 :                CALL section_vals_val_get(pp_section, "KIND_COORDINATION_NUMBERS", n_rep_val=n_rep)
     288          154 :                IF (n_rep > 0) THEN
     289           24 :                   ALLOCATE (dispersion_env%cnkind(n_rep))
     290           12 :                   DO i = 1, n_rep
     291              :                      CALL section_vals_val_get(pp_section, "KIND_COORDINATION_NUMBERS", i_rep_val=i, &
     292            6 :                                                c_vals=tmpstringlist)
     293            6 :                      READ (tmpstringlist(1), *) dispersion_env%cnkind(i)%cnum
     294           12 :                      READ (tmpstringlist(2), *) dispersion_env%cnkind(i)%kind
     295              :                   END DO
     296              :                END IF
     297          154 :                CALL section_vals_val_get(pp_section, "ATOM_COORDINATION_NUMBERS", n_rep_val=n_rep)
     298          154 :                IF (n_rep > 0) THEN
     299           10 :                   ALLOCATE (dispersion_env%cnlist(n_rep))
     300            6 :                   DO i = 1, n_rep
     301              :                      CALL section_vals_val_get(pp_section, "ATOM_COORDINATION_NUMBERS", i_rep_val=i, &
     302            4 :                                                c_vals=tmpstringlist)
     303            4 :                      nl = SIZE(tmpstringlist)
     304           12 :                      ALLOCATE (dispersion_env%cnlist(i)%atom(nl - 1))
     305            4 :                      dispersion_env%cnlist(i)%natom = nl - 1
     306            4 :                      READ (tmpstringlist(1), *) dispersion_env%cnlist(i)%cnum
     307           14 :                      DO j = 1, nl - 1
     308           12 :                         READ (tmpstringlist(j + 1), *) dispersion_env%cnlist(i)%atom(j)
     309              :                      END DO
     310              :                   END DO
     311              :                END IF
     312              :                ! Check for exclusion lists
     313          154 :                CALL section_vals_val_get(pp_section, "D3_EXCLUDE_KIND", explicit=explicit)
     314          154 :                IF (explicit) THEN
     315            2 :                   CALL section_vals_val_get(pp_section, "D3_EXCLUDE_KIND", i_vals=exlist)
     316            4 :                   DO j = 1, SIZE(exlist)
     317            2 :                      ikind = exlist(j)
     318            2 :                      CALL get_qs_kind(qs_kind_set(ikind), dispersion=disp)
     319            4 :                      disp%defined = .FALSE.
     320              :                   END DO
     321              :                END IF
     322          154 :                CALL section_vals_val_get(pp_section, "D3_EXCLUDE_KIND_PAIR", n_rep_val=n_rep)
     323          154 :                dispersion_env%nd3_exclude_pair = n_rep
     324          154 :                IF (n_rep > 0) THEN
     325            6 :                   ALLOCATE (dispersion_env%d3_exclude_pair(n_rep, 2))
     326            6 :                   DO i = 1, n_rep
     327              :                      CALL section_vals_val_get(pp_section, "D3_EXCLUDE_KIND_PAIR", i_rep_val=i, &
     328            4 :                                                i_vals=exlist)
     329           22 :                      dispersion_env%d3_exclude_pair(i, :) = exlist
     330              :                   END DO
     331              :                END IF
     332              :             END IF
     333              :          CASE (vdw_pairpot_dftd4)
     334              :             !most checks are done by the library
     335          682 :             CALL cite_reference(Caldeweyher2017)
     336          682 :             CALL cite_reference(Caldeweyher2019)
     337          682 :             CALL cite_reference(Caldeweyher2020)
     338         2122 :             DO ikind = 1, nkind
     339         1440 :                CALL get_atomic_kind(atomic_kind_set(ikind), element_symbol=symbol, z=elem)
     340         1440 :                ALLOCATE (disp)
     341         1440 :                disp%type = dftd4_pp
     342         1440 :                disp%defined = .TRUE.
     343         3562 :                CALL set_qs_kind(qs_kind_set(ikind), dispersion=disp)
     344              :             END DO
     345              :             ! maybe needed in cnumber calculations
     346          682 :             max_elem = 103
     347          682 :             maxc = 7
     348          682 :             dispersion_env%max_elem = max_elem
     349          682 :             dispersion_env%maxc = maxc
     350          682 :             ALLOCATE (dispersion_env%maxci(max_elem))
     351          682 :             ALLOCATE (dispersion_env%rcov(max_elem))
     352          682 :             ALLOCATE (dispersion_env%eneg(max_elem))
     353          682 :             ALLOCATE (dispersion_env%cn(max_elem))
     354              :             ! the default covalent radii
     355          682 :             CALL setrcov(dispersion_env%rcov)
     356              :             ! the default coordination numbers
     357          682 :             CALL setcn(dispersion_env%cn)
     358              :             ! Electronegativity
     359          682 :             CALL seten(dispersion_env%eneg)
     360              :             ! parameters
     361          682 :             dispersion_env%k1 = 16.0_dp
     362          682 :             dispersion_env%k2 = 4._dp/3._dp
     363          682 :             dispersion_env%k3 = -4._dp
     364        70928 :             dispersion_env%rcov = dispersion_env%k2*dispersion_env%rcov*bohr
     365          682 :             dispersion_env%alp = 14._dp
     366              :             !
     367          682 :             dispersion_env%cnfun = 3
     368          682 :             IF (dispersion_env%rc_cn < 0.0_dp) THEN
     369          682 :                dispersion_env%rc_cn = get_cn_radius(dispersion_env)
     370              :             END IF
     371         1918 :             IF (PRESENT(pp_section)) THEN
     372           42 :                eeq_section => section_vals_get_subs_vals(pp_section, "EEQ")
     373           42 :                CALL read_eeq_param(eeq_section, dispersion_env%eeq_sparam)
     374              :             END IF
     375              :          END SELECT
     376              :       END SELECT
     377              : 
     378         1236 :       CALL timestop(handle)
     379              : 
     380         1236 :    END SUBROUTINE qs_dispersion_pairpot_init
     381              : 
     382              : ! **************************************************************************************************
     383              : !> \brief ...
     384              : !> \param qs_env ...
     385              : !> \param dispersion_env ...
     386              : !> \param energy ...
     387              : !> \param calculate_forces ...
     388              : !> \param atevdw ...
     389              : ! **************************************************************************************************
     390        24228 :    SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculate_forces, atevdw)
     391              : 
     392              :       TYPE(qs_environment_type), POINTER                 :: qs_env
     393              :       TYPE(qs_dispersion_type), POINTER                  :: dispersion_env
     394              :       REAL(KIND=dp), INTENT(INOUT)                       :: energy
     395              :       LOGICAL, INTENT(IN)                                :: calculate_forces
     396              :       REAL(KIND=dp), DIMENSION(:), OPTIONAL              :: atevdw
     397              : 
     398              :       CHARACTER(LEN=*), PARAMETER :: routineN = 'calculate_dispersion_pairpot'
     399              : 
     400              :       INTEGER                                            :: atom_a, handle, iatom, ikind, iw, natom, &
     401              :                                                             nkind, unit_nr
     402        24228 :       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: atom_of_kind, kind_of
     403              :       LOGICAL                                            :: atenergy, atex, debugall, use_virial
     404              :       REAL(KIND=dp)                                      :: evdw, gnorm
     405        24228 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: atomic_energy
     406              :       REAL(KIND=dp), DIMENSION(3)                        :: fdij
     407              :       REAL(KIND=dp), DIMENSION(3, 3)                     :: dvirial, pv_loc, pv_virial_thread
     408        24228 :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
     409              :       TYPE(atprop_type), POINTER                         :: atprop
     410              :       TYPE(cell_type), POINTER                           :: cell
     411              :       TYPE(cp_logger_type), POINTER                      :: logger
     412              :       TYPE(mp_para_env_type), POINTER                    :: para_env
     413        24228 :       TYPE(qs_force_type), DIMENSION(:), POINTER         :: force
     414              :       TYPE(virial_type), POINTER                         :: virial
     415              : 
     416        24228 :       energy = 0._dp
     417              :       ! make valgrind happy
     418        24228 :       use_virial = .FALSE.
     419              : 
     420        24228 :       IF (dispersion_env%type /= xc_vdw_fun_pairpot) THEN
     421              :          RETURN
     422              :       END IF
     423              : 
     424         6542 :       CALL timeset(routineN, handle)
     425              : 
     426         6542 :       NULLIFY (atomic_kind_set)
     427              : 
     428              :       CALL get_qs_env(qs_env=qs_env, nkind=nkind, natom=natom, atomic_kind_set=atomic_kind_set, &
     429         6542 :                       cell=cell, virial=virial, para_env=para_env, atprop=atprop)
     430              : 
     431         6542 :       debugall = dispersion_env%verbose
     432              : 
     433         6542 :       NULLIFY (logger)
     434         6542 :       logger => cp_get_default_logger()
     435         6542 :       IF (ASSOCIATED(dispersion_env%dftd_section)) THEN
     436              :          unit_nr = cp_print_key_unit_nr(logger, dispersion_env%dftd_section, "PRINT_DFTD", &
     437          378 :                                         extension=".dftd")
     438              :       ELSE
     439         6164 :          unit_nr = -1
     440              :       END IF
     441              : 
     442              :       ! atomic energy and stress arrays
     443         6542 :       atenergy = atprop%energy
     444              :       ! external atomic energy
     445         6542 :       atex = .FALSE.
     446         6542 :       IF (PRESENT(atevdw)) THEN
     447            2 :          atex = .TRUE.
     448              :       END IF
     449              : 
     450         6542 :       IF (unit_nr > 0) THEN
     451           68 :          WRITE (unit_nr, *)
     452           68 :          WRITE (unit_nr, *) " Pair potential vdW calculation"
     453           68 :          IF (dispersion_env%pp_type == vdw_pairpot_dftd2) THEN
     454            7 :             WRITE (unit_nr, *) " Dispersion potential type: DFT-D2"
     455            7 :             WRITE (unit_nr, *) " Scaling parameter (s6) ", dispersion_env%scaling
     456            7 :             WRITE (unit_nr, *) " Exponential prefactor  ", dispersion_env%exp_pre
     457           61 :          ELSE IF (dispersion_env%pp_type == vdw_pairpot_dftd3) THEN
     458           20 :             WRITE (unit_nr, *) " Dispersion potential type: DFT-D3"
     459           41 :          ELSE IF (dispersion_env%pp_type == vdw_pairpot_dftd3bj) THEN
     460           25 :             WRITE (unit_nr, *) " Dispersion potential type: DFT-D3(BJ)"
     461           16 :          ELSE IF (dispersion_env%pp_type == vdw_pairpot_dftd4) THEN
     462           16 :             WRITE (unit_nr, *) " Dispersion potential type: DFT-D4"
     463              :          END IF
     464              :       END IF
     465              : 
     466         6542 :       CALL get_qs_env(qs_env=qs_env, force=force)
     467         6542 :       use_virial = virial%pv_availability .AND. (.NOT. virial%pv_numer)
     468          702 :       IF (use_virial .AND. debugall) THEN
     469          104 :          dvirial = virial%pv_virial
     470              :       END IF
     471         6542 :       IF (use_virial) THEN
     472         9126 :          pv_loc = virial%pv_virial
     473              :       END IF
     474              : 
     475         6542 :       evdw = 0._dp
     476              :       pv_virial_thread(:, :) = 0._dp
     477              : 
     478         6542 :       CALL get_atomic_kind_set(atomic_kind_set, atom_of_kind=atom_of_kind, kind_of=kind_of)
     479              : 
     480         6542 :       IF (dispersion_env%pp_type == vdw_pairpot_dftd2) THEN
     481          144 :          CALL calculate_dispersion_d2_pairpot(qs_env, dispersion_env, evdw, calculate_forces, atevdw)
     482         6470 :       ELSEIF (dispersion_env%pp_type == vdw_pairpot_dftd3 .OR. &
     483              :               dispersion_env%pp_type == vdw_pairpot_dftd3bj) THEN
     484              :          CALL calculate_dispersion_d3_pairpot(qs_env, dispersion_env, evdw, calculate_forces, &
     485        11118 :                                               unit_nr, atevdw)
     486          910 :       ELSEIF (dispersion_env%pp_type == vdw_pairpot_dftd4) THEN
     487          910 :          IF (dispersion_env%lrc) THEN
     488            0 :             CPABORT("Long range correction with DFTD4 not implemented")
     489              :          END IF
     490          910 :          IF (dispersion_env%srb) THEN
     491            0 :             CPABORT("Short range bond correction with DFTD4 not implemented")
     492              :          END IF
     493          910 :          IF (dispersion_env%domol) THEN
     494            0 :             CPABORT("Molecular approximation with DFTD4 not implemented")
     495              :          END IF
     496              :          !
     497          910 :          iw = -1
     498          910 :          IF (dispersion_env%verbose) iw = cp_logger_get_default_io_unit(logger)
     499              :          !
     500          910 :          IF (atenergy .OR. atex) THEN
     501            0 :             ALLOCATE (atomic_energy(natom))
     502              :             CALL calculate_dispersion_d4_pairpot(qs_env, dispersion_env, evdw, calculate_forces, &
     503            0 :                                                  iw, atomic_energy=atomic_energy)
     504              :          ELSE
     505          910 :             CALL calculate_dispersion_d4_pairpot(qs_env, dispersion_env, evdw, calculate_forces, iw)
     506              :          END IF
     507              :          !
     508          910 :          IF (atex) THEN
     509            0 :             atevdw(1:natom) = atomic_energy(1:natom)
     510              :          END IF
     511          910 :          IF (atenergy) THEN
     512            0 :             CALL atprop_array_init(atprop%atevdw, natom)
     513            0 :             atprop%atevdw(1:natom) = atomic_energy(1:natom)
     514              :          END IF
     515          910 :          IF (atenergy .OR. atex) THEN
     516            0 :             DEALLOCATE (atomic_energy)
     517              :          END IF
     518              :       END IF
     519              : 
     520              :       ! set dispersion energy
     521         6542 :       CALL para_env%sum(evdw)
     522         6542 :       energy = evdw
     523         6542 :       IF (unit_nr > 0) THEN
     524           68 :          WRITE (unit_nr, *) " Total vdW energy [au]     :", evdw
     525           68 :          WRITE (unit_nr, *) " Total vdW energy [kcal]   :", evdw*kcalmol
     526           68 :          WRITE (unit_nr, *)
     527              :       END IF
     528         6542 :       IF (calculate_forces .AND. debugall) THEN
     529           42 :          IF (unit_nr > 0) THEN
     530            1 :             WRITE (unit_nr, *) " Dispersion Forces         "
     531            1 :             WRITE (unit_nr, *) " Atom   Kind                            Forces    "
     532              :          END IF
     533           42 :          gnorm = 0._dp
     534          226 :          DO iatom = 1, natom
     535          184 :             ikind = kind_of(iatom)
     536          184 :             atom_a = atom_of_kind(iatom)
     537          736 :             fdij(1:3) = force(ikind)%dispersion(:, atom_a)
     538          184 :             CALL para_env%sum(fdij)
     539          736 :             gnorm = gnorm + SUM(ABS(fdij))
     540          226 :             IF (unit_nr > 0) WRITE (unit_nr, "(i5,i7,3F20.14)") iatom, ikind, fdij
     541              :          END DO
     542           42 :          IF (unit_nr > 0) THEN
     543            1 :             WRITE (unit_nr, *)
     544            1 :             WRITE (unit_nr, *) "|G| = ", gnorm
     545            1 :             WRITE (unit_nr, *)
     546              :          END IF
     547           42 :          IF (use_virial) THEN
     548           78 :             dvirial = virial%pv_virial - dvirial
     549            6 :             CALL para_env%sum(dvirial)
     550            6 :             IF (unit_nr > 0) THEN
     551            0 :                WRITE (unit_nr, *) "Stress Tensor (dispersion)"
     552            0 :                WRITE (unit_nr, "(3G20.12)") dvirial
     553            0 :                WRITE (unit_nr, *) "  Tr(P)/3 :  ", (dvirial(1, 1) + dvirial(2, 2) + dvirial(3, 3))/3._dp
     554            0 :                WRITE (unit_nr, *)
     555              :             END IF
     556              :          END IF
     557              :       END IF
     558              : 
     559         6542 :       IF (calculate_forces .AND. use_virial) THEN
     560         3510 :          virial%pv_vdw = virial%pv_vdw + (virial%pv_virial - pv_loc)
     561              :       END IF
     562              : 
     563         6542 :       IF (ASSOCIATED(dispersion_env%dftd_section)) THEN
     564          378 :          CALL cp_print_key_finished_output(unit_nr, logger, dispersion_env%dftd_section, "PRINT_DFTD")
     565              :       END IF
     566              : 
     567         6542 :       CALL timestop(handle)
     568              : 
     569        30770 :    END SUBROUTINE calculate_dispersion_pairpot
     570              : 
     571              : END MODULE qs_dispersion_pairpot
        

Generated by: LCOV version 2.0-1