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 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 0 : 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 0 : logger => cp_get_default_logger()
99 0 : shell%para_env => logger%para_env
100 0 : shell%iw = cp_logger_get_default_io_unit()
101 :
102 : DO
103 0 : IF (.NOT. parse_next_line(shell, cmd, arg1, arg2)) EXIT
104 :
105 : ! dispatch command
106 0 : SELECT CASE (cmd)
107 : CASE ('HELP')
108 0 : CALL help_command(shell)
109 : CASE ('INFO', 'INFORMATION', 'LICENSE')
110 0 : CALL info_license_command(shell)
111 : CASE ('VERSION')
112 0 : CALL version_command(shell)
113 : CASE ('WRITE_FILE')
114 0 : CALL write_file_command(shell)
115 : CASE ('LAST_ENV_ID')
116 0 : CALL get_last_env_id(shell)
117 : CASE ('BG_LOAD', 'BGLOAD')
118 0 : CALL bg_load_command(shell, input_declaration, arg1)
119 : CASE ('LOAD')
120 0 : CALL load_command(shell, input_declaration, arg1, arg2)
121 : CASE ('DESTROY')
122 0 : CALL destroy_force_env_command(shell, arg1)
123 : CASE ('NATOM', 'N_ATOM')
124 0 : CALL get_natom_command(shell, arg1)
125 : CASE ('SETPOS', 'SET_POS')
126 0 : CALL set_pos_command(shell, arg1)
127 : CASE ('SETCELL', 'SET_CELL')
128 0 : CALL set_cell_command(shell, arg1)
129 : CASE ('GETCELL', 'GET_CELL')
130 0 : CALL get_cell_command(shell, arg1)
131 : CASE ('GETSTRESS', 'GET_STRESS')
132 0 : CALL get_stress_command(shell, arg1)
133 : CASE ('GETPOS', 'GET_POS')
134 0 : CALL get_pos_command(shell, arg1)
135 : CASE ('GETE', 'GET_E')
136 0 : CALL get_energy_command(shell, arg1)
137 : CASE ('EVALE', 'EVAL_E')
138 0 : CALL eval_energy_command(shell, arg1)
139 : CASE ('CALCE', 'CALC_E')
140 0 : CALL calc_energy_command(shell, arg1)
141 : CASE ('EVALEF', 'EVAL_EF')
142 0 : CALL eval_energy_force_command(shell, arg1)
143 : CASE ('GETF', 'GET_F')
144 0 : CALL get_forces_command(shell, arg1)
145 : CASE ('CALCEF', 'CALC_EF')
146 0 : CALL calc_energy_forces_command(shell, arg1)
147 : CASE ('RUN')
148 0 : CALL run_command(shell, input_declaration, arg1, arg2)
149 : CASE ('UNITS_EVA', 'UNITS_EV_A')
150 0 : CALL set_units_ev_a(shell)
151 : CASE ('UNITS_AU')
152 0 : CALL set_units_au(shell)
153 : CASE ('UNITS')
154 0 : CALL get_units(shell)
155 : CASE ('HARSH')
156 0 : shell%harsh = .TRUE.
157 : CASE ('PERMISSIVE')
158 0 : shell%harsh = .FALSE.
159 : CASE ('CD', 'CHDIR')
160 0 : CALL set_pwd_command(shell, arg1)
161 : CASE ('PWD', 'CWD')
162 0 : CALL get_pwd_command(shell)
163 : CASE ('EXIT')
164 0 : IF (shell%iw > 0) WRITE (shell%iw, '(a)') '* EXIT'
165 0 : EXIT
166 : CASE default
167 0 : CALL print_error('unknown command: '//cmd, shell)
168 : END SELECT
169 : END DO
170 :
171 0 : 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 0 : 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 0 : success = .TRUE.
190 0 : IF (shell%iw > 0) THEN
191 0 : WRITE (shell%iw, '("* READY")')
192 0 : CALL m_flush(shell%iw)
193 0 : READ (*, '(a)', iostat=iostat) line
194 0 : IF (iostat /= 0) THEN
195 0 : IF (iostat == IOSTAT_END) THEN
196 0 : WRITE (shell%iw, '(a)') '* EOF'
197 : END IF
198 0 : success = .FALSE. ! EOF
199 : END IF
200 : END IF
201 0 : CALL shell%para_env%bcast(success)
202 0 : IF (.NOT. success) RETURN
203 0 : CALL shell%para_env%bcast(line)
204 :
205 : ! extract command
206 : line = TRIM(line)
207 0 : DO i = 1, LEN_TRIM(line)
208 0 : IF (line(i:i) == ' ') EXIT
209 : END DO
210 0 : cmd = line(1:i)
211 0 : CALL uppercase(cmd)
212 0 : line = ADJUSTL(line(i:)) ! shift
213 :
214 : ! extract first arg
215 0 : DO i = 1, LEN_TRIM(line)
216 0 : IF (line(i:i) == ' ') EXIT
217 : END DO
218 0 : arg1 = line(1:i)
219 0 : line = ADJUSTL(line(i:)) ! shift
220 :
221 : ! extract second arg
222 0 : DO i = 1, LEN_TRIM(line)
223 0 : IF (line(i:i) == ' ') EXIT
224 : END DO
225 0 : arg2 = line(1:i)
226 :
227 : ! ignore remaining line
228 0 : 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 0 : 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 0 : success = .TRUE.
244 0 : IF (LEN_TRIM(str) > 0) THEN
245 0 : READ (str, *, iostat=iostat) shell%env_id
246 0 : IF (iostat /= 0) THEN
247 0 : shell%env_id = -1
248 0 : success = .FALSE.
249 0 : CALL print_error("parse_env_id failed", shell)
250 : END IF
251 0 : ELSE IF (shell%env_id < 1) THEN
252 0 : CALL print_error("last env_id not set", shell)
253 0 : success = .FALSE.
254 : END IF
255 : ! fallback: reuse last env_id
256 0 : END FUNCTION parse_env_id
257 :
258 : ! **************************************************************************************************
259 : !> \brief ...
260 : !> \param condition ...
261 : !> \param message ...
262 : !> \param shell ...
263 : !> \return ...
264 : ! **************************************************************************************************
265 0 : 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 0 : success = condition
272 0 : IF (.NOT. success) THEN
273 0 : CALL print_error(message, shell)
274 : END IF
275 0 : END FUNCTION my_assert
276 :
277 : ! **************************************************************************************************
278 : !> \brief ...
279 : !> \param message ...
280 : !> \param shell ...
281 : ! **************************************************************************************************
282 0 : SUBROUTINE print_error(message, shell)
283 : CHARACTER(LEN=*), INTENT(in) :: message
284 : TYPE(cp2k_shell_type) :: shell
285 :
286 0 : IF (shell%harsh) CPABORT(message)
287 :
288 0 : IF (shell%iw > 0) THEN
289 0 : WRITE (shell%iw, '("* ERROR ",a)') message
290 : END IF
291 0 : END SUBROUTINE print_error
292 :
293 : ! **************************************************************************************************
294 : !> \brief ...
295 : !> \param shell ...
296 : ! **************************************************************************************************
297 0 : SUBROUTINE help_command(shell)
298 : TYPE(cp2k_shell_type) :: shell
299 :
300 0 : IF (shell%iw > 0) THEN
301 0 : WRITE (shell%iw, *) 'Commands'
302 0 : WRITE (shell%iw, *) ' '
303 0 : WRITE (shell%iw, *) ' If there is [env_id] it means that an optional env_id can be given,'
304 0 : WRITE (shell%iw, *) ' if none is given it defaults to the last env_id loaded'
305 0 : WRITE (shell%iw, *) ' All commands are case insensitive.'
306 0 : WRITE (shell%iw, *) ' '
307 0 : WRITE (shell%iw, *) ' INFO: returns some information about cp2k.'
308 0 : WRITE (shell%iw, *) ' VERSION: returns shell version. (queried by ASE to assert features & bugfixes)'
309 0 : WRITE (shell%iw, *) ' WRITE_FILE: Writes content to a file (allows for using ASE over ssh).'
310 0 : WRITE (shell%iw, *) ' LOAD <inp-filename> [out-filename]: loads the filename, returns the env_id, or -1 in case of error'
311 0 : WRITE (shell%iw, *) ' out-filename is optional and defaults to <inp-filename>.out'
312 0 : WRITE (shell%iw, *) ' use "__STD_OUT__" for printing to the screen'
313 0 : WRITE (shell%iw, *) ' BG_LOAD <filename>: loads the filename, without returning the env_id'
314 0 : WRITE (shell%iw, *) ' LAST_ENV_ID: returns the env_id of the last environment loaded'
315 0 : WRITE (shell%iw, *) ' DESTROY [env_id]: destroys the given environment (last and default env'
316 0 : WRITE (shell%iw, *) ' might become invalid)'
317 0 : WRITE (shell%iw, *) ' NATOM [env_id]: returns the number of atoms in the environment env_id'
318 0 : WRITE (shell%iw, *) ' SET_POS [env_id]: sets the positions of the atoms, should be followed'
319 0 : WRITE (shell%iw, *) ' by natom*3 (on a line) and then all the positions. Returns the max'
320 0 : WRITE (shell%iw, *) ' change of the coordinates (useful to avoid extra calculations).'
321 0 : WRITE (shell%iw, *) ' SET_CELL [env_id]: sets the cell, should be followed by 9 numbers'
322 0 : WRITE (shell%iw, *) ' GET_CELL [env_id]: gets the cell vectors'
323 0 : WRITE (shell%iw, *) ' GET_STRESS [env_id]: gets the stress tensor of the last calculation on env_id'
324 0 : WRITE (shell%iw, *) ' GET_POS [env_id]: gets the positions of the atoms, returns'
325 0 : WRITE (shell%iw, *) ' natom*3 (on a line) and then all the positions then "* END" '
326 0 : WRITE (shell%iw, *) ' (alone on a line)'
327 0 : WRITE (shell%iw, *) ' GET_E [env_id]: gets the energy of the last calculation on env_id'
328 0 : WRITE (shell%iw, *) ' GET_F [env_id]: gets the forces on the atoms,of the last calculation on '
329 0 : WRITE (shell%iw, *) ' env_id, if only the energy was calculated the content is undefined. Returns'
330 0 : WRITE (shell%iw, *) ' natom*3 (on a line) and then all the forces then "* END" (alone on'
331 0 : WRITE (shell%iw, *) ' a line)'
332 0 : WRITE (shell%iw, *) ' CALC_E [env_id]: calculate the energy and returns it'
333 0 : WRITE (shell%iw, *) ' EVAL_E [env_id]: calculate the energy (without returning it)'
334 0 : WRITE (shell%iw, *) ' CALC_EF [env_id]: calculate energy and forces and returns them,'
335 0 : WRITE (shell%iw, *) ' first the energy on a line, then the natom*3 (on a line)'
336 0 : WRITE (shell%iw, *) ' and finally all the values and "* END" (alone on a line)'
337 0 : WRITE (shell%iw, *) ' EVAL_EF [env_id]: calculate the energy and forces (without returning them)'
338 0 : WRITE (shell%iw, *) ' RUN <inp-filename> <out-filename>: run the given input file'
339 0 : WRITE (shell%iw, *) ' HARSH: stops on any error'
340 0 : WRITE (shell%iw, *) ' PERMISSIVE: stops only on serious errors'
341 0 : WRITE (shell%iw, *) ' UNITS: returns the units used for energy and position'
342 0 : WRITE (shell%iw, *) ' UNITS_EV_A: sets the units to electron volt (energy) and Angstrom (positions)'
343 0 : WRITE (shell%iw, *) ' UNITS_AU: sets the units atomic units'
344 0 : WRITE (shell%iw, *) ' CD <dir>: change working directory'
345 0 : WRITE (shell%iw, *) ' PWD: print working directory'
346 0 : WRITE (shell%iw, *) ' EXIT: Quit the shell'
347 0 : WRITE (shell%iw, *) ' HELP: writes the present help'
348 0 : CALL m_flush(shell%iw)
349 : END IF
350 0 : END SUBROUTINE help_command
351 :
352 : ! **************************************************************************************************
353 : !> \brief ...
354 : !> \param shell ...
355 : ! **************************************************************************************************
356 0 : 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 0 : IF (shell%iw > 0) THEN
363 0 : CALL m_getcwd(cwd)
364 0 : CALL m_getpid(pid)
365 0 : CALL m_getlog(user_name)
366 0 : CALL m_hostnm(host_name)
367 : WRITE (UNIT=shell%iw, FMT="(A,A)") &
368 0 : " PROGRAM STARTED ON ", TRIM(host_name)
369 : WRITE (UNIT=shell%iw, FMT="(A,A)") &
370 0 : " PROGRAM STARTED BY ", TRIM(user_name)
371 : WRITE (UNIT=shell%iw, FMT="(A,i10)") &
372 0 : " PROGRAM PROCESS ID ", pid
373 : WRITE (UNIT=shell%iw, FMT="(A,A)") &
374 0 : " PROGRAM STARTED IN ", TRIM(cwd)
375 : WRITE (UNIT=shell%iw, FMT="(/,T2,A,T31,A50)") &
376 0 : "CP2K| version string: ", &
377 0 : ADJUSTR(TRIM(cp2k_version))
378 : WRITE (UNIT=shell%iw, FMT="(T2,A,T41,A40)") &
379 0 : "CP2K| source code revision number:", &
380 0 : ADJUSTR(compile_revision)
381 : WRITE (UNIT=shell%iw, FMT="(T2,A,T41,A40)") &
382 0 : "CP2K| is freely available from ", &
383 0 : ADJUSTR(TRIM(cp2k_home))
384 : WRITE (UNIT=shell%iw, FMT="(T2,A,T31,A50)") &
385 0 : "CP2K| Program compiled at", &
386 0 : ADJUSTR(compile_date(1:MIN(50, LEN(compile_date))))
387 : WRITE (UNIT=shell%iw, FMT="(T2,A,T31,A50)") &
388 0 : "CP2K| Program compiled on", &
389 0 : ADJUSTR(compile_host(1:MIN(50, LEN(compile_host))))
390 : WRITE (UNIT=shell%iw, FMT="(T2,A,T31,A50)") &
391 0 : "CP2K| Program compiled for", &
392 0 : ADJUSTR(compile_arch(1:MIN(50, LEN(compile_arch))))
393 :
394 0 : CALL print_cp2k_license(shell%iw)
395 0 : CALL m_flush(shell%iw)
396 : END IF
397 :
398 0 : END SUBROUTINE info_license_command
399 :
400 : ! **************************************************************************************************
401 : !> \brief ...
402 : !> \param shell ...
403 : ! **************************************************************************************************
404 0 : SUBROUTINE version_command(shell)
405 : TYPE(cp2k_shell_type) :: shell
406 :
407 0 : IF (shell%iw > 0) THEN
408 0 : WRITE (shell%iw, '(a,a)') "CP2K Shell Version: ", CP2K_SHELL_VERSION
409 0 : CALL m_flush(shell%iw)
410 : END IF
411 0 : END SUBROUTINE version_command
412 :
413 : ! **************************************************************************************************
414 : !> \brief ...
415 : !> \param shell ...
416 : ! **************************************************************************************************
417 0 : 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 0 : IF (shell%iw > 0) THEN
424 0 : READ (*, '(a)', iostat=iostat) out_filename
425 0 : IF (iostat /= 0) CPABORT('WRITE_FILE bad filename')
426 0 : READ (*, *, iostat=iostat) n_lines
427 0 : IF (iostat /= 0) CPABORT('WRITE_FILE bad number of lines')
428 : CALL open_file(file_name=TRIM(out_filename), unit_number=file_unit, &
429 0 : file_status="UNKNOWN", file_form="FORMATTED", file_action="WRITE")
430 0 : DO i = 1, n_lines
431 0 : READ (*, '(a)', iostat=iostat) line
432 0 : IF (iostat /= 0) CPABORT('WRITE_FILE read error')
433 0 : WRITE (file_unit, '(a)', iostat=iostat) TRIM(line)
434 0 : IF (iostat /= 0) CPABORT('WRITE_FILE write error')
435 : END DO
436 0 : READ (*, '(a)', iostat=iostat) line
437 0 : IF (iostat /= 0) CPABORT('WRITE_FILE read error')
438 0 : IF (TRIM(line) /= "*END") CPABORT('WRITE_FILE bad end delimiter')
439 0 : CALL close_file(unit_number=file_unit)
440 : END IF
441 0 : END SUBROUTINE write_file_command
442 :
443 : ! **************************************************************************************************
444 : !> \brief ...
445 : !> \param shell ...
446 : ! **************************************************************************************************
447 0 : SUBROUTINE get_last_env_id(shell)
448 : TYPE(cp2k_shell_type) :: shell
449 :
450 0 : IF (shell%iw > 0) THEN
451 0 : WRITE (shell%iw, '(i10)') shell%env_id
452 0 : CALL m_flush(shell%iw)
453 : END IF
454 0 : END SUBROUTINE get_last_env_id
455 :
456 : ! **************************************************************************************************
457 : !> \brief ...
458 : !> \param shell ...
459 : !> \param input_declaration ...
460 : !> \param arg1 ...
461 : ! **************************************************************************************************
462 0 : 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 0 : 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 0 : owns_out_unit=.TRUE., ierr=ierr)
475 0 : IF (ierr /= 0) THEN
476 0 : shell%env_id = -1
477 0 : 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 0 : 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 0 : IF (.NOT. my_assert(LEN_TRIM(arg1) > 0, "file argument missing", shell)) RETURN
497 0 : inp_filename = arg1
498 0 : out_filename = TRIM(inp_filename)//'.out'
499 0 : 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 0 : owns_out_unit=.TRUE., ierr=ierr)
505 0 : IF (ierr /= 0) THEN
506 0 : shell%env_id = -1
507 0 : CALL print_error("create_force_env failed", shell)
508 0 : ELSE IF (shell%iw > 0) THEN
509 0 : WRITE (shell%iw, '(i10)') shell%env_id
510 0 : CALL m_flush(shell%iw)
511 : END IF
512 0 : END SUBROUTINE load_command
513 :
514 : ! **************************************************************************************************
515 : !> \brief ...
516 : !> \param shell ...
517 : !> \param arg1 ...
518 : ! **************************************************************************************************
519 0 : 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 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
526 0 : CALL destroy_force_env(shell%env_id, ierr)
527 0 : shell%env_id = -1
528 0 : 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 0 : 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 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
543 0 : CALL get_natom(shell%env_id, n_atom, ierr)
544 0 : IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
545 0 : IF (shell%iw > 0) THEN
546 0 : WRITE (shell%iw, '(i10)', iostat=iostat) n_atom
547 0 : 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 0 : 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 0 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: old_pos, pos
564 :
565 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
566 0 : CALL get_natom(shell%env_id, n_atom, ierr)
567 0 : IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
568 0 : ALLOCATE (pos(3*n_atom), old_pos(3*n_atom))
569 0 : IF (shell%iw > 0) THEN
570 0 : READ (*, *, iostat=iostat) n_atom
571 0 : IF (.NOT. my_assert(iostat == 0, 'setpos read n_atom failed', shell)) RETURN
572 0 : IF (.NOT. my_assert(n_atom == SIZE(pos), 'setpos invalid number of atoms', shell)) RETURN
573 0 : READ (*, *, iostat=iostat) pos
574 0 : IF (.NOT. my_assert(iostat == 0, 'setpos read coords failed', shell)) RETURN
575 0 : pos(:) = pos(:)/shell%pos_fact
576 0 : READ (*, '(a)', iostat=iostat) line
577 0 : IF (.NOT. my_assert(iostat == 0, 'setpos read END failed', shell)) RETURN
578 0 : CALL uppercase(line)
579 0 : IF (.NOT. my_assert(TRIM(line) == '*END', 'missing *END', shell)) RETURN
580 : END IF
581 0 : CALL shell%para_env%bcast(pos)
582 0 : CALL get_pos(shell%env_id, old_pos, n_el=3*n_atom, ierr=ierr)
583 0 : IF (.NOT. my_assert(ierr == 0, 'get_pos error', shell)) RETURN
584 0 : CALL set_pos(shell%env_id, new_pos=pos, n_el=3*n_atom, ierr=ierr)
585 0 : IF (.NOT. my_assert(ierr == 0, 'set_pos error', shell)) RETURN
586 0 : max_change = 0.0_dp
587 0 : DO i = 1, SIZE(pos)
588 0 : max_change = MAX(max_change, ABS(pos(i) - old_pos(i)))
589 : END DO
590 0 : DEALLOCATE (pos, old_pos)
591 0 : IF (shell%iw > 0) THEN
592 0 : WRITE (shell%iw, '(ES22.13)') max_change*shell%pos_fact
593 0 : CALL m_flush(shell%iw)
594 : END IF
595 0 : END SUBROUTINE set_pos_command
596 :
597 : ! **************************************************************************************************
598 : !> \brief ...
599 : !> \param shell ...
600 : !> \param arg1 ...
601 : ! **************************************************************************************************
602 0 : 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 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
610 0 : IF (shell%iw > 0) THEN
611 0 : READ (*, *, iostat=iostat) cell
612 0 : IF (.NOT. my_assert(iostat == 0, 'setcell read failed', shell)) RETURN
613 0 : cell(:, :) = cell(:, :)/shell%pos_fact
614 : END IF
615 0 : CALL shell%para_env%bcast(cell)
616 0 : CALL set_cell(shell%env_id, new_cell=cell, ierr=ierr)
617 0 : 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 0 : 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 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
633 0 : CALL get_cell(shell%env_id, cell=cell, ierr=ierr)
634 0 : IF (.NOT. my_assert(ierr == 0, 'get_cell failed', shell)) RETURN
635 0 : cell(:, :) = cell(:, :)*shell%pos_fact
636 0 : IF (shell%iw > 0) THEN
637 0 : WRITE (shell%iw, '(9ES22.13)') cell
638 0 : 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 0 : 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 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
655 0 : CALL get_stress_tensor(shell%env_id, stress_tensor=stress_tensor, ierr=ierr)
656 0 : IF (.NOT. my_assert(ierr == 0, 'get_stress_tensor failed', shell)) RETURN
657 0 : stress_tensor(:, :) = stress_tensor(:, :)*(shell%e_fact/shell%pos_fact**3)
658 0 : IF (shell%iw > 0) THEN
659 0 : WRITE (shell%iw, '(9ES22.13)') stress_tensor
660 0 : 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 0 : 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 0 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: pos
675 :
676 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
677 0 : CALL get_natom(shell%env_id, n_atom, ierr)
678 0 : IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
679 0 : ALLOCATE (pos(3*n_atom))
680 0 : CALL get_pos(shell%env_id, pos=pos, n_el=3*n_atom, ierr=ierr)
681 0 : IF (.NOT. my_assert(ierr == 0, 'get_pos failed', shell)) RETURN
682 0 : IF (shell%iw > 0) THEN
683 0 : WRITE (shell%iw, '(i10)') 3*n_atom
684 0 : WRITE (shell%iw, '(3ES22.13)') pos(:)*shell%pos_fact
685 0 : WRITE (shell%iw, '(a)') "* END"
686 0 : CALL m_flush(shell%iw)
687 : END IF
688 0 : DEALLOCATE (pos)
689 0 : END SUBROUTINE get_pos_command
690 :
691 : ! **************************************************************************************************
692 : !> \brief ...
693 : !> \param shell ...
694 : !> \param arg1 ...
695 : ! **************************************************************************************************
696 0 : 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 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
704 0 : CALL get_energy(shell%env_id, e_pot, ierr)
705 0 : IF (.NOT. my_assert(ierr == 0, 'get_energy failed', shell)) RETURN
706 0 : IF (shell%iw > 0) THEN
707 0 : WRITE (shell%iw, '(ES22.13)') e_pot*shell%e_fact
708 0 : 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 0 : SUBROUTINE eval_energy_command(shell, arg1)
718 : TYPE(cp2k_shell_type) :: shell
719 : CHARACTER(LEN=*), INTENT(IN) :: arg1
720 :
721 : INTEGER :: ierr
722 :
723 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
724 0 : CALL calc_energy_force(shell%env_id, calc_force=.FALSE., ierr=ierr)
725 0 : 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 0 : 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 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
741 0 : CALL calc_energy_force(shell%env_id, calc_force=.FALSE., ierr=ierr)
742 0 : IF (.NOT. my_assert(ierr == 0, 'calc_energy_force failed', shell)) RETURN
743 0 : CALL get_energy(shell%env_id, e_pot, ierr)
744 0 : IF (.NOT. my_assert(ierr == 0, 'get_energy failed', shell)) RETURN
745 0 : IF (shell%iw > 0) THEN
746 0 : WRITE (shell%iw, '(ES22.13)') e_pot*shell%e_fact
747 0 : 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 0 : 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 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
763 0 : CALL calc_energy_force(shell%env_id, calc_force=.TRUE., ierr=ierr)
764 0 : 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 0 : 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 0 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: forces
778 :
779 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
780 0 : CALL get_natom(shell%env_id, n_atom, ierr)
781 0 : IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
782 0 : ALLOCATE (forces(3*n_atom))
783 0 : CALL get_force(shell%env_id, frc=forces, n_el=3*n_atom, ierr=ierr)
784 0 : IF (.NOT. my_assert(ierr == 0, 'get_force failed', shell)) RETURN
785 0 : forces(:) = forces(:)*(shell%e_fact/shell%pos_fact)
786 0 : IF (shell%iw > 0) THEN
787 0 : WRITE (shell%iw, '(i10)') 3*n_atom
788 0 : WRITE (shell%iw, '(3ES22.13)') forces
789 0 : WRITE (shell%iw, '("* END")')
790 0 : CALL m_flush(shell%iw)
791 : END IF
792 0 : DEALLOCATE (forces)
793 0 : END SUBROUTINE get_forces_command
794 :
795 : ! **************************************************************************************************
796 : !> \brief ...
797 : !> \param shell ...
798 : !> \param arg1 ...
799 : ! **************************************************************************************************
800 0 : 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 0 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: forces
807 :
808 0 : IF (.NOT. parse_env_id(arg1, shell)) RETURN
809 0 : CALL calc_energy_force(shell%env_id, calc_force=.TRUE., ierr=ierr)
810 0 : IF (.NOT. my_assert(ierr == 0, 'calc_energy_force failed', shell)) RETURN
811 0 : CALL get_energy(shell%env_id, e_pot, ierr)
812 0 : IF (.NOT. my_assert(ierr == 0, 'get_energy failed', shell)) RETURN
813 0 : CALL get_natom(shell%env_id, n_atom, ierr)
814 0 : IF (.NOT. my_assert(ierr == 0, 'get_natom failed', shell)) RETURN
815 0 : ALLOCATE (forces(3*n_atom))
816 0 : CALL get_force(shell%env_id, frc=forces, n_el=3*n_atom, ierr=ierr)
817 0 : IF (.NOT. my_assert(ierr == 0, 'get_energy failed', shell)) RETURN
818 0 : IF (shell%iw > 0) THEN
819 0 : WRITE (shell%iw, '(ES22.13)') e_pot*shell%e_fact
820 0 : WRITE (shell%iw, '(i10)') 3*n_atom
821 0 : WRITE (shell%iw, '(3ES22.13)') forces*(shell%e_fact/shell%pos_fact)
822 0 : WRITE (shell%iw, '("* END")')
823 0 : CALL m_flush(shell%iw)
824 : END IF
825 0 : DEALLOCATE (forces)
826 0 : 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 0 : 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 0 : IF (.NOT. my_assert(LEN_TRIM(arg1) > 0, "input-file argument missing", shell)) RETURN
841 0 : IF (.NOT. my_assert(LEN_TRIM(arg2) > 0, "input-file argument missing", shell)) RETURN
842 0 : CALL run_input(input_declaration, arg1, arg2, empty_initial_variables)
843 : END SUBROUTINE run_command
844 :
845 : ! **************************************************************************************************
846 : !> \brief ...
847 : !> \param shell ...
848 : ! **************************************************************************************************
849 0 : SUBROUTINE set_units_ev_a(shell)
850 : TYPE(cp2k_shell_type) :: shell
851 :
852 0 : shell%e_fact = evolt
853 0 : shell%pos_fact = angstrom
854 0 : shell%units = 'eV_A'
855 0 : END SUBROUTINE set_units_ev_a
856 :
857 : ! **************************************************************************************************
858 : !> \brief ...
859 : !> \param shell ...
860 : ! **************************************************************************************************
861 0 : SUBROUTINE set_units_au(shell)
862 : TYPE(cp2k_shell_type) :: shell
863 :
864 0 : shell%e_fact = 1.0_dp
865 0 : shell%pos_fact = 1.0_dp
866 0 : shell%units = 'au'
867 0 : END SUBROUTINE set_units_au
868 :
869 : ! **************************************************************************************************
870 : !> \brief ...
871 : !> \param shell ...
872 : ! **************************************************************************************************
873 0 : SUBROUTINE get_units(shell)
874 : TYPE(cp2k_shell_type) :: shell
875 :
876 0 : IF (shell%iw > 0) THEN
877 0 : WRITE (shell%iw, '(a)') TRIM(shell%units)
878 0 : CALL m_flush(shell%iw)
879 : END IF
880 0 : END SUBROUTINE get_units
881 :
882 : ! **************************************************************************************************
883 : !> \brief ...
884 : !> \param shell ...
885 : !> \param arg1 ...
886 : ! **************************************************************************************************
887 0 : SUBROUTINE set_pwd_command(shell, arg1)
888 : TYPE(cp2k_shell_type) :: shell
889 : CHARACTER(LEN=*), INTENT(IN) :: arg1
890 :
891 : INTEGER :: ierr
892 :
893 0 : IF (.NOT. my_assert(LEN_TRIM(arg1) > 0, 'missing directory', shell)) RETURN
894 0 : CALL m_chdir(arg1, ierr)
895 0 : 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 0 : SUBROUTINE get_pwd_command(shell)
903 : TYPE(cp2k_shell_type) :: shell
904 :
905 : CHARACTER(LEN=default_path_length) :: cwd
906 :
907 0 : IF (shell%iw > 0) THEN
908 0 : CALL m_getcwd(cwd)
909 0 : WRITE (shell%iw, '(a)') TRIM(cwd)
910 : END IF
911 0 : END SUBROUTINE get_pwd_command
912 :
913 0 : END MODULE cp2k_shell
|
