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