LCOV - code coverage report
Current view: top level - src/subsys - cp_subsys_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:20fe009) Lines: 212 292 72.6 %
Date: 2022-07-05 19:56:53 Functions: 6 8 75.0 %

          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 types that represent a subsys, i.e. a part of the system
      10             : !> \par History
      11             : !>      07.2003 created [fawzi]
      12             : !>      09.2007 cleaned [tlaino] - University of Zurich
      13             : !>      22.11.2010 pack/unpack particle routines added (MK)
      14             : !> \author Fawzi Mohamed
      15             : ! **************************************************************************************************
      16             : MODULE cp_subsys_types
      17             :    USE atomic_kind_list_types,          ONLY: atomic_kind_list_release,&
      18             :                                               atomic_kind_list_retain,&
      19             :                                               atomic_kind_list_type
      20             :    USE atomic_kind_types,               ONLY: atomic_kind_type
      21             :    USE atprop_types,                    ONLY: atprop_release,&
      22             :                                               atprop_type
      23             :    USE cell_types,                      ONLY: cell_release,&
      24             :                                               cell_retain,&
      25             :                                               cell_type,&
      26             :                                               real_to_scaled,&
      27             :                                               scaled_to_real
      28             :    USE colvar_types,                    ONLY: colvar_p_release,&
      29             :                                               colvar_p_type
      30             :    USE cp_para_env,                     ONLY: cp_para_env_release,&
      31             :                                               cp_para_env_retain
      32             :    USE cp_para_types,                   ONLY: cp_para_env_type
      33             :    USE cp_result_types,                 ONLY: cp_result_release,&
      34             :                                               cp_result_retain,&
      35             :                                               cp_result_type
      36             :    USE distribution_1d_types,           ONLY: distribution_1d_release,&
      37             :                                               distribution_1d_retain,&
      38             :                                               distribution_1d_type
      39             :    USE kinds,                           ONLY: dp
      40             :    USE molecule_kind_list_types,        ONLY: molecule_kind_list_release,&
      41             :                                               molecule_kind_list_retain,&
      42             :                                               molecule_kind_list_type
      43             :    USE molecule_kind_types,             ONLY: molecule_kind_type
      44             :    USE molecule_list_types,             ONLY: molecule_list_release,&
      45             :                                               molecule_list_retain,&
      46             :                                               molecule_list_type
      47             :    USE molecule_types,                  ONLY: deallocate_global_constraint,&
      48             :                                               global_constraint_type,&
      49             :                                               molecule_type
      50             :    USE multipole_types,                 ONLY: multipole_type,&
      51             :                                               release_multipole_type,&
      52             :                                               retain_multipole_type
      53             :    USE particle_list_types,             ONLY: particle_list_release,&
      54             :                                               particle_list_retain,&
      55             :                                               particle_list_type
      56             :    USE particle_types,                  ONLY: particle_type
      57             :    USE virial_types,                    ONLY: virial_release,&
      58             :                                               virial_type
      59             : #include "../base/base_uses.f90"
      60             : 
      61             :    IMPLICIT NONE
      62             :    PRIVATE
      63             : 
      64             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_subsys_types'
      65             :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .FALSE.
      66             : 
      67             :    PUBLIC :: cp_subsys_type, &
      68             :              cp_subsys_p_type
      69             : 
      70             :    PUBLIC :: cp_subsys_retain, &
      71             :              cp_subsys_release, &
      72             :              cp_subsys_get, &
      73             :              cp_subsys_set, &
      74             :              pack_subsys_particles, &
      75             :              unpack_subsys_particles
      76             : 
      77             : ! **************************************************************************************************
      78             : !> \brief represents a system: atoms, molecules, their pos,vel,...
      79             : !> \param atomic_kinds list with all the kinds in the actual subsys
      80             : !> \param particles list with the particles of the actual subsys
      81             : !> \param local_particles the particles that are local to the actual processor
      82             : !> \param molecule_kinds list with the molecule kinds
      83             : !> \param local_molecules the molecule structures of the actual subsys
      84             : !>        that are local to this processor
      85             : !> \param para_env the parallel environment of the actual subsys
      86             : !> \param shell_particles list with the shells of the actual subsys if shell-model is used
      87             : !> \param core_particles list with the shells of the actual subsys if shell-model is used
      88             : !> \par History
      89             : !>      07.2003 created [fawzi]
      90             : !> \author Fawzi Mohamed
      91             : ! **************************************************************************************************
      92             :    TYPE cp_subsys_type
      93             :       INTEGER                                    :: ref_count = 1
      94             :       REAL(KIND=dp), DIMENSION(3, 2)             :: seed
      95             :       TYPE(atomic_kind_list_type), POINTER       :: atomic_kinds => Null()
      96             :       TYPE(particle_list_type), POINTER          :: particles => Null()
      97             :       TYPE(particle_list_type), POINTER          :: shell_particles => Null()
      98             :       TYPE(particle_list_type), POINTER          :: core_particles => Null()
      99             :       TYPE(distribution_1d_type), POINTER        :: local_particles => Null()
     100             :       TYPE(cp_para_env_type), POINTER            :: para_env => Null()
     101             :       ! molecules kinds
     102             :       TYPE(molecule_list_type), POINTER          :: molecules => Null()
     103             :       TYPE(molecule_kind_list_type), POINTER     :: molecule_kinds => Null()
     104             :       TYPE(distribution_1d_type), POINTER        :: local_molecules => Null()
     105             :       ! Definitions of the collective variables
     106             :       TYPE(colvar_p_type), DIMENSION(:), POINTER :: colvar_p => Null()
     107             :       ! Intermolecular constraints
     108             :       TYPE(global_constraint_type), POINTER      :: gci => Null()
     109             :       ! Multipoles
     110             :       TYPE(multipole_type), POINTER              :: multipoles => Null()
     111             :       TYPE(atprop_type), POINTER                 :: atprop => Null()
     112             :       TYPE(virial_type), POINTER                 :: virial => Null()
     113             :       TYPE(cp_result_type), POINTER              :: results => Null()
     114             :       TYPE(cell_type), POINTER                   :: cell => Null()
     115             :    END TYPE cp_subsys_type
     116             : 
     117             : ! **************************************************************************************************
     118             : !> \brief represent a pointer to a subsys, to be able to create arrays
     119             : !>      of pointers
     120             : !> \param subsys the pointer to the subsys
     121             : !> \par History
     122             : !>      07.2003 created [fawzi]
     123             : !> \author Fawzi Mohamed
     124             : ! **************************************************************************************************
     125             :    TYPE cp_subsys_p_type
     126             :       TYPE(cp_subsys_type), POINTER :: subsys
     127             :    END TYPE cp_subsys_p_type
     128             : 
     129             : CONTAINS
     130             : 
     131             : ! **************************************************************************************************
     132             : !> \brief retains a subsys (see doc/ReferenceCounting.html)
     133             : !> \param subsys the subsys to retain
     134             : !> \par History
     135             : !>      07.2003 created [fawzi]
     136             : !> \author Fawzi Mohamed
     137             : ! **************************************************************************************************
     138        8585 :    SUBROUTINE cp_subsys_retain(subsys)
     139             :       TYPE(cp_subsys_type), POINTER                      :: subsys
     140             : 
     141        8585 :       CPASSERT(ASSOCIATED(subsys))
     142        8585 :       CPASSERT(subsys%ref_count > 0)
     143        8585 :       subsys%ref_count = subsys%ref_count + 1
     144        8585 :    END SUBROUTINE cp_subsys_retain
     145             : 
     146             : ! **************************************************************************************************
     147             : !> \brief releases a subsys (see doc/ReferenceCounting.html)
     148             : !> \param subsys the subsys to release
     149             : !> \par History
     150             : !>      07.2003 created [fawzi]
     151             : !> \author Fawzi Mohamed
     152             : ! **************************************************************************************************
     153       25753 :    SUBROUTINE cp_subsys_release(subsys)
     154             :       TYPE(cp_subsys_type), POINTER                      :: subsys
     155             : 
     156       25753 :       IF (ASSOCIATED(subsys)) THEN
     157       17168 :          CPASSERT(subsys%ref_count > 0)
     158       17168 :          subsys%ref_count = subsys%ref_count - 1
     159       17168 :          IF (subsys%ref_count == 0) THEN
     160        8583 :             CALL atomic_kind_list_release(subsys%atomic_kinds)
     161        8583 :             CALL particle_list_release(subsys%particles)
     162        8583 :             CALL particle_list_release(subsys%shell_particles)
     163        8583 :             CALL particle_list_release(subsys%core_particles)
     164        8583 :             CALL distribution_1d_release(subsys%local_particles)
     165        8583 :             CALL molecule_kind_list_release(subsys%molecule_kinds)
     166        8583 :             CALL molecule_list_release(subsys%molecules)
     167        8583 :             CALL distribution_1d_release(subsys%local_molecules)
     168        8583 :             CALL cp_para_env_release(subsys%para_env)
     169        8583 :             CALL release_multipole_type(subsys%multipoles)
     170        8583 :             CALL colvar_p_release(subsys%colvar_p)
     171        8583 :             CALL deallocate_global_constraint(subsys%gci)
     172        8583 :             CALL atprop_release(subsys%atprop)
     173        8583 :             CALL virial_release(subsys%virial)
     174        8583 :             CALL cp_result_release(subsys%results)
     175        8583 :             CALL cell_release(subsys%cell)
     176        8583 :             DEALLOCATE (subsys)
     177             :          END IF
     178       17168 :          NULLIFY (subsys)
     179             :       END IF
     180       25753 :    END SUBROUTINE cp_subsys_release
     181             : 
     182             : ! **************************************************************************************************
     183             : !> \brief sets various propreties of the subsys
     184             : !> \param subsys the subsys you want to modify
     185             : !> \param atomic_kinds ...
     186             : !> \param particles ...
     187             : !> \param local_particles ...
     188             : !> \param molecules ...
     189             : !> \param molecule_kinds ...
     190             : !> \param local_molecules ...
     191             : !> \param para_env ...
     192             : !> \param colvar_p ...
     193             : !> \param shell_particles ...
     194             : !> \param core_particles ...
     195             : !> \param gci ...
     196             : !> \param multipoles ...
     197             : !> \param results ...
     198             : !> \param cell ...
     199             : !> \par History
     200             : !>      08.2003 created [fawzi]
     201             : !> \author Fawzi Mohamed
     202             : ! **************************************************************************************************
     203       69690 :    SUBROUTINE cp_subsys_set(subsys, atomic_kinds, particles, local_particles, &
     204             :                             molecules, molecule_kinds, local_molecules, para_env, &
     205             :                             colvar_p, shell_particles, core_particles, gci, multipoles, results, cell)
     206             :       TYPE(cp_subsys_type), INTENT(INOUT)                :: subsys
     207             :       TYPE(atomic_kind_list_type), OPTIONAL, POINTER     :: atomic_kinds
     208             :       TYPE(particle_list_type), OPTIONAL, POINTER        :: particles
     209             :       TYPE(distribution_1d_type), OPTIONAL, POINTER      :: local_particles
     210             :       TYPE(molecule_list_type), OPTIONAL, POINTER        :: molecules
     211             :       TYPE(molecule_kind_list_type), OPTIONAL, POINTER   :: molecule_kinds
     212             :       TYPE(distribution_1d_type), OPTIONAL, POINTER      :: local_molecules
     213             :       TYPE(cp_para_env_type), OPTIONAL, POINTER          :: para_env
     214             :       TYPE(colvar_p_type), DIMENSION(:), OPTIONAL, &
     215             :          POINTER                                         :: colvar_p
     216             :       TYPE(particle_list_type), OPTIONAL, POINTER        :: shell_particles, core_particles
     217             :       TYPE(global_constraint_type), OPTIONAL, POINTER    :: gci
     218             :       TYPE(multipole_type), OPTIONAL, POINTER            :: multipoles
     219             :       TYPE(cp_result_type), OPTIONAL, POINTER            :: results
     220             :       TYPE(cell_type), OPTIONAL, POINTER                 :: cell
     221             : 
     222       69690 :       CPASSERT(subsys%ref_count > 0)
     223       69690 :       IF (PRESENT(multipoles)) THEN
     224        2579 :          CALL retain_multipole_type(multipoles)
     225        2579 :          CALL release_multipole_type(subsys%multipoles)
     226        2579 :          subsys%multipoles => multipoles
     227             :       END IF
     228       69690 :       IF (PRESENT(atomic_kinds)) THEN
     229        8583 :          CALL atomic_kind_list_retain(atomic_kinds)
     230        8583 :          CALL atomic_kind_list_release(subsys%atomic_kinds)
     231        8583 :          subsys%atomic_kinds => atomic_kinds
     232             :       END IF
     233       69690 :       IF (PRESENT(particles)) THEN
     234       10583 :          CALL particle_list_retain(particles)
     235       10583 :          CALL particle_list_release(subsys%particles)
     236       10583 :          subsys%particles => particles
     237             :       END IF
     238       69690 :       IF (PRESENT(local_particles)) THEN
     239        8585 :          CALL distribution_1d_retain(local_particles)
     240        8585 :          CALL distribution_1d_release(subsys%local_particles)
     241        8585 :          subsys%local_particles => local_particles
     242             :       END IF
     243       69690 :       IF (PRESENT(local_molecules)) THEN
     244        8585 :          CALL distribution_1d_retain(local_molecules)
     245        8585 :          CALL distribution_1d_release(subsys%local_molecules)
     246        8585 :          subsys%local_molecules => local_molecules
     247             :       END IF
     248       69690 :       IF (PRESENT(molecule_kinds)) THEN
     249        8583 :          CALL molecule_kind_list_retain(molecule_kinds)
     250        8583 :          CALL molecule_kind_list_release(subsys%molecule_kinds)
     251        8583 :          subsys%molecule_kinds => molecule_kinds
     252             :       END IF
     253       69690 :       IF (PRESENT(molecules)) THEN
     254        8583 :          CALL molecule_list_retain(molecules)
     255        8583 :          CALL molecule_list_release(subsys%molecules)
     256        8583 :          subsys%molecules => molecules
     257             :       END IF
     258       69690 :       IF (PRESENT(para_env)) THEN
     259           0 :          CALL cp_para_env_retain(para_env)
     260           0 :          CALL cp_para_env_release(subsys%para_env)
     261           0 :          subsys%para_env => para_env
     262             :       END IF
     263       69690 :       IF (PRESENT(colvar_p)) THEN
     264           0 :          CPASSERT(.NOT. ASSOCIATED(subsys%colvar_p))
     265           0 :          subsys%colvar_p => colvar_p
     266             :       END IF
     267       69690 :       IF (PRESENT(shell_particles)) THEN
     268        2579 :          IF (ASSOCIATED(shell_particles)) THEN
     269         254 :             CALL particle_list_retain(shell_particles)
     270         254 :             CALL particle_list_release(subsys%shell_particles)
     271         254 :             subsys%shell_particles => shell_particles
     272             :          END IF
     273             :       END IF
     274       69690 :       IF (PRESENT(core_particles)) THEN
     275        2579 :          IF (ASSOCIATED(core_particles)) THEN
     276         254 :             CALL particle_list_retain(core_particles)
     277         254 :             CALL particle_list_release(subsys%core_particles)
     278         254 :             subsys%core_particles => core_particles
     279             :          END IF
     280             :       END IF
     281       69690 :       IF (PRESENT(gci)) THEN
     282           0 :          CPASSERT(.NOT. ASSOCIATED(subsys%gci))
     283           0 :          subsys%gci => gci
     284             :       END IF
     285       69690 :       IF (PRESENT(results)) THEN
     286        5102 :          IF (ASSOCIATED(results)) THEN
     287        5102 :             CALL cp_result_retain(results)
     288        5102 :             CALL cp_result_release(subsys%results)
     289        5102 :             subsys%results => results
     290             :          END IF
     291             :       END IF
     292       69690 :       IF (PRESENT(cell)) THEN
     293       24353 :          IF (ASSOCIATED(cell)) THEN
     294       24353 :             CALL cell_retain(cell)
     295       24353 :             CALL cell_release(subsys%cell)
     296       24353 :             subsys%cell => cell
     297             :          END IF
     298             :       END IF
     299       69690 :    END SUBROUTINE cp_subsys_set
     300             : 
     301             : ! **************************************************************************************************
     302             : !> \brief returns information about various attributes of the given subsys
     303             : !> \param subsys the subsys you want info about
     304             : !> \param ref_count ...
     305             : !> \param atomic_kinds ...
     306             : !> \param atomic_kind_set ...
     307             : !> \param particles ...
     308             : !> \param particle_set ...
     309             : !> \param local_particles ...
     310             : !> \param molecules ...
     311             : !> \param molecule_set ...
     312             : !> \param molecule_kinds ...
     313             : !> \param molecule_kind_set ...
     314             : !> \param local_molecules ...
     315             : !> \param para_env ...
     316             : !> \param colvar_p ...
     317             : !> \param shell_particles ...
     318             : !> \param core_particles ...
     319             : !> \param gci ...
     320             : !> \param multipoles ...
     321             : !> \param natom ...
     322             : !> \param nparticle ...
     323             : !> \param ncore ...
     324             : !> \param nshell ...
     325             : !> \param nkind ...
     326             : !> \param atprop ...
     327             : !> \param virial ...
     328             : !> \param results ...
     329             : !> \param cell ...
     330             : !> \par History
     331             : !>      08.2003 created [fawzi]
     332             : !>      22.11.2010 (MK)
     333             : !> \author Fawzi Mohamed
     334             : ! **************************************************************************************************
     335    11525146 :    SUBROUTINE cp_subsys_get(subsys, ref_count, atomic_kinds, atomic_kind_set, &
     336             :                             particles, particle_set, &
     337             :                             local_particles, molecules, molecule_set, molecule_kinds, &
     338             :                             molecule_kind_set, local_molecules, para_env, colvar_p, &
     339             :                             shell_particles, core_particles, gci, multipoles, &
     340             :                             natom, nparticle, ncore, nshell, nkind, atprop, virial, &
     341             :                             results, cell)
     342             :       TYPE(cp_subsys_type), INTENT(IN)                   :: subsys
     343             :       INTEGER, INTENT(out), OPTIONAL                     :: ref_count
     344             :       TYPE(atomic_kind_list_type), OPTIONAL, POINTER     :: atomic_kinds
     345             :       TYPE(atomic_kind_type), DIMENSION(:), OPTIONAL, &
     346             :          POINTER                                         :: atomic_kind_set
     347             :       TYPE(particle_list_type), OPTIONAL, POINTER        :: particles
     348             :       TYPE(particle_type), DIMENSION(:), OPTIONAL, &
     349             :          POINTER                                         :: particle_set
     350             :       TYPE(distribution_1d_type), OPTIONAL, POINTER      :: local_particles
     351             :       TYPE(molecule_list_type), OPTIONAL, POINTER        :: molecules
     352             :       TYPE(molecule_type), DIMENSION(:), OPTIONAL, &
     353             :          POINTER                                         :: molecule_set
     354             :       TYPE(molecule_kind_list_type), OPTIONAL, POINTER   :: molecule_kinds
     355             :       TYPE(molecule_kind_type), DIMENSION(:), OPTIONAL, &
     356             :          POINTER                                         :: molecule_kind_set
     357             :       TYPE(distribution_1d_type), OPTIONAL, POINTER      :: local_molecules
     358             :       TYPE(cp_para_env_type), OPTIONAL, POINTER          :: para_env
     359             :       TYPE(colvar_p_type), DIMENSION(:), OPTIONAL, &
     360             :          POINTER                                         :: colvar_p
     361             :       TYPE(particle_list_type), OPTIONAL, POINTER        :: shell_particles, core_particles
     362             :       TYPE(global_constraint_type), OPTIONAL, POINTER    :: gci
     363             :       TYPE(multipole_type), OPTIONAL, POINTER            :: multipoles
     364             :       INTEGER, INTENT(out), OPTIONAL                     :: natom, nparticle, ncore, nshell, nkind
     365             :       TYPE(atprop_type), OPTIONAL, POINTER               :: atprop
     366             :       TYPE(virial_type), OPTIONAL, POINTER               :: virial
     367             :       TYPE(cp_result_type), OPTIONAL, POINTER            :: results
     368             :       TYPE(cell_type), OPTIONAL, POINTER                 :: cell
     369             : 
     370             :       INTEGER                                            :: n_atom, n_core, n_shell
     371             : 
     372    11525146 :       n_atom = 0
     373    11525146 :       n_core = 0
     374    11525146 :       n_shell = 0
     375             : 
     376    11525146 :       CPASSERT(subsys%ref_count > 0)
     377             : 
     378    11525146 :       IF (PRESENT(ref_count)) ref_count = subsys%ref_count
     379    11525146 :       IF (PRESENT(atomic_kinds)) atomic_kinds => subsys%atomic_kinds
     380    11525146 :       IF (PRESENT(atomic_kind_set)) atomic_kind_set => subsys%atomic_kinds%els
     381    11525146 :       IF (PRESENT(particles)) particles => subsys%particles
     382    11525146 :       IF (PRESENT(particle_set)) particle_set => subsys%particles%els
     383    11525146 :       IF (PRESENT(local_particles)) local_particles => subsys%local_particles
     384    11525146 :       IF (PRESENT(molecules)) molecules => subsys%molecules
     385    11525146 :       IF (PRESENT(molecule_set)) molecule_set => subsys%molecules%els
     386    11525146 :       IF (PRESENT(molecule_kinds)) molecule_kinds => subsys%molecule_kinds
     387    11525146 :       IF (PRESENT(molecule_kind_set)) molecule_kind_set => subsys%molecule_kinds%els
     388    11525146 :       IF (PRESENT(local_molecules)) local_molecules => subsys%local_molecules
     389    11525146 :       IF (PRESENT(para_env)) para_env => subsys%para_env
     390    11525146 :       IF (PRESENT(colvar_p)) colvar_p => subsys%colvar_p
     391    11525146 :       IF (PRESENT(shell_particles)) shell_particles => subsys%shell_particles
     392    11525146 :       IF (PRESENT(core_particles)) core_particles => subsys%core_particles
     393    11525146 :       IF (PRESENT(gci)) gci => subsys%gci
     394    11525146 :       IF (PRESENT(multipoles)) multipoles => subsys%multipoles
     395    11525146 :       IF (PRESENT(virial)) virial => subsys%virial
     396    11525146 :       IF (PRESENT(atprop)) atprop => subsys%atprop
     397    11525146 :       IF (PRESENT(results)) results => subsys%results
     398    11525146 :       IF (PRESENT(cell)) cell => subsys%cell
     399    11525146 :       IF (PRESENT(nkind)) nkind = SIZE(subsys%atomic_kinds%els)
     400             : 
     401    11525146 :       IF (PRESENT(natom) .OR. PRESENT(nparticle) .OR. PRESENT(nshell)) THEN
     402             :          ! An atomic particle set should be present in each subsystem at the moment
     403      593934 :          CPASSERT(ASSOCIATED(subsys%particles))
     404      593934 :          n_atom = subsys%particles%n_els
     405             :          ! Check if we have other kinds of particles in this subsystem
     406      593934 :          IF (ASSOCIATED(subsys%shell_particles)) THEN
     407       39276 :             n_shell = subsys%shell_particles%n_els
     408       39276 :             CPASSERT(ASSOCIATED(subsys%core_particles))
     409       39276 :             n_core = subsys%core_particles%n_els
     410             :             ! The same number of shell and core particles is assumed
     411       39276 :             CPASSERT(n_core == n_shell)
     412      554658 :          ELSE IF (ASSOCIATED(subsys%core_particles)) THEN
     413             :             ! This case should not occur at the moment
     414           0 :             CPASSERT(ASSOCIATED(subsys%shell_particles))
     415             :          ELSE
     416             :             n_core = 0
     417             :             n_shell = 0
     418             :          END IF
     419      593934 :          IF (PRESENT(natom)) natom = n_atom
     420      593934 :          IF (PRESENT(nparticle)) nparticle = n_atom + n_shell
     421      593934 :          IF (PRESENT(ncore)) ncore = n_core
     422      593934 :          IF (PRESENT(nshell)) nshell = n_shell
     423             :       END IF
     424             : 
     425    11525146 :    END SUBROUTINE cp_subsys_get
     426             : 
     427             : ! **************************************************************************************************
     428             : !> \brief   Pack components of a subsystem particle sets into a single vector
     429             : !> \param subsys ...
     430             : !> \param f ...
     431             : !> \param r ...
     432             : !> \param s ...
     433             : !> \param v ...
     434             : !> \param fscale ...
     435             : !> \param cell ...
     436             : !> \date    19.11.10
     437             : !> \author  Matthias Krack (MK)
     438             : !> \version 1.0
     439             : !> \note    It is assumed that f, r, s, or v are properly allocated already
     440             : ! **************************************************************************************************
     441       30185 :    SUBROUTINE pack_subsys_particles(subsys, f, r, s, v, fscale, cell)
     442             : 
     443             :       TYPE(cp_subsys_type), INTENT(IN)                   :: subsys
     444             :       REAL(KIND=dp), DIMENSION(:), INTENT(OUT), OPTIONAL :: f, r, s, v
     445             :       REAL(KIND=dp), INTENT(IN), OPTIONAL                :: fscale
     446             :       TYPE(cell_type), OPTIONAL, POINTER                 :: cell
     447             : 
     448             :       INTEGER                                            :: i, iatom, j, k, natom, nparticle, nsize, &
     449             :                                                             shell_index
     450             :       REAL(KIND=dp), DIMENSION(3)                        :: rs
     451             :       TYPE(particle_list_type), POINTER                  :: core_particles, particles, &
     452             :                                                             shell_particles
     453             : 
     454       30185 :       IF (PRESENT(s)) THEN
     455           0 :          CPASSERT(PRESENT(cell))
     456             :       END IF
     457             : 
     458       30185 :       NULLIFY (core_particles)
     459       30185 :       NULLIFY (particles)
     460       30185 :       NULLIFY (shell_particles)
     461             : 
     462             :       CALL cp_subsys_get(subsys, &
     463             :                          core_particles=core_particles, &
     464             :                          natom=natom, &
     465             :                          nparticle=nparticle, &
     466             :                          particles=particles, &
     467       30185 :                          shell_particles=shell_particles)
     468             : 
     469       30185 :       nsize = 3*nparticle
     470             : 
     471             :       ! Pack forces
     472             : 
     473       30185 :       IF (PRESENT(f)) THEN
     474       22448 :          CPASSERT((SIZE(f) >= nsize))
     475       22448 :          j = 0
     476     1078735 :          DO iatom = 1, natom
     477     1056287 :             shell_index = particles%els(iatom)%shell_index
     478     1078735 :             IF (shell_index == 0) THEN
     479     3121308 :                DO i = 1, 3
     480     2340981 :                   j = j + 1
     481     3121308 :                   f(j) = particles%els(iatom)%f(i)
     482             :                END DO
     483             :             ELSE
     484     1103840 :                DO i = 1, 3
     485      827880 :                   j = j + 1
     486     1103840 :                   f(j) = core_particles%els(shell_index)%f(i)
     487             :                END DO
     488      275960 :                k = 3*(natom + shell_index - 1)
     489     1103840 :                DO i = 1, 3
     490     1103840 :                   f(k + i) = shell_particles%els(shell_index)%f(i)
     491             :                END DO
     492             :             END IF
     493             :          END DO
     494     2417087 :          IF (PRESENT(fscale)) f(1:nsize) = fscale*f(1:nsize)
     495             :       END IF
     496             : 
     497             :       ! Pack coordinates
     498             : 
     499       30185 :       IF (PRESENT(r)) THEN
     500        7737 :          CPASSERT((SIZE(r) >= nsize))
     501        7737 :          j = 0
     502      180699 :          DO iatom = 1, natom
     503      172962 :             shell_index = particles%els(iatom)%shell_index
     504      180699 :             IF (shell_index == 0) THEN
     505      630312 :                DO i = 1, 3
     506      472734 :                   j = j + 1
     507      630312 :                   r(j) = particles%els(iatom)%r(i)
     508             :                END DO
     509             :             ELSE
     510       61536 :                DO i = 1, 3
     511       46152 :                   j = j + 1
     512       61536 :                   r(j) = core_particles%els(shell_index)%r(i)
     513             :                END DO
     514       15384 :                k = 3*(natom + shell_index - 1)
     515       61536 :                DO i = 1, 3
     516       61536 :                   r(k + i) = shell_particles%els(shell_index)%r(i)
     517             :                END DO
     518             :             END IF
     519             :          END DO
     520             :       END IF
     521             : 
     522             :       ! Pack as scaled coordinates
     523             : 
     524       30185 :       IF (PRESENT(s)) THEN
     525           0 :          CPASSERT((SIZE(s) >= nsize))
     526           0 :          CPASSERT(PRESENT(cell))
     527           0 :          j = 0
     528           0 :          DO iatom = 1, natom
     529           0 :             shell_index = particles%els(iatom)%shell_index
     530           0 :             IF (shell_index == 0) THEN
     531           0 :                CALL real_to_scaled(rs, particles%els(iatom)%r, cell)
     532           0 :                DO i = 1, 3
     533           0 :                   j = j + 1
     534           0 :                   s(j) = rs(i)
     535             :                END DO
     536             :             ELSE
     537           0 :                CALL real_to_scaled(rs, core_particles%els(shell_index)%r, cell)
     538           0 :                DO i = 1, 3
     539           0 :                   j = j + 1
     540           0 :                   s(j) = rs(i)
     541             :                END DO
     542           0 :                CALL real_to_scaled(rs, shell_particles%els(shell_index)%r, cell)
     543           0 :                k = 3*(natom + shell_index - 1)
     544           0 :                DO i = 1, 3
     545           0 :                   s(k + i) = rs(i)
     546             :                END DO
     547             :             END IF
     548             :          END DO
     549             :       END IF
     550             : 
     551             :       ! Pack velocities
     552             : 
     553       30185 :       IF (PRESENT(v)) THEN
     554           0 :          CPASSERT((SIZE(v) >= nsize))
     555           0 :          j = 0
     556           0 :          DO iatom = 1, natom
     557           0 :             shell_index = particles%els(iatom)%shell_index
     558           0 :             IF (shell_index == 0) THEN
     559           0 :                DO i = 1, 3
     560           0 :                   j = j + 1
     561           0 :                   v(j) = particles%els(iatom)%v(i)
     562             :                END DO
     563             :             ELSE
     564           0 :                DO i = 1, 3
     565           0 :                   j = j + 1
     566           0 :                   v(j) = core_particles%els(shell_index)%v(i)
     567             :                END DO
     568           0 :                k = 3*(natom + shell_index - 1)
     569           0 :                DO i = 1, 3
     570           0 :                   v(k + i) = shell_particles%els(shell_index)%v(i)
     571             :                END DO
     572             :             END IF
     573             :          END DO
     574             :       END IF
     575             : 
     576       30185 :    END SUBROUTINE pack_subsys_particles
     577             : 
     578             : ! **************************************************************************************************
     579             : !> \brief   Unpack components of a subsystem particle sets into a single vector
     580             : !> \param subsys ...
     581             : !> \param f ...
     582             : !> \param r ...
     583             : !> \param s ...
     584             : !> \param v ...
     585             : !> \param fscale ...
     586             : !> \param cell ...
     587             : !> \date    19.11.10
     588             : !> \author  Matthias Krack (MK)
     589             : !> \version 1.0
     590             : ! **************************************************************************************************
     591       41290 :    SUBROUTINE unpack_subsys_particles(subsys, f, r, s, v, fscale, cell)
     592             : 
     593             :       TYPE(cp_subsys_type), INTENT(IN)                   :: subsys
     594             :       REAL(KIND=dp), DIMENSION(:), INTENT(IN), OPTIONAL  :: f, r, s, v
     595             :       REAL(KIND=dp), INTENT(IN), OPTIONAL                :: fscale
     596             :       TYPE(cell_type), OPTIONAL, POINTER                 :: cell
     597             : 
     598             :       INTEGER                                            :: i, iatom, j, k, natom, nparticle, nsize, &
     599             :                                                             shell_index
     600             :       REAL(KIND=dp)                                      :: fc, fs, mass, my_fscale
     601             :       REAL(KIND=dp), DIMENSION(3)                        :: rs
     602             :       TYPE(particle_list_type), POINTER                  :: core_particles, particles, &
     603             :                                                             shell_particles
     604             : 
     605       41290 :       NULLIFY (core_particles)
     606       41290 :       NULLIFY (particles)
     607       41290 :       NULLIFY (shell_particles)
     608             : 
     609             :       CALL cp_subsys_get(subsys, &
     610             :                          core_particles=core_particles, &
     611             :                          natom=natom, &
     612             :                          nparticle=nparticle, &
     613             :                          particles=particles, &
     614       41290 :                          shell_particles=shell_particles)
     615             : 
     616       41290 :       nsize = 3*nparticle
     617             : 
     618             :       ! Unpack forces
     619             : 
     620       41290 :       IF (PRESENT(f)) THEN
     621           0 :          CPASSERT((SIZE(f) >= nsize))
     622           0 :          IF (PRESENT(fscale)) THEN
     623           0 :             my_fscale = fscale
     624             :          ELSE
     625             :             my_fscale = 1.0_dp
     626             :          END IF
     627           0 :          j = 0
     628           0 :          DO iatom = 1, natom
     629           0 :             shell_index = particles%els(iatom)%shell_index
     630           0 :             IF (shell_index == 0) THEN
     631           0 :                DO i = 1, 3
     632           0 :                   j = j + 1
     633           0 :                   particles%els(iatom)%f(i) = my_fscale*f(j)
     634             :                END DO
     635             :             ELSE
     636           0 :                DO i = 1, 3
     637           0 :                   j = j + 1
     638           0 :                   core_particles%els(shell_index)%f(i) = my_fscale*f(j)
     639             :                END DO
     640           0 :                k = 3*(natom + shell_index - 1)
     641           0 :                DO i = 1, 3
     642           0 :                   shell_particles%els(shell_index)%f(i) = my_fscale*f(k + i)
     643             :                END DO
     644             :             END IF
     645             :          END DO
     646             :       END IF
     647             : 
     648             :       ! Unpack coordinates
     649             : 
     650       41290 :       IF (PRESENT(r)) THEN
     651       41148 :          CPASSERT((SIZE(r) >= nsize))
     652       41148 :          j = 0
     653     1614810 :          DO iatom = 1, natom
     654     1573662 :             shell_index = particles%els(iatom)%shell_index
     655     1614810 :             IF (shell_index == 0) THEN
     656     5239752 :                DO i = 1, 3
     657     3929814 :                   j = j + 1
     658     5239752 :                   particles%els(iatom)%r(i) = r(j)
     659             :                END DO
     660             :             ELSE
     661     1054896 :                DO i = 1, 3
     662      791172 :                   j = j + 1
     663     1054896 :                   core_particles%els(shell_index)%r(i) = r(j)
     664             :                END DO
     665      263724 :                k = 3*(natom + shell_index - 1)
     666     1054896 :                DO i = 1, 3
     667     1054896 :                   shell_particles%els(shell_index)%r(i) = r(k + i)
     668             :                END DO
     669             :                ! Update atomic position due to core and shell motion
     670      263724 :                mass = particles%els(iatom)%atomic_kind%mass
     671      263724 :                fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass
     672      263724 :                fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass
     673             :                particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3) + &
     674     2109792 :                                              fs*shell_particles%els(shell_index)%r(1:3)
     675             :             END IF
     676             :          END DO
     677             :       END IF
     678             : 
     679             :       ! Unpack scaled coordinates
     680             : 
     681       41290 :       IF (PRESENT(s)) THEN
     682           0 :          CPASSERT((SIZE(s) >= nsize))
     683           0 :          CPASSERT(PRESENT(cell))
     684           0 :          j = 0
     685           0 :          DO iatom = 1, natom
     686           0 :             shell_index = particles%els(iatom)%shell_index
     687           0 :             IF (shell_index == 0) THEN
     688           0 :                DO i = 1, 3
     689           0 :                   j = j + 1
     690           0 :                   rs(i) = s(j)
     691             :                END DO
     692           0 :                CALL scaled_to_real(particles%els(iatom)%r, rs, cell)
     693             :             ELSE
     694           0 :                DO i = 1, 3
     695           0 :                   j = j + 1
     696           0 :                   rs(i) = s(j)
     697             :                END DO
     698           0 :                CALL scaled_to_real(core_particles%els(shell_index)%r, rs, cell)
     699           0 :                k = 3*(natom + shell_index - 1)
     700           0 :                DO i = 1, 3
     701           0 :                   rs(i) = s(k + i)
     702             :                END DO
     703           0 :                CALL scaled_to_real(shell_particles%els(shell_index)%r, rs, cell)
     704             :                ! Update atomic position due to core and shell motion
     705           0 :                mass = particles%els(iatom)%atomic_kind%mass
     706           0 :                fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass
     707           0 :                fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass
     708             :                particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3) + &
     709           0 :                                              fs*shell_particles%els(shell_index)%r(1:3)
     710             :             END IF
     711             :          END DO
     712             :       END IF
     713             : 
     714             :       ! Unpack velocities
     715             : 
     716       41290 :       IF (PRESENT(v)) THEN
     717         142 :          CPASSERT((SIZE(v) >= nsize))
     718         142 :          j = 0
     719       25104 :          DO iatom = 1, natom
     720       24962 :             shell_index = particles%els(iatom)%shell_index
     721       25104 :             IF (shell_index == 0) THEN
     722       98328 :                DO i = 1, 3
     723       73746 :                   j = j + 1
     724       98328 :                   particles%els(iatom)%v(i) = v(j)
     725             :                END DO
     726             :             ELSE
     727        1520 :                DO i = 1, 3
     728        1140 :                   j = j + 1
     729        1520 :                   core_particles%els(shell_index)%v(i) = v(j)
     730             :                END DO
     731         380 :                k = 3*(natom + shell_index - 1)
     732        1520 :                DO i = 1, 3
     733        1520 :                   shell_particles%els(shell_index)%v(i) = v(k + i)
     734             :                END DO
     735             :                ! Update atomic velocity due to core and shell motion
     736         380 :                mass = particles%els(iatom)%atomic_kind%mass
     737         380 :                fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass
     738         380 :                fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass
     739             :                particles%els(iatom)%v(1:3) = fc*core_particles%els(shell_index)%v(1:3) + &
     740        3040 :                                              fs*shell_particles%els(shell_index)%v(1:3)
     741             :             END IF
     742             :          END DO
     743             :       END IF
     744             : 
     745       41290 :    END SUBROUTINE unpack_subsys_particles
     746             : 
     747           0 : END MODULE cp_subsys_types

Generated by: LCOV version 1.15