1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief I/O Module for Nudged Elastic Band Calculation 8!> \note 9!> Numerical accuracy for parallel runs: 10!> Each replica starts the SCF run from the one optimized 11!> in a previous run. It may happen then energies and derivatives 12!> of a serial run and a parallel run could be slightly different 13!> 'cause of a different starting density matrix. 14!> Exact results are obtained using: 15!> EXTRAPOLATION USE_GUESS in QS section (Teo 09.2006) 16!> \author Teodoro Laino 10.2006 17! ************************************************************************************************** 18MODULE neb_io 19 USE cell_types, ONLY: cell_type 20 USE cp2k_info, ONLY: get_runtime_info 21 USE cp_files, ONLY: close_file,& 22 open_file 23 USE cp_log_handling, ONLY: cp_add_default_logger,& 24 cp_get_default_logger,& 25 cp_logger_type,& 26 cp_rm_default_logger,& 27 cp_to_string 28 USE cp_output_handling, ONLY: cp_print_key_finished_output,& 29 cp_print_key_unit_nr 30 USE cp_units, ONLY: cp_unit_from_cp2k 31 USE f77_interface, ONLY: f_env_add_defaults,& 32 f_env_rm_defaults,& 33 f_env_type 34 USE force_env_types, ONLY: force_env_get,& 35 use_mixed_force 36 USE header, ONLY: cp2k_footer 37 USE input_constants, ONLY: band_md_opt,& 38 do_sm,& 39 dump_xmol,& 40 pot_neb_fe,& 41 pot_neb_full,& 42 pot_neb_me 43 USE input_cp2k_neb, ONLY: create_band_section 44 USE input_cp2k_restarts, ONLY: write_restart 45 USE input_enumeration_types, ONLY: enum_i2c,& 46 enumeration_type 47 USE input_keyword_types, ONLY: keyword_get,& 48 keyword_type 49 USE input_section_types, ONLY: section_get_keyword,& 50 section_release,& 51 section_type,& 52 section_vals_get,& 53 section_vals_get_subs_vals,& 54 section_vals_type,& 55 section_vals_val_get,& 56 section_vals_val_set 57 USE kinds, ONLY: default_path_length,& 58 default_string_length,& 59 dp 60 USE machine, ONLY: m_flush 61 USE neb_md_utils, ONLY: get_temperatures 62 USE neb_types, ONLY: neb_type,& 63 neb_var_type 64 USE particle_methods, ONLY: write_particle_coordinates 65 USE particle_types, ONLY: get_particle_pos_or_vel,& 66 particle_type 67 USE physcon, ONLY: angstrom 68 USE replica_types, ONLY: replica_env_type 69#include "../base/base_uses.f90" 70 71 IMPLICIT NONE 72 PRIVATE 73 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'neb_io' 74 75 PUBLIC :: read_neb_section, & 76 dump_neb_info, & 77 dump_replica_coordinates, & 78 handle_band_file_names, & 79 neb_rep_env_map_info 80 81CONTAINS 82 83! ************************************************************************************************** 84!> \brief Read data from the NEB input section 85!> \param neb_env ... 86!> \param neb_section ... 87!> \author Teodoro Laino 09.2006 88! ************************************************************************************************** 89 SUBROUTINE read_neb_section(neb_env, neb_section) 90 TYPE(neb_type), POINTER :: neb_env 91 TYPE(section_vals_type), POINTER :: neb_section 92 93 CHARACTER(len=*), PARAMETER :: routineN = 'read_neb_section', & 94 routineP = moduleN//':'//routineN 95 96 LOGICAL :: explicit 97 TYPE(section_vals_type), POINTER :: wrk_section 98 99 CPASSERT(ASSOCIATED(neb_env)) 100 neb_env%istep = 0 101 CALL section_vals_val_get(neb_section, "BAND_TYPE", i_val=neb_env%id_type) 102 CALL section_vals_val_get(neb_section, "NUMBER_OF_REPLICA", i_val=neb_env%number_of_replica) 103 CALL section_vals_val_get(neb_section, "K_SPRING", r_val=neb_env%K) 104 CALL section_vals_val_get(neb_section, "ROTATE_FRAMES", l_val=neb_env%rotate_frames) 105 CALL section_vals_val_get(neb_section, "ALIGN_FRAMES", l_val=neb_env%align_frames) 106 CALL section_vals_val_get(neb_section, "OPTIMIZE_BAND%OPTIMIZE_END_POINTS", l_val=neb_env%optimize_end_points) 107 ! Climb Image NEB 108 CALL section_vals_val_get(neb_section, "CI_NEB%NSTEPS_IT", i_val=neb_env%nsteps_it) 109 ! Band Optimization Type 110 CALL section_vals_val_get(neb_section, "OPTIMIZE_BAND%OPT_TYPE", i_val=neb_env%opt_type) 111 ! Use colvars 112 CALL section_vals_val_get(neb_section, "USE_COLVARS", l_val=neb_env%use_colvar) 113 CALL section_vals_val_get(neb_section, "POT_TYPE", i_val=neb_env%pot_type) 114 ! Before continuing let's do some consistency check between keywords 115 IF (neb_env%pot_type /= pot_neb_full) THEN 116 ! Requires the use of colvars 117 IF (.NOT. neb_env%use_colvar) & 118 CALL cp_abort(__LOCATION__, & 119 "A potential energy function based on free energy or minimum energy"// & 120 " was requested without enabling the usage of COLVARS. Both methods"// & 121 " are based on COLVARS definition.") 122 ! Moreover let's check if the proper sections have been defined.. 123 SELECT CASE (neb_env%pot_type) 124 CASE (pot_neb_fe) 125 wrk_section => section_vals_get_subs_vals(neb_env%root_section, "MOTION%MD") 126 CALL section_vals_get(wrk_section, explicit=explicit) 127 IF (.NOT. explicit) & 128 CALL cp_abort(__LOCATION__, & 129 "A free energy BAND (colvars projected) calculation is requested"// & 130 " but NONE MD section was defined in the input.") 131 CASE (pot_neb_me) 132 wrk_section => section_vals_get_subs_vals(neb_env%root_section, "MOTION%GEO_OPT") 133 CALL section_vals_get(wrk_section, explicit=explicit) 134 IF (.NOT. explicit) & 135 CALL cp_abort(__LOCATION__, & 136 "A minimum energy BAND (colvars projected) calculation is requested"// & 137 " but NONE GEO_OPT section was defined in the input.") 138 END SELECT 139 ELSE 140 IF (neb_env%use_colvar) & 141 CALL cp_abort(__LOCATION__, & 142 "A band calculation was requested with a full potential energy. USE_COLVAR cannot"// & 143 " be set for this kind of calculation!") 144 END IF 145 ! String Method 146 CALL section_vals_val_get(neb_section, "STRING_METHOD%SMOOTHING", r_val=neb_env%smoothing) 147 CALL section_vals_val_get(neb_section, "STRING_METHOD%SPLINE_ORDER", i_val=neb_env%spline_order) 148 neb_env%reparametrize_frames = .FALSE. 149 IF (neb_env%id_type == do_sm) THEN 150 neb_env%reparametrize_frames = .TRUE. 151 END IF 152 END SUBROUTINE read_neb_section 153 154! ************************************************************************************************** 155!> \brief dump print info of a NEB run 156!> \param neb_env ... 157!> \param coords ... 158!> \param vels ... 159!> \param forces ... 160!> \param particle_set ... 161!> \param logger ... 162!> \param istep ... 163!> \param energies ... 164!> \param distances ... 165!> \param output_unit ... 166!> \author Teodoro Laino 09.2006 167! ************************************************************************************************** 168 SUBROUTINE dump_neb_info(neb_env, coords, vels, forces, particle_set, logger, & 169 istep, energies, distances, output_unit) 170 TYPE(neb_type), POINTER :: neb_env 171 TYPE(neb_var_type), POINTER :: coords 172 TYPE(neb_var_type), OPTIONAL, POINTER :: vels, forces 173 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set 174 TYPE(cp_logger_type), POINTER :: logger 175 INTEGER, INTENT(IN) :: istep 176 REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: energies, distances 177 INTEGER, INTENT(IN) :: output_unit 178 179 CHARACTER(len=*), PARAMETER :: routineN = 'dump_neb_info', routineP = moduleN//':'//routineN 180 181 CHARACTER(LEN=20) :: mytype 182 CHARACTER(LEN=default_string_length) :: line, title, unit_str 183 INTEGER :: crd, ener, frc, handle, i, irep, ndig, & 184 ndigl, ttst, vel 185 LOGICAL :: explicit, lval 186 REAL(KIND=dp) :: f_ann, tmp_r1, unit_conv 187 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: ekin, temperatures 188 TYPE(cell_type), POINTER :: cell 189 TYPE(enumeration_type), POINTER :: enum 190 TYPE(keyword_type), POINTER :: keyword 191 TYPE(section_type), POINTER :: section 192 TYPE(section_vals_type), POINTER :: tc_section, vc_section 193 194 CALL timeset(routineN, handle) 195 ndig = CEILING(LOG10(REAL(neb_env%number_of_replica + 1, KIND=dp))) 196 CALL force_env_get(neb_env%force_env, cell=cell) 197 DO irep = 1, neb_env%number_of_replica 198 ndigl = CEILING(LOG10(REAL(irep + 1, KIND=dp))) 199 WRITE (line, '(A,'//cp_to_string(ndig)//'("0"),T'//cp_to_string(11 + ndig + 1 - ndigl)//',I0)') "Replica_nr_", irep 200 crd = cp_print_key_unit_nr(logger, neb_env%motion_print_section, "TRAJECTORY", & 201 extension=".xyz", file_form="FORMATTED", middle_name="pos-"//TRIM(line)) 202 IF (PRESENT(vels)) THEN 203 vel = cp_print_key_unit_nr(logger, neb_env%motion_print_section, "VELOCITIES", & 204 extension=".xyz", file_form="FORMATTED", middle_name="vel-"//TRIM(line)) 205 END IF 206 IF (PRESENT(forces)) THEN 207 frc = cp_print_key_unit_nr(logger, neb_env%motion_print_section, "FORCES", & 208 extension=".xyz", file_form="FORMATTED", middle_name="force-"//TRIM(line)) 209 END IF 210 ! Dump Trajectory 211 IF (crd > 0) THEN 212 ! Gather units of measure for output 213 CALL section_vals_val_get(neb_env%motion_print_section, "TRAJECTORY%UNIT", & 214 c_val=unit_str) 215 unit_conv = cp_unit_from_cp2k(1.0_dp, TRIM(unit_str)) 216 ! This information can be digested by Molden 217 WRITE (UNIT=title, FMT="(A,I8,A,F20.10)") " i =", istep, ", E =", energies(irep) 218 CALL write_particle_coordinates(particle_set, crd, dump_xmol, "POS", title, & 219 cell=cell, array=coords%xyz(:, irep), unit_conv=unit_conv) 220 CALL m_flush(crd) 221 END IF 222 ! Dump Velocities 223 IF (vel > 0 .AND. PRESENT(vels)) THEN 224 ! Gather units of measure for output 225 CALL section_vals_val_get(neb_env%motion_print_section, "VELOCITIES%UNIT", & 226 c_val=unit_str) 227 unit_conv = cp_unit_from_cp2k(1.0_dp, TRIM(unit_str)) 228 WRITE (UNIT=title, FMT="(A,I8,A,F20.10)") " i =", istep, ", E =", energies(irep) 229 CALL write_particle_coordinates(particle_set, vel, dump_xmol, "VEL", title, & 230 cell=cell, array=vels%xyz(:, irep), unit_conv=unit_conv) 231 CALL m_flush(vel) 232 END IF 233 ! Dump Forces 234 IF (frc > 0 .AND. PRESENT(forces)) THEN 235 ! Gather units of measure for output 236 CALL section_vals_val_get(neb_env%motion_print_section, "FORCES%UNIT", & 237 c_val=unit_str) 238 unit_conv = cp_unit_from_cp2k(1.0_dp, TRIM(unit_str)) 239 WRITE (UNIT=title, FMT="(A,I8,A,F20.10)") " i =", istep, ", E =", energies(irep) 240 CALL write_particle_coordinates(particle_set, frc, dump_xmol, "FRC", title, & 241 cell=cell, array=forces%xyz(:, irep), unit_conv=unit_conv) 242 CALL m_flush(frc) 243 END IF 244 CALL cp_print_key_finished_output(crd, logger, neb_env%motion_print_section, & 245 "TRAJECTORY") 246 IF (PRESENT(vels)) THEN 247 CALL cp_print_key_finished_output(vel, logger, neb_env%motion_print_section, & 248 "VELOCITIES") 249 END IF 250 IF (PRESENT(forces)) THEN 251 CALL cp_print_key_finished_output(frc, logger, neb_env%motion_print_section, & 252 "FORCES") 253 END IF 254 END DO 255 ! NEB summary info on screen 256 IF (output_unit > 0) THEN 257 tc_section => section_vals_get_subs_vals(neb_env%neb_section, "OPTIMIZE_BAND%MD%TEMP_CONTROL") 258 vc_section => section_vals_get_subs_vals(neb_env%neb_section, "OPTIMIZE_BAND%MD%VEL_CONTROL") 259 ALLOCATE (temperatures(neb_env%number_of_replica)) 260 ALLOCATE (ekin(neb_env%number_of_replica)) 261 CALL get_temperatures(vels, particle_set, temperatures, ekin=ekin) 262 WRITE (output_unit, '(/)', ADVANCE="NO") 263 WRITE (output_unit, FMT='(A,A)') ' **************************************', & 264 '*****************************************' 265 NULLIFY (section, keyword, enum) 266 CALL create_band_section(section) 267 keyword => section_get_keyword(section, "BAND_TYPE") 268 CALL keyword_get(keyword, enum=enum) 269 mytype = TRIM(enum_i2c(enum, neb_env%id_type)) 270 WRITE (output_unit, FMT='(A,T61,A)') & 271 ' BAND TYPE =', ADJUSTR(mytype) 272 CALL section_release(section) 273 WRITE (output_unit, FMT='(A,T61,A)') & 274 ' BAND TYPE OPTIMIZATION =', ADJUSTR(neb_env%opt_type_label(1:20)) 275 WRITE (output_unit, '( A,T71,I10 )') & 276 ' STEP NUMBER =', istep 277 IF (neb_env%rotate_frames) WRITE (output_unit, '( A,T71,L10 )') & 278 ' RMSD DISTANCE DEFINITION =', neb_env%rotate_frames 279 ! velocity control parameters output 280 CALL section_vals_get(vc_section, explicit=explicit) 281 IF (explicit) THEN 282 CALL section_vals_val_get(vc_section, "PROJ_VELOCITY_VERLET", l_val=lval) 283 IF (lval) WRITE (output_unit, '( A,T71,L10 )') & 284 ' PROJECTED VELOCITY VERLET =', lval 285 CALL section_vals_val_get(vc_section, "SD_LIKE", l_val=lval) 286 IF (lval) WRITE (output_unit, '( A,T71,L10)') & 287 ' STEEPEST DESCENT LIKE =', lval 288 CALL section_vals_val_get(vc_section, "ANNEALING", r_val=f_ann) 289 IF (f_ann /= 1.0_dp) THEN 290 WRITE (output_unit, '( A,T71,F10.5)') & 291 ' ANNEALING FACTOR = ', f_ann 292 END IF 293 END IF 294 ! temperature control parameters output 295 CALL section_vals_get(tc_section, explicit=explicit) 296 IF (explicit) THEN 297 CALL section_vals_val_get(tc_section, "TEMP_TOL_STEPS", i_val=ttst) 298 IF (istep <= ttst) THEN 299 CALL section_vals_val_get(tc_section, "TEMPERATURE", r_val=f_ann) 300 tmp_r1 = cp_unit_from_cp2k(f_ann, "K") 301 WRITE (output_unit, '( A,T71,F10.5)') & 302 ' TEMPERATURE TARGET =', tmp_r1 303 END IF 304 END IF 305 WRITE (output_unit, '( A,T71,I10 )') & 306 ' NUMBER OF NEB REPLICA =', neb_env%number_of_replica 307 WRITE (output_unit, '( A,T17,4F16.6)') & 308 ' DISTANCES REP =', distances(1:MIN(4, SIZE(distances))) 309 IF (SIZE(distances) > 4) THEN 310 WRITE (output_unit, '( T17,4F16.6)') distances(5:SIZE(distances)) 311 END IF 312 WRITE (output_unit, '( A,T17,4F16.6)') & 313 ' ENERGIES [au] =', energies(1:MIN(4, SIZE(energies))) 314 IF (SIZE(energies) > 4) THEN 315 WRITE (output_unit, '( T17,4F16.6)') energies(5:SIZE(energies)) 316 END IF 317 IF (neb_env%opt_type == band_md_opt) THEN 318 WRITE (output_unit, '( A,T33,4(1X,F11.5))') & 319 ' REPLICA TEMPERATURES (K) =', temperatures(1:MIN(4, SIZE(temperatures))) 320 DO i = 5, SIZE(temperatures), 4 321 WRITE (output_unit, '( T33,4(1X,F11.5))') & 322 temperatures(i:MIN(i + 3, SIZE(temperatures))) 323 END DO 324 END IF 325 WRITE (output_unit, '( A,T56,F25.14)') & 326 ' BAND TOTAL ENERGY [au] =', SUM(energies(:) + ekin(:)) + & 327 neb_env%spring_energy 328 WRITE (output_unit, FMT='(A,A)') ' **************************************', & 329 '*****************************************' 330 DEALLOCATE (ekin) 331 DEALLOCATE (temperatures) 332 END IF 333 ! Ener file 334 ener = cp_print_key_unit_nr(logger, neb_env%neb_section, "ENERGY", & 335 extension=".ener", file_form="FORMATTED") 336 IF (ener > 0) THEN 337 WRITE (line, '(I0)') 2*neb_env%number_of_replica - 1 338 WRITE (ener, '(I10,'//TRIM(line)//'(1X,F20.9))') istep, & 339 energies, distances 340 END IF 341 CALL cp_print_key_finished_output(ener, logger, neb_env%neb_section, & 342 "ENERGY") 343 344 ! Dump Restarts 345 CALL cp_add_default_logger(logger) 346 CALL write_restart(force_env=neb_env%force_env, & 347 root_section=neb_env%root_section, & 348 coords=coords, & 349 vels=vels) 350 CALL cp_rm_default_logger() 351 352 CALL timestop(handle) 353 354 END SUBROUTINE dump_neb_info 355 356! ************************************************************************************************** 357!> \brief dump coordinates of a replica NEB 358!> \param particle_set ... 359!> \param coords ... 360!> \param i_rep ... 361!> \param ienum ... 362!> \param iw ... 363!> \param use_colvar ... 364!> \author Teodoro Laino 09.2006 365! ************************************************************************************************** 366 SUBROUTINE dump_replica_coordinates(particle_set, coords, i_rep, ienum, iw, use_colvar) 367 368 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set 369 TYPE(neb_var_type), POINTER :: coords 370 INTEGER, INTENT(IN) :: i_rep, ienum, iw 371 LOGICAL, INTENT(IN) :: use_colvar 372 373 INTEGER :: iatom, j 374 REAL(KIND=dp), DIMENSION(3) :: r 375 376 IF (iw > 0) THEN 377 WRITE (iw, '(/,T2,"NEB|",75("*"))') 378 WRITE (iw, '(T2,"NEB|",1X,A,I0,A)') & 379 "Geometry for Replica Nr. ", ienum, " in Angstrom" 380 DO iatom = 1, SIZE(particle_set) 381 r(1:3) = get_particle_pos_or_vel(iatom, particle_set, coords%xyz(:, i_rep)) 382 WRITE (iw, '(T2,"NEB|",1X,A10,5X,3F15.9)') & 383 TRIM(particle_set(iatom)%atomic_kind%name), r(1:3)*angstrom 384 END DO 385 IF (use_colvar) THEN 386 WRITE (iw, '(/,T2,"NEB|",1X,A10)') "COLLECTIVE VARIABLES:" 387 WRITE (iw, '(T2,"NEB|",16X,3F15.9)') & 388 (coords%int(j, i_rep), j=1, SIZE(coords%int(:, :), 1)) 389 END IF 390 WRITE (iw, '(T2,"NEB|",75("*"))') 391 CALL m_flush(iw) 392 END IF 393 394 END SUBROUTINE dump_replica_coordinates 395 396! ************************************************************************************************** 397!> \brief Handles the correct file names during a band calculation 398!> \param rep_env ... 399!> \param irep ... 400!> \param n_rep ... 401!> \param istep ... 402!> \author Teodoro Laino 06.2009 403! ************************************************************************************************** 404 SUBROUTINE handle_band_file_names(rep_env, irep, n_rep, istep) 405 TYPE(replica_env_type), POINTER :: rep_env 406 INTEGER, INTENT(IN) :: irep, n_rep, istep 407 408 CHARACTER(len=*), PARAMETER :: routineN = 'handle_band_file_names', & 409 routineP = moduleN//':'//routineN 410 411 CHARACTER(LEN=default_path_length) :: output_file_path, replica_proj_name 412 INTEGER :: handle, handle2, i, ierr, j, lp, unit_nr 413 TYPE(cp_logger_type), POINTER :: logger, sub_logger 414 TYPE(f_env_type), POINTER :: f_env 415 TYPE(section_vals_type), POINTER :: root_section 416 417 CALL timeset(routineN, handle) 418 CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env, & 419 handle=handle2) 420 logger => cp_get_default_logger() 421 CALL force_env_get(f_env%force_env, root_section=root_section) 422 j = irep + (rep_env%local_rep_indices(1) - 1) 423 ! Get replica_project_name 424 replica_proj_name = get_replica_project_name(rep_env, n_rep, j) 425 lp = LEN_TRIM(replica_proj_name) 426 CALL section_vals_val_set(root_section, "GLOBAL%PROJECT_NAME", & 427 c_val=TRIM(replica_proj_name)) 428 logger%iter_info%project_name = replica_proj_name 429 430 ! We change the file on which is pointing the global logger and error 431 output_file_path = replica_proj_name(1:lp)//".out" 432 CALL section_vals_val_set(root_section, "GLOBAL%OUTPUT_FILE_NAME", & 433 c_val=TRIM(output_file_path)) 434 IF (logger%default_global_unit_nr > 0) THEN 435 CALL close_file(logger%default_global_unit_nr) 436 CALL open_file(file_name=output_file_path, file_status="UNKNOWN", & 437 file_action="WRITE", file_position="APPEND", & 438 unit_number=logger%default_global_unit_nr, & 439 skip_get_unit_number=.TRUE.) 440 WRITE (UNIT=logger%default_global_unit_nr, FMT="(/,(T2,A79))") & 441 "*******************************************************************************", & 442 "** BAND EVALUATION OF ENERGIES AND FORCES **", & 443 "*******************************************************************************" 444 WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A,T79,A)") "**", "**" 445 WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A,T79,A)") "**", "**" 446 WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A,I5,T41,A,I5,T79,A)") & 447 "** Replica Env Nr. :", rep_env%local_rep_indices(1) - 1, "Replica Band Nr. :", j, "**" 448 WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A,I5,T79,A)") & 449 "** Band Step Nr. :", istep, "**" 450 WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A79)") & 451 "*******************************************************************************" 452 END IF 453 454 ! Handle specific case for mixed_env 455 SELECT CASE (f_env%force_env%in_use) 456 CASE (use_mixed_force) 457 DO i = 1, f_env%force_env%mixed_env%ngroups 458 IF (MODULO(i - 1, f_env%force_env%mixed_env%ngroups) == & 459 f_env%force_env%mixed_env%group_distribution(f_env%force_env%mixed_env%para_env%mepos)) THEN 460 sub_logger => f_env%force_env%mixed_env%sub_logger(i)%p 461 sub_logger%iter_info%project_name = replica_proj_name(1:lp)//"-r-"//TRIM(ADJUSTL(cp_to_string(i))) 462 463 unit_nr = sub_logger%default_global_unit_nr 464 IF (unit_nr > 0) THEN 465 CALL close_file(unit_nr) 466 467 output_file_path = replica_proj_name(1:lp)//"-r-"//TRIM(ADJUSTL(cp_to_string(i)))//".out" 468 CALL open_file(file_name=output_file_path, file_status="UNKNOWN", & 469 file_action="WRITE", file_position="APPEND", & 470 unit_number=unit_nr, skip_get_unit_number=.TRUE.) 471 END IF 472 END IF 473 END DO 474 END SELECT 475 476 CALL f_env_rm_defaults(f_env=f_env, ierr=ierr, handle=handle2) 477 CPASSERT(ierr == 0) 478 CALL timestop(handle) 479 480 END SUBROUTINE handle_band_file_names 481 482! ************************************************************************************************** 483!> \brief Constructs project names for BAND replicas 484!> \param rep_env ... 485!> \param n_rep ... 486!> \param j ... 487!> \return ... 488!> \author Teodoro Laino 06.2009 489! ************************************************************************************************** 490 FUNCTION get_replica_project_name(rep_env, n_rep, j) RESULT(replica_proj_name) 491 TYPE(replica_env_type), POINTER :: rep_env 492 INTEGER, INTENT(IN) :: n_rep, j 493 CHARACTER(LEN=default_path_length) :: replica_proj_name 494 495 CHARACTER(len=*), PARAMETER :: routineN = 'get_replica_project_name', & 496 routineP = moduleN//':'//routineN 497 498 CHARACTER(LEN=default_string_length) :: padding 499 INTEGER :: i, lp, ndigits 500 501! Setup new replica project name and output file 502 503 replica_proj_name = rep_env%original_project_name 504 ! Find padding 505 ndigits = CEILING(LOG10(REAL(n_rep + 1, KIND=dp))) - & 506 CEILING(LOG10(REAL(j + 1, KIND=dp))) 507 padding = "" 508 DO i = 1, ndigits 509 padding(i:i) = "0" 510 END DO 511 lp = LEN_TRIM(replica_proj_name) 512 replica_proj_name(lp + 1:LEN(replica_proj_name)) = "-BAND"// & 513 TRIM(padding)//ADJUSTL(cp_to_string(j)) 514 END FUNCTION get_replica_project_name 515 516! ************************************************************************************************** 517!> \brief Print some mapping infos in the replica_env setup output files 518!> i.e. prints in which files one can find information for each band 519!> replica 520!> \param rep_env ... 521!> \param neb_env ... 522!> \author Teodoro Laino 06.2009 523! ************************************************************************************************** 524 SUBROUTINE neb_rep_env_map_info(rep_env, neb_env) 525 TYPE(replica_env_type), POINTER :: rep_env 526 TYPE(neb_type), POINTER :: neb_env 527 528 CHARACTER(len=*), PARAMETER :: routineN = 'neb_rep_env_map_info', & 529 routineP = moduleN//':'//routineN 530 531 CHARACTER(LEN=default_path_length) :: replica_proj_name 532 INTEGER :: handle2, ierr, irep, n_rep, n_rep_neb, & 533 output_unit 534 TYPE(cp_logger_type), POINTER :: logger 535 TYPE(f_env_type), POINTER :: f_env 536 537 n_rep_neb = neb_env%number_of_replica 538 n_rep = rep_env%nrep 539 CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env, & 540 handle=handle2) 541 logger => cp_get_default_logger() 542 output_unit = logger%default_global_unit_nr 543 IF (output_unit > 0) THEN 544 WRITE (UNIT=output_unit, FMT='(/,(T2,A79))') & 545 "*******************************************************************************", & 546 "** MAPPING OF BAND REPLICA TO REPLICA ENV **", & 547 "*******************************************************************************" 548 WRITE (UNIT=output_unit, FMT='(T2,A,I6,T32,A,T79,A)') & 549 "** Replica Env Nr.: ", rep_env%local_rep_indices(1) - 1, & 550 "working on the following BAND replicas", "**" 551 WRITE (UNIT=output_unit, FMT='(T2,A79)') & 552 "** **" 553 END IF 554 DO irep = 1, n_rep_neb, n_rep 555 replica_proj_name = get_replica_project_name(rep_env, n_rep_neb, irep + rep_env%local_rep_indices(1) - 1) 556 IF (output_unit > 0) THEN 557 WRITE (UNIT=output_unit, FMT='(T2,A,I6,T32,A,T79,A)') & 558 "** Band Replica Nr.: ", irep + rep_env%local_rep_indices(1) - 1, & 559 "Output available on file: "//TRIM(replica_proj_name)//".out", "**" 560 END IF 561 END DO 562 IF (output_unit > 0) THEN 563 WRITE (UNIT=output_unit, FMT='(T2,A79)') & 564 "** **", & 565 "*******************************************************************************" 566 WRITE (UNIT=output_unit, FMT='(/)') 567 END IF 568 ! update runtime info before printing the footer 569 CALL get_runtime_info() 570 ! print footer 571 CALL cp2k_footer(output_unit) 572 CALL f_env_rm_defaults(f_env=f_env, ierr=ierr, handle=handle2) 573 CPASSERT(ierr == 0) 574 END SUBROUTINE neb_rep_env_map_info 575 576END MODULE neb_io 577