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
|