File: test_fortran_extract_fix.f90

package info (click to toggle)
lammps 20250204%2Bdfsg.1-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 474,368 kB
  • sloc: cpp: 1,060,070; python: 27,785; ansic: 8,956; f90: 7,254; sh: 6,044; perl: 4,171; fortran: 2,442; xml: 1,714; makefile: 1,352; objc: 238; lisp: 188; yacc: 58; csh: 16; awk: 14; tcl: 6; javascript: 2
file content (99 lines) | stat: -rw-r--r-- 3,622 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
FUNCTION f_lammps_with_args() BIND(C)
  USE ISO_C_BINDING, ONLY: C_ptr
  USE liblammps
  USE keepstuff, ONLY: lmp
  IMPLICIT NONE
  TYPE(C_ptr) :: f_lammps_with_args
  CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = &
      [ CHARACTER(len=12) :: 'liblammps', '-log', 'none', &
      '-echo','screen','-nocite','-var','zpos','1.5','-var','x','2']

  lmp = lammps(args)
  f_lammps_with_args = lmp%handle
END FUNCTION f_lammps_with_args

SUBROUTINE f_lammps_close() BIND(C)
  USE ISO_C_BINDING, ONLY: c_null_ptr
  USE liblammps
  USE keepstuff, ONLY: lmp
  IMPLICIT NONE

  CALL lmp%close()
  lmp%handle = C_NULL_PTR
END SUBROUTINE f_lammps_close

SUBROUTINE f_lammps_setup_extract_fix() BIND(C)
   USE LIBLAMMPS
   USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input, more_input
   IMPLICIT NONE

   CALL lmp%commands_list(big_input)
   CALL lmp%commands_list(cont_input)
   CALL lmp%commands_list(more_input)
   CALL lmp%commands_list(pair_input)
   CALL lmp%command("fix state all store/state 0 z") ! per-atom vector
   CALL lmp%command("fix move all move linear 0 0 0") ! for per-atom array
   CALL lmp%command("fix recenter all recenter 1 1 1") ! global scalar, vector
   CALL lmp%command("variable natoms equal count(all)")
   CALL lmp%command("variable ts equal step")
   CALL lmp%command("fix vec all vector 1 v_natoms v_ts") ! global array
   CALL lmp%command("run 1") ! must be 1, otherwise move/recenter won't happen
END SUBROUTINE f_lammps_setup_extract_fix

FUNCTION f_lammps_extract_fix_global_scalar() BIND(C) RESULT(scalar)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
   USE LIBLAMMPS
   USE keepstuff, ONLY : lmp
   IMPLICIT NONE
   REAL(c_double) :: scalar

   scalar = lmp%extract_fix("recenter", lmp%style%global, lmp%type%scalar)
END FUNCTION f_lammps_extract_fix_global_scalar

FUNCTION f_lammps_extract_fix_global_vector(i) BIND(C) RESULT(element)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
   USE LIBLAMMPS
   USE keepstuff, ONLY : lmp
   IMPLICIT NONE
   INTEGER(c_int), INTENT(IN), VALUE :: i
   REAL(c_double) :: element

   element = lmp%extract_fix("recenter", lmp%style%global, lmp%type%vector, i)
END FUNCTION f_lammps_extract_fix_global_vector

FUNCTION f_lammps_extract_fix_global_array(i,j) BIND(C) RESULT(element)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
   USE LIBLAMMPS
   USE keepstuff, ONLY : lmp
   IMPLICIT NONE
   INTEGER(c_int), INTENT(IN), VALUE :: i, j
   REAL(c_double) :: element

   element = lmp%extract_fix("vec", lmp%style%global, lmp%type%array, i, j)
END FUNCTION f_lammps_extract_fix_global_array

FUNCTION f_lammps_extract_fix_peratom_vector(i) BIND(C)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
   USE LIBLAMMPS
   USE keepstuff, ONLY : lmp
   IMPLICIT NONE
   INTEGER(c_int), INTENT(IN), VALUE :: i
   REAL(c_double) :: f_lammps_extract_fix_peratom_vector
   REAL(c_double), DIMENSION(:), POINTER :: vector

   vector = lmp%extract_fix("state", lmp%style%atom, lmp%type%vector, -1, -1)
   f_lammps_extract_fix_peratom_vector = vector(i)
END FUNCTION f_lammps_extract_fix_peratom_vector

FUNCTION f_lammps_extract_fix_peratom_array(i,j) BIND(C)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
   USE LIBLAMMPS
   USE keepstuff, ONLY : lmp
   IMPLICIT NONE
   INTEGER(c_int), INTENT(IN), VALUE :: i, j
   REAL(c_double) :: f_lammps_extract_fix_peratom_array
   REAL(c_double), DIMENSION(:,:), POINTER :: array

   array = lmp%extract_fix("move", lmp%style%atom, lmp%type%array, -1, -1)
   f_lammps_extract_fix_peratom_array = array(i,j)
END FUNCTION f_lammps_extract_fix_peratom_array