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             :       CHARACTER(len=msglength)                 :: msgbuffer
      94             :       CHARACTER(len=msglength), PARAMETER      :: initmsg = "INIT"
      95             :       LOGICAL                                  :: drv_unix, ionode
      96             : 
      97           0 :       CALL timeset(routineN, handle)
      98           0 :       ionode = para_env%is_source()
      99           0 :       output_unit = cp_logger_get_default_io_unit()
     100             : 
     101             :       ! Read connection parameters
     102           0 :       CALL section_vals_val_get(driver_section, "HOST", c_val=drv_hostname)
     103           0 :       CALL section_vals_val_get(driver_section, "PORT", i_val=drv_port)
     104           0 :       CALL section_vals_val_get(driver_section, "UNIX", l_val=drv_unix)
     105           0 :       IF (output_unit > 0) THEN
     106           0 :          WRITE (output_unit, *) "@ i-PI SERVER BEING STARTED"
     107           0 :          WRITE (output_unit, *) "@ HOSTNAME: ", TRIM(drv_hostname)
     108           0 :          WRITE (output_unit, *) "@ PORT: ", drv_port
     109           0 :          WRITE (output_unit, *) "@ UNIX SOCKET: ", drv_unix
     110             :       END IF
     111             : 
     112             :       ! opens the socket
     113           0 :       socket = 0
     114             :       !inet = 1
     115           0 :       i_drv_unix = 1 ! a bit convoluted. socket.c uses a different convention...
     116           0 :       IF (drv_unix) i_drv_unix = 0
     117             : 
     118           0 :       c_hostname = TRIM(drv_hostname)//C_NULL_CHAR
     119           0 :       IF (ionode) THEN
     120           0 :          CALL open_bind_socket(socket, i_drv_unix, drv_port, c_hostname)
     121           0 :          CALL listen_socket(socket, 1_c_int)
     122           0 :          CALL accept_socket(socket, comm_socket)
     123           0 :          CALL close_socket(socket)
     124           0 :          CALL remove_socket_file(c_hostname)
     125           0 :          CALL ipi_env_set(ipi_env=ipi_env, sockfd=comm_socket)
     126             :       END IF
     127             : 
     128             :       ! Check if the client needs initialization
     129             :       ! We only send a meaningless message since we have no general way of
     130             :       ! knowing what the client is expecting
     131           0 :       CALL ask_status(comm_socket, msgbuffer)
     132           0 :       IF (TRIM(msgbuffer) == "NEEDINIT") THEN
     133           0 :          CALL writebuffer(comm_socket, initmsg, msglength)
     134           0 :          CALL writebuffer(comm_socket, 1) ! Bead index - just send 1
     135           0 :          CALL writebuffer(comm_socket, 12) ! Bits in the following message
     136           0 :          CALL writebuffer(comm_socket, "Initializing", 12)
     137             :       END IF
     138             : 
     139             : #endif
     140             : 
     141           0 :       CALL timestop(handle)
     142             : 
     143           0 :    END SUBROUTINE start_server
     144             : 
     145             : ! **************************************************************************************************
     146             : !> \brief Shut down the i–PI server.
     147             : !> \param ipi_env The ipi environment in charge of the server
     148             : !> \author Sebastian Seidenath (sebastian.seidenath@uni-jena.de)
     149             : ! **************************************************************************************************
     150           0 :    SUBROUTINE shutdown_server(ipi_env)
     151             :       TYPE(ipi_environment_type), POINTER                :: ipi_env
     152             : 
     153             :       CHARACTER(len=msglength), PARAMETER                :: msg = "EXIT"
     154             : 
     155             :       INTEGER                                            :: output_unit
     156             : 
     157           0 :       output_unit = cp_logger_get_default_io_unit()
     158           0 :       WRITE (output_unit, *) "@ i–PI: Shutting down server."
     159           0 :       CALL writebuffer(ipi_env%sockfd, msg, msglength)
     160           0 :       CALL close_socket(ipi_env%sockfd)
     161           0 :    END SUBROUTINE shutdown_server
     162             : 
     163             : ! **************************************************************************************************
     164             : !> \brief Send atomic positions to a client and retrieve forces
     165             : !> \param ipi_env The ipi environment in charge of the connection
     166             : !> \author Sebastian Seidenath
     167             : ! **************************************************************************************************
     168           0 :    SUBROUTINE request_forces(ipi_env)
     169             :       TYPE(ipi_environment_type), POINTER                :: ipi_env
     170             : 
     171             :       CHARACTER(len=msglength)                           :: msgbuffer
     172             :       INTEGER                                            :: comm_socket, i, nAtom, p, xyz
     173             :       REAL(kind=dp)                                      :: energy
     174           0 :       REAL(kind=dp), DIMENSION(:, :), POINTER            :: forces
     175             : 
     176           0 :       i = 0
     177           0 :       nAtom = ipi_env%subsys%particles%n_els
     178           0 :       comm_socket = ipi_env%sockfd
     179             : 
     180             :       ! Step 1: See if the client is ready
     181           0 :       CALL ask_status(comm_socket, msgbuffer)
     182           0 :       IF (TRIM(msgbuffer) /= "READY") &
     183           0 :          CPABORT("i–PI: Expected READY header but recieved "//TRIM(msgbuffer))
     184             : 
     185             :       ! Step 2: Send cell and position data to client
     186           0 :       CALL send_posdata(comm_socket, subsys=ipi_env%subsys)
     187             : 
     188             :       ! Step 3: Ask for status, should be done now
     189           0 :       CALL ask_status(comm_socket, msgbuffer)
     190           0 :       IF (TRIM(msgbuffer) /= "HAVEDATA") &
     191           0 :          CPABORT("i–PI: Expected HAVEDATA header but recieved "//TRIM(msgbuffer))
     192             : 
     193             :       ! Step 4: Ask for data
     194           0 :       ALLOCATE (forces(3, nAtom))
     195           0 :       CALL ask_getforce(comm_socket, energy=energy, forces=forces)
     196             : 
     197             :       ! Step 4.5: Check for sanity
     198           0 :       IF (SIZE(forces) /= (nAtom*3)) THEN
     199           0 :          CPABORT("i–PI: Mismatch in particle number between CP2K and i–PI client")
     200             :       END IF
     201             : 
     202             :       ! Step 5: Return data
     203           0 :       DO p = 1, nAtom
     204           0 :          DO xyz = 1, 3
     205           0 :             ipi_env%subsys%particles%els(p)%f(xyz) = forces(xyz, p)
     206             :          END DO
     207             :       END DO
     208           0 :       CALL ipi_env_set(ipi_env=ipi_env, ipi_energy=energy, ipi_forces=forces)
     209           0 :    END SUBROUTINE request_forces
     210             : 
     211             : ! **************************************************************************************************
     212             : !> \brief ...
     213             : !> \param sockfd ...
     214             : !> \param buffer ...
     215             : ! **************************************************************************************************
     216           0 :    SUBROUTINE get_header(sockfd, buffer)
     217             :       INTEGER, INTENT(IN)                                :: sockfd
     218             :       CHARACTER(len=msglength), INTENT(OUT)              :: buffer
     219             : 
     220             :       INTEGER                                            :: output_unit
     221             : 
     222           0 :       CALL readbuffer(sockfd, buffer, msglength)
     223           0 :       output_unit = cp_logger_get_default_io_unit()
     224           0 :       IF (output_unit > 0) WRITE (output_unit, *) " @ i–PI Server: recieved ", TRIM(buffer)
     225           0 :    END SUBROUTINE get_header
     226             : 
     227             : ! **************************************************************************************************
     228             : !> \brief ...
     229             : !> \param sockfd ...
     230             : !> \param buffer ...
     231             : ! **************************************************************************************************
     232           0 :    SUBROUTINE ask_status(sockfd, buffer)
     233             :       INTEGER, INTENT(IN)                                :: sockfd
     234             :       CHARACTER(len=msglength), INTENT(OUT)              :: buffer
     235             : 
     236             :       CHARACTER(len=msglength), PARAMETER                :: msg = "STATUS"
     237             : 
     238           0 :       CALL writebuffer(sockfd, msg, msglength)
     239           0 :       CALL get_header(sockfd, buffer)
     240           0 :    END SUBROUTINE ask_status
     241             : 
     242             : ! **************************************************************************************************
     243             : !> \brief ...
     244             : !> \param sockfd ...
     245             : !> \param energy ...
     246             : !> \param forces ...
     247             : !> \param virial ...
     248             : !> \param extra ...
     249             : ! **************************************************************************************************
     250           0 :    SUBROUTINE ask_getforce(sockfd, energy, forces, virial, extra)
     251             :       INTEGER, INTENT(IN)                                :: sockfd
     252             :       REAL(kind=dp), INTENT(OUT)                         :: energy
     253             :       REAL(kind=dp), DIMENSION(:, :), INTENT(OUT), &
     254             :          OPTIONAL, POINTER                               :: forces
     255             :       REAL(kind=dp), DIMENSION(3, 3), INTENT(OUT), &
     256             :          OPTIONAL                                        :: virial
     257             :       CHARACTER(len=:), INTENT(OUT), OPTIONAL, POINTER   :: extra
     258             : 
     259             :       CHARACTER(len=msglength), PARAMETER                :: msg = "GETFORCE"
     260             : 
     261           0 :       CHARACTER(len=:), ALLOCATABLE                      :: extra_buffer
     262             :       CHARACTER(len=msglength)                           :: msgbuffer
     263             :       INTEGER                                            :: extraLength, nAtom
     264           0 :       REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: forces_buffer
     265             :       REAL(kind=dp), DIMENSION(9)                        :: virial_buffer
     266             : 
     267             :       ! Exchange headers
     268           0 :       CALL writebuffer(sockfd, msg, msglength)
     269           0 :       CALL get_header(sockfd, msgbuffer)
     270           0 :       IF (TRIM(msgbuffer) /= "FORCEREADY") &
     271           0 :          CPABORT("i–PI: Expected FORCEREADY header but recieved "//TRIM(msgbuffer))
     272             : 
     273             :       ! Recieve data
     274           0 :       CALL readbuffer(sockfd, energy)
     275           0 :       CALL readbuffer(sockfd, nAtom)
     276           0 :       ALLOCATE (forces_buffer(3*nAtom))
     277           0 :       CALL readbuffer(sockfd, forces_buffer, nAtom*3)
     278           0 :       CALL readbuffer(sockfd, virial_buffer, 9)
     279           0 :       CALL readbuffer(sockfd, extraLength)
     280           0 :       ALLOCATE (CHARACTER(len=extraLength) :: extra_buffer)
     281           0 :       IF (extraLength /= 0) THEN ! readbuffer(x,y,0) is always an error
     282           0 :          CALL readbuffer(sockfd, extra_buffer, extraLength)
     283             :       END IF
     284             : 
     285           0 :       IF (PRESENT(forces)) forces = RESHAPE(forces_buffer, shape=[3, nAtom])
     286           0 :       IF (PRESENT(virial)) virial = RESHAPE(virial_buffer, shape=[3, 3])
     287           0 :       IF (PRESENT(extra)) extra = extra_buffer
     288           0 :    END SUBROUTINE ask_getforce
     289             : 
     290             : ! **************************************************************************************************
     291             : !> \brief ...
     292             : !> \param sockfd ...
     293             : !> \param subsys ...
     294             : ! **************************************************************************************************
     295           0 :    SUBROUTINE send_posdata(sockfd, subsys)
     296             :       INTEGER, INTENT(IN)                                :: sockfd
     297             :       TYPE(cp_subsys_type), POINTER                      :: subsys
     298             : 
     299             :       CHARACTER(len=msglength), PARAMETER                :: msg = "POSDATA"
     300             : 
     301             :       INTEGER                                            :: i, nAtom, p, xyz
     302           0 :       REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: particle_buffer
     303             :       REAL(kind=dp), DIMENSION(9)                        :: cell_data, icell_data
     304             : 
     305           0 :       i = 0
     306             : 
     307           0 :       CALL writebuffer(sockfd, msg, msglength)
     308             : 
     309           0 :       cell_data = RESHAPE(TRANSPOSE(subsys%cell%hmat), (/9/))
     310           0 :       CALL writebuffer(sockfd, cell_data, 9)
     311             : 
     312           0 :       icell_data = RESHAPE(TRANSPOSE(subsys%cell%h_inv), (/9/))
     313           0 :       CALL writebuffer(sockfd, icell_data, 9)
     314             : 
     315           0 :       nAtom = subsys%particles%n_els
     316           0 :       CALL writebuffer(sockfd, nAtom)
     317             : 
     318           0 :       ALLOCATE (particle_buffer(3*nAtom))
     319           0 :       DO p = 1, nAtom
     320           0 :          DO xyz = 1, 3
     321           0 :             i = i + 1
     322           0 :             particle_buffer(i) = subsys%particles%els(p)%r(xyz)
     323             :          END DO
     324             :       END DO
     325           0 :       CALL writebuffer(sockfd, particle_buffer, nAtom*3)
     326             : 
     327           0 :    END SUBROUTINE send_posdata
     328             : 
     329             : END MODULE ipi_server