LCOV - code coverage report
Current view: top level - src - qs_loc_molecules.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 100.0 % 84 84
Test Date: 2025-07-25 12:55:17 Functions: 100.0 % 1 1

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief Set of routines handling the localization for molecular properties
      10              : ! **************************************************************************************************
      11              : MODULE qs_loc_molecules
      12              :    USE cell_types,                      ONLY: pbc
      13              :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      14              :                                               cp_logger_type
      15              :    USE distribution_1d_types,           ONLY: distribution_1d_type
      16              :    USE kinds,                           ONLY: dp
      17              :    USE memory_utilities,                ONLY: reallocate
      18              :    USE message_passing,                 ONLY: mp_para_env_type
      19              :    USE molecule_kind_types,             ONLY: get_molecule_kind,&
      20              :                                               molecule_kind_type
      21              :    USE molecule_types,                  ONLY: molecule_type
      22              :    USE particle_types,                  ONLY: particle_type
      23              :    USE qs_loc_types,                    ONLY: qs_loc_env_type
      24              : #include "./base/base_uses.f90"
      25              : 
      26              :    IMPLICIT NONE
      27              : 
      28              :    PRIVATE
      29              : 
      30              :    ! *** Public ***
      31              :    PUBLIC :: wfc_to_molecule
      32              : 
      33              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_loc_molecules'
      34              : 
      35              : CONTAINS
      36              : 
      37              : ! **************************************************************************************************
      38              : !> \brief maps wfc's to molecules and also prints molecular dipoles
      39              : !> \param qs_loc_env ...
      40              : !> \param center ...
      41              : !> \param molecule_set ...
      42              : !> \param ispin ...
      43              : !> \param nspins ...
      44              : ! **************************************************************************************************
      45           42 :    SUBROUTINE wfc_to_molecule(qs_loc_env, center, molecule_set, ispin, nspins)
      46              :       TYPE(qs_loc_env_type), INTENT(IN)                  :: qs_loc_env
      47              :       REAL(KIND=dp), INTENT(IN)                          :: center(:, :)
      48              :       TYPE(molecule_type), POINTER                       :: molecule_set(:)
      49              :       INTEGER, INTENT(IN)                                :: ispin, nspins
      50              : 
      51              :       INTEGER :: counter, first_atom, i, iatom, ikind, imol, imol_now, istate, k, local_location, &
      52              :          natom, natom_loc, natom_max, nkind, nmol, nstate
      53           42 :       INTEGER, POINTER                                   :: wfc_to_atom_map(:)
      54              :       REAL(KIND=dp)                                      :: dr(3), mydist(2), ria(3)
      55           42 :       REAL(KIND=dp), POINTER                             :: distance(:), r(:, :)
      56              :       TYPE(cp_logger_type), POINTER                      :: logger
      57              :       TYPE(distribution_1d_type), POINTER                :: local_molecules
      58              :       TYPE(molecule_kind_type), POINTER                  :: molecule_kind
      59              :       TYPE(mp_para_env_type), POINTER                    :: para_env
      60           42 :       TYPE(particle_type), POINTER                       :: particle_set(:)
      61              : 
      62           42 :       logger => cp_get_default_logger()
      63              : 
      64           42 :       particle_set => qs_loc_env%particle_set
      65           42 :       para_env => qs_loc_env%para_env
      66           42 :       local_molecules => qs_loc_env%local_molecules
      67           42 :       nstate = SIZE(center, 2)
      68          126 :       ALLOCATE (wfc_to_atom_map(nstate))
      69              :       !---------------------------------------------------------------------------
      70              :       !---------------------------------------------------------------------------
      71           42 :       nkind = SIZE(local_molecules%n_el)
      72              :       natom = 0
      73           42 :       natom_max = 0
      74          110 :       DO ikind = 1, nkind
      75           68 :          nmol = SIZE(local_molecules%list(ikind)%array)
      76          147 :          DO imol = 1, nmol
      77           37 :             i = local_molecules%list(ikind)%array(imol)
      78           37 :             molecule_kind => molecule_set(i)%molecule_kind
      79           37 :             CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
      80           37 :             natom_max = natom_max + natom
      81           37 :             IF (.NOT. ASSOCIATED(molecule_set(i)%lmi)) THEN
      82           91 :                ALLOCATE (molecule_set(i)%lmi(nspins))
      83           49 :                DO k = 1, nspins
      84           49 :                   NULLIFY (molecule_set(i)%lmi(k)%states)
      85              :                END DO
      86              :             END IF
      87           37 :             molecule_set(i)%lmi(ispin)%nstates = 0
      88          142 :             IF (ASSOCIATED(molecule_set(i)%lmi(ispin)%states)) THEN
      89            9 :                DEALLOCATE (molecule_set(i)%lmi(ispin)%states)
      90              :             END IF
      91              :          END DO
      92              :       END DO
      93           42 :       natom_loc = natom_max
      94           42 :       natom = natom_max
      95              : 
      96           42 :       CALL para_env%max(natom_max)
      97              : 
      98          126 :       ALLOCATE (r(3, natom_max))
      99              : 
     100          126 :       ALLOCATE (distance(natom_max))
     101              : 
     102              :       !Zero all the stuff
     103          530 :       r(:, :) = 0.0_dp
     104          164 :       distance(:) = 1.E10_dp
     105              : 
     106              :       !---------------------------------------------------------------------------
     107              :       !---------------------------------------------------------------------------
     108           42 :       counter = 0
     109           42 :       nkind = SIZE(local_molecules%n_el)
     110          110 :       DO ikind = 1, nkind
     111           68 :          nmol = SIZE(local_molecules%list(ikind)%array)
     112          147 :          DO imol = 1, nmol
     113           37 :             i = local_molecules%list(ikind)%array(imol)
     114           37 :             molecule_kind => molecule_set(i)%molecule_kind
     115           37 :             first_atom = molecule_set(i)%first_atom
     116           37 :             CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
     117              : 
     118          199 :             DO iatom = 1, natom
     119           94 :                counter = counter + 1
     120          413 :                r(:, counter) = particle_set(first_atom + iatom - 1)%r(:)
     121              :             END DO
     122              :          END DO
     123              :       END DO
     124              : 
     125              :       !---------------------------------------------------------------------------
     126              :       !---------------------------------------------------------------------------
     127          294 :       DO istate = 1, nstate
     128         1004 :          distance(:) = 1.E10_dp
     129          886 :          DO iatom = 1, natom_loc
     130          634 :             dr(1) = r(1, iatom) - center(1, istate)
     131          634 :             dr(2) = r(2, iatom) - center(2, istate)
     132          634 :             dr(3) = r(3, iatom) - center(3, istate)
     133          634 :             ria = pbc(dr, qs_loc_env%cell)
     134         2788 :             distance(iatom) = SQRT(DOT_PRODUCT(ria, ria))
     135              :          END DO
     136              : 
     137              :          !combine distance() from all procs
     138         1004 :          local_location = MAX(1, MINLOC(distance, DIM=1))
     139              : 
     140          252 :          mydist(1) = distance(local_location)
     141          252 :          mydist(2) = para_env%mepos
     142              : 
     143          252 :          CALL para_env%minloc(mydist)
     144              : 
     145          294 :          IF (mydist(2) == para_env%mepos) THEN
     146          126 :             wfc_to_atom_map(istate) = local_location
     147              :          ELSE
     148          126 :             wfc_to_atom_map(istate) = 0
     149              :          END IF
     150              :       END DO
     151              :       !---------------------------------------------------------------------------
     152              :       !---------------------------------------------------------------------------
     153           42 :       IF (natom_loc /= 0) THEN
     154          254 :          DO istate = 1, nstate
     155          220 :             iatom = wfc_to_atom_map(istate)
     156          254 :             IF (iatom /= 0) THEN
     157          126 :                counter = 0
     158          126 :                nkind = SIZE(local_molecules%n_el)
     159          163 :                DO ikind = 1, nkind
     160          163 :                   nmol = SIZE(local_molecules%list(ikind)%array)
     161          166 :                   DO imol = 1, nmol
     162          129 :                      imol_now = local_molecules%list(ikind)%array(imol)
     163          129 :                      molecule_kind => molecule_set(imol_now)%molecule_kind
     164          129 :                      CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
     165          129 :                      counter = counter + natom
     166          166 :                      IF (counter >= iatom) EXIT
     167              :                   END DO
     168          163 :                   IF (counter >= iatom) EXIT
     169              :                END DO
     170          126 :                i = molecule_set(imol_now)%lmi(ispin)%nstates
     171          126 :                i = i + 1
     172          126 :                molecule_set(imol_now)%lmi(ispin)%nstates = i
     173          126 :                CALL reallocate(molecule_set(imol_now)%lmi(ispin)%states, 1, i)
     174          126 :                molecule_set(imol_now)%lmi(ispin)%states(i) = istate
     175              :             END IF
     176              :          END DO
     177              :       END IF
     178              : 
     179           42 :       DEALLOCATE (distance)
     180           42 :       DEALLOCATE (r)
     181           42 :       DEALLOCATE (wfc_to_atom_map)
     182              : 
     183           42 :    END SUBROUTINE wfc_to_molecule
     184              :    !------------------------------------------------------------------------------
     185              : 
     186              : END MODULE qs_loc_molecules
     187              : 
        

Generated by: LCOV version 2.0-1