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 Output Utilities for MOTION_SECTION
10 : !> \author Teodoro Laino [tlaino] - University of Zurich
11 : !> \date 02.2008
12 : ! **************************************************************************************************
13 : MODULE motion_utils
14 :
15 : USE cell_types, ONLY: cell_type
16 : USE cp2k_info, ONLY: compile_revision,&
17 : cp2k_version,&
18 : r_datx,&
19 : r_host_name,&
20 : r_user_name
21 : USE cp_log_handling, ONLY: cp_get_default_logger,&
22 : cp_logger_type
23 : USE cp_output_handling, ONLY: cp_print_key_finished_output,&
24 : cp_print_key_unit_nr
25 : USE cp_subsys_types, ONLY: cp_subsys_get,&
26 : cp_subsys_type
27 : USE cp_units, ONLY: cp_unit_from_cp2k
28 : USE force_env_types, ONLY: force_env_get,&
29 : force_env_type
30 : USE input_constants, ONLY: dump_atomic,&
31 : dump_dcd,&
32 : dump_dcd_aligned_cell,&
33 : dump_pdb,&
34 : dump_xmol
35 : USE input_section_types, ONLY: section_get_ival,&
36 : section_vals_get,&
37 : section_vals_get_subs_vals,&
38 : section_vals_type,&
39 : section_vals_val_get
40 : USE kinds, ONLY: default_string_length,&
41 : dp,&
42 : sp
43 : USE machine, ONLY: m_flush
44 : USE mathlib, ONLY: diamat_all
45 : USE particle_list_types, ONLY: particle_list_type
46 : USE particle_methods, ONLY: write_particle_coordinates
47 : USE particle_types, ONLY: particle_type
48 : USE physcon, ONLY: angstrom
49 : USE virial_types, ONLY: virial_type
50 : #include "./base/base_uses.f90"
51 :
52 : IMPLICIT NONE
53 :
54 : PRIVATE
55 :
56 : PUBLIC :: write_trajectory, write_stress_tensor_to_file, write_simulation_cell, &
57 : get_output_format, rot_ana
58 :
59 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'motion_utils'
60 : REAL(KIND=dp), PARAMETER, PUBLIC :: thrs_motion = 5.0E-10_dp
61 :
62 : CONTAINS
63 :
64 : ! **************************************************************************************************
65 : !> \brief Performs an analysis of the principal inertia axis
66 : !> Getting back the generators of the translating and
67 : !> rotating frame
68 : !> \param particles ...
69 : !> \param mat ...
70 : !> \param dof ...
71 : !> \param print_section ...
72 : !> \param keep_rotations ...
73 : !> \param mass_weighted ...
74 : !> \param natoms ...
75 : !> \param rot_dof ...
76 : !> \param inertia ...
77 : !> \author Teodoro Laino 08.2006
78 : ! **************************************************************************************************
79 2162 : SUBROUTINE rot_ana(particles, mat, dof, print_section, keep_rotations, mass_weighted, &
80 : natoms, rot_dof, inertia)
81 : TYPE(particle_type), DIMENSION(:), POINTER :: particles
82 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: mat
83 : INTEGER, INTENT(OUT) :: dof
84 : TYPE(section_vals_type), POINTER :: print_section
85 : LOGICAL, INTENT(IN) :: keep_rotations, mass_weighted
86 : INTEGER, INTENT(IN) :: natoms
87 : INTEGER, INTENT(OUT), OPTIONAL :: rot_dof
88 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: inertia(3)
89 :
90 : CHARACTER(len=*), PARAMETER :: routineN = 'rot_ana'
91 :
92 : INTEGER :: handle, i, iparticle, iseq, iw, j, k, &
93 : lrot(3)
94 : LOGICAL :: present_mat
95 : REAL(KIND=dp) :: cp(3), Ip(3, 3), Ip_eigval(3), mass, &
96 : masst, norm, rcom(3), rm(3)
97 2162 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: Rot, Tr
98 : TYPE(cp_logger_type), POINTER :: logger
99 :
100 2162 : CALL timeset(routineN, handle)
101 2162 : logger => cp_get_default_logger()
102 2162 : present_mat = PRESENT(mat)
103 2162 : CPASSERT(ASSOCIATED(particles))
104 2162 : IF (present_mat) THEN
105 376 : CPASSERT(.NOT. ASSOCIATED(mat))
106 : END IF
107 2162 : IF (.NOT. keep_rotations) THEN
108 2160 : rcom = 0.0_dp
109 2160 : masst = 0.0_dp
110 : ! Center of mass
111 489724 : DO iparticle = 1, natoms
112 487564 : mass = 1.0_dp
113 487564 : IF (mass_weighted) mass = particles(iparticle)%atomic_kind%mass
114 487564 : CPASSERT(mass >= 0.0_dp)
115 487564 : masst = masst + mass
116 1952416 : rcom = particles(iparticle)%r*mass + rcom
117 : END DO
118 2160 : CPASSERT(masst > 0.0_dp)
119 8640 : rcom = rcom/masst
120 : ! Intertia Tensor
121 2160 : Ip = 0.0_dp
122 489724 : DO iparticle = 1, natoms
123 487564 : mass = 1.0_dp
124 487564 : IF (mass_weighted) mass = particles(iparticle)%atomic_kind%mass
125 1950256 : rm = particles(iparticle)%r - rcom
126 487564 : Ip(1, 1) = Ip(1, 1) + mass*(rm(2)**2 + rm(3)**2)
127 487564 : Ip(2, 2) = Ip(2, 2) + mass*(rm(1)**2 + rm(3)**2)
128 487564 : Ip(3, 3) = Ip(3, 3) + mass*(rm(1)**2 + rm(2)**2)
129 487564 : Ip(1, 2) = Ip(1, 2) - mass*(rm(1)*rm(2))
130 487564 : Ip(1, 3) = Ip(1, 3) - mass*(rm(1)*rm(3))
131 489724 : Ip(2, 3) = Ip(2, 3) - mass*(rm(2)*rm(3))
132 : END DO
133 : ! Diagonalize the Inertia Tensor
134 2160 : CALL diamat_all(Ip, Ip_eigval)
135 2160 : IF (PRESENT(inertia)) inertia = Ip_eigval
136 2160 : iw = cp_print_key_unit_nr(logger, print_section, "ROTATIONAL_INFO", extension=".vibLog")
137 2160 : IF (iw > 0) THEN
138 : WRITE (UNIT=iw, FMT='(/,T2,A)') &
139 989 : 'ROT| Rotational analysis information'
140 : WRITE (UNIT=iw, FMT='(T2,A)') &
141 989 : 'ROT| Principal axes and moments of inertia [a.u.]'
142 : WRITE (UNIT=iw, FMT='(T2,A,T14,3(1X,I19))') &
143 989 : 'ROT|', 1, 2, 3
144 : WRITE (UNIT=iw, FMT='(T2,A,T21,3(1X,ES19.11))') &
145 989 : 'ROT| Eigenvalues', Ip_eigval(1:3)
146 : WRITE (UNIT=iw, FMT='(T2,A,T21,3(1X,F19.12))') &
147 989 : 'ROT| x', Ip(1, 1:3)
148 : WRITE (UNIT=iw, FMT='(T2,A,T21,3(1X,F19.12))') &
149 989 : 'ROT| y', Ip(2, 1:3)
150 : WRITE (UNIT=iw, FMT='(T2,A,T21,3(1X,F19.12))') &
151 989 : 'ROT| z', Ip(3, 1:3)
152 : END IF
153 2160 : CALL cp_print_key_finished_output(iw, logger, print_section, "ROTATIONAL_INFO")
154 2160 : iw = cp_print_key_unit_nr(logger, print_section, "ROTATIONAL_INFO/COORDINATES", extension=".vibLog")
155 2160 : IF (iw > 0) THEN
156 62 : WRITE (UNIT=iw, FMT='(/,T2,A)') 'ROT| Standard molecule orientation in Angstrom'
157 428 : DO iparticle = 1, natoms
158 : WRITE (UNIT=iw, FMT='(T2,"ROT|",T20,A,T27,3(3X,F15.9))') &
159 366 : TRIM(particles(iparticle)%atomic_kind%name), &
160 6284 : MATMUL(particles(iparticle)%r, Ip)*angstrom
161 : END DO
162 : END IF
163 2160 : CALL cp_print_key_finished_output(iw, logger, print_section, "ROTATIONAL_INFO/COORDINATES")
164 : END IF
165 : ! Build up the Translational vectors
166 8648 : ALLOCATE (Tr(natoms*3, 3))
167 4396778 : Tr = 0.0_dp
168 8648 : DO k = 1, 3
169 : iseq = 0
170 1471358 : DO iparticle = 1, natoms
171 1462710 : mass = 1.0_dp
172 1462710 : IF (mass_weighted) mass = SQRT(particles(iparticle)%atomic_kind%mass)
173 5857326 : DO j = 1, 3
174 4388130 : iseq = iseq + 1
175 5850840 : IF (j == k) Tr(iseq, k) = mass
176 : END DO
177 : END DO
178 : END DO
179 : ! Normalize Translations
180 8648 : DO i = 1, 3
181 4394616 : norm = SQRT(DOT_PRODUCT(Tr(:, i), Tr(:, i)))
182 4396778 : Tr(:, i) = Tr(:, i)/norm
183 : END DO
184 2162 : dof = 3
185 : ! Build up the Rotational vectors
186 4324 : ALLOCATE (Rot(natoms*3, 3))
187 2162 : lrot = 0
188 2162 : IF (.NOT. keep_rotations) THEN
189 489724 : DO iparticle = 1, natoms
190 487564 : mass = 1.0_dp
191 487564 : IF (mass_weighted) mass = SQRT(particles(iparticle)%atomic_kind%mass)
192 1950256 : rm = particles(iparticle)%r - rcom
193 487564 : cp(1) = rm(1)*Ip(1, 1) + rm(2)*Ip(2, 1) + rm(3)*Ip(3, 1)
194 487564 : cp(2) = rm(1)*Ip(1, 2) + rm(2)*Ip(2, 2) + rm(3)*Ip(3, 2)
195 487564 : cp(3) = rm(1)*Ip(1, 3) + rm(2)*Ip(2, 3) + rm(3)*Ip(3, 3)
196 : ! X Rot
197 487564 : Rot((iparticle - 1)*3 + 1, 1) = (cp(2)*Ip(1, 3) - Ip(1, 2)*cp(3))*mass
198 487564 : Rot((iparticle - 1)*3 + 2, 1) = (cp(2)*Ip(2, 3) - Ip(2, 2)*cp(3))*mass
199 487564 : Rot((iparticle - 1)*3 + 3, 1) = (cp(2)*Ip(3, 3) - Ip(3, 2)*cp(3))*mass
200 : ! Y Rot
201 487564 : Rot((iparticle - 1)*3 + 1, 2) = (cp(3)*Ip(1, 1) - Ip(1, 3)*cp(1))*mass
202 487564 : Rot((iparticle - 1)*3 + 2, 2) = (cp(3)*Ip(2, 1) - Ip(2, 3)*cp(1))*mass
203 487564 : Rot((iparticle - 1)*3 + 3, 2) = (cp(3)*Ip(3, 1) - Ip(3, 3)*cp(1))*mass
204 : ! Z Rot
205 487564 : Rot((iparticle - 1)*3 + 1, 3) = (cp(1)*Ip(1, 2) - Ip(1, 1)*cp(2))*mass
206 487564 : Rot((iparticle - 1)*3 + 2, 3) = (cp(1)*Ip(2, 2) - Ip(2, 1)*cp(2))*mass
207 489724 : Rot((iparticle - 1)*3 + 3, 3) = (cp(1)*Ip(3, 2) - Ip(3, 1)*cp(2))*mass
208 : END DO
209 :
210 : ! Normalize Rotations and count the number of degree of freedom
211 8640 : lrot = 1
212 8640 : DO i = 1, 3
213 4394556 : norm = SQRT(DOT_PRODUCT(Rot(:, i), Rot(:, i)))
214 6480 : IF (norm <= SQRT(thrs_motion)) THEN
215 226 : lrot(i) = 0
216 226 : CYCLE
217 : END IF
218 4393010 : Rot(:, i) = Rot(:, i)/norm
219 : ! Clean Rotational modes for spurious/numerical contamination
220 8414 : IF (i < 3) THEN
221 10360 : DO j = 1, i
222 8783872 : Rot(:, i + 1) = Rot(:, i + 1) - DOT_PRODUCT(Rot(:, i + 1), Rot(:, j))*Rot(:, j)
223 : END DO
224 : END IF
225 : END DO
226 : END IF
227 7520 : IF (PRESENT(rot_dof)) rot_dof = COUNT(lrot == 1)
228 8648 : dof = dof + COUNT(lrot == 1)
229 2162 : iw = cp_print_key_unit_nr(logger, print_section, "ROTATIONAL_INFO", extension=".vibLog")
230 2162 : IF (iw > 0) THEN
231 989 : WRITE (iw, '(T2,A,T71,I10)') 'ROT| Number of rotovibrational vectors', dof
232 989 : IF (dof == 5) THEN
233 : WRITE (iw, '(T2,A)') &
234 92 : 'ROT| Linear molecule detected'
235 : END IF
236 989 : IF ((dof == 3) .AND. (.NOT. keep_rotations)) THEN
237 : WRITE (iw, '(T2,A)') &
238 6 : 'ROT| Single atom detected'
239 : END IF
240 : END IF
241 2162 : CALL cp_print_key_finished_output(iw, logger, print_section, "ROTATIONAL_INFO")
242 2162 : IF (present_mat) THEN
243 : ! Give back the vectors generating the rototranslating Frame
244 1504 : ALLOCATE (mat(natoms*3, dof))
245 376 : iseq = 0
246 1504 : DO i = 1, 3
247 17310 : mat(:, i) = Tr(:, i)
248 1504 : IF (lrot(i) == 1) THEN
249 1072 : iseq = iseq + 1
250 16900 : mat(:, 3 + iseq) = Rot(:, i)
251 : END IF
252 : END DO
253 : END IF
254 2162 : DEALLOCATE (Tr)
255 2162 : DEALLOCATE (Rot)
256 2162 : CALL timestop(handle)
257 :
258 2162 : END SUBROUTINE rot_ana
259 :
260 : ! **************************************************************************************************
261 : !> \brief Prints the information controlled by the TRAJECTORY section
262 : !> \param force_env ...
263 : !> \param root_section ...
264 : !> \param it ...
265 : !> \param time ...
266 : !> \param dtime ...
267 : !> \param etot ...
268 : !> \param pk_name ...
269 : !> \param pos ...
270 : !> \param act ...
271 : !> \param middle_name ...
272 : !> \param particles ...
273 : !> \param extended_xmol_title ...
274 : !> \date 02.2008
275 : !> \author Teodoro Laino [tlaino] - University of Zurich
276 : !> \version 1.0
277 : ! **************************************************************************************************
278 229420 : SUBROUTINE write_trajectory(force_env, root_section, it, time, dtime, etot, pk_name, &
279 : pos, act, middle_name, particles, extended_xmol_title)
280 : TYPE(force_env_type), POINTER :: force_env
281 : TYPE(section_vals_type), POINTER :: root_section
282 : INTEGER, INTENT(IN) :: it
283 : REAL(KIND=dp), INTENT(IN) :: time, dtime, etot
284 : CHARACTER(LEN=*), OPTIONAL :: pk_name
285 : CHARACTER(LEN=default_string_length), OPTIONAL :: pos, act
286 : CHARACTER(LEN=*), OPTIONAL :: middle_name
287 : TYPE(particle_list_type), OPTIONAL, POINTER :: particles
288 : LOGICAL, INTENT(IN), OPTIONAL :: extended_xmol_title
289 :
290 : CHARACTER(LEN=*), PARAMETER :: routineN = 'write_trajectory'
291 :
292 : CHARACTER(LEN=4) :: id_dcd
293 : CHARACTER(LEN=default_string_length) :: id_label, id_wpc, my_act, my_ext, &
294 : my_form, my_middle, my_pk_name, &
295 : my_pos, remark1, remark2, section_ref, &
296 : title, unit_str
297 : INTEGER :: handle, i, ii, iskip, nat, outformat, &
298 : traj_unit
299 229420 : INTEGER, POINTER :: force_mixing_indices(:), &
300 229420 : force_mixing_labels(:)
301 : LOGICAL :: charge_beta, charge_extended, &
302 : charge_occup, explicit, &
303 : my_extended_xmol_title, new_file, &
304 : print_kind
305 229420 : REAL(dp), ALLOCATABLE :: fml_array(:)
306 : REAL(KIND=dp) :: unit_conv
307 : TYPE(cell_type), POINTER :: cell
308 : TYPE(cp_logger_type), POINTER :: logger
309 : TYPE(cp_subsys_type), POINTER :: subsys
310 : TYPE(particle_list_type), POINTER :: my_particles
311 229420 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
312 : TYPE(section_vals_type), POINTER :: force_env_section, &
313 : force_mixing_restart_section
314 :
315 229420 : CALL timeset(routineN, handle)
316 :
317 229420 : NULLIFY (logger, cell, subsys, my_particles, particle_set)
318 229420 : logger => cp_get_default_logger()
319 229420 : id_label = logger%iter_info%level_name(logger%iter_info%n_rlevel)
320 229420 : my_pos = "APPEND"
321 229420 : my_act = "WRITE"
322 229420 : my_middle = "pos"
323 229420 : my_pk_name = "TRAJECTORY"
324 229420 : IF (PRESENT(middle_name)) my_middle = middle_name
325 229420 : IF (PRESENT(pos)) my_pos = pos
326 229420 : IF (PRESENT(act)) my_act = act
327 229420 : IF (PRESENT(pk_name)) my_pk_name = pk_name
328 :
329 298637 : SELECT CASE (TRIM(my_pk_name))
330 : CASE ("TRAJECTORY", "SHELL_TRAJECTORY", "CORE_TRAJECTORY")
331 69217 : id_dcd = "CORD"
332 69217 : id_wpc = "POS"
333 : CASE ("VELOCITIES", "SHELL_VELOCITIES", "CORE_VELOCITIES")
334 47879 : id_dcd = "VEL "
335 47879 : id_wpc = "VEL"
336 : CASE ("FORCES", "SHELL_FORCES", "CORE_FORCES")
337 69217 : id_dcd = "FRC "
338 69217 : id_wpc = "FORCE"
339 : CASE ("FORCE_MIXING_LABELS")
340 43107 : id_dcd = "FML "
341 43107 : id_wpc = "FORCE_MIXING_LABELS"
342 : CASE DEFAULT
343 229420 : CPABORT("")
344 : END SELECT
345 :
346 229420 : charge_occup = .FALSE.
347 229420 : charge_beta = .FALSE.
348 229420 : charge_extended = .FALSE.
349 229420 : print_kind = .FALSE.
350 :
351 229420 : CALL force_env_get(force_env, cell=cell, subsys=subsys)
352 229420 : IF (PRESENT(particles)) THEN
353 30740 : CPASSERT(ASSOCIATED(particles))
354 30740 : my_particles => particles
355 : ELSE
356 198680 : CALL cp_subsys_get(subsys=subsys, particles=my_particles)
357 : END IF
358 229420 : particle_set => my_particles%els
359 229420 : nat = my_particles%n_els
360 :
361 : ! Gather units of measure for output (if available)
362 229420 : IF (TRIM(my_pk_name) /= "FORCE_MIXING_LABELS") THEN
363 : CALL section_vals_val_get(root_section, "MOTION%PRINT%"//TRIM(my_pk_name)//"%UNIT", &
364 186313 : c_val=unit_str)
365 186313 : unit_conv = cp_unit_from_cp2k(1.0_dp, TRIM(unit_str))
366 : END IF
367 :
368 : ! Get the output format
369 229420 : CALL get_output_format(root_section, "MOTION%PRINT%"//TRIM(my_pk_name), my_form, my_ext)
370 : traj_unit = cp_print_key_unit_nr(logger, root_section, "MOTION%PRINT%"//TRIM(my_pk_name), &
371 : extension=my_ext, file_position=my_pos, file_action=my_act, &
372 229420 : file_form=my_form, middle_name=TRIM(my_middle), is_new_file=new_file)
373 229420 : IF (traj_unit > 0) THEN
374 : CALL section_vals_val_get(root_section, "MOTION%PRINT%"//TRIM(my_pk_name)//"%FORMAT", &
375 22785 : i_val=outformat)
376 22785 : title = ""
377 4 : SELECT CASE (outformat)
378 : CASE (dump_dcd, dump_dcd_aligned_cell)
379 4 : IF (new_file) THEN
380 : !Lets write the header for the coordinate dcd
381 1 : section_ref = "MOTION%PRINT%"//TRIM(my_pk_name)//"%EACH%"//TRIM(id_label)
382 1 : iskip = section_get_ival(root_section, TRIM(section_ref))
383 1 : WRITE (UNIT=traj_unit) id_dcd, 0, it, iskip, 0, 0, 0, 0, 0, 0, REAL(dtime, KIND=sp), &
384 2 : 1, 0, 0, 0, 0, 0, 0, 0, 0, 24
385 : remark1 = "REMARK "//id_dcd//" DCD file created by "//TRIM(cp2k_version)// &
386 1 : " (revision "//TRIM(compile_revision)//")"
387 1 : remark2 = "REMARK "//TRIM(r_user_name)//"@"//TRIM(r_host_name)
388 1 : WRITE (UNIT=traj_unit) 2, remark1, remark2
389 1 : WRITE (UNIT=traj_unit) nat
390 1 : CALL m_flush(traj_unit)
391 : END IF
392 : CASE (dump_xmol)
393 22712 : my_extended_xmol_title = .FALSE.
394 : CALL section_vals_val_get(root_section, "MOTION%PRINT%TRAJECTORY%PRINT_ATOM_KIND", &
395 22712 : l_val=print_kind)
396 22712 : IF (PRESENT(extended_xmol_title)) my_extended_xmol_title = extended_xmol_title
397 : ! This information can be digested by Molden
398 18405 : IF (my_extended_xmol_title) THEN
399 : WRITE (UNIT=title, FMT="(A,I8,A,F12.3,A,F20.10)") &
400 18405 : " i = ", it, ", time = ", time, ", E = ", etot
401 : ELSE
402 4307 : WRITE (UNIT=title, FMT="(A,I8,A,F20.10)") " i = ", it, ", E = ", etot
403 : END IF
404 : CASE (dump_atomic)
405 : ! Do nothing
406 : CASE (dump_pdb)
407 59 : IF (id_wpc == "POS") THEN
408 : CALL section_vals_val_get(root_section, "MOTION%PRINT%TRAJECTORY%CHARGE_OCCUP", &
409 59 : l_val=charge_occup)
410 : CALL section_vals_val_get(root_section, "MOTION%PRINT%TRAJECTORY%CHARGE_BETA", &
411 59 : l_val=charge_beta)
412 : CALL section_vals_val_get(root_section, "MOTION%PRINT%TRAJECTORY%CHARGE_EXTENDED", &
413 59 : l_val=charge_extended)
414 236 : i = COUNT((/charge_occup, charge_beta, charge_extended/))
415 59 : IF (i > 1) &
416 0 : CPABORT("Either only CHARGE_OCCUP, CHARGE_BETA, or CHARGE_EXTENDED can be selected, ")
417 : END IF
418 59 : IF (new_file) THEN
419 : ! COLUMNS DATA TYPE FIELD DEFINITION
420 : ! 1 - 6 Record name "TITLE "
421 : ! 9 - 10 Continuation continuation Allows concatenation
422 : ! 11 - 70 String title Title of the experiment
423 : WRITE (UNIT=traj_unit, FMT="(A6,T11,A)") &
424 4 : "TITLE ", "PDB file created by "//TRIM(cp2k_version)//" (revision "//TRIM(compile_revision)//")", &
425 8 : "AUTHOR", TRIM(r_user_name)//"@"//TRIM(r_host_name)//" "//r_datx(1:19)
426 : END IF
427 59 : my_extended_xmol_title = .FALSE.
428 59 : IF (PRESENT(extended_xmol_title)) my_extended_xmol_title = extended_xmol_title
429 0 : IF (my_extended_xmol_title) THEN
430 : WRITE (UNIT=title, FMT="(A,I0,A,F0.3,A,F0.10)") &
431 0 : "Step ", it, ", time = ", time, ", E = ", etot
432 : ELSE
433 : WRITE (UNIT=title, FMT="(A,I0,A,F0.10)") &
434 59 : "Step ", it, ", E = ", etot
435 : END IF
436 : CASE DEFAULT
437 22785 : CPABORT("")
438 : END SELECT
439 22785 : IF (TRIM(my_pk_name) == "FORCE_MIXING_LABELS") THEN
440 453 : ALLOCATE (fml_array(3*SIZE(particle_set)))
441 25978 : fml_array = 0.0_dp
442 151 : CALL force_env_get(force_env, force_env_section=force_env_section)
443 : force_mixing_restart_section => section_vals_get_subs_vals(force_env_section, &
444 : "QMMM%FORCE_MIXING%RESTART_INFO", &
445 151 : can_return_null=.TRUE.)
446 151 : IF (ASSOCIATED(force_mixing_restart_section)) THEN
447 151 : CALL section_vals_get(force_mixing_restart_section, explicit=explicit)
448 151 : IF (explicit) THEN
449 0 : CALL section_vals_val_get(force_mixing_restart_section, "INDICES", i_vals=force_mixing_indices)
450 0 : CALL section_vals_val_get(force_mixing_restart_section, "LABELS", i_vals=force_mixing_labels)
451 0 : DO i = 1, SIZE(force_mixing_indices)
452 0 : ii = force_mixing_indices(i)
453 0 : CPASSERT(ii <= SIZE(particle_set))
454 0 : fml_array((ii - 1)*3 + 1:(ii - 1)*3 + 3) = force_mixing_labels(i)
455 : END DO
456 : END IF
457 : END IF
458 : CALL write_particle_coordinates(particle_set, traj_unit, outformat, TRIM(id_wpc), TRIM(title), cell, &
459 151 : array=fml_array, print_kind=print_kind)
460 151 : DEALLOCATE (fml_array)
461 : ELSE
462 : CALL write_particle_coordinates(particle_set, traj_unit, outformat, TRIM(id_wpc), TRIM(title), cell, &
463 : unit_conv=unit_conv, print_kind=print_kind, &
464 : charge_occup=charge_occup, &
465 : charge_beta=charge_beta, &
466 22634 : charge_extended=charge_extended)
467 : END IF
468 : END IF
469 :
470 229420 : CALL cp_print_key_finished_output(traj_unit, logger, root_section, "MOTION%PRINT%"//TRIM(my_pk_name))
471 :
472 229420 : CALL timestop(handle)
473 :
474 458840 : END SUBROUTINE write_trajectory
475 :
476 : ! **************************************************************************************************
477 : !> \brief Info on the unit to be opened to dump MD informations
478 : !> \param section ...
479 : !> \param path ...
480 : !> \param my_form ...
481 : !> \param my_ext ...
482 : !> \author Teodoro Laino - University of Zurich - 07.2007
483 : ! **************************************************************************************************
484 229446 : SUBROUTINE get_output_format(section, path, my_form, my_ext)
485 :
486 : TYPE(section_vals_type), POINTER :: section
487 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: path
488 : CHARACTER(LEN=*), INTENT(OUT) :: my_form, my_ext
489 :
490 : INTEGER :: output_format
491 :
492 229472 : IF (PRESENT(path)) THEN
493 229420 : CALL section_vals_val_get(section, TRIM(path)//"%FORMAT", i_val=output_format)
494 : ELSE
495 26 : CALL section_vals_val_get(section, "FORMAT", i_val=output_format)
496 : END IF
497 :
498 14 : SELECT CASE (output_format)
499 : CASE (dump_dcd, dump_dcd_aligned_cell)
500 14 : my_form = "UNFORMATTED"
501 14 : my_ext = ".dcd"
502 : CASE (dump_pdb)
503 118 : my_form = "FORMATTED"
504 118 : my_ext = ".pdb"
505 : CASE DEFAULT
506 229314 : my_form = "FORMATTED"
507 458760 : my_ext = ".xyz"
508 : END SELECT
509 :
510 229446 : END SUBROUTINE get_output_format
511 :
512 : ! **************************************************************************************************
513 : !> \brief Prints the Stress Tensor
514 : !> \param virial ...
515 : !> \param cell ...
516 : !> \param motion_section ...
517 : !> \param itimes ...
518 : !> \param time ...
519 : !> \param pos ...
520 : !> \param act ...
521 : !> \date 02.2008
522 : !> \author Teodoro Laino [tlaino] - University of Zurich
523 : !> \version 1.0
524 : ! **************************************************************************************************
525 55842 : SUBROUTINE write_stress_tensor_to_file(virial, cell, motion_section, itimes, time, pos, act)
526 :
527 : TYPE(virial_type), POINTER :: virial
528 : TYPE(cell_type), POINTER :: cell
529 : TYPE(section_vals_type), POINTER :: motion_section
530 : INTEGER, INTENT(IN) :: itimes
531 : REAL(KIND=dp), INTENT(IN) :: time
532 : CHARACTER(LEN=default_string_length), INTENT(IN), &
533 : OPTIONAL :: pos, act
534 :
535 : CHARACTER(LEN=default_string_length) :: my_act, my_pos
536 : INTEGER :: output_unit
537 : LOGICAL :: new_file
538 : REAL(KIND=dp), DIMENSION(3, 3) :: pv_total_bar
539 : TYPE(cp_logger_type), POINTER :: logger
540 :
541 55842 : NULLIFY (logger)
542 55842 : logger => cp_get_default_logger()
543 :
544 55842 : IF (virial%pv_availability) THEN
545 13220 : my_pos = "APPEND"
546 13220 : my_act = "WRITE"
547 13220 : IF (PRESENT(pos)) my_pos = pos
548 13220 : IF (PRESENT(act)) my_act = act
549 : output_unit = cp_print_key_unit_nr(logger, motion_section, "PRINT%STRESS", &
550 : extension=".stress", file_position=my_pos, &
551 : file_action=my_act, file_form="FORMATTED", &
552 13220 : is_new_file=new_file)
553 : ELSE
554 42622 : output_unit = 0
555 : END IF
556 :
557 55842 : IF (output_unit > 0) THEN
558 1482 : IF (new_file) THEN
559 : WRITE (UNIT=output_unit, FMT='(A,9(12X,A2," [bar]"),6X,A)') &
560 74 : "# Step Time [fs]", "xx", "xy", "xz", "yx", "yy", "yz", "zx", "zy", "zz"
561 : END IF
562 1482 : pv_total_bar(1, 1) = cp_unit_from_cp2k(virial%pv_total(1, 1)/cell%deth, "bar")
563 1482 : pv_total_bar(1, 2) = cp_unit_from_cp2k(virial%pv_total(1, 2)/cell%deth, "bar")
564 1482 : pv_total_bar(1, 3) = cp_unit_from_cp2k(virial%pv_total(1, 3)/cell%deth, "bar")
565 1482 : pv_total_bar(2, 1) = cp_unit_from_cp2k(virial%pv_total(2, 1)/cell%deth, "bar")
566 1482 : pv_total_bar(2, 2) = cp_unit_from_cp2k(virial%pv_total(2, 2)/cell%deth, "bar")
567 1482 : pv_total_bar(2, 3) = cp_unit_from_cp2k(virial%pv_total(2, 3)/cell%deth, "bar")
568 1482 : pv_total_bar(3, 1) = cp_unit_from_cp2k(virial%pv_total(3, 1)/cell%deth, "bar")
569 1482 : pv_total_bar(3, 2) = cp_unit_from_cp2k(virial%pv_total(3, 2)/cell%deth, "bar")
570 1482 : pv_total_bar(3, 3) = cp_unit_from_cp2k(virial%pv_total(3, 3)/cell%deth, "bar")
571 1482 : WRITE (UNIT=output_unit, FMT='(I8,F12.3,9(1X,F19.10))') itimes, time, &
572 1482 : pv_total_bar(1, 1), pv_total_bar(1, 2), pv_total_bar(1, 3), &
573 1482 : pv_total_bar(2, 1), pv_total_bar(2, 2), pv_total_bar(2, 3), &
574 2964 : pv_total_bar(3, 1), pv_total_bar(3, 2), pv_total_bar(3, 3)
575 1482 : CALL m_flush(output_unit)
576 : END IF
577 :
578 55842 : IF (virial%pv_availability) THEN
579 : CALL cp_print_key_finished_output(output_unit, logger, motion_section, &
580 13220 : "PRINT%STRESS")
581 : END IF
582 :
583 55842 : END SUBROUTINE write_stress_tensor_to_file
584 :
585 : ! **************************************************************************************************
586 : !> \brief Prints the Simulation Cell
587 : !> \param cell ...
588 : !> \param motion_section ...
589 : !> \param itimes ...
590 : !> \param time ...
591 : !> \param pos ...
592 : !> \param act ...
593 : !> \date 02.2008
594 : !> \author Teodoro Laino [tlaino] - University of Zurich
595 : !> \version 1.0
596 : ! **************************************************************************************************
597 55842 : SUBROUTINE write_simulation_cell(cell, motion_section, itimes, time, pos, act)
598 :
599 : TYPE(cell_type), POINTER :: cell
600 : TYPE(section_vals_type), POINTER :: motion_section
601 : INTEGER, INTENT(IN) :: itimes
602 : REAL(KIND=dp), INTENT(IN) :: time
603 : CHARACTER(LEN=default_string_length), INTENT(IN), &
604 : OPTIONAL :: pos, act
605 :
606 : CHARACTER(LEN=default_string_length) :: my_act, my_pos
607 : INTEGER :: output_unit
608 : LOGICAL :: new_file
609 : TYPE(cp_logger_type), POINTER :: logger
610 :
611 55842 : NULLIFY (logger)
612 55842 : logger => cp_get_default_logger()
613 :
614 55842 : my_pos = "APPEND"
615 55842 : my_act = "WRITE"
616 55842 : IF (PRESENT(pos)) my_pos = pos
617 55842 : IF (PRESENT(act)) my_act = act
618 :
619 : output_unit = cp_print_key_unit_nr(logger, motion_section, "PRINT%CELL", &
620 : extension=".cell", file_position=my_pos, &
621 : file_action=my_act, file_form="FORMATTED", &
622 55842 : is_new_file=new_file)
623 :
624 55842 : IF (output_unit > 0) THEN
625 2236 : IF (new_file) THEN
626 : WRITE (UNIT=output_unit, FMT='(A,9(7X,A2," [Angstrom]"),6X,A)') &
627 106 : "# Step Time [fs]", "Ax", "Ay", "Az", "Bx", "By", "Bz", "Cx", "Cy", "Cz", &
628 212 : "Volume [Angstrom^3]"
629 : END IF
630 2236 : WRITE (UNIT=output_unit, FMT="(I8,F12.3,9(1X,F19.10),1X,F24.10)") itimes, time, &
631 2236 : cell%hmat(1, 1)*angstrom, cell%hmat(2, 1)*angstrom, cell%hmat(3, 1)*angstrom, &
632 2236 : cell%hmat(1, 2)*angstrom, cell%hmat(2, 2)*angstrom, cell%hmat(3, 2)*angstrom, &
633 2236 : cell%hmat(1, 3)*angstrom, cell%hmat(2, 3)*angstrom, cell%hmat(3, 3)*angstrom, &
634 4472 : cell%deth*angstrom*angstrom*angstrom
635 2236 : CALL m_flush(output_unit)
636 : END IF
637 :
638 : CALL cp_print_key_finished_output(output_unit, logger, motion_section, &
639 55842 : "PRINT%CELL")
640 :
641 55842 : END SUBROUTINE write_simulation_cell
642 :
643 : END MODULE motion_utils
|