Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2022 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             :                                               shell_release,&
      34             :                                               shell_retain
      35             : #include "../base/base_uses.f90"
      36             : 
      37             :    IMPLICIT NONE
      38             : 
      39             :    PRIVATE
      40             : 
      41             :    ! Global parameters (only in this module)
      42             : 
      43             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'atomic_kind_types'
      44             : 
      45             : !> \brief Provides all information about an atomic kind
      46             : ! **************************************************************************************************
      47             :    TYPE atomic_kind_type
      48             :       TYPE(fist_potential_type), POINTER     :: fist_potential => Null()
      49             :       CHARACTER(LEN=default_string_length)   :: name = ""
      50             :       CHARACTER(LEN=2)                       :: element_symbol = ""
      51             :       REAL(KIND=dp)                          :: mass = 0.0_dp
      52             :       INTEGER                                :: kind_number = -1
      53             :       INTEGER                                :: natom = -1
      54             :       INTEGER, DIMENSION(:), POINTER         :: atom_list => Null()
      55             :       LOGICAL                                :: shell_active = .FALSE.
      56             :       TYPE(shell_kind_type), POINTER         :: shell => Null()
      57             :       TYPE(damping_p_type), POINTER          :: damping => Null()
      58             :    END TYPE atomic_kind_type
      59             : 
      60             : !> \brief Provides a vector of pointers of type atomic_kind_type
      61             : ! **************************************************************************************************
      62             :    TYPE atomic_kind_p_type
      63             :       TYPE(atomic_kind_type), DIMENSION(:), &
      64             :          POINTER                             :: atomic_kind_set
      65             :    END TYPE atomic_kind_p_type
      66             : 
      67             :    ! Public subroutines
      68             : 
      69             :    PUBLIC :: deallocate_atomic_kind_set, &
      70             :              get_atomic_kind, &
      71             :              get_atomic_kind_set, &
      72             :              set_atomic_kind, &
      73             :              is_hydrogen
      74             : 
      75             :    ! Public data types
      76             :    PUBLIC :: atomic_kind_type
      77             : 
      78             : CONTAINS
      79             : 
      80             : ! **************************************************************************************************
      81             : !> \brief   Destructor routine for a set of atomic kinds
      82             : !> \param atomic_kind_set ...
      83             : !> \date    02.01.2002
      84             : !> \author  Matthias Krack (MK)
      85             : !> \version 2.0
      86             : ! **************************************************************************************************
      87       15104 :    SUBROUTINE deallocate_atomic_kind_set(atomic_kind_set)
      88             : 
      89             :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      90             : 
      91             :       INTEGER                                            :: ikind, nkind
      92             : 
      93       15104 :       IF (.NOT. ASSOCIATED(atomic_kind_set)) THEN
      94             :          CALL cp_abort(__LOCATION__, &
      95             :                        "The pointer atomic_kind_set is not associated and "// &
      96           0 :                        "cannot be deallocated")
      97             :       END IF
      98             : 
      99       15104 :       nkind = SIZE(atomic_kind_set)
     100             : 
     101       44683 :       DO ikind = 1, nkind
     102       29579 :          IF (ASSOCIATED(atomic_kind_set(ikind)%fist_potential)) THEN
     103       11130 :             CALL deallocate_potential(atomic_kind_set(ikind)%fist_potential)
     104             :          END IF
     105       29579 :          IF (ASSOCIATED(atomic_kind_set(ikind)%atom_list)) THEN
     106       29566 :             DEALLOCATE (atomic_kind_set(ikind)%atom_list)
     107             :          END IF
     108       29579 :          CALL shell_release(atomic_kind_set(ikind)%shell)
     109             : 
     110       44683 :          CALL damping_p_release(atomic_kind_set(ikind)%damping)
     111             :       END DO
     112       15104 :       DEALLOCATE (atomic_kind_set)
     113       15104 :    END SUBROUTINE deallocate_atomic_kind_set
     114             : 
     115             : ! **************************************************************************************************
     116             : !> \brief Get attributes of an atomic kind.
     117             : !> \param atomic_kind ...
     118             : !> \param fist_potential ...
     119             : !> \param element_symbol ...
     120             : !> \param name ...
     121             : !> \param mass ...
     122             : !> \param kind_number ...
     123             : !> \param natom ...
     124             : !> \param atom_list ...
     125             : !> \param rcov ...
     126             : !> \param rvdw ...
     127             : !> \param z ...
     128             : !> \param qeff ...
     129             : !> \param apol ...
     130             : !> \param cpol ...
     131             : !> \param mm_radius ...
     132             : !> \param shell ...
     133             : !> \param shell_active ...
     134             : !> \param damping ...
     135             : ! **************************************************************************************************
     136   145477562 :    SUBROUTINE get_atomic_kind(atomic_kind, fist_potential, &
     137             :                               element_symbol, name, mass, kind_number, natom, atom_list, &
     138             :                               rcov, rvdw, z, qeff, apol, cpol, mm_radius, &
     139             :                               shell, shell_active, damping)
     140             : 
     141             :       TYPE(atomic_kind_type), INTENT(IN)                 :: atomic_kind
     142             :       TYPE(fist_potential_type), OPTIONAL, POINTER       :: fist_potential
     143             :       CHARACTER(LEN=2), INTENT(OUT), OPTIONAL            :: element_symbol
     144             :       CHARACTER(LEN=default_string_length), &
     145             :          INTENT(OUT), OPTIONAL                           :: name
     146             :       REAL(KIND=dp), INTENT(OUT), OPTIONAL               :: mass
     147             :       INTEGER, INTENT(OUT), OPTIONAL                     :: kind_number, natom
     148             :       INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: atom_list
     149             :       REAL(KIND=dp), INTENT(OUT), OPTIONAL               :: rcov, rvdw
     150             :       INTEGER, INTENT(OUT), OPTIONAL                     :: z
     151             :       REAL(KIND=dp), INTENT(OUT), OPTIONAL               :: qeff, apol, cpol, mm_radius
     152             :       TYPE(shell_kind_type), OPTIONAL, POINTER           :: shell
     153             :       LOGICAL, INTENT(OUT), OPTIONAL                     :: shell_active
     154             :       TYPE(damping_p_type), OPTIONAL, POINTER            :: damping
     155             : 
     156   145477562 :       IF (PRESENT(fist_potential)) fist_potential => atomic_kind%fist_potential
     157   145477562 :       IF (PRESENT(element_symbol)) element_symbol = atomic_kind%element_symbol
     158   145477562 :       IF (PRESENT(name)) name = atomic_kind%name
     159   145477562 :       IF (PRESENT(mass)) mass = atomic_kind%mass
     160   145477562 :       IF (PRESENT(kind_number)) kind_number = atomic_kind%kind_number
     161   145477562 :       IF (PRESENT(natom)) natom = atomic_kind%natom
     162   145477562 :       IF (PRESENT(atom_list)) atom_list => atomic_kind%atom_list
     163             : 
     164   145477562 :       IF (PRESENT(z)) THEN
     165      142816 :          CALL get_ptable_info(atomic_kind%element_symbol, number=z)
     166             :       END IF
     167   145477562 :       IF (PRESENT(rcov)) THEN
     168         340 :          CALL get_ptable_info(atomic_kind%element_symbol, covalent_radius=rcov)
     169             :       END IF
     170   145477562 :       IF (PRESENT(rvdw)) THEN
     171        6474 :          CALL get_ptable_info(atomic_kind%element_symbol, vdw_radius=rvdw)
     172             :       END IF
     173   145477562 :       IF (PRESENT(qeff)) THEN
     174    37266351 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     175    36631565 :             CALL get_potential(potential=atomic_kind%fist_potential, qeff=qeff)
     176             :          ELSE
     177      634786 :             qeff = -HUGE(0.0_dp)
     178             :          END IF
     179             :       END IF
     180   145477562 :       IF (PRESENT(apol)) THEN
     181        4112 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     182        4112 :             CALL get_potential(potential=atomic_kind%fist_potential, apol=apol)
     183             :          ELSE
     184           0 :             apol = -HUGE(0.0_dp)
     185             :          END IF
     186             :       END IF
     187   145477562 :       IF (PRESENT(cpol)) THEN
     188         820 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     189         820 :             CALL get_potential(potential=atomic_kind%fist_potential, cpol=cpol)
     190             :          ELSE
     191           0 :             cpol = -HUGE(0.0_dp)
     192             :          END IF
     193             :       END IF
     194   145477562 :       IF (PRESENT(mm_radius)) THEN
     195      542351 :          IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
     196      542351 :             CALL get_potential(potential=atomic_kind%fist_potential, mm_radius=mm_radius)
     197             :          ELSE
     198           0 :             mm_radius = -HUGE(0.0_dp)
     199             :          END IF
     200             :       END IF
     201   145477562 :       IF (PRESENT(shell)) shell => atomic_kind%shell
     202   145477562 :       IF (PRESENT(shell_active)) shell_active = atomic_kind%shell_active
     203   145477562 :       IF (PRESENT(damping)) damping => atomic_kind%damping
     204             : 
     205   145477562 :    END SUBROUTINE get_atomic_kind
     206             : 
     207             : ! **************************************************************************************************
     208             : !> \brief Get attributes of an atomic kind set.
     209             : !> \param atomic_kind_set ...
     210             : !> \param atom_of_kind ...
     211             : !> \param kind_of ...
     212             : !> \param natom_of_kind ...
     213             : !> \param maxatom ...
     214             : !> \param natom ...
     215             : !> \param nshell ...
     216             : !> \param fist_potential_present ...
     217             : !> \param shell_present ...
     218             : !> \param shell_adiabatic ...
     219             : !> \param shell_check_distance ...
     220             : !> \param damping_present ...
     221             : ! **************************************************************************************************
     222      777224 :    SUBROUTINE get_atomic_kind_set(atomic_kind_set, &
     223      777224 :                                   atom_of_kind, kind_of, natom_of_kind, &
     224             :                                   maxatom, &
     225             :                                   natom, &
     226             :                                   nshell, &
     227             :                                   fist_potential_present, &
     228             :                                   shell_present, shell_adiabatic, &
     229             :                                   shell_check_distance, &
     230             :                                   damping_present)
     231             : 
     232             :       TYPE(atomic_kind_type), DIMENSION(:), INTENT(IN)   :: atomic_kind_set
     233             :       INTEGER, DIMENSION(:), INTENT(OUT), OPTIONAL       :: atom_of_kind, kind_of, natom_of_kind
     234             :       INTEGER, INTENT(OUT), OPTIONAL                     :: maxatom, natom, nshell
     235             :       LOGICAL, INTENT(OUT), OPTIONAL                     :: fist_potential_present, shell_present, &
     236             :                                                             shell_adiabatic, shell_check_distance, &
     237             :                                                             damping_present
     238             : 
     239             :       INTEGER                                            :: atom_a, iatom, ikind, nkind
     240             :       TYPE(damping_p_type), POINTER                      :: damping
     241             :       TYPE(fist_potential_type), POINTER                 :: fist_potential
     242             :       TYPE(shell_kind_type), POINTER                     :: shell
     243             : 
     244      777224 :       IF (PRESENT(maxatom)) maxatom = 0
     245      777224 :       IF (PRESENT(natom)) natom = 0
     246      777224 :       IF (PRESENT(nshell)) nshell = 0
     247      777224 :       IF (PRESENT(shell_present)) shell_present = .FALSE.
     248      777224 :       IF (PRESENT(shell_adiabatic)) shell_adiabatic = .FALSE.
     249      777224 :       IF (PRESENT(shell_check_distance)) shell_check_distance = .FALSE.
     250      777224 :       IF (PRESENT(damping_present)) damping_present = .FALSE.
     251     1673991 :       IF (PRESENT(atom_of_kind)) atom_of_kind(:) = 0
     252     1962074 :       IF (PRESENT(kind_of)) kind_of(:) = 0
     253      788483 :       IF (PRESENT(natom_of_kind)) natom_of_kind(:) = 0
     254             : 
     255      777224 :       nkind = SIZE(atomic_kind_set)
     256     2707810 :       DO ikind = 1, nkind
     257      777224 :          ASSOCIATE (atomic_kind => atomic_kind_set(ikind))
     258             :             CALL get_atomic_kind(atomic_kind=atomic_kind, &
     259             :                                  fist_potential=fist_potential, &
     260             :                                  shell=shell, &
     261     1930586 :                                  damping=damping)
     262     1930586 :             IF (PRESENT(maxatom)) THEN
     263      100035 :                maxatom = MAX(maxatom, atomic_kind%natom)
     264             :             END IF
     265     1930586 :             IF (PRESENT(natom)) THEN
     266      165447 :                natom = natom + atomic_kind_set(ikind)%natom
     267             :             END IF
     268     1930586 :             IF (PRESENT(fist_potential_present)) THEN
     269           0 :                IF (ASSOCIATED(fist_potential)) THEN
     270           0 :                   fist_potential_present = .TRUE.
     271             :                END IF
     272             :             END IF
     273     1930586 :             IF (PRESENT(shell_present)) THEN
     274      840211 :                IF (ASSOCIATED(shell)) THEN
     275       48032 :                   shell_present = .TRUE.
     276             :                END IF
     277             :             END IF
     278     1930586 :             IF (PRESENT(shell_adiabatic) .AND. ASSOCIATED(shell)) THEN
     279       53072 :                IF (.NOT. shell_adiabatic) shell_adiabatic = (shell%massfrac /= 0.0_dp)
     280             :             END IF
     281     1930586 :             IF (PRESENT(shell_check_distance) .AND. ASSOCIATED(shell)) THEN
     282        6360 :                IF (.NOT. shell_check_distance) shell_check_distance = (shell%max_dist > 0.0_dp)
     283             :             END IF
     284     1930586 :             IF (PRESENT(damping_present)) THEN
     285           0 :                IF (ASSOCIATED(damping)) THEN
     286           0 :                   damping_present = .TRUE.
     287             :                END IF
     288             :             END IF
     289     1930586 :             IF (PRESENT(atom_of_kind)) THEN
     290     1036956 :                DO iatom = 1, atomic_kind%natom
     291      768038 :                   atom_a = atomic_kind%atom_list(iatom)
     292     1036956 :                   atom_of_kind(atom_a) = iatom
     293             :                END DO
     294             :             END IF
     295     1930586 :             IF (PRESENT(kind_of)) THEN
     296     1385404 :                DO iatom = 1, atomic_kind%natom
     297      999038 :                   atom_a = atomic_kind%atom_list(iatom)
     298     1385404 :                   kind_of(atom_a) = ikind
     299             :                END DO
     300             :             END IF
     301     3861172 :             IF (PRESENT(natom_of_kind)) THEN
     302        7396 :                natom_of_kind(ikind) = atomic_kind_set(ikind)%natom
     303             :             END IF
     304             :          END ASSOCIATE
     305             :       END DO
     306             : 
     307      777224 :    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       87437 :    SUBROUTINE set_atomic_kind(atomic_kind, element_symbol, name, mass, kind_number, &
     324       29566 :                               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       87437 :       IF (PRESENT(element_symbol)) atomic_kind%element_symbol = element_symbol
     341       87437 :       IF (PRESENT(name)) atomic_kind%name = name
     342       87437 :       IF (PRESENT(mass)) atomic_kind%mass = mass
     343       87437 :       IF (PRESENT(kind_number)) atomic_kind%kind_number = kind_number
     344       87437 :       IF (PRESENT(natom)) atomic_kind%natom = natom
     345       87437 :       IF (PRESENT(atom_list)) THEN
     346       29566 :          n = SIZE(atom_list)
     347       29566 :          IF (n > 0) THEN
     348       29566 :             IF (ASSOCIATED(atomic_kind%atom_list)) THEN
     349           0 :                DEALLOCATE (atomic_kind%atom_list)
     350             :             END IF
     351       88698 :             ALLOCATE (atomic_kind%atom_list(n))
     352      968497 :             atomic_kind%atom_list(:) = atom_list(:)
     353       29566 :             atomic_kind%natom = n
     354             :          ELSE
     355           0 :             CPABORT("An invalid atom_list was supplied")
     356             :          END IF
     357             :       END IF
     358       87437 :       IF (PRESENT(fist_potential)) atomic_kind%fist_potential => fist_potential
     359       87437 :       IF (PRESENT(shell)) THEN
     360         442 :          atomic_kind%shell => shell
     361         442 :          CALL shell_retain(shell)
     362             :       END IF
     363       87437 :       IF (PRESENT(shell_active)) atomic_kind%shell_active = shell_active
     364             : 
     365       87437 :       IF (PRESENT(damping)) atomic_kind%damping => damping
     366             : 
     367       87437 :    END SUBROUTINE set_atomic_kind
     368             : 
     369             : ! **************************************************************************************************
     370             : !> \brief Determines if the atomic_kind is HYDROGEN
     371             : !> \param atomic_kind ...
     372             : !> \return ...
     373             : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
     374             : ! **************************************************************************************************
     375     2732644 :    PURE FUNCTION is_hydrogen(atomic_kind) RESULT(res)
     376             :       TYPE(atomic_kind_type), INTENT(IN)                 :: atomic_kind
     377             :       LOGICAL                                            :: res
     378             : 
     379     2732644 :       res = TRIM(atomic_kind%element_symbol) == "H"
     380     2732644 :    END FUNCTION is_hydrogen
     381             : 
     382           0 : END MODULE atomic_kind_types