(git:34ef472)
cp2k_shell.F
Go to the documentation of this file.
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 Interactive shell of CP2K
10 !> \note
11 !> sample of a simple runner that uses the f77_interface
12 !> it can be used to connect c programs, communicating through std-in/ std-out
13 !>
14 !> positions are in angstrom, energies in evolt
15 !>
16 !> commands:
17 !> load filename: loads the filename, returns the env_id, or -1 in case of error
18 !> natom [env_id]: returns the number of atoms in the environment env_id
19 !> (defaults to the last loaded)
20 !> setpos [env_id]: sets the positions of the atoms, should be followed
21 !> by natom*3 (on a line) and then all the positions [angstrom]
22 !> getpos [env_id]: gets the positions of the atoms, returns
23 !> natom*3 (on a line) and then all the positions [angstrom]
24 !> calcE [env_id]: calculate the energy and returns it (in eV)
25 !> calcEF [env_id]: calculate the energy and forces and returns it,
26 !> first the energy on a line (in eV), then the natom*3 (on a line)
27 !> and finally all the values (in eV/angstrom)
28 !> \par History
29 !> 2019: Complete refactoring (Ole Schuett)
30 !>
31 !> \author Fawzi Mohamed
32 ! **************************************************************************************************
33 MODULE cp2k_shell
34  USE iso_fortran_env, ONLY: iostat_end
35  USE cp2k_info, ONLY: compile_arch,&
36  compile_date,&
37  compile_host,&
38  compile_revision,&
39  cp2k_home,&
40  cp2k_version,&
41  print_cp2k_license
42  USE cp2k_runs, ONLY: run_input
43  USE cp_files, ONLY: close_file,&
44  open_file
45  USE cp_log_handling, ONLY: cp_get_default_logger,&
46  cp_logger_get_default_io_unit,&
47  cp_logger_type
48  USE f77_interface, ONLY: &
49  calc_energy_force, calc_force, create_force_env, destroy_force_env, get_cell, get_energy, &
50  get_force, get_natom, get_pos, get_stress_tensor, set_cell, set_pos
51  USE input_cp2k_read, ONLY: empty_initial_variables
52  USE input_section_types, ONLY: section_type
53  USE kinds, ONLY: default_path_length,&
54  dp
55  USE machine, ONLY: m_chdir,&
56  m_flush,&
57  m_getcwd,&
58  m_getlog,&
59  m_getpid,&
60  m_hostnm
61  USE message_passing, ONLY: mp_para_env_type
62  USE physcon, ONLY: angstrom,&
63  evolt
64  USE string_utilities, ONLY: uppercase
65 #include "../base/base_uses.f90"
66 
67  IMPLICIT NONE
68  PRIVATE
69 
70  ! Queried by ASE. Increase version after bug-fixing or behavior changes.
71  CHARACTER(LEN=*), PARAMETER :: CP2K_SHELL_VERSION = "6.0"
72 
73  TYPE cp2k_shell_type
74  REAL(dp) :: pos_fact = 1.0_dp
75  REAL(dp) :: e_fact = 1.0_dp
76  LOGICAL :: harsh = .false.
77  TYPE(mp_para_env_type), POINTER :: para_env => null()
78  CHARACTER(LEN=5) :: units = "au"
79  INTEGER :: env_id = -1
80  INTEGER :: iw = -1
81  END TYPE cp2k_shell_type
82 
83  PUBLIC :: launch_cp2k_shell
84 
85 CONTAINS
86 
87 ! **************************************************************************************************
88 !> \brief Launch the interactive CP2K shell.
89 !> \param input_declaration ...
90 ! **************************************************************************************************
91  SUBROUTINE launch_cp2k_shell(input_declaration)
92  TYPE(section_type), POINTER :: input_declaration
93 
94  CHARACTER(LEN=default_path_length) :: arg1, arg2, cmd
95  TYPE(cp2k_shell_type) :: shell
96  TYPE(cp_logger_type), POINTER :: logger
97 
98  logger => cp_get_default_logger()
99  shell%para_env => logger%para_env
100  shell%iw = cp_logger_get_default_io_unit()
101 
102  DO
103  IF (.NOT. parse_next_line(shell, cmd, arg1, arg2)) EXIT
104 
105  ! dispatch command
106  SELECT CASE (cmd)
107  CASE ('HELP')
108  CALL help_command(shell)
109  CASE ('INFO', 'INFORMATION', 'LICENSE')
110  CALL info_license_command(shell)
111  CASE ('VERSION')
112  CALL version_command(shell)
113  CASE ('WRITE_FILE')
114  CALL write_file_command(shell)
115  CASE ('LAST_ENV_ID')
116  CALL get_last_env_id(shell)
117  CASE ('BG_LOAD', 'BGLOAD')
118  CALL bg_load_command(shell, input_declaration, arg1)
119  CASE ('LOAD')
120  CALL load_command(shell, input_declaration, arg1, arg2)
121  CASE ('DESTROY')
122  CALL destroy_force_env_command(shell, arg1)
123  CASE ('NATOM', 'N_ATOM')
124  CALL get_natom_command(shell, arg1)
125  CASE ('SETPOS', 'SET_POS')
126  CALL set_pos_command(shell, arg1)
127  CASE ('SETCELL', 'SET_CELL')
128  CALL set_cell_command(shell, arg1)
129  CASE ('GETCELL', 'GET_CELL')
130  CALL get_cell_command(shell, arg1)
131  CASE ('GETSTRESS', 'GET_STRESS')
132  CALL get_stress_command(shell, arg1)
133  CASE ('GETPOS', 'GET_POS')
134  CALL get_pos_command(shell, arg1)
135  CASE ('GETE', 'GET_E')
136  CALL get_energy_command(shell, arg1)
137  CASE ('EVALE', 'EVAL_E')
138  CALL eval_energy_command(shell, arg1)
139  CASE ('CALCE', 'CALC_E')
140  CALL calc_energy_command(shell, arg1)
141  CASE ('EVALEF', 'EVAL_EF')
142  CALL eval_energy_force_command(shell, arg1)
143  CASE ('GETF', 'GET_F')
144  CALL get_forces_command(shell, arg1)
145  CASE ('CALCEF', 'CALC_EF')
146  CALL calc_energy_forces_command(shell, arg1)
147  CASE ('RUN')
148  CALL run_command(shell, input_declaration, arg1, arg2)
149  CASE ('UNITS_EVA', 'UNITS_EV_A')
150  CALL set_units_ev_a(shell)
151  CASE ('UNITS_AU')
152  CALL set_units_au(shell)
153  CASE ('UNITS')
154  CALL get_units(shell)
155  CASE ('HARSH')
156  shell%harsh = .true.
157  CASE ('PERMISSIVE')
158  shell%harsh = .false.
159  CASE ('CD', 'CHDIR')
160  CALL set_pwd_command(shell, arg1)
161  CASE ('PWD', 'CWD')
162  CALL get_pwd_command(shell)
163  CASE ('EXIT')
164  IF (shell%iw > 0) WRITE (shell%iw, '(a)') '* EXIT'
165  EXIT
166  CASE default
167  CALL print_error('unknown command: '//cmd, shell)
168  END SELECT
169  END DO
170 
171  END SUBROUTINE launch_cp2k_shell
172 
173 ! **************************************************************************************************
174 !> \brief ...
175 !> \param shell ...
176 !> \param cmd ...
177 !> \param arg1 ...
178 !> \param arg2 ...
179 !> \return ...
180 ! **************************************************************************************************
181  FUNCTION parse_next_line(shell, cmd, arg1, arg2) RESULT(success)
182  TYPE(cp2k_shell_type) :: shell
183  CHARACTER(LEN=*), INTENT(out) :: cmd, arg1, arg2
184  LOGICAL :: success
185 
186  CHARACTER(LEN=default_path_length) :: line
187  INTEGER :: i, iostat
188 
189  success = .true.
190  IF (shell%iw > 0) THEN
191  WRITE (shell%iw, '("* READY")')
192  CALL m_flush(shell%iw)
193  READ (*, '(a)', iostat=iostat) line
194  IF (iostat /= 0) THEN
195  IF (iostat == iostat_end) THEN
196  WRITE (shell%iw, '(a)') '* EOF'
197  END IF
198  success = .false. ! EOF
199  END IF
200  END IF
201  CALL shell%para_env%bcast(success)
202  IF (.NOT. success) RETURN
203  CALL shell%para_env%bcast(line)
204 
205  ! extract command
206  line = trim(line)
207  DO i = 1, len_trim(line)
208  IF (line(i:i) == ' ') EXIT
209  END DO
210  cmd = line(1:i)
211  CALL uppercase(cmd)
212  line = adjustl(line(i:)) ! shift
213 
214  ! extract first arg
215  DO i = 1, len_trim(line)
216  IF (line(i:i) == ' ') EXIT
217  END DO
218  arg1 = line(1:i)
219  line = adjustl(line(i:)) ! shift
220 
221  ! extract second arg
222  DO i = 1, len_trim(line)
223  IF (line(i:i) == ' ') EXIT
224  END DO
225  arg2 = line(1:i)
226 
227  ! ignore remaining line
228  END FUNCTION parse_next_line
229 
230 ! **************************************************************************************************
231 !> \brief Falls be env_id unchagned if not provided
232 !> \param str ...
233 !> \param shell ...
234 !> \return ...
235 ! **************************************************************************************************
236  FUNCTION parse_env_id(str, shell) RESULT(success)
237  CHARACTER(LEN=*), INTENT(in) :: str
238  TYPE(cp2k_shell_type) :: shell
239  LOGICAL :: success
240 
241  INTEGER :: iostat
242 
243  success = .true.
244  IF (len_trim(str) > 0) THEN
245  READ (str, *, iostat=iostat) shell%env_id
246  IF (iostat /= 0) THEN
247  shell%env_id = -1
248  success = .false.
249  CALL print_error("parse_env_id failed", shell)
250  END IF
251  ELSE IF (shell%env_id < 1) THEN
252  CALL print_error("last env_id not set", shell)
253  success = .false.
254  END IF
255  ! fallback: reuse last env_id
256  END FUNCTION parse_env_id
257 
258 ! **************************************************************************************************
259 !> \brief ...
260 !> \param condition ...
261 !> \param message ...
262 !> \param shell ...
263 !> \return ...
264 ! **************************************************************************************************
265  FUNCTION my_assert(condition, message, shell) RESULT(success)
266  LOGICAL, INTENT(in) :: condition
267  CHARACTER(LEN=*), INTENT(in) :: message
268  TYPE(cp2k_shell_type) :: shell
269  LOGICAL :: success
270 
271  success = condition
272  IF (.NOT. success) THEN
273  CALL print_error(message, shell)
274  END IF
275  END FUNCTION my_assert
276 
277 ! **************************************************************************************************
278 !> \brief ...
279 !> \param message ...
280 !> \param shell ...
281 ! **************************************************************************************************
282  SUBROUTINE print_error(message, shell)
283  CHARACTER(LEN=*), INTENT(in) :: message
284  TYPE(cp2k_shell_type) :: shell
285 
286  IF (shell%harsh) cpabort(message)
287 
288  IF (shell%iw > 0) THEN
289  WRITE (shell%iw, '("* ERROR ",a)') message
290  END IF
291  END SUBROUTINE print_error
292 
293 ! **************************************************************************************************
294 !> \brief ...
295 !> \param shell ...
296 ! **************************************************************************************************
297  SUBROUTINE help_command(shell)
298  TYPE(cp2k_shell_type) :: shell
299 
300  IF (shell%iw > 0) THEN
301  WRITE (shell%iw, *) 'Commands'
302  WRITE (shell%iw, *) ' '
303  WRITE (shell%iw, *) ' If there is [env_id] it means that an optional env_id can be given,'
304  WRITE (shell%iw, *) ' if none is given it defaults to the last env_id loaded'
305  WRITE (shell%iw, *) ' All commands are case insensitive.'
306  WRITE (shell%iw, *) ' '
307  WRITE (shell%iw, *) ' INFO: returns some information about cp2k.'
308  WRITE (shell%iw, *) ' VERSION: returns shell version. (queried by ASE to assert features & bugfixes)'
309  WRITE (shell%iw, *) ' WRITE_FILE: Writes content to a file (allows for using ASE over ssh).'
310  WRITE (shell%iw, *) ' LOAD <inp-filename> [out-filename]: loads the filename, returns the env_id, or -1 in case of error'
311  WRITE (shell%iw, *) ' out-filename is optional and defaults to <inp-filename>.out'
312  WRITE (shell%iw, *) ' use "__STD_OUT__" for printing to the screen'
313  WRITE (shell%iw, *) ' BG_LOAD <filename>: loads the filename, without returning the env_id'
314  WRITE (shell%iw, *) ' LAST_ENV_ID: returns the env_id of the last environment loaded'
315  WRITE (shell%iw, *) ' DESTROY [env_id]: destroys the given environment (last and default env'
316  WRITE (shell%iw, *) ' might become invalid)'
317  WRITE (shell%iw, *) ' NATOM [env_id]: returns the number of atoms in the environment env_id'
318  WRITE (shell%iw, *) ' SET_POS [env_id]: sets the positions of the atoms, should be followed'
319  WRITE (shell%iw, *) ' by natom*3 (on a line) and then all the positions. Returns the max'
320  WRITE (shell%iw, *) ' change of the coordinates (useful to avoid extra calculations).'
321  WRITE (shell%iw, *) ' SET_CELL [env_id]: sets the cell, should be followed by 9 numbers'
322  WRITE (shell%iw, *) ' GET_CELL [env_id]: gets the cell vectors'
323  WRITE (shell%iw, *) ' GET_STRESS [env_id]: gets the stress tensor of the last calculation on env_id'
324  WRITE (shell%iw, *) ' GET_POS [env_id]: gets the positions of the atoms, returns'
325  WRITE (shell%iw, *) ' natom*3 (on a line) and then all the positions then "* END" '
326  WRITE (shell%iw, *) ' (alone on a line)'
327  WRITE (shell%iw, *) ' GET_E [env_id]: gets the energy of the last calculation on env_id'
328  WRITE (shell%iw, *) ' GET_F [env_id]: gets the forces on the atoms,of the last calculation on '
329  WRITE (shell%iw, *) ' env_id, if only the energy was calculated the content is undefined. Returns'
330  WRITE (shell%iw, *) ' natom*3 (on a line) and then all the forces then "* END" (alone on'
331  WRITE (shell%iw, *) ' a line)'
332  WRITE (shell%iw, *) ' CALC_E [env_id]: calculate the energy and returns it'
333  WRITE (shell%iw, *) ' EVAL_E [env_id]: calculate the energy (without returning it)'
334  WRITE (shell%iw, *) ' CALC_EF [env_id]: calculate energy and forces and returns them,'
335  WRITE (shell%iw, *) ' first the energy on a line, then the natom*3 (on a line)'
336  WRITE (shell%iw, *) ' and finally all the values and "* END" (alone on a line)'
337  WRITE (shell%iw, *) ' EVAL_EF [env_id]: calculate the energy and forces (without returning them)'
338  WRITE (shell%iw, *) ' RUN <inp-filename> <out-filename>: run the given input file'
339  WRITE (shell%iw, *) ' HARSH: stops on any error'
340  WRITE (shell%iw, *) ' PERMISSIVE: stops only on serious errors'
341  WRITE (shell%iw, *) ' UNITS: returns the units used for energy and position'
342  WRITE (shell%iw, *) ' UNITS_EV_A: sets the units to electron volt (energy) and Angstrom (positions)'
343  WRITE (shell%iw, *) ' UNITS_AU: sets the units atomic units'
344  WRITE (shell%iw, *) ' CD <dir>: change working directory'
345  WRITE (shell%iw, *) ' PWD: print working directory'
346  WRITE (shell%iw, *) ' EXIT: Quit the shell'
347  WRITE (shell%iw, *) ' HELP: writes the present help'
348  CALL m_flush(shell%iw)
349  END IF
350  END SUBROUTINE help_command
351 
352 ! **************************************************************************************************
353 !> \brief ...
354 !> \param shell ...
355 ! **************************************************************************************************
356  SUBROUTINE info_license_command(shell)
357  TYPE(cp2k_shell_type) :: shell
358 
359  CHARACTER(LEN=default_path_length) :: cwd, host_name, user_name
360  INTEGER :: pid
361 
362  IF (shell%iw > 0) THEN
363  CALL m_getcwd(cwd)
364  CALL m_getpid(pid)
365  CALL m_getlog(user_name)
366  CALL m_hostnm(host_name)
367  WRITE (unit=shell%iw, fmt="(A,A)") &
368  " PROGRAM STARTED ON ", trim(host_name)
369  WRITE (unit=shell%iw, fmt="(A,A)") &
370  " PROGRAM STARTED BY ", trim(user_name)
371  WRITE (unit=shell%iw, fmt="(A,i10)") &
372  " PROGRAM PROCESS ID ", pid
373  WRITE (unit=shell%iw, fmt="(A,A)") &
374  " PROGRAM STARTED IN ", trim(cwd)
375  WRITE (unit=shell%iw, fmt="(/,T2,A,T31,A50)") &
376  "CP2K| version string: ", &
377  adjustr(trim(cp2k_version))
378  WRITE (unit=shell%iw, fmt="(T2,A,T41,A40)") &
379  "CP2K| source code revision number:", &
380  adjustr(compile_revision)
381  WRITE (unit=shell%iw, fmt="(T2,A,T41,A40)") &
382  "CP2K| is freely available from ", &
383  adjustr(trim(cp2k_home))
384  WRITE (unit=shell%iw, fmt="(T2,A,T31,A50)") &
385  "CP2K| Program compiled at", &
386  adjustr(compile_date(1:min(50, len(compile_date))))
387  WRITE (unit=shell%iw, fmt="(T2,A,T31,A50)") &
388  "CP2K| Program compiled on", &
389  adjustr(compile_host(1:min(50, len(compile_host))))
390  WRITE (unit=shell%iw, fmt="(T2,A,T31,A50)") &
391  "CP2K| Program compiled for", &
392  adjustr(compile_arch(1:min(50, len(compile_arch))))
393 
394  CALL print_cp2k_license(shell%iw)
395  CALL m_flush(shell%iw)
396  END IF
397 
398  END SUBROUTINE info_license_command
399 
400 ! **************************************************************************************************
401 !> \brief ...
402 !> \param shell ...
403 ! **************************************************************************************************
404  SUBROUTINE version_command(shell)
405  TYPE(cp2k_shell_type) :: shell
406 
407  IF (shell%iw > 0) THEN
408  WRITE (shell%iw, '(a,a)') "CP2K Shell Version: ", cp2k_shell_version
409  CALL m_flush(shell%iw)
410  END IF
411  END SUBROUTINE version_command
412 
413 ! **************************************************************************************************
414 !> \brief ...
415 !> \param shell ...
416 ! **************************************************************************************************
417  SUBROUTINE write_file_command(shell)
418  TYPE(cp2k_shell_type) :: shell
419 
420  CHARACTER(LEN=default_path_length) :: line, out_filename
421  INTEGER :: file_unit, i, iostat, n_lines
422 
423  IF (shell%iw > 0) THEN
424  READ (*, '(a)', iostat=iostat) out_filename
425  IF (iostat /= 0) cpabort('WRITE_FILE bad filename')
426  READ (*, *, iostat=iostat) n_lines
427  IF (iostat /= 0) cpabort('WRITE_FILE bad number of lines')
428  CALL open_file(file_name=trim(out_filename), unit_number=file_unit, &
429  file_status="UNKNOWN", file_form="FORMATTED", file_action="WRITE")
430  DO i = 1, n_lines
431  READ (*, '(a)', iostat=iostat) line
432  IF (iostat /= 0) cpabort('WRITE_FILE read error')
433  WRITE (file_unit, '(a)', iostat=iostat) trim(line)
434  IF (iostat /= 0) cpabort('WRITE_FILE write error')
435  END DO
436  READ (*, '(a)', iostat=iostat) line
437  IF (iostat /= 0) cpabort('WRITE_FILE read error')
438  IF (trim(line) /= "*END") cpabort('WRITE_FILE bad end delimiter')
439  CALL close_file(unit_number=file_unit)
440  END IF
441  END SUBROUTINE write_file_command
442 
443 ! **************************************************************************************************
444 !> \brief ...
445 !> \param shell ...
446 ! **************************************************************************************************
447  SUBROUTINE get_last_env_id(shell)
448  TYPE(cp2k_shell_type) :: shell
449 
450  IF (shell%iw > 0) THEN
451  WRITE (shell%iw, '(i10)') shell%env_id
452  CALL m_flush(shell%iw)
453  END IF
454  END SUBROUTINE get_last_env_id
455 
456 ! **************************************************************************************************
457 !> \brief ...
458 !> \param shell ...
459 !> \param input_declaration ...
460 !> \param arg1 ...
461 ! **************************************************************************************************
462  SUBROUTINE bg_load_command(shell, input_declaration, arg1)
463  TYPE(cp2k_shell_type) :: shell
464  TYPE(section_type), POINTER :: input_declaration
465  CHARACTER(LEN=*) :: arg1
466 
467  INTEGER :: ierr
468 
469  IF (.NOT. my_assert(len_trim(arg1) > 0, "file argument missing", shell)) RETURN
470  CALL create_force_env(new_env_id=shell%env_id, &
471  input_declaration=input_declaration, &
472  input_path=trim(arg1), &
473  output_path=trim(arg1)//'.out', &
474  owns_out_unit=.true., ierr=ierr)
475  IF (ierr /= 0) THEN
476  shell%env_id = -1
477  CALL print_error("create_force_env failed", shell)
478  END IF
479  END SUBROUTINE bg_load_command
480 
481 ! **************************************************************************************************
482 !> \brief ...
483 !> \param shell ...
484 !> \param input_declaration ...
485 !> \param arg1 ...
486 !> \param arg2 ...
487 ! **************************************************************************************************
488  SUBROUTINE load_command(shell, input_declaration, arg1, arg2)
489  TYPE(cp2k_shell_type) :: shell
490  TYPE(section_type), POINTER :: input_declaration
491  CHARACTER(LEN=*), INTENT(IN) :: arg1, arg2
492 
493  CHARACTER(LEN=default_path_length) :: inp_filename, out_filename
494  INTEGER :: ierr
495 
496  IF (.NOT. my_assert(len_trim(arg1) > 0, "file argument missing", shell)) RETURN
497  inp_filename = arg1
498  out_filename = trim(inp_filename)//'.out'
499  IF (len_trim(arg2) > 0) out_filename = arg2
500  CALL create_force_env(new_env_id=shell%env_id, &
501  input_declaration=input_declaration, &
502  input_path=inp_filename, &
503  output_path=out_filename, &
504  owns_out_unit=.true., ierr=ierr)
505  IF (ierr /= 0) THEN
506  shell%env_id = -1
507  CALL print_error("create_force_env failed", shell)
508  ELSE IF (shell%iw > 0) THEN
509  WRITE (shell%iw, '(i10)') shell%env_id
510  CALL m_flush(shell%iw)
511  END IF
512  END SUBROUTINE load_command
513 
514 ! **************************************************************************************************
515 !> \brief ...
516 !> \param shell ...
517 !> \param arg1 ...
518 ! **************************************************************************************************
519  SUBROUTINE destroy_force_env_command(shell, arg1)
520  TYPE(cp2k_shell_type) :: shell
521  CHARACTER(LEN=*), INTENT(IN) :: arg1
522 
523  INTEGER :: ierr
524 
525  IF (.NOT. parse_env_id(arg1, shell)) RETURN
526  CALL destroy_force_env(shell%env_id, ierr)
527  shell%env_id = -1
528  IF (ierr /= 0) CALL print_error('destroy_force_env failed', shell)
529  END SUBROUTINE destroy_force_env_command
530 
531 ! **************************************************************************************************
532 !> \brief ...
533 !> \param shell ...
534 !> \param arg1 ...
535 ! **************************************************************************************************
536  SUBROUTINE get_natom_command(shell, arg1)
537  TYPE(cp2k_shell_type) :: shell
538  CHARACTER(LEN=*), INTENT(IN) :: arg1
539 
540  INTEGER :: ierr, iostat, n_atom
541 
542  IF (.NOT. parse_env_id(arg1, shell)) RETURN
543  CALL get_natom(shell%env_id, n_atom, ierr)
544  IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
545  IF (shell%iw > 0) THEN
546  WRITE (shell%iw, '(i10)', iostat=iostat) n_atom
547  CALL m_flush(shell%iw)
548  END IF
549  END SUBROUTINE get_natom_command
550 
551 ! **************************************************************************************************
552 !> \brief ...
553 !> \param shell ...
554 !> \param arg1 ...
555 ! **************************************************************************************************
556  SUBROUTINE set_pos_command(shell, arg1)
557  TYPE(cp2k_shell_type) :: shell
558  CHARACTER(LEN=*), INTENT(IN) :: arg1
559 
560  CHARACTER(LEN=default_path_length) :: line
561  INTEGER :: i, ierr, iostat, n_atom
562  REAL(kind=dp) :: max_change
563  REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: old_pos, pos
564 
565  IF (.NOT. parse_env_id(arg1, shell)) RETURN
566  CALL get_natom(shell%env_id, n_atom, ierr)
567  IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
568  ALLOCATE (pos(3*n_atom), old_pos(3*n_atom))
569  IF (shell%iw > 0) THEN
570  READ (*, *, iostat=iostat) n_atom
571  IF (.NOT. my_assert(iostat == 0, 'setpos read n_atom failed', shell)) RETURN
572  IF (.NOT. my_assert(n_atom == SIZE(pos), 'setpos invalid number of atoms', shell)) RETURN
573  READ (*, *, iostat=iostat) pos
574  IF (.NOT. my_assert(iostat == 0, 'setpos read coords failed', shell)) RETURN
575  pos(:) = pos(:)/shell%pos_fact
576  READ (*, '(a)', iostat=iostat) line
577  IF (.NOT. my_assert(iostat == 0, 'setpos read END failed', shell)) RETURN
578  CALL uppercase(line)
579  IF (.NOT. my_assert(trim(line) == '*END', 'missing *END', shell)) RETURN
580  END IF
581  CALL shell%para_env%bcast(pos)
582  CALL get_pos(shell%env_id, old_pos, n_el=3*n_atom, ierr=ierr)
583  IF (.NOT. my_assert(ierr == 0, 'get_pos error', shell)) RETURN
584  CALL set_pos(shell%env_id, new_pos=pos, n_el=3*n_atom, ierr=ierr)
585  IF (.NOT. my_assert(ierr == 0, 'set_pos error', shell)) RETURN
586  max_change = 0.0_dp
587  DO i = 1, SIZE(pos)
588  max_change = max(max_change, abs(pos(i) - old_pos(i)))
589  END DO
590  DEALLOCATE (pos, old_pos)
591  IF (shell%iw > 0) THEN
592  WRITE (shell%iw, '(ES22.13)') max_change*shell%pos_fact
593  CALL m_flush(shell%iw)
594  END IF
595  END SUBROUTINE set_pos_command
596 
597 ! **************************************************************************************************
598 !> \brief ...
599 !> \param shell ...
600 !> \param arg1 ...
601 ! **************************************************************************************************
602  SUBROUTINE set_cell_command(shell, arg1)
603  TYPE(cp2k_shell_type) :: shell
604  CHARACTER(LEN=*), INTENT(IN) :: arg1
605 
606  INTEGER :: ierr, iostat
607  REAL(kind=dp), DIMENSION(3, 3) :: cell
608 
609  IF (.NOT. parse_env_id(arg1, shell)) RETURN
610  IF (shell%iw > 0) THEN
611  READ (*, *, iostat=iostat) cell
612  IF (.NOT. my_assert(iostat == 0, 'setcell read failed', shell)) RETURN
613  cell(:, :) = cell(:, :)/shell%pos_fact
614  END IF
615  CALL shell%para_env%bcast(cell)
616  CALL set_cell(shell%env_id, new_cell=cell, ierr=ierr)
617  IF (.NOT. my_assert(ierr == 0, 'set_cell failed', shell)) RETURN
618  END SUBROUTINE set_cell_command
619 
620 ! **************************************************************************************************
621 !> \brief ...
622 !> \param shell ...
623 !> \param arg1 ...
624 ! **************************************************************************************************
625  SUBROUTINE get_cell_command(shell, arg1)
626  TYPE(cp2k_shell_type) :: shell
627  CHARACTER(LEN=*), INTENT(IN) :: arg1
628 
629  INTEGER :: ierr
630  REAL(kind=dp), DIMENSION(3, 3) :: cell
631 
632  IF (.NOT. parse_env_id(arg1, shell)) RETURN
633  CALL get_cell(shell%env_id, cell=cell, ierr=ierr)
634  IF (.NOT. my_assert(ierr == 0, 'get_cell failed', shell)) RETURN
635  cell(:, :) = cell(:, :)*shell%pos_fact
636  IF (shell%iw > 0) THEN
637  WRITE (shell%iw, '(9ES22.13)') cell
638  CALL m_flush(shell%iw)
639  END IF
640  END SUBROUTINE get_cell_command
641 
642 ! **************************************************************************************************
643 !> \brief ...
644 !> \param shell ...
645 !> \param arg1 ...
646 ! **************************************************************************************************
647  SUBROUTINE get_stress_command(shell, arg1)
648  TYPE(cp2k_shell_type) :: shell
649  CHARACTER(LEN=*), INTENT(IN) :: arg1
650 
651  INTEGER :: ierr
652  REAL(kind=dp), DIMENSION(3, 3) :: stress_tensor
653 
654  IF (.NOT. parse_env_id(arg1, shell)) RETURN
655  CALL get_stress_tensor(shell%env_id, stress_tensor=stress_tensor, ierr=ierr)
656  IF (.NOT. my_assert(ierr == 0, 'get_stress_tensor failed', shell)) RETURN
657  stress_tensor(:, :) = stress_tensor(:, :)*(shell%e_fact/shell%pos_fact**3)
658  IF (shell%iw > 0) THEN
659  WRITE (shell%iw, '(9ES22.13)') stress_tensor
660  CALL m_flush(shell%iw)
661  END IF
662  END SUBROUTINE get_stress_command
663 
664 ! **************************************************************************************************
665 !> \brief ...
666 !> \param shell ...
667 !> \param arg1 ...
668 ! **************************************************************************************************
669  SUBROUTINE get_pos_command(shell, arg1)
670  TYPE(cp2k_shell_type) :: shell
671  CHARACTER(LEN=*), INTENT(IN) :: arg1
672 
673  INTEGER :: ierr, n_atom
674  REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: pos
675 
676  IF (.NOT. parse_env_id(arg1, shell)) RETURN
677  CALL get_natom(shell%env_id, n_atom, ierr)
678  IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
679  ALLOCATE (pos(3*n_atom))
680  CALL get_pos(shell%env_id, pos=pos, n_el=3*n_atom, ierr=ierr)
681  IF (.NOT. my_assert(ierr == 0, 'get_pos failed', shell)) RETURN
682  IF (shell%iw > 0) THEN
683  WRITE (shell%iw, '(i10)') 3*n_atom
684  WRITE (shell%iw, '(3ES22.13)') pos(:)*shell%pos_fact
685  WRITE (shell%iw, '(a)') "* END"
686  CALL m_flush(shell%iw)
687  END IF
688  DEALLOCATE (pos)
689  END SUBROUTINE get_pos_command
690 
691 ! **************************************************************************************************
692 !> \brief ...
693 !> \param shell ...
694 !> \param arg1 ...
695 ! **************************************************************************************************
696  SUBROUTINE get_energy_command(shell, arg1)
697  TYPE(cp2k_shell_type) :: shell
698  CHARACTER(LEN=*), INTENT(IN) :: arg1
699 
700  INTEGER :: ierr
701  REAL(kind=dp) :: e_pot
702 
703  IF (.NOT. parse_env_id(arg1, shell)) RETURN
704  CALL get_energy(shell%env_id, e_pot, ierr)
705  IF (.NOT. my_assert(ierr == 0, 'get_energy failed', shell)) RETURN
706  IF (shell%iw > 0) THEN
707  WRITE (shell%iw, '(ES22.13)') e_pot*shell%e_fact
708  CALL m_flush(shell%iw)
709  END IF
710  END SUBROUTINE get_energy_command
711 
712 ! **************************************************************************************************
713 !> \brief ...
714 !> \param shell ...
715 !> \param arg1 ...
716 ! **************************************************************************************************
717  SUBROUTINE eval_energy_command(shell, arg1)
718  TYPE(cp2k_shell_type) :: shell
719  CHARACTER(LEN=*), INTENT(IN) :: arg1
720 
721  INTEGER :: ierr
722 
723  IF (.NOT. parse_env_id(arg1, shell)) RETURN
724  CALL calc_energy_force(shell%env_id, calc_force=.false., ierr=ierr)
725  IF (ierr /= 0) CALL print_error('calc_energy_force failed', shell)
726  END SUBROUTINE eval_energy_command
727 
728 ! **************************************************************************************************
729 !> \brief ...
730 !> \param shell ...
731 !> \param arg1 ...
732 ! **************************************************************************************************
733  SUBROUTINE calc_energy_command(shell, arg1)
734  TYPE(cp2k_shell_type) :: shell
735  CHARACTER(LEN=*), INTENT(IN) :: arg1
736 
737  INTEGER :: ierr
738  REAL(kind=dp) :: e_pot
739 
740  IF (.NOT. parse_env_id(arg1, shell)) RETURN
741  CALL calc_energy_force(shell%env_id, calc_force=.false., ierr=ierr)
742  IF (.NOT. my_assert(ierr == 0, 'calc_energy_force failed', shell)) RETURN
743  CALL get_energy(shell%env_id, e_pot, ierr)
744  IF (.NOT. my_assert(ierr == 0, 'get_energy failed', shell)) RETURN
745  IF (shell%iw > 0) THEN
746  WRITE (shell%iw, '(ES22.13)') e_pot*shell%e_fact
747  CALL m_flush(shell%iw)
748  END IF
749  END SUBROUTINE calc_energy_command
750 
751 ! **************************************************************************************************
752 !> \brief ...
753 !> \param shell ...
754 !> \param arg1 ...
755 ! **************************************************************************************************
756  SUBROUTINE eval_energy_force_command(shell, arg1)
757  TYPE(cp2k_shell_type) :: shell
758  CHARACTER(LEN=*), INTENT(IN) :: arg1
759 
760  INTEGER :: ierr
761 
762  IF (.NOT. parse_env_id(arg1, shell)) RETURN
763  CALL calc_energy_force(shell%env_id, calc_force=.true., ierr=ierr)
764  IF (ierr /= 0) CALL print_error('calc_energy_force failed', shell)
765  END SUBROUTINE eval_energy_force_command
766 
767 ! **************************************************************************************************
768 !> \brief ...
769 !> \param shell ...
770 !> \param arg1 ...
771 ! **************************************************************************************************
772  SUBROUTINE get_forces_command(shell, arg1)
773  TYPE(cp2k_shell_type) :: shell
774  CHARACTER(LEN=*), INTENT(IN) :: arg1
775 
776  INTEGER :: ierr, n_atom
777  REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: forces
778 
779  IF (.NOT. parse_env_id(arg1, shell)) RETURN
780  CALL get_natom(shell%env_id, n_atom, ierr)
781  IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
782  ALLOCATE (forces(3*n_atom))
783  CALL get_force(shell%env_id, frc=forces, n_el=3*n_atom, ierr=ierr)
784  IF (.NOT. my_assert(ierr == 0, 'get_force failed', shell)) RETURN
785  forces(:) = forces(:)*(shell%e_fact/shell%pos_fact)
786  IF (shell%iw > 0) THEN
787  WRITE (shell%iw, '(i10)') 3*n_atom
788  WRITE (shell%iw, '(3ES22.13)') forces
789  WRITE (shell%iw, '("* END")')
790  CALL m_flush(shell%iw)
791  END IF
792  DEALLOCATE (forces)
793  END SUBROUTINE get_forces_command
794 
795 ! **************************************************************************************************
796 !> \brief ...
797 !> \param shell ...
798 !> \param arg1 ...
799 ! **************************************************************************************************
800  SUBROUTINE calc_energy_forces_command(shell, arg1)
801  TYPE(cp2k_shell_type) :: shell
802  CHARACTER(LEN=*), INTENT(IN) :: arg1
803 
804  INTEGER :: ierr, n_atom
805  REAL(kind=dp) :: e_pot
806  REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: forces
807 
808  IF (.NOT. parse_env_id(arg1, shell)) RETURN
809  CALL calc_energy_force(shell%env_id, calc_force=.true., ierr=ierr)
810  IF (.NOT. my_assert(ierr == 0, 'calc_energy_force failed', shell)) RETURN
811  CALL get_energy(shell%env_id, e_pot, ierr)
812  IF (.NOT. my_assert(ierr == 0, 'get_energy failed', shell)) RETURN
813  CALL get_natom(shell%env_id, n_atom, ierr)
814  IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
815  ALLOCATE (forces(3*n_atom))
816  CALL get_force(shell%env_id, frc=forces, n_el=3*n_atom, ierr=ierr)
817  IF (.NOT. my_assert(ierr == 0, 'get_energy failed', shell)) RETURN
818  IF (shell%iw > 0) THEN
819  WRITE (shell%iw, '(ES22.13)') e_pot*shell%e_fact
820  WRITE (shell%iw, '(i10)') 3*n_atom
821  WRITE (shell%iw, '(3ES22.13)') forces*(shell%e_fact/shell%pos_fact)
822  WRITE (shell%iw, '("* END")')
823  CALL m_flush(shell%iw)
824  END IF
825  DEALLOCATE (forces)
826  END SUBROUTINE calc_energy_forces_command
827 
828 ! **************************************************************************************************
829 !> \brief ...
830 !> \param shell ...
831 !> \param input_declaration ...
832 !> \param arg1 ...
833 !> \param arg2 ...
834 ! **************************************************************************************************
835  SUBROUTINE run_command(shell, input_declaration, arg1, arg2)
836  TYPE(cp2k_shell_type) :: shell
837  TYPE(section_type), POINTER :: input_declaration
838  CHARACTER(LEN=*), INTENT(IN) :: arg1, arg2
839 
840  IF (.NOT. my_assert(len_trim(arg1) > 0, "input-file argument missing", shell)) RETURN
841  IF (.NOT. my_assert(len_trim(arg2) > 0, "input-file argument missing", shell)) RETURN
842  CALL run_input(input_declaration, arg1, arg2, empty_initial_variables)
843  END SUBROUTINE run_command
844 
845 ! **************************************************************************************************
846 !> \brief ...
847 !> \param shell ...
848 ! **************************************************************************************************
849  SUBROUTINE set_units_ev_a(shell)
850  TYPE(cp2k_shell_type) :: shell
851 
852  shell%e_fact = evolt
853  shell%pos_fact = angstrom
854  shell%units = 'eV_A'
855  END SUBROUTINE set_units_ev_a
856 
857 ! **************************************************************************************************
858 !> \brief ...
859 !> \param shell ...
860 ! **************************************************************************************************
861  SUBROUTINE set_units_au(shell)
862  TYPE(cp2k_shell_type) :: shell
863 
864  shell%e_fact = 1.0_dp
865  shell%pos_fact = 1.0_dp
866  shell%units = 'au'
867  END SUBROUTINE set_units_au
868 
869 ! **************************************************************************************************
870 !> \brief ...
871 !> \param shell ...
872 ! **************************************************************************************************
873  SUBROUTINE get_units(shell)
874  TYPE(cp2k_shell_type) :: shell
875 
876  IF (shell%iw > 0) THEN
877  WRITE (shell%iw, '(a)') trim(shell%units)
878  CALL m_flush(shell%iw)
879  END IF
880  END SUBROUTINE get_units
881 
882 ! **************************************************************************************************
883 !> \brief ...
884 !> \param shell ...
885 !> \param arg1 ...
886 ! **************************************************************************************************
887  SUBROUTINE set_pwd_command(shell, arg1)
888  TYPE(cp2k_shell_type) :: shell
889  CHARACTER(LEN=*), INTENT(IN) :: arg1
890 
891  INTEGER :: ierr
892 
893  IF (.NOT. my_assert(len_trim(arg1) > 0, 'missing directory', shell)) RETURN
894  CALL m_chdir(arg1, ierr)
895  IF (ierr /= 0) CALL print_error('changing directory failed', shell)
896  END SUBROUTINE set_pwd_command
897 
898 ! **************************************************************************************************
899 !> \brief ...
900 !> \param shell ...
901 ! **************************************************************************************************
902  SUBROUTINE get_pwd_command(shell)
903  TYPE(cp2k_shell_type) :: shell
904 
905  CHARACTER(LEN=default_path_length) :: cwd
906 
907  IF (shell%iw > 0) THEN
908  CALL m_getcwd(cwd)
909  WRITE (shell%iw, '(a)') trim(cwd)
910  END IF
911  END SUBROUTINE get_pwd_command
912 
913 END MODULE cp2k_shell
parse_next_line
static void parse_next_line(const char key[], FILE *fp, const char format[], const int nargs,...)
Parses next line from file, expecting it to match "${key} ${format}".
Definition: grid_replay.c:42
cp2k_info
some minimal info about CP2K, including its version and license
Definition: cp2k_info.F:16
cp2k_info::cp2k_home
character(len= *), parameter, public cp2k_home
Definition: cp2k_info.F:42
cp2k_info::compile_host
character(len= *), parameter, public compile_host
Definition: cp2k_info.F:60
cp2k_info::compile_arch
character(len= *), parameter, public compile_arch
Definition: cp2k_info.F:48
cp2k_info::print_cp2k_license
subroutine, public print_cp2k_license(iunit)
...
Definition: cp2k_info.F:280
cp2k_info::compile_revision
character(len= *), parameter, public compile_revision
Definition: cp2k_info.F:37
cp2k_info::compile_date
character(len= *), parameter, public compile_date
Definition: cp2k_info.F:54
cp2k_info::cp2k_version
character(len= *), parameter, public cp2k_version
Definition: cp2k_info.F:40
cp2k_runs
Definition: cp2k_runs.F:9
cp2k_runs::run_input
subroutine, public run_input(input_declaration, input_file_path, output_file_path, initial_variables, mpi_comm)
runs the given input
Definition: cp2k_runs.F:958
cp2k_shell
Interactive shell of CP2K.
Definition: cp2k_shell.F:33
cp2k_shell::launch_cp2k_shell
subroutine, public launch_cp2k_shell(input_declaration)
Launch the interactive CP2K shell.
Definition: cp2k_shell.F:92
cp_files
Utility routines to open and close files. Tracking of preconnections.
Definition: cp_files.F:16
cp_files::open_file
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
Definition: cp_files.F:308
cp_files::close_file
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Definition: cp_files.F:119
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition: cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_io_unit
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
Definition: cp_log_handling.F:515
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition: cp_log_handling.F:234
f77_interface
interface to use cp2k as library
Definition: f77_interface.F:20
f77_interface::destroy_force_env
recursive subroutine, public destroy_force_env(env_id, ierr, q_finalize)
deallocates the force_env with the given id
Definition: f77_interface.F:952
f77_interface::get_natom
subroutine, public get_natom(env_id, n_atom, ierr)
returns the number of atoms in the given force env
Definition: f77_interface.F:997
f77_interface::get_cell
subroutine, public get_cell(env_id, cell, per, ierr)
gets a cell
Definition: f77_interface.F:1043
f77_interface::calc_energy_force
recursive subroutine, public calc_energy_force(env_id, calc_force, ierr)
updates the energy and the forces of given force_env
Definition: f77_interface.F:1333
f77_interface::get_energy
subroutine, public get_energy(env_id, e_pot, ierr)
returns the energy of the last configuration calculated
Definition: f77_interface.F:1358
f77_interface::get_pos
subroutine, public get_pos(env_id, pos, n_el, ierr)
gets the positions of the particles
Definition: f77_interface.F:1202
f77_interface::create_force_env
recursive subroutine, public create_force_env(new_env_id, input_declaration, input_path, output_path, mpi_comm, output_unit, owns_out_unit, input, ierr, work_dir, initial_variables)
creates a new force environment using the given input, and writing the output to the given output uni...
Definition: f77_interface.F:566
f77_interface::set_cell
subroutine, public set_cell(env_id, new_cell, ierr)
sets a new cell
Definition: f77_interface.F:1248
f77_interface::set_pos
subroutine, public set_pos(env_id, new_pos, n_el, ierr)
sets the positions of the particles
Definition: f77_interface.F:1280
f77_interface::get_stress_tensor
subroutine, public get_stress_tensor(env_id, stress_tensor, ierr)
gets the stress tensor
Definition: f77_interface.F:1169
f77_interface::get_force
subroutine, public get_force(env_id, frc, n_el, ierr)
gets the forces of the particles
Definition: f77_interface.F:1147
f77_interface::calc_force
recursive subroutine, public calc_force(env_id, pos, n_el_pos, e_pot, force, n_el_force, ierr)
returns the energy of the configuration given by the positions passed as argument
Definition: f77_interface.F:1415
input_cp2k_read
parse cp2k input files
Definition: input_cp2k_read.F:15
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition: input_section_types.F:15
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
kinds::default_path_length
integer, parameter, public default_path_length
Definition: kinds.F:58
machine
Machine interface based on Fortran 2003 and POSIX.
Definition: machine.F:17
machine::m_getpid
subroutine, public m_getpid(pid)
...
Definition: machine.F:555
machine::m_flush
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition: machine.F:106
machine::m_getcwd
subroutine, public m_getcwd(curdir)
...
Definition: machine.F:507
machine::m_chdir
subroutine, public m_chdir(dir, ierror)
...
Definition: machine.F:536
machine::m_getlog
subroutine, public m_getlog(user)
...
Definition: machine.F:632
machine::m_hostnm
subroutine, public m_hostnm(hname)
...
Definition: machine.F:474
message_passing
Interface to the message passing library MPI.
Definition: message_passing.F:23
physcon
Definition of physical constants:
Definition: physcon.F:68
physcon::evolt
real(kind=dp), parameter, public evolt
Definition: physcon.F:183
physcon::angstrom
real(kind=dp), parameter, public angstrom
Definition: physcon.F:144
string_utilities
Utilities for string manipulations.
Definition: string_utilities.F:16
string_utilities::uppercase
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Definition: string_utilities.F:3361