Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 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       16653 :    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       16653 :       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       16653 :       nkind = SIZE(atomic_kind_set)
      98             : 
      99       48245 :       DO ikind = 1, nkind
     100       31592 :          IF (ASSOCIATED(atomic_kind_set(ikind)%fist_potential)) THEN
     101       11272 :             CALL deallocate_potential(atomic_kind_set(ikind)%fist_potential)
     102             :          END IF
     103       31592 :          IF (ASSOCIATED(atomic_kind_set(ikind)%atom_list)) THEN
     104       31578 :             DEALLOCATE (atomic_kind_set(ikind)%atom_list)
     105             :          END IF
     106       31592 :          IF (ASSOCIATED(atomic_kind_set(ikind)%shell)) DEALLOCATE (atomic_kind_set(ikind)%shell)
     107             : 
     108       48245 :          CALL damping_p_release(atomic_kind_set(ikind)%damping)
     109             :       END DO
     110       16653 :       DEALLOCATE (atomic_kind_set)
     111       16653 :    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   144285522 :    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   144285522 :       IF (PRESENT(fist_potential)) fist_potential => atomic_kind%fist_potential
     155   144285522 :       IF (PRESENT(element_symbol)) element_symbol = atomic_kind%element_symbol
     156   144285522 :       IF (PRESENT(name)) name = atomic_kind%name
     157   144285522 :       IF (PRESENT(mass)) mass = atomic_kind%mass
     158   144285522 :       IF (PRESENT(kind_number)) kind_number = atomic_kind%kind_number
     159   144285522 :       IF (PRESENT(natom)) natom = atomic_kind%natom
     160   144285522 :       IF (PRESENT(atom_list)) atom_list => atomic_kind%atom_list
     161             : 
     162   144285522 :       IF (PRESENT(z)) THEN
     163      144842 :          CALL get_ptable_info(atomic_kind%element_symbol, number=z)
     164             :       END IF
     165   144285522 :       IF (PRESENT(rcov)) THEN
     166         340 :          CALL get_ptable_info(atomic_kind%element_symbol, covalent_radius=rcov)
     167             :       END IF
     168   144285522 :       IF (PRESENT(rvdw)) THEN
     169        6474 :          CALL get_ptable_info(atomic_kind%element_symbol, vdw_radius=rvdw)
     170             :       END IF
     171   144285522 :       IF (PRESENT(qeff)) THEN
     172    37007349 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     173    36456923 :             CALL get_potential(potential=atomic_kind%fist_potential, qeff=qeff)
     174             :          ELSE
     175      550426 :             qeff = -HUGE(0.0_dp)
     176             :          END IF
     177             :       END IF
     178   144285522 :       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   144285522 :       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   144285522 :       IF (PRESENT(mm_radius)) THEN
     193      549893 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     194      549893 :             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   144285522 :       IF (PRESENT(shell)) shell => atomic_kind%shell
     200   144285522 :       IF (PRESENT(shell_active)) shell_active = atomic_kind%shell_active
     201   144285522 :       IF (PRESENT(damping)) damping => atomic_kind%damping
     202             : 
     203   144285522 :    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     1026997 :    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     1026997 :       my_natom = 0
     235     3449853 :       DO ikind = 1, SIZE(atomic_kind_set)
     236     3449853 :          my_natom = my_natom + atomic_kind_set(ikind)%natom
     237             :       END DO
     238             : 
     239     1026997 :       IF (PRESENT(maxatom)) maxatom = 0
     240     1026997 :       IF (PRESENT(natom)) natom = my_natom
     241     1026997 :       IF (PRESENT(nshell)) nshell = 0
     242     1026997 :       IF (PRESENT(shell_present)) shell_present = .FALSE.
     243     1026997 :       IF (PRESENT(shell_adiabatic)) shell_adiabatic = .FALSE.
     244     1026997 :       IF (PRESENT(shell_check_distance)) shell_check_distance = .FALSE.
     245     1026997 :       IF (PRESENT(damping_present)) damping_present = .FALSE.
     246     1026997 :       IF (PRESENT(atom_of_kind)) THEN
     247      526956 :          ALLOCATE (atom_of_kind(my_natom))
     248     1263505 :          atom_of_kind(:) = 0
     249             :       END IF
     250     1026997 :       IF (PRESENT(kind_of)) THEN
     251     1116738 :          ALLOCATE (kind_of(my_natom))
     252     1941766 :          kind_of(:) = 0
     253             :       END IF
     254     1026997 :       IF (PRESENT(natom_of_kind)) THEN
     255       13785 :          ALLOCATE (natom_of_kind(SIZE(atomic_kind_set)))
     256       13365 :          natom_of_kind(:) = 0
     257             :       END IF
     258             : 
     259     3449853 :       DO ikind = 1, SIZE(atomic_kind_set)
     260     1026997 :          ASSOCIATE (atomic_kind => atomic_kind_set(ikind))
     261     2422856 :             IF (PRESENT(maxatom)) THEN
     262      104649 :                maxatom = MAX(maxatom, atomic_kind%natom)
     263             :             END IF
     264     2422856 :             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     2422856 :             IF (PRESENT(shell_present)) THEN
     270      854443 :                IF (ASSOCIATED(atomic_kind%shell)) THEN
     271       50872 :                   shell_present = .TRUE.
     272             :                END IF
     273             :             END IF
     274     2422856 :             IF (PRESENT(shell_adiabatic) .AND. ASSOCIATED(atomic_kind%shell)) THEN
     275       55920 :                IF (.NOT. shell_adiabatic) THEN
     276       31724 :                   shell_adiabatic = (atomic_kind%shell%massfrac /= 0.0_dp)
     277             :                END IF
     278             :             END IF
     279     2422856 :             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     2422856 :             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     2422856 :             IF (PRESENT(atom_of_kind)) THEN
     290     1454477 :                DO iatom = 1, atomic_kind%natom
     291     1087853 :                   atom_a = atomic_kind%atom_list(iatom)
     292     1454477 :                   atom_of_kind(atom_a) = iatom
     293             :                END DO
     294             :             END IF
     295     2422856 :             IF (PRESENT(kind_of)) THEN
     296     2322520 :                DO iatom = 1, atomic_kind%natom
     297     1569520 :                   atom_a = atomic_kind%atom_list(iatom)
     298     2322520 :                   kind_of(atom_a) = ikind
     299             :                END DO
     300             :             END IF
     301     4845712 :             IF (PRESENT(natom_of_kind)) THEN
     302        8770 :                natom_of_kind(ikind) = atomic_kind%natom
     303             :             END IF
     304             :          END ASSOCIATE
     305             :       END DO
     306             : 
     307     1026997 :    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       91018 :    SUBROUTINE set_atomic_kind(atomic_kind, element_symbol, name, mass, kind_number, &
     324       31578 :                               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       91018 :       IF (PRESENT(element_symbol)) atomic_kind%element_symbol = element_symbol
     341       91018 :       IF (PRESENT(name)) atomic_kind%name = name
     342       91018 :       IF (PRESENT(mass)) atomic_kind%mass = mass
     343       91018 :       IF (PRESENT(kind_number)) atomic_kind%kind_number = kind_number
     344       91018 :       IF (PRESENT(natom)) atomic_kind%natom = natom
     345       91018 :       IF (PRESENT(atom_list)) THEN
     346       31578 :          n = SIZE(atom_list)
     347       31578 :          IF (n > 0) THEN
     348       31578 :             IF (ASSOCIATED(atomic_kind%atom_list)) THEN
     349           0 :                DEALLOCATE (atomic_kind%atom_list)
     350             :             END IF
     351       94734 :             ALLOCATE (atomic_kind%atom_list(n))
     352      994541 :             atomic_kind%atom_list(:) = atom_list(:)
     353       31578 :             atomic_kind%natom = n
     354             :          ELSE
     355           0 :             CPABORT("An invalid atom_list was supplied")
     356             :          END IF
     357             :       END IF
     358       91018 :       IF (PRESENT(fist_potential)) atomic_kind%fist_potential => fist_potential
     359       91018 :       IF (PRESENT(shell)) THEN
     360         450 :          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         450 :          atomic_kind%shell => shell
     366             :       END IF
     367       91018 :       IF (PRESENT(shell_active)) atomic_kind%shell_active = shell_active
     368             : 
     369       91018 :       IF (PRESENT(damping)) atomic_kind%damping => damping
     370             : 
     371       91018 :    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     1900392 :    ELEMENTAL FUNCTION is_hydrogen(atomic_kind) RESULT(res)
     380             :       TYPE(atomic_kind_type), INTENT(IN)                 :: atomic_kind
     381             :       LOGICAL                                            :: res
     382             : 
     383     1900392 :       res = TRIM(atomic_kind%element_symbol) == "H"
     384     1900392 :    END FUNCTION is_hydrogen
     385             : 
     386           0 : END MODULE atomic_kind_types