File: test_fortran_properties.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 (126 lines) | stat: -rw-r--r-- 3,953 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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
SUBROUTINE f_lammps_memory_usage(meminfo) BIND(C)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
   USE liblammps
   USE keepstuff, ONLY : lmp
   IMPLICIT NONE
   REAL(c_double), DIMENSION(3), INTENT(OUT) :: meminfo

   CALL lmp%memory_usage(meminfo)
END SUBROUTINE f_lammps_memory_usage

FUNCTION f_lammps_get_mpi_comm() BIND(C)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
   USE liblammps
   USE keepstuff, ONLY : lmp
   IMPLICIT NONE
   INTEGER(c_int) :: f_lammps_get_mpi_comm

   f_lammps_get_mpi_comm = lmp%get_mpi_comm()
END FUNCTION f_lammps_get_mpi_comm

FUNCTION f_lammps_extract_setting(Cstr) BIND(C)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_char, c_null_char
   USE keepstuff, ONLY : lmp
   USE LIBLAMMPS
   IMPLICIT NONE
   INTEGER(c_int) :: f_lammps_extract_setting
   CHARACTER(KIND=c_char, LEN=1), DIMENSION(*), INTENT(IN) :: Cstr
   INTEGER :: strlen, i
   CHARACTER(LEN=:), ALLOCATABLE :: Fstr

   i = 1
   DO WHILE (Cstr(i) /= c_null_char)
      i = i + 1
   END DO
   strlen = i
   ALLOCATE(CHARACTER(LEN=strlen) :: Fstr)
   DO i = 1, strlen
      Fstr(i:i) = Cstr(i)
   END DO
   f_lammps_extract_setting = lmp%extract_setting(Fstr)
   DEALLOCATE(Fstr)
END FUNCTION f_lammps_extract_setting

FUNCTION f_lammps_has_error() BIND(C)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
   USE keepstuff, ONLY : lmp
   USE LIBLAMMPS
   IMPLICIT NONE
   INTEGER(c_int) :: f_lammps_has_error

   IF (lmp%has_error()) THEN
      f_lammps_has_error = 1_c_int
   ELSE
      f_lammps_has_error = 0_c_int
   END IF
END FUNCTION f_lammps_has_error

FUNCTION f_lammps_get_last_error_message(errmesg, errlen) BIND(C)
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_char, c_ptr, C_F_POINTER, &
      c_null_char
   USE keepstuff, ONLY : lmp
   USE LIBLAMMPS
   IMPLICIT NONE
   INTEGER(c_int) :: f_lammps_get_last_error_message
   CHARACTER(KIND=c_char), DIMENSION(*) :: errmesg
   INTEGER(c_int), VALUE, INTENT(IN) :: errlen
   CHARACTER(LEN=:), ALLOCATABLE :: buffer
   INTEGER :: status, i

   ! copy error message to buffer
   ALLOCATE(CHARACTER(errlen) :: buffer)
   CALL lmp%get_last_error_message(buffer, status)
   f_lammps_get_last_error_message = status
   ! and copy to C style string
   errmesg(1:errlen) = c_null_char
   DO i=1, errlen
      errmesg(i) = buffer(i:i)
      IF (buffer(i:i) == c_null_char) EXIT
   END DO
   errmesg(errlen) = c_null_char
   DEALLOCATE(buffer)
END FUNCTION f_lammps_get_last_error_message

FUNCTION f_lammps_get_image_flags_int(ix, iy, iz) BIND(C)
  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
  USE keepstuff, ONLY : lmp
  USE LIBLAMMPS
  IMPLICIT NONE
  INTEGER(c_int), INTENT(IN), VALUE :: ix, iy, iz
  INTEGER(c_int) :: f_lammps_get_image_flags_int

  f_lammps_get_image_flags_int = lmp%encode_image_flags(ix, iy, iz)
END FUNCTION f_lammps_get_image_flags_int

FUNCTION f_lammps_get_image_flags_bigint(ix, iy, iz) BIND(C)
  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
  USE keepstuff, ONLY : lmp
  USE LIBLAMMPS
  IMPLICIT NONE
  INTEGER(c_int), INTENT(IN), VALUE :: ix, iy, iz
  INTEGER(c_int64_t) :: f_lammps_get_image_flags_bigint

  f_lammps_get_image_flags_bigint = lmp%encode_image_flags(ix, iy, iz)
END FUNCTION f_lammps_get_image_flags_bigint

SUBROUTINE f_lammps_decode_image_flags(image, flag) BIND(C)
  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
  USE keepstuff, ONLY : lmp
  USE LIBLAMMPS
  IMPLICIT NONE
  INTEGER(c_int), INTENT(IN), VALUE :: image
  INTEGER(c_int), INTENT(OUT) :: flag(3)

  CALL lmp%decode_image_flags(image, flag)
END SUBROUTINE f_lammps_decode_image_flags

SUBROUTINE f_lammps_decode_image_flags_bigbig(image, flag) BIND(C)
  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
  USE keepstuff, ONLY : lmp
  USE LIBLAMMPS
  IMPLICIT NONE
  INTEGER(c_int64_t), INTENT(IN), VALUE :: image
  INTEGER(c_int), INTENT(OUT) :: flag(3)

  CALL lmp%decode_image_flags(image, flag)
END SUBROUTINE f_lammps_decode_image_flags_bigbig