LCOV - code coverage report
Current view: top level - src/subsys - particle_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:20fe009) Lines: 57 73 78.1 %
Date: 2022-07-05 19:56:53 Functions: 5 6 83.3 %

          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 data structure for the particle information.
      10             : !> \par History
      11             : !>      - Atomic kind added in particle_type (MK,08.01.2002)
      12             : !>      - Functionality for particle_type added (MK,14.01.2002)
      13             : !>      - Allow for general coordinate input (MK,13.09.2003)
      14             : !>      - Molecule concept introduced (MK,26.09.2003)
      15             : !>      - Last atom information added (jgh,23.05.2004)
      16             : !>      - particle_type cleaned (MK,03.02.2005)
      17             : !> \author CJM, MK
      18             : ! **************************************************************************************************
      19             : MODULE particle_types
      20             :    USE atomic_kind_types,               ONLY: atomic_kind_type
      21             :    USE kinds,                           ONLY: dp
      22             :    USE message_passing,                 ONLY: mp_sum
      23             : #include "../base/base_uses.f90"
      24             : 
      25             :    IMPLICIT NONE
      26             : 
      27             :    PRIVATE
      28             : 
      29             :    ! Global parameters (in this module)
      30             : 
      31             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'particle_types'
      32             : 
      33             :    ! Data types
      34             : ! **************************************************************************************************
      35             :    TYPE particle_type
      36             :       TYPE(atomic_kind_type), POINTER       :: atomic_kind => Null() ! atomic kind information
      37             :       REAL(KIND=dp), DIMENSION(3)           :: f = 0.0_dp, & ! force
      38             :                                                r = 0.0_dp, & ! position
      39             :                                                v = 0.0_dp ! velocity
      40             :       ! Particle dependent terms for shell-model
      41             :       INTEGER                               :: atom_index = -1, &
      42             :                                                t_region_index = -1, &
      43             :                                                shell_index = -1
      44             :    END TYPE particle_type
      45             : 
      46             :    ! Public data types
      47             : 
      48             :    PUBLIC :: particle_type
      49             : 
      50             :    ! Public subroutines
      51             : 
      52             :    PUBLIC :: allocate_particle_set, &
      53             :              deallocate_particle_set, &
      54             :              update_particle_set, &
      55             :              update_particle_pos_or_vel, &
      56             :              get_particle_pos_or_vel
      57             : 
      58             : CONTAINS
      59             : 
      60             : ! **************************************************************************************************
      61             : !> \brief   Allocate a particle set.
      62             : !> \param particle_set ...
      63             : !> \param nparticle ...
      64             : !> \date    14.01.2002
      65             : !> \author  MK
      66             : !> \version 1.0
      67             : ! **************************************************************************************************
      68       16988 :    SUBROUTINE allocate_particle_set(particle_set, nparticle)
      69             :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      70             :       INTEGER, INTENT(IN)                                :: nparticle
      71             : 
      72             :       INTEGER                                            :: iparticle
      73             : 
      74       16988 :       IF (ASSOCIATED(particle_set)) THEN
      75           0 :          CALL deallocate_particle_set(particle_set)
      76             :       END IF
      77     1236654 :       ALLOCATE (particle_set(nparticle))
      78             : 
      79     1015810 :       DO iparticle = 1, nparticle
      80      998822 :          NULLIFY (particle_set(iparticle)%atomic_kind)
      81     3995288 :          particle_set(iparticle)%f(:) = 0.0_dp
      82     3995288 :          particle_set(iparticle)%r(:) = 0.0_dp
      83     3995288 :          particle_set(iparticle)%v(:) = 0.0_dp
      84      998822 :          particle_set(iparticle)%shell_index = 0
      85      998822 :          particle_set(iparticle)%atom_index = 0
      86     1015810 :          particle_set(iparticle)%t_region_index = 0
      87             :       END DO
      88             : 
      89       16988 :    END SUBROUTINE allocate_particle_set
      90             : 
      91             : ! **************************************************************************************************
      92             : !> \brief   Deallocate a particle set.
      93             : !> \param particle_set ...
      94             : !> \date    14.01.2002
      95             : !> \author  MK
      96             : !> \version 1.0
      97             : ! **************************************************************************************************
      98       16988 :    SUBROUTINE deallocate_particle_set(particle_set)
      99             :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
     100             : 
     101       16988 :       IF (ASSOCIATED(particle_set)) THEN
     102       16988 :          DEALLOCATE (particle_set)
     103             :       ELSE
     104             :          CALL cp_abort(__LOCATION__, &
     105             :                        "The pointer particle_set is not associated and "// &
     106           0 :                        "cannot be deallocated")
     107             :       END IF
     108             : 
     109       16988 :    END SUBROUTINE deallocate_particle_set
     110             : 
     111             : ! **************************************************************************************************
     112             : !> \brief ...
     113             : !> \param particle_set ...
     114             : !> \param int_group ...
     115             : !> \param pos ...
     116             : !> \param vel ...
     117             : !> \param for ...
     118             : !> \param add ...
     119             : ! **************************************************************************************************
     120       96746 :    SUBROUTINE update_particle_set(particle_set, int_group, pos, vel, for, add)
     121             : 
     122             :       TYPE(particle_type), INTENT(INOUT)                 :: particle_set(:)
     123             :       INTEGER, INTENT(IN)                                :: int_group
     124             :       REAL(KIND=dp), INTENT(INOUT), OPTIONAL             :: pos(:, :), vel(:, :), for(:, :)
     125             :       LOGICAL, INTENT(IN), OPTIONAL                      :: add
     126             : 
     127             :       CHARACTER(len=*), PARAMETER :: routineN = 'update_particle_set'
     128             : 
     129             :       INTEGER                                            :: handle, iparticle, nparticle
     130             :       LOGICAL                                            :: my_add, update_for, update_pos, &
     131             :                                                             update_vel
     132             : 
     133       96746 :       CALL timeset(routineN, handle)
     134             : 
     135       96746 :       nparticle = SIZE(particle_set)
     136       96746 :       update_pos = PRESENT(pos)
     137       96746 :       update_vel = PRESENT(vel)
     138       96746 :       update_for = PRESENT(for)
     139       96746 :       my_add = .FALSE.
     140       96746 :       IF (PRESENT(add)) my_add = add
     141             : 
     142       96746 :       IF (update_pos) THEN
     143       47075 :          CALL mp_sum(pos, int_group)
     144       47075 :          IF (my_add) THEN
     145           0 :             DO iparticle = 1, nparticle
     146           0 :                particle_set(iparticle)%r(:) = particle_set(iparticle)%r(:) + pos(:, iparticle)
     147             :             END DO
     148             :          ELSE
     149     6218441 :             DO iparticle = 1, nparticle
     150    24732539 :                particle_set(iparticle)%r(:) = pos(:, iparticle)
     151             :             END DO
     152             :          END IF
     153             :       END IF
     154       96746 :       IF (update_vel) THEN
     155       48141 :          CALL mp_sum(vel, int_group)
     156       48141 :          IF (my_add) THEN
     157           0 :             DO iparticle = 1, nparticle
     158           0 :                particle_set(iparticle)%v(:) = particle_set(iparticle)%v(:) + vel(:, iparticle)
     159             :             END DO
     160             :          ELSE
     161     6203045 :             DO iparticle = 1, nparticle
     162    24667757 :                particle_set(iparticle)%v(:) = vel(:, iparticle)
     163             :             END DO
     164             :          END IF
     165             :       END IF
     166       96746 :       IF (update_for) THEN
     167        1530 :          CALL mp_sum(for, int_group)
     168        1530 :          IF (my_add) THEN
     169       17772 :             DO iparticle = 1, nparticle
     170       66498 :                particle_set(iparticle)%f(:) = particle_set(iparticle)%f(:) + for(:, iparticle)
     171             :             END DO
     172             :          ELSE
     173           0 :             DO iparticle = 1, nparticle
     174           0 :                particle_set(iparticle)%f(:) = for(:, iparticle)
     175             :             END DO
     176             :          END IF
     177             :       END IF
     178             : 
     179       96746 :       CALL timestop(handle)
     180             : 
     181       96746 :    END SUBROUTINE update_particle_set
     182             : 
     183             : ! **************************************************************************************************
     184             : !> \brief   Return the atomic position or velocity of atom iatom in x from a
     185             : !>          packed vector even if core-shell particles are present
     186             : !> \param iatom ...
     187             : !> \param particle_set ...
     188             : !> \param vector ...
     189             : !> \return ...
     190             : !> \date    25.11.2010
     191             : !> \author  Matthias Krack
     192             : !> \version 1.0
     193             : ! **************************************************************************************************
     194      375784 :    FUNCTION get_particle_pos_or_vel(iatom, particle_set, vector) RESULT(x)
     195             : 
     196             :       INTEGER, INTENT(IN)                                :: iatom
     197             :       TYPE(particle_type), DIMENSION(:), INTENT(IN)      :: particle_set
     198             :       REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: vector
     199             :       REAL(KIND=dp), DIMENSION(3)                        :: x
     200             : 
     201             :       INTEGER                                            :: ic, is
     202             :       REAL(KIND=dp)                                      :: fc, fs, mass
     203             : 
     204      375784 :       ic = 3*(iatom - 1)
     205      375784 :       IF (particle_set(iatom)%shell_index == 0) THEN
     206      739336 :          x(1:3) = vector(ic + 1:ic + 3)
     207             :       ELSE
     208      190950 :          is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
     209      190950 :          mass = particle_set(iatom)%atomic_kind%mass
     210      190950 :          fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
     211      190950 :          fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
     212      763800 :          x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
     213             :       END IF
     214             : 
     215      375784 :    END FUNCTION get_particle_pos_or_vel
     216             : 
     217             : ! **************************************************************************************************
     218             : !> \brief   Update the atomic position or velocity by x and return the updated
     219             : !>          atomic position or velocity in x even if core-shell particles are
     220             : !>          present
     221             : !> \param iatom ...
     222             : !> \param particle_set ...
     223             : !> \param x ...
     224             : !> \param vector ...
     225             : !> \date    26.11.2010
     226             : !> \author  Matthias Krack
     227             : !> \version 1.0
     228             : !> \note    particle-set is not changed, only the positions or velocities in
     229             : !>          the packed vector are updated
     230             : ! **************************************************************************************************
     231        1020 :    SUBROUTINE update_particle_pos_or_vel(iatom, particle_set, x, vector)
     232             : 
     233             :       INTEGER, INTENT(IN)                                :: iatom
     234             :       TYPE(particle_type), DIMENSION(:), INTENT(IN)      :: particle_set
     235             :       REAL(KIND=dp), DIMENSION(3), INTENT(INOUT)         :: x
     236             :       REAL(KIND=dp), DIMENSION(:), INTENT(INOUT)         :: vector
     237             : 
     238             :       INTEGER                                            :: ic, is
     239             :       REAL(KIND=dp)                                      :: fc, fs, mass
     240             : 
     241        1020 :       ic = 3*(iatom - 1)
     242        1020 :       IF (particle_set(iatom)%shell_index == 0) THEN
     243        4080 :          vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
     244        4080 :          x(1:3) = vector(ic + 1:ic + 3)
     245             :       ELSE
     246           0 :          is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
     247           0 :          mass = particle_set(iatom)%atomic_kind%mass
     248           0 :          fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
     249           0 :          fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
     250           0 :          vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
     251           0 :          vector(is + 1:is + 3) = vector(is + 1:is + 3) + x(1:3)
     252           0 :          x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
     253             :       END IF
     254             : 
     255        1020 :    END SUBROUTINE update_particle_pos_or_vel
     256             : 
     257           0 : END MODULE particle_types

Generated by: LCOV version 1.15