Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief i–PI server mode: Communication with i–PI clients
      10             : !> \par History
      11             : !>      03.2024 created
      12             : !> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de)
      13             : ! **************************************************************************************************
      14             : MODULE ipi_server
      15             :    USE ISO_C_BINDING, ONLY: C_CHAR, &
      16             :                             C_DOUBLE, &
      17             :                             C_INT, &
      18             :                             C_LOC, &
      19             :                             C_NULL_CHAR, &
      20             :                             C_PTR
      21             :    USE cell_methods, ONLY: cell_create, &
      22             :                            init_cell
      23             :    USE cell_types, ONLY: cell_release, &
      24             :                          cell_type
      25             :    USE cp_external_control, ONLY: external_control
      26             :    USE cp_log_handling, ONLY: cp_logger_get_default_io_unit
      27             :    USE cp_subsys_types, ONLY: cp_subsys_get, &
      28             :                               cp_subsys_set, &
      29             :                               cp_subsys_type
      30             :    USE global_types, ONLY: global_environment_type
      31             :    USE input_section_types, ONLY: section_vals_get_subs_vals, &
      32             :                                   section_vals_type, &
      33             :                                   section_vals_val_get
      34             :    USE ipi_environment_types, ONLY: ipi_environment_type, &
      35             :                                     ipi_env_set
      36             :    USE kinds, ONLY: default_path_length, &
      37             :                     default_string_length, &
      38             :                     dp, &
      39             :                     int_4
      40             :    USE message_passing, ONLY: mp_para_env_type, &
      41             :                               mp_request_type, &
      42             :                               mp_testany
      43             :    USE particle_list_types, ONLY: particle_list_type
      44             :    USE particle_types, ONLY: particle_type
      45             : #ifndef __NO_SOCKETS
      46             :    USE sockets_interface, ONLY: writebuffer, &
      47             :                                 readbuffer, &
      48             :                                 uwait, &
      49             :                                 open_bind_socket, &
      50             :                                 listen_socket, &
      51             :                                 accept_socket, &
      52             :                                 close_socket, &
      53             :                                 remove_socket_file
      54             : #endif
      55             :    USE virial_types, ONLY: virial_type
      56             : #include "./base/base_uses.f90"
      57             : 
      58             :    IMPLICIT NONE
      59             : 
      60             :    PRIVATE
      61             : 
      62             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ipi_server'
      63             :    INTEGER, PARAMETER                   :: msglength = 12
      64             : 
      65             :    PUBLIC                               :: start_server, &
      66             :                                            shutdown_server, &
      67             :                                            request_forces
      68             : 
      69             : CONTAINS
      70             : 
      71             : ! **************************************************************************************************
      72             : !> \brief Starts the i–PI server. Will block until it recieves a connection.
      73             : !> \param driver_section The driver section from the input file
      74             : !> \param para_env ...
      75             : !> \param ipi_env The ipi environment
      76             : !> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de)
      77             : ! **************************************************************************************************
      78           0 :    SUBROUTINE start_server(driver_section, para_env, ipi_env)
      79             :       TYPE(section_vals_type), POINTER         :: driver_section
      80             :       TYPE(mp_para_env_type), POINTER          :: para_env
      81             :       TYPE(ipi_environment_type), POINTER      :: ipi_env
      82             : 
      83             :       CHARACTER(len=*), PARAMETER :: routineN = 'start_server'
      84             : 
      85             : #ifdef __NO_SOCKETS
      86             :       INTEGER                                  :: handle
      87             :       CALL timeset(routineN, handle)
      88             :       CPABORT("CP2K was compiled with the __NO_SOCKETS option!")
      89             : #else
      90             :       CHARACTER(len=default_path_length)       :: c_hostname, drv_hostname
      91             :       INTEGER                                  :: drv_port, handle, i_drv_unix, &
      92             :                                                   output_unit, socket, comm_socket
      93             :       LOGICAL                                  :: drv_unix, ionode
      94             : 
      95           0 :       CALL timeset(routineN, handle)
      96           0 :       ionode = para_env%is_source()
      97           0 :       output_unit = cp_logger_get_default_io_unit()
      98             : 
      99             :       ! Read connection parameters
     100           0 :       CALL section_vals_val_get(driver_section, "HOST", c_val=drv_hostname)
     101           0 :       CALL section_vals_val_get(driver_section, "PORT", i_val=drv_port)
     102           0 :       CALL section_vals_val_get(driver_section, "UNIX", l_val=drv_unix)
     103           0 :       IF (output_unit > 0) THEN
     104           0 :          WRITE (output_unit, *) "@ i-PI SERVER BEING STARTED"
     105           0 :          WRITE (output_unit, *) "@ HOSTNAME: ", TRIM(drv_hostname)
     106           0 :          WRITE (output_unit, *) "@ PORT: ", drv_port
     107           0 :          WRITE (output_unit, *) "@ UNIX SOCKET: ", drv_unix
     108             :       END IF
     109             : 
     110             :       ! opens the socket
     111           0 :       socket = 0
     112             :       !inet = 1
     113           0 :       i_drv_unix = 1 ! a bit convoluted. socket.c uses a different convention...
     114           0 :       IF (drv_unix) i_drv_unix = 0
     115             : 
     116           0 :       c_hostname = TRIM(drv_hostname)//C_NULL_CHAR
     117           0 :       IF (ionode) THEN
     118           0 :          CALL open_bind_socket(socket, i_drv_unix, drv_port, c_hostname)
     119           0 :          CALL listen_socket(socket, 1_c_int)
     120           0 :          CALL accept_socket(socket, comm_socket)
     121           0 :          CALL close_socket(socket)
     122           0 :          CALL remove_socket_file(c_hostname)
     123           0 :          CALL ipi_env_set(ipi_env=ipi_env, sockfd=comm_socket)
     124             :       END IF
     125             : 
     126             : #endif
     127             : 
     128           0 :       CALL timestop(handle)
     129             : 
     130           0 :    END SUBROUTINE start_server
     131             : 
     132             : ! **************************************************************************************************
     133             : !> \brief Shut down the i–PI server.
     134             : !> \param ipi_env The ipi environment in charge of the server
     135             : !> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de)
     136             : ! **************************************************************************************************
     137           0 :    SUBROUTINE shutdown_server(ipi_env)
     138             :       TYPE(ipi_environment_type), POINTER                :: ipi_env
     139             : 
     140             :       CHARACTER(len=msglength), PARAMETER                :: msg = "EXIT"
     141             : 
     142             :       INTEGER                                            :: output_unit
     143             : 
     144           0 :       output_unit = cp_logger_get_default_io_unit()
     145           0 :       WRITE (output_unit, *) "@ i–PI: Shutting down server."
     146           0 :       CALL writebuffer(ipi_env%sockfd, msg, msglength)
     147           0 :       CALL close_socket(ipi_env%sockfd)
     148           0 :    END SUBROUTINE shutdown_server
     149             : 
     150             : ! **************************************************************************************************
     151             : !> \brief Send atomic positions to a client and retrieve forces
     152             : !> \param ipi_env The ipi environment in charge of the connection
     153             : !> \author Sebastian Seidenath
     154             : ! **************************************************************************************************
     155           0 :    SUBROUTINE request_forces(ipi_env)
     156             :       TYPE(ipi_environment_type), POINTER                :: ipi_env
     157             : 
     158             :       CHARACTER(len=msglength)                           :: msgbuffer
     159             :       INTEGER                                            :: comm_socket, i, nAtom, p, xyz
     160             :       REAL(kind=dp)                                      :: energy
     161           0 :       REAL(kind=dp), DIMENSION(:, :), POINTER            :: forces
     162             : 
     163           0 :       i = 0
     164           0 :       nAtom = ipi_env%subsys%particles%n_els
     165           0 :       comm_socket = ipi_env%sockfd
     166             : 
     167             :       ! Step 1: See if the client is ready
     168           0 :       CALL ask_status(comm_socket, msgbuffer)
     169           0 :       IF (TRIM(msgbuffer) /= "READY") &
     170           0 :          CPABORT("i–PI: Expected READY header but recieved "//TRIM(msgbuffer))
     171             : 
     172             :       ! Step 2: Send cell and position data to client
     173           0 :       CALL send_posdata(comm_socket, subsys=ipi_env%subsys)
     174             : 
     175             :       ! Step 3: Ask for status, should be done now
     176           0 :       CALL ask_status(comm_socket, msgbuffer)
     177           0 :       IF (TRIM(msgbuffer) /= "HAVEDATA") &
     178           0 :          CPABORT("i–PI: Expected HAVEDATA header but recieved "//TRIM(msgbuffer))
     179             : 
     180             :       ! Step 4: Ask for data
     181           0 :       ALLOCATE (forces(3, nAtom))
     182           0 :       CALL ask_getforce(comm_socket, energy=energy, forces=forces)
     183             : 
     184             :       ! Step 4.5: Check for sanity
     185           0 :       IF (SIZE(forces) /= (nAtom*3)) THEN
     186           0 :          CPABORT("i–PI: Mismatch in particle number between CP2K and i–PI client")
     187             :       END IF
     188             : 
     189             :       ! Step 5: Return data
     190           0 :       DO p = 1, nAtom
     191           0 :          DO xyz = 1, 3
     192           0 :             ipi_env%subsys%particles%els(p)%f(xyz) = forces(xyz, p)
     193             :          END DO
     194             :       END DO
     195           0 :       CALL ipi_env_set(ipi_env=ipi_env, ipi_energy=energy, ipi_forces=forces)
     196           0 :    END SUBROUTINE request_forces
     197             : 
     198             : ! **************************************************************************************************
     199             : !> \brief ...
     200             : !> \param sockfd ...
     201             : !> \param buffer ...
     202             : ! **************************************************************************************************
     203           0 :    SUBROUTINE get_header(sockfd, buffer)
     204             :       INTEGER, INTENT(IN)                                :: sockfd
     205             :       CHARACTER(len=msglength), INTENT(OUT)              :: buffer
     206             : 
     207             :       INTEGER                                            :: output_unit
     208             : 
     209           0 :       CALL readbuffer(sockfd, buffer, msglength)
     210           0 :       output_unit = cp_logger_get_default_io_unit()
     211           0 :       IF (output_unit > 0) WRITE (output_unit, *) " @ i–PI Server: recieved ", TRIM(buffer)
     212           0 :    END SUBROUTINE get_header
     213             : 
     214             : ! **************************************************************************************************
     215             : !> \brief ...
     216             : !> \param sockfd ...
     217             : !> \param buffer ...
     218             : ! **************************************************************************************************
     219           0 :    SUBROUTINE ask_status(sockfd, buffer)
     220             :       INTEGER, INTENT(IN)                                :: sockfd
     221             :       CHARACTER(len=msglength), INTENT(OUT)              :: buffer
     222             : 
     223             :       CHARACTER(len=msglength), PARAMETER                :: msg = "STATUS"
     224             : 
     225           0 :       CALL writebuffer(sockfd, msg, msglength)
     226           0 :       CALL get_header(sockfd, buffer)
     227           0 :    END SUBROUTINE ask_status
     228             : 
     229             : ! **************************************************************************************************
     230             : !> \brief ...
     231             : !> \param sockfd ...
     232             : !> \param energy ...
     233             : !> \param forces ...
     234             : !> \param virial ...
     235             : !> \param extra ...
     236             : ! **************************************************************************************************
     237           0 :    SUBROUTINE ask_getforce(sockfd, energy, forces, virial, extra)
     238             :       INTEGER, INTENT(IN)                                :: sockfd
     239             :       REAL(kind=dp), INTENT(OUT)                         :: energy
     240             :       REAL(kind=dp), DIMENSION(:, :), INTENT(OUT), &
     241             :          OPTIONAL, POINTER                               :: forces
     242             :       REAL(kind=dp), DIMENSION(3, 3), INTENT(OUT), &
     243             :          OPTIONAL                                        :: virial
     244             :       CHARACTER(len=:), INTENT(OUT), OPTIONAL, POINTER   :: extra
     245             : 
     246             :       CHARACTER(len=msglength), PARAMETER                :: msg = "GETFORCE"
     247             : 
     248           0 :       CHARACTER(len=:), ALLOCATABLE                      :: extra_buffer
     249             :       CHARACTER(len=msglength)                           :: msgbuffer
     250             :       INTEGER                                            :: extraLength, nAtom
     251           0 :       REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: forces_buffer
     252             :       REAL(kind=dp), DIMENSION(9)                        :: virial_buffer
     253             : 
     254             :       ! Exchange headers
     255           0 :       CALL writebuffer(sockfd, msg, msglength)
     256           0 :       CALL get_header(sockfd, msgbuffer)
     257           0 :       IF (TRIM(msgbuffer) /= "FORCEREADY") &
     258           0 :          CPABORT("i–PI: Expected FORCEREADY header but recieved "//TRIM(msgbuffer))
     259             : 
     260             :       ! Recieve data
     261           0 :       CALL readbuffer(sockfd, energy)
     262           0 :       CALL readbuffer(sockfd, nAtom)
     263           0 :       ALLOCATE (forces_buffer(3*nAtom))
     264           0 :       CALL readbuffer(sockfd, forces_buffer, nAtom*3)
     265           0 :       CALL readbuffer(sockfd, virial_buffer, 9)
     266           0 :       CALL readbuffer(sockfd, extraLength)
     267           0 :       ALLOCATE (CHARACTER(len=extraLength) :: extra_buffer)
     268           0 :       IF (extraLength /= 0) THEN ! readbuffer(x,y,0) is always an error
     269           0 :          CALL readbuffer(sockfd, extra_buffer, extraLength)
     270             :       END IF
     271             : 
     272           0 :       IF (PRESENT(forces)) forces = RESHAPE(forces_buffer, shape=[3, nAtom])
     273           0 :       IF (PRESENT(virial)) virial = RESHAPE(virial_buffer, shape=[3, 3])
     274           0 :       IF (PRESENT(extra)) extra = extra_buffer
     275           0 :    END SUBROUTINE ask_getforce
     276             : 
     277             : ! **************************************************************************************************
     278             : !> \brief ...
     279             : !> \param sockfd ...
     280             : !> \param subsys ...
     281             : ! **************************************************************************************************
     282           0 :    SUBROUTINE send_posdata(sockfd, subsys)
     283             :       INTEGER, INTENT(IN)                                :: sockfd
     284             :       TYPE(cp_subsys_type), POINTER                      :: subsys
     285             : 
     286             :       CHARACTER(len=msglength), PARAMETER                :: msg = "POSDATA"
     287             : 
     288             :       INTEGER                                            :: i, nAtom, p, xyz
     289           0 :       REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: particle_buffer
     290             :       REAL(kind=dp), DIMENSION(9)                        :: cell_data, icell_data
     291             : 
     292           0 :       i = 0
     293             : 
     294           0 :       CALL writebuffer(sockfd, msg, msglength)
     295             : 
     296           0 :       cell_data = RESHAPE(TRANSPOSE(subsys%cell%hmat), (/9/))
     297           0 :       CALL writebuffer(sockfd, cell_data, 9)
     298             : 
     299           0 :       icell_data = RESHAPE(TRANSPOSE(subsys%cell%h_inv), (/9/))
     300           0 :       CALL writebuffer(sockfd, icell_data, 9)
     301             : 
     302           0 :       nAtom = subsys%particles%n_els
     303           0 :       CALL writebuffer(sockfd, nAtom)
     304             : 
     305           0 :       ALLOCATE (particle_buffer(3*nAtom))
     306           0 :       DO p = 1, nAtom
     307           0 :          DO xyz = 1, 3
     308           0 :             i = i + 1
     309           0 :             particle_buffer(i) = subsys%particles%els(p)%r(xyz)
     310             :          END DO
     311             :       END DO
     312           0 :       CALL writebuffer(sockfd, particle_buffer, nAtom*3)
     313             : 
     314           0 :    END SUBROUTINE send_posdata
     315             : 
     316             : END MODULE ipi_server