Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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
|
