71#include "../base/base_uses.f90"
75 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'neb_io'
98 cpassert(
ASSOCIATED(neb_env))
105 CALL section_vals_val_get(neb_section,
"OPTIMIZE_BAND%OPTIMIZE_END_POINTS", l_val=neb_env%optimize_end_points)
116 IF (.NOT. neb_env%use_colvar) &
117 CALL cp_abort(__location__, &
118 "A potential energy function based on free energy or minimum energy"// &
119 " was requested without enabling the usage of COLVARS. Both methods"// &
120 " are based on COLVARS definition.")
122 SELECT CASE (neb_env%pot_type)
126 IF (.NOT. explicit) &
127 CALL cp_abort(__location__, &
128 "A free energy BAND (colvars projected) calculation is requested"// &
129 " but NONE MD section was defined in the input.")
133 IF (.NOT. explicit) &
134 CALL cp_abort(__location__, &
135 "A minimum energy BAND (colvars projected) calculation is requested"// &
136 " but NONE GEO_OPT section was defined in the input.")
139 IF (neb_env%use_colvar) &
140 CALL cp_abort(__location__, &
141 "A band calculation was requested with a full potential energy. USE_COLVAR cannot"// &
142 " be set for this kind of calculation!")
146 CALL section_vals_val_get(neb_section,
"STRING_METHOD%SPLINE_ORDER", i_val=neb_env%spline_order)
147 neb_env%reparametrize_frames = .false.
148 IF (neb_env%id_type ==
do_sm)
THEN
149 neb_env%reparametrize_frames = .true.
167 SUBROUTINE dump_neb_info(neb_env, coords, vels, forces, particle_set, logger, &
168 istep, energies, distances, output_unit)
174 INTEGER,
INTENT(IN) :: istep
175 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: energies, distances
176 INTEGER,
INTENT(IN) :: output_unit
178 CHARACTER(len=*),
PARAMETER :: routinen =
'dump_neb_info'
180 CHARACTER(LEN=20) :: mytype
181 CHARACTER(LEN=default_string_length) :: line, title, unit_str
182 INTEGER :: crd, ener, frc, handle, i, irep, ndig, &
184 LOGICAL :: explicit, lval, print_kind
185 REAL(kind=
dp) :: f_ann, tmp_r1, unit_conv
186 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: ekin, temperatures
193 CALL timeset(routinen, handle)
194 ndig = ceiling(log10(real(neb_env%number_of_replica + 1, kind=
dp)))
196 DO irep = 1, neb_env%number_of_replica
197 ndigl = ceiling(log10(real(irep + 1, kind=
dp)))
200 extension=
".xyz", file_form=
"FORMATTED", middle_name=
"pos-"//trim(line))
201 IF (
PRESENT(vels))
THEN
203 extension=
".xyz", file_form=
"FORMATTED", middle_name=
"vel-"//trim(line))
205 IF (
PRESENT(forces))
THEN
207 extension=
".xyz", file_form=
"FORMATTED", middle_name=
"force-"//trim(line))
218 WRITE (unit=title, fmt=
"(A,I8,A,F20.10)")
" i =", istep,
", E =", energies(irep)
220 cell=cell, array=coords%xyz(:, irep), unit_conv=unit_conv, &
221 print_kind=print_kind)
225 IF (vel > 0 .AND.
PRESENT(vels))
THEN
232 WRITE (unit=title, fmt=
"(A,I8,A,F20.10)")
" i =", istep,
", E =", energies(irep)
234 cell=cell, array=vels%xyz(:, irep), unit_conv=unit_conv, &
235 print_kind=print_kind)
239 IF (frc > 0 .AND.
PRESENT(forces))
THEN
246 WRITE (unit=title, fmt=
"(A,I8,A,F20.10)")
" i =", istep,
", E =", energies(irep)
248 cell=cell, array=forces%xyz(:, irep), unit_conv=unit_conv, &
249 print_kind=print_kind)
254 IF (
PRESENT(vels))
THEN
258 IF (
PRESENT(forces))
THEN
264 IF (output_unit > 0)
THEN
267 ALLOCATE (temperatures(neb_env%number_of_replica))
268 ALLOCATE (ekin(neb_env%number_of_replica))
270 WRITE (output_unit,
'(/)', advance=
"NO")
271 WRITE (output_unit, fmt=
'(A,A)')
' **************************************', &
272 '*****************************************'
273 NULLIFY (section, keyword, enum)
277 mytype = trim(
enum_i2c(enum, neb_env%id_type))
278 WRITE (output_unit, fmt=
'(A,T61,A)') &
279 ' BAND TYPE =', adjustr(mytype)
281 WRITE (output_unit, fmt=
'(A,T61,A)') &
282 ' BAND TYPE OPTIMIZATION =', adjustr(neb_env%opt_type_label(1:20))
283 WRITE (output_unit,
'( A,T71,I10 )') &
284 ' STEP NUMBER =', istep
285 IF (neb_env%rotate_frames)
WRITE (output_unit,
'( A,T71,L10 )') &
286 ' RMSD DISTANCE DEFINITION =', neb_env%rotate_frames
291 IF (lval)
WRITE (output_unit,
'( A,T71,L10 )') &
292 ' PROJECTED VELOCITY VERLET =', lval
294 IF (lval)
WRITE (output_unit,
'( A,T71,L10)') &
295 ' STEEPEST DESCENT LIKE =', lval
297 IF (f_ann /= 1.0_dp)
THEN
298 WRITE (output_unit,
'( A,T71,F10.5)') &
299 ' ANNEALING FACTOR = ', f_ann
306 IF (istep <= ttst)
THEN
309 WRITE (output_unit,
'( A,T71,F10.5)') &
310 ' TEMPERATURE TARGET =', tmp_r1
313 WRITE (output_unit,
'( A,T71,I10 )') &
314 ' NUMBER OF NEB REPLICA =', neb_env%number_of_replica
315 WRITE (output_unit,
'( A,T17,4F16.6)') &
316 ' DISTANCES REP =', distances(1:min(4,
SIZE(distances)))
317 IF (
SIZE(distances) > 4)
THEN
318 WRITE (output_unit,
'( T17,4F16.6)') distances(5:
SIZE(distances))
320 WRITE (output_unit,
'( A,T17,4F16.6)') &
321 ' ENERGIES [au] =', energies(1:min(4,
SIZE(energies)))
322 IF (
SIZE(energies) > 4)
THEN
323 WRITE (output_unit,
'( T17,4F16.6)') energies(5:
SIZE(energies))
326 WRITE (output_unit,
'( A,T33,4(1X,F11.5))') &
327 ' REPLICA TEMPERATURES (K) =', temperatures(1:min(4,
SIZE(temperatures)))
328 DO i = 5,
SIZE(temperatures), 4
329 WRITE (output_unit,
'( T33,4(1X,F11.5))') &
330 temperatures(i:min(i + 3,
SIZE(temperatures)))
333 WRITE (output_unit,
'( A,T56,F25.14)') &
334 ' BAND TOTAL ENERGY [au] =', sum(energies(:) + ekin(:)) + &
335 neb_env%spring_energy
336 WRITE (output_unit, fmt=
'(A,A)')
' **************************************', &
337 '*****************************************'
339 DEALLOCATE (temperatures)
343 extension=
".ener", file_form=
"FORMATTED")
345 WRITE (line,
'(I0)') 2*neb_env%number_of_replica - 1
346 WRITE (ener,
'(I10,'//trim(line)//
'(1X,F20.9))') istep, &
355 root_section=neb_env%root_section, &
360 CALL timestop(handle)
167 SUBROUTINE dump_neb_info(neb_env, coords, vels, forces, particle_set, logger, &
…
378 INTEGER,
INTENT(IN) :: i_rep, ienum, iw
379 LOGICAL,
INTENT(IN) :: use_colvar
382 REAL(kind=
dp),
DIMENSION(3) :: r
385 WRITE (iw,
'(/,T2,"NEB|",75("*"))')
386 WRITE (iw,
'(T2,"NEB|",1X,A,I0,A)') &
387 "Geometry for Replica Nr. ", ienum,
" in Angstrom"
388 DO iatom = 1,
SIZE(particle_set)
390 WRITE (iw,
'(T2,"NEB|",1X,A10,5X,3F15.9)') &
391 trim(particle_set(iatom)%atomic_kind%name), r(1:3)*
angstrom
394 WRITE (iw,
'(/,T2,"NEB|",1X,A10)')
"COLLECTIVE VARIABLES:"
395 WRITE (iw,
'(T2,"NEB|",16X,3F15.9)') &
396 (coords%int(j, i_rep), j=1,
SIZE(coords%int(:, :), 1))
398 WRITE (iw,
'(T2,"NEB|",75("*"))')
414 INTEGER,
INTENT(IN) :: irep, n_rep, istep
416 CHARACTER(len=*),
PARAMETER :: routinen =
'handle_band_file_names'
418 CHARACTER(LEN=default_path_length) :: output_file_path, replica_proj_name
419 INTEGER :: handle, handle2, i, ierr, j, lp, unit_nr
424 CALL timeset(routinen, handle)
428 CALL force_env_get(f_env%force_env, root_section=root_section)
429 j = irep + (rep_env%local_rep_indices(1) - 1)
431 replica_proj_name = get_replica_project_name(rep_env, n_rep, j)
432 lp = len_trim(replica_proj_name)
434 c_val=trim(replica_proj_name))
435 logger%iter_info%project_name = replica_proj_name
438 output_file_path = replica_proj_name(1:lp)//
".out"
440 c_val=trim(output_file_path))
441 IF (logger%default_global_unit_nr > 0)
THEN
442 CALL close_file(logger%default_global_unit_nr)
443 CALL open_file(file_name=output_file_path, file_status=
"UNKNOWN", &
444 file_action=
"WRITE", file_position=
"APPEND", &
445 unit_number=logger%default_global_unit_nr, &
446 skip_get_unit_number=.true.)
447 WRITE (unit=logger%default_global_unit_nr, fmt=
"(/,(T2,A79))") &
448 "*******************************************************************************", &
449 "** BAND EVALUATION OF ENERGIES AND FORCES **", &
450 "*******************************************************************************"
451 WRITE (unit=logger%default_global_unit_nr, fmt=
"(T2,A,T79,A)")
"**",
"**"
452 WRITE (unit=logger%default_global_unit_nr, fmt=
"(T2,A,T79,A)")
"**",
"**"
453 WRITE (unit=logger%default_global_unit_nr, fmt=
"(T2,A,I5,T41,A,I5,T79,A)") &
454 "** Replica Env Nr. :", rep_env%local_rep_indices(1) - 1,
"Replica Band Nr. :", j,
"**"
455 WRITE (unit=logger%default_global_unit_nr, fmt=
"(T2,A,I5,T79,A)") &
456 "** Band Step Nr. :", istep,
"**"
457 WRITE (unit=logger%default_global_unit_nr, fmt=
"(T2,A79)") &
458 "*******************************************************************************"
462 SELECT CASE (f_env%force_env%in_use)
464 DO i = 1, f_env%force_env%mixed_env%ngroups
465 IF (
modulo(i - 1, f_env%force_env%mixed_env%ngroups) == &
466 f_env%force_env%mixed_env%group_distribution(f_env%force_env%mixed_env%para_env%mepos))
THEN
467 sub_logger => f_env%force_env%mixed_env%sub_logger(i)%p
468 sub_logger%iter_info%project_name = replica_proj_name(1:lp)//
"-r-"//trim(adjustl(
cp_to_string(i)))
470 unit_nr = sub_logger%default_global_unit_nr
471 IF (unit_nr > 0)
THEN
474 output_file_path = replica_proj_name(1:lp)//
"-r-"//trim(adjustl(
cp_to_string(i)))//
".out"
475 CALL open_file(file_name=output_file_path, file_status=
"UNKNOWN", &
476 file_action=
"WRITE", file_position=
"APPEND", &
477 unit_number=unit_nr, skip_get_unit_number=.true.)
485 CALL timestop(handle)
497 FUNCTION get_replica_project_name(rep_env, n_rep, j)
RESULT(replica_proj_name)
499 INTEGER,
INTENT(IN) :: n_rep, j
500 CHARACTER(LEN=default_path_length) :: replica_proj_name
502 CHARACTER(LEN=default_string_length) :: padding
503 INTEGER :: i, lp, ndigits
507 replica_proj_name = rep_env%original_project_name
509 ndigits = ceiling(log10(real(n_rep + 1, kind=
dp))) - &
510 ceiling(log10(real(j + 1, kind=
dp)))
515 lp = len_trim(replica_proj_name)
516 replica_proj_name(lp + 1:len(replica_proj_name)) =
"-BAND"// &
518 END FUNCTION get_replica_project_name
532 CHARACTER(LEN=default_path_length) :: replica_proj_name
533 INTEGER :: handle2, ierr, irep, n_rep, n_rep_neb, &
538 n_rep_neb = neb_env%number_of_replica
543 output_unit = logger%default_global_unit_nr
544 IF (output_unit > 0)
THEN
545 WRITE (unit=output_unit, fmt=
'(/,(T2,A79))') &
546 "*******************************************************************************", &
547 "** MAPPING OF BAND REPLICA TO REPLICA ENV **", &
548 "*******************************************************************************"
549 WRITE (unit=output_unit, fmt=
'(T2,A,I6,T32,A,T79,A)') &
550 "** Replica Env Nr.: ", rep_env%local_rep_indices(1) - 1, &
551 "working on the following BAND replicas",
"**"
552 WRITE (unit=output_unit, fmt=
'(T2,A79)') &
555 DO irep = 1, n_rep_neb, n_rep
556 replica_proj_name = get_replica_project_name(rep_env, n_rep_neb, irep + rep_env%local_rep_indices(1) - 1)
557 IF (output_unit > 0)
THEN
558 WRITE (unit=output_unit, fmt=
'(T2,A,I6,T32,A,T79,A)') &
559 "** Band Replica Nr.: ", irep + rep_env%local_rep_indices(1) - 1, &
560 "Output available on file: "//trim(replica_proj_name)//
".out",
"**"
563 IF (output_unit > 0)
THEN
564 WRITE (unit=output_unit, fmt=
'(T2,A79)') &
566 "*******************************************************************************"
567 WRITE (unit=output_unit, fmt=
'(/)')
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Handles all functions related to the CELL.
some minimal info about CP2K, including its version and license
subroutine, public get_runtime_info()
...
Utility routines to open and close files. Tracking of preconnections.
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.
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.
various routines to log and control the output. The idea is that decisions about where to log should ...
subroutine, public cp_rm_default_logger()
the cousin of cp_add_default_logger, decrements the stack, so that the default logger is what it has ...
subroutine, public cp_add_default_logger(logger)
adds a default logger. MUST be called before logging occours
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 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)
...
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,...
real(kind=dp) function, public cp_unit_from_cp2k(value, unit_str, defaults, power)
converts from the internal cp2k units to the given unit
interface to use cp2k as library
subroutine, public f_env_add_defaults(f_env_id, f_env, handle)
adds the default environments of the f_env to the stack of the defaults, and returns a new error and ...
subroutine, public f_env_rm_defaults(f_env, ierr, handle)
removes the default environments of the f_env to the stack of the defaults, and sets ierr accordingly...
Interface for the force calculations.
integer, parameter, public use_mixed_force
recursive subroutine, public force_env_get(force_env, in_use, fist_env, qs_env, meta_env, fp_env, subsys, para_env, potential_energy, additional_potential, kinetic_energy, harmonic_shell, kinetic_shell, cell, sub_force_env, qmmm_env, qmmmx_env, eip_env, pwdft_env, globenv, input, force_env_section, method_name_id, root_section, mixed_env, nnp_env, embed_env, ipi_env)
returns various attributes about the force environment
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
integer, parameter, public default_path_length
Machine interface based on Fortran 2003 and POSIX.
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
I/O Module for Nudged Elastic Band Calculation.
subroutine, public read_neb_section(neb_env, neb_section)
Read data from the NEB input section.
subroutine, public dump_replica_coordinates(particle_set, coords, i_rep, ienum, iw, use_colvar)
dump coordinates of a replica NEB
subroutine, public neb_rep_env_map_info(rep_env, neb_env)
Print some mapping infos in the replica_env setup output files i.e. prints in which files one can fin...
subroutine, public dump_neb_info(neb_env, coords, vels, forces, particle_set, logger, istep, energies, distances, output_unit)
dump print info of a NEB run
subroutine, public handle_band_file_names(rep_env, irep, n_rep, istep)
Handles the correct file names during a band calculation.
Module with utility to perform MD Nudged Elastic Band Calculation.
subroutine, public get_temperatures(vels, particle_set, temperatures, ekin, factor)
Computes temperatures.
Typo for Nudged Elastic Band Calculation.
Define methods related to particle_type.
subroutine, public write_particle_coordinates(particle_set, iunit, output_format, content, title, cell, array, unit_conv, charge_occup, charge_beta, charge_extended, print_kind)
Should be able to write a few formats e.g. xmol, and some binary format (dcd) some format can be used...
Define the data structure for the particle information.
pure real(kind=dp) function, dimension(3), public get_particle_pos_or_vel(iatom, particle_set, vector)
Return the atomic position or velocity of atom iatom in x from a packed vector even if core-shell par...
Definition of physical constants:
real(kind=dp), parameter, public angstrom
types used to handle many replica of the same system that differ only in atom positions,...
Type defining parameters related to the simulation cell.
type of a logger, at the moment it contains just a print level starting at which level it should be l...
keeps replicated information about the replicas