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

            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              : !> \par History
      10              : !>    cjm, Feb-20-2001 : added all the extended variables to
      11              : !>    system_type
      12              : !>    gt 23-09-2002 : major changes. Pointer part is allocated/deallocated
      13              : !>                    and initialized here. Atomic coordinates can now be
      14              : !>                    read also from &COORD section in the input file.
      15              : !>                    If &COORD is not found, .dat file is read.
      16              : !>                    If & coord is found and .NOT. 'INIT', parsing of the .dat
      17              : !>                    is performed to get the proper coords/vel/eta variables
      18              : !>     CJM 31-7-03  : Major rewrite.  No more atype
      19              : ! **************************************************************************************************
      20              : MODULE atoms_input
      21              :    USE atomic_kind_types,               ONLY: atomic_kind_type,&
      22              :                                               get_atomic_kind
      23              :    USE cell_types,                      ONLY: cell_type,&
      24              :                                               pbc,&
      25              :                                               scaled_to_real
      26              :    USE cp_linked_list_input,            ONLY: cp_sll_val_next,&
      27              :                                               cp_sll_val_type
      28              :    USE cp_log_handling,                 ONLY: cp_logger_get_default_io_unit,&
      29              :                                               cp_to_string
      30              :    USE cp_parser_methods,               ONLY: read_float_object
      31              :    USE cp_units,                        ONLY: cp_unit_to_cp2k
      32              :    USE input_section_types,             ONLY: section_vals_get,&
      33              :                                               section_vals_get_subs_vals,&
      34              :                                               section_vals_list_get,&
      35              :                                               section_vals_remove_values,&
      36              :                                               section_vals_type,&
      37              :                                               section_vals_val_get
      38              :    USE input_val_types,                 ONLY: val_get,&
      39              :                                               val_type
      40              :    USE kinds,                           ONLY: default_string_length,&
      41              :                                               dp
      42              :    USE memory_utilities,                ONLY: reallocate
      43              :    USE particle_types,                  ONLY: particle_type
      44              :    USE shell_potential_types,           ONLY: shell_kind_type
      45              :    USE string_table,                    ONLY: id2str,&
      46              :                                               s2s,&
      47              :                                               str2id
      48              :    USE string_utilities,                ONLY: uppercase
      49              :    USE topology_types,                  ONLY: atom_info_type,&
      50              :                                               topology_parameters_type
      51              : #include "./base/base_uses.f90"
      52              : 
      53              :    IMPLICIT NONE
      54              : 
      55              :    PRIVATE
      56              :    PUBLIC :: read_atoms_input, read_shell_coord_input
      57              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'atoms_input'
      58              : 
      59              : CONTAINS
      60              : 
      61              : ! **************************************************************************************************
      62              : !> \brief ...
      63              : !> \param topology ...
      64              : !> \param overwrite ...
      65              : !> \param subsys_section ...
      66              : !> \param save_mem ...
      67              : !> \author CJM
      68              : ! **************************************************************************************************
      69        42935 :    SUBROUTINE read_atoms_input(topology, overwrite, subsys_section, save_mem)
      70              : 
      71              :       TYPE(topology_parameters_type)                     :: topology
      72              :       LOGICAL, INTENT(IN), OPTIONAL                      :: overwrite
      73              :       TYPE(section_vals_type), POINTER                   :: subsys_section
      74              :       LOGICAL, INTENT(IN), OPTIONAL                      :: save_mem
      75              : 
      76              :       CHARACTER(len=*), PARAMETER                        :: routineN = 'read_atoms_input'
      77              : 
      78              :       CHARACTER(len=2*default_string_length)             :: line_att
      79              :       CHARACTER(len=default_string_length)               :: error_message, my_default_index, strtmp, &
      80              :                                                             unit_str
      81              :       INTEGER                                            :: default_id, end_c, handle, iatom, j, &
      82              :                                                             natom, output_unit, start_c, wrd
      83              :       LOGICAL                                            :: explicit, is_ok, my_overwrite, &
      84              :                                                             my_save_mem, scaled_coordinates
      85              :       REAL(KIND=dp)                                      :: r0(3), unit_conv
      86              :       TYPE(atom_info_type), POINTER                      :: atom_info
      87              :       TYPE(cell_type), POINTER                           :: cell
      88              :       TYPE(cp_sll_val_type), POINTER                     :: list
      89              :       TYPE(section_vals_type), POINTER                   :: coord_section
      90              :       TYPE(val_type), POINTER                            :: val
      91              : 
      92         9634 :       my_overwrite = .FALSE.
      93         9634 :       my_save_mem = .FALSE.
      94         9634 :       error_message = ""
      95         9634 :       output_unit = cp_logger_get_default_io_unit()
      96         9634 :       IF (PRESENT(overwrite)) my_overwrite = overwrite
      97         9634 :       IF (PRESENT(save_mem)) my_save_mem = save_mem
      98         9634 :       NULLIFY (coord_section)
      99         9634 :       coord_section => section_vals_get_subs_vals(subsys_section, "COORD")
     100         9634 :       CALL section_vals_get(coord_section, explicit=explicit)
     101         9634 :       IF (.NOT. explicit) RETURN
     102              : 
     103         7889 :       CALL timeset(routineN, handle)
     104              :       !-----------------------------------------------------------------------------
     105              :       !-----------------------------------------------------------------------------
     106              :       ! 1. get cell and topology%atom_info
     107              :       !-----------------------------------------------------------------------------
     108         7889 :       atom_info => topology%atom_info
     109         7889 :       cell => topology%cell_muc
     110         7889 :       CALL section_vals_val_get(coord_section, "UNIT", c_val=unit_str)
     111         7889 :       CALL section_vals_val_get(coord_section, "SCALED", l_val=scaled_coordinates)
     112         7889 :       unit_conv = cp_unit_to_cp2k(1.0_dp, TRIM(unit_str))
     113              : 
     114              :       !-----------------------------------------------------------------------------
     115              :       !-----------------------------------------------------------------------------
     116              :       ! 2. Read in the coordinates from &COORD section in the input file
     117              :       !-----------------------------------------------------------------------------
     118              :       CALL section_vals_val_get(coord_section, "_DEFAULT_KEYWORD_", &
     119         7889 :                                 n_rep_val=natom)
     120         7889 :       topology%natoms = natom
     121         7889 :       IF (my_overwrite) THEN
     122          126 :          CPASSERT(SIZE(atom_info%r, 2) == natom)
     123              :          CALL cp_warn(__LOCATION__, &
     124              :                       "Overwriting coordinates. Active coordinates read from &COORD section."// &
     125          126 :                       " Active coordinates READ from &COORD section ")
     126          126 :          CALL section_vals_list_get(coord_section, "_DEFAULT_KEYWORD_", list=list)
     127        22418 :          DO iatom = 1, natom
     128        22292 :             is_ok = cp_sll_val_next(list, val)
     129        22292 :             CALL val_get(val, c_val=line_att)
     130              :             ! Read name and atomic coordinates
     131        22292 :             start_c = 1
     132       111586 :             DO wrd = 1, 4
     133       314538 :                DO j = start_c, LEN(line_att)
     134       314538 :                   IF (line_att(j:j) /= ' ') THEN
     135              :                      start_c = j
     136              :                      EXIT
     137              :                   END IF
     138              :                END DO
     139        89168 :                end_c = LEN(line_att) + 1
     140      1659050 :                DO j = start_c, LEN(line_att)
     141      1659050 :                   IF (line_att(j:j) == ' ') THEN
     142              :                      end_c = j
     143              :                      EXIT
     144              :                   END IF
     145              :                END DO
     146        89168 :                IF (LEN_TRIM(line_att(start_c:end_c - 1)) == 0) &
     147            0 :                   CPABORT("incorrectly formatted line in coord section'"//line_att//"'")
     148        89168 :                IF (wrd == 1) THEN
     149        22292 :                   atom_info%id_atmname(iatom) = str2id(s2s(line_att(start_c:end_c - 1)))
     150              :                ELSE
     151        66876 :                   READ (line_att(start_c:end_c - 1), *) atom_info%r(wrd - 1, iatom)
     152              :                END IF
     153       111460 :                start_c = end_c
     154              :             END DO
     155              :          END DO
     156              :       ELSE
     157              :          ! Element is assigned on the basis of the atm_name
     158         7763 :          topology%aa_element = .TRUE.
     159              : 
     160         7763 :          CALL reallocate(atom_info%id_molname, 1, natom)
     161         7763 :          CALL reallocate(atom_info%id_resname, 1, natom)
     162         7763 :          CALL reallocate(atom_info%resid, 1, natom)
     163         7763 :          CALL reallocate(atom_info%id_atmname, 1, natom)
     164         7763 :          CALL reallocate(atom_info%id_element, 1, natom)
     165         7763 :          CALL reallocate(atom_info%r, 1, 3, 1, natom)
     166         7763 :          CALL reallocate(atom_info%atm_mass, 1, natom)
     167         7763 :          CALL reallocate(atom_info%atm_charge, 1, natom)
     168              : 
     169         7763 :          CALL section_vals_list_get(coord_section, "_DEFAULT_KEYWORD_", list=list)
     170       211377 :          DO iatom = 1, natom
     171              :             ! we use only the first default_string_length characters of each line
     172       203614 :             is_ok = cp_sll_val_next(list, val)
     173       203614 :             CALL val_get(val, c_val=line_att)
     174       203614 :             default_id = str2id(s2s(""))
     175       203614 :             atom_info%id_molname(iatom) = default_id
     176       203614 :             atom_info%id_resname(iatom) = default_id
     177       203614 :             atom_info%resid(iatom) = 1
     178       203614 :             atom_info%id_atmname(iatom) = default_id
     179       203614 :             atom_info%id_element(iatom) = default_id
     180       203614 :             topology%molname_generated = .TRUE.
     181              :             ! Read name and atomic coordinates
     182       203614 :             start_c = 1
     183       950238 :             DO wrd = 1, 6
     184      3446381 :                DO j = start_c, LEN(line_att)
     185      3446381 :                   IF (line_att(j:j) /= ' ') THEN
     186              :                      start_c = j
     187              :                      EXIT
     188              :                   END IF
     189              :                END DO
     190       944058 :                end_c = LEN(line_att) + 1
     191      8293601 :                DO j = start_c, LEN(line_att)
     192      8293601 :                   IF (line_att(j:j) == ' ') THEN
     193              :                      end_c = j
     194              :                      EXIT
     195              :                   END IF
     196              :                END DO
     197       944058 :                IF (LEN_TRIM(line_att(start_c:end_c - 1)) == 0) &
     198              :                   CALL cp_abort(__LOCATION__, &
     199              :                                 "Incorrectly formatted input line for atom "// &
     200              :                                 TRIM(ADJUSTL(cp_to_string(iatom)))// &
     201              :                                 " found in COORD section. Input line: <"// &
     202            0 :                                 TRIM(line_att)//"> ")
     203       203614 :                SELECT CASE (wrd)
     204              :                CASE (1)
     205       203614 :                   atom_info%id_atmname(iatom) = str2id(s2s(line_att(start_c:end_c - 1)))
     206              :                CASE (2:4)
     207              :                   CALL read_float_object(line_att(start_c:end_c - 1), &
     208       610842 :                                          atom_info%r(wrd - 1, iatom), error_message)
     209       610842 :                   IF (LEN_TRIM(error_message) /= 0) &
     210              :                      CALL cp_abort(__LOCATION__, &
     211              :                                    "Incorrectly formatted input line for atom "// &
     212              :                                    TRIM(ADJUSTL(cp_to_string(iatom)))// &
     213              :                                    " found in COORD section. "//TRIM(error_message)// &
     214            0 :                                    " Input line: <"//TRIM(line_att)//"> ")
     215              :                CASE (5)
     216       101886 :                   READ (line_att(start_c:end_c - 1), *) strtmp
     217       101886 :                   atom_info%id_molname(iatom) = str2id(strtmp)
     218       101886 :                   atom_info%id_resname(iatom) = atom_info%id_molname(iatom)
     219       101886 :                   topology%molname_generated = .FALSE.
     220              :                CASE (6)
     221        27716 :                   READ (line_att(start_c:end_c - 1), *) strtmp
     222       971774 :                   atom_info%id_resname(iatom) = str2id(strtmp)
     223              :                END SELECT
     224       944058 :                start_c = end_c
     225       950238 :                IF (start_c > LEN_TRIM(line_att)) EXIT
     226              :             END DO
     227       203614 :             IF (topology%molname_generated) THEN
     228              :                ! Use defaults, if no molname was specified
     229       101728 :                WRITE (my_default_index, '(I0)') iatom
     230       101728 :                atom_info%id_molname(iatom) = str2id(s2s(TRIM(id2str(atom_info%id_atmname(iatom)))//TRIM(my_default_index)))
     231       101728 :                atom_info%id_resname(iatom) = atom_info%id_molname(iatom)
     232              :             END IF
     233       203614 :             atom_info%id_element(iatom) = atom_info%id_atmname(iatom)
     234       203614 :             atom_info%atm_mass(iatom) = 0.0_dp
     235       211377 :             atom_info%atm_charge(iatom) = -HUGE(0.0_dp)
     236              :          END DO
     237              :       END IF
     238              :       !-----------------------------------------------------------------------------
     239              :       !-----------------------------------------------------------------------------
     240              :       ! 3. Convert coordinates into internal cp2k coordinates
     241              :       !-----------------------------------------------------------------------------
     242       233795 :       DO iatom = 1, natom
     243       233795 :          IF (scaled_coordinates) THEN
     244       111704 :             r0 = atom_info%r(:, iatom)
     245        27926 :             CALL scaled_to_real(atom_info%r(:, iatom), r0, cell)
     246              :          ELSE
     247       791920 :             atom_info%r(:, iatom) = atom_info%r(:, iatom)*unit_conv
     248              :          END IF
     249              :       END DO
     250         7889 :       IF (my_save_mem) CALL section_vals_remove_values(coord_section)
     251              : 
     252         7889 :       CALL timestop(handle)
     253              :    END SUBROUTINE read_atoms_input
     254              : 
     255              : ! **************************************************************************************************
     256              : !> \brief ...
     257              : !> \param particle_set ...
     258              : !> \param shell_particle_set ...
     259              : !> \param cell ...
     260              : !> \param subsys_section ...
     261              : !> \param core_particle_set ...
     262              : !> \param save_mem ...
     263              : !> \author MI
     264              : ! **************************************************************************************************
     265          240 :    SUBROUTINE read_shell_coord_input(particle_set, shell_particle_set, cell, &
     266              :                                      subsys_section, core_particle_set, save_mem)
     267              : 
     268              :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set, shell_particle_set
     269              :       TYPE(cell_type), POINTER                           :: cell
     270              :       TYPE(section_vals_type), POINTER                   :: subsys_section
     271              :       TYPE(particle_type), DIMENSION(:), OPTIONAL, &
     272              :          POINTER                                         :: core_particle_set
     273              :       LOGICAL, INTENT(IN), OPTIONAL                      :: save_mem
     274              : 
     275              :       CHARACTER(len=*), PARAMETER :: routineN = 'read_shell_coord_input'
     276              : 
     277              :       CHARACTER(len=2*default_string_length)             :: line_att
     278              :       CHARACTER(len=default_string_length)               :: name_kind, unit_str
     279              :       CHARACTER(len=default_string_length), &
     280          240 :          ALLOCATABLE, DIMENSION(:)                       :: at_name, at_name_c
     281              :       INTEGER                                            :: end_c, handle, ishell, j, nshell, &
     282              :                                                             output_unit, sh_index, start_c, wrd
     283          240 :       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: at_index, at_index_c
     284              :       LOGICAL                                            :: core_scaled_coordinates, explicit, &
     285              :                                                             is_ok, is_shell, my_save_mem, &
     286              :                                                             shell_scaled_coordinates
     287              :       REAL(KIND=dp)                                      :: dab, mass_com, rab(3), unit_conv_core, &
     288              :                                                             unit_conv_shell
     289          240 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: r, rc
     290              :       TYPE(atomic_kind_type), POINTER                    :: atomic_kind
     291              :       TYPE(cp_sll_val_type), POINTER                     :: list
     292              :       TYPE(section_vals_type), POINTER                   :: core_coord_section, shell_coord_section
     293              :       TYPE(shell_kind_type), POINTER                     :: shell
     294              :       TYPE(val_type), POINTER                            :: val
     295              : 
     296          240 :       my_save_mem = .FALSE.
     297          240 :       NULLIFY (atomic_kind, list, shell_coord_section, shell, val)
     298          240 :       output_unit = cp_logger_get_default_io_unit()
     299              : 
     300          240 :       IF (PRESENT(save_mem)) my_save_mem = save_mem
     301          240 :       NULLIFY (shell_coord_section, core_coord_section)
     302          240 :       shell_coord_section => section_vals_get_subs_vals(subsys_section, "SHELL_COORD")
     303          240 :       CALL section_vals_get(shell_coord_section, explicit=explicit)
     304          240 :       IF (.NOT. explicit) RETURN
     305              : 
     306           44 :       CALL timeset(routineN, handle)
     307           44 :       CPASSERT(ASSOCIATED(particle_set))
     308              :       !-----------------------------------------------------------------------------
     309              :       !-----------------------------------------------------------------------------
     310              :       ! 2. Read in the coordinates from &SHELL_COORD section in the input file
     311              :       !-----------------------------------------------------------------------------
     312           44 :       CALL section_vals_val_get(shell_coord_section, "UNIT", c_val=unit_str)
     313           44 :       CALL section_vals_val_get(shell_coord_section, "SCALED", l_val=shell_scaled_coordinates)
     314           44 :       unit_conv_shell = cp_unit_to_cp2k(1.0_dp, TRIM(unit_str))
     315              :       CALL section_vals_val_get(shell_coord_section, "_DEFAULT_KEYWORD_", &
     316           44 :                                 n_rep_val=nshell)
     317              : 
     318           44 :       IF (ASSOCIATED(shell_particle_set)) THEN
     319           44 :          CPASSERT((SIZE(shell_particle_set, 1) == nshell))
     320          308 :          ALLOCATE (r(3, nshell), at_name(nshell), at_index(nshell))
     321              :          CALL cp_warn(__LOCATION__, &
     322              :                       "Overwriting shell coordinates. "// &
     323           44 :                       "Active coordinates READ from &SHELL_COORD section. ")
     324           44 :          CALL section_vals_list_get(shell_coord_section, "_DEFAULT_KEYWORD_", list=list)
     325         4284 :          DO ishell = 1, nshell
     326              :             ! we use only the first default_string_length characters of each line
     327         4240 :             is_ok = cp_sll_val_next(list, val)
     328         4240 :             CALL val_get(val, c_val=line_att)
     329         4240 :             start_c = 1
     330        25484 :             DO wrd = 1, 5
     331        50558 :                DO j = start_c, LEN(line_att)
     332        50558 :                   IF (line_att(j:j) /= ' ') THEN
     333              :                      start_c = j
     334              :                      EXIT
     335              :                   END IF
     336              :                END DO
     337        21200 :                end_c = LEN(line_att) + 1
     338       327022 :                DO j = start_c, LEN(line_att)
     339       327022 :                   IF (line_att(j:j) == ' ') THEN
     340              :                      end_c = j
     341              :                      EXIT
     342              :                   END IF
     343              :                END DO
     344        21200 :                IF (wrd /= 5 .AND. end_c >= LEN(line_att) + 1) &
     345            0 :                   CPABORT("incorrectly formatted line in coord section'"//line_att//"'")
     346        21200 :                IF (wrd == 1) THEN
     347         4240 :                   at_name(ishell) = line_att(start_c:end_c - 1)
     348         4240 :                   CALL uppercase(at_name(ishell))
     349        16960 :                ELSE IF (wrd == 5) THEN
     350         4240 :                   READ (line_att(start_c:end_c - 1), *) at_index(ishell)
     351              :                ELSE
     352        12720 :                   READ (line_att(start_c:end_c - 1), *) r(wrd - 1, ishell)
     353              :                END IF
     354        25440 :                start_c = end_c
     355              :             END DO
     356              :          END DO
     357              : 
     358           44 :          IF (PRESENT(core_particle_set)) THEN
     359           44 :             CPASSERT(ASSOCIATED(core_particle_set))
     360           44 :             core_coord_section => section_vals_get_subs_vals(subsys_section, "CORE_COORD")
     361           44 :             CALL section_vals_get(core_coord_section, explicit=explicit)
     362           44 :             IF (explicit) THEN
     363           44 :                CALL section_vals_val_get(core_coord_section, "UNIT", c_val=unit_str)
     364           44 :                CALL section_vals_val_get(core_coord_section, "SCALED", l_val=core_scaled_coordinates)
     365           44 :                unit_conv_core = cp_unit_to_cp2k(1.0_dp, TRIM(unit_str))
     366              :                CALL section_vals_val_get(core_coord_section, "_DEFAULT_KEYWORD_", &
     367           44 :                                          n_rep_val=nshell)
     368              : 
     369           44 :                CPASSERT((SIZE(core_particle_set, 1) == nshell))
     370          308 :                ALLOCATE (rc(3, nshell), at_name_c(nshell), at_index_c(nshell))
     371              :                CALL cp_warn(__LOCATION__, &
     372              :                             "Overwriting cores coordinates. "// &
     373           44 :                             "Active coordinates READ from &CORE_COORD section. ")
     374           44 :                CALL section_vals_list_get(core_coord_section, "_DEFAULT_KEYWORD_", list=list)
     375         4284 :                DO ishell = 1, nshell
     376              :                   ! we use only the first default_string_length characters of each line
     377         4240 :                   is_ok = cp_sll_val_next(list, val)
     378         4240 :                   CALL val_get(val, c_val=line_att)
     379         4240 :                   start_c = 1
     380        25484 :                   DO wrd = 1, 5
     381        50548 :                      DO j = start_c, LEN(line_att)
     382        50548 :                         IF (line_att(j:j) /= ' ') THEN
     383              :                            start_c = j
     384              :                            EXIT
     385              :                         END IF
     386              :                      END DO
     387        21200 :                      end_c = LEN(line_att) + 1
     388       326746 :                      DO j = start_c, LEN(line_att)
     389       326746 :                         IF (line_att(j:j) == ' ') THEN
     390              :                            end_c = j
     391              :                            EXIT
     392              :                         END IF
     393              :                      END DO
     394        21200 :                      IF (wrd /= 5 .AND. end_c >= LEN(line_att) + 1) &
     395            0 :                         CPABORT("incorrectly formatted line in coord section'"//line_att//"'")
     396        21200 :                      IF (wrd == 1) THEN
     397         4240 :                         at_name_c(ishell) = line_att(start_c:end_c - 1)
     398         4240 :                         CALL uppercase(at_name_c(ishell))
     399        16960 :                      ELSE IF (wrd == 5) THEN
     400         4240 :                         READ (line_att(start_c:end_c - 1), *) at_index_c(ishell)
     401              :                      ELSE
     402        12720 :                         READ (line_att(start_c:end_c - 1), *) rc(wrd - 1, ishell)
     403              :                      END IF
     404        25440 :                      start_c = end_c
     405              :                   END DO
     406              :                END DO
     407          132 :                IF (my_save_mem) CALL section_vals_remove_values(core_coord_section)
     408              :             END IF ! explicit
     409              :          END IF ! core_particle_set
     410              : 
     411              :          !-----------------------------------------------------------------------------
     412              :          ! 3. Check corrispondence and convert coordinates into internal cp2k coordinates
     413              :          !-----------------------------------------------------------------------------
     414         4284 :          DO ishell = 1, nshell
     415         4240 :             atomic_kind => particle_set(at_index(ishell))%atomic_kind
     416              :             CALL get_atomic_kind(atomic_kind=atomic_kind, &
     417         4240 :                                  name=name_kind, shell_active=is_shell, mass=mass_com, shell=shell)
     418         4240 :             CALL uppercase(name_kind)
     419         8524 :             IF ((TRIM(at_name(ishell)) == TRIM(name_kind)) .AND. is_shell) THEN
     420         4240 :                sh_index = particle_set(at_index(ishell))%shell_index
     421         4240 :                IF (shell_scaled_coordinates) THEN
     422            0 :                   CALL scaled_to_real(r(:, ishell), shell_particle_set(sh_index)%r(:), cell)
     423              :                ELSE
     424        16960 :                   shell_particle_set(sh_index)%r(:) = r(:, ishell)*unit_conv_shell
     425              :                END IF
     426         4240 :                shell_particle_set(sh_index)%atom_index = at_index(ishell)
     427              : 
     428         4240 :                IF (PRESENT(core_particle_set) .AND. .NOT. explicit) THEN
     429              :                   core_particle_set(sh_index)%r(1) = (mass_com*particle_set(at_index(ishell))%r(1) - &
     430            0 :                                                       shell%mass_shell*shell_particle_set(sh_index)%r(1))/shell%mass_core
     431              :                   core_particle_set(sh_index)%r(2) = (mass_com*particle_set(at_index(ishell))%r(2) - &
     432            0 :                                                       shell%mass_shell*shell_particle_set(sh_index)%r(2))/shell%mass_core
     433              :                   core_particle_set(sh_index)%r(3) = (mass_com*particle_set(at_index(ishell))%r(3) - &
     434            0 :                                                       shell%mass_shell*shell_particle_set(sh_index)%r(3))/shell%mass_core
     435            0 :                   core_particle_set(sh_index)%atom_index = at_index(ishell)
     436            0 :                   rab = pbc(shell_particle_set(sh_index)%r, core_particle_set(sh_index)%r, cell)
     437         4240 :                ELSE IF (explicit) THEN
     438         4240 :                   IF (core_scaled_coordinates) THEN
     439            0 :                      CALL scaled_to_real(rc(:, ishell), core_particle_set(sh_index)%r(:), cell)
     440              :                   ELSE
     441        16960 :                      core_particle_set(sh_index)%r(:) = rc(:, ishell)*unit_conv_core
     442              :                   END IF
     443         4240 :                   core_particle_set(sh_index)%atom_index = at_index_c(ishell)
     444         4240 :                   rab = pbc(shell_particle_set(sh_index)%r, core_particle_set(sh_index)%r, cell)
     445         4240 :                   CPASSERT(TRIM(at_name(ishell)) == TRIM(at_name_c(ishell)))
     446         4240 :                   CPASSERT(at_index(ishell) == at_index_c(ishell))
     447              :                ELSE
     448            0 :                   rab = pbc(shell_particle_set(sh_index)%r, particle_set(at_index(ishell))%r, cell)
     449              :                END IF
     450              : 
     451         4240 :                dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3))
     452         4240 :                IF (shell%max_dist > 0.0_dp .AND. shell%max_dist < dab) THEN
     453            0 :                   IF (output_unit > 0) THEN
     454            0 :                      WRITE (output_unit, *) "WARNING : shell and core for atom ", at_index(ishell), " seem to be too distant."
     455              :                   END IF
     456              :                END IF
     457              : 
     458              :             ELSE
     459            0 :                CPABORT("shell coordinate assigned to the wrong atom. check the shell indexes in the input")
     460              :             END IF
     461              :          END DO
     462           44 :          DEALLOCATE (r, at_index, at_name)
     463           44 :          DEALLOCATE (rc, at_index_c, at_name_c)
     464              : 
     465              :       END IF
     466              : 
     467           44 :       IF (my_save_mem) CALL section_vals_remove_values(shell_coord_section)
     468              : 
     469           44 :       CALL timestop(handle)
     470              : 
     471              :    END SUBROUTINE read_shell_coord_input
     472              : 
     473              : END MODULE atoms_input
        

Generated by: LCOV version 2.0-1