1! -------------------------------------------------------------------------
2!   LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
3!   https://www.lammps.org/ Sandia National Laboratories
4!   Steve Plimpton, sjplimp@sandia.gov
5!
6!   Copyright (2003) Sandia Corporation.  Under the terms of Contract
7!   DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
8!   certain rights in this software.  This software is distributed under
9!   the GNU General Public License.
10!
11!   See the README file in the top-level LAMMPS directory.
12! -------------------------------------------------------------------------
13!
14! Fortran interface to the LAMMPS library implemented as a Fortran 2003
15! style module that wraps the C-style library interface in library.cpp
16! and library.h using the ISO_C_BINDING module of the Fortran compiler.
17!
18! Based on the LAMMPS Fortran 2003 module contributed by:
19!   Karl D. Hammond <hammondkd@missouri.edu>
20!   University of Missouri, 2012-2020
21!
22! The Fortran module tries to follow the API of the C-library interface
23! closely, but like the Python wrapper it employs an object oriented
24! approach.  To accommodate the object oriented approach, all exported
25! subroutine and functions have to be implemented in Fortran to then
26! call the interfaced C style functions with adapted calling conventions
27! as needed.  The C-library interfaced functions retain their names
28! starting with "lammps_" while the Fortran versions start with "lmp_".
29!
30MODULE LIBLAMMPS
31
32  USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_loc, &
33      c_int, c_char, c_null_char, c_double, c_size_t, c_f_pointer
34
35  IMPLICIT NONE
36  PRIVATE
37  PUBLIC :: lammps
38
39  TYPE lammps
40      TYPE(c_ptr) :: handle
41    CONTAINS
42      PROCEDURE :: close              => lmp_close
43      PROCEDURE :: file               => lmp_file
44      PROCEDURE :: command            => lmp_command
45      PROCEDURE :: commands_list      => lmp_commands_list
46      PROCEDURE :: commands_string    => lmp_commands_string
47      PROCEDURE :: version            => lmp_version
48      PROCEDURE :: get_natoms         => lmp_get_natoms
49  END TYPE lammps
50
51  INTERFACE lammps
52      MODULE PROCEDURE lmp_open
53  END INTERFACE lammps
54
55  ! interface definitions for calling functions in library.cpp
56  INTERFACE
57      FUNCTION lammps_open(argc,argv,comm) &
58          BIND(C, name='lammps_open_fortran')
59        IMPORT :: c_ptr, c_int
60        INTEGER(c_int), VALUE, INTENT(in)     :: argc, comm
61        TYPE(c_ptr), DIMENSION(*), INTENT(in) :: argv
62        TYPE(c_ptr)                           :: lammps_open
63      END FUNCTION lammps_open
64
65      FUNCTION lammps_open_no_mpi(argc,argv,handle) &
66          BIND(C, name='lammps_open_no_mpi')
67        IMPORT :: c_ptr, c_int
68        INTEGER(c_int), VALUE, INTENT(in)     :: argc
69        TYPE(c_ptr), DIMENSION(*), INTENT(in) :: argv
70        TYPE(c_ptr), INTENT(out)              :: handle
71        TYPE(c_ptr)                           :: lammps_open_no_mpi
72      END FUNCTION lammps_open_no_mpi
73
74      SUBROUTINE lammps_close(handle) BIND(C, name='lammps_close')
75        IMPORT :: c_ptr
76        TYPE(c_ptr), VALUE :: handle
77      END SUBROUTINE lammps_close
78
79      SUBROUTINE lammps_mpi_init() BIND(C, name='lammps_mpi_init')
80      END SUBROUTINE lammps_mpi_init
81
82      SUBROUTINE lammps_mpi_finalize() BIND(C, name='lammps_mpi_finalize')
83      END SUBROUTINE lammps_mpi_finalize
84
85      SUBROUTINE lammps_kokkos_finalize() BIND(C, name='lammps_kokkos_finalize')
86      END SUBROUTINE lammps_kokkos_finalize
87
88      SUBROUTINE lammps_file(handle,filename) BIND(C, name='lammps_file')
89        IMPORT :: c_ptr
90        TYPE(c_ptr), VALUE :: handle
91        TYPE(c_ptr), VALUE :: filename
92      END SUBROUTINE lammps_file
93
94      SUBROUTINE lammps_command(handle,cmd) BIND(C, name='lammps_command')
95        IMPORT :: c_ptr
96        TYPE(c_ptr), VALUE :: handle
97        TYPE(c_ptr), VALUE :: cmd
98      END SUBROUTINE lammps_command
99
100      SUBROUTINE lammps_commands_list(handle,ncmd,cmds) &
101          BIND(C, name='lammps_commands_list')
102        IMPORT :: c_ptr, c_int
103        TYPE(c_ptr), VALUE :: handle
104        INTEGER(c_int), VALUE, INTENT(in)     :: ncmd
105        TYPE(c_ptr), DIMENSION(*), INTENT(in) :: cmds
106      END SUBROUTINE lammps_commands_list
107
108      SUBROUTINE lammps_commands_string(handle,str) &
109          BIND(C, name='lammps_commands_string')
110        IMPORT :: c_ptr
111        TYPE(c_ptr), VALUE :: handle
112        TYPE(c_ptr), VALUE :: str
113      END SUBROUTINE lammps_commands_string
114
115      FUNCTION lammps_malloc(size) BIND(C, name='malloc')
116        IMPORT :: c_ptr, c_size_t
117        INTEGER(c_size_t), value :: size
118        TYPE(c_ptr) :: lammps_malloc
119      END FUNCTION lammps_malloc
120
121      SUBROUTINE lammps_free(ptr) BIND(C, name='lammps_free')
122        IMPORT :: c_ptr
123        TYPE(c_ptr), VALUE :: ptr
124      END SUBROUTINE lammps_free
125
126      FUNCTION lammps_version(handle) BIND(C, name='lammps_version')
127        IMPORT :: c_ptr, c_int
128        TYPE(c_ptr), VALUE :: handle
129        INTEGER(c_int) :: lammps_version
130      END FUNCTION lammps_version
131
132      FUNCTION lammps_get_natoms(handle) BIND(C, name='lammps_get_natoms')
133        IMPORT :: c_ptr, c_double
134        TYPE(c_ptr), VALUE :: handle
135        REAL(c_double) :: lammps_get_natoms
136      END FUNCTION lammps_get_natoms
137  END INTERFACE
138
139CONTAINS
140
141  ! Fortran wrappers and helper functions.
142
143  ! Constructor for the LAMMPS class.
144  ! Combined wrapper around lammps_open_fortran() and lammps_open_no_mpi()
145  TYPE(lammps) FUNCTION lmp_open(args,comm)
146    IMPLICIT NONE
147    INTEGER,INTENT(in), OPTIONAL :: comm
148    CHARACTER(len=*), INTENT(in), OPTIONAL :: args(:)
149    TYPE(c_ptr), ALLOCATABLE     :: argv(:)
150    TYPE(c_ptr)                  :: dummy=c_null_ptr
151    INTEGER :: i,argc
152
153    IF (PRESENT(args)) THEN
154        ! convert argument list to c style
155        argc = SIZE(args)
156        ALLOCATE(argv(argc))
157        DO i=1,argc
158           argv(i) = f2c_string(args(i))
159        END DO
160    ELSE
161        argc = 1
162        ALLOCATE(argv(1))
163        argv(1) = f2c_string("liblammps")
164    ENDIF
165
166    IF (PRESENT(comm)) THEN
167        lmp_open%handle = lammps_open(argc,argv,comm)
168    ELSE
169        lmp_open%handle = lammps_open_no_mpi(argc,argv,dummy)
170    END IF
171
172    ! Clean up allocated memory
173    DO i=1,argc
174        CALL lammps_free(argv(i))
175    END DO
176    DEALLOCATE(argv)
177  END FUNCTION lmp_open
178
179  ! Combined Fortran wrapper around lammps_close() and lammps_mpi_finalize()
180  SUBROUTINE lmp_close(self,finalize)
181    IMPLICIT NONE
182    CLASS(lammps) :: self
183    LOGICAL,INTENT(in),OPTIONAL :: finalize
184
185    CALL lammps_close(self%handle)
186
187    IF (PRESENT(finalize)) THEN
188        IF (finalize) THEN
189            CALL lammps_kokkos_finalize()
190            CALL lammps_mpi_finalize()
191        END IF
192    END IF
193  END SUBROUTINE lmp_close
194
195  INTEGER FUNCTION lmp_version(self)
196    IMPLICIT NONE
197    CLASS(lammps) :: self
198
199    lmp_version = lammps_version(self%handle)
200  END FUNCTION lmp_version
201
202  DOUBLE PRECISION FUNCTION lmp_get_natoms(self)
203    IMPLICIT NONE
204    CLASS(lammps) :: self
205
206    lmp_get_natoms = lammps_get_natoms(self%handle)
207  END FUNCTION lmp_get_natoms
208
209  SUBROUTINE lmp_file(self,filename)
210    IMPLICIT NONE
211    CLASS(lammps) :: self
212    CHARACTER(len=*) :: filename
213    TYPE(c_ptr) :: str
214
215    str = f2c_string(filename)
216    CALL lammps_file(self%handle,str)
217    CALL lammps_free(str)
218  END SUBROUTINE lmp_file
219
220  ! equivalent function to lammps_command()
221  SUBROUTINE lmp_command(self,cmd)
222    IMPLICIT NONE
223    CLASS(lammps) :: self
224    CHARACTER(len=*) :: cmd
225    TYPE(c_ptr) :: str
226
227    str = f2c_string(cmd)
228    CALL lammps_command(self%handle,str)
229    CALL lammps_free(str)
230  END SUBROUTINE lmp_command
231
232  ! equivalent function to lammps_commands_list()
233  SUBROUTINE lmp_commands_list(self,cmds)
234    IMPLICIT NONE
235    CLASS(lammps) :: self
236    CHARACTER(len=*), INTENT(in), OPTIONAL :: cmds(:)
237    TYPE(c_ptr), ALLOCATABLE     :: cmdv(:)
238    INTEGER :: i,ncmd
239
240    ! convert command list to c style
241    ncmd = SIZE(cmds)
242    ALLOCATE(cmdv(ncmd))
243    DO i=1,ncmd
244        cmdv(i) = f2c_string(cmds(i))
245    END DO
246
247    CALL lammps_commands_list(self%handle,ncmd,cmdv)
248
249    ! Clean up allocated memory
250    DO i=1,ncmd
251        CALL lammps_free(cmdv(i))
252    END DO
253    DEALLOCATE(cmdv)
254  END SUBROUTINE lmp_commands_list
255
256  ! equivalent function to lammps_commands_string()
257  SUBROUTINE lmp_commands_string(self,str)
258    IMPLICIT NONE
259    CLASS(lammps) :: self
260    CHARACTER(len=*) :: str
261    TYPE(c_ptr) :: tmp
262
263    tmp = f2c_string(str)
264    CALL lammps_commands_string(self%handle,tmp)
265    CALL lammps_free(tmp)
266  END SUBROUTINE lmp_commands_string
267
268  ! ----------------------------------------------------------------------
269  ! local helper functions
270  ! copy fortran string to zero terminated c string
271  FUNCTION f2c_string(f_string) RESULT(ptr)
272    CHARACTER (len=*), INTENT(in)           :: f_string
273    CHARACTER (len=1, kind=c_char), POINTER :: c_string(:)
274    TYPE(c_ptr) :: ptr
275    INTEGER(c_size_t) :: i, n
276
277    n = LEN_TRIM(f_string)
278    ptr = lammps_malloc(n+1)
279    CALL C_F_POINTER(ptr,c_string,[1])
280    DO i=1,n
281        c_string(i) = f_string(i:i)
282    END DO
283    c_string(n+1) = c_null_char
284  END FUNCTION f2c_string
285END MODULE LIBLAMMPS
286