(git:9111030)
Loading...
Searching...
No Matches
topology_xtl.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Handles XTL (Molecular Simulations, Inc (MSI)) files
10!> \author Teodoro Laino [tlaino]
11!> \date 05.2009
12! **************************************************************************************************
13MODULE topology_xtl
14 USE cell_methods, ONLY: cell_create,&
15 set_cell_param,&
16 write_cell
17 USE cell_types, ONLY: cell_release,&
18 cell_type,&
19 pbc,&
20 scaled_to_real
21 USE cp_log_handling, ONLY: cp_get_default_logger,&
22 cp_logger_type,&
23 cp_to_string
24 USE cp_output_handling, ONLY: cp_print_key_finished_output,&
25 cp_print_key_unit_nr
26 USE cp_parser_methods, ONLY: parser_get_next_line,&
27 parser_get_object,&
28 parser_search_string
29 USE cp_parser_types, ONLY: cp_parser_type,&
30 parser_create,&
31 parser_release
32 USE cp_units, ONLY: cp_unit_to_cp2k
33 USE input_section_types, ONLY: section_get_rval,&
34 section_vals_type
35 USE kinds, ONLY: default_string_length,&
36 dp
37 USE memory_utilities, ONLY: reallocate
38 USE message_passing, ONLY: mp_para_env_type
39 USE string_table, ONLY: id2str,&
40 s2s,&
41 str2id
42 USE topology_types, ONLY: atom_info_type,&
43 topology_parameters_type
44#include "./base/base_uses.f90"
45
46 IMPLICIT NONE
47
48 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'topology_xtl'
49
50 PRIVATE
51 PUBLIC :: read_coordinate_xtl
52
53CONTAINS
54
55! **************************************************************************************************
56!> \brief Performs the real task of reading the proper information from the XTL
57!> file
58!> \param topology ...
59!> \param para_env ...
60!> \param subsys_section ...
61!> \date 05.2009
62!> \par Format Information implemented:
63!> TITLE
64!> DIMENSION
65!> CELL
66!> SYMMETRY
67!> SYM MAT
68!> ATOMS
69!> EOF
70!>
71!> \author Teodoro Laino [tlaino]
72! **************************************************************************************************
73 SUBROUTINE read_coordinate_xtl(topology, para_env, subsys_section)
74 TYPE(topology_parameters_type) :: topology
75 TYPE(mp_para_env_type), POINTER :: para_env
76 TYPE(section_vals_type), POINTER :: subsys_section
77
78 CHARACTER(len=*), PARAMETER :: routinen = 'read_coordinate_xtl'
79 INTEGER, PARAMETER :: nblock = 1000
80 REAL(kind=dp), PARAMETER :: threshold = 1.0e-6_dp
81
82 CHARACTER(LEN=default_string_length) :: strtmp
83 INTEGER :: dimensions, handle, icol, ii, isym, iw, &
84 jj, natom, natom_orig, newsize
85 INTEGER, DIMENSION(3) :: periodic
86 LOGICAL :: check, found, my_end
87 REAL(kind=dp) :: pfactor, threshold2
88 REAL(kind=dp), DIMENSION(3) :: cell_angles, cell_lengths, r, r1, r2, s, &
89 transl_vec
90 REAL(kind=dp), DIMENSION(3, 3) :: rot_mat
91 TYPE(atom_info_type), POINTER :: atom_info
92 TYPE(cell_type), POINTER :: cell
93 TYPE(cp_logger_type), POINTER :: logger
94 TYPE(cp_parser_type) :: parser
95
96 NULLIFY (logger)
97 logger => cp_get_default_logger()
98 iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/XTL_INFO", &
99 extension=".subsysLog")
100 CALL timeset(routinen, handle)
101
102 pfactor = section_get_rval(subsys_section, "TOPOLOGY%MEMORY_PROGRESSION_FACTOR")
103 ! Element is assigned on the basis of the atm_name
104 topology%aa_element = .true.
105
106 atom_info => topology%atom_info
107 CALL reallocate(atom_info%id_molname, 1, nblock)
108 CALL reallocate(atom_info%id_resname, 1, nblock)
109 CALL reallocate(atom_info%resid, 1, nblock)
110 CALL reallocate(atom_info%id_atmname, 1, nblock)
111 CALL reallocate(atom_info%r, 1, 3, 1, nblock)
112 CALL reallocate(atom_info%atm_mass, 1, nblock)
113 CALL reallocate(atom_info%atm_charge, 1, nblock)
114 CALL reallocate(atom_info%occup, 1, nblock)
115 CALL reallocate(atom_info%beta, 1, nblock)
116 CALL reallocate(atom_info%id_element, 1, nblock)
117
118 IF (iw > 0) WRITE (iw, *) " Reading in XTL file ", trim(topology%coord_file_name)
119 CALL parser_create(parser, topology%coord_file_name, para_env=para_env)
120
121 ! Check for TITLE
122 CALL parser_search_string(parser, "TITLE", ignore_case=.false., found=found, &
123 begin_line=.false., search_from_begin_of_file=.true.)
124 IF (found) THEN
125 IF (iw > 0) WRITE (iw, '(/,A)') " XTL_INFO| TITLE :: "//trim(parser%input_line(parser%icol:))
126 END IF
127
128 ! Check for _chemical_formula_sum
129 CALL parser_search_string(parser, "DIMENSION", ignore_case=.false., found=found, &
130 begin_line=.false., search_from_begin_of_file=.true.)
131 IF (found) THEN
132 IF (iw > 0) WRITE (iw, '(A)') " XTL_INFO| DIMENSION :: "//trim(parser%input_line(parser%icol:))
133 CALL parser_get_object(parser, dimensions)
134 IF (dimensions /= 3) THEN
135 cpabort("XTL file with working DIMENSION different from 3 cannot be parsed!")
136 END IF
137 ELSE
138 ! Assuming by default we work in 3D-periodic systems
139 dimensions = 3
140 END IF
141
142 ! Parsing cell infos
143 periodic = 1
144 ! Check for _cell_length_a
145 CALL parser_search_string(parser, "CELL", ignore_case=.false., found=found, &
146 begin_line=.false., search_from_begin_of_file=.true.)
147 IF (.NOT. found) THEN
148 cpabort("The field CELL was not found in XTL file! ")
149 END IF
150 CALL parser_get_next_line(parser, 1)
151 ! CELL LENGTH A
152 CALL parser_get_object(parser, cell_lengths(1))
153 cell_lengths(1) = cp_unit_to_cp2k(cell_lengths(1), "angstrom")
154 ! CELL LENGTH B
155 CALL parser_get_object(parser, cell_lengths(2))
156 cell_lengths(2) = cp_unit_to_cp2k(cell_lengths(2), "angstrom")
157 ! CELL LENGTH C
158 CALL parser_get_object(parser, cell_lengths(3))
159 cell_lengths(3) = cp_unit_to_cp2k(cell_lengths(3), "angstrom")
160
161 ! CELL ANGLE ALPHA
162 CALL parser_get_object(parser, cell_angles(1))
163 cell_angles(1) = cp_unit_to_cp2k(cell_angles(1), "deg")
164 ! CELL ANGLE BETA
165 CALL parser_get_object(parser, cell_angles(2))
166 cell_angles(2) = cp_unit_to_cp2k(cell_angles(2), "deg")
167 ! CELL ANGLE GAMMA
168 CALL parser_get_object(parser, cell_angles(3))
169 cell_angles(3) = cp_unit_to_cp2k(cell_angles(3), "deg")
170
171 ! Create cell
172 NULLIFY (cell)
173 CALL cell_create(cell, tag="CELL_XTL")
174 CALL set_cell_param(cell, cell_lengths, cell_angles, periodic=periodic, &
175 do_init_cell=.true.)
176 CALL write_cell(cell, subsys_section)
177
178 ! Parse atoms info and fractional coordinates
179 ! Check for _atom_site_label
180 CALL parser_search_string(parser, "ATOMS", ignore_case=.false., found=found, &
181 begin_line=.false., search_from_begin_of_file=.true.)
182 IF (.NOT. found) THEN
183 cpabort("The field ATOMS was not found in XTL file! ")
184 END IF
185 CALL parser_get_next_line(parser, 1)
186 ! Paranoic syntax check.. if this fails one should improve the description of XTL files
187 found = (index(parser%input_line, "NAME X Y Z") /= 0)
188 IF (.NOT. found) THEN
189 cpabort("The field ATOMS in XTL file, is not followed by name and coordinates tags! ")
190 END IF
191 CALL parser_get_next_line(parser, 1)
192 ! Parse real info
193 natom = 0
194 DO WHILE (index(parser%input_line, "EOF") == 0)
195 natom = natom + 1
196 ! Resize in case needed
197 IF (natom > SIZE(atom_info%id_molname)) THEN
198 newsize = int(pfactor*natom)
199 CALL reallocate(atom_info%id_molname, 1, newsize)
200 CALL reallocate(atom_info%id_resname, 1, newsize)
201 CALL reallocate(atom_info%resid, 1, newsize)
202 CALL reallocate(atom_info%id_atmname, 1, newsize)
203 CALL reallocate(atom_info%r, 1, 3, 1, newsize)
204 CALL reallocate(atom_info%atm_mass, 1, newsize)
205 CALL reallocate(atom_info%atm_charge, 1, newsize)
206 CALL reallocate(atom_info%occup, 1, newsize)
207 CALL reallocate(atom_info%beta, 1, newsize)
208 CALL reallocate(atom_info%id_element, 1, newsize)
209 END IF
210 ! NAME
211 CALL parser_get_object(parser, strtmp)
212 atom_info%id_atmname(natom) = str2id(strtmp)
213 atom_info%id_molname(natom) = str2id(s2s("MOL"//trim(adjustl(cp_to_string(natom)))))
214 atom_info%id_resname(natom) = atom_info%id_molname(natom)
215 atom_info%resid(natom) = 1
216 atom_info%id_element(natom) = atom_info%id_atmname(natom)
217 ! X
218 CALL parser_get_object(parser, atom_info%r(1, natom))
219 ! Y
220 CALL parser_get_object(parser, atom_info%r(2, natom))
221 ! Z
222 CALL parser_get_object(parser, atom_info%r(3, natom))
223 s = atom_info%r(1:3, natom)
224 CALL scaled_to_real(atom_info%r(1:3, natom), s, cell)
225 CALL parser_get_next_line(parser, 1, at_end=my_end)
226 IF (my_end) EXIT
227 END DO
228 !
229 threshold2 = threshold*threshold
230 ! Preliminary check: check if atoms provided are really unique.. this is a paranoic
231 ! check since they should be REALLY unique.. anyway..
232 DO ii = 1, natom
233 r1 = atom_info%r(1:3, ii)
234 DO jj = ii + 1, natom
235 r2 = atom_info%r(1:3, jj)
236 r = pbc(r1 - r2, cell)
237 ! SQRT(DOT_PRODUCT(r, r)) >= threshold
238 check = (dot_product(r, r) >= threshold2)
239 cpassert(check)
240 END DO
241 END DO
242 ! Parse Symmetry Group and generation elements..
243 ! Check for SYMMETRY
244 CALL parser_search_string(parser, "SYMMETRY", ignore_case=.false., found=found, &
245 begin_line=.false., search_from_begin_of_file=.true.)
246 IF (found) THEN
247 IF (iw > 0) WRITE (iw, '(A)') " XTL_INFO| Symmetry Infos :: "//trim(parser%input_line(parser%icol:))
248 END IF
249
250 ! Check for SYM MAT
251 CALL parser_search_string(parser, "SYM MAT", ignore_case=.false., found=found, &
252 begin_line=.false., search_from_begin_of_file=.true.)
253 cpwarn_if(.NOT. found, "The field SYM MAT was not found in XTL file! ")
254 IF (iw > 0) WRITE (iw, '(A,I0)') " XTL_INFO| Number of atoms before applying symmetry operations :: ", natom
255 IF (iw > 0) WRITE (iw, '(A10,1X,3F12.6)') (trim(id2str(atom_info%id_atmname(ii))), atom_info%r(1:3, ii), ii=1, natom)
256 IF (found) THEN
257 ! Apply symmetry elements and generate the whole set of atoms in the unit cell
258 isym = 0
259 natom_orig = natom
260 DO WHILE (found)
261 isym = isym + 1
262 icol = index(parser%input_line, "SYM MAT") + 8
263 READ (parser%input_line(icol:), *) ((rot_mat(ii, jj), jj=1, 3), ii=1, 3), transl_vec(1:3)
264 loop_over_unique_atoms: DO ii = 1, natom_orig
265 ! Rotate and apply translation
266 r1 = matmul(rot_mat, atom_info%r(1:3, ii)) + transl_vec
267 ! Verify if this atom is really unique..
268 check = .true.
269 DO jj = 1, natom
270 r2 = atom_info%r(1:3, jj)
271 r = pbc(r1 - r2, cell)
272 ! SQRT(DOT_PRODUCT(r, r)) <= threshold
273 IF (dot_product(r, r) <= threshold2) THEN
274 check = .false.
275 EXIT
276 END IF
277 END DO
278 ! If the atom generated is unique let's add to the atom set..
279 IF (check) THEN
280 natom = natom + 1
281 ! Resize in case needed
282 IF (natom > SIZE(atom_info%id_molname)) THEN
283 newsize = int(pfactor*natom)
284 CALL reallocate(atom_info%id_molname, 1, newsize)
285 CALL reallocate(atom_info%id_resname, 1, newsize)
286 CALL reallocate(atom_info%resid, 1, newsize)
287 CALL reallocate(atom_info%id_atmname, 1, newsize)
288 CALL reallocate(atom_info%r, 1, 3, 1, newsize)
289 CALL reallocate(atom_info%atm_mass, 1, newsize)
290 CALL reallocate(atom_info%atm_charge, 1, newsize)
291 CALL reallocate(atom_info%occup, 1, newsize)
292 CALL reallocate(atom_info%beta, 1, newsize)
293 CALL reallocate(atom_info%id_element, 1, newsize)
294 END IF
295 atom_info%id_atmname(natom) = atom_info%id_atmname(ii)
296 atom_info%id_molname(natom) = atom_info%id_molname(ii)
297 atom_info%id_resname(natom) = atom_info%id_resname(ii)
298 atom_info%resid(natom) = atom_info%resid(ii)
299 atom_info%id_element(natom) = atom_info%id_element(ii)
300 atom_info%r(1:3, natom) = r1
301 END IF
302 END DO loop_over_unique_atoms
303 CALL parser_search_string(parser, "SYM MAT", ignore_case=.false., found=found, &
304 begin_line=.false., search_from_begin_of_file=.false.)
305 END DO
306 END IF
307 IF (iw > 0) WRITE (iw, '(A,I0)') " XTL_INFO| Number of symmetry operations :: ", isym
308 IF (iw > 0) WRITE (iw, '(A,I0)') " XTL_INFO| Number of total atoms :: ", natom
309 IF (iw > 0) WRITE (iw, '(A10,1X,3F12.6)') (trim(id2str(atom_info%id_atmname(ii))), atom_info%r(1:3, ii), ii=1, natom)
310
311 ! Releasse local cell type and parser
312 CALL cell_release(cell)
313 CALL parser_release(parser)
314
315 ! Reallocate all structures with the exact NATOM size
316 CALL reallocate(atom_info%id_molname, 1, natom)
317 CALL reallocate(atom_info%id_resname, 1, natom)
318 CALL reallocate(atom_info%resid, 1, natom)
319 CALL reallocate(atom_info%id_atmname, 1, natom)
320 CALL reallocate(atom_info%r, 1, 3, 1, natom)
321 CALL reallocate(atom_info%atm_mass, 1, natom)
322 CALL reallocate(atom_info%atm_charge, 1, natom)
323 CALL reallocate(atom_info%occup, 1, natom)
324 CALL reallocate(atom_info%beta, 1, natom)
325 CALL reallocate(atom_info%id_element, 1, natom)
326
327 topology%natoms = natom
328 topology%molname_generated = .true.
329 CALL cp_print_key_finished_output(iw, logger, subsys_section, &
330 "PRINT%TOPOLOGY_INFO/XTL_INFO")
331 CALL timestop(handle)
332 END SUBROUTINE read_coordinate_xtl
333
334END MODULE topology_xtl
cell_types::pbc
Definition cell_types.F:103
cp_log_handling::cp_to_string
Definition cp_log_handling.F:90
cp_parser_methods::parser_get_object
Definition cp_parser_methods.F:54
memory_utilities::reallocate
Definition memory_utilities.F:27
cell_methods
Handles all functions related to the CELL.
Definition cell_methods.F:15
cell_methods::write_cell
subroutine, public write_cell(cell, subsys_section, tag)
Write the cell parameters to the output unit.
Definition cell_methods.F:1359
cell_methods::set_cell_param
subroutine, public set_cell_param(cell, cell_length, cell_angle, periodic, do_init_cell)
Sets the cell using the internal parameters (a,b,c) (alpha,beta,gamma) using the convention: a parall...
Definition cell_methods.F:671
cell_methods::cell_create
subroutine, public cell_create(cell, hmat, periodic, tag)
allocates and initializes a cell
Definition cell_methods.F:94
cell_types
Handles all functions related to the CELL.
Definition cell_types.F:15
cell_types::scaled_to_real
subroutine, public scaled_to_real(r, s, cell)
Transform scaled cell coordinates real coordinates. r=h*s.
Definition cell_types.F:565
cell_types::cell_release
subroutine, public cell_release(cell)
releases the given cell (see doc/ReferenceCounting.html)
Definition cell_types.F:608
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
cp_output_handling
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
Definition cp_output_handling.F:25
cp_output_handling::cp_print_key_unit_nr
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
Definition cp_output_handling.F:853
cp_output_handling::cp_print_key_finished_output
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
Definition cp_output_handling.F:1073
cp_parser_methods
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_methods.F:20
cp_parser_methods::parser_get_next_line
subroutine, public parser_get_next_line(parser, nline, at_end)
Read the next input line and broadcast the input information. Skip (nline-1) lines and skip also all ...
Definition cp_parser_methods.F:421
cp_parser_methods::parser_search_string
subroutine, public parser_search_string(parser, string, ignore_case, found, line, begin_line, search_from_begin_of_file)
Search a string pattern in a file defined by its logical unit number "unit". A case sensitive search ...
Definition cp_parser_methods.F:787
cp_parser_types
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_types.F:21
cp_parser_types::parser_release
subroutine, public parser_release(parser)
releases the parser
Definition cp_parser_types.F:109
cp_parser_types::parser_create
subroutine, public parser_create(parser, file_name, unit_nr, para_env, end_section_label, separator_chars, comment_char, continuation_char, quote_char, section_char, parse_white_lines, initial_variables, apply_preprocessing)
Start a parser run. Initial variables allow to @SET stuff before opening the file.
Definition cp_parser_types.F:147
cp_units
unit conversion facility
Definition cp_units.F:30
cp_units::cp_unit_to_cp2k
real(kind=dp) function, public cp_unit_to_cp2k(value, unit_str, defaults, power)
converts to the internal cp2k units to the given unit
Definition cp_units.F:1222
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition input_section_types.F:15
input_section_types::section_get_rval
real(kind=dp) function, public section_get_rval(section_vals, keyword_name)
...
Definition input_section_types.F:953
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
memory_utilities
Utility routines for the memory handling.
Definition memory_utilities.F:14
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
string_table
generates a unique id number for a string (str2id) that can be used two compare two strings....
Definition string_table.F:22
string_table::s2s
character(len=default_string_length) function, public s2s(str)
converts a string in a string of default_string_length
Definition string_table.F:141
string_table::str2id
integer function, public str2id(str)
returns a unique id for a given string, and stores the string for later retrieval using the id.
Definition string_table.F:72
string_table::id2str
character(len=default_string_length) function, public id2str(id)
returns the string associated with a given id
Definition string_table.F:115
topology_types
Definition topology_types.F:18
topology_xtl
Handles XTL (Molecular Simulations, Inc (MSI)) files.
Definition topology_xtl.F:13
topology_xtl::read_coordinate_xtl
subroutine, public read_coordinate_xtl(topology, para_env, subsys_section)
Performs the real task of reading the proper information from the XTL file.
Definition topology_xtl.F:74
topology
Control for reading in different topologies and coordinates.
Definition topology.F:13
cell_types::cell_type
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
cp_parser_types::cp_parser_type
represent a parser
Definition cp_parser_types.F:77
input_section_types::section_vals_type
stores the values of a section
Definition input_section_types.F:127
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:746
topology_types::atom_info_type
Definition topology_types.F:35
topology_types::topology_parameters_type
Definition topology_types.F:144