diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 893285a8df..0f683e1f33 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -290,6 +290,9 @@ list( iao_analysis.F iao_types.F ipi_driver.F + ipi_environment.F + ipi_environment_types.F + ipi_server.F iterate_matrix.F kg_correction.F kg_environment.F diff --git a/src/f77_interface.F b/src/f77_interface.F index 51618594db..bd2e68ae82 100644 --- a/src/f77_interface.F +++ b/src/f77_interface.F @@ -73,7 +73,7 @@ MODULE f77_interface USE grid_api, ONLY: grid_library_finalize,& grid_library_init USE input_constants, ONLY: & - do_eip, do_embed, do_fist, do_mixed, do_nnp, do_qmmm, do_qmmmx, do_qs, do_sirius + do_eip, do_embed, do_fist, do_ipi, do_mixed, do_nnp, do_qmmm, do_qmmmx, do_qs, do_sirius USE input_cp2k_check, ONLY: check_cp2k_input USE input_cp2k_force_eval, ONLY: create_force_eval_section USE input_cp2k_read, ONLY: empty_initial_variables,& @@ -87,6 +87,8 @@ MODULE f77_interface section_vals_get, section_vals_get_subs_vals, section_vals_release, & section_vals_remove_values, section_vals_retain, section_vals_type, section_vals_val_get, & section_vals_write + USE ipi_environment, ONLY: ipi_init + USE ipi_environment_types, ONLY: ipi_environment_type USE kinds, ONLY: default_path_length,& default_string_length,& dp @@ -594,6 +596,7 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, TYPE(force_env_type), POINTER :: force_env, my_force_env TYPE(fp_type), POINTER :: fp_env TYPE(global_environment_type), POINTER :: globenv + TYPE(ipi_environment_type), POINTER :: ipi_env TYPE(keyword_type), POINTER :: keyword TYPE(meta_env_type), POINTER :: meta_env TYPE(mixed_environment_type), POINTER :: mixed_env @@ -868,6 +871,13 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, CALL force_env_create(my_force_env, root_section, nnp_env=nnp_env, para_env=my_para_env, & globenv=globenv, force_env_section=force_env_section) + CASE (do_ipi) + ALLOCATE (ipi_env) + CALL ipi_init(ipi_env, root_section, my_para_env, force_env_section=force_env_section, & + subsys_section=subsys_section) + CALL force_env_create(my_force_env, root_section, ipi_env=ipi_env, para_env=my_para_env, & + globenv=globenv, force_env_section=force_env_section) + CASE default CALL create_force_eval_section(section) keyword => section_get_keyword(section, "METHOD") diff --git a/src/force_env_methods.F b/src/force_env_methods.F index e040d94eff..74cc2f7899 100644 --- a/src/force_env_methods.F +++ b/src/force_env_methods.F @@ -66,8 +66,8 @@ MODULE force_env_methods USE fist_force, ONLY: fist_calc_energy_force USE force_env_types, ONLY: & force_env_get, force_env_get_natom, force_env_p_type, force_env_set, force_env_type, & - use_eip_force, use_embed, use_fist_force, use_mixed_force, use_nnp_force, use_prog_name, & - use_pwdft_force, use_qmmm, use_qmmmx, use_qs_force + use_eip_force, use_embed, use_fist_force, use_ipi, use_mixed_force, use_nnp_force, & + use_prog_name, use_pwdft_force, use_qmmm, use_qmmmx, use_qs_force USE force_env_utils, ONLY: rescale_forces,& write_atener,& write_forces @@ -89,6 +89,8 @@ MODULE force_env_methods section_vals_retain,& section_vals_type,& section_vals_val_get + USE ipi_environment_types, ONLY: ipi_environment_type + USE ipi_server, ONLY: request_forces USE kahan_sum, ONLY: accurate_sum USE kinds, ONLY: default_path_length,& default_string_length,& @@ -283,6 +285,8 @@ RECURSIVE SUBROUTINE force_env_calc_energy_force(force_env, calc_force, & calculate_forces) CASE (use_embed) CALL embed_energy(force_env) + CASE (use_ipi) + CALL request_forces(force_env%ipi_env) CASE default CPABORT("") END SELECT @@ -749,13 +753,14 @@ END SUBROUTINE force_env_calc_num_pressure !> \param mixed_env ... !> \param embed_env ... !> \param nnp_env ... +!> \param ipi_env ... !> \par History !> 04.2003 created [fawzi] !> \author fawzi ! ************************************************************************************************** SUBROUTINE force_env_create(force_env, root_section, para_env, globenv, fist_env, & qs_env, meta_env, sub_force_env, qmmm_env, qmmmx_env, eip_env, pwdft_env, force_env_section, & - mixed_env, embed_env, nnp_env) + mixed_env, embed_env, nnp_env, ipi_env) TYPE(force_env_type), POINTER :: force_env TYPE(section_vals_type), POINTER :: root_section @@ -774,6 +779,7 @@ SUBROUTINE force_env_create(force_env, root_section, para_env, globenv, fist_env TYPE(mixed_environment_type), OPTIONAL, POINTER :: mixed_env TYPE(embed_env_type), OPTIONAL, POINTER :: embed_env TYPE(nnp_type), OPTIONAL, POINTER :: nnp_env + TYPE(ipi_environment_type), OPTIONAL, POINTER :: ipi_env ALLOCATE (force_env) NULLIFY (force_env%fist_env, force_env%qs_env, & @@ -854,6 +860,12 @@ SUBROUTINE force_env_create(force_env, root_section, para_env, globenv, fist_env force_env%in_use = use_nnp_force force_env%nnp_env => nnp_env END IF + IF (PRESENT(ipi_env)) THEN + CPASSERT(ASSOCIATED(ipi_env)) + CPASSERT(force_env%in_use == 0) + force_env%in_use = use_ipi + force_env%ipi_env => ipi_env + END IF CPASSERT(force_env%in_use /= 0) IF (PRESENT(sub_force_env)) THEN diff --git a/src/force_env_types.F b/src/force_env_types.F index e38f62e0e4..7347f01b51 100644 --- a/src/force_env_types.F +++ b/src/force_env_types.F @@ -42,6 +42,10 @@ MODULE force_env_types section_vals_retain,& section_vals_type,& section_vals_val_get + USE ipi_environment_types, ONLY: ipi_env_get,& + ipi_env_release,& + ipi_environment_type + USE ipi_server, ONLY: shutdown_server USE kinds, ONLY: dp USE message_passing, ONLY: mp_para_env_release,& mp_para_env_type @@ -84,9 +88,10 @@ MODULE force_env_types use_mixed_force = 506, & use_embed = 507, & use_pwdft_force = 508, & - use_nnp_force = 509 + use_nnp_force = 509, & + use_ipi = 510 - CHARACTER(LEN=10), DIMENSION(501:509), PARAMETER, PUBLIC :: & + CHARACTER(LEN=10), DIMENSION(501:510), PARAMETER, PUBLIC :: & use_prog_name = (/ & "FIST ", & "QS ", & @@ -96,7 +101,8 @@ MODULE force_env_types "MIXED ", & "EMBED ", & "SIRIUS", & - "NNP "/) + "NNP ", & + "IPI "/) PUBLIC :: force_env_type, & force_env_p_type @@ -153,6 +159,7 @@ MODULE force_env_types TYPE(mixed_environment_type), POINTER :: mixed_env => NULL() TYPE(nnp_type), POINTER :: nnp_env => NULL() TYPE(embed_env_type), POINTER :: embed_env => NULL() + TYPE(ipi_environment_type), POINTER :: ipi_env => NULL() TYPE(section_vals_type), POINTER :: force_env_section => NULL() TYPE(section_vals_type), POINTER :: root_section => NULL() END TYPE force_env_type @@ -253,6 +260,10 @@ RECURSIVE SUBROUTINE force_env_release(force_env) CASE (use_embed) CALL embed_env_release(force_env%embed_env) DEALLOCATE (force_env%embed_env) + CASE (use_ipi) + CALL shutdown_server(force_env%ipi_env) + CALL ipi_env_release(force_env%ipi_env) + DEALLOCATE (force_env%ipi_env) END SELECT CALL globenv_release(force_env%globenv) CALL mp_para_env_release(force_env%para_env) @@ -264,6 +275,7 @@ RECURSIVE SUBROUTINE force_env_release(force_env) CPASSERT(.NOT. ASSOCIATED(force_env%mixed_env)) CPASSERT(.NOT. ASSOCIATED(force_env%nnp_env)) CPASSERT(.NOT. ASSOCIATED(force_env%embed_env)) + CPASSERT(.NOT. ASSOCIATED(force_env%ipi_env)) IF (ASSOCIATED(force_env%meta_env)) THEN CALL meta_env_release(force_env%meta_env) DEALLOCATE (force_env%meta_env) @@ -317,6 +329,7 @@ END SUBROUTINE force_env_release !> \param mixed_env ... !> \param nnp_env ... !> \param embed_env ... +!> \param ipi_env ... !> \par History !> 04.2003 created [fawzi] !> \author fawzi @@ -325,7 +338,7 @@ RECURSIVE SUBROUTINE 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) + method_name_id, root_section, mixed_env, nnp_env, embed_env, ipi_env) TYPE(force_env_type), INTENT(IN) :: force_env INTEGER, INTENT(out), OPTIONAL :: in_use TYPE(fist_environment_type), OPTIONAL, POINTER :: fist_env @@ -351,6 +364,7 @@ RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, & TYPE(mixed_environment_type), OPTIONAL, POINTER :: mixed_env TYPE(nnp_type), OPTIONAL, POINTER :: nnp_env TYPE(embed_env_type), OPTIONAL, POINTER :: embed_env + TYPE(ipi_environment_type), OPTIONAL, POINTER :: ipi_env REAL(KIND=dp) :: eip_kinetic_energy, eip_potential_energy TYPE(cp_subsys_type), POINTER :: subsys_tmp @@ -369,6 +383,7 @@ RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, & CPASSERT(.NOT. PRESENT(fist_env)) CPASSERT(.NOT. PRESENT(eip_env)) CPASSERT(.NOT. PRESENT(pwdft_env)) + CPASSERT(.NOT. PRESENT(ipi_env)) CALL get_qs_env(force_env%qs_env, & energy=qs_energy, & input=input, & @@ -389,6 +404,7 @@ RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, & CPASSERT(ASSOCIATED(force_env%eip_env)) CPASSERT(.NOT. PRESENT(qs_env)) CPASSERT(.NOT. PRESENT(fist_env)) + CPASSERT(.NOT. PRESENT(ipi_env)) CALL eip_env_get(force_env%eip_env, & eip_potential_energy=eip_potential_energy, & eip_kinetic_energy=eip_kinetic_energy, & @@ -402,6 +418,7 @@ RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, & CPASSERT(ASSOCIATED(force_env%pwdft_env)) CPASSERT(.NOT. PRESENT(qs_env)) CPASSERT(.NOT. PRESENT(fist_env)) + CPASSERT(.NOT. PRESENT(ipi_env)) CALL pwdft_env_get(force_env%pwdft_env, energy=pwdft_energy) CALL pwdft_env_get(force_env%pwdft_env, cp_subsys=subsys) IF (PRESENT(potential_energy)) potential_energy = pwdft_energy%etotal @@ -433,10 +450,15 @@ RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, & subsys=subsys) CASE (use_nnp_force) CPASSERT(ASSOCIATED(force_env%nnp_env)) + CPASSERT(.NOT. PRESENT(ipi_env)) CALL nnp_env_get(force_env%nnp_env, & nnp_potential_energy=potential_energy, & subsys=subsys) CPASSERT(.NOT. PRESENT(kinetic_energy)) + CASE (use_ipi) + CALL ipi_env_get(force_env%ipi_env, & + ipi_energy=potential_energy, & + subsys=subsys) CASE DEFAULT CPABORT("unknown in_use flag value ") END SELECT @@ -459,6 +481,9 @@ RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, & IF (PRESENT(nnp_env)) THEN nnp_env => force_env%nnp_env END IF + IF (PRESENT(ipi_env)) THEN + ipi_env => force_env%ipi_env + END IF IF (PRESENT(para_env)) para_env => force_env%para_env ! adjust the total energy for the metadynamics IF (ASSOCIATED(force_env%meta_env)) THEN @@ -495,6 +520,7 @@ RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, & IF (PRESENT(qmmmx_env)) qmmmx_env => force_env%qmmmx_env IF (PRESENT(mixed_env)) mixed_env => force_env%mixed_env IF (PRESENT(embed_env)) embed_env => force_env%embed_env + IF (PRESENT(ipi_env)) ipi_env => force_env%ipi_env IF (PRESENT(globenv)) globenv => force_env%globenv IF (PRESENT(root_section)) root_section => force_env%root_section diff --git a/src/input_constants.F b/src/input_constants.F index f321b41bf7..9838becb07 100644 --- a/src/input_constants.F +++ b/src/input_constants.F @@ -53,7 +53,8 @@ MODULE input_constants do_mixed = 6, & do_embed = 7, & do_sirius = 8, & - do_nnp = 9 + do_nnp = 9, & + do_ipi = 10 ! QMMM REAL(KIND=dp), PARAMETER, PUBLIC :: RADIUS_QMMM_DEFAULT = 0.80_dp, & ! Angstrom diff --git a/src/input_cp2k_force_eval.F b/src/input_cp2k_force_eval.F index afd9bcf71d..50a75410b6 100644 --- a/src/input_cp2k_force_eval.F +++ b/src/input_cp2k_force_eval.F @@ -20,7 +20,7 @@ MODULE input_cp2k_force_eval medium_print_level USE cp_units, ONLY: cp_unit_to_cp2k USE input_constants, ONLY: & - do_eip, do_embed, do_fist, do_mixed, do_nnp, do_qmmm, do_qs, do_sirius, & + do_eip, do_embed, do_fist, do_ipi, do_mixed, do_nnp, do_qmmm, do_qs, do_sirius, & do_stress_analytical, do_stress_diagonal_anal, do_stress_diagonal_numer, do_stress_none, & do_stress_numerical, numerical USE input_cp2k_dft, ONLY: create_bsse_section,& @@ -90,7 +90,8 @@ SUBROUTINE create_force_eval_section(section) "QUICKSTEP", & "NNP", & "MIXED", & - "EMBED"), & + "EMBED", & + "IPI"), & enum_desc=s2a("Alias for QUICKSTEP", & "PW DFT using the SIRIUS library", & "Molecular Mechanics", & @@ -99,8 +100,9 @@ SUBROUTINE create_force_eval_section(section) "Electronic structure methods (DFT, ...)", & "Neural Network Potentials", & "Use a combination of two of the above", & - "Perform an embedded calculation"), & - enum_i_vals=(/do_qs, do_sirius, do_fist, do_qmmm, do_eip, do_qs, do_nnp, do_mixed, do_embed/), & + "Perform an embedded calculation", & + "Recieve forces from i–PI client"), & + enum_i_vals=(/do_qs, do_sirius, do_fist, do_qmmm, do_eip, do_qs, do_nnp, do_mixed, do_embed, do_ipi/), & default_i_val=do_qs) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) diff --git a/src/ipi_environment.F b/src/ipi_environment.F new file mode 100644 index 0000000000..b82c1492de --- /dev/null +++ b/src/ipi_environment.F @@ -0,0 +1,192 @@ +!--------------------------------------------------------------------------------------------------! +! CP2K: A general program to perform molecular dynamics simulations ! +! Copyright 2000-2024 CP2K developers group ! +! ! +! SPDX-License-Identifier: GPL-2.0-or-later ! +!--------------------------------------------------------------------------------------------------! + +! ************************************************************************************************** +!> \brief Methods and functions on the i–PI environment +!> \par History +!> 03.2024 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** +MODULE ipi_environment + USE atomic_kind_types, ONLY: atomic_kind_type + USE cell_methods, ONLY: read_cell,& + write_cell + USE cell_types, ONLY: cell_release,& + cell_type,& + get_cell + USE cp_subsys_methods, ONLY: cp_subsys_create + USE cp_subsys_types, ONLY: cp_subsys_set,& + cp_subsys_type + USE distribution_1d_types, ONLY: distribution_1d_release,& + distribution_1d_type + USE distribution_methods, ONLY: distribute_molecules_1d + USE input_section_types, ONLY: section_vals_get_subs_vals,& + section_vals_type + USE ipi_environment_types, ONLY: ipi_env_set,& + ipi_environment_type + USE ipi_server, ONLY: start_server + USE kinds, ONLY: dp + USE message_passing, ONLY: mp_para_env_type + USE molecule_kind_types, ONLY: molecule_kind_type,& + write_molecule_kind_set + USE molecule_types, ONLY: molecule_type + USE particle_methods, ONLY: write_fist_particle_coordinates,& + write_particle_distances,& + write_structure_data + USE particle_types, ONLY: particle_type +#include "./base/base_uses.f90" + + IMPLICIT NONE + + PRIVATE + +! *** Global parameters *** + + CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ipi_environment' + +! *** Public subroutines *** + + PUBLIC :: ipi_init + +CONTAINS + +! ************************************************************************************************** +!> \brief Initialize the ipi environment +!> \param ipi_env The ipi environment to retain +!> \param root_section ... +!> \param para_env ... +!> \param force_env_section ... +!> \param subsys_section ... +!> \par History +!> 03.2006 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + SUBROUTINE ipi_init(ipi_env, root_section, para_env, force_env_section, & + subsys_section) + TYPE(ipi_environment_type), POINTER :: ipi_env + TYPE(section_vals_type), POINTER :: root_section + TYPE(mp_para_env_type), POINTER :: para_env + TYPE(section_vals_type), POINTER :: force_env_section, subsys_section + + CHARACTER(len=*), PARAMETER :: routineN = 'ipi_init' + + INTEGER :: handle + REAL(KIND=dp), DIMENSION(3) :: abc + TYPE(cell_type), POINTER :: cell, cell_ref + TYPE(cp_subsys_type), POINTER :: subsys + TYPE(section_vals_type), POINTER :: cell_section, driver_section, & + motion_section + + CALL timeset(routineN, handle) + + CPASSERT(ASSOCIATED(ipi_env)) + + ! nullifying pointers + NULLIFY (cell_section, cell, cell_ref, subsys) + + IF (.NOT. ASSOCIATED(subsys_section)) THEN + subsys_section => section_vals_get_subs_vals(force_env_section, "SUBSYS") + END IF + cell_section => section_vals_get_subs_vals(subsys_section, "CELL") + + CALL ipi_env_set(ipi_env=ipi_env, force_env_input=force_env_section) + + CALL read_cell(cell=cell, cell_ref=cell_ref, & + cell_section=cell_section, para_env=para_env) + CALL get_cell(cell=cell, abc=abc) + CALL write_cell(cell=cell, subsys_section=subsys_section) + + CALL cp_subsys_create(subsys, para_env, root_section) + + CALL ipi_init_subsys(ipi_env=ipi_env, subsys=subsys, cell=cell, & + cell_ref=cell_ref, subsys_section=subsys_section) + + CALL cell_release(cell) + CALL cell_release(cell_ref) + + motion_section => section_vals_get_subs_vals(root_section, "MOTION") + driver_section => section_vals_get_subs_vals(motion_section, "DRIVER") + CALL start_server(para_env=para_env, driver_section=driver_section, ipi_env=ipi_env) + + CALL timestop(handle) + + END SUBROUTINE ipi_init + +! ************************************************************************************************** +!> \brief Initialize the ipi environment +!> \param ipi_env The ipi environment +!> \param subsys the subsys +!> \param cell Pointer to the actual simulation cell +!> \param cell_ref Pointer to the reference cell, used e.g. in NPT simulations +!> \param subsys_section ... +!> \par History +!> 03.2024 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + SUBROUTINE ipi_init_subsys(ipi_env, subsys, cell, cell_ref, subsys_section) + TYPE(ipi_environment_type), POINTER :: ipi_env + TYPE(cp_subsys_type), POINTER :: subsys + TYPE(cell_type), POINTER :: cell, cell_ref + TYPE(section_vals_type), POINTER :: subsys_section + + CHARACTER(len=*), PARAMETER :: routineN = 'ipi_init_subsys' + + INTEGER :: handle, natom + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(distribution_1d_type), POINTER :: local_molecules, local_particles + TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set + TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + + CALL timeset(routineN, handle) + + NULLIFY (atomic_kind_set, molecule_kind_set, particle_set, molecule_set, & + local_molecules, local_particles) + + particle_set => subsys%particles%els + atomic_kind_set => subsys%atomic_kinds%els + molecule_kind_set => subsys%molecule_kinds%els + molecule_set => subsys%molecules%els + +! *** Print the molecule kind set *** + CALL write_molecule_kind_set(molecule_kind_set, subsys_section) + +! *** Print the atomic coordinates *** + CALL write_fist_particle_coordinates(particle_set, subsys_section) + CALL write_particle_distances(particle_set, cell=cell, & + subsys_section=subsys_section) + CALL write_structure_data(particle_set, cell=cell, & + input_section=subsys_section) + +! *** Distribute molecules and atoms using the new data structures *** + CALL distribute_molecules_1d(atomic_kind_set=atomic_kind_set, & + particle_set=particle_set, & + local_particles=local_particles, & + molecule_kind_set=molecule_kind_set, & + molecule_set=molecule_set, & + local_molecules=local_molecules, & + force_env_section=ipi_env%force_env_input) + + natom = SIZE(particle_set) + + ALLOCATE (ipi_env%ipi_forces(3, natom)) + ipi_env%ipi_forces(:, :) = 0.0_dp + + CALL cp_subsys_set(subsys, cell=cell) + CALL ipi_env_set(ipi_env=ipi_env, subsys=subsys, & + cell_ref=cell_ref, & + local_molecules=local_molecules, & + local_particles=local_particles) + + CALL distribution_1d_release(local_particles) + CALL distribution_1d_release(local_molecules) + + CALL timestop(handle) + + END SUBROUTINE ipi_init_subsys + +END MODULE ipi_environment diff --git a/src/ipi_environment_types.F b/src/ipi_environment_types.F new file mode 100644 index 0000000000..e2ee11d63a --- /dev/null +++ b/src/ipi_environment_types.F @@ -0,0 +1,324 @@ +!--------------------------------------------------------------------------------------------------! +! CP2K: A general program to perform molecular dynamics simulations ! +! Copyright 2000-2024 CP2K developers group ! +! ! +! SPDX-License-Identifier: GPL-2.0-or-later ! +!--------------------------------------------------------------------------------------------------! + +! ************************************************************************************************** +!> \brief The environment for the empirical interatomic potential methods. +!> \par History +!> 03.2024 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** +MODULE ipi_environment_types + USE atomic_kind_list_types, ONLY: atomic_kind_list_create,& + atomic_kind_list_release,& + atomic_kind_list_type + USE atomic_kind_types, ONLY: atomic_kind_type + USE cell_types, ONLY: cell_release,& + cell_retain,& + cell_type + USE cp_subsys_types, ONLY: cp_subsys_get,& + cp_subsys_release,& + cp_subsys_set,& + cp_subsys_type + USE distribution_1d_types, ONLY: distribution_1d_type + USE input_section_types, ONLY: section_vals_release,& + section_vals_retain,& + section_vals_type + USE kinds, ONLY: dp + USE molecule_kind_list_types, ONLY: molecule_kind_list_create,& + molecule_kind_list_release,& + molecule_kind_list_type + USE molecule_kind_types, ONLY: molecule_kind_type + USE molecule_list_types, ONLY: molecule_list_create,& + molecule_list_release,& + molecule_list_type + USE molecule_types, ONLY: molecule_type + USE particle_list_types, ONLY: particle_list_create,& + particle_list_release,& + particle_list_type + USE particle_types, ONLY: particle_type + USE virial_types, ONLY: virial_type +#include "./base/base_uses.f90" + + IMPLICIT NONE + PRIVATE + + CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ipi_environment_types' + + ! *** Public data types *** + PUBLIC :: ipi_environment_type + + ! *** Public subroutines *** + PUBLIC :: ipi_env_release, & + ipi_env_set, & + ipi_env_get, & + ipi_env_create + +! ************************************************************************************************** +!> \brief The i–PI environment +!> \param ipi_energy The total ipi energy +!> \param ipi_forces The final ipi forces [eV/A] +!> \param subsystem The particles, molecules,... of this environment +!> \param force_env_input Pointer to the force_env input section +!> \param cell_ref The reference simulation cell +!> \par History +!> 03.2024 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + TYPE ipi_environment_type + REAL(KIND=dp) :: ipi_energy = 0.0_dp + REAL(KIND=dp), DIMENSION(:, :), POINTER :: ipi_forces => Null() + TYPE(cp_subsys_type), POINTER :: subsys => Null() + TYPE(section_vals_type), POINTER :: force_env_input => Null() + TYPE(cell_type), POINTER :: cell_ref => Null() + INTEGER :: sockfd + END TYPE ipi_environment_type + +CONTAINS + +! ************************************************************************************************** +!> \brief Releases the given ipi environment (see doc/ReferenceCounting.html) +!> \param ipi_env The ipi environment to release +!> \par History +!> 03.2024 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + SUBROUTINE ipi_env_release(ipi_env) + TYPE(ipi_environment_type), INTENT(INOUT) :: ipi_env + + IF (ASSOCIATED(ipi_env%ipi_forces)) THEN + DEALLOCATE (ipi_env%ipi_forces) + END IF + IF (ASSOCIATED(ipi_env%subsys)) THEN + CALL cp_subsys_release(ipi_env%subsys) + END IF + IF (ASSOCIATED(ipi_env%force_env_input)) THEN + CALL section_vals_release(ipi_env%force_env_input) + END IF + IF (ASSOCIATED(ipi_env%cell_ref)) THEN + CALL cell_release(ipi_env%cell_ref) + END IF + END SUBROUTINE ipi_env_release + +! ************************************************************************************************** +!> \brief Returns various attributes of the ipi environment +!> \param ipi_env The enquired ipi environment +!> \param ipi_energy The total ipi energy +!> \param ipi_forces The final ipi forces [eV/A] +!> \param subsys the particles, molecules,... of this environment +!> \param atomic_kind_set The set of all atomic kinds involved +!> \param particle_set The set of all particles +!> \param local_particles All particles on this particular node +!> \param molecule_kind_set The set of all different molecule kinds involved +!> \param molecule_set The set of all molecules +!> \param local_molecules All molecules on this particular node +!> \param force_env_input Pointer to the force_env input section +!> \param cell The simulation cell +!> \param cell_ref The reference simulation cell +!> \param virial Dummy virial pointer +!> \param sockfd File descriptor of the communications socket +!> \par History +!> 03.2024 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + SUBROUTINE ipi_env_get(ipi_env, ipi_energy, ipi_forces, subsys, & + atomic_kind_set, particle_set, local_particles, & + molecule_kind_set, molecule_set, local_molecules, & + force_env_input, cell, cell_ref, virial, sockfd) + + TYPE(ipi_environment_type), INTENT(IN) :: ipi_env + REAL(kind=dp), OPTIONAL :: ipi_energy + REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: ipi_forces + TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys + TYPE(atomic_kind_type), DIMENSION(:), OPTIONAL, & + POINTER :: atomic_kind_set + TYPE(particle_type), DIMENSION(:), OPTIONAL, & + POINTER :: particle_set + TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_particles + TYPE(molecule_kind_type), DIMENSION(:), OPTIONAL, & + POINTER :: molecule_kind_set + TYPE(molecule_type), DIMENSION(:), OPTIONAL, & + POINTER :: molecule_set + TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_molecules + TYPE(section_vals_type), OPTIONAL, POINTER :: force_env_input + TYPE(cell_type), OPTIONAL, POINTER :: cell, cell_ref + TYPE(virial_type), OPTIONAL, POINTER :: virial + INTEGER, OPTIONAL :: sockfd + + TYPE(atomic_kind_list_type), POINTER :: atomic_kinds + TYPE(molecule_kind_list_type), POINTER :: molecule_kinds + TYPE(molecule_list_type), POINTER :: molecules + TYPE(particle_list_type), POINTER :: particles + + NULLIFY (atomic_kinds, particles, molecules, molecule_kinds) + + IF (PRESENT(ipi_energy)) ipi_energy = ipi_env%ipi_energy + IF (PRESENT(ipi_forces)) ipi_forces = ipi_env%ipi_forces + IF (PRESENT(subsys)) subsys => ipi_env%subsys + CALL cp_subsys_get(ipi_env%subsys, & + atomic_kinds=atomic_kinds, & + particles=particles, & + molecule_kinds=molecule_kinds, & + molecules=molecules, & + local_molecules=local_molecules, & + local_particles=local_particles, & + virial=virial, & + cell=cell) + IF (PRESENT(atomic_kind_set)) atomic_kind_set => atomic_kinds%els + IF (PRESENT(particle_set)) particle_set => particles%els + IF (PRESENT(molecule_kind_set)) molecule_kind_set => molecule_kinds%els + IF (PRESENT(molecule_set)) molecule_set => molecules%els + + IF (PRESENT(force_env_input)) force_env_input => ipi_env%force_env_input + IF (PRESENT(cell_ref)) cell_ref => ipi_env%cell_ref + IF (PRESENT(sockfd)) sockfd = ipi_env%sockfd + + END SUBROUTINE ipi_env_get + +! ************************************************************************************************** +!> \brief Sets various attributes of the ipi environment +!> \param ipi_env The enquired ipi environment +!> \param ipi_energy The total ipi energy +!> \param ipi_forces The final ipi forces [eV/A] +!> \param subsys the particles, molecules,... of this environment +!> \param atomic_kind_set The set of all atomic kinds involved +!> \param particle_set The set of all particles +!> \param local_particles All particles on this particular node +!> \param molecule_kind_set The set of all different molecule kinds involved +!> \param molecule_set The set of all molecules +!> \param local_molecules All molecules on this particular node +!> \param force_env_input Pointer to the force_env input section +!> \param cell_ref The reference simulation cell +!> \param sockfd File descriptor of the communications socket +!> \par History +!> 03.2024 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + SUBROUTINE ipi_env_set(ipi_env, ipi_energy, ipi_forces, subsys, & + atomic_kind_set, particle_set, local_particles, & + molecule_kind_set, molecule_set, local_molecules, & + force_env_input, cell_ref, sockfd) + + TYPE(ipi_environment_type), INTENT(INOUT) :: ipi_env + REAL(KIND=dp), OPTIONAL :: ipi_energy + REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: ipi_forces + TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys + TYPE(atomic_kind_type), DIMENSION(:), OPTIONAL, & + POINTER :: atomic_kind_set + TYPE(particle_type), DIMENSION(:), OPTIONAL, & + POINTER :: particle_set + TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_particles + TYPE(molecule_kind_type), DIMENSION(:), OPTIONAL, & + POINTER :: molecule_kind_set + TYPE(molecule_type), DIMENSION(:), OPTIONAL, & + POINTER :: molecule_set + TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_molecules + TYPE(section_vals_type), OPTIONAL, POINTER :: force_env_input + TYPE(cell_type), OPTIONAL, POINTER :: cell_ref + INTEGER, OPTIONAL :: sockfd + + TYPE(atomic_kind_list_type), POINTER :: atomic_kinds + TYPE(molecule_kind_list_type), POINTER :: molecule_kinds + TYPE(molecule_list_type), POINTER :: molecules + TYPE(particle_list_type), POINTER :: particles + + IF (PRESENT(ipi_energy)) ipi_env%ipi_energy = ipi_energy + IF (PRESENT(ipi_forces)) ipi_env%ipi_forces = ipi_forces + IF (PRESENT(subsys)) THEN + IF (ASSOCIATED(ipi_env%subsys)) THEN + IF (.NOT. ASSOCIATED(ipi_env%subsys, subsys)) THEN + CALL cp_subsys_release(ipi_env%subsys) + END IF + END IF + ipi_env%subsys => subsys + END IF + IF (PRESENT(atomic_kind_set)) THEN + CALL atomic_kind_list_create(atomic_kinds, els_ptr=atomic_kind_set) + CALL cp_subsys_set(ipi_env%subsys, atomic_kinds=atomic_kinds) + CALL atomic_kind_list_release(atomic_kinds) + END IF + IF (PRESENT(particle_set)) THEN + CALL particle_list_create(particles, els_ptr=particle_set) + CALL cp_subsys_set(ipi_env%subsys, particles=particles) + CALL particle_list_release(particles) + END IF + IF (PRESENT(molecule_kind_set)) THEN + CALL molecule_kind_list_create(molecule_kinds, els_ptr=molecule_kind_set) + CALL cp_subsys_set(ipi_env%subsys, molecule_kinds=molecule_kinds) + CALL molecule_kind_list_release(molecule_kinds) + END IF + IF (PRESENT(molecule_set)) THEN + CALL molecule_list_create(molecules, els_ptr=molecule_set) + CALL cp_subsys_set(ipi_env%subsys, molecules=molecules) + CALL molecule_list_release(molecules) + END IF + IF (PRESENT(local_particles)) THEN + CALL cp_subsys_set(ipi_env%subsys, local_particles=local_particles) + END IF + IF (PRESENT(local_molecules)) THEN + CALL cp_subsys_set(ipi_env%subsys, local_molecules=local_molecules) + END IF + + IF (PRESENT(force_env_input)) THEN + CALL section_vals_retain(force_env_input) + CALL section_vals_release(ipi_env%force_env_input) + ipi_env%force_env_input => force_env_input + END IF + IF (PRESENT(cell_ref)) THEN + CALL cell_retain(cell_ref) + CALL cell_release(ipi_env%cell_ref) + ipi_env%cell_ref => cell_ref + END IF + IF (PRESENT(sockfd)) ipi_env%sockfd = sockfd + END SUBROUTINE ipi_env_set + +! ************************************************************************************************** +!> \brief Reinitializes the ipi environment +!> \param ipi_env The ipi environment to be reinitialized +!> \par History +!> 03.2024 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + SUBROUTINE ipi_env_clear(ipi_env) + + TYPE(ipi_environment_type), INTENT(INOUT) :: ipi_env + + IF (ASSOCIATED(ipi_env%ipi_forces)) THEN + ipi_env%ipi_forces(:, :) = 0.0_dp + END IF + IF (ASSOCIATED(ipi_env%subsys)) THEN + CALL cp_subsys_release(ipi_env%subsys) + END IF + IF (ASSOCIATED(ipi_env%force_env_input)) THEN + CALL section_vals_release(ipi_env%force_env_input) + END IF + IF (ASSOCIATED(ipi_env%cell_ref)) THEN + CALL cell_release(ipi_env%cell_ref) + END IF + END SUBROUTINE ipi_env_clear + +! ************************************************************************************************** +!> \brief Creates the ipi environment +!> \param ipi_env The ipi environment to be created +!> \par History +!> 03.2024 initial create +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + SUBROUTINE ipi_env_create(ipi_env) + + TYPE(ipi_environment_type), INTENT(OUT) :: ipi_env + + NULLIFY (ipi_env%ipi_forces) + NULLIFY (ipi_env%subsys) + NULLIFY (ipi_env%force_env_input) + NULLIFY (ipi_env%cell_ref) + + ipi_env%ipi_energy = 0_dp + ipi_env%sockfd = 0 ! stdinp + CALL ipi_env_clear(ipi_env) + END SUBROUTINE ipi_env_create + +END MODULE ipi_environment_types diff --git a/src/ipi_server.F b/src/ipi_server.F new file mode 100644 index 0000000000..8d0c09f3a3 --- /dev/null +++ b/src/ipi_server.F @@ -0,0 +1,316 @@ +!--------------------------------------------------------------------------------------------------! +! CP2K: A general program to perform molecular dynamics simulations ! +! Copyright 2000-2024 CP2K developers group ! +! ! +! SPDX-License-Identifier: GPL-2.0-or-later ! +!--------------------------------------------------------------------------------------------------! + +! ************************************************************************************************** +!> \brief i–PI server mode: Communication with i–PI clients +!> \par History +!> 03.2024 created +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** +MODULE ipi_server + USE ISO_C_BINDING, ONLY: C_CHAR, & + C_DOUBLE, & + C_INT, & + C_LOC, & + C_NULL_CHAR, & + C_PTR + USE cell_methods, ONLY: cell_create, & + init_cell + USE cell_types, ONLY: cell_release, & + cell_type + USE cp_external_control, ONLY: external_control + USE cp_log_handling, ONLY: cp_logger_get_default_io_unit + USE cp_subsys_types, ONLY: cp_subsys_get, & + cp_subsys_set, & + cp_subsys_type + USE global_types, ONLY: global_environment_type + USE input_section_types, ONLY: section_vals_get_subs_vals, & + section_vals_type, & + section_vals_val_get + USE ipi_environment_types, ONLY: ipi_environment_type, & + ipi_env_set + USE kinds, ONLY: default_path_length, & + default_string_length, & + dp, & + int_4 + USE message_passing, ONLY: mp_para_env_type, & + mp_request_type, & + mp_testany + USE particle_list_types, ONLY: particle_list_type + USE particle_types, ONLY: particle_type +#ifndef __NO_SOCKETS + USE sockets_interface, ONLY: writebuffer, & + readbuffer, & + uwait, & + open_bind_socket, & + listen_socket, & + accept_socket, & + close_socket, & + remove_socket_file +#endif + USE virial_types, ONLY: virial_type +#include "./base/base_uses.f90" + + IMPLICIT NONE + + PRIVATE + + CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ipi_server' + INTEGER, PARAMETER :: msglength = 12 + + PUBLIC :: start_server, & + shutdown_server, & + request_forces + +CONTAINS + +! ************************************************************************************************** +!> \brief Starts the i–PI server. Will block until it recieves a connection. +!> \param driver_section The driver section from the input file +!> \param para_env ... +!> \param ipi_env The ipi environment +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + SUBROUTINE start_server(driver_section, para_env, ipi_env) + TYPE(section_vals_type), POINTER :: driver_section + TYPE(mp_para_env_type), POINTER :: para_env + TYPE(ipi_environment_type), POINTER :: ipi_env + + CHARACTER(len=*), PARAMETER :: routineN = 'start_server' + +#ifdef __NO_SOCKETS + INTEGER :: handle + CALL timeset(routineN, handle) + CPABORT("CP2K was compiled with the __NO_SOCKETS option!") +#else + CHARACTER(len=default_path_length) :: c_hostname, drv_hostname + INTEGER :: drv_port, handle, i_drv_unix, & + output_unit, socket, comm_socket + LOGICAL :: drv_unix, ionode + + CALL timeset(routineN, handle) + ionode = para_env%is_source() + output_unit = cp_logger_get_default_io_unit() + + ! Read connection parameters + CALL section_vals_val_get(driver_section, "HOST", c_val=drv_hostname) + CALL section_vals_val_get(driver_section, "PORT", i_val=drv_port) + CALL section_vals_val_get(driver_section, "UNIX", l_val=drv_unix) + IF (output_unit > 0) THEN + WRITE (output_unit, *) "@ i-PI SERVER BEING STARTED" + WRITE (output_unit, *) "@ HOSTNAME: ", TRIM(drv_hostname) + WRITE (output_unit, *) "@ PORT: ", drv_port + WRITE (output_unit, *) "@ UNIX SOCKET: ", drv_unix + END IF + + ! opens the socket + socket = 0 + !inet = 1 + i_drv_unix = 1 ! a bit convoluted. socket.c uses a different convention... + IF (drv_unix) i_drv_unix = 0 + + c_hostname = TRIM(drv_hostname)//C_NULL_CHAR + IF (ionode) THEN + CALL open_bind_socket(socket, i_drv_unix, drv_port, c_hostname) + CALL listen_socket(socket, 1_c_int) + CALL accept_socket(socket, comm_socket) + CALL close_socket(socket) + CALL remove_socket_file(c_hostname) + CALL ipi_env_set(ipi_env=ipi_env, sockfd=comm_socket) + END IF + +#endif + + CALL timestop(handle) + + END SUBROUTINE start_server + +! ************************************************************************************************** +!> \brief Shut down the i–PI server. +!> \param ipi_env The ipi environment in charge of the server +!> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de) +! ************************************************************************************************** + SUBROUTINE shutdown_server(ipi_env) + TYPE(ipi_environment_type), POINTER :: ipi_env + + CHARACTER(len=msglength), PARAMETER :: msg = "EXIT" + + INTEGER :: output_unit + + output_unit = cp_logger_get_default_io_unit() + WRITE (output_unit, *) "@ i–PI: Shutting down server." + CALL writebuffer(ipi_env%sockfd, msg, msglength) + CALL close_socket(ipi_env%sockfd) + END SUBROUTINE shutdown_server + +! ************************************************************************************************** +!> \brief Send atomic positions to a client and retrieve forces +!> \param ipi_env The ipi environment in charge of the connection +!> \author Sebastian Seidenath +! ************************************************************************************************** + SUBROUTINE request_forces(ipi_env) + TYPE(ipi_environment_type), POINTER :: ipi_env + + CHARACTER(len=msglength) :: msgbuffer + INTEGER :: comm_socket, i, nAtom, p, xyz + REAL(kind=dp) :: energy + REAL(kind=dp), DIMENSION(:, :), POINTER :: forces + + i = 0 + nAtom = ipi_env%subsys%particles%n_els + comm_socket = ipi_env%sockfd + + ! Step 1: See if the client is ready + CALL ask_status(comm_socket, msgbuffer) + IF (TRIM(msgbuffer) /= "READY") & + CPABORT("i–PI: Expected READY header but recieved "//TRIM(msgbuffer)) + + ! Step 2: Send cell and position data to client + CALL send_posdata(comm_socket, subsys=ipi_env%subsys) + + ! Step 3: Ask for status, should be done now + CALL ask_status(comm_socket, msgbuffer) + IF (TRIM(msgbuffer) /= "HAVEDATA") & + CPABORT("i–PI: Expected HAVEDATA header but recieved "//TRIM(msgbuffer)) + + ! Step 4: Ask for data + ALLOCATE (forces(3, nAtom)) + CALL ask_getforce(comm_socket, energy=energy, forces=forces) + + ! Step 4.5: Check for sanity + IF (SIZE(forces) /= (nAtom*3)) THEN + CPABORT("i–PI: Mismatch in particle number between CP2K and i–PI client") + END IF + + ! Step 5: Return data + DO p = 1, nAtom + DO xyz = 1, 3 + ipi_env%subsys%particles%els(p)%f(xyz) = forces(xyz, p) + END DO + END DO + CALL ipi_env_set(ipi_env=ipi_env, ipi_energy=energy, ipi_forces=forces) + END SUBROUTINE request_forces + +! ************************************************************************************************** +!> \brief ... +!> \param sockfd ... +!> \param buffer ... +! ************************************************************************************************** + SUBROUTINE get_header(sockfd, buffer) + INTEGER, INTENT(IN) :: sockfd + CHARACTER(len=msglength), INTENT(OUT) :: buffer + + INTEGER :: output_unit + + CALL readbuffer(sockfd, buffer, msglength) + output_unit = cp_logger_get_default_io_unit() + IF (output_unit > 0) WRITE (output_unit, *) " @ i–PI Server: recieved ", TRIM(buffer) + END SUBROUTINE get_header + +! ************************************************************************************************** +!> \brief ... +!> \param sockfd ... +!> \param buffer ... +! ************************************************************************************************** + SUBROUTINE ask_status(sockfd, buffer) + INTEGER, INTENT(IN) :: sockfd + CHARACTER(len=msglength), INTENT(OUT) :: buffer + + CHARACTER(len=msglength), PARAMETER :: msg = "STATUS" + + CALL writebuffer(sockfd, msg, msglength) + CALL get_header(sockfd, buffer) + END SUBROUTINE ask_status + +! ************************************************************************************************** +!> \brief ... +!> \param sockfd ... +!> \param energy ... +!> \param forces ... +!> \param virial ... +!> \param extra ... +! ************************************************************************************************** + SUBROUTINE ask_getforce(sockfd, energy, forces, virial, extra) + INTEGER, INTENT(IN) :: sockfd + REAL(kind=dp), INTENT(OUT) :: energy + REAL(kind=dp), DIMENSION(:, :), INTENT(OUT), & + OPTIONAL, POINTER :: forces + REAL(kind=dp), DIMENSION(3, 3), INTENT(OUT), & + OPTIONAL :: virial + CHARACTER(len=:), INTENT(OUT), OPTIONAL, POINTER :: extra + + CHARACTER(len=msglength), PARAMETER :: msg = "GETFORCE" + + CHARACTER(len=:), ALLOCATABLE :: extra_buffer + CHARACTER(len=msglength) :: msgbuffer + INTEGER :: extraLength, nAtom + REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: forces_buffer + REAL(kind=dp), DIMENSION(9) :: virial_buffer + + ! Exchange headers + CALL writebuffer(sockfd, msg, msglength) + CALL get_header(sockfd, msgbuffer) + IF (TRIM(msgbuffer) /= "FORCEREADY") & + CPABORT("i–PI: Expected FORCEREADY header but recieved "//TRIM(msgbuffer)) + + ! Recieve data + CALL readbuffer(sockfd, energy) + CALL readbuffer(sockfd, nAtom) + ALLOCATE (forces_buffer(3*nAtom)) + CALL readbuffer(sockfd, forces_buffer, nAtom*3) + CALL readbuffer(sockfd, virial_buffer, 9) + CALL readbuffer(sockfd, extraLength) + ALLOCATE (CHARACTER(len=extraLength) :: extra_buffer) + IF (extraLength /= 0) THEN ! readbuffer(x,y,0) is always an error + CALL readbuffer(sockfd, extra_buffer, extraLength) + END IF + + IF (PRESENT(forces)) forces = RESHAPE(forces_buffer, shape=[3, nAtom]) + IF (PRESENT(virial)) virial = RESHAPE(virial_buffer, shape=[3, 3]) + IF (PRESENT(extra)) extra = extra_buffer + END SUBROUTINE ask_getforce + +! ************************************************************************************************** +!> \brief ... +!> \param sockfd ... +!> \param subsys ... +! ************************************************************************************************** + SUBROUTINE send_posdata(sockfd, subsys) + INTEGER, INTENT(IN) :: sockfd + TYPE(cp_subsys_type), POINTER :: subsys + + CHARACTER(len=msglength), PARAMETER :: msg = "POSDATA" + + INTEGER :: i, nAtom, p, xyz + REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: particle_buffer + REAL(kind=dp), DIMENSION(9) :: cell_data, icell_data + + i = 0 + + CALL writebuffer(sockfd, msg, msglength) + + cell_data = RESHAPE(TRANSPOSE(subsys%cell%hmat), (/9/)) + CALL writebuffer(sockfd, cell_data, 9) + + icell_data = RESHAPE(TRANSPOSE(subsys%cell%h_inv), (/9/)) + CALL writebuffer(sockfd, icell_data, 9) + + nAtom = subsys%particles%n_els + CALL writebuffer(sockfd, nAtom) + + ALLOCATE (particle_buffer(3*nAtom)) + DO p = 1, nAtom + DO xyz = 1, 3 + i = i + 1 + particle_buffer(i) = subsys%particles%els(p)%r(xyz) + END DO + END DO + CALL writebuffer(sockfd, particle_buffer, nAtom*3) + + END SUBROUTINE send_posdata + +END MODULE ipi_server diff --git a/src/start/cp2k_runs.F b/src/start/cp2k_runs.F index 9ed90fc9c7..508e46a478 100644 --- a/src/start/cp2k_runs.F +++ b/src/start/cp2k_runs.F @@ -76,8 +76,8 @@ MODULE cp2k_runs grid_library_set_config USE input_constants, ONLY: & bsse_run, cell_opt_run, debug_run, do_atom, do_band, do_cp2k, do_embed, do_farming, & - do_fist, do_mixed, do_nnp, do_opt_basis, do_optimize_input, do_qmmm, do_qs, do_sirius, & - do_swarm, do_tamc, do_test, do_tree_mc, do_tree_mc_ana, driver_run, ehrenfest, & + do_fist, do_ipi, do_mixed, do_nnp, do_opt_basis, do_optimize_input, do_qmmm, do_qs, & + do_sirius, do_swarm, do_tamc, do_test, do_tree_mc, do_tree_mc_ana, driver_run, ehrenfest, & electronic_spectra_run, energy_force_run, energy_run, geo_opt_run, linear_response_run, & mol_dyn_run, mon_car_run, negf_run, none_run, pint_run, real_time_propagation, & tree_mc_run, vib_anal @@ -341,7 +341,8 @@ RECURSIVE SUBROUTINE cp2k_run(input_declaration, input_file_name, output_unit, m method_name_id /= do_mixed .AND. & method_name_id /= do_nnp .AND. & method_name_id /= do_embed .AND. & - method_name_id /= do_fist) & + method_name_id /= do_fist .AND. & + method_name_id /= do_ipi) & CPABORT("Energy/Force run not available for all methods ") sublogger => cp_get_default_logger() diff --git a/tests/i-PI/ipi_client.inp b/tests/i-PI/ipi_client.inp new file mode 100644 index 0000000000..792142aef3 --- /dev/null +++ b/tests/i-PI/ipi_client.inp @@ -0,0 +1,46 @@ +&GLOBAL + PRINT_LEVEL LOW + RUN_TYPE DRIVER + SEED 1 +&END GLOBAL + +&MOTION + &DRIVER + HOST myHost + PORT 8421 + UNIX + &END DRIVER +&END MOTION + +&FORCE_EVAL + METHOD Quickstep + &DFT + &QS + METHOD XTB + &XTB + &PARAMETER + PARAM_FILE_NAME xTB_parameters + PARAM_FILE_PATH /opt/cp2k/data/ + &END PARAMETER + &END XTB + &END QS + &SCF + EPS_SCF 1.0E-3 + &OT ON + MINIMIZER DIIS + PRECONDITIONER FULL_ALL + &END OT + &END SCF + &END DFT + &SUBSYS + &CELL + ABC 5.0 5.0 5.0 + PERIODIC NONE + &END CELL + &COORD + O 0.00 0.00 0.00 + H 0.00 -0.75 0.50 + H 0.00 0.75 0.50 + &END COORD + &END SUBSYS +&END FORCE_EVAL diff --git a/tests/i-PI/ipi_server.inp b/tests/i-PI/ipi_server.inp new file mode 100644 index 0000000000..1188cfb18e --- /dev/null +++ b/tests/i-PI/ipi_server.inp @@ -0,0 +1,41 @@ +&GLOBAL + PRINT_LEVEL LOW + RUN_TYPE GEO_OPT + SEED 1 +&END GLOBAL + +&MOTION + &DRIVER + HOST "/tmp/qiskit_myHost" + PORT 8421 + SLEEP_TIME 0.1 + UNIX + &END DRIVER + &GEO_OPT + MAX_ITER 10 + OPTIMIZER BFGS + TYPE MINIMIZATION + &END GEO_OPT + &PRINT + &FORCES + &EACH + GEO_OPT 1 + &END EACH + &END FORCES + &END PRINT +&END MOTION + +&FORCE_EVAL + METHOD IPI + &SUBSYS + &CELL + ABC 5.0 5.0 5.0 + PERIODIC NONE + &END CELL + &COORD + O 0.00 0.00 0.00 + H 0.00 -0.75 0.50 + H 0.00 0.75 0.50 + &END COORD + &END SUBSYS +&END FORCE_EVAL diff --git a/tools/docker/scripts/test_i-pi.sh b/tools/docker/scripts/test_i-pi.sh index 9068c580ec..5952f30644 100755 --- a/tools/docker/scripts/test_i-pi.sh +++ b/tools/docker/scripts/test_i-pi.sh @@ -21,7 +21,7 @@ python3 -m venv /opt/venv export PATH="/opt/venv/bin:$PATH" echo -e "\n========== Installing i-Pi ==========" -git clone --quiet --depth=1 --single-branch -b master https://github.com/i-pi/i-pi.git /opt/i-pi +git clone --quiet --depth=1 --single-branch -b main https://github.com/i-pi/i-pi.git /opt/i-pi cd /opt/i-pi pip3 install --quiet . @@ -39,8 +39,7 @@ ulimit -t ${TIMEOUT_SEC} # Limit cpu time. cd run_1 echo 42 > cp2k_exit_code sleep 10 # give i-pi some time to startup - export OMP_NUM_THREADS=2 - /opt/cp2k/exe/local/cp2k.ssmp ../in.cp2k + OMP_NUM_THREADS=2 /opt/cp2k/exe/local/cp2k.ssmp ../in.cp2k echo $? > cp2k_exit_code ) & @@ -59,11 +58,59 @@ echo "i-Pi exit code: ${IPI_EXIT_CODE}" IPI_REVISION=$(git rev-parse --short HEAD) if ((IPI_EXIT_CODE)) || ((CP2K_EXIT_CODE)); then - echo -e "\nSummary: Something is wrong with i-Pi commit ${IPI_REVISION}." - echo -e "Status: FAILED\n" + echo -e "\nSomething is wrong with i-Pi commit ${IPI_REVISION}." + IPI_TEST_SUCCESS=false else + echo -e "\ni-Pi commit ${IPI_REVISION} works fine." + IPI_TEST_SUCCESS=true +fi + +echo -e "\n========== Running i-Pi Protocol Tests ==========" + +cd /opt +export CP2K_DATA_DIR="/opt/cp2k/data" +TIMEOUT_SEC="300" +ulimit -t ${TIMEOUT_SEC} # Limit cpu time. +export OMP_NUM_THREADS=2 + +# launch cp2k in client mode +( + mkdir -p run_client + cd run_client + echo 42 > cp2k_client_exit_code + sleep 10 # give server some time to startup + /opt/cp2k/exe/local/cp2k.ssmp /opt/cp2k/tests/i-PI/ipi_client.inp + echo $? > cp2k_client_exit_code +) & + +# launch cp2k in server mode +mkdir -p run_server +cd run_server +/opt/cp2k/exe/local/cp2k.ssmp /opt/cp2k/tests/i-PI/ipi_server.inp +SERVER_EXIT_CODE=$? + +wait # for cp2k client to shutdown +cd /opt +CLIENT_EXIT_CODE=$(cat ./run_client/cp2k_client_exit_code) + +echo "" +echo "Client CP2K exit code: ${CLIENT_EXIT_CODE}" +echo "Server CP2K exit code: ${SERVER_EXIT_CODE}" + +if ((SERVER_EXIT_CODE)) || ((CLIENT_EXIT_CODE)); then + echo -e "\nSomething is wrong with i-Pi functionality." + COMM_TEST_SUCCESS=false +else + echo -e "\ni-Pi communication works fine." + COMM_TEST_SUCCESS=true +fi + +if [ "$IPI_TEST_SUCCESS" = true ] && [ "$COMM_TEST_SUCCESS" = true ]; then echo -e "\nSummary: i-Pi commit ${IPI_REVISION} works fine." echo -e "Status: OK\n" +else + echo -e "\nSummary: Something is wrong with i-Pi commit ${IPI_REVISION}." + echo -e "Status: FAILED\n" fi #EOF