Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief types that represent a quickstep subsys
      10             : !> \author Ole Schuett
      11             : ! **************************************************************************************************
      12             : MODULE qs_subsys_types
      13             :    USE atomic_kind_list_types,          ONLY: atomic_kind_list_type
      14             :    USE atomic_kind_types,               ONLY: atomic_kind_type
      15             :    USE atprop_types,                    ONLY: atprop_type
      16             :    USE cell_types,                      ONLY: cell_release,&
      17             :                                               cell_retain,&
      18             :                                               cell_type
      19             :    USE colvar_types,                    ONLY: colvar_p_type
      20             :    USE cp_result_types,                 ONLY: cp_result_type
      21             :    USE cp_subsys_types,                 ONLY: cp_subsys_get,&
      22             :                                               cp_subsys_release,&
      23             :                                               cp_subsys_retain,&
      24             :                                               cp_subsys_set,&
      25             :                                               cp_subsys_type
      26             :    USE distribution_1d_types,           ONLY: distribution_1d_type
      27             :    USE message_passing,                 ONLY: mp_para_env_type
      28             :    USE molecule_kind_list_types,        ONLY: molecule_kind_list_type
      29             :    USE molecule_kind_types,             ONLY: molecule_kind_type
      30             :    USE molecule_list_types,             ONLY: molecule_list_type
      31             :    USE molecule_types,                  ONLY: global_constraint_type,&
      32             :                                               molecule_type
      33             :    USE multipole_types,                 ONLY: multipole_type
      34             :    USE particle_list_types,             ONLY: particle_list_type
      35             :    USE particle_types,                  ONLY: particle_type
      36             :    USE qs_energy_types,                 ONLY: deallocate_qs_energy,&
      37             :                                               qs_energy_type
      38             :    USE qs_force_types,                  ONLY: deallocate_qs_force,&
      39             :                                               qs_force_type
      40             :    USE qs_kind_types,                   ONLY: deallocate_qs_kind_set,&
      41             :                                               qs_kind_type
      42             :    USE virial_types,                    ONLY: virial_type
      43             : #include "./base/base_uses.f90"
      44             : 
      45             :    IMPLICIT NONE
      46             :    PRIVATE
      47             : 
      48             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_subsys_types'
      49             : 
      50             :    PUBLIC :: qs_subsys_type
      51             : 
      52             :    PUBLIC :: qs_subsys_release, &
      53             :              qs_subsys_get, &
      54             :              qs_subsys_set
      55             : 
      56             :    TYPE qs_subsys_type
      57             :       PRIVATE
      58             :       INTEGER                                               :: nelectron_total = -1
      59             :       INTEGER                                               :: nelectron_spin(2) = -1
      60             :       TYPE(cp_subsys_type), POINTER                         :: cp_subsys => Null()
      61             :       TYPE(qs_kind_type), DIMENSION(:), POINTER             :: qs_kind_set => Null()
      62             :       TYPE(cell_type), POINTER                              :: cell_ref => Null()
      63             :       LOGICAL                                               :: use_ref_cell = .FALSE.
      64             :       TYPE(qs_energy_type), POINTER                         :: energy => Null()
      65             :       TYPE(qs_force_type), DIMENSION(:), POINTER            :: force => Null()
      66             :    END TYPE qs_subsys_type
      67             : 
      68             : CONTAINS
      69             : 
      70             : ! **************************************************************************************************
      71             : !> \brief releases a subsys (see doc/ReferenceCounting.html)
      72             : !> \param subsys the subsys to release
      73             : !> \author Ole Schuett
      74             : ! **************************************************************************************************
      75        6702 :    SUBROUTINE qs_subsys_release(subsys)
      76             :       TYPE(qs_subsys_type), INTENT(INOUT)                :: subsys
      77             : 
      78        6702 :       CALL cp_subsys_release(subsys%cp_subsys)
      79        6702 :       CALL cell_release(subsys%cell_ref)
      80        6702 :       IF (ASSOCIATED(subsys%qs_kind_set)) &
      81        6702 :          CALL deallocate_qs_kind_set(subsys%qs_kind_set)
      82        6702 :       IF (ASSOCIATED(subsys%energy)) &
      83        6702 :          CALL deallocate_qs_energy(subsys%energy)
      84        6702 :       IF (ASSOCIATED(subsys%force)) &
      85        2821 :          CALL deallocate_qs_force(subsys%force)
      86             : 
      87        6702 :    END SUBROUTINE qs_subsys_release
      88             : 
      89             : ! **************************************************************************************************
      90             : !> \brief ...
      91             : !> \param subsys ...
      92             : !> \param atomic_kinds ...
      93             : !> \param atomic_kind_set ...
      94             : !> \param particles ...
      95             : !> \param particle_set ...
      96             : !> \param local_particles ...
      97             : !> \param molecules ...
      98             : !> \param molecule_set ...
      99             : !> \param molecule_kinds ...
     100             : !> \param molecule_kind_set ...
     101             : !> \param local_molecules ...
     102             : !> \param para_env ...
     103             : !> \param colvar_p ...
     104             : !> \param shell_particles ...
     105             : !> \param core_particles ...
     106             : !> \param gci ...
     107             : !> \param multipoles ...
     108             : !> \param natom ...
     109             : !> \param nparticle ...
     110             : !> \param ncore ...
     111             : !> \param nshell ...
     112             : !> \param nkind ...
     113             : !> \param atprop ...
     114             : !> \param virial ...
     115             : !> \param results ...
     116             : !> \param cell ...
     117             : !> \param cell_ref ...
     118             : !> \param use_ref_cell ...
     119             : !> \param energy ...
     120             : !> \param force ...
     121             : !> \param qs_kind_set ...
     122             : !> \param cp_subsys ...
     123             : !> \param nelectron_total ...
     124             : !> \param nelectron_spin ...
     125             : ! **************************************************************************************************
     126     9463349 :    SUBROUTINE qs_subsys_get(subsys, atomic_kinds, atomic_kind_set, particles, particle_set, &
     127             :                             local_particles, molecules, molecule_set, &
     128             :                             molecule_kinds, molecule_kind_set, &
     129             :                             local_molecules, para_env, colvar_p, &
     130             :                             shell_particles, core_particles, gci, multipoles, &
     131             :                             natom, nparticle, ncore, nshell, nkind, atprop, virial, &
     132             :                             results, cell, cell_ref, use_ref_cell, energy, force, &
     133             :                             qs_kind_set, cp_subsys, nelectron_total, nelectron_spin)
     134             :       TYPE(qs_subsys_type), INTENT(IN)                   :: subsys
     135             :       TYPE(atomic_kind_list_type), OPTIONAL, POINTER     :: atomic_kinds
     136             :       TYPE(atomic_kind_type), DIMENSION(:), OPTIONAL, &
     137             :          POINTER                                         :: atomic_kind_set
     138             :       TYPE(particle_list_type), OPTIONAL, POINTER        :: particles
     139             :       TYPE(particle_type), DIMENSION(:), OPTIONAL, &
     140             :          POINTER                                         :: particle_set
     141             :       TYPE(distribution_1d_type), OPTIONAL, POINTER      :: local_particles
     142             :       TYPE(molecule_list_type), OPTIONAL, POINTER        :: molecules
     143             :       TYPE(molecule_type), DIMENSION(:), OPTIONAL, &
     144             :          POINTER                                         :: molecule_set
     145             :       TYPE(molecule_kind_list_type), OPTIONAL, POINTER   :: molecule_kinds
     146             :       TYPE(molecule_kind_type), DIMENSION(:), OPTIONAL, &
     147             :          POINTER                                         :: molecule_kind_set
     148             :       TYPE(distribution_1d_type), OPTIONAL, POINTER      :: local_molecules
     149             :       TYPE(mp_para_env_type), OPTIONAL, POINTER          :: para_env
     150             :       TYPE(colvar_p_type), DIMENSION(:), OPTIONAL, &
     151             :          POINTER                                         :: colvar_p
     152             :       TYPE(particle_list_type), OPTIONAL, POINTER        :: shell_particles, core_particles
     153             :       TYPE(global_constraint_type), OPTIONAL, POINTER    :: gci
     154             :       TYPE(multipole_type), OPTIONAL, POINTER            :: multipoles
     155             :       INTEGER, INTENT(out), OPTIONAL                     :: natom, nparticle, ncore, nshell, nkind
     156             :       TYPE(atprop_type), OPTIONAL, POINTER               :: atprop
     157             :       TYPE(virial_type), OPTIONAL, POINTER               :: virial
     158             :       TYPE(cp_result_type), OPTIONAL, POINTER            :: results
     159             :       TYPE(cell_type), OPTIONAL, POINTER                 :: cell, cell_ref
     160             :       LOGICAL, OPTIONAL                                  :: use_ref_cell
     161             :       TYPE(qs_energy_type), OPTIONAL, POINTER            :: energy
     162             :       TYPE(qs_force_type), DIMENSION(:), OPTIONAL, &
     163             :          POINTER                                         :: force
     164             :       TYPE(qs_kind_type), DIMENSION(:), OPTIONAL, &
     165             :          POINTER                                         :: qs_kind_set
     166             :       TYPE(cp_subsys_type), OPTIONAL, POINTER            :: cp_subsys
     167             :       INTEGER, OPTIONAL                                  :: nelectron_total
     168             :       INTEGER, DIMENSION(2), OPTIONAL                    :: nelectron_spin
     169             : 
     170             :       CALL cp_subsys_get(subsys%cp_subsys, &
     171             :                          atomic_kinds=atomic_kinds, &
     172             :                          atomic_kind_set=atomic_kind_set, &
     173             :                          particles=particles, &
     174             :                          particle_set=particle_set, &
     175             :                          local_particles=local_particles, &
     176             :                          molecules=molecules, &
     177             :                          molecule_set=molecule_set, &
     178             :                          molecule_kinds=molecule_kinds, &
     179             :                          molecule_kind_set=molecule_kind_set, &
     180             :                          local_molecules=local_molecules, &
     181             :                          para_env=para_env, &
     182             :                          colvar_p=colvar_p, &
     183             :                          shell_particles=shell_particles, &
     184             :                          core_particles=core_particles, &
     185             :                          gci=gci, &
     186             :                          multipoles=multipoles, &
     187             :                          natom=natom, &
     188             :                          nkind=nkind, &
     189             :                          nparticle=nparticle, &
     190             :                          ncore=ncore, &
     191             :                          nshell=nshell, &
     192             :                          atprop=atprop, &
     193             :                          virial=virial, &
     194             :                          results=results, &
     195     9463349 :                          cell=cell)
     196             : 
     197     9463349 :       IF (PRESENT(cell_ref)) cell_ref => subsys%cell_ref
     198     9463349 :       IF (PRESENT(use_ref_cell)) use_ref_cell = subsys%use_ref_cell
     199     9463349 :       IF (PRESENT(energy)) energy => subsys%energy
     200     9463349 :       IF (PRESENT(force)) force => subsys%force
     201     9463349 :       IF (PRESENT(qs_kind_set)) qs_kind_set => subsys%qs_kind_set
     202     9463349 :       IF (PRESENT(cp_subsys)) cp_subsys => subsys%cp_subsys
     203     9463349 :       IF (PRESENT(nelectron_total)) nelectron_total = subsys%nelectron_total
     204     9488909 :       IF (PRESENT(nelectron_spin)) nelectron_spin = subsys%nelectron_spin
     205     9463349 :    END SUBROUTINE qs_subsys_get
     206             : 
     207             : ! **************************************************************************************************
     208             : !> \brief ...
     209             : !> \param subsys ...
     210             : !> \param cp_subsys ...
     211             : !> \param local_particles ...
     212             : !> \param local_molecules ...
     213             : !> \param cell ...
     214             : !> \param cell_ref ...
     215             : !> \param use_ref_cell ...
     216             : !> \param energy ...
     217             : !> \param force ...
     218             : !> \param qs_kind_set ...
     219             : !> \param nelectron_total ...
     220             : !> \param nelectron_spin ...
     221             : ! **************************************************************************************************
     222       31861 :    SUBROUTINE qs_subsys_set(subsys, cp_subsys, &
     223             :                             local_particles, local_molecules, cell, &
     224             :                             cell_ref, use_ref_cell, energy, force, &
     225             :                             qs_kind_set, nelectron_total, nelectron_spin)
     226             :       TYPE(qs_subsys_type), INTENT(INOUT)                :: subsys
     227             :       TYPE(cp_subsys_type), OPTIONAL, POINTER            :: cp_subsys
     228             :       TYPE(distribution_1d_type), OPTIONAL, POINTER      :: local_particles, local_molecules
     229             :       TYPE(cell_type), OPTIONAL, POINTER                 :: cell, cell_ref
     230             :       LOGICAL, OPTIONAL                                  :: use_ref_cell
     231             :       TYPE(qs_energy_type), OPTIONAL, POINTER            :: energy
     232             :       TYPE(qs_force_type), DIMENSION(:), OPTIONAL, &
     233             :          POINTER                                         :: force
     234             :       TYPE(qs_kind_type), DIMENSION(:), OPTIONAL, &
     235             :          POINTER                                         :: qs_kind_set
     236             :       INTEGER, OPTIONAL                                  :: nelectron_total
     237             :       INTEGER, DIMENSION(2), OPTIONAL                    :: nelectron_spin
     238             : 
     239       31861 :       IF (PRESENT(cp_subsys)) THEN
     240        6702 :          CALL cp_subsys_retain(cp_subsys)
     241        6702 :          CALL cp_subsys_release(subsys%cp_subsys)
     242        6702 :          subsys%cp_subsys => cp_subsys
     243             :       END IF
     244             : 
     245             :       CALL cp_subsys_set(subsys%cp_subsys, &
     246             :                          local_particles=local_particles, &
     247             :                          local_molecules=local_molecules, &
     248       31861 :                          cell=cell)
     249             : 
     250       31861 :       IF (PRESENT(cell_ref)) THEN
     251       13388 :          CALL cell_retain(cell_ref)
     252       13388 :          CALL cell_release(subsys%cell_ref)
     253       13388 :          subsys%cell_ref => cell_ref
     254             :       END IF
     255             : 
     256       31861 :       IF (PRESENT(use_ref_cell)) subsys%use_ref_cell = use_ref_cell
     257       31861 :       IF (PRESENT(energy)) subsys%energy => energy
     258             :       ! if intels checking (-C) complains here, you have rediscovered a bug in the intel
     259             :       ! compiler (present in at least 10.0.025). A testcase has been submitted to intel.
     260       31861 :       IF (PRESENT(force)) subsys%force => force
     261       31861 :       IF (PRESENT(qs_kind_set)) subsys%qs_kind_set => qs_kind_set
     262       31861 :       IF (PRESENT(nelectron_total)) subsys%nelectron_total = nelectron_total
     263       51919 :       IF (PRESENT(nelectron_spin)) subsys%nelectron_spin = nelectron_spin
     264       31861 :    END SUBROUTINE qs_subsys_set
     265             : 
     266           0 : END MODULE qs_subsys_types