(git:0de0cc2)
input_cp2k_binary_restarts.F
Go to the documentation of this file.
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 Routines to read the binary restart file of CP2K
10 !> \author Matthias Krack (MK)
11 !> \par History
12 !> - Creation (17.02.2011,MK)
13 !> \version 1.0
14 ! **************************************************************************************************
16 
17  USE cp_files, ONLY: close_file,&
18  open_file
21  cp_logger_type,&
22  cp_to_string
25  USE extended_system_types, ONLY: lnhc_parameters_type
26  USE input_section_types, ONLY: section_vals_type,&
28  USE kinds, ONLY: default_path_length,&
30  dp
31  USE message_passing, ONLY: mp_para_env_type
32  USE particle_types, ONLY: particle_type
33  USE physcon, ONLY: angstrom
34  USE print_messages, ONLY: print_message
35  USE string_table, ONLY: id2str,&
36  s2s,&
37  str2id
38  USE topology_types, ONLY: atom_info_type,&
40 #include "./base/base_uses.f90"
41 
42  IMPLICIT NONE
43 
44  PRIVATE
45 
46  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_binary_restarts'
47 
48  PUBLIC :: read_binary_coordinates, &
52 
53 CONTAINS
54 
55 ! **************************************************************************************************
56 !> \brief Read the input section &COORD from an external file written in
57 !> binary format.
58 !> \param topology ...
59 !> \param root_section ...
60 !> \param para_env ...
61 !> \param subsys_section ...
62 !> \param binary_file_read ...
63 !> \par History
64 !> - Creation (10.02.2011,MK)
65 !> \author Matthias Krack (MK)
66 !> \version 1.0
67 ! **************************************************************************************************
68  SUBROUTINE read_binary_coordinates(topology, root_section, para_env, &
69  subsys_section, binary_file_read)
70 
72  TYPE(section_vals_type), POINTER :: root_section
73  TYPE(mp_para_env_type), POINTER :: para_env
74  TYPE(section_vals_type), POINTER :: subsys_section
75  LOGICAL, INTENT(OUT) :: binary_file_read
76 
77  CHARACTER(LEN=*), PARAMETER :: routinen = 'read_binary_coordinates'
78 
79  CHARACTER(LEN=default_path_length) :: binary_restart_file_name
80  CHARACTER(LEN=default_string_length) :: string
81  INTEGER :: handle, iatom, ikind, input_unit, istat, &
82  iw, natom, natomkind, ncore, &
83  nmolecule, nmoleculekind, nshell
84  INTEGER, ALLOCATABLE, DIMENSION(:) :: ibuf, id_name
85  TYPE(atom_info_type), POINTER :: atom_info
86  TYPE(cp_logger_type), POINTER :: logger
87 
88  CALL timeset(routinen, handle)
89 
90  NULLIFY (logger)
91  cpassert(ASSOCIATED(root_section))
92  cpassert(ASSOCIATED(para_env))
93  cpassert(ASSOCIATED(subsys_section))
94  logger => cp_get_default_logger()
95 
96  binary_file_read = .false.
97 
98  CALL section_vals_val_get(root_section, "EXT_RESTART%BINARY_RESTART_FILE_NAME", &
99  c_val=binary_restart_file_name)
100 
101  IF (trim(adjustl(binary_restart_file_name)) == "") THEN
102  CALL timestop(handle)
103  RETURN
104  END IF
105 
106  iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/XYZ_INFO", &
107  extension=".subsysLog")
108 
109  natomkind = 0
110  natom = 0
111  ncore = 0
112  nshell = 0
113  nmoleculekind = 0
114  nmolecule = 0
115 
116  ! Open binary restart file and read number atomic kinds, atoms, etc.
117  IF (para_env%is_source()) THEN
118  CALL open_file(file_name=binary_restart_file_name, &
119  file_status="OLD", &
120  file_form="UNFORMATTED", &
121  file_action="READWRITE", &
122  file_position="REWIND", &
123  unit_number=input_unit, &
124  debug=iw)
125  READ (unit=input_unit, iostat=istat) &
126  natomkind, natom, ncore, nshell, nmoleculekind, nmolecule
127  IF (istat /= 0) THEN
128  CALL stop_read("natomkind,natom,ncore,nshell,nmoleculekind,nmolecule "// &
129  "(IOSTAT = "//trim(adjustl(cp_to_string(istat)))//")", &
130  input_unit)
131  END IF
132  IF (iw > 0) THEN
133  WRITE (unit=iw, fmt="(T2,A,T71,I10)") &
134  "Number of atomic kinds:", natomkind, &
135  "Number of atoms:", natom, &
136  "Number of cores (only core-shell model):", ncore, &
137  "Number of shells (only core-shell model):", nshell, &
138  "Number of molecule kinds:", nmoleculekind, &
139  "Number of molecules", nmolecule
140  END IF
141  END IF
142 
143  CALL para_env%bcast(natomkind)
144  CALL para_env%bcast(natom)
145  CALL para_env%bcast(ncore)
146  CALL para_env%bcast(nshell)
147  CALL para_env%bcast(nmoleculekind)
148  CALL para_env%bcast(nmolecule)
149 
150  ALLOCATE (id_name(natomkind))
151  ! Read atomic kind names
152  DO ikind = 1, natomkind
153  IF (para_env%is_source()) THEN
154  READ (unit=input_unit, iostat=istat) string
155  IF (istat /= 0) CALL stop_read("string (IOSTAT = "// &
156  trim(adjustl(cp_to_string(istat)))//")", &
157  input_unit)
158  END IF
159  CALL para_env%bcast(string)
160  id_name(ikind) = str2id(string)
161  END DO
162 
163  ! Allocate and initialise atom_info array
164  atom_info => topology%atom_info
165  ALLOCATE (atom_info%id_molname(natom))
166  atom_info%id_molname(:) = 0
167  ALLOCATE (atom_info%id_resname(natom))
168  atom_info%id_resname(:) = 0
169  ALLOCATE (atom_info%resid(natom))
170  atom_info%resid = 1
171  ALLOCATE (atom_info%id_atmname(natom))
172  atom_info%id_atmname = 0
173  ALLOCATE (atom_info%r(3, natom))
174  atom_info%r(:, :) = 0.0_dp
175  ALLOCATE (atom_info%atm_mass(natom))
176  atom_info%atm_mass(:) = huge(0.0_dp)
177  ALLOCATE (atom_info%atm_charge(natom))
178  atom_info%atm_charge(:) = -huge(0.0_dp)
179  ALLOCATE (atom_info%occup(natom))
180  atom_info%occup(:) = 0.0_dp
181  ALLOCATE (atom_info%beta(natom))
182  atom_info%beta(:) = 0.0_dp
183  ALLOCATE (atom_info%id_element(natom))
184  atom_info%id_element(:) = 0
185  ALLOCATE (ibuf(natom))
186 
187  ! Read atomic kind number of each atom
188  IF (para_env%is_source()) THEN
189  READ (unit=input_unit, iostat=istat) ibuf(1:natom)
190  IF (istat /= 0) CALL stop_read("ibuf (IOSTAT = "// &
191  trim(adjustl(cp_to_string(istat)))//")", &
192  input_unit)
193  END IF
194  CALL para_env%bcast(ibuf)
195  DO iatom = 1, natom
196  ikind = ibuf(iatom)
197  atom_info%id_atmname(iatom) = id_name(ikind)
198  atom_info%id_element(iatom) = id_name(ikind)
199  END DO
200  DEALLOCATE (id_name)
201 
202  ! Read atomic coordinates
203  IF (para_env%is_source()) THEN
204  READ (unit=input_unit, iostat=istat) atom_info%r(1:3, 1:natom)
205  IF (istat /= 0) CALL stop_read("atom_info%r(1:3,1:natom) (IOSTAT = "// &
206  trim(adjustl(cp_to_string(istat)))//")", &
207  input_unit)
208  END IF
209  CALL para_env%bcast(atom_info%r)
210 
211  ! Read molecule information if available
212  IF (nmolecule > 0) THEN
213  ALLOCATE (id_name(nmoleculekind))
214  ! Read molecule kind names
215  DO ikind = 1, nmoleculekind
216  IF (para_env%is_source()) THEN
217  READ (unit=input_unit, iostat=istat) string
218  IF (istat /= 0) CALL stop_read("string (IOSTAT = "// &
219  trim(adjustl(cp_to_string(istat)))//")", &
220  input_unit)
221  END IF
222  CALL para_env%bcast(string)
223  id_name(ikind) = str2id(string)
224  END DO
225  ! Read molecule kind numbers
226  IF (para_env%is_source()) THEN
227  READ (unit=input_unit, iostat=istat) ibuf(1:natom)
228  IF (istat /= 0) CALL stop_read("ibuf(1:natom) (IOSTAT = "// &
229  trim(adjustl(cp_to_string(istat)))//")", &
230  input_unit)
231  END IF
232  CALL para_env%bcast(ibuf)
233  DO iatom = 1, natom
234  ikind = ibuf(iatom)
235  atom_info%id_molname(iatom) = id_name(ikind)
236  END DO
237  DEALLOCATE (id_name)
238  ! Read molecule index which is used also as residue id
239  IF (para_env%is_source()) THEN
240  READ (unit=input_unit, iostat=istat) atom_info%resid(1:natom)
241  IF (istat /= 0) CALL stop_read("atom_info%resid(1:natom) (IOSTAT = "// &
242  trim(adjustl(cp_to_string(istat)))//")", &
243  input_unit)
244  END IF
245  CALL para_env%bcast(atom_info%resid)
246  DO iatom = 1, natom
247  atom_info%id_resname(iatom) = str2id(s2s(cp_to_string(atom_info%resid(iatom))))
248  END DO
249  END IF
250  DEALLOCATE (ibuf)
251 
252  !MK to be checked ...
253  topology%aa_element = .true.
254  topology%molname_generated = .false.
255  topology%natoms = natom
256 
257  IF (iw > 0) THEN
258  WRITE (unit=iw, fmt="(T2,A)") &
259  "BEGIN of COORD section data [Angstrom] read in binary format from file "// &
260  trim(binary_restart_file_name)
261  DO iatom = 1, natom
262  WRITE (unit=iw, fmt="(T2,A2,3(1X,ES25.16),2(1X,A))") &
263  trim(adjustl(id2str(atom_info%id_atmname(iatom)))), &
264  atom_info%r(1:3, iatom)*angstrom, &
265  trim(adjustl(id2str(atom_info%id_molname(iatom)))), &
266  trim(adjustl(id2str(atom_info%id_resname(iatom))))
267  END DO
268  WRITE (unit=iw, fmt="(T2,A)") &
269  "END of COORD section data [Angstrom] read from binary restart file "// &
270  trim(binary_restart_file_name)
271  END IF
272 
273  IF (para_env%is_source()) CALL close_file(unit_number=input_unit, &
274  keep_preconnection=.true.)
275 
276  binary_file_read = .true.
277 
278  CALL timestop(handle)
279 
280  END SUBROUTINE read_binary_coordinates
281 
282 ! **************************************************************************************************
283 !> \brief Read the input section &CORE_COORD or &SHELL_COORD from an external
284 !> file written in binary format.
285 !> \param prefix ...
286 !> \param particle_set ...
287 !> \param root_section ...
288 !> \param subsys_section ...
289 !> \param binary_file_read ...
290 !> \par History
291 !> - Creation (17.02.2011,MK)
292 !> \author Matthias Krack (MK)
293 !> \version 1.0
294 ! **************************************************************************************************
295  SUBROUTINE read_binary_cs_coordinates(prefix, particle_set, root_section, &
296  subsys_section, binary_file_read)
297 
298  CHARACTER(LEN=*), INTENT(IN) :: prefix
299  TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
300  TYPE(section_vals_type), POINTER :: root_section, subsys_section
301  LOGICAL, INTENT(OUT) :: binary_file_read
302 
303  CHARACTER(LEN=*), PARAMETER :: routinen = 'read_binary_cs_coordinates'
304 
305  CHARACTER(LEN=default_path_length) :: binary_restart_file_name, message
306  CHARACTER(LEN=default_string_length) :: section_label, section_name
307  INTEGER :: handle, input_unit, iparticle, istat, &
308  iw, nbuf, nparticle
309  INTEGER, ALLOCATABLE, DIMENSION(:) :: ibuf
310  LOGICAL :: exit_routine
311  REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: rbuf
312  TYPE(cp_logger_type), POINTER :: logger
313  TYPE(mp_para_env_type), POINTER :: para_env
314 
315  CALL timeset(routinen, handle)
316 
317  NULLIFY (logger)
318  cpassert(ASSOCIATED(root_section))
319  cpassert(ASSOCIATED(subsys_section))
320  logger => cp_get_default_logger()
321  para_env => logger%para_env
322 
323  binary_file_read = .false.
324 
325  IF (ASSOCIATED(particle_set)) THEN
326  exit_routine = .false.
327  nparticle = SIZE(particle_set)
328  ELSE
329  exit_routine = .true.
330  nparticle = 0
331  END IF
332 
333  CALL section_vals_val_get(root_section, "EXT_RESTART%BINARY_RESTART_FILE_NAME", &
334  c_val=binary_restart_file_name)
335 
336  IF (trim(adjustl(binary_restart_file_name)) == "") THEN
337  CALL timestop(handle)
338  RETURN
339  END IF
340 
341  iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/XYZ_INFO", &
342  extension=".subsysLog")
343 
344  section_name = prefix//" COORDINATES"
345 
346  ! Open binary restart file at last position
347  IF (para_env%is_source()) THEN
348  CALL open_file(file_name=trim(binary_restart_file_name), &
349  file_status="OLD", &
350  file_form="UNFORMATTED", &
351  file_action="READWRITE", &
352  file_position="ASIS", &
353  unit_number=input_unit, &
354  debug=iw)
355  READ (unit=input_unit, iostat=istat) section_label, nbuf
356  IF (istat /= 0) CALL stop_read("section_label, nbuf -> "//trim(section_label)//", "// &
357  trim(adjustl(cp_to_string(nbuf)))// &
358  " (IOSTAT = "//trim(adjustl(cp_to_string(istat)))//"). "// &
359  "Section "//trim(adjustl(section_name))//" was expected.", &
360  input_unit)
361  IF (trim(section_label) == trim(section_name)) THEN
362  IF (nbuf /= nparticle) THEN
363  IF (iw > 0) THEN
364  message = "INFO: The requested number of "//trim(section_name)//" ("// &
365  trim(adjustl(cp_to_string(nparticle)))//") does not match the "// &
366  "number ("//trim(adjustl(cp_to_string(nbuf)))//") available from the "// &
367  "binary restart file <"//trim(binary_restart_file_name)// &
368  ">. The restart file information is ignored."
369  CALL print_message(message, iw, 1, 1, 1)
370  END IF
371  ! Ignore this section
372  IF (nbuf > 0) THEN
373  ! Perform dummy read
374  ALLOCATE (rbuf(3, nbuf))
375  READ (unit=input_unit, iostat=istat) rbuf(1:3, 1:nbuf)
376  IF (istat /= 0) CALL stop_read("rbuf(1:3,1:nbuf) -> "//prefix// &
377  " coordinates (IOSTAT = "// &
378  trim(adjustl(cp_to_string(istat)))//")", &
379  input_unit)
380  DEALLOCATE (rbuf)
381  ALLOCATE (ibuf(nbuf))
382  READ (unit=input_unit, iostat=istat) ibuf(1:nbuf)
383  IF (istat /= 0) CALL stop_read("ibuf(1:nparticle) -> atomic indices of the "// &
384  trim(section_name)//" (IOSTAT = "// &
385  trim(adjustl(cp_to_string(istat)))//")", &
386  input_unit)
387  DEALLOCATE (ibuf)
388  END IF
389  exit_routine = .true.
390  ELSE
391  IF (iw > 0) THEN
392  WRITE (unit=iw, fmt="(T2,A,T71,I10)") &
393  "Number of "//prefix//" particles:", nparticle
394  END IF
395  IF (nparticle == 0) exit_routine = .true.
396  END IF
397  ELSE
398  CALL cp_abort(__location__, &
399  "Section label <"//trim(section_label)//"> read from the "// &
400  "binary restart file <"//trim(binary_restart_file_name)// &
401  "> does not match the requested section name <"// &
402  trim(section_name)//">.")
403  END IF
404  END IF
405 
406  CALL para_env%bcast(exit_routine)
407  IF (exit_routine) THEN
408  IF (para_env%is_source()) CALL close_file(unit_number=input_unit, &
409  keep_preconnection=.true.)
410  CALL timestop(handle)
411  RETURN
412  END IF
413 
414  cpassert(nparticle > 0)
415 
416  ALLOCATE (rbuf(3, nparticle))
417 
418  IF (para_env%is_source()) THEN
419  READ (unit=input_unit, iostat=istat) rbuf(1:3, 1:nparticle)
420  IF (istat /= 0) CALL stop_read("rbuf(1:3,1:nparticle) -> "//prefix// &
421  " coordinates (IOSTAT = "// &
422  trim(adjustl(cp_to_string(istat)))//")", &
423  input_unit)
424  END IF
425  CALL para_env%bcast(rbuf)
426 
427  DO iparticle = 1, nparticle
428  particle_set(iparticle)%r(1:3) = rbuf(1:3, iparticle)
429  END DO
430 
431  DEALLOCATE (rbuf)
432 
433  ALLOCATE (ibuf(nparticle))
434 
435  IF (para_env%is_source()) THEN
436  READ (unit=input_unit, iostat=istat) ibuf(1:nparticle)
437  IF (istat /= 0) CALL stop_read("ibuf(1:nparticle) -> atomic indices of the "// &
438  trim(section_name)//" (IOSTAT = "// &
439  trim(adjustl(cp_to_string(istat)))//")", &
440  input_unit)
441  END IF
442 
443  CALL para_env%bcast(ibuf)
444 
445  DO iparticle = 1, nparticle
446  particle_set(iparticle)%atom_index = ibuf(iparticle)
447  END DO
448 
449  DEALLOCATE (ibuf)
450 
451  IF (iw > 0) THEN
452  WRITE (unit=iw, fmt="(T2,A)") &
453  "BEGIN of "//trim(adjustl(section_name))// &
454  " section data [Angstrom] read in binary format from file "// &
455  trim(binary_restart_file_name)
456  DO iparticle = 1, nparticle
457  WRITE (unit=iw, fmt="(T2,A2,3(1X,ES25.16),1X,I0)") &
458  trim(adjustl(particle_set(iparticle)%atomic_kind%name)), &
459  particle_set(iparticle)%r(1:3)*angstrom, &
460  particle_set(iparticle)%atom_index
461  END DO
462  WRITE (unit=iw, fmt="(T2,A)") &
463  "END of "//trim(adjustl(section_name))// &
464  " section data [Angstrom] read from binary restart file "// &
465  trim(binary_restart_file_name)
466  END IF
467 
468  IF (para_env%is_source()) CALL close_file(unit_number=input_unit, &
469  keep_preconnection=.true.)
470 
471  binary_file_read = .true.
472 
473  CALL timestop(handle)
474 
475  END SUBROUTINE read_binary_cs_coordinates
476 
477 ! **************************************************************************************************
478 !> \brief Read the input section &VELOCITY, &CORE_VELOCITY, or
479 !> &SHELL_VELOCITY from an external file written in binary format.
480 !> \param prefix ...
481 !> \param particle_set ...
482 !> \param root_section ...
483 !> \param para_env ...
484 !> \param subsys_section ...
485 !> \param binary_file_read ...
486 !> \par History
487 !> - Creation (17.02.2011,MK)
488 !> \author Matthias Krack (MK)
489 !> \version 1.0
490 ! **************************************************************************************************
491  SUBROUTINE read_binary_velocities(prefix, particle_set, root_section, para_env, &
492  subsys_section, binary_file_read)
493 
494  CHARACTER(LEN=*), INTENT(IN) :: prefix
495  TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
496  TYPE(section_vals_type), POINTER :: root_section
497  TYPE(mp_para_env_type), POINTER :: para_env
498  TYPE(section_vals_type), POINTER :: subsys_section
499  LOGICAL, INTENT(OUT) :: binary_file_read
500 
501  CHARACTER(LEN=*), PARAMETER :: routinen = 'read_binary_velocities'
502 
503  CHARACTER(LEN=default_path_length) :: binary_restart_file_name, message
504  CHARACTER(LEN=default_string_length) :: section_label, section_name
505  INTEGER :: handle, i, input_unit, iparticle, istat, &
506  iw, nbuf, nparticle
507  LOGICAL :: have_velocities
508  REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: rbuf
509  TYPE(cp_logger_type), POINTER :: logger
510 
511  CALL timeset(routinen, handle)
512 
513  NULLIFY (logger)
514  cpassert(ASSOCIATED(root_section))
515  cpassert(ASSOCIATED(para_env))
516  cpassert(ASSOCIATED(subsys_section))
517  logger => cp_get_default_logger()
518 
519  binary_file_read = .false.
520 
521  CALL section_vals_val_get(root_section, "EXT_RESTART%BINARY_RESTART_FILE_NAME", &
522  c_val=binary_restart_file_name)
523 
524  IF (trim(adjustl(binary_restart_file_name)) == "") THEN
525  CALL timestop(handle)
526  RETURN
527  END IF
528 
529  iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/XYZ_INFO", &
530  extension=".subsysLog")
531 
532  IF (len_trim(prefix) == 0) THEN
533  section_name = "VELOCITIES"
534  ELSE
535  section_name = prefix//" VELOCITIES"
536  END IF
537 
538  have_velocities = .false.
539 
540  IF (ASSOCIATED(particle_set)) THEN
541  nparticle = SIZE(particle_set)
542  ELSE
543  nparticle = 0
544  END IF
545 
546  ! Open binary restart file at last position and check if there are
547  ! velocities available
548  IF (para_env%is_source()) THEN
549  CALL open_file(file_name=binary_restart_file_name, &
550  file_status="OLD", &
551  file_form="UNFORMATTED", &
552  file_action="READWRITE", &
553  file_position="ASIS", &
554  unit_number=input_unit, &
555  debug=iw)
556  DO
557  READ (unit=input_unit, iostat=istat) section_label, nbuf
558  IF (istat /= 0) CALL stop_read("section_label, nbuf -> "//trim(section_label)//", "// &
559  trim(adjustl(cp_to_string(nbuf)))// &
560  " (IOSTAT = "//trim(adjustl(cp_to_string(istat)))//"). "// &
561  "Section "//trim(adjustl(section_name))//" was expected.", &
562  input_unit)
563  IF (index(section_label, "THERMOSTAT") > 0) THEN
564  IF (nbuf > 0) THEN
565  ! Ignore thermostat information
566  ALLOCATE (rbuf(nbuf, 1))
567  ! Perform dummy read
568  DO i = 1, 4
569  READ (unit=input_unit, iostat=istat) rbuf(1:nbuf, 1)
570  IF (istat /= 0) CALL stop_read("rbuf(1:nbuf,1) -> "// &
571  trim(adjustl(section_label))// &
572  " (IOSTAT = "//trim(adjustl(cp_to_string(istat)))//")", &
573  input_unit)
574  END DO
575  DEALLOCATE (rbuf)
576  IF (iw > 0) THEN
577  message = "INFO: Ignoring section <"//trim(adjustl(section_label))// &
578  "> from binary restart file <"//trim(binary_restart_file_name)//">."
579  CALL print_message(message, iw, 1, 1, 1)
580  END IF
581  END IF
582  cycle
583  ELSE IF (index(section_label, "VELOCIT") == 0) THEN
584  CALL cp_abort(__location__, &
585  "Section label <"//trim(section_label)//"> read from the "// &
586  "binary restart file <"//trim(binary_restart_file_name)// &
587  "> does not match the requested section name <"// &
588  trim(section_name)//">.")
589  ELSE
590  IF (nbuf > 0) have_velocities = .true.
591  EXIT
592  END IF
593  END DO
594  END IF
595 
596  CALL para_env%bcast(nbuf)
597  CALL para_env%bcast(have_velocities)
598 
599  IF (have_velocities) THEN
600 
601  ALLOCATE (rbuf(3, nbuf))
602 
603  IF (para_env%is_source()) THEN
604  READ (unit=input_unit, iostat=istat) rbuf(1:3, 1:nbuf)
605  IF (istat /= 0) CALL stop_read("rbuf(1:3,1:nbuf) -> "// &
606  trim(adjustl(section_name))// &
607  " (IOSTAT = "//trim(adjustl(cp_to_string(istat)))//")", &
608  input_unit)
609  END IF
610 
611  IF (nbuf == nparticle) THEN
612  CALL para_env%bcast(rbuf)
613  DO iparticle = 1, nparticle
614  particle_set(iparticle)%v(1:3) = rbuf(1:3, iparticle)
615  END DO
616  ELSE
617  IF (iw > 0) THEN
618  message = "INFO: The requested number of "//trim(adjustl(section_name))// &
619  " ("//trim(adjustl(cp_to_string(nparticle)))//") does not match the "// &
620  "number ("//trim(adjustl(cp_to_string(nbuf)))//") available from the "// &
621  "binary restart file <"//trim(binary_restart_file_name)// &
622  ">. The restart file information is ignored."
623  CALL print_message(message, iw, 1, 1, 1)
624  END IF
625  END IF
626 
627  DEALLOCATE (rbuf)
628 
629  END IF
630 
631  IF (nbuf == nparticle) THEN
632  IF (iw > 0) THEN
633  WRITE (unit=iw, fmt="(T2,A)") &
634  "BEGIN of "//trim(adjustl(section_name))// &
635  " section data [a.u.] read in binary format from file "// &
636  trim(binary_restart_file_name)
637  IF (have_velocities) THEN
638  DO iparticle = 1, nparticle
639  WRITE (unit=iw, fmt="(T2,A2,3(1X,ES25.16))") &
640  trim(adjustl(particle_set(iparticle)%atomic_kind%name)), &
641  particle_set(iparticle)%v(1:3)
642  END DO
643  ELSE
644  WRITE (unit=iw, fmt="(A)") &
645  "# No "//trim(adjustl(section_name))//" available"
646  END IF
647  WRITE (unit=iw, fmt="(T2,A)") &
648  "END of "//trim(adjustl(section_name))// &
649  " section data [a.u.] read from binary restart file "// &
650  trim(binary_restart_file_name)
651  END IF
652  binary_file_read = .true.
653  END IF
654 
655  IF (para_env%is_source()) CALL close_file(unit_number=input_unit, &
656  keep_preconnection=.true.)
657 
658  CALL timestop(handle)
659 
660  END SUBROUTINE read_binary_velocities
661 
662 ! **************************************************************************************************
663 !> \brief Read the input section &THERMOSTAT for Nose thermostats from an
664 !> external file written in binary format.
665 !> \param prefix ...
666 !> \param nhc ...
667 !> \param binary_restart_file_name ...
668 !> \param restart ...
669 !> \param para_env ...
670 !> \par History
671 !> - Creation (28.02.2011,MK)
672 !> \author Matthias Krack (MK)
673 !> \version 1.0
674 ! **************************************************************************************************
675  SUBROUTINE read_binary_thermostats_nose(prefix, nhc, binary_restart_file_name, &
676  restart, para_env)
677 
678  CHARACTER(LEN=*), INTENT(IN) :: prefix
679  TYPE(lnhc_parameters_type), POINTER :: nhc
680  CHARACTER(LEN=*), INTENT(IN) :: binary_restart_file_name
681  LOGICAL, INTENT(OUT) :: restart
682  TYPE(mp_para_env_type), POINTER :: para_env
683 
684  CHARACTER(LEN=*), PARAMETER :: routinen = 'read_binary_thermostats_nose'
685 
686  CHARACTER(LEN=default_string_length) :: section_label, section_name
687  INTEGER :: handle, i, idx, input_unit, istat, j, &
688  nhc_size, output_unit
689  LOGICAL :: debug
690  REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: rbuf
691  TYPE(cp_logger_type), POINTER :: logger
692 
693  CALL timeset(routinen, handle)
694 
695  cpassert(ASSOCIATED(nhc))
696  cpassert(ASSOCIATED(para_env))
697 
698  ! Set to .TRUE. for debug mode, i.e. all data read are written to stdout
699  NULLIFY (logger)
700  logger => cp_get_default_logger()
701  output_unit = cp_logger_get_default_io_unit(logger)
702 
703  IF (logger%iter_info%print_level >= debug_print_level) THEN
704  debug = .true.
705  ELSE
706  debug = .false.
707  END IF
708 
709  restart = .false.
710 
711  section_name = prefix//" THERMOSTATS"
712 
713  ! Open binary restart file at last position
714  IF (para_env%is_source()) THEN
715  CALL open_file(file_name=binary_restart_file_name, &
716  file_status="OLD", &
717  file_form="UNFORMATTED", &
718  file_action="READWRITE", &
719  file_position="ASIS", &
720  unit_number=input_unit)
721  READ (unit=input_unit, iostat=istat) section_label, nhc_size
722  IF (istat /= 0) CALL stop_read("nhc_size (IOSTAT = "// &
723  trim(adjustl(cp_to_string(istat)))//")", &
724  input_unit)
725  IF (index(section_label, "THERMOSTAT") == 0) THEN
726  CALL cp_abort(__location__, &
727  "Section label <"//trim(section_label)//"> read from the "// &
728  "binary restart file <"//trim(binary_restart_file_name)// &
729  "> does not match the requested section name <"// &
730  trim(section_name)//">.")
731  END IF
732  IF (debug .AND. output_unit > 0) THEN
733  WRITE (unit=output_unit, fmt="(T2,A,/,T2,A,I0)") &
734  "BEGIN of "//trim(adjustl(section_label))// &
735  " section data read in binary format from file "// &
736  trim(binary_restart_file_name), &
737  "# nhc_size = ", nhc_size
738  END IF
739  END IF
740 
741  CALL para_env%bcast(nhc_size)
742 
743  IF (nhc_size > 0) THEN
744 
745  ALLOCATE (rbuf(nhc_size))
746  rbuf(:) = 0.0_dp
747 
748  ! Read NHC section &COORD
749  IF (para_env%is_source()) THEN
750  READ (unit=input_unit, iostat=istat) rbuf(1:nhc_size)
751  IF (istat /= 0) CALL stop_read("eta -> rbuf (IOSTAT = "// &
752  trim(adjustl(cp_to_string(istat)))//")", &
753  input_unit)
754  IF (debug .AND. output_unit > 0) THEN
755  WRITE (unit=output_unit, fmt="(T2,A,/,(4(1X,ES25.16)))") &
756  "&COORD", rbuf(1:nhc_size)
757  END IF
758  END IF
759  CALL para_env%bcast(rbuf)
760  DO i = 1, SIZE(nhc%nvt, 2)
761  idx = (nhc%map_info%index(i) - 1)*nhc%nhc_len
762  DO j = 1, SIZE(nhc%nvt, 1)
763  idx = idx + 1
764  nhc%nvt(j, i)%eta = rbuf(idx)
765  END DO
766  END DO
767 
768  ! Read NHC section &VELOCITY
769  IF (para_env%is_source()) THEN
770  READ (unit=input_unit, iostat=istat) rbuf(1:nhc_size)
771  IF (istat /= 0) CALL stop_read("veta -> rbuf (IOSTAT = "// &
772  trim(adjustl(cp_to_string(istat)))//")", &
773  input_unit)
774  IF (debug .AND. output_unit > 0) THEN
775  WRITE (unit=output_unit, fmt="(T2,A,/,(4(1X,ES25.16)))") &
776  "&VELOCITY", rbuf(1:nhc_size)
777  END IF
778  END IF
779  CALL para_env%bcast(rbuf)
780  DO i = 1, SIZE(nhc%nvt, 2)
781  idx = (nhc%map_info%index(i) - 1)*nhc%nhc_len
782  DO j = 1, SIZE(nhc%nvt, 1)
783  idx = idx + 1
784  nhc%nvt(j, i)%v = rbuf(idx)
785  END DO
786  END DO
787 
788  ! Read NHC section &MASS
789  IF (para_env%is_source()) THEN
790  READ (unit=input_unit, iostat=istat) rbuf(1:nhc_size)
791  IF (istat /= 0) CALL stop_read("mnhc -> rbuf (IOSTAT = "// &
792  trim(adjustl(cp_to_string(istat)))//")", &
793  input_unit)
794  IF (debug .AND. output_unit > 0) THEN
795  WRITE (unit=output_unit, fmt="(T2,A,/,(4(1X,ES25.16)))") &
796  "&MASS:", rbuf(1:nhc_size)
797  END IF
798  END IF
799  CALL para_env%bcast(rbuf)
800  DO i = 1, SIZE(nhc%nvt, 2)
801  idx = (nhc%map_info%index(i) - 1)*nhc%nhc_len
802  DO j = 1, SIZE(nhc%nvt, 1)
803  idx = idx + 1
804  nhc%nvt(j, i)%mass = rbuf(idx)
805  END DO
806  END DO
807 
808  ! Read NHC section &FORCE
809  IF (para_env%is_source()) THEN
810  READ (unit=input_unit, iostat=istat) rbuf(1:nhc_size)
811  IF (istat /= 0) CALL stop_read("fnhc -> rbuf (IOSTAT = "// &
812  trim(adjustl(cp_to_string(istat)))//")", &
813  input_unit)
814  IF (debug .AND. output_unit > 0) THEN
815  WRITE (unit=output_unit, fmt="(T2,A,/,(4(1X,ES25.16)))") &
816  "&FORCE", rbuf(1:nhc_size)
817  END IF
818  END IF
819  CALL para_env%bcast(rbuf)
820  DO i = 1, SIZE(nhc%nvt, 2)
821  idx = (nhc%map_info%index(i) - 1)*nhc%nhc_len
822  DO j = 1, SIZE(nhc%nvt, 1)
823  idx = idx + 1
824  nhc%nvt(j, i)%f = rbuf(idx)
825  END DO
826  END DO
827 
828  DEALLOCATE (rbuf)
829 
830  restart = .true.
831 
832  END IF
833 
834  IF (para_env%is_source()) THEN
835  IF (debug .AND. output_unit > 0) THEN
836  WRITE (unit=output_unit, fmt="(T2,A)") &
837  "END of"//trim(adjustl(section_label))// &
838  " section data read in binary format from file "// &
839  trim(binary_restart_file_name)
840  END IF
841  CALL close_file(unit_number=input_unit, &
842  keep_preconnection=.true.)
843  END IF
844 
845  CALL timestop(handle)
846 
847  END SUBROUTINE read_binary_thermostats_nose
848 
849 ! **************************************************************************************************
850 !> \brief Print an error message and stop the program execution in case of a
851 !> read error.
852 !> \param object ...
853 !> \param unit_number ...
854 !> \par History
855 !> - Creation (15.02.2011,MK)
856 !> \author Matthias Krack (MK)
857 !> \note
858 !> object : Name of the data object for which I/O operation failed
859 !> unit_number: Logical unit number of the file read from
860 ! **************************************************************************************************
861  SUBROUTINE stop_read(object, unit_number)
862  CHARACTER(LEN=*), INTENT(IN) :: object
863  INTEGER, INTENT(IN) :: unit_number
864 
865  CHARACTER(LEN=2*default_path_length) :: message
866  CHARACTER(LEN=default_path_length) :: file_name
867  LOGICAL :: file_exists
868 
869  IF (unit_number >= 0) THEN
870  INQUIRE (unit=unit_number, exist=file_exists)
871  ELSE
872  file_exists = .false.
873  END IF
874  IF (file_exists) THEN
875  INQUIRE (unit=unit_number, name=file_name)
876  WRITE (unit=message, fmt="(A)") &
877  "An error occurred reading data object <"//trim(adjustl(object))// &
878  "> from file <"//trim(adjustl(file_name))//">"
879  ELSE
880  WRITE (unit=message, fmt="(A,I0,A)") &
881  "Could not read data object <"//trim(adjustl(object))// &
882  "> from logical unit ", unit_number, ". The I/O unit does not exist."
883  END IF
884 
885  cpabort(message)
886 
887  END SUBROUTINE stop_read
888 
static GRID_HOST_DEVICE int idx(const orbital a)
Return coset index of given orbital angular momentum.
Definition: grid_common.h:153
Utility routines to open and close files. Tracking of preconnections.
Definition: cp_files.F:16
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
Definition: cp_files.F:308
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Definition: cp_files.F:119
various routines to log and control the output. The idea is that decisions about where to log should ...
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer, parameter, public debug_print_level
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)
...
Lumps all possible extended system variables into one type for easy access and passing.
Routines to read the binary restart file of CP2K.
subroutine, public read_binary_thermostats_nose(prefix, nhc, binary_restart_file_name, restart, para_env)
Read the input section &THERMOSTAT for Nose thermostats from an external file written in binary forma...
subroutine, public read_binary_coordinates(topology, root_section, para_env, subsys_section, binary_file_read)
Read the input section &COORD from an external file written in binary format.
subroutine, public read_binary_velocities(prefix, particle_set, root_section, para_env, subsys_section, binary_file_read)
Read the input section &VELOCITY, &CORE_VELOCITY, or &SHELL_VELOCITY from an external file written in...
subroutine, public read_binary_cs_coordinates(prefix, particle_set, root_section, subsys_section, binary_file_read)
Read the input section &CORE_COORD or &SHELL_COORD from an external file written in binary format.
objects that represent the structure of input sections and the data contained in an input section
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
integer, parameter, public default_string_length
Definition: kinds.F:57
integer, parameter, public default_path_length
Definition: kinds.F:58
Interface to the message passing library MPI.
Define the data structure for the particle information.
Definition of physical constants:
Definition: physcon.F:68
real(kind=dp), parameter, public angstrom
Definition: physcon.F:144
Perform an abnormal program termination.
subroutine, public print_message(message, output_unit, declev, before, after)
Perform a basic blocking of the text in message and print it optionally decorated with a frame of sta...
generates a unique id number for a string (str2id) that can be used two compare two strings....
Definition: string_table.F:22
character(len=default_string_length) function, public s2s(str)
converts a string in a string of default_string_length
Definition: string_table.F:141
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
character(len=default_string_length) function, public id2str(id)
returns the string associated with a given id
Definition: string_table.F:115
Control for reading in different topologies and coordinates.
Definition: topology.F:13