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 Define the neighbor list data types and the corresponding functionality
      10             : ! **************************************************************************************************
      11             : MODULE fist_neighbor_list_types
      12             : 
      13             :    USE cell_types,                      ONLY: cell_type,&
      14             :                                               pbc
      15             :    USE exclusion_types,                 ONLY: exclusion_type
      16             :    USE kinds,                           ONLY: dp
      17             :    USE memory_utilities,                ONLY: reallocate
      18             : #include "./base/base_uses.f90"
      19             : 
      20             :    IMPLICIT NONE
      21             : 
      22             :    PRIVATE
      23             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'fist_neighbor_list_types'
      24             : 
      25             : ! **************************************************************************************************
      26             :    TYPE neighbor_kind_pairs_type
      27             :       INTEGER, POINTER, DIMENSION(:, :)  :: list, ij_kind
      28             :       INTEGER, POINTER, DIMENSION(:)    :: id_kind
      29             :       INTEGER, POINTER, DIMENSION(:)    :: grp_kind_start, grp_kind_end
      30             :       INTEGER                           :: cell_vector(3), npairs
      31             :       INTEGER                           :: ngrp_kind
      32             :       REAL(KIND=dp)                     :: rmax
      33             :       ! The *_scale arrays are scaling factors for the corresponding nonbonding
      34             :       ! interaction energies and forces for the pairs in 'list'. To keep the size
      35             :       ! of these arrays small, pairs whose interaction must be scaled are moved
      36             :       ! to beginning of the array 'list'. nscale is the number of elements in
      37             :       ! *_scale that are effectively used. This way one does not have to
      38             :       ! reallocate the *_scale arrays for every new scaled pair interaction.
      39             :       ! The field is_info is only used to switch between the regular nonbonded
      40             :       ! and the nonbonded14 splines for the van der waals interactions.
      41             :       REAL(KIND=dp), POINTER, DIMENSION(:)    :: ei_scale
      42             :       REAL(KIND=dp), POINTER, DIMENSION(:)    :: vdw_scale
      43             :       LOGICAL, POINTER, DIMENSION(:)          :: is_onfo
      44             :       INTEGER                                 :: nscale
      45             :    END TYPE neighbor_kind_pairs_type
      46             : 
      47             : ! **************************************************************************************************
      48             :    TYPE fist_neighbor_type
      49             :       TYPE(neighbor_kind_pairs_type), DIMENSION(:), POINTER :: neighbor_kind_pairs
      50             :       INTEGER                                               :: nlists
      51             :    END TYPE fist_neighbor_type
      52             : 
      53             :    PUBLIC :: neighbor_kind_pairs_type, &
      54             :              fist_neighbor_type, &
      55             :              fist_neighbor_init, &
      56             :              fist_neighbor_deallocate, &
      57             :              fist_neighbor_add
      58             : 
      59             : CONTAINS
      60             : 
      61             : ! **************************************************************************************************
      62             : !> \brief ...
      63             : !> \param fist_neighbor ...
      64             : !> \par History
      65             : !>      08.2006 created [tlaino]
      66             : !> \author Teodoro Laino
      67             : ! **************************************************************************************************
      68        9822 :    SUBROUTINE fist_neighbor_deallocate(fist_neighbor)
      69             :       TYPE(fist_neighbor_type), POINTER                  :: fist_neighbor
      70             : 
      71             :       INTEGER                                            :: i
      72             : 
      73        9822 :       IF (ASSOCIATED(fist_neighbor)) THEN
      74             :          ! deallocate neighbor_kind_pairs
      75        9822 :          IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs)) THEN
      76      533370 :             DO i = 1, SIZE(fist_neighbor%neighbor_kind_pairs)
      77      523548 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%list)) THEN
      78      523548 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%list)
      79             :                END IF
      80      523548 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%id_kind)) THEN
      81         772 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%id_kind)
      82             :                END IF
      83      523548 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ij_kind)) THEN
      84      132147 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ij_kind)
      85             :                END IF
      86      523548 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)) THEN
      87      132147 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)
      88             :                END IF
      89      523548 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)) THEN
      90      132147 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)
      91             :                END IF
      92      523548 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ei_scale)) THEN
      93      522776 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ei_scale)
      94             :                END IF
      95      523548 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)) THEN
      96      522776 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)
      97             :                END IF
      98      533370 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%is_onfo)) THEN
      99      522776 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo)
     100             :                END IF
     101             :             END DO
     102        9822 :             DEALLOCATE (fist_neighbor%neighbor_kind_pairs)
     103             :          END IF
     104        9822 :          DEALLOCATE (fist_neighbor)
     105             :       END IF
     106        9822 :    END SUBROUTINE fist_neighbor_deallocate
     107             : 
     108             : ! **************************************************************************************************
     109             : !> \brief ...
     110             : !> \param fist_neighbor ...
     111             : !> \param ncell ...
     112             : !> \par History
     113             : !>      08.2006 created [tlaino]
     114             : !> \author Teodoro Laino
     115             : ! **************************************************************************************************
     116       18432 :    SUBROUTINE fist_neighbor_init(fist_neighbor, ncell)
     117             :       TYPE(fist_neighbor_type), POINTER                  :: fist_neighbor
     118             :       INTEGER, INTENT(IN)                                :: ncell(3)
     119             : 
     120             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'fist_neighbor_init'
     121             : 
     122             :       INTEGER                                            :: handle, i, list_size, nlistmin
     123             :       TYPE(neighbor_kind_pairs_type), DIMENSION(:), &
     124       18432 :          POINTER                                         :: new_pairs
     125             : 
     126       18432 :       CALL timeset(routineN, handle)
     127       18432 :       IF (.NOT. ASSOCIATED(fist_neighbor)) THEN
     128        9822 :          ALLOCATE (fist_neighbor)
     129        9822 :          NULLIFY (fist_neighbor%neighbor_kind_pairs)
     130             :       END IF
     131             : 
     132       73728 :       nlistmin = (2*MAXVAL(ncell) + 1)**3
     133       18432 :       IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs)) THEN
     134        8610 :          IF (SIZE(fist_neighbor%neighbor_kind_pairs) < nlistmin) THEN
     135           6 :             ALLOCATE (new_pairs(nlistmin))
     136         688 :             DO i = 1, SIZE(fist_neighbor%neighbor_kind_pairs)
     137         686 :                new_pairs(i)%list => fist_neighbor%neighbor_kind_pairs(i)%list
     138         686 :                list_size = SIZE(new_pairs(i)%list)
     139        1503 :                ALLOCATE (new_pairs(i)%id_kind(list_size))
     140         686 :                ALLOCATE (new_pairs(i)%ei_scale(0))
     141         686 :                ALLOCATE (new_pairs(i)%vdw_scale(0))
     142         686 :                ALLOCATE (new_pairs(i)%is_onfo(0))
     143             :                NULLIFY (new_pairs(i)%ij_kind, &
     144         686 :                         new_pairs(i)%grp_kind_start, &
     145         686 :                         new_pairs(i)%grp_kind_end)
     146         686 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ij_kind)) THEN
     147         131 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ij_kind)
     148             :                END IF
     149         686 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%id_kind)) THEN
     150           0 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%id_kind)
     151             :                END IF
     152         686 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)) THEN
     153         131 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)
     154             :                END IF
     155         686 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)) THEN
     156         131 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)
     157             :                END IF
     158         686 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ei_scale)) THEN
     159         686 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ei_scale)
     160             :                END IF
     161         686 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)) THEN
     162         686 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)
     163             :                END IF
     164         688 :                IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%is_onfo)) THEN
     165         686 :                   DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo)
     166             :                END IF
     167             :             END DO
     168         774 :             DO i = SIZE(fist_neighbor%neighbor_kind_pairs) + 1, nlistmin
     169         772 :                ALLOCATE (new_pairs(i)%list(2, 0))
     170         772 :                ALLOCATE (new_pairs(i)%id_kind(0))
     171             :                NULLIFY (new_pairs(i)%ij_kind, &
     172         772 :                         new_pairs(i)%grp_kind_start, &
     173         772 :                         new_pairs(i)%grp_kind_end)
     174         774 :                NULLIFY (new_pairs(i)%ei_scale, new_pairs(i)%vdw_scale, new_pairs(i)%is_onfo)
     175             :             END DO
     176           2 :             DEALLOCATE (fist_neighbor%neighbor_kind_pairs)
     177           2 :             fist_neighbor%neighbor_kind_pairs => new_pairs
     178             :          ELSE
     179      340772 :             DO i = 1, SIZE(fist_neighbor%neighbor_kind_pairs)
     180      332164 :                list_size = SIZE(fist_neighbor%neighbor_kind_pairs(i)%list)
     181      340772 :                CALL reallocate(fist_neighbor%neighbor_kind_pairs(i)%id_kind, 1, list_size)
     182             :             END DO
     183             :          END IF
     184             :       ELSE
     185       29466 :          ALLOCATE (fist_neighbor%neighbor_kind_pairs(nlistmin))
     186      532598 :          DO i = 1, nlistmin
     187      522776 :             ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%list(2, 0))
     188      522776 :             ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%id_kind(0))
     189      522776 :             ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ei_scale(0))
     190      522776 :             ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%vdw_scale(0))
     191      522776 :             ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo(0))
     192             :             NULLIFY (fist_neighbor%neighbor_kind_pairs(i)%ij_kind, &
     193      522776 :                      fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start, &
     194      532598 :                      fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)
     195             :          END DO
     196             :       END IF
     197             : 
     198       18432 :       fist_neighbor%nlists = nlistmin
     199      868654 :       DO i = 1, nlistmin
     200      850222 :          fist_neighbor%neighbor_kind_pairs(i)%npairs = 0
     201   209463970 :          fist_neighbor%neighbor_kind_pairs(i)%list = HUGE(0)
     202   139926054 :          fist_neighbor%neighbor_kind_pairs(i)%id_kind = HUGE(0)
     203     3400888 :          fist_neighbor%neighbor_kind_pairs(i)%cell_vector = HUGE(0)
     204      868654 :          fist_neighbor%neighbor_kind_pairs(i)%nscale = 0
     205             :       END DO
     206       18432 :       CALL timestop(handle)
     207       18432 :    END SUBROUTINE fist_neighbor_init
     208             : 
     209             : ! **************************************************************************************************
     210             : !> \brief ...
     211             : !> \param neighbor_kind_pair ...
     212             : !> \param atom_a ...
     213             : !> \param atom_b ...
     214             : !> \param rab ...
     215             : !> \param check_spline ...
     216             : !> \param id_kind ...
     217             : !> \param skip ...
     218             : !> \param cell ...
     219             : !> \param ei_scale14 ...
     220             : !> \param vdw_scale14 ...
     221             : !> \param exclusions ...
     222             : !> \par History
     223             : !>      08.2006 created [tlaino]
     224             : !> \author Teodoro Laino
     225             : ! **************************************************************************************************
     226   151579614 :    SUBROUTINE fist_neighbor_add(neighbor_kind_pair, atom_a, atom_b, &
     227             :                                 rab, check_spline, id_kind, skip, cell, &
     228   151579614 :                                 ei_scale14, vdw_scale14, exclusions)
     229             :       TYPE(neighbor_kind_pairs_type), POINTER            :: neighbor_kind_pair
     230             :       INTEGER, INTENT(IN)                                :: atom_a, atom_b
     231             :       REAL(KIND=dp), DIMENSION(3)                        :: rab
     232             :       LOGICAL, INTENT(OUT)                               :: check_spline
     233             :       INTEGER, INTENT(IN)                                :: id_kind
     234             :       LOGICAL, INTENT(IN)                                :: skip
     235             :       TYPE(cell_type), POINTER                           :: cell
     236             :       REAL(KIND=dp), INTENT(IN)                          :: ei_scale14, vdw_scale14
     237             :       TYPE(exclusion_type), DIMENSION(:), OPTIONAL       :: exclusions
     238             : 
     239             :       REAL(KIND=dp), PARAMETER :: eps_default = EPSILON(0.0_dp)*1.0E4_dp
     240             : 
     241             :       INTEGER                                            :: new_npairs, npairs, nscale, old_npairs
     242   151579614 :       INTEGER, DIMENSION(:), POINTER                     :: new_id_kind
     243   151579614 :       INTEGER, DIMENSION(:, :), POINTER                  :: new_list
     244             :       LOGICAL                                            :: ex_ei, ex_vdw, is_onfo
     245             :       REAL(KIND=dp), DIMENSION(3)                        :: rabc
     246             : 
     247   151579614 :       IF (.NOT. PRESENT(exclusions)) THEN
     248             :          ex_ei = .FALSE.
     249             :          ex_vdw = .FALSE.
     250             :          is_onfo = .FALSE.
     251             :       ELSE
     252   598659218 :          ex_ei = ANY(exclusions(atom_a)%list_exclude_ei == atom_b)
     253   598659205 :          ex_vdw = ANY(exclusions(atom_a)%list_exclude_vdw == atom_b)
     254   278731835 :          is_onfo = ANY(exclusions(atom_a)%list_onfo == atom_b)
     255   144049183 :          IF (ex_ei .OR. ex_vdw .OR. is_onfo) THEN
     256             :             ! Check if this pair could correspond to a local interaction (bond, bend,
     257             :             ! or torsion) to which the exclusion lists and 14 potentials apply.
     258             :             !
     259             :             ! rab is the relative vector that may include some cell vectors. rabc is
     260             :             ! the 'shortest' possible relative vector, i.e. cell vectors are
     261             :             ! subtracted. When they are not the same, rab corresponds to a non-local
     262             :             ! interaction and the exclusion lists do not apply.
     263     4396699 :             rabc = pbc(rab, cell)
     264     7134063 :             IF ((ANY(ABS(rab - rabc) > eps_default))) THEN
     265     3607629 :                ex_ei = .FALSE.
     266     3607629 :                ex_vdw = .FALSE.
     267     3607629 :                is_onfo = .FALSE.
     268             :             END IF
     269             :          END IF
     270             :       END IF
     271             : 
     272             :       ! The skip option is .TRUE. for QM-QM pairs in an QM/MM run. In case these
     273             :       ! interactions have an ex_ei option, we store it in the neighbor list to
     274             :       ! do a proper bonded correction for the ewald summation. If there is no
     275             :       ! exclusion, the pair can be neglected.
     276   151579614 :       IF (skip .AND. (.NOT. ex_ei)) THEN
     277             :          ! If the pair is not present, checking is obviously not need.
     278       27161 :          check_spline = .FALSE.
     279       27161 :          RETURN
     280             :       END IF
     281             : 
     282             :       ! The check_spline is set to .TRUE. when the van derwaals is not excluded.
     283             :       ! Electrostatic interactions do not matter here as they are not evaluated
     284             :       ! with splines.
     285   151552453 :       check_spline = (.NOT. ex_vdw)
     286             : 
     287             :       ! If both types of interactions are excluded, the corresponding potentials
     288             :       ! will never be evaluated. At first sight such a pair would not need to be
     289             :       ! added to the neighborlists at all. However, they are still needed for
     290             :       ! proper corrections on interactions between the screening charges of bonded
     291             :       ! atoms when the ewald summation is used for the electrostatic interactions.
     292             : 
     293             :       ! If an interaction is excluded or scaled, store scale. If the interaction
     294             :       ! is an onfo, also store that property.
     295   151552453 :       IF (ex_ei .OR. ex_vdw .OR. is_onfo) THEN
     296             :          ! Allocate more memory for the scalings if necessary.
     297      788069 :          nscale = neighbor_kind_pair%nscale
     298      788069 :          IF (nscale == SIZE(neighbor_kind_pair%ei_scale)) THEN
     299       11082 :             CALL reallocate(neighbor_kind_pair%ei_scale, 1, INT(5 + 1.2*nscale))
     300       11082 :             CALL reallocate(neighbor_kind_pair%vdw_scale, 1, INT(5 + 1.2*nscale))
     301       11082 :             CALL reallocate(neighbor_kind_pair%is_onfo, 1, INT(5 + 1.2*nscale))
     302             :          END IF
     303      788069 :          nscale = nscale + 1
     304      788069 :          IF (ex_ei) THEN
     305      631961 :             neighbor_kind_pair%ei_scale(nscale) = 0.0_dp
     306      156108 :          ELSE IF (is_onfo) THEN
     307      155496 :             neighbor_kind_pair%ei_scale(nscale) = ei_scale14
     308             :          ELSE
     309         612 :             neighbor_kind_pair%ei_scale(nscale) = 1.0_dp
     310             :          END IF
     311      788069 :          IF (ex_vdw) THEN
     312      631959 :             neighbor_kind_pair%vdw_scale(nscale) = 0.0_dp
     313      156110 :          ELSE IF (is_onfo) THEN
     314      155496 :             neighbor_kind_pair%vdw_scale(nscale) = vdw_scale14
     315             :          ELSE
     316         614 :             neighbor_kind_pair%vdw_scale(nscale) = 1.0_dp
     317             :          END IF
     318      788069 :          neighbor_kind_pair%is_onfo(nscale) = is_onfo
     319      788069 :          neighbor_kind_pair%nscale = nscale
     320             :       ELSE
     321             :          nscale = HUGE(0)
     322             :       END IF
     323             : 
     324             :       ! Allocate more memory for the pair list if necessary.
     325   151552453 :       old_npairs = SIZE(neighbor_kind_pair%list, 2)
     326   151552453 :       IF (old_npairs == neighbor_kind_pair%npairs) THEN
     327             :          ! just a choice that will also grow for zero size arrays:
     328      533806 :          new_npairs = INT(5 + 1.2*old_npairs)
     329             :          ! Pair Atoms Info
     330     1601418 :          ALLOCATE (new_list(2, new_npairs))
     331  2908541902 :          new_list(1:2, 1:old_npairs) = neighbor_kind_pair%list(1:2, 1:old_npairs)
     332      533806 :          DEALLOCATE (neighbor_kind_pair%list)
     333      533806 :          neighbor_kind_pair%list => new_list
     334             :          ! Kind Info
     335     1601418 :          ALLOCATE (new_id_kind(new_npairs))
     336   969869838 :          new_id_kind(1:old_npairs) = neighbor_kind_pair%id_kind(1:old_npairs)
     337      533806 :          DEALLOCATE (neighbor_kind_pair%id_kind)
     338      533806 :          neighbor_kind_pair%id_kind => new_id_kind
     339             :       END IF
     340             : 
     341             :       ! Store the pair ...
     342   151552453 :       npairs = neighbor_kind_pair%npairs + 1
     343   151552453 :       IF ((ex_ei .OR. ex_vdw .OR. is_onfo) .AND. (npairs > nscale)) THEN
     344             :          ! ... after the previous pair that had scaling factors.
     345      760607 :          neighbor_kind_pair%list(1, npairs) = neighbor_kind_pair%list(1, nscale)
     346      760607 :          neighbor_kind_pair%list(2, npairs) = neighbor_kind_pair%list(2, nscale)
     347      760607 :          neighbor_kind_pair%id_kind(npairs) = neighbor_kind_pair%id_kind(nscale)
     348      760607 :          neighbor_kind_pair%list(1, nscale) = atom_a
     349      760607 :          neighbor_kind_pair%list(2, nscale) = atom_b
     350      760607 :          neighbor_kind_pair%id_kind(nscale) = id_kind
     351             :       ELSE
     352             :          ! ... at the end of the list.
     353   150791846 :          neighbor_kind_pair%list(1, npairs) = atom_a
     354   150791846 :          neighbor_kind_pair%list(2, npairs) = atom_b
     355   150791846 :          neighbor_kind_pair%id_kind(npairs) = id_kind
     356             :       END IF
     357   151552453 :       neighbor_kind_pair%npairs = npairs
     358   151579614 :    END SUBROUTINE fist_neighbor_add
     359             : 
     360           0 : END MODULE fist_neighbor_list_types