LCOV - code coverage report
Current view: top level - src/subsys - particle_types.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 76.6 % 64 49
Test Date: 2025-07-25 12:55:17 Functions: 83.3 % 6 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 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_comm_type
      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 = 0, &
      42              :                                                t_region_index = 0, &
      43              :                                                shell_index = 0
      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        20230 :    SUBROUTINE allocate_particle_set(particle_set, nparticle)
      69              :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      70              :       INTEGER, INTENT(IN)                                :: nparticle
      71              : 
      72        20230 :       IF (ASSOCIATED(particle_set)) THEN
      73            0 :          CALL deallocate_particle_set(particle_set)
      74              :       END IF
      75      1314776 :       ALLOCATE (particle_set(nparticle))
      76              : 
      77        20230 :    END SUBROUTINE allocate_particle_set
      78              : 
      79              : ! **************************************************************************************************
      80              : !> \brief   Deallocate a particle set.
      81              : !> \param particle_set ...
      82              : !> \date    14.01.2002
      83              : !> \author  MK
      84              : !> \version 1.0
      85              : ! **************************************************************************************************
      86        20230 :    SUBROUTINE deallocate_particle_set(particle_set)
      87              :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      88              : 
      89        20230 :       IF (ASSOCIATED(particle_set)) THEN
      90        20230 :          DEALLOCATE (particle_set)
      91              :          NULLIFY (particle_set)
      92              :       END IF
      93              : 
      94        20230 :    END SUBROUTINE deallocate_particle_set
      95              : 
      96              : ! **************************************************************************************************
      97              : !> \brief ...
      98              : !> \param particle_set ...
      99              : !> \param int_group ...
     100              : !> \param pos ...
     101              : !> \param vel ...
     102              : !> \param for ...
     103              : !> \param add ...
     104              : ! **************************************************************************************************
     105        92648 :    SUBROUTINE update_particle_set(particle_set, int_group, pos, vel, for, add)
     106              : 
     107              :       TYPE(particle_type), INTENT(INOUT)                 :: particle_set(:)
     108              : 
     109              :       CLASS(mp_comm_type), INTENT(IN)                     :: int_group
     110              :       REAL(KIND=dp), INTENT(INOUT), OPTIONAL             :: pos(:, :), vel(:, :), for(:, :)
     111              :       LOGICAL, INTENT(IN), OPTIONAL                      :: add
     112              : 
     113              :       CHARACTER(len=*), PARAMETER :: routineN = 'update_particle_set'
     114              : 
     115              :       INTEGER                                            :: handle, iparticle, nparticle
     116              :       LOGICAL                                            :: my_add, update_for, update_pos, &
     117              :                                                             update_vel
     118              : 
     119        92648 :       CALL timeset(routineN, handle)
     120              : 
     121        92648 :       nparticle = SIZE(particle_set)
     122        92648 :       update_pos = PRESENT(pos)
     123        92648 :       update_vel = PRESENT(vel)
     124        92648 :       update_for = PRESENT(for)
     125        92648 :       my_add = .FALSE.
     126        92648 :       IF (PRESENT(add)) my_add = add
     127              : 
     128        92648 :       IF (update_pos) THEN
     129     51567643 :          CALL int_group%sum(pos)
     130        45003 :          IF (my_add) THEN
     131            0 :             DO iparticle = 1, nparticle
     132            0 :                particle_set(iparticle)%r(:) = particle_set(iparticle)%r(:) + pos(:, iparticle)
     133              :             END DO
     134              :          ELSE
     135      6485333 :             DO iparticle = 1, nparticle
     136     25806323 :                particle_set(iparticle)%r(:) = pos(:, iparticle)
     137              :             END DO
     138              :          END IF
     139              :       END IF
     140        92648 :       IF (update_vel) THEN
     141     51438147 :          CALL int_group%sum(vel)
     142        46115 :          IF (my_add) THEN
     143            0 :             DO iparticle = 1, nparticle
     144            0 :                particle_set(iparticle)%v(:) = particle_set(iparticle)%v(:) + vel(:, iparticle)
     145              :             END DO
     146              :          ELSE
     147      6470119 :             DO iparticle = 1, nparticle
     148     25742131 :                particle_set(iparticle)%v(:) = vel(:, iparticle)
     149              :             END DO
     150              :          END IF
     151              :       END IF
     152        92648 :       IF (update_for) THEN
     153       131466 :          CALL int_group%sum(for)
     154         1530 :          IF (my_add) THEN
     155        17772 :             DO iparticle = 1, nparticle
     156        66498 :                particle_set(iparticle)%f(:) = particle_set(iparticle)%f(:) + for(:, iparticle)
     157              :             END DO
     158              :          ELSE
     159            0 :             DO iparticle = 1, nparticle
     160            0 :                particle_set(iparticle)%f(:) = for(:, iparticle)
     161              :             END DO
     162              :          END IF
     163              :       END IF
     164              : 
     165        92648 :       CALL timestop(handle)
     166              : 
     167        92648 :    END SUBROUTINE update_particle_set
     168              : 
     169              : ! **************************************************************************************************
     170              : !> \brief   Return the atomic position or velocity of atom iatom in x from a
     171              : !>          packed vector even if core-shell particles are present
     172              : !> \param iatom ...
     173              : !> \param particle_set ...
     174              : !> \param vector ...
     175              : !> \return ...
     176              : !> \date    25.11.2010
     177              : !> \author  Matthias Krack
     178              : !> \version 1.0
     179              : ! **************************************************************************************************
     180       357014 :    PURE FUNCTION get_particle_pos_or_vel(iatom, particle_set, vector) RESULT(x)
     181              : 
     182              :       INTEGER, INTENT(IN)                                :: iatom
     183              :       TYPE(particle_type), DIMENSION(:), INTENT(IN)      :: particle_set
     184              :       REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: vector
     185              :       REAL(KIND=dp), DIMENSION(3)                        :: x
     186              : 
     187              :       INTEGER                                            :: ic, is
     188              :       REAL(KIND=dp)                                      :: fc, fs, mass
     189              : 
     190       357014 :       ic = 3*(iatom - 1)
     191       357014 :       IF (particle_set(iatom)%shell_index == 0) THEN
     192       737216 :          x(1:3) = vector(ic + 1:ic + 3)
     193              :       ELSE
     194       172710 :          is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
     195       172710 :          mass = particle_set(iatom)%atomic_kind%mass
     196       172710 :          fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
     197       172710 :          fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
     198       690840 :          x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
     199              :       END IF
     200              : 
     201       357014 :    END FUNCTION get_particle_pos_or_vel
     202              : 
     203              : ! **************************************************************************************************
     204              : !> \brief   Update the atomic position or velocity by x and return the updated
     205              : !>          atomic position or velocity in x even if core-shell particles are
     206              : !>          present
     207              : !> \param iatom ...
     208              : !> \param particle_set ...
     209              : !> \param x ...
     210              : !> \param vector ...
     211              : !> \date    26.11.2010
     212              : !> \author  Matthias Krack
     213              : !> \version 1.0
     214              : !> \note    particle-set is not changed, only the positions or velocities in
     215              : !>          the packed vector are updated
     216              : ! **************************************************************************************************
     217         1020 :    PURE SUBROUTINE update_particle_pos_or_vel(iatom, particle_set, x, vector)
     218              : 
     219              :       INTEGER, INTENT(IN)                                :: iatom
     220              :       TYPE(particle_type), DIMENSION(:), INTENT(IN)      :: particle_set
     221              :       REAL(KIND=dp), DIMENSION(3), INTENT(INOUT)         :: x
     222              :       REAL(KIND=dp), DIMENSION(:), INTENT(INOUT)         :: vector
     223              : 
     224              :       INTEGER                                            :: ic, is
     225              :       REAL(KIND=dp)                                      :: fc, fs, mass
     226              : 
     227         1020 :       ic = 3*(iatom - 1)
     228         1020 :       IF (particle_set(iatom)%shell_index == 0) THEN
     229         4080 :          vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
     230         4080 :          x(1:3) = vector(ic + 1:ic + 3)
     231              :       ELSE
     232            0 :          is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1)
     233            0 :          mass = particle_set(iatom)%atomic_kind%mass
     234            0 :          fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass
     235            0 :          fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass
     236            0 :          vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3)
     237            0 :          vector(is + 1:is + 3) = vector(is + 1:is + 3) + x(1:3)
     238            0 :          x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3)
     239              :       END IF
     240              : 
     241         1020 :    END SUBROUTINE update_particle_pos_or_vel
     242              : 
     243            0 : END MODULE particle_types
        

Generated by: LCOV version 2.0-1