1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief Driver mode - To communicate with i-PI Python wrapper 8!> \par History 9!> none 10!> \author Michele Ceriotti 03.2012 11! ************************************************************************************************** 12MODULE ipi_driver 13 USE ISO_C_BINDING, ONLY: C_CHAR,& 14 C_DOUBLE,& 15 C_INT,& 16 C_LOC,& 17 C_NULL_CHAR,& 18 C_PTR 19 USE bibliography, ONLY: Ceriotti2014,& 20 Kapil2016,& 21 cite_reference 22 USE cell_types, ONLY: cell_create,& 23 cell_release,& 24 cell_type,& 25 init_cell 26 USE cp_external_control, ONLY: external_control 27 USE cp_log_handling, ONLY: cp_logger_get_default_io_unit 28 USE cp_para_types, ONLY: cp_para_env_type 29 USE cp_subsys_types, ONLY: cp_subsys_get,& 30 cp_subsys_set,& 31 cp_subsys_type 32 USE force_env_methods, ONLY: force_env_calc_energy_force 33 USE force_env_types, ONLY: force_env_get,& 34 force_env_type 35 USE global_types, ONLY: global_environment_type 36 USE input_section_types, ONLY: section_vals_get_subs_vals,& 37 section_vals_type,& 38 section_vals_val_get 39 USE kinds, ONLY: default_path_length,& 40 default_string_length,& 41 dp,& 42 int_4 43 USE message_passing, ONLY: mp_bcast,& 44 mp_irecv,& 45 mp_send,& 46 mp_sync,& 47 mp_testany 48 USE virial_types, ONLY: virial_type 49#include "./base/base_uses.f90" 50 51 IMPLICIT NONE 52 53 PRIVATE 54 55 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ipi_driver' 56 57 PUBLIC :: run_driver 58 59#ifndef __NO_IPI_DRIVER 60 INTERFACE writebuffer 61 MODULE PROCEDURE writebuffer_s, & 62 writebuffer_d, writebuffer_dv, & 63 writebuffer_i 64 65 END INTERFACE 66 67 INTERFACE readbuffer 68 MODULE PROCEDURE readbuffer_s, & 69 readbuffer_dv, readbuffer_d, & 70 readbuffer_i 71 72 END INTERFACE 73 74 INTERFACE 75 SUBROUTINE uwait(sec) BIND(C, NAME="uwait") 76 USE ISO_C_BINDING, ONLY: C_DOUBLE 77 REAL(C_DOUBLE) :: sec 78 79 END SUBROUTINE 80 END INTERFACE 81 82 INTERFACE 83 SUBROUTINE open_socket(psockfd, inet, port, host) BIND(C) 84 IMPORT 85 INTEGER(KIND=C_INT) :: psockfd, inet, port 86 CHARACTER(KIND=C_CHAR), DIMENSION(*) :: host 87 88 END SUBROUTINE open_socket 89 90 SUBROUTINE writebuffer_csocket(psockfd, pdata, plen) BIND(C, name="writebuffer") 91 IMPORT 92 INTEGER(KIND=C_INT) :: psockfd 93 TYPE(C_PTR), VALUE :: pdata 94 INTEGER(KIND=C_INT) :: plen 95 96 END SUBROUTINE writebuffer_csocket 97 98 SUBROUTINE readbuffer_csocket(psockfd, pdata, plen) BIND(C, name="readbuffer") 99 IMPORT 100 INTEGER(KIND=C_INT) :: psockfd 101 TYPE(C_PTR), VALUE :: pdata 102 INTEGER(KIND=C_INT) :: plen 103 104 END SUBROUTINE readbuffer_csocket 105 END INTERFACE 106#endif 107 108CONTAINS 109 110#ifndef __NO_IPI_DRIVER 111! ************************************************************************************************** 112!> \brief ... 113!> \param psockfd ... 114!> \param fdata ... 115! ************************************************************************************************** 116 SUBROUTINE writebuffer_d(psockfd, fdata) 117 INTEGER, INTENT(IN) :: psockfd 118 REAL(KIND=dp), INTENT(IN) :: fdata 119 120 CHARACTER(len=*), PARAMETER :: routineN = 'writebuffer_d', routineP = moduleN//':'//routineN 121 122 INTEGER :: handle 123 REAL(KIND=C_DOUBLE), TARGET :: cdata 124 125 CALL timeset(routineN, handle) 126 127 cdata = fdata 128 CALL writebuffer_csocket(psockfd, c_loc(cdata), 8) 129 130 CALL timestop(handle) 131 END SUBROUTINE 132 133! ************************************************************************************************** 134!> \brief ... 135!> \param psockfd ... 136!> \param fdata ... 137! ************************************************************************************************** 138 SUBROUTINE writebuffer_i(psockfd, fdata) 139 INTEGER, INTENT(IN) :: psockfd, fdata 140 141 CHARACTER(len=*), PARAMETER :: routineN = 'writebuffer_i', routineP = moduleN//':'//routineN 142 143 INTEGER :: handle 144 INTEGER(KIND=C_INT), TARGET :: cdata 145 146 CALL timeset(routineN, handle) 147 148 cdata = fdata 149 CALL writebuffer_csocket(psockfd, c_loc(cdata), 4) 150 151 CALL timestop(handle) 152 END SUBROUTINE 153 154! ************************************************************************************************** 155!> \brief ... 156!> \param psockfd ... 157!> \param fstring ... 158!> \param plen ... 159! ************************************************************************************************** 160 SUBROUTINE writebuffer_s(psockfd, fstring, plen) 161 INTEGER, INTENT(IN) :: psockfd 162 CHARACTER(LEN=*), INTENT(IN) :: fstring 163 INTEGER, INTENT(IN) :: plen 164 165 CHARACTER(len=*), PARAMETER :: routineN = 'writebuffer_s', routineP = moduleN//':'//routineN 166 167 INTEGER :: handle, i 168 CHARACTER(LEN=1, KIND=C_CHAR), TARGET :: cstring(plen) 169 170 CALL timeset(routineN, handle) 171 172 DO i = 1, plen 173 cstring(i) = fstring(i:i) 174 ENDDO 175 CALL writebuffer_csocket(psockfd, c_loc(cstring(1)), plen) 176 177 CALL timestop(handle) 178 179 END SUBROUTINE 180 181! ************************************************************************************************** 182!> \brief ... 183!> \param psockfd ... 184!> \param fdata ... 185!> \param plen ... 186! ************************************************************************************************** 187 SUBROUTINE writebuffer_dv(psockfd, fdata, plen) 188 INTEGER, INTENT(IN) :: psockfd, plen 189 REAL(KIND=dp), INTENT(IN), TARGET :: fdata(plen) 190 191 CHARACTER(len=*), PARAMETER :: routineN = 'writebuffer_dv', routineP = moduleN//':'//routineN 192 193 INTEGER :: handle 194 195 CALL timeset(routineN, handle) 196 197 CALL writebuffer_csocket(psockfd, c_loc(fdata(1)), 8*plen) 198 199 CALL timestop(handle) 200 END SUBROUTINE 201 202! ************************************************************************************************** 203!> \brief ... 204!> \param psockfd ... 205!> \param fdata ... 206! ************************************************************************************************** 207 SUBROUTINE readbuffer_d(psockfd, fdata) 208 INTEGER, INTENT(IN) :: psockfd 209 REAL(KIND=dp), INTENT(OUT) :: fdata 210 211 CHARACTER(len=*), PARAMETER :: routineN = 'readbuffer_d', routineP = moduleN//':'//routineN 212 213 INTEGER :: handle 214 REAL(KIND=C_DOUBLE), TARGET :: cdata 215 216 CALL timeset(routineN, handle) 217 218 CALL readbuffer_csocket(psockfd, c_loc(cdata), 8) 219 fdata = cdata 220 221 CALL timestop(handle) 222 END SUBROUTINE 223 224! ************************************************************************************************** 225!> \brief ... 226!> \param psockfd ... 227!> \param fdata ... 228! ************************************************************************************************** 229 SUBROUTINE readbuffer_i(psockfd, fdata) 230 INTEGER, INTENT(IN) :: psockfd 231 INTEGER, INTENT(OUT) :: fdata 232 233 CHARACTER(len=*), PARAMETER :: routineN = 'readbuffer_i', routineP = moduleN//':'//routineN 234 235 INTEGER :: handle 236 INTEGER(KIND=C_INT), TARGET :: cdata 237 238 CALL timeset(routineN, handle) 239 240 CALL readbuffer_csocket(psockfd, c_loc(cdata), 4) 241 fdata = cdata 242 243 CALL timestop(handle) 244 END SUBROUTINE 245 246! ************************************************************************************************** 247!> \brief ... 248!> \param psockfd ... 249!> \param fstring ... 250!> \param plen ... 251! ************************************************************************************************** 252 SUBROUTINE readbuffer_s(psockfd, fstring, plen) 253 INTEGER, INTENT(IN) :: psockfd 254 CHARACTER(LEN=*), INTENT(OUT) :: fstring 255 INTEGER, INTENT(IN) :: plen 256 257 CHARACTER(len=*), PARAMETER :: routineN = 'readbuffer_s', routineP = moduleN//':'//routineN 258 259 INTEGER :: handle, i 260 CHARACTER(LEN=1, KIND=C_CHAR), TARGET :: cstring(plen) 261 262 CALL timeset(routineN, handle) 263 264 CALL readbuffer_csocket(psockfd, c_loc(cstring(1)), plen) 265 fstring = "" 266 DO i = 1, plen 267 fstring(i:i) = cstring(i) 268 ENDDO 269 270 CALL timestop(handle) 271 272 END SUBROUTINE 273 274! ************************************************************************************************** 275!> \brief ... 276!> \param psockfd ... 277!> \param fdata ... 278!> \param plen ... 279! ************************************************************************************************** 280 SUBROUTINE readbuffer_dv(psockfd, fdata, plen) 281 INTEGER, INTENT(IN) :: psockfd, plen 282 REAL(KIND=dp), INTENT(OUT), TARGET :: fdata(plen) 283 284 CHARACTER(len=*), PARAMETER :: routineN = 'readbuffer_dv', routineP = moduleN//':'//routineN 285 286 INTEGER :: handle 287 288 CALL timeset(routineN, handle) 289 290 CALL readbuffer_csocket(psockfd, c_loc(fdata(1)), 8*plen) 291 292 CALL timestop(handle) 293 294 END SUBROUTINE 295#endif 296 297! ************************************************************************************************** 298!> \brief ... 299!> \param force_env ... 300!> \param globenv ... 301!> \par History 302!> 12.2013 included in repository 303!> \author Ceriotti 304! ************************************************************************************************** 305 306 SUBROUTINE run_driver(force_env, globenv) 307 TYPE(force_env_type), POINTER :: force_env 308 TYPE(global_environment_type), POINTER :: globenv 309 310 CHARACTER(len=*), PARAMETER :: routineN = 'run_driver', & 311 routineP = moduleN//':'//routineN 312 313#ifdef __NO_IPI_DRIVER 314 INTEGER :: handle 315 CALL timeset(routineN, handle) 316 CPABORT("CP2K was compiled with the __NO_IPI_DRIVER option!") 317 MARK_USED(globenv) 318 MARK_USED(force_env) 319#else 320 INTEGER, PARAMETER :: MSGLEN = 12 321 322 CHARACTER(len=default_path_length) :: c_hostname, drv_hostname 323 CHARACTER(LEN=default_string_length) :: header 324 INTEGER :: drv_port, handle, i_drv_unix, & 325 idir, ii, inet, ip, iwait, & 326 nat, output_unit, socket, & 327 wait_req(2) 328 INTEGER(KIND=int_4), POINTER :: wait_msg(:) 329 LOGICAL :: drv_unix, fwait, hasdata, & 330 ionode, should_stop 331 REAL(KIND=dp) :: cellh(3, 3), cellih(3, 3), & 332 mxmat(9), pot, vir(3, 3) 333 REAL(KIND=dp), ALLOCATABLE :: combuf(:) 334 TYPE(cell_type), POINTER :: cpcell 335 TYPE(cp_para_env_type), POINTER :: para_env 336 TYPE(cp_subsys_type), POINTER :: subsys 337 TYPE(section_vals_type), POINTER :: drv_section, motion_section 338 TYPE(virial_type), POINTER :: virial 339 REAL(KIND=dp) :: sleeptime 340 341 CALL timeset(routineN, handle) 342 343 CALL cite_reference(Ceriotti2014) 344 CALL cite_reference(Kapil2016) 345 346! server address parsing 347! buffers and temporaries for communication 348! access cp2k structures 349 350 CPASSERT(ASSOCIATED(force_env)) 351 CALL force_env_get(force_env, para_env=para_env) 352 353 hasdata = .FALSE. 354 ionode = para_env%ionode 355 356 output_unit = cp_logger_get_default_io_unit() 357 358 ! reads driver parameters from input 359 motion_section => section_vals_get_subs_vals(force_env%root_section, "MOTION") 360 drv_section => section_vals_get_subs_vals(motion_section, "DRIVER") 361 362 CALL section_vals_val_get(drv_section, "HOST", c_val=drv_hostname) 363 CALL section_vals_val_get(drv_section, "PORT", i_val=drv_port) 364 CALL section_vals_val_get(drv_section, "UNIX", l_val=drv_unix) 365 CALL section_vals_val_get(drv_section, "SLEEP_TIME", r_val=sleeptime) 366 CPASSERT(sleeptime >= 0) 367 368 ! opens the socket 369 socket = 0 370 inet = 1 371 i_drv_unix = 1 ! a bit convoluted. socket.c uses a different convention... 372 IF (drv_unix) i_drv_unix = 0 373 IF (output_unit > 0) THEN 374 WRITE (output_unit, *) "@ i-PI DRIVER BEING LOADED" 375 WRITE (output_unit, *) "@ INPUT DATA: ", TRIM(drv_hostname), drv_port, drv_unix 376 ENDIF 377 378 c_hostname = TRIM(drv_hostname)//C_NULL_CHAR 379 IF (ionode) CALL open_socket(socket, i_drv_unix, drv_port, c_hostname) 380 381 NULLIFY (wait_msg) 382 ALLOCATE (wait_msg(1)) 383 !now we have a socket, so we can initialize the CP2K environments. 384 NULLIFY (cpcell) 385 CALL cell_create(cpcell) 386 driver_loop: DO 387 ! do communication on master node only... 388 header = "" 389 390 CALL mp_sync(para_env%group) 391 392 ! non-blocking sync to avoid useless CPU consumption 393 IF (ionode) THEN 394 CALL readbuffer(socket, header, MSGLEN) 395 wait_msg = 0 396 DO iwait = 0, para_env%num_pe - 1 397 IF (iwait /= para_env%source) THEN 398 CALL mp_send(msg=wait_msg, dest=iwait, gid=para_env%group, tag=666) 399 ENDIF 400 ENDDO 401 ELSE 402 CALL mp_irecv(msgout=wait_msg, source=para_env%source, comm=para_env%group, & 403 tag=666, request=wait_req(2)) 404 CALL mp_testany(wait_req(2:), flag=fwait) 405 DO WHILE (.NOT. fwait) 406 CALL mp_testany(wait_req(2:), flag=fwait) 407 CALL uwait(sleeptime) 408 ENDDO 409 ENDIF 410 411 CALL mp_sync(para_env%group) 412 413 CALL mp_bcast(header, para_env%source, para_env%group) 414 415 IF (output_unit > 0) WRITE (output_unit, *) " @ DRIVER MODE: Message from server: ", TRIM(header) 416 IF (TRIM(header) == "STATUS") THEN 417 418 CALL mp_sync(para_env%group) 419 IF (ionode) THEN ! does not need init (well, maybe it should, just to check atom numbers and the like... ) 420 IF (hasdata) THEN 421 CALL writebuffer(socket, "HAVEDATA ", MSGLEN) 422 ELSE 423 CALL writebuffer(socket, "READY ", MSGLEN) 424 ENDIF 425 ENDIF 426 CALL mp_sync(para_env%group) 427 ELSE IF (TRIM(header) == "POSDATA") THEN 428 IF (ionode) THEN 429 CALL readbuffer(socket, mxmat, 9) 430 cellh = RESHAPE(mxmat, (/3, 3/)) 431 CALL readbuffer(socket, mxmat, 9) 432 cellih = RESHAPE(mxmat, (/3, 3/)) 433 CALL readbuffer(socket, nat) 434 cellh = TRANSPOSE(cellh) 435 cellih = TRANSPOSE(cellih) 436 ENDIF 437 CALL mp_bcast(cellh, para_env%source, para_env%group) 438 CALL mp_bcast(cellih, para_env%source, para_env%group) 439 CALL mp_bcast(nat, para_env%source, para_env%group) 440 IF (.NOT. ALLOCATED(combuf)) ALLOCATE (combuf(3*nat)) 441 IF (ionode) CALL readbuffer(socket, combuf, nat*3) 442 CALL mp_bcast(combuf, para_env%source, para_env%group) 443 444 CALL force_env_get(force_env, subsys=subsys) 445 IF (nat /= subsys%particles%n_els) & 446 CPABORT("@DRIVER MODE: Uh-oh! Particle number mismatch between i-PI and cp2k input!") 447 ii = 0 448 DO ip = 1, subsys%particles%n_els 449 DO idir = 1, 3 450 ii = ii + 1 451 subsys%particles%els(ip)%r(idir) = combuf(ii) 452 END DO 453 END DO 454 CALL init_cell(cpcell, hmat=cellh) 455 CALL cp_subsys_set(subsys, cell=cpcell) 456 457 CALL force_env_calc_energy_force(force_env, calc_force=.TRUE.) 458 459 IF (output_unit > 0) WRITE (output_unit, *) " @ DRIVER MODE: Received positions " 460 461 combuf = 0 462 ii = 0 463 DO ip = 1, subsys%particles%n_els 464 DO idir = 1, 3 465 ii = ii + 1 466 combuf(ii) = subsys%particles%els(ip)%f(idir) 467 END DO 468 END DO 469 CALL force_env_get(force_env, potential_energy=pot) 470 CALL force_env_get(force_env, cell=cpcell) 471 CALL cp_subsys_get(subsys, virial=virial) 472 vir = TRANSPOSE(virial%pv_virial) 473 474 CALL external_control(should_stop, "IPI", globenv=globenv) 475 IF (should_stop) EXIT 476 477 hasdata = .TRUE. 478 ELSE IF (TRIM(header) == "GETFORCE") THEN 479 IF (output_unit > 0) WRITE (output_unit, *) " @ DRIVER MODE: Returning v,forces,stress " 480 IF (ionode) THEN 481 CALL writebuffer(socket, "FORCEREADY ", MSGLEN) 482 CALL writebuffer(socket, pot) 483 CALL writebuffer(socket, nat) 484 CALL writebuffer(socket, combuf, 3*nat) 485 CALL writebuffer(socket, RESHAPE(vir, (/9/)), 9) 486 487 ! i-pi can also receive an arbitrary string, that will be printed out to the "extra" 488 ! trajectory file. this is useful if you want to return additional information, e.g. 489 ! atomic charges, wannier centres, etc. one must return the number of characters, then 490 ! the string. here we just send back zero characters. 491 nat = 0 492 CALL writebuffer(socket, nat) ! writes out zero for the length of the "extra" field (not implemented yet!) 493 ENDIF 494 hasdata = .FALSE. 495 ELSE 496 IF (output_unit > 0) WRITE (output_unit, *) " @DRIVER MODE: Socket disconnected, time to exit. " 497 EXIT 498 ENDIF 499 ENDDO driver_loop 500 501 ! clean up 502 CALL cell_release(cpcell) 503 DEALLOCATE (wait_msg) 504#endif 505 506 CALL timestop(handle) 507 508 END SUBROUTINE run_driver 509END MODULE ipi_driver 510