LCOV - code coverage report
Current view: top level - src/subsys - atomic_kind_types.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 89.7 % 126 113
Test Date: 2025-07-25 12:55:17 Functions: 71.4 % 7 5

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief   Define the atomic kind types and their sub types
      10              : !> \author  Matthias Krack (MK)
      11              : !> \date    02.01.2002
      12              : !> \version 1.0
      13              : !>
      14              : !> <b>Modification history:</b>
      15              : !> - 01.2002 creation [MK]
      16              : !> - 04.2002 added pao [fawzi]
      17              : !> - 09.2002 adapted for POL/KG use [GT]
      18              : !> - 02.2004 flexible normalization of basis sets [jgh]
      19              : !> - 03.2004 attach/detach routines [jgh]
      20              : !> - 10.2004 removed pao [fawzi]
      21              : !> - 08.2014 moevd qs-related stuff into new qs_kind_types.F [Ole Schuett]
      22              : ! **************************************************************************************************
      23              : MODULE atomic_kind_types
      24              :    USE damping_dipole_types,            ONLY: damping_p_release,&
      25              :                                               damping_p_type
      26              :    USE external_potential_types,        ONLY: deallocate_potential,&
      27              :                                               fist_potential_type,&
      28              :                                               get_potential
      29              :    USE kinds,                           ONLY: default_string_length,&
      30              :                                               dp
      31              :    USE periodic_table,                  ONLY: get_ptable_info
      32              :    USE shell_potential_types,           ONLY: shell_kind_type
      33              : #include "../base/base_uses.f90"
      34              : 
      35              :    IMPLICIT NONE
      36              : 
      37              :    PRIVATE
      38              : 
      39              :    ! Global parameters (only in this module)
      40              : 
      41              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'atomic_kind_types'
      42              : 
      43              : !> \brief Provides all information about an atomic kind
      44              : ! **************************************************************************************************
      45              :    TYPE atomic_kind_type
      46              :       TYPE(fist_potential_type), POINTER     :: fist_potential => Null()
      47              :       CHARACTER(LEN=default_string_length)   :: name = ""
      48              :       CHARACTER(LEN=2)                       :: element_symbol = ""
      49              :       REAL(KIND=dp)                          :: mass = 0.0_dp
      50              :       INTEGER                                :: kind_number = -1
      51              :       INTEGER                                :: natom = -1
      52              :       INTEGER, DIMENSION(:), POINTER         :: atom_list => Null()
      53              :       LOGICAL                                :: shell_active = .FALSE.
      54              :       TYPE(shell_kind_type), POINTER         :: shell => Null()
      55              :       TYPE(damping_p_type), POINTER          :: damping => Null()
      56              :    END TYPE atomic_kind_type
      57              : 
      58              : !> \brief Provides a vector of pointers of type atomic_kind_type
      59              : ! **************************************************************************************************
      60              :    TYPE atomic_kind_p_type
      61              :       TYPE(atomic_kind_type), DIMENSION(:), &
      62              :          POINTER                             :: atomic_kind_set => NULL()
      63              :    END TYPE atomic_kind_p_type
      64              : 
      65              :    ! Public subroutines
      66              : 
      67              :    PUBLIC :: deallocate_atomic_kind_set, &
      68              :              get_atomic_kind, &
      69              :              get_atomic_kind_set, &
      70              :              set_atomic_kind, &
      71              :              is_hydrogen
      72              : 
      73              :    ! Public data types
      74              :    PUBLIC :: atomic_kind_type
      75              : 
      76              : CONTAINS
      77              : 
      78              : ! **************************************************************************************************
      79              : !> \brief   Destructor routine for a set of atomic kinds
      80              : !> \param atomic_kind_set ...
      81              : !> \date    02.01.2002
      82              : !> \author  Matthias Krack (MK)
      83              : !> \version 2.0
      84              : ! **************************************************************************************************
      85        18342 :    SUBROUTINE deallocate_atomic_kind_set(atomic_kind_set)
      86              : 
      87              :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      88              : 
      89              :       INTEGER                                            :: ikind, nkind
      90              : 
      91        18342 :       IF (.NOT. ASSOCIATED(atomic_kind_set)) THEN
      92              :          CALL cp_abort(__LOCATION__, &
      93              :                        "The pointer atomic_kind_set is not associated and "// &
      94            0 :                        "cannot be deallocated")
      95              :       END IF
      96              : 
      97        18342 :       nkind = SIZE(atomic_kind_set)
      98              : 
      99        52627 :       DO ikind = 1, nkind
     100        34285 :          IF (ASSOCIATED(atomic_kind_set(ikind)%fist_potential)) THEN
     101        11282 :             CALL deallocate_potential(atomic_kind_set(ikind)%fist_potential)
     102              :          END IF
     103        34285 :          IF (ASSOCIATED(atomic_kind_set(ikind)%atom_list)) THEN
     104        34272 :             DEALLOCATE (atomic_kind_set(ikind)%atom_list)
     105              :          END IF
     106        34285 :          IF (ASSOCIATED(atomic_kind_set(ikind)%shell)) DEALLOCATE (atomic_kind_set(ikind)%shell)
     107              : 
     108        52627 :          CALL damping_p_release(atomic_kind_set(ikind)%damping)
     109              :       END DO
     110        18342 :       DEALLOCATE (atomic_kind_set)
     111        18342 :    END SUBROUTINE deallocate_atomic_kind_set
     112              : 
     113              : ! **************************************************************************************************
     114              : !> \brief Get attributes of an atomic kind.
     115              : !> \param atomic_kind ...
     116              : !> \param fist_potential ...
     117              : !> \param element_symbol ...
     118              : !> \param name ...
     119              : !> \param mass ...
     120              : !> \param kind_number ...
     121              : !> \param natom ...
     122              : !> \param atom_list ...
     123              : !> \param rcov ...
     124              : !> \param rvdw ...
     125              : !> \param z ...
     126              : !> \param qeff ...
     127              : !> \param apol ...
     128              : !> \param cpol ...
     129              : !> \param mm_radius ...
     130              : !> \param shell ...
     131              : !> \param shell_active ...
     132              : !> \param damping ...
     133              : ! **************************************************************************************************
     134    144748049 :    SUBROUTINE get_atomic_kind(atomic_kind, fist_potential, &
     135              :                               element_symbol, name, mass, kind_number, natom, atom_list, &
     136              :                               rcov, rvdw, z, qeff, apol, cpol, mm_radius, &
     137              :                               shell, shell_active, damping)
     138              : 
     139              :       TYPE(atomic_kind_type), INTENT(IN)                 :: atomic_kind
     140              :       TYPE(fist_potential_type), OPTIONAL, POINTER       :: fist_potential
     141              :       CHARACTER(LEN=2), INTENT(OUT), OPTIONAL            :: element_symbol
     142              :       CHARACTER(LEN=default_string_length), &
     143              :          INTENT(OUT), OPTIONAL                           :: name
     144              :       REAL(KIND=dp), INTENT(OUT), OPTIONAL               :: mass
     145              :       INTEGER, INTENT(OUT), OPTIONAL                     :: kind_number, natom
     146              :       INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: atom_list
     147              :       REAL(KIND=dp), INTENT(OUT), OPTIONAL               :: rcov, rvdw
     148              :       INTEGER, INTENT(OUT), OPTIONAL                     :: z
     149              :       REAL(KIND=dp), INTENT(OUT), OPTIONAL               :: qeff, apol, cpol, mm_radius
     150              :       TYPE(shell_kind_type), OPTIONAL, POINTER           :: shell
     151              :       LOGICAL, INTENT(OUT), OPTIONAL                     :: shell_active
     152              :       TYPE(damping_p_type), OPTIONAL, POINTER            :: damping
     153              : 
     154    144748049 :       IF (PRESENT(fist_potential)) fist_potential => atomic_kind%fist_potential
     155    144748049 :       IF (PRESENT(element_symbol)) element_symbol = atomic_kind%element_symbol
     156    144748049 :       IF (PRESENT(name)) name = atomic_kind%name
     157    144748049 :       IF (PRESENT(mass)) mass = atomic_kind%mass
     158    144748049 :       IF (PRESENT(kind_number)) kind_number = atomic_kind%kind_number
     159    144748049 :       IF (PRESENT(natom)) natom = atomic_kind%natom
     160    144748049 :       IF (PRESENT(atom_list)) atom_list => atomic_kind%atom_list
     161              : 
     162    144748049 :       IF (PRESENT(z)) THEN
     163       160059 :          CALL get_ptable_info(atomic_kind%element_symbol, number=z)
     164              :       END IF
     165    144748049 :       IF (PRESENT(rcov)) THEN
     166          340 :          CALL get_ptable_info(atomic_kind%element_symbol, covalent_radius=rcov)
     167              :       END IF
     168    144748049 :       IF (PRESENT(rvdw)) THEN
     169         6474 :          CALL get_ptable_info(atomic_kind%element_symbol, vdw_radius=rvdw)
     170              :       END IF
     171    144748049 :       IF (PRESENT(qeff)) THEN
     172     37222724 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     173     36491418 :             CALL get_potential(potential=atomic_kind%fist_potential, qeff=qeff)
     174              :          ELSE
     175       731306 :             qeff = -HUGE(0.0_dp)
     176              :          END IF
     177              :       END IF
     178    144748049 :       IF (PRESENT(apol)) THEN
     179         4196 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     180         4196 :             CALL get_potential(potential=atomic_kind%fist_potential, apol=apol)
     181              :          ELSE
     182            0 :             apol = -HUGE(0.0_dp)
     183              :          END IF
     184              :       END IF
     185    144748049 :       IF (PRESENT(cpol)) THEN
     186          904 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     187          904 :             CALL get_potential(potential=atomic_kind%fist_potential, cpol=cpol)
     188              :          ELSE
     189            0 :             cpol = -HUGE(0.0_dp)
     190              :          END IF
     191              :       END IF
     192    144748049 :       IF (PRESENT(mm_radius)) THEN
     193       547510 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     194       547510 :             CALL get_potential(potential=atomic_kind%fist_potential, mm_radius=mm_radius)
     195              :          ELSE
     196            0 :             mm_radius = -HUGE(0.0_dp)
     197              :          END IF
     198              :       END IF
     199    144748049 :       IF (PRESENT(shell)) shell => atomic_kind%shell
     200    144748049 :       IF (PRESENT(shell_active)) shell_active = atomic_kind%shell_active
     201    144748049 :       IF (PRESENT(damping)) damping => atomic_kind%damping
     202              : 
     203    144748049 :    END SUBROUTINE get_atomic_kind
     204              : 
     205              : ! **************************************************************************************************
     206              : !> \brief Get attributes of an atomic kind set.
     207              : !> \param atomic_kind_set ...
     208              : !> \param atom_of_kind ...
     209              : !> \param kind_of ...
     210              : !> \param natom_of_kind ...
     211              : !> \param maxatom ...
     212              : !> \param natom ...
     213              : !> \param nshell ...
     214              : !> \param fist_potential_present ...
     215              : !> \param shell_present ...
     216              : !> \param shell_adiabatic ...
     217              : !> \param shell_check_distance ...
     218              : !> \param damping_present ...
     219              : ! **************************************************************************************************
     220      1294343 :    SUBROUTINE get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, &
     221              :                                   natom, nshell, fist_potential_present, shell_present, &
     222              :                                   shell_adiabatic, shell_check_distance, damping_present)
     223              : 
     224              :       TYPE(atomic_kind_type), DIMENSION(:), INTENT(IN)   :: atomic_kind_set
     225              :       INTEGER, ALLOCATABLE, DIMENSION(:), OPTIONAL       :: atom_of_kind, kind_of, natom_of_kind
     226              :       INTEGER, INTENT(OUT), OPTIONAL                     :: maxatom, natom, nshell
     227              :       LOGICAL, INTENT(OUT), OPTIONAL                     :: fist_potential_present, shell_present, &
     228              :                                                             shell_adiabatic, shell_check_distance, &
     229              :                                                             damping_present
     230              : 
     231              :       INTEGER                                            :: atom_a, iatom, ikind, my_natom
     232              : 
     233              :       ! Compute number of atoms which is needed for possible allocations later.
     234      1294343 :       my_natom = 0
     235      4301089 :       DO ikind = 1, SIZE(atomic_kind_set)
     236      4301089 :          my_natom = my_natom + atomic_kind_set(ikind)%natom
     237              :       END DO
     238              : 
     239      1294343 :       IF (PRESENT(maxatom)) maxatom = 0
     240      1294343 :       IF (PRESENT(natom)) natom = my_natom
     241      1294343 :       IF (PRESENT(nshell)) nshell = 0
     242      1294343 :       IF (PRESENT(shell_present)) shell_present = .FALSE.
     243      1294343 :       IF (PRESENT(shell_adiabatic)) shell_adiabatic = .FALSE.
     244      1294343 :       IF (PRESENT(shell_check_distance)) shell_check_distance = .FALSE.
     245      1294343 :       IF (PRESENT(damping_present)) damping_present = .FALSE.
     246      1294343 :       IF (PRESENT(atom_of_kind)) THEN
     247       643644 :          ALLOCATE (atom_of_kind(my_natom))
     248      1553819 :          atom_of_kind(:) = 0
     249              :       END IF
     250      1294343 :       IF (PRESENT(kind_of)) THEN
     251      1885836 :          ALLOCATE (kind_of(my_natom))
     252      3053939 :          kind_of(:) = 0
     253              :       END IF
     254      1294343 :       IF (PRESENT(natom_of_kind)) THEN
     255        14415 :          ALLOCATE (natom_of_kind(SIZE(atomic_kind_set)))
     256        14045 :          natom_of_kind(:) = 0
     257              :       END IF
     258              : 
     259      4301089 :       DO ikind = 1, SIZE(atomic_kind_set)
     260      1294343 :          ASSOCIATE (atomic_kind => atomic_kind_set(ikind))
     261      3006746 :             IF (PRESENT(maxatom)) THEN
     262       113021 :                maxatom = MAX(maxatom, atomic_kind%natom)
     263              :             END IF
     264      3006746 :             IF (PRESENT(fist_potential_present)) THEN
     265            0 :                IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     266            0 :                   fist_potential_present = .TRUE.
     267              :                END IF
     268              :             END IF
     269      3006746 :             IF (PRESENT(shell_present)) THEN
     270       850949 :                IF (ASSOCIATED(atomic_kind%shell)) THEN
     271        50868 :                   shell_present = .TRUE.
     272              :                END IF
     273              :             END IF
     274      3006746 :             IF (PRESENT(shell_adiabatic) .AND. ASSOCIATED(atomic_kind%shell)) THEN
     275        55914 :                IF (.NOT. shell_adiabatic) THEN
     276        31760 :                   shell_adiabatic = (atomic_kind%shell%massfrac /= 0.0_dp)
     277              :                END IF
     278              :             END IF
     279      3006746 :             IF (PRESENT(shell_check_distance) .AND. ASSOCIATED(atomic_kind%shell)) THEN
     280         6360 :                IF (.NOT. shell_check_distance) THEN
     281         5450 :                   shell_check_distance = (atomic_kind%shell%max_dist > 0.0_dp)
     282              :                END IF
     283              :             END IF
     284      3006746 :             IF (PRESENT(damping_present)) THEN
     285            0 :                IF (ASSOCIATED(atomic_kind%damping)) THEN
     286            0 :                   damping_present = .TRUE.
     287              :                END IF
     288              :             END IF
     289      3006746 :             IF (PRESENT(atom_of_kind)) THEN
     290      1799561 :                DO iatom = 1, atomic_kind%natom
     291      1339271 :                   atom_a = atomic_kind%atom_list(iatom)
     292      1799561 :                   atom_of_kind(atom_a) = iatom
     293              :                END DO
     294              :             END IF
     295      3006746 :             IF (PRESENT(kind_of)) THEN
     296      3717122 :                DO iatom = 1, atomic_kind%natom
     297      2425327 :                   atom_a = atomic_kind%atom_list(iatom)
     298      3717122 :                   kind_of(atom_a) = ikind
     299              :                END DO
     300              :             END IF
     301      6013492 :             IF (PRESENT(natom_of_kind)) THEN
     302         9240 :                natom_of_kind(ikind) = atomic_kind%natom
     303              :             END IF
     304              :          END ASSOCIATE
     305              :       END DO
     306              : 
     307      1294343 :    END SUBROUTINE get_atomic_kind_set
     308              : 
     309              : ! **************************************************************************************************
     310              : !> \brief Set the components of an atomic kind data set.
     311              : !> \param atomic_kind ...
     312              : !> \param element_symbol ...
     313              : !> \param name ...
     314              : !> \param mass ...
     315              : !> \param kind_number ...
     316              : !> \param natom ...
     317              : !> \param atom_list ...
     318              : !> \param fist_potential ...
     319              : !> \param shell ...
     320              : !> \param shell_active ...
     321              : !> \param damping ...
     322              : ! **************************************************************************************************
     323        95589 :    SUBROUTINE set_atomic_kind(atomic_kind, element_symbol, name, mass, kind_number, &
     324        34272 :                               natom, atom_list, &
     325              :                               fist_potential, shell, &
     326              :                               shell_active, damping)
     327              : 
     328              :       TYPE(atomic_kind_type), INTENT(INOUT)              :: atomic_kind
     329              :       CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: element_symbol, name
     330              :       REAL(KIND=dp), INTENT(IN), OPTIONAL                :: mass
     331              :       INTEGER, INTENT(IN), OPTIONAL                      :: kind_number, natom
     332              :       INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: atom_list
     333              :       TYPE(fist_potential_type), OPTIONAL, POINTER       :: fist_potential
     334              :       TYPE(shell_kind_type), OPTIONAL, POINTER           :: shell
     335              :       LOGICAL, INTENT(IN), OPTIONAL                      :: shell_active
     336              :       TYPE(damping_p_type), OPTIONAL, POINTER            :: damping
     337              : 
     338              :       INTEGER                                            :: n
     339              : 
     340        95589 :       IF (PRESENT(element_symbol)) atomic_kind%element_symbol = element_symbol
     341        95589 :       IF (PRESENT(name)) atomic_kind%name = name
     342        95589 :       IF (PRESENT(mass)) atomic_kind%mass = mass
     343        95589 :       IF (PRESENT(kind_number)) atomic_kind%kind_number = kind_number
     344        95589 :       IF (PRESENT(natom)) atomic_kind%natom = natom
     345        95589 :       IF (PRESENT(atom_list)) THEN
     346        34272 :          n = SIZE(atom_list)
     347        34272 :          IF (n > 0) THEN
     348        34272 :             IF (ASSOCIATED(atomic_kind%atom_list)) THEN
     349            0 :                DEALLOCATE (atomic_kind%atom_list)
     350              :             END IF
     351       102816 :             ALLOCATE (atomic_kind%atom_list(n))
     352      1005177 :             atomic_kind%atom_list(:) = atom_list(:)
     353        34272 :             atomic_kind%natom = n
     354              :          ELSE
     355            0 :             CPABORT("An invalid atom_list was supplied")
     356              :          END IF
     357              :       END IF
     358        95589 :       IF (PRESENT(fist_potential)) atomic_kind%fist_potential => fist_potential
     359        95589 :       IF (PRESENT(shell)) THEN
     360          448 :          IF (ASSOCIATED(atomic_kind%shell)) THEN
     361            0 :             IF (.NOT. ASSOCIATED(atomic_kind%shell, shell)) THEN
     362            0 :                DEALLOCATE (atomic_kind%shell)
     363              :             END IF
     364              :          END IF
     365          448 :          atomic_kind%shell => shell
     366              :       END IF
     367        95589 :       IF (PRESENT(shell_active)) atomic_kind%shell_active = shell_active
     368              : 
     369        95589 :       IF (PRESENT(damping)) atomic_kind%damping => damping
     370              : 
     371        95589 :    END SUBROUTINE set_atomic_kind
     372              : 
     373              : ! **************************************************************************************************
     374              : !> \brief Determines if the atomic_kind is HYDROGEN
     375              : !> \param atomic_kind ...
     376              : !> \return ...
     377              : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
     378              : ! **************************************************************************************************
     379      2165778 :    ELEMENTAL FUNCTION is_hydrogen(atomic_kind) RESULT(res)
     380              :       TYPE(atomic_kind_type), INTENT(IN)                 :: atomic_kind
     381              :       LOGICAL                                            :: res
     382              : 
     383      2165778 :       res = TRIM(atomic_kind%element_symbol) == "H"
     384      2165778 :    END FUNCTION is_hydrogen
     385              : 
     386            0 : END MODULE atomic_kind_types
        

Generated by: LCOV version 2.0-1