24 #include "./base/base_uses.f90"
28 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'topology_multiple_unit_cell'
45 TYPE(section_vals_type),
POINTER :: subsys_section
47 CHARACTER(len=*),
PARAMETER :: routinen =
'topology_muc'
49 CHARACTER(LEN=default_string_length) :: unit_str
50 INTEGER :: handle, i, ind, j, k, m, n, natoms, nrep
51 INTEGER,
DIMENSION(:),
POINTER :: iwork, multiple_unit_cell
52 LOGICAL :: check, explicit, scale
53 REAL(kind=
dp),
DIMENSION(3) :: trsl, trsl_i, trsl_j, trsl_k
54 TYPE(cell_type),
POINTER :: cell
55 TYPE(section_vals_type),
POINTER :: work_section
57 CALL timeset(routinen, handle)
58 NULLIFY (multiple_unit_cell, iwork, cell)
60 i_vals=multiple_unit_cell)
62 IF (any(multiple_unit_cell <= 0)) &
63 CALL cp_abort(__location__,
"SUBSYS%TOPOLOGY%MULTIPLE_UNIT_CELL accepts "// &
64 "only integer values larger than 0! A value of 0 or negative is meaningless!")
65 IF (any(multiple_unit_cell /= 1))
THEN
69 IF (any(iwork /= multiple_unit_cell)) &
70 CALL cp_abort(__location__,
"SUBSYS%TOPOLOGY%MULTIPLE_UNIT_CELL and "// &
71 "SUBSYS%CELL%MULTIPLE_UNIT_CELL have been "// &
72 "setup to two different values!! Correct this error!!")
74 natoms =
topology%natoms*product(multiple_unit_cell)
81 check = nrep == natoms
83 CALL cp_abort(__location__, &
84 "Number of available entries in VELOCITY section is not compatible with the number of atoms!")
87 CALL reallocate(
topology%atom_info%id_molname, 1, natoms)
88 CALL reallocate(
topology%atom_info%id_resname, 1, natoms)
89 CALL reallocate(
topology%atom_info%resid, 1, natoms)
90 CALL reallocate(
topology%atom_info%id_atmname, 1, natoms)
91 CALL reallocate(
topology%atom_info%r, 1, 3, 1, natoms)
92 CALL reallocate(
topology%atom_info%atm_mass, 1, natoms)
93 CALL reallocate(
topology%atom_info%atm_charge, 1, natoms)
94 CALL reallocate(
topology%atom_info%occup, 1, natoms)
95 CALL reallocate(
topology%atom_info%beta, 1, natoms)
96 CALL reallocate(
topology%atom_info%id_element, 1, natoms)
98 DO k = 1, multiple_unit_cell(3)
99 trsl_k = cell%hmat(:, 3)*real(k - 1, kind=
dp)
100 DO j = 1, multiple_unit_cell(2)
101 trsl_j = cell%hmat(:, 2)*real(j - 1, kind=
dp)
102 DO i = 1, multiple_unit_cell(1)
103 trsl_i = cell%hmat(:, 1)*real(i - 1, kind=
dp)
104 trsl = trsl_i + trsl_j + trsl_k
140 CALL timestop(handle)
Handles all functions related to the CELL.
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
Utility routines for the memory handling.
Handles the multiple unit cell option regarding atomic coordinates.
subroutine, public topology_muc(topology, subsys_section)
Handles the multiple_unit_cell for the atomic coordinates..
Control for reading in different topologies and coordinates.