tx258/lammps-gran-kokkos
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remove obsolete Fortran interfaces from examples/COUPLE folder

Browse Source
This commit is contained in:
Axel Kohlmeyer
2023-06-17 18:22:53 -04:00
parent 9673c22cc7
commit 753a0bd386
23 changed files with 4 additions and 4219 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
doc/src/Fortran.rst
View File

@ -56,17 +56,6 @@ C++ in the ``examples/COUPLE/simple`` folder of the LAMMPS distribution.
and Ubuntu 18.04 LTS and not compatible. Either newer compilers
need to be installed or the Linux updated.
.. versionchanged:: 8Feb2023
.. note::
A contributed Fortran interface is available in the
``examples/COUPLE/fortran2`` folder. However, since the completion
of the :f:mod:`LIBLAMMPS` module, this interface is now deprecated,
no longer actively maintained and will likely be removed in the
future. Please see the ``README`` file in that folder for more
information about it and how to contact its author and maintainer.
----------
Creating or deleting a LAMMPS object

13
examples/COUPLE/README
View File

@ -19,12 +19,12 @@ See these sections of the LAMMPS manual for details:
Build LAMMPS as a library (doc/html/Build_basics.html)
Link LAMMPS as a library to another code (doc/html/Build_link.html)
Coupling LAMMPS to other codes (doc/html/Howto_couple.html)
Using LAMMPS in client/server mode (doc/html/Howto_client_server.html)
Library interface to LAMMPS (doc/html/Howto_library.html)
Detailed documentation of the LAMMPS interfaces (doc/html/Library.html)
The library interface to LAMMPS is in src/library.cpp. Routines can
be easily added to this file so an external program can perform the
LAMMPS tasks desired.
The core library interface to LAMMPS is in src/library.cpp. Routines
can be easily added to this file so an external program can perform
the LAMMPS tasks desired.
-------------------------------------------------------------------
@ -36,10 +36,5 @@ plugin example for loading LAMMPS at runtime from a shared library
lammps_spparks grain-growth Monte Carlo with strain via MD,
coupling to SPPARKS kinetic MC code
library collection of useful inter-code communication routines
fortran2 a more sophisticated wrapper on the LAMMPS library API that
can be called from Fortran
fortran_dftb wrapper written by Nir Goldman (LLNL), as an
extension to fortran2, used for calling LAMMPS
from Fortran DFTB+ tight-binding code
Each sub-directory has its own README with more details.

1
examples/COUPLE/fortran2/.gitignore vendored
View File

@ -1 +0,0 @@
*.mod

96
examples/COUPLE/fortran2/LAMMPS-wrapper.cpp
View File

@ -1,96 +0,0 @@
/* -----------------------------------------------------------------------
LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
https://www.lammps.org/, Sandia National Laboratories
LAMMPS development team: developers@lammps.org
Copyright (2003) Sandia Corporation. Under the terms of Contract
DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
certain rights in this software. This software is distributed under
the GNU General Public License.
See the README file in the top-level LAMMPS directory.
------------------------------------------------------------------------- */
/* ------------------------------------------------------------------------
Contributing author: Karl D. Hammond <hammondkd@missouri.edu>
University of Missouri (USA), 2012
------------------------------------------------------------------------- */
/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself
provides a (I hope) robust Fortran interface to library.cpp and
library.h. All functions herein COULD be added to library.cpp instead of
including this as a separate file. See the README for instructions. */
#include <mpi.h>
#include "LAMMPS-wrapper.h"
#define LAMMPS_LIB_MPI 1
#include <library.h>
#include <lammps.h>
#include <atom.h>
#include <fix.h>
#include <compute.h>
#include <modify.h>
#include <error.h>
#include <cstdlib>
using namespace LAMMPS_NS;
void lammps_open_fortran_wrapper (int argc, char **argv,
MPI_Fint communicator, void **ptr)
{
MPI_Comm C_communicator = MPI_Comm_f2c (communicator);
lammps_open (argc, argv, C_communicator, ptr);
}
int lammps_get_ntypes (void *ptr)
{
class LAMMPS *lmp = (class LAMMPS *) ptr;
int ntypes = lmp->atom->ntypes;
return ntypes;
}
void lammps_error_all (void *ptr, const char *file, int line, const char *str)
{
class LAMMPS *lmp = (class LAMMPS *) ptr;
lmp->error->all (file, line, str);
}
int lammps_extract_compute_vectorsize (void *ptr, char *id, int style)
{
int *size;
size = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_VECTOR);
if (size) return *size;
return 0;
}
void lammps_extract_compute_arraysize (void *ptr, char *id, int style,
int *nrows, int *ncols)
{
int *tmp;
tmp = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_ROWS);
if (tmp) *nrows = *tmp;
tmp = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_COLS);
if (tmp) *ncols = *tmp;
return;
}
int lammps_extract_fix_vectorsize (void *ptr, char *id, int style)
{
int *size;
size = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_VECTOR, 0, 0);
if (size) return *size;
return 0;
}
void lammps_extract_fix_arraysize (void *ptr, char *id, int style,
int *nrows, int *ncols)
{
int *tmp;
tmp = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_ROWS, 0, 0);
if (tmp) *nrows = *tmp;
tmp = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_COLS, 0, 0);
if (tmp) *ncols = *tmp;
return;
}
/* vim: set ts=3 sts=3 expandtab: */

41
examples/COUPLE/fortran2/LAMMPS-wrapper.h
View File

@ -1,41 +0,0 @@
/* -----------------------------------------------------------------------
LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
https://www.lammps.org/, Sandia National Laboratories
LAMMPS development team: developers@lammps.org
Copyright (2003) Sandia Corporation. Under the terms of Contract
DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
certain rights in this software. This software is distributed under
the GNU General Public License.
See the README file in the top-level LAMMPS directory.
------------------------------------------------------------------------- */
/* ------------------------------------------------------------------------
Contributing author: Karl D. Hammond <hammondkd@missouri.edu>
University of Missouri (USA), 2012
------------------------------------------------------------------------- */
/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself
provides a (I hope) robust Fortran interface to library.cpp and
library.h. All prototypes herein COULD be added to library.h instead of
including this as a separate file. See the README for instructions. */
#ifdef __cplusplus
extern "C" {
#endif
/* Prototypes for auxiliary functions */
void lammps_open_fortran_wrapper (int, char**, MPI_Fint, void**);
int lammps_get_ntypes (void*);
int lammps_extract_compute_vectorsize (void*, char*, int);
void lammps_extract_compute_arraysize (void*, char*, int, int*, int*);
int lammps_extract_fix_vectorsize (void*, char*, int);
void lammps_extract_fix_arraysize (void*, char*, int, int*, int*);
void lammps_error_all (void*, const char*, int, const char*);
#ifdef __cplusplus
}
#endif
/* vim: set ts=3 sts=3 expandtab: */

1788
examples/COUPLE/fortran2/LAMMPS.F90
View File

File diff suppressed because it is too large Load Diff

41
examples/COUPLE/fortran2/Makefile
View File

@ -1,41 +0,0 @@
SHELL = /bin/sh
# Path to LAMMPS extraction directory
LAMMPS_ROOT = ../../..
LAMMPS_SRC = $(LAMMPS_ROOT)/src
# Uncomment the line below if using the MPI stubs library
MPI_STUBS = #-I$(LAMMPS_SRC)/STUBS
FC = mpifort # replace with your Fortran compiler
CXX = mpicxx # replace with your C++ compiler
CXXLIB = -lstdc++ # replace with your C++ runtime libs
# Flags for Fortran compiler, C++ compiler, and C preprocessor, respectively
FFLAGS = -O2 -fPIC
CXXFLAGS = -O2 -fPIC
CPPFLAGS = -DOMPI_SKIP_MPICXX=1 -DMPICH_SKIP_MPICXX
all : liblammps_fortran.a liblammps_fortran.so
@echo "WARNING: this Fortran interface is obsolete and is no longer
maintained. See $(LAMMPS_ROOT)/fortran for the new, maintained interface
(largely written by the same author). You may continue to use this interface if
desired, but it may eventually be removed from LAMMPS."
liblammps_fortran.so : LAMMPS.o LAMMPS-wrapper.o
$(FC) $(FFLAGS) -shared -o $@ $^ $(CXXLIB)
liblammps_fortran.a : LAMMPS.o LAMMPS-wrapper.o
$(AR) rs $@ $^
LAMMPS.o lammps.mod : LAMMPS.F90
$(FC) $(CPPFLAGS) $(FFLAGS) -c $<
LAMMPS-wrapper.o : LAMMPS-wrapper.cpp LAMMPS-wrapper.h
$(CXX) $(CPPFLAGS) $(CXXFLAGS) -c $< -I$(LAMMPS_SRC) $(MPI_STUBS)
clean :
$(RM) *.o *.mod liblammps_fortran.a liblammps_fortran.so
dist :
tar -czf Fortran-interface.tar.gz LAMMPS-wrapper.h LAMMPS-wrapper.cpp LAMMPS.F90 makefile README

273
examples/COUPLE/fortran2/README
View File

@ -1,273 +0,0 @@
!! NOTE -------------------------------------------------------------------
! This interface is obsolete and may be removed in a future release of
! LAMMPS. The interface in fortran/lammps.f90 replaces this one. That API
! is maintained by the LAMMPS developers and has documentation written for
! it; it is based loosely on this one, but binds all procedures to a lammps
! derived type. That interface was written in large
! part by the same author, but is also supported by other developers.
!--------------------------------------------------------------------------
LAMMPS.F90 defines a Fortran 2003 module, LAMMPS, which wraps all functions in
src/library.h so they can be used directly from Fortran-encoded programs.
All functions in src/library.h that use and/or return C-style pointers have
Fortran wrapper functions that use Fortran-style arrays, pointers, and
strings; all C-style memory management is handled internally with no user
intervention. See --USE-- for notes on how this interface differs from the
C interface (and the Python interface).
This interface was created by Karl Hammond who you can contact with
questions:
Karl D. Hammond
University of Missouri
hammondkd at missouri.edu
-------------------------------------
--COMPILATION--
First, be advised that mixed-language programming is not trivial. It requires
you to link in the required libraries of all languages you use (in this case,
those for Fortran, C, and C++), as well as any other libraries required.
You are also advised to read the --USE-- section below before trying to
compile.
The following steps will work to compile this module (replace ${LAMMPS_SRC}
with the path to your LAMMPS source directory).
Steps 3-5 are accomplished, possibly after some modifications to
the makefile, by make using the attached makefile. Said makefile also builds
the dynamically-linkable library (liblammps_fortran.so).
** STATIC LIBRARY INSTRUCTIONS **
(1) Compile LAMMPS as a static library.
Call the resulting file ${LAMMPS_LIB}, which will have an actual name
like liblmp_openmpi.a. If compiling using the MPI stubs in
${LAMMPS_SRC}/STUBS, you will need to know where libmpi_stubs.a
is as well (I'll call it ${MPI_STUBS} hereafter)
(2) Copy said library to your Fortran program's source directory or replace
${LAMMPS_LIB} with its full path in the instructions below.
(3) Compile (but don't link!) LAMMPS.F90. Example:
mpifort -c LAMMPS.f90
OR
gfortran -c LAMMPS.F90
NOTE: you may get a warning such as,
subroutine lammps_open_wrapper (argc, argv, communicator, ptr) &
Variable 'communicator' at (1) is a parameter to the BIND(C)
procedure 'lammps_open_wrapper' but may not be C interoperable
This is normal (see --IMPLEMENTATION NOTES--).
(4) Compile (but don't link) LAMMPS-wrapper.cpp. You will need its header
file as well. You will have to provide the locations of LAMMPS's
header files. For example,
mpicxx -c -I${LAMMPS_SRC} LAMMPS-wrapper.cpp
OR
g++ -c -I${LAMMPS_SRC} -I${LAMMPS_SRC}/STUBS LAMMPS-wrapper.cpp
OR
icpc -c -I${LAMMPS_SRC} -I${LAMMPS_SRC}/STUBS LAMMPS-wrapper.cpp
(5) OPTIONAL: Make a library from the object files so you can carry around
two files instead of three. Example:
ar rs liblammps_fortran.a LAMMPS.o LAMMPS-wrapper.o
This will create the file liblammps_fortran.a that you can use in place
of "LAMMPS.o LAMMPS-wrapper.o" later. Note that you will still
need to have the .mod file from part (3).
It is also possible to add LAMMPS.o and LAMMPS-wrapper.o into the
LAMMPS library (e.g., liblmp_openmpi.a) instead of creating a separate
library, like so:
ar rs ${LAMMPS_LIB} LAMMPS.o LAMMPS-wrapper.o
In this case, you can now use the Fortran wrapper functions as if they
were part of the usual LAMMPS library interface (if you have the module
file visible to the compiler, that is).
(6) Compile (but don't link) your Fortran program. Example:
mpifort -c myfreeformatfile.f90
mpifort -c myfixedformatfile.f
OR
gfortran -c myfreeformatfile.f90
gfortran -c myfixedformatfile.f
The object files generated by these steps are collectively referred to
as ${my_object_files} in the next step(s).
IMPORTANT: If the Fortran module from part (3) is not in the current
directory or in one searched by the compiler for module files, you will
need to include that location via the -I flag to the compiler, like so:
mpifort -I${LAMMPS_SRC}/examples/COUPLE/fortran2 -c myfreeformatfile.f90
(7) Link everything together, including any libraries needed by LAMMPS (such
as the C++ standard library, the C math library, the JPEG library, fftw,
etc.) For example,
mpifort LAMMPS.o LAMMPS-wrapper.o ${my_object_files} \
${LAMMPS_LIB} -lmpi_cxx -lstdc++ -lm
OR
gfortran LAMMPS.o LAMMPS-wrapper.o ${my_object_files} \
${LAMMPS_LIB} ${MPI_STUBS} -lstdc++ -lm
OR
ifort LAMMPS.o LAMMPS-wrapper.o ${my_object_files} \
${LAMMPS_LIB} ${MPI_STUBS} -cxxlib -lm
Any other required libraries (e.g. -ljpeg, -lfftw) should be added to
the end of this line.
You should now have a working executable.
** DYNAMIC LIBRARY INSTRUCTIONS **
(1) Compile LAMMPS as a dynamic library
(make makeshlib && make -f Makefile.shlib [targetname]).
(2) Compile, but don't link, LAMMPS.F90 using the -fPIC flag, such as
mpifort -fPIC -c LAMMPS.f90
(3) Compile, but don't link, LAMMPS-wrapper.cpp in the same manner, e.g.
mpicxx -fPIC -c LAMMPS-wrapper.cpp
(4) Make the dynamic library, like so:
mpifort -fPIC -shared -o liblammps_fortran.so LAMMPS.o LAMMPS-wrapper.o
(5) Compile your program, such as,
mpifort -I${LAMMPS_SRC}/examples/COUPLE/fortran2 -c myfreeformatfile.f90
where ${LAMMPS_SRC}/examples/COUPLE/fortran2 contains the .mod file from
step (3)
(6) Link everything together, such as
mpifort ${my_object_files} -L${LAMMPS_SRC} \
-L${LAMMPS_SRC}/examples/COUPLE/fortran2 -llammps_fortran \
-llammps_openmpi -lmpi_cxx -lstdc++ -lm
If you wish to avoid the -L flags, add the directories containing your
shared libraries to the LIBRARY_PATH environment variable. At run time, you
will have to add these directories to LD_LIBRARY_PATH as well; otherwise,
your executable will not find the libraries it needs.
-------------------------------------
--USAGE--
To use this API, your program unit (PROGRAM/SUBROUTINE/FUNCTION/MODULE/etc.)
should look something like this:
program call_lammps
use LAMMPS
! Other modules, etc.
implicit none
type (lammps_instance) :: lmp ! This is a pointer to your LAMMPS instance
real (C_double) :: fix
real (C_double), dimension(:), pointer :: fix2
! Rest of declarations
call lammps_open_no_mpi ('lmp -in /dev/null -screen out.lammps',lmp)
! Set up rest of program here
call lammps_file (lmp, 'in.example')
call lammps_extract_fix (fix, lmp, '2', 0, 1, 1, 1)
call lammps_extract_fix (fix2, lmp, '4', 0, 2, 1, 1)
call lammps_close (lmp)
end program call_lammps
Important notes:
* Though I dislike the use of pointers, they are necessary when communicating
with C and C++, which do not support Fortran's ALLOCATABLE attribute.
* There is no need to deallocate C-allocated memory; this is done for you in
the cases when it is done (which are all cases when pointers are not
accepted, such as global fix data)
* All arguments which are char* variables in library.cpp are character (len=*)
variables here. For example,
call lammps_command (lmp, 'units metal')
will work as expected.
* The public functions (the only ones you can use) have interfaces as
described in the comments at the top of LAMMPS.F90. They are not always
the same as those in library.h, since C strings are replaced by Fortran
strings and the like.
* The module attempts to check whether you have done something stupid (such
as assign a 2D array to a scalar), but it's not perfect. For example, the
command
call lammps_extract_global (nlocal, ptr, 'nlocal')
will give nlocal correctly if nlocal is a pointer to type INTEGER, but it
will give the wrong answer if nlocal is a pointer to type REAL. This is a
feature of the (void*) type cast in library.cpp. There is no way I can
check this for you! It WILL catch you if you pass it an allocatable or
fixed-size array when it expects a pointer.
* Arrays constructed from temporary data from LAMMPS are ALLOCATABLE, and
represent COPIES of data, not the originals. Functions like
lammps_extract_atom, which return actual LAMMPS data, are pointers.
* IMPORTANT: Due to the differences between C and Fortran arrays (C uses
row-major vectors, Fortran uses column-major vectors), all arrays returned
from LAMMPS have their indices swapped.
* An example of a complete program, simple.f90, is included with this
package.
-------------------------------------
--TROUBLESHOOTING--
Compile-time errors (when compiling LAMMPS.F90, that is) probably indicate
that your compiler is not new enough to support Fortran 2003 features. For
example, GCC 4.1.2 will not compile this module, but GCC 4.4.0 will.
If your compiler balks at 'use, intrinsic :: ISO_C_binding,' try removing the
intrinsic part so it looks like an ordinary module. However, it is likely
that such a compiler will also have problems with everything else in the
file as well.
If you get a segfault as soon as the lammps_open call is made, check that you
compiled your program AND LAMMPS-wrapper.cpp using the same MPI headers. Using
the stubs for one and the actual MPI library for the other will cause Bad
Things to happen.
If you find run-time errors, please pass them along via the LAMMPS Users
mailing list (please CC me as well; address above). Please provide a minimal
working example along with the names and versions of the compilers you are
using. Please make sure the error is repeatable and is in MY code, not yours
(generating a minimal working example will usually ensure this anyway).
-------------------------------------
--IMPLEMENTATION NOTES--
The Fortran procedures have the same names as the C procedures, and
their purpose is the same, but they may take different arguments. Here are
some of the important differences:
* lammps_open and lammps_open_no_mpi take a string instead of argc and
argv. This is necessary because C and C++ have a very different way
of treating strings than Fortran. If you want the command line to be
passed to lammps_open (as it often would be from C/C++), use the
GET_COMMAND intrinsic to obtain it.
* All C++ functions that accept char* pointers now accept Fortran-style
strings within this interface instead.
* All of the lammps_extract_[something] functions, which return void*
C-style pointers, have been replaced by generic subroutines that return
Fortran variables (which may be arrays). The first argument houses the
variable/pointer to be returned (pretend it's on the left-hand side); all
other arguments are identical except as stipulated above.
Note that it is not possible to declare generic functions that are selected
based solely on the type/kind/rank (TKR) signature of the return value,
only based on the TKR of the arguments.
* The SHAPE of the first argument to lammps_extract_[something] is checked
against the "shape" of the C array (e.g., double vs. double* vs. double**).
Calling a subroutine with arguments of inappropriate rank will result in an
error at run time.
* The indices i and j in lammps_extract_fix are used the same way they
are in f_ID[i][j] references in LAMMPS (i.e., starting from 1). This is
different than the way library.cpp uses these numbers, but is more
consistent with the way arrays are accessed in LAMMPS and in Fortran.
* The char* pointer normally returned by lammps_command is thrown away
in this version; note also that lammps_command is now a subroutine
instead of a function.
* The pointer to LAMMPS itself is of type(lammps_instance), which is itself
a synonym for type(C_ptr), part of ISO_C_BINDING. Type (C_ptr) is
C's void* data type.
* This module will almost certainly generate a compile-time warning,
such as,
subroutine lammps_open_wrapper (argc, argv, communicator, ptr) &
Variable 'communicator' at (1) is a parameter to the BIND(C)
procedure 'lammps_open_wrapper' but may not be C interoperable
This happens because lammps_open_wrapper actually takes a Fortran
INTEGER argument, whose type is defined by the MPI library itself. The
Fortran integer is converted to a C integer by the MPI library (if such
conversion is actually necessary).
* lammps_extract_global returns COPIES of the (scalar) data, as does the
C version.
* lammps_extract_atom, lammps_extract_compute, and lammps_extract_fix
have a first argument that will be associated with ACTUAL LAMMPS DATA.
This means the first argument must be:
* The right rank (via the DIMENSION modifier)
* A C-interoperable POINTER type (i.e., INTEGER (C_int) or
REAL (C_double)).
* lammps_extract_variable returns COPIES of the data, as the C library
interface does. There is no need to deallocate using lammps_free.
* The 'data' argument to lammps_gather_atoms and lammps_scatter atoms must
be ALLOCATABLE. It should be of type INTEGER or DOUBLE PRECISION. It
does NOT need to be C inter-operable (and indeed should not be).
* The 'count' argument of lammps_scatter_atoms is unnecessary; the shape of
the array determines the number of elements LAMMPS will read.

16
examples/COUPLE/fortran2/in.simple
View File

@ -1,16 +0,0 @@
units lj
atom_modify map array
lattice bcc 1.0
region simbox block 0 10 0 10 0 10
create_box 2 simbox
create_atoms 1 region simbox
pair_style lj/cut 2.5
pair_coeff * * 1.0 1.0
mass 1 58.2 # These are made-up numbers
mass 2 28.3
velocity all create 1200.0 7474848 dist gaussian
fix 1 all nve
fix 2 all dt/reset 1 1E-5 1E-3 0.01 units box
fix 4 all ave/histo 10 5 100 0.5 1.5 50 f_2 file temp.histo ave running
thermo_style custom step dt temp press etotal f_4[1][1]
thermo 100

112
examples/COUPLE/fortran2/simple.f90
View File

@ -1,112 +0,0 @@
program simple
use MPI
use LAMMPS
! The following line is unnecessary, as I have included these three entities
! with the LAMMPS module, but I leave them in anyway to remind people where
! they came from
use, intrinsic :: ISO_C_binding, only : C_double, C_ptr, C_int
implicit none
! Notes:
! * If LAMMPS returns a scalar that is allocated by the library interface
! (see library.cpp), then that memory is deallocated automatically and
! the argument to lammps_extract_fix must be a SCALAR.
! * If LAMMPS returns a pointer to an array, consisting of internal LAMMPS
! data, then the argument must be an interoperable Fortran pointer.
! Interoperable means it is of type INTEGER (C_INT) or of type
! REAL (C_DOUBLE) in this context.
! * Pointers should NEVER be deallocated, as that would deallocate internal
! LAMMPS data!
! * Note that just because you can read the values of, say, a compute at
! any time does not mean those values represent the "correct" values.
! LAMMPS will abort you if you try to grab a pointer to a non-current
! entity, but once it's bound, it's your responsibility to check that
! it's current before evaluating.
! * IMPORTANT: Two-dimensional arrays (such as 'x' from extract_atom)
! will be transposed from what they might look like in C++. This is
! because of different bookkeeping conventions between Fortran and C
! that date back to about 1970 or so (when C was written).
! * Arrays start from 1, EXCEPT for mass from extract_atom, which
! starts from 0. This is because the C array actually has a blank
! first element (and thus mass[1] corresponds to the mass of type 1)
type (C_ptr) :: lmp
real (C_double), pointer :: compute => NULL()
real (C_double) :: fix, fix2
real (C_double), dimension(:), pointer :: compute_v => NULL()
real (C_double), dimension(:,:), pointer :: x => NULL()
real (C_double), dimension(:), pointer :: mass => NULL()
integer, dimension(:), allocatable :: types
double precision, dimension(:), allocatable :: r
integer :: error, narg, me, nprocs
character (len=1024) :: command_line
call MPI_Init (error)
call MPI_Comm_rank (MPI_COMM_WORLD, me, error)
call MPI_Comm_size (MPI_COMM_WORLD, nprocs, error)
! You are free to pass any string you like to lammps_open or
! lammps_open_no_mpi; here is how you pass it the command line
!call get_command (command_line)
!call lammps_open (command_line, MPI_COMM_WORLD, lmp)
! And here's how to to it with a string constant of your choice
call lammps_open_no_mpi ('lmp -log log.simple', lmp)
call lammps_file (lmp, 'in.simple')
call lammps_command (lmp, 'run 500')
! This extracts f_2 as a scalar (the last two arguments can be arbitrary)
call lammps_extract_fix (fix, lmp, '2', LMP_STYLE_GLOBAL, LMP_TYPE_SCALAR, 1, 1)
print *, 'Fix is ', fix
! This extracts f_4[1][1] as a scalar
call lammps_extract_fix (fix2, lmp, '4', LMP_STYLE_GLOBAL, LMP_TYPE_ARRAY, 1, 1)
print *, 'Fix 2 is ', fix2
! This extracts the scalar compute of compute thermo_temp
call lammps_extract_compute (compute, lmp, 'thermo_temp', LMP_STYLE_GLOBAL, LMP_TYPE_SCALAR)
print *, 'Compute is ', compute
! This extracts the vector compute of compute thermo_temp
call lammps_extract_compute (compute_v, lmp, 'thermo_temp', LMP_STYLE_GLOBAL, LMP_TYPE_VECTOR)
print *, 'Vector is ', compute_v
! This extracts the masses
call lammps_extract_atom (mass, lmp, 'mass')
print *, 'Mass is ', mass(1:)
! Extracts a pointer to the arrays of positions for all atoms
call lammps_extract_atom (x, lmp, 'x')
if ( .not. associated (x) ) print *, 'x is not associated'
print *, 'x is ', x(:,1) ! Prints x, y, z for atom 1
! Extracts pointer to atom types
call lammps_gather_atoms (lmp, 'type', 1, types)
print *, 'types is ', types(1:3)
! Allocates an array and assigns all positions to it
call lammps_gather_atoms (lmp, 'x', 3, r)
print *, 'natoms = ', int(lammps_get_natoms(lmp))
print *, 'size(r) = ', size(r)
print *, 'r is ', r(1:6)
! Puts those position data back
call lammps_scatter_atoms (lmp, 'x', r)
call lammps_command (lmp, 'run 1')
print *, 'x is ', x(:,1) ! Note that the position updates!
print *, 'Compute is ', compute ! This did only because "temp" is part of
! the thermo output; the vector part did
! not, and won't until we give LAMMPS a
! thermo output or other command that
! requires its value
call lammps_close (lmp)
call MPI_Finalize (error)
end program simple

96
examples/COUPLE/fortran_dftb/LAMMPS-wrapper.cpp
View File

@ -1,96 +0,0 @@
/* -----------------------------------------------------------------------
LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
https://www.lammps.org/, Sandia National Laboratories
LAMMPS development team: developers@lammps.org
Copyright (2003) Sandia Corporation. Under the terms of Contract
DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
certain rights in this software. This software is distributed under
the GNU General Public License.
See the README file in the top-level LAMMPS directory.
------------------------------------------------------------------------- */
/* ------------------------------------------------------------------------
Contributing author: Karl D. Hammond <hammondkd@missouri.edu>
University of Missouri (USA), 2012
------------------------------------------------------------------------- */
/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself
provides a (I hope) robust Fortran interface to library.cpp and
library.h. All functions herein COULD be added to library.cpp instead of
including this as a separate file. See the README for instructions. */
#include <mpi.h>
#include "LAMMPS-wrapper.h"
#define LAMMPS_LIB_MPI 1
#include <library.h>
#include <lammps.h>
#include <atom.h>
#include <fix.h>
#include <compute.h>
#include <modify.h>
#include <error.h>
#include <cstdlib>
using namespace LAMMPS_NS;
void lammps_open_fortran_wrapper (int argc, char **argv,
MPI_Fint communicator, void **ptr)
{
MPI_Comm C_communicator = MPI_Comm_f2c (communicator);
lammps_open (argc, argv, C_communicator, ptr);
}
int lammps_get_ntypes (void *ptr)
{
class LAMMPS *lmp = (class LAMMPS *) ptr;
int ntypes = lmp->atom->ntypes;
return ntypes;
}
void lammps_error_all (void *ptr, const char *file, int line, const char *str)
{
class LAMMPS *lmp = (class LAMMPS *) ptr;
lmp->error->all (file, line, str);
}
int lammps_extract_compute_vectorsize (void *ptr, char *id, int style)
{
int *size;
size = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_VECTOR);
if (size) return *size;
return 0;
}
void lammps_extract_compute_arraysize (void *ptr, char *id, int style,
int *nrows, int *ncols)
{
int *tmp;
tmp = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_ROWS);
if (tmp) *nrows = *tmp;
tmp = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_COLS);
if (tmp) *ncols = *tmp;
return;
}
int lammps_extract_fix_vectorsize (void *ptr, char *id, int style)
{
int *size;
size = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_VECTOR, 0, 0);
if (size) return *size;
return 0;
}
void lammps_extract_fix_arraysize (void *ptr, char *id, int style,
int *nrows, int *ncols)
{
int *tmp;
tmp = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_ROWS, 0, 0);
if (tmp) *nrows = *tmp;
tmp = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_COLS, 0, 0);
if (tmp) *ncols = *tmp;
return;
}
/* vim: set ts=3 sts=3 expandtab: */

40
examples/COUPLE/fortran_dftb/LAMMPS-wrapper.h
View File

@ -1,40 +0,0 @@
/* -----------------------------------------------------------------------
LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
https://www.lammps.org/, Sandia National Laboratories
LAMMPS development team: developers@lammps.org
Copyright (2003) Sandia Corporation. Under the terms of Contract
DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
certain rights in this software. This software is distributed under
the GNU General Public License.
See the README file in the top-level LAMMPS directory.
------------------------------------------------------------------------- */
/* ------------------------------------------------------------------------
Contributing author: Karl D. Hammond <hammondkd@missouri.edu>
University of Missouri (USA), 2012
------------------------------------------------------------------------- */
/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself
provides a (I hope) robust Fortran interface to library.cpp and
library.h. All prototypes herein COULD be added to library.h instead of
including this as a separate file. See the README for instructions. */
#ifdef __cplusplus
extern "C" {
#endif
/* Prototypes for auxiliary functions */
void lammps_open_fortran_wrapper (int, char**, MPI_Fint, void**);
int lammps_get_ntypes (void*);
int lammps_extract_compute_vectorsize (void*, char*, int);
void lammps_extract_compute_arraysize (void*, char*, int, int*, int*);
int lammps_extract_fix_vectorsize (void*, char*, int);
void lammps_extract_fix_arraysize (void*, char*, int, int*, int*);
void lammps_error_all (void*, const char*, int, const char*);
#ifdef __cplusplus
}
#endif
/* vim: set ts=3 sts=3 expandtab: */

80
examples/COUPLE/fortran_dftb/LAMMPS-wrapper2.cpp
View File

@ -1,80 +0,0 @@
/* -----------------------------------------------------------------------
LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
https://www.lammps.org/, Sandia National Laboratories
LAMMPS development team: developers@lammps.org
Copyright (2003) Sandia Corporation. Under the terms of Contract
DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
certain rights in this software. This software is distributed under
the GNU General Public License.
See the README file in the top-level LAMMPS directory.
------------------------------------------------------------------------- */
/* ------------------------------------------------------------------------
Contributing author: Nir Goldman, LLNL <ngoldman@llnl.gov>, 2016
------------------------------------------------------------------------- */
/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself
provides a (I hope) robust Fortran interface to library.cpp and
library.h. All functions herein COULD be added to library.cpp instead of
including this as a separate file. See the README for instructions. */
#include <mpi.h>
#include "LAMMPS-wrapper2.h"
#include <library.h>
#include <lammps.h>
#include <atom.h>
#include <input.h>
#include <modify.h>
#include <fix.h>
#include <fix_external.h>
#include <compute.h>
#include <modify.h>
#include <error.h>
#include <cstdlib>
using namespace LAMMPS_NS;
extern "C" void f_callback(void *, bigint, int, tagint *, double **, double **);
void lammps_set_callback (void *ptr) {
class LAMMPS *lmp = (class LAMMPS *) ptr;
int ifix = lmp->modify->find_fix_by_style("external");
FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix];
fix->set_callback(f_callback, ptr);
return;
}
void lammps_set_external_vector_length (void *ptr, int n) {
class LAMMPS *lmp = (class LAMMPS *) ptr;
int ifix = lmp->modify->find_fix_by_style("external");
FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix];
fix->set_vector_length(n);
return;
}
void lammps_set_external_vector (void *ptr, int n, double val) {
class LAMMPS *lmp = (class LAMMPS *) ptr;
int ifix = lmp->modify->find_fix_by_style("external");
FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix];
fix->set_vector (n, val);
return;
}
void lammps_set_user_energy (void *ptr, double energy) {
class LAMMPS *lmp = (class LAMMPS *) ptr;
int ifix = lmp->modify->find_fix_by_style("external");
FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix];
fix->set_energy_global(energy);
return;
}
void lammps_set_user_virial (void *ptr, double *virial) {
class LAMMPS *lmp = (class LAMMPS *) ptr;
int ifix = lmp->modify->find_fix_by_style("external");
FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix];
fix->set_virial_global(virial);
return;
}

37
examples/COUPLE/fortran_dftb/LAMMPS-wrapper2.h
View File

@ -1,37 +0,0 @@
/* -----------------------------------------------------------------------
LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
https://www.lammps.org/, Sandia National Laboratories
LAMMPS development team: developers@lammps.org
Copyright (2003) Sandia Corporation. Under the terms of Contract
DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
certain rights in this software. This software is distributed under
the GNU General Public License.
See the README file in the top-level LAMMPS directory.
------------------------------------------------------------------------- */
/* ------------------------------------------------------------------------
Contributing author: Nir Goldman, LLNL <ngoldman@llnl.gov>, 2016
------------------------------------------------------------------------- */
/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself
provides a (I hope) robust Fortran interface to library.cpp and
library.h. All prototypes herein COULD be added to library.h instead of
including this as a separate file. See the README for instructions. */
#ifdef __cplusplus
extern "C" {
#endif
/* Prototypes for auxiliary functions */
void lammps_set_callback (void *);
void lammps_set_user_energy (void*, double);
void lammps_set_user_virial (void*, double*);
void lammps_set_external_vector_length (void*, int);
void lammps_set_external_vector (void*, int, double);
#ifdef __cplusplus
}
#endif
/* vim: set ts=3 sts=3 expandtab: */

982
examples/COUPLE/fortran_dftb/LAMMPS.F90
View File

@ -1,982 +0,0 @@
!! -----------------------------------------------------------------------
! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator
! www.cs.sandia.gov/~sjplimp/lammps.html
! Steve Plimpton, sjplimp@sandia.gov, Sandia National Laboratories
!
! Copyright (2003) Sandia Corporation. Under the terms of Contract
! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
! certain rights in this software. This software is distributed under
! the GNU General Public License.
!
! See the README file in the top-level LAMMPS directory.
!--------------------------------------------------------------------------
!! ------------------------------------------------------------------------
! Contributing author: Karl D. Hammond <hammondkd@missouri.edu>
! University of Missouri (USA), 2012
!--------------------------------------------------------------------------
!! LAMMPS, a Fortran 2003 module containing an interface between Fortran
!! programs and the C-style functions in library.cpp that ship with LAMMPS.
!! This file should be accompanied by LAMMPS-wrapper.cpp and LAMMPS-wrapper.h,
!! which define wrapper functions that ease portability and enforce array
!! dimensions.
!!
!! Everything in this module should be 100% portable by way of Fortran 2003's
!! ISO_C_BINDING intrinsic module. See the README for instructions for
!! compilation and use.
!!
!! Here are the PUBLIC functions and subroutines included in this module.
!! subroutine lammps_open (command_line, communicator, ptr)
!! subroutine lammps_open_no_mpi (command_line, ptr)
!! subroutine lammps_close (ptr)
!! subroutine lammps_file (ptr, str)
!! subroutine lammps_command (ptr, str)
!! subroutine lammps_free (ptr)
!! subroutine lammps_extract_global (global, ptr, name)
!! subroutine lammps_extract_atom (atom, ptr, name)
!! subroutine lammps_extract_fix (fix, ptr, id, style, type, i, j)
!! subroutine lammps_extract_compute (compute, ptr, id, style, type)
!! subroutine lammps_extract_variable (variable, ptr, name, group)
!! function lammps_get_natoms (ptr)
!! subroutine lammps_gather_atoms (ptr, name, count, data)
!! subroutine lammps_scatter_atoms (ptr, name, data)
#define FLERR __FILE__,__LINE__
! The above line allows for similar error checking as is done with standard
! LAMMPS files.
module LAMMPS
use, intrinsic :: ISO_C_binding, only : C_double, C_int, C_ptr, C_char, &
C_NULL_CHAR, C_loc, C_F_pointer, lammps_instance => C_ptr
implicit none
private
public :: lammps_set_user_virial
public :: lammps_set_external_vector_length
public :: lammps_set_external_vector
public :: lammps_set_user_energy
public :: lammps_open, lammps_open_no_mpi, lammps_close, lammps_file, &
lammps_command, lammps_free, lammps_extract_global, &
lammps_extract_atom, lammps_extract_compute, lammps_extract_fix, &
lammps_extract_variable, lammps_get_natoms, lammps_gather_atoms, &
lammps_set_callback
public :: lammps_scatter_atoms, lammps_instance, C_ptr, C_double, C_int
!! Functions supplemental to the prototypes in library.h. {{{1
!! The function definitions (in C++) are contained in LAMMPS-wrapper.cpp.
!! I would have written the first in Fortran, but the MPI libraries (which
!! were written in C) have C-based functions to convert from Fortran MPI
!! handles to C MPI handles, and there is no Fortran equivalent for those
!! functions.
interface
subroutine lammps_open_wrapper (argc, argv, communicator, ptr) &
bind (C, name='lammps_open_fortran_wrapper')
import :: C_int, C_ptr
integer (C_int), value :: argc
type (C_ptr), dimension(*) :: argv
integer, value :: communicator
type (C_ptr) :: ptr
end subroutine lammps_open_wrapper
subroutine lammps_actual_error_all (ptr, file, line, str) &
bind (C, name='lammps_error_all')
import :: C_int, C_char, C_ptr
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*), intent(in) :: file, str
integer (C_int), value :: line
end subroutine lammps_actual_error_all
function lammps_get_ntypes (ptr) result (ntypes) &
bind (C, name='lammps_get_ntypes')
import :: C_int, C_ptr
type (C_ptr), value :: ptr
integer (C_int) :: ntypes
end function lammps_get_ntypes
function lammps_actual_extract_compute_vectorsize (ptr, id, style) &
result (vectorsize) bind (C, name='lammps_extract_compute_vectorsize')
import :: C_int, C_char, C_ptr
integer (C_int) :: vectorsize
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: id
integer (C_int), value :: style
end function lammps_actual_extract_compute_vectorsize
subroutine lammps_actual_extract_compute_arraysize (ptr, id, style, &
nrows, ncols) bind (C, name='lammps_extract_compute_arraysize')
import :: C_int, C_char, C_ptr
integer (C_int) :: arraysize
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: id
integer (C_int), value :: style
integer (C_int) :: nrows, ncols
end subroutine lammps_actual_extract_compute_arraysize
function lammps_actual_extract_fix_vectorsize (ptr, id, style) &
result (vectorsize) bind (C, name='lammps_extract_fix_vectorsize')
import :: C_int, C_char, C_ptr
integer (C_int) :: vectorsize
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: id
integer (C_int), value :: style
end function lammps_actual_extract_fix_vectorsize
subroutine lammps_actual_extract_fix_arraysize (ptr, id, style, &
nrows, ncols) bind (C, name='lammps_extract_fix_arraysize')
import :: C_int, C_char, C_ptr
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: id
integer (C_int), value :: style
integer (C_int) :: nrows, ncols
end subroutine lammps_actual_extract_fix_arraysize
end interface
!! Functions/subroutines defined in library.h and library.cpp {{{1
interface
subroutine lammps_actual_open_no_mpi (argc, argv, ptr) &
bind (C, name='lammps_open_no_mpi')
import :: C_int, C_ptr
integer (C_int), value :: argc
type (C_ptr), dimension(*) :: argv
type (C_ptr) :: ptr
end subroutine lammps_actual_open_no_mpi
subroutine lammps_close (ptr) bind (C, name='lammps_close')
import :: C_ptr
type (C_ptr), value :: ptr
end subroutine lammps_close
subroutine lammps_actual_file (ptr, str) bind (C, name='lammps_file')
import :: C_ptr, C_char
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: str
end subroutine lammps_actual_file
function lammps_actual_command (ptr, str) result (command) &
bind (C, name='lammps_command')
import :: C_ptr, C_char
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: str
type (C_ptr) :: command
end function lammps_actual_command
subroutine lammps_free (ptr) bind (C, name='lammps_free')
import :: C_ptr
type (C_ptr), value :: ptr
end subroutine lammps_free
function lammps_actual_extract_global (ptr, name) &
bind (C, name='lammps_extract_global') result (global)
import :: C_ptr, C_char
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: name
type (C_ptr) :: global
end function lammps_actual_extract_global
function lammps_actual_extract_atom (ptr, name) &
bind (C, name='lammps_extract_atom') result (atom)
import :: C_ptr, C_char
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: name
type (C_ptr) :: atom
end function lammps_actual_extract_atom
function lammps_actual_extract_compute (ptr, id, style, type) &
result (compute) bind (C, name='lammps_extract_compute')
import :: C_ptr, C_char, C_int
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: id
integer (C_int), value :: style, type
type (C_ptr) :: compute
end function lammps_actual_extract_compute
function lammps_actual_extract_fix (ptr, id, style, type, i, j) &
result (fix) bind (C, name='lammps_extract_fix')
import :: C_ptr, C_char, C_int
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: id
integer (C_int), value :: style, type, i, j
type (C_ptr) :: fix
end function lammps_actual_extract_fix
function lammps_actual_extract_variable (ptr, name, group) &
result (variable) bind (C, name='lammps_extract_variable')
import :: C_ptr, C_char
type (C_ptr), value :: ptr
character (kind=C_char), dimension(*) :: name, group
type (C_ptr) :: variable
end function lammps_actual_extract_variable
function lammps_get_natoms (ptr) result (natoms) &
bind (C, name='lammps_get_natoms')
import :: C_ptr, C_int
type (C_ptr), value :: ptr
integer (C_int) :: natoms
end function lammps_get_natoms
subroutine lammps_set_callback (ptr) &
bind (C, name='lammps_set_callback')
import :: C_ptr
type (C_ptr), value :: ptr
end subroutine lammps_set_callback
subroutine lammps_set_user_energy (ptr, energy) &
bind (C, name='lammps_set_user_energy')
import :: C_ptr, C_double
type (C_ptr), value :: ptr
real(C_double), value :: energy
end subroutine lammps_set_user_energy
subroutine lammps_set_user_virial (ptr, virial) &
bind (C, name='lammps_set_user_virial')
import :: C_ptr, C_double
type (C_ptr), value :: ptr
real(C_double) :: virial(6)
end subroutine lammps_set_user_virial
subroutine lammps_set_external_vector_length (ptr, n) &
bind (C, name='lammps_set_external_vector_length')
import :: C_ptr, C_double, C_int
type(C_ptr), value :: ptr
integer (C_int), value :: n
end subroutine lammps_set_external_vector_length
subroutine lammps_set_external_vector (ptr, n, val) &
bind (C, name='lammps_set_external_vector')
import :: C_ptr, C_int, C_double
type (C_ptr), value :: ptr
integer (C_int), value :: n
real(C_double), value :: val
end subroutine lammps_set_external_vector
subroutine lammps_actual_gather_atoms (ptr, name, type, count, data) &
bind (C, name='lammps_gather_atoms')
import :: C_ptr, C_int, C_char
type (C_ptr), value :: ptr, data
character (kind=C_char), dimension(*) :: name
integer (C_int), value :: type, count
end subroutine lammps_actual_gather_atoms
subroutine lammps_actual_scatter_atoms (ptr, name, type, count, data) &
bind (C, name='lammps_scatter_atoms')
import :: C_ptr, C_int, C_char
type (C_ptr), value :: ptr, data
character (kind=C_char), dimension(*) :: name
integer (C_int), value :: type, count
end subroutine lammps_actual_scatter_atoms
end interface
! Generic functions for the wrappers below {{{1
interface lammps_extract_global
module procedure lammps_extract_global_i, &
lammps_extract_global_dp
end interface lammps_extract_global
interface lammps_extract_atom
module procedure lammps_extract_atom_ia, &
lammps_extract_atom_dpa, &
lammps_extract_atom_dp2a
end interface lammps_extract_atom
interface lammps_extract_compute
module procedure lammps_extract_compute_dp, &
lammps_extract_compute_dpa, &
lammps_extract_compute_dp2a
end interface lammps_extract_compute
interface lammps_extract_fix
module procedure lammps_extract_fix_dp, &
lammps_extract_fix_dpa, &
lammps_extract_fix_dp2a
end interface lammps_extract_fix
interface lammps_extract_variable
module procedure lammps_extract_variable_dp, &
lammps_extract_variable_dpa
end interface lammps_extract_variable
interface lammps_gather_atoms
module procedure lammps_gather_atoms_ia, lammps_gather_atoms_dpa
end interface lammps_gather_atoms
interface lammps_scatter_atoms
module procedure lammps_scatter_atoms_ia, lammps_scatter_atoms_dpa
end interface lammps_scatter_atoms
contains !! Wrapper functions local to this module {{{1
subroutine lammps_open (command_line, communicator, ptr)
character (len=*), intent(in) :: command_line
integer, intent(in) :: communicator
type (C_ptr) :: ptr
integer (C_int) :: argc
type (C_ptr), dimension(:), allocatable :: argv
character (kind=C_char), dimension(len_trim(command_line)+1), target :: &
c_command_line
c_command_line = string2Cstring (command_line)
call Cstring2argcargv (c_command_line, argc, argv)
call lammps_open_wrapper (argc, argv, communicator, ptr)
deallocate (argv)
end subroutine lammps_open
!-----------------------------------------------------------------------------
subroutine lammps_open_no_mpi (command_line, ptr)
character (len=*), intent(in) :: command_line
type (C_ptr) :: ptr
integer (C_int) :: argc
type (C_ptr), dimension(:), allocatable :: argv
character (kind=C_char), dimension(len_trim(command_line)+1), target :: &
c_command_line
c_command_line = string2Cstring (command_line)
call Cstring2argcargv (c_command_line, argc, argv)
call lammps_actual_open_no_mpi (argc, argv, ptr)
deallocate (argv)
end subroutine lammps_open_no_mpi
!-----------------------------------------------------------------------------
subroutine lammps_file (ptr, str)
type (C_ptr) :: ptr
character (len=*) :: str
character (kind=C_char), dimension(len_trim(str)+1) :: Cstr
Cstr = string2Cstring (str)
call lammps_actual_file (ptr, Cstr)
end subroutine lammps_file
!-----------------------------------------------------------------------------
subroutine lammps_command (ptr, str)
type (C_ptr) :: ptr
character (len=*) :: str
character (kind=C_char), dimension(len_trim(str)+1) :: Cstr
type (C_ptr) :: dummy
Cstr = string2Cstring (str)
dummy = lammps_actual_command (ptr, Cstr)
end subroutine lammps_command
!-----------------------------------------------------------------------------
! lammps_extract_global {{{2
function lammps_extract_global_Cptr (ptr, name) result (global)
type (C_ptr) :: global
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
character (kind=C_char), dimension(len_trim(name)+1) :: Cname
Cname = string2Cstring (name)
global = lammps_actual_extract_global (ptr, Cname)
end function lammps_extract_global_Cptr
subroutine lammps_extract_global_i (global, ptr, name)
integer (C_int), pointer, intent(out) :: global
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
type (C_ptr) :: Cptr
Cptr = lammps_extract_global_Cptr (ptr, name)
call C_F_pointer (Cptr, global)
end subroutine lammps_extract_global_i
subroutine lammps_extract_global_dp (global, ptr, name)
real (C_double), pointer, intent(out) :: global
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
type (C_ptr) :: Cptr
Cptr = lammps_extract_global_Cptr (ptr, name)
call C_F_pointer (Cptr, global)
end subroutine lammps_extract_global_dp
!-----------------------------------------------------------------------------
! lammps_extract_atom {{{2
function lammps_extract_atom_Cptr (ptr, name) result (atom)
type (C_ptr) :: atom
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
character (kind=C_char), dimension(len_trim(name)+1) :: Cname
Cname = string2Cstring (name)
atom = lammps_actual_extract_atom (ptr, Cname)
end function lammps_extract_atom_Cptr
subroutine lammps_extract_atom_ia (atom, ptr, name)
integer (C_int), dimension(:), pointer, intent(out) :: atom
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
type (C_ptr) :: Cptr
integer (C_int), pointer :: nelements
call lammps_extract_global_i (nelements, ptr, 'nlocal')
Cptr = lammps_extract_atom_Cptr (ptr, name)
call C_F_pointer (Cptr, atom, (/nelements/))
end subroutine lammps_extract_atom_ia
subroutine lammps_extract_atom_dpa (atom, ptr, name)
real (C_double), dimension(:), pointer, intent(out) :: atom
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
type (C_ptr) :: Cptr
integer (C_int), pointer :: nlocal
integer :: nelements
real (C_double), dimension(:), pointer :: Fptr
if ( name == 'mass' ) then
nelements = lammps_get_ntypes (ptr) + 1
else if ( name == 'x' .or. name == 'v' .or. name == 'f' .or. &
name == 'mu' .or. name == 'omega' .or. name == 'torque' .or. &
name == 'angmom' ) then
! We should not be getting a rank-2 array here!
call lammps_error_all (ptr, FLERR, 'You cannot extract those atom&
& data (' // trim(name) // ') into a rank 1 array.')
return
else
! Everything else we can get is probably nlocal units long
call lammps_extract_global_i (nlocal, ptr, 'nlocal')
nelements = nlocal
end if
Cptr = lammps_extract_atom_Cptr (ptr, name)
call C_F_pointer (Cptr, Fptr, (/nelements/))
if ( name == 'mass' ) then
!atom(0:) => Fptr
atom => Fptr
else
atom => Fptr
end if
end subroutine lammps_extract_atom_dpa
subroutine lammps_extract_atom_dp2a (atom, ptr, name)
real (C_double), dimension(:,:), pointer, intent(out) :: atom
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
type (C_ptr) :: Cptr
type (C_ptr), pointer, dimension(:) :: Catom
integer (C_int), pointer :: nelements
if ( name /= 'x' .and. name /= 'v' .and. name /= 'f' .and. &
name /= 'mu' .and. name /= 'omega' .and. name /= 'tandque' .and. &
name /= 'angmom' .and. name /= 'fexternal' ) then
! We should not be getting a rank-2 array here!
call lammps_error_all (ptr, FLERR, 'You cannot extract those atom&
& data (' // trim(name) // ') into a rank 2 array.')
return
end if
Cptr = lammps_extract_atom_Cptr (ptr, name)
call lammps_extract_global_i (nelements, ptr, 'nlocal')
! Catom will now be the array of void* pointers that the void** pointer
! pointed to. Catom(1) is now the pointer to the first element.
call C_F_pointer (Cptr, Catom, (/nelements/))
! Now get the actual array, which has its shape transposed from what we
! might think of it in C
call C_F_pointer (Catom(1), atom, (/3, nelements/))
end subroutine lammps_extract_atom_dp2a
!-----------------------------------------------------------------------------
! lammps_extract_compute {{{2
function lammps_extract_compute_Cptr (ptr, id, style, type) result (compute)
type (C_ptr) :: compute
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style, type
integer (kind=C_int) :: Cstyle, Ctype
character (kind=C_char), dimension(len_trim(id)+1) :: Cid
Cid = string2Cstring (id)
Cstyle = style
Ctype = type
compute = lammps_actual_extract_compute (ptr, Cid, Cstyle, Ctype)
end function lammps_extract_compute_Cptr
subroutine lammps_extract_compute_dp (compute, ptr, id, style, type)
real (C_double), pointer, intent(out) :: compute
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style, type
type (C_ptr) :: Cptr
! The only valid values of (style,type) are (0,0) for scalar 'compute'
if ( style /= 0 ) then
call lammps_error_all (ptr, FLERR, 'You cannot pack per-atom/local&
& data into a scalar.')
return
end if
if ( type == 1 ) then
call lammps_error_all (ptr, FLERR, 'You cannot extract a compute&
& vector (rank 1) into a scalar.')
return
else if ( type == 2 ) then
call lammps_error_all (ptr, FLERR, 'You cannot extract a compute&
& array (rank 2) into a scalar.')
return
end if
Cptr = lammps_extract_compute_Cptr (ptr, id, style, type)
call C_F_pointer (Cptr, compute)
end subroutine lammps_extract_compute_dp
subroutine lammps_extract_compute_dpa (compute, ptr, id, style, type)
real (C_double), dimension(:), pointer, intent(out) :: compute
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style, type
type (C_ptr) :: Cptr
integer :: nelements
! Check for the correct dimensionality
if ( type == 0 ) then
call lammps_error_all (ptr, FLERR, 'You cannot extract a compute&
& scalar (rank 0) into a rank 1 variable.')
return
else if ( type == 2 ) then
call lammps_error_all (ptr, FLERR, 'You cannot extract a compute&
& array (rank 2) into a rank 1 variable.')
return
end if
nelements = lammps_extract_compute_vectorsize (ptr, id, style)
Cptr = lammps_extract_compute_Cptr (ptr, id, style, type)
call C_F_pointer (Cptr, compute, (/nelements/))
end subroutine lammps_extract_compute_dpa
subroutine lammps_extract_compute_dp2a (compute, ptr, id, style, type)
real (C_double), dimension(:,:), pointer, intent(out) :: compute
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style, type
type (C_ptr) :: Cptr
type (C_ptr), pointer, dimension(:) :: Ccompute
integer :: nr, nc
! Check for the correct dimensionality
if ( type == 0 ) then
call lammps_error_all (ptr, FLERR, 'You cannot extract a compute&
& scalar (rank 0) into a rank 2 variable.')
return
else if ( type == 1 ) then
call lammps_error_all (ptr, FLERR, 'You cannot extract a compute&
& array (rank 1) into a rank 2 variable.')
return
end if
call lammps_extract_compute_arraysize (ptr, id, style, nr, nc)
Cptr = lammps_extract_compute_Cptr (ptr, id, style, type)
call C_F_pointer (Cptr, Ccompute, (/nr/))
! Note that the matrix is transposed, from Fortran's perspective
call C_F_pointer (Ccompute(1), compute, (/nc, nr/))
end subroutine lammps_extract_compute_dp2a
!-----------------------------------------------------------------------------
! lammps_extract_fix {{{2
function lammps_extract_fix_Cptr (ptr, id, style, type, i, j) &
result (fix)
type (C_ptr) :: fix
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style, type, i, j
character (kind=C_char), dimension(len_trim(id)+1) :: Cid
integer (kind=C_int) :: Cstyle, Ctype, Ci, Cj
Cid = string2Cstring (id)
Cstyle = style
Ctype = type
Ci = i - 1 ! This is for consistency with the values from f_ID[i],
Cj = j - 1 ! which is different from what library.cpp uses!
if ( (type >= 1 .and. Ci < 0) .or. &
(type == 2 .and. (Ci < 0 .or. Cj < 0) ) ) then
call lammps_error_all (ptr, FLERR, 'Index out of range in&
& lammps_extract_fix')
end if
fix = lammps_actual_extract_fix (ptr, Cid, Cstyle, Ctype, Ci, Cj)
end function lammps_extract_fix_Cptr
subroutine lammps_extract_fix_dp (fix, ptr, id, style, type, i, j)
real (C_double), intent(out) :: fix
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style, type, i, j
type (C_ptr) :: Cptr
real (C_double), pointer :: Fptr
! Check for the correct dimensionality
if ( style /= 0 ) then
select case (type)
case (0)
call lammps_error_all (ptr, FLERR, 'There is no per-atom or local&
& scalar data available from fixes.')
case (1)
call lammps_error_all (ptr, FLERR, 'You cannot extract a fix''s &
&per-atom/local vector (rank 1) into a scalar.')
case (2)
call lammps_error_all (ptr, FLERR, 'You cannot extract a fix''s &
&per-atom/local array (rank 2) into a scalar.')
case default
call lammps_error_all (ptr, FLERR, 'Invalid extract_fix style/&
&type combination.')
end select
return
end if
Cptr = lammps_extract_fix_Cptr (ptr, id, style, type, i, j)
call C_F_pointer (Cptr, Fptr)
fix = Fptr
nullify (Fptr)
! Memory is only allocated for "global" fix variables
if ( style == 0 ) call lammps_free (Cptr)
end subroutine lammps_extract_fix_dp
subroutine lammps_extract_fix_dpa (fix, ptr, id, style, type, i, j)
real (C_double), dimension(:), pointer, intent(out) :: fix
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style, type, i, j
type (C_ptr) :: Cptr
integer :: fix_len
! Check for the correct dimensionality
if ( style == 0 ) then
call lammps_error_all (ptr, FLERR, 'You can''t extract the&
& whole vector from global fix data')
return
else if ( type == 0 ) then
call lammps_error_all (ptr, FLERR, 'You can''t extract a fix&
& scalar into a rank 1 variable')
return
else if ( type == 2 ) then
call lammps_error_all (ptr, FLERR, 'You cannot extract a fix&
& array into a rank 1 variable.')
return
else if ( type /= 1 ) then
call lammps_error_all (ptr, FLERR, 'Invalid type for fix extraction.')
return
end if
fix_len = lammps_extract_fix_vectorsize (ptr, id, style)
call C_F_pointer (Cptr, fix, (/fix_len/))
! Memory is only allocated for "global" fix variables, which we should
! never get here, so no need to call lammps_free!
end subroutine lammps_extract_fix_dpa
subroutine lammps_extract_fix_dp2a (fix, ptr, id, style, type, i, j)
real (C_double), dimension(:,:), pointer, intent(out) :: fix
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style, type, i, j
type (C_ptr) :: Cptr
type (C_ptr), pointer, dimension(:) :: Cfix
integer :: nr, nc
! Check for the correct dimensionality
if ( style == 0 ) then
call lammps_error_all (ptr, FLERR, 'It is not possible to extract the&
& entire array from global fix data.')
return
else if ( type == 0 ) then
call lammps_error_all (ptr, FLERR, 'You cannot extract a fix&
& scalar (rank 0) into a rank 2 variable.')
return
else if ( type == 1 ) then
call lammps_error_all (ptr, FLERR, 'You cannot extract a fix&
& vector (rank 1) into a rank 2 variable.')
return
end if
call lammps_extract_fix_arraysize (ptr, id, style, nr, nc)
! Extract pointer to first element as Cfix(1)
call C_F_pointer (Cptr, Cfix, (/nr/))
! Now extract the array, which is transposed
call C_F_pointer (Cfix(1), fix, (/nc, nr/))
end subroutine lammps_extract_fix_dp2a
!-----------------------------------------------------------------------------
! lammps_extract_variable {{{2
function lammps_extract_variable_Cptr (ptr, name, group) result (variable)
type (C_ptr) :: ptr, variable
character (len=*) :: name
character (len=*), optional :: group
character (kind=C_char), dimension(len_trim(name)+1) :: Cname
character (kind=C_char), dimension(:), allocatable :: Cgroup
Cname = string2Cstring (name)
if ( present(group) ) then
allocate (Cgroup(len_trim(group)+1))
Cgroup = string2Cstring (group)
else
allocate (Cgroup(1))
Cgroup(1) = C_NULL_CHAR
end if
variable = lammps_actual_extract_variable (ptr, Cname, Cgroup)
deallocate (Cgroup)
end function lammps_extract_variable_Cptr
subroutine lammps_extract_variable_dp (variable, ptr, name, group)
real (C_double), intent(out) :: variable
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
character (len=*), intent(in), optional :: group
type (C_ptr) :: Cptr
real (C_double), pointer :: Fptr
if ( present(group) ) then
Cptr = lammps_extract_variable_Cptr (ptr, name, group)
else
Cptr = lammps_extract_variable_Cptr (ptr, name)
end if
call C_F_pointer (Cptr, Fptr)
variable = Fptr
nullify (Fptr)
call lammps_free (Cptr)
end subroutine lammps_extract_variable_dp
subroutine lammps_extract_variable_dpa (variable, ptr, name, group)
real (C_double), dimension(:), allocatable, intent(out) :: variable
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
character (len=*), intent(in), optional :: group
type (C_ptr) :: Cptr
real (C_double), dimension(:), pointer :: Fptr
integer :: natoms
if ( present(group) ) then
Cptr = lammps_extract_variable_Cptr (ptr, name, group)
else
Cptr = lammps_extract_variable_Cptr (ptr, name)
end if
natoms = lammps_get_natoms (ptr)
allocate (variable(natoms))
call C_F_pointer (Cptr, Fptr, (/natoms/))
variable = Fptr
nullify (Fptr)
call lammps_free (Cptr)
end subroutine lammps_extract_variable_dpa
!-------------------------------------------------------------------------2}}}
subroutine lammps_gather_atoms_ia (ptr, name, count, data)
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
integer, intent(in) :: count
integer, dimension(:), allocatable, intent(out) :: data
type (C_ptr) :: Cdata
integer (C_int), dimension(:), pointer :: Fdata
integer (C_int) :: natoms
character (kind=C_char), dimension(len_trim(name)+1) :: Cname
integer (C_int), parameter :: Ctype = 0_C_int
integer (C_int) :: Ccount
natoms = lammps_get_natoms (ptr)
Cname = string2Cstring (name)
if ( count /= 1 .and. count /= 3 ) then
call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires&
& count to be either 1 or 3')
else
Ccount = count
end if
allocate ( Fdata(count*natoms) )
allocate ( data(count*natoms) )
Cdata = C_loc (Fdata(1))
call lammps_actual_gather_atoms (ptr, Cname, Ctype, Ccount, Cdata)
data = Fdata
deallocate (Fdata)
end subroutine lammps_gather_atoms_ia
subroutine lammps_gather_atoms_dpa (ptr, name, count, data)
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
integer, intent(in) :: count
double precision, dimension(:), allocatable, intent(out) :: data
type (C_ptr) :: Cdata
real (C_double), dimension(:), pointer :: Fdata
integer (C_int) :: natoms
character (kind=C_char), dimension(len_trim(name)+1) :: Cname
integer (C_int), parameter :: Ctype = 1_C_int
integer (C_int) :: Ccount
natoms = lammps_get_natoms (ptr)
Cname = string2Cstring (name)
if ( count /= 1 .and. count /= 3 ) then
call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires&
& count to be either 1 or 3')
else
Ccount = count
end if
allocate ( Fdata(count*natoms) )
allocate ( data(count*natoms) )
Cdata = C_loc (Fdata(1))
call lammps_actual_gather_atoms (ptr, Cname, Ctype, Ccount, Cdata)
data = Fdata(:)
deallocate (Fdata)
end subroutine lammps_gather_atoms_dpa
!-----------------------------------------------------------------------------
subroutine lammps_scatter_atoms_ia (ptr, name, data)
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
integer, dimension(:), intent(in) :: data
integer (kind=C_int) :: natoms, Ccount
integer (kind=C_int), parameter :: Ctype = 0_C_int
character (kind=C_char), dimension(len_trim(name)+1) :: Cname
integer (C_int), dimension(size(data)), target :: Fdata
type (C_ptr) :: Cdata
natoms = lammps_get_natoms (ptr)
Cname = string2Cstring (name)
Ccount = size(data) / natoms
if ( Ccount /= 1 .and. Ccount /= 3 ) &
call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires&
& count to be either 1 or 3')
Fdata = data
Cdata = C_loc (Fdata(1))
call lammps_actual_scatter_atoms (ptr, Cname, Ctype, Ccount, Cdata)
end subroutine lammps_scatter_atoms_ia
subroutine lammps_scatter_atoms_dpa (ptr, name, data)
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: name
double precision, dimension(:), intent(in) :: data
integer (kind=C_int) :: natoms, Ccount
integer (kind=C_int), parameter :: Ctype = 1_C_int
character (kind=C_char), dimension(len_trim(name)+1) :: Cname
real (C_double), dimension(size(data)), target :: Fdata
type (C_ptr) :: Cdata
natoms = lammps_get_natoms (ptr)
Cname = string2Cstring (name)
Ccount = size(data) / natoms
if ( Ccount /= 1 .and. Ccount /= 3 ) &
call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires&
& count to be either 1 or 3')
Fdata = data
Cdata = C_loc (Fdata(1))
call lammps_actual_scatter_atoms (ptr, Cname, Ctype, Ccount, Cdata)
end subroutine lammps_scatter_atoms_dpa
!-----------------------------------------------------------------------------
function lammps_extract_compute_vectorsize (ptr, id, style) &
result (vectorsize)
integer :: vectorsize
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style
integer (C_int) :: Cvectorsize, Cstyle
character (kind=C_char), dimension(len_trim(id)+1) :: Cid
Cid = string2Cstring (id)
Cstyle = int(style, C_int)
Cvectorsize = lammps_actual_extract_compute_vectorsize (ptr, Cid, Cstyle)
vectorsize = int(Cvectorsize, kind(vectorsize))
end function lammps_extract_compute_vectorsize
!-----------------------------------------------------------------------------
function lammps_extract_fix_vectorsize (ptr, id, style) &
result (vectorsize)
integer :: vectorsize
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style
integer (C_int) :: Cvectorsize, Cstyle
character (kind=C_char), dimension(len_trim(id)+1) :: Cid
Cid = string2Cstring (id)
Cstyle = int(style, C_int)
Cvectorsize = lammps_actual_extract_fix_vectorsize (ptr, Cid, Cstyle)
vectorsize = int(Cvectorsize, kind(vectorsize))
end function lammps_extract_fix_vectorsize
!-----------------------------------------------------------------------------
subroutine lammps_extract_compute_arraysize (ptr, id, style, nrows, ncols)
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style
integer, intent(out) :: nrows, ncols
integer (C_int) :: Cstyle, Cnrows, Cncols
character (kind=C_char), dimension(len_trim(id)+1) :: Cid
Cid = string2Cstring (id)
Cstyle = int (style, C_int)
call lammps_actual_extract_compute_arraysize (ptr, Cid, Cstyle, &
Cnrows, Cncols)
nrows = int (Cnrows, kind(nrows))
ncols = int (Cncols, kind(ncols))
end subroutine lammps_extract_compute_arraysize
!-----------------------------------------------------------------------------
subroutine lammps_extract_fix_arraysize (ptr, id, style, nrows, ncols)
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: id
integer, intent(in) :: style
integer, intent(out) :: nrows, ncols
integer (C_int) :: Cstyle, Cnrows, Cncols
character (kind=C_char), dimension(len_trim(id)+1) :: Cid
Cid = string2Cstring (id)
Cstyle = int (style, kind(Cstyle))
call lammps_actual_extract_fix_arraysize (ptr, Cid, Cstyle, &
Cnrows, Cncols)
nrows = int (Cnrows, kind(nrows))
ncols = int (Cncols, kind(ncols))
end subroutine lammps_extract_fix_arraysize
!-----------------------------------------------------------------------------
subroutine lammps_error_all (ptr, file, line, str)
type (C_ptr), intent(in) :: ptr
character (len=*), intent(in) :: file, str
integer, intent(in) :: line
character (kind=C_char), dimension(len_trim(file)+1) :: Cfile
character (kind=C_char), dimension(len_trim(str)+1) :: Cstr
integer (C_int) :: Cline
Cline = int(line, kind(Cline))
Cfile = string2Cstring (file)
Cstr = string2Cstring (str)
call lammps_actual_error_all (ptr, Cfile, Cline, Cstr)
end subroutine lammps_error_all
!-----------------------------------------------------------------------------
! Locally defined helper functions {{{1
pure function string2Cstring (string) result (C_string)
use, intrinsic :: ISO_C_binding, only : C_char, C_NULL_CHAR
character (len=*), intent(in) :: string
character (len=1, kind=C_char) :: C_string (len_trim(string)+1)
integer :: i, n
n = len_trim (string)
forall (i = 1:n)
C_string(i) = string(i:i)
end forall
C_string(n+1) = C_NULL_CHAR
end function string2Cstring
!-----------------------------------------------------------------------------
subroutine Cstring2argcargv (Cstring, argc, argv)
!! Converts a C-style string to argc and argv, that is, words in Cstring
!! become C-style strings in argv. IMPORTANT: Cstring is modified by
!! this routine! I would make Cstring local TO this routine and accept
!! a Fortran-style string instead, but we run into scoping and
!! allocation problems that way. This routine assumes the string is
!! null-terminated, as all C-style strings must be.
character (kind=C_char), dimension(*), target, intent(inout) :: Cstring
integer (C_int), intent(out) :: argc
type (C_ptr), dimension(:), allocatable, intent(out) :: argv
integer :: StringStart, SpaceIndex, strlen, argnum
argc = 1_C_int
! Find the length of the string
strlen = 1
do while ( Cstring(strlen) /= C_NULL_CHAR )
strlen = strlen + 1
end do
! Find the number of non-escaped spaces
SpaceIndex = 2
do while ( SpaceIndex < strlen )
if ( Cstring(SpaceIndex) == ' ' .and. &
Cstring(SpaceIndex-1) /= '\' ) then
argc = argc + 1_C_int
! Find the next non-space character
do while ( Cstring(SpaceIndex+1) == ' ')
SpaceIndex = SpaceIndex + 1
end do
end if
SpaceIndex = SpaceIndex + 1
end do
! Now allocate memory for argv
allocate (argv(argc))
! Now find the string starting and ending locations
StringStart = 1
SpaceIndex = 2
argnum = 1
do while ( SpaceIndex < strlen )
if ( Cstring(SpaceIndex) == ' ' .and. &
Cstring(SpaceIndex-1) /= '\' ) then
! Found a real space => split strings and store this one
Cstring(Spaceindex) = C_NULL_CHAR ! Replaces space with NULL
argv(argnum) = C_loc(Cstring(StringStart))
argnum = argnum + 1
! Find the next non-space character
do while ( Cstring(SpaceIndex+1) == ' ')
SpaceIndex = SpaceIndex + 1
end do
StringStart = SpaceIndex + 1
else if ( Cstring(SpaceIndex) == ' ' .and. &
Cstring(SpaceIndex-1) == '\' ) then
! Escaped space => remove backslash and move rest of array
Cstring(SpaceIndex-1:strlen-1) = Cstring(SpaceIndex:strlen)
strlen = strlen - 1 ! Last character is still C_NULL_CHAR
end if
SpaceIndex = SpaceIndex + 1
end do
! Now handle the last argument
argv(argnum) = C_loc(Cstring(StringStart))
end subroutine Cstring2argcargv
! 1}}}
end module LAMMPS
! vim: foldmethod=marker tabstop=3 softtabstop=3 shiftwidth=3 expandtab

37
examples/COUPLE/fortran_dftb/README
View File

@ -1,37 +0,0 @@
This directory has an example of using a callback function to obtain
forces from a fortran code for a LAMMPS simulation. The reader should
refer to the README file in COUPLE/fortran2 before proceeding. Here,
the LAMMPS.F90 file has been modified slightly and additional files
named LAMMPS-wrapper2.h and LAMMPS-wrapper2.cpp have been included in
order to supply wrapper functions to set the LAMMPS callback function,
total energy, virial, and electronic entropy contribution (needed for
MSST simulations with a quantum code).
In this example, the callback function is set to run the
semi-empirical quantum code DFTB+ in serial and then read in the total
energy, forces, and stress tensor from file. In this case, nlocal =
the total number of atoms in the system, so particle positions can be
read from the pos array directly, and DFTB+ forces can simply be
included via the fext array. The user should take care in the case of
a parallel calculation, where LAMMPS can assign different particules
to each processor. For example, the user should use functions such as
lammps_gather_atoms() and lammps_scatter_atoms() in the case where the
fortran force calculating code requires the positions of all atoms,
etc.
A few more important notes:
-Calling the subroutine lammps_set_callback() is required in order to set
a pointer to the callback function in LAMMPS.
-The subroutine lammps_set_user_energy() passes in the potential energy
from DFTB+ to LAMMPS. Similarly, lammps_set_user_virial passes the stress tensor.
-The electronic entropy contribution is set via lammps_set_external_vector(). Their needs
to be a call to lammps_set_external_vector_length() before this value can be
passed to LAMMPS.
This example was created by Nir Goldman, whom you can contact with
questions:
Nir Goldman, LLNL
ngoldman@llnl.gov

148
examples/COUPLE/fortran_dftb/data.diamond
View File

@ -1,148 +0,0 @@
# Position data file
64 atoms
1 atom types
0 7.134 xlo xhi
0 7.134 ylo yhi
0 7.134 zlo zhi
0.00000000 0.00000000 0.00000000 xy xz yz
Masses
1 12.010000
Atoms
1 1 0 0 0 0
2 1 0 0.89175 0.89175 0.89175
3 1 0 1.7835 1.7835 0
4 1 0 2.67525 2.67525 0.89175
5 1 0 0 1.7835 1.7835
6 1 0 0.89175 2.67525 2.67525
7 1 0 1.7835 0 1.7835
8 1 0 2.67525 0.89175 2.67525
9 1 0 0 0 3.567
10 1 0 0.89175 0.89175 4.45875
11 1 0 1.7835 1.7835 3.567
12 1 0 2.67525 2.67525 4.45875
13 1 0 0 1.7835 5.3505
14 1 0 0.89175 2.67525 6.24225
15 1 0 1.7835 0 5.3505
16 1 0 2.67525 0.89175 6.24225
17 1 0 0 3.567 0
18 1 0 0.89175 4.45875 0.89175
19 1 0 1.7835 5.3505 0
20 1 0 2.67525 6.24225 0.89175
21 1 0 0 5.3505 1.7835
22 1 0 0.89175 6.24225 2.67525
23 1 0 1.7835 3.567 1.7835
24 1 0 2.67525 4.45875 2.67525
25 1 0 0 3.567 3.567
26 1 0 0.89175 4.45875 4.45875
27 1 0 1.7835 5.3505 3.567
28 1 0 2.67525 6.24225 4.45875
29 1 0 0 5.3505 5.3505
30 1 0 0.89175 6.24225 6.24225
31 1 0 1.7835 3.567 5.3505
32 1 0 2.67525 4.45875 6.24225
33 1 0 3.567 0 0
34 1 0 4.45875 0.89175 0.89175
35 1 0 5.3505 1.7835 0
36 1 0 6.24225 2.67525 0.89175
37 1 0 3.567 1.7835 1.7835
38 1 0 4.45875 2.67525 2.67525
39 1 0 5.3505 0 1.7835
40 1 0 6.24225 0.89175 2.67525
41 1 0 3.567 0 3.567
42 1 0 4.45875 0.89175 4.45875
43 1 0 5.3505 1.7835 3.567
44 1 0 6.24225 2.67525 4.45875
45 1 0 3.567 1.7835 5.3505
46 1 0 4.45875 2.67525 6.24225
47 1 0 5.3505 0 5.3505
48 1 0 6.24225 0.89175 6.24225
49 1 0 3.567 3.567 0
50 1 0 4.45875 4.45875 0.89175
51 1 0 5.3505 5.3505 0
52 1 0 6.24225 6.24225 0.89175
53 1 0 3.567 5.3505 1.7835
54 1 0 4.45875 6.24225 2.67525
55 1 0 5.3505 3.567 1.7835
56 1 0 6.24225 4.45875 2.67525
57 1 0 3.567 3.567 3.567
58 1 0 4.45875 4.45875 4.45875
59 1 0 5.3505 5.3505 3.567
60 1 0 6.24225 6.24225 4.45875
61 1 0 3.567 5.3505 5.3505
62 1 0 4.45875 6.24225 6.24225
63 1 0 5.3505 3.567 5.3505
64 1 0 6.24225 4.45875 6.24225
Velocities
1 -0.00733742 -0.0040297 -0.00315229
2 -0.00788609 -0.00567535 -0.00199152
3 -0.00239042 0.00710139 -0.00335049
4 0.00678551 0.0019976 0.00219289
5 0.00413717 0.00275709 0.000937637
6 -0.00126313 0.00485636 0.00727862
7 0.00337547 -0.00234623 -0.000922223
8 -0.00792183 -0.00509186 -0.00104168
9 0.00414091 0.00390285 0.000845961
10 -0.000284543 0.0010771 -0.00458404
11 -0.00394968 -0.00446363 -0.00361688
12 0.00067088 -0.00655175 -0.00752464
13 0.00306632 -0.00245545 -0.00183867
14 -0.0082145 -0.00564127 0.000281191
15 0.00504454 0.0045835 0.000495763
16 0.0035767 0.00320441 -0.00486426
17 0.00420597 0.00262005 -0.0049459
18 0.00440579 -1.76783e-05 0.00449311
19 -0.00406463 0.00613304 0.00285599
20 0.00171215 -0.00517887 0.00124326
21 0.0011118 0.00334129 -0.0015222
22 -0.00838394 -0.00112906 -0.00353379
23 -0.00578527 -0.00415501 0.00297043
24 -0.00211466 0.000964108 -0.00716523
25 -0.000204107 -0.00380986 0.00681648
26 0.00677838 0.00540935 0.0044354
27 -0.00266809 -0.00358382 -0.00241889
28 -0.0003973 0.00236566 0.00558871
29 0.000754103 0.00457797 0.000105531
30 -0.00246049 0.00110428 0.00511088
31 0.00248891 0.00623314 0.00461597
32 -0.00509423 0.000570503 0.00720856
33 -0.00244427 -0.00374384 0.00618767
34 -0.000360752 -8.10558e-05 0.00314052
35 0.00435313 -0.00630587 -0.0070309
36 0.00651087 -0.00389833 3.72525e-05
37 0.00631828 -0.00316064 0.00231522
38 -0.00579624 -0.00345068 -0.000277486
39 0.00483974 0.000715028 0.000206355
40 -0.00388164 -0.00189242 -0.00554862
41 0.00398115 0.00152915 0.00756919
42 -0.000552263 0.00352025 -0.000246143
43 -0.00800284 0.00555703 0.00425716
44 -0.00734405 -0.00752512 0.00667173
45 -0.00545636 0.00421035 0.00399552
46 0.00480246 0.00621147 -0.00492715
47 -0.00424168 0.00621818 -9.37733e-05
48 -0.00649561 0.00612908 -0.0020753
49 -0.0075007 -0.00384737 -0.00687913
50 -0.00203903 -0.00764372 0.0023883
51 0.00442642 0.00744072 -0.0049344
52 -0.00280486 -0.00509128 -0.00678045
53 0.00679491 0.00583493 0.00333875
54 0.00574665 -0.00521074 0.00523475
55 0.00305618 -0.00320094 0.00341297
56 0.004304 0.000615544 -0.00668787
57 0.00564532 0.00327373 0.00388611
58 0.000676899 0.00210326 0.00495295
59 0.000160781 -0.00744313 -0.00279828
60 0.00623521 0.00371301 0.00178015
61 0.00520759 0.000642669 0.00207913
62 0.00398042 0.0046438 -0.00359978
63 -0.00478071 -0.00304932 -0.00765125
64 0.00282671 -0.00548392 -0.00692691

40
examples/COUPLE/fortran_dftb/dftb_in.hsd
View File

@ -1,40 +0,0 @@
#sample DFTB+ script to run this test code
Geometry = GenFormat {
<<< "lammps.gen"
}
Driver = {
}
Hamiltonian = DFTB {
LAMMPS = Yes # keyword to print energy, forces, and stress tensor to file(results.out)
SCC = No
MaxAngularMomentum = {
C = "p"
}
Charge = 0.0
Eigensolver = Standard {}
Filling = Fermi {
Temperature [Kelvin] = 298.0
}
SlaterKosterFiles = Type2FileNames {
Prefix = "~/slako/mio-1-1/" # the user must define the location of the skf files
Separator = "-"
Suffix = ".skf"
LowerCaseTypeName = No
}
KPointsAndWeights = {
0.0000000000000 0.0000000000000 0.0000000000000 1.00000000000000
}
}
Options = {
CalculateForces = Yes
WriteDetailedOut = No
WriteBandOut = No
RandomSeed = 12345
}
ParserOptions = {
ParserVersion = 3
}

129
examples/COUPLE/fortran_dftb/dftb_pin.hsd
View File

@ -1,129 +0,0 @@
Geometry = GenFormat {
64 S
C
1 1 7.099007 7.117657 7.119139
2 1 0.858709 0.867233 0.882294
3 1 1.772527 1.811776 7.120239
4 1 2.702145 2.681271 0.901362
5 1 0.017539 1.794455 1.788454
6 1 0.885593 2.694118 2.707994
7 1 1.795055 7.120787 1.777896
8 1 2.642849 0.868278 2.670699
9 1 0.016060 0.017156 3.568644
10 1 0.891891 0.896406 4.439286
11 1 1.766086 1.764402 3.550134
12 1 2.677349 2.648926 4.427174
13 1 0.010133 1.771283 5.342173
14 1 0.858153 2.653565 6.241596
15 1 1.804087 0.020636 5.353268
16 1 2.689680 0.907188 6.224575
17 1 0.017845 3.577563 7.113016
18 1 0.910027 4.459286 0.910286
19 1 1.766394 5.376046 0.015526
20 1 2.683727 6.220728 0.898553
21 1 0.003357 5.363423 1.774139
22 1 0.856735 6.238324 2.660213
23 1 1.761079 3.549776 1.797054
24 1 2.667227 4.463441 2.646074
25 1 7.132499 3.551558 3.599764
26 1 0.920387 4.482191 4.479257
27 1 1.772194 5.337132 3.555569
28 1 2.675010 6.251629 4.483124
29 1 0.005702 5.371095 5.351147
30 1 0.880807 6.249819 6.264231
31 1 1.793177 3.592396 5.369939
32 1 2.653179 4.463595 6.274044
33 1 3.557243 7.118913 0.026006
34 1 4.458971 0.889331 0.904950
35 1 5.367903 1.759757 7.104941
36 1 6.271565 2.658454 0.890168
37 1 3.591915 1.768681 1.793880
38 1 4.435612 2.662184 2.676722
39 1 5.371040 0.000196 1.783464
40 1 6.226453 0.886640 2.653384
41 1 3.583339 0.005449 3.600177
42 1 4.453692 0.909417 4.459713
43 1 5.314554 1.805409 3.584215
44 1 6.210181 2.642660 4.486206
45 1 3.545704 1.802745 5.365369
46 1 4.476660 2.701226 6.220451
47 1 5.332820 0.029557 5.347965
48 1 6.215725 0.915081 6.230289
49 1 3.536446 3.551469 7.106600
50 1 4.451181 4.426439 0.900180
51 1 5.368735 5.377996 7.109524
52 1 6.230666 6.220985 0.862175
53 1 3.596626 5.372822 1.797613
54 1 4.485613 6.221252 2.699652
55 1 5.364421 3.549838 1.796281
56 1 6.261739 4.459046 2.648152
57 1 3.588752 3.581054 3.581755
58 1 4.462342 4.467270 4.478800
59 1 5.355202 5.318323 3.556531
60 1 6.268570 6.259831 4.465795
61 1 3.588636 5.354278 5.362327
62 1 4.475747 6.263866 6.227803
63 1 5.331158 3.554349 5.318368
64 1 6.254581 4.436344 6.209681
0.0 0.0 0.0
7.13400000000000 0 0
0 7.13400000000000 0
0 0 7.13400000000000
}
Driver = {}
Hamiltonian = DFTB {
LAMMPS = Yes
SCC = No
MaxAngularMomentum = {
C = "p"
}
Charge = 0.0
Eigensolver = Standard {}
Filling = Fermi {
Temperature [Kelvin] = 298.0
IndependentKFilling = No
}
SlaterKosterFiles = Type2FileNames {
Prefix = "~/slako/mio-1-1/"
Separator = "-"
Suffix = ".skf"
LowerCaseTypeName = No
}
KPointsAndWeights = {
0.0000000000000 0.0000000000000 0.0000000000000 1.00000000000000
}
PolynomialRepulsive = {}
OldRepulsiveSum = No
OrbitalResolvedSCC = No
OldSKInterpolation = No
NoErep = No
Dispersion = {}
ThirdOrder = No
ThirdOrderFull = No
}
Options = {
CalculateForces = Yes
WriteDetailedOut = No
WriteBandOut = No
RandomSeed = 12345
MullikenAnalysis = No
WriteEigenvectors = No
WriteAutotestTag = No
WriteDetailedXML = No
WriteResultsTag = No
AtomResolvedEnergies = No
WriteHS = No
WriteRealHS = No
MinimiseMemoryUsage = No
ShowFoldedCoords = No
}
ParserOptions = {
ParserVersion = 3
WriteHSDInput = Yes
WriteXMLInput = No
StopAfterParsing = No
IgnoreUnprocessedNodes = No
}
Analysis = {
ProjectStates = {}
}

16
examples/COUPLE/fortran_dftb/in.simple
View File

@ -1,16 +0,0 @@
units real
atom_style charge
atom_modify map array
atom_modify sort 0 0.0
read_data data.diamond
neighbor 1.0 bin
neigh_modify delay 0 every 5 check no
fix 1 all nve
fix 2 all external pf/callback 1 1
fix_modify 2 energy yes
thermo_style custom step temp etotal ke pe lx ly lz pxx pyy pzz press
thermo 1
timestep 0.5

71
examples/COUPLE/fortran_dftb/log.simple
View File

@ -1,71 +0,0 @@
LAMMPS (6 Jul 2017)
units real
atom_style charge
atom_modify map array
atom_modify sort 0 0.0
read_data data.diamond
triclinic box = (0 0 0) to (7.134 7.134 7.134) with tilt (0 0 0)
1 by 1 by 1 MPI processor grid
reading atoms ...
64 atoms
reading velocities ...
64 velocities
neighbor 1.0 bin
neigh_modify delay 0 every 5 check no
fix 1 all nve
fix 2 all external pf/callback 1 1
fix_modify 2 energy yes
thermo_style custom step temp etotal ke pe lx ly lz pxx pyy pzz press
thermo 1
timestep 0.5
run 10
Neighbor list info ...
update every 5 steps, delay 0 steps, check no
max neighbors/atom: 2000, page size: 100000
master list distance cutoff = 0
ghost atom cutoff = 0
binsize = 7.134, bins = 1 1 1
0 neighbor lists, perpetual/occasional/extra = 0 0 0
Per MPI rank memory allocation (min/avg/max) = 2.3 | 2.3 | 2.3 Mbytes
Step Temp TotEng KinEng PotEng Lx Ly Lz Pxx Pyy Pzz Press
0 298.24835 -69593.587 56.008365 -69649.595 7.134 7.134 7.134 -19980.19 -21024.038 -21097.458 -20700.562
1 295.24358 -69593.585 55.444098 -69649.029 7.134 7.134 7.134 -19778.833 -20799.657 -20854.156 -20477.549
2 286.37211 -69593.58 53.778115 -69647.358 7.134 7.134 7.134 -19227.52 -20177.28 -20176.12 -19860.306
3 272.062 -69593.572 51.090804 -69644.663 7.134 7.134 7.134 -18360.869 -19189.684 -19100.021 -18883.525
4 253.01834 -69593.561 47.514575 -69641.075 7.134 7.134 7.134 -17198.143 -17855.03 -17652.036 -17568.403
5 230.19242 -69593.547 43.228073 -69636.775 7.134 7.134 7.134 -15750.247 -16183.764 -15854.145 -15929.386
6 204.71787 -69593.533 38.44418 -69631.977 7.134 7.134 7.134 -14083.498 -14247.434 -13789.835 -14040.256
7 177.82397 -69593.518 33.393748 -69626.911 7.134 7.134 7.134 -12340.963 -12202.878 -11623.171 -12055.671
8 150.76736 -69593.503 28.312758 -69621.816 7.134 7.134 7.134 -10637.824 -10180.827 -9495.0496 -10104.567
9 124.7737 -69593.49 23.431383 -69616.921 7.134 7.134 7.134 -9113.3842 -8339.0492 -7572.8076 -8341.747
10 100.98183 -69593.478 18.963481 -69612.442 7.134 7.134 7.134 -7833.9349 -6756.9749 -5945.8968 -6845.6022
Loop time of 2.20497 on 1 procs for 10 steps with 64 atoms
Performance: 0.196 ns/day, 122.499 hours/ns, 4.535 timesteps/s
0.2% CPU use with 1 MPI tasks x no OpenMP threads
MPI task timing breakdown:
Section | min time | avg time | max time |%varavg| %total
---------------------------------------------------------------
Pair | 0 | 0 | 0 | 0.0 | 0.00
Neigh | 1.4305e-06 | 1.4305e-06 | 1.4305e-06 | 0.0 | 0.00
Comm | 4.22e-05 | 4.22e-05 | 4.22e-05 | 0.0 | 0.00
Output | 0.00067687 | 0.00067687 | 0.00067687 | 0.0 | 0.03
Modify | 2.2042 | 2.2042 | 2.2042 | 0.0 | 99.96
Other | | 6.533e-05 | | | 0.00
Nlocal: 64 ave 64 max 64 min
Histogram: 1 0 0 0 0 0 0 0 0 0
Nghost: 0 ave 0 max 0 min
Histogram: 1 0 0 0 0 0 0 0 0 0
Neighs: 0 ave 0 max 0 min
Histogram: 1 0 0 0 0 0 0 0 0 0
Total # of neighbors = 0
Ave neighs/atom = 0
Neighbor list builds = 2
Dangerous builds not checked
Total wall time: 0:00:02

45
examples/COUPLE/fortran_dftb/makefile
View File

@ -1,45 +0,0 @@
SHELL = /bin/sh
# Path to LAMMPS extraction directory
LAMMPS_ROOT = ../../..
LAMMPS_SRC = $(LAMMPS_ROOT)/src
# Uncomment the line below if using the MPI stubs library
MPI_STUBS = #-I$(LAMMPS_SRC)/STUBS
FC = mpif90 # replace with your Fortran compiler
CXX = mpicc # replace with your C++ compiler
# Flags for Fortran compiler, C++ compiler, and C preprocessor, respectively
FFLAGS = -O2 -fPIC
CXXFLAGS = -O2 -fPIC
CPPFLAGS = -DOMPI_SKIP_MPICXX=1 -DMPICH_SKIP_MPICXX
all : liblammps_fortran.a liblammps_fortran.so simpleF.x
liblammps_fortran.so : LAMMPS.o LAMMPS-wrapper.o LAMMPS-wrapper2.o
$(FC) $(FFLAGS) -shared -o $@ $^
simpleF.x: simple.o LAMMPS.o LAMMPS-wrapper.o LAMMPS-wrapper2.o
$(FC) $(FFLAGS) simple.o -o simpleF.x liblammps_fortran.a $(LAMMPS_SRC)/liblammps_mvapich.a -lstdc++ /usr/lib64/libfftw3.a
liblammps_fortran.a : LAMMPS.o LAMMPS-wrapper.o LAMMPS-wrapper2.o
$(AR) rs $@ $^
LAMMPS.o lammps.mod : LAMMPS.F90
$(FC) $(CPPFLAGS) $(FFLAGS) -c $<
simple.o : simple.f90
$(FC) $(FFLAGS) -c $<
LAMMPS-wrapper.o : LAMMPS-wrapper.cpp LAMMPS-wrapper.h
$(CXX) $(CPPFLAGS) $(CXXFLAGS) -c $< -I$(LAMMPS_SRC) $(MPI_STUBS)
LAMMPS-wrapper2.o : LAMMPS-wrapper2.cpp LAMMPS-wrapper2.h
$(CXX) $(CPPFLAGS) $(CXXFLAGS) -c $< -I$(LAMMPS_SRC) $(MPI_STUBS)
clean :
$(RM) *.o *.mod liblammps_fortran.a liblammps_fortran.so
dist :
tar -czvf fortran-interface-callback.tar.gz LAMMPS-wrapper.h LAMMPS-wrapper.cpp LAMMPS-wrapper2.h LAMMPS-wrapper2.cpp LAMMPS.F90 makefile README simple.f90

110
examples/COUPLE/fortran_dftb/simple.f90
View File

@ -1,110 +0,0 @@
module callback
implicit none
contains
subroutine fortran_callback(lmp, timestep, nlocal, ids, c_pos, c_fext) &
& bind(C, name='f_callback')
use, intrinsic :: ISO_C_binding
use LAMMPS
implicit none
type (C_ptr), value :: lmp
integer(C_int64_t), intent(in), value :: timestep
integer(C_int), intent(in), value :: nlocal
real (C_double), dimension(:,:), pointer :: x
type(c_ptr) :: c_pos, c_fext, c_ids
double precision, pointer :: fext(:,:), pos(:,:)
integer, intent(in) :: ids(nlocal)
real(C_double) :: virial(6)
real (C_double) :: etot
real(C_double), pointer :: ts_lmp
double precision :: stress(3,3), ts_dftb
integer :: natom , i
real (C_double), parameter :: econv = 627.4947284155114 ! converts from Ha to
double precision, parameter :: fconv = 1185.793095983065 ! converts from Ha/bohr to
double precision, parameter :: autoatm = 2.9037166638E8
double precision lx, ly, lz
real (C_double), pointer :: boxxlo, boxxhi
real (C_double), pointer :: boxylo, boxyhi
real (C_double), pointer :: boxzlo, boxzhi
double precision, parameter :: nktv2p = 68568.4149999999935972
double precision :: volume
type (C_ptr) :: Cptr
type (C_ptr), pointer, dimension(:) :: Catom
call c_f_pointer(c_pos, pos, [3,nlocal])
call c_f_pointer(c_fext, fext, [3,nlocal])
call lammps_extract_global(boxxlo, lmp, 'boxxlo')
call lammps_extract_global(boxxhi, lmp, 'boxxhi')
call lammps_extract_global(boxylo, lmp, 'boxylo')
call lammps_extract_global(boxyhi, lmp, 'boxyhi')
call lammps_extract_global(boxzlo, lmp, 'boxzlo')
call lammps_extract_global(boxzhi, lmp, 'boxzhi')
lx = boxxhi - boxxlo
ly = boxyhi - boxylo
lz = boxzhi - boxzlo
volume = lx*ly*lz
open (unit = 10, status = 'replace', action = 'write', file='lammps.gen')
write(10,*)nlocal,"S"
write(10,*) "C"
do i = 1, nlocal
write(10,'(2I,3F15.6)')i,1,pos(:,ids(i))
enddo
write(10,*)"0.0 0.0 0.0"
write(10,*)lx,0,0
write(10,*)0,ly,0
write(10,*)0,0,lz
close(10)
call system("./dftb+ > dftb.out")
open (unit = 10, status = 'old', file = 'results.out')
read(10,*)etot
read(10,*)ts_dftb
do i = 1, 3
read(10,*)stress(i,:)
enddo
stress (:,:) = stress(:,:)*autoatm
virial(1) = stress(1,1)/(nktv2p/volume)
virial(2) = stress(2,2)/(nktv2p/volume)
virial(3) = stress(3,3)/(nktv2p/volume)
virial(4) = stress(1,2)/(nktv2p/volume)
virial(5) = stress(1,3)/(nktv2p/volume)
virial(6) = stress(2,3)/(nktv2p/volume)
etot = etot*econv
call lammps_set_external_vector(lmp,1,ts_dftb*econv)
do i = 1, nlocal
read(10,*)fext(:,ids(i))
fext(:,ids(i)) = fext(:,ids(i))*fconv
enddo
close(10)
call lammps_set_user_energy (lmp, etot)
call lammps_set_user_virial (lmp, virial)
end subroutine
end module callback
program simple_fortran_callback
use MPI
use LAMMPS
use callback
use, intrinsic :: ISO_C_binding, only : C_double, C_ptr, C_int, C_FUNPTR
implicit none
type (C_ptr) :: lmp
integer :: error, narg, me, nprocs
call MPI_Init (error)
call MPI_Comm_rank (MPI_COMM_WORLD, me, error)
call MPI_Comm_size (MPI_COMM_WORLD, nprocs, error)
call lammps_open_no_mpi ('lmp -log log.simple', lmp)
call lammps_file (lmp, 'in.simple')
call lammps_set_callback(lmp)
call lammps_set_external_vector_length(lmp,2)
call lammps_command (lmp, 'run 10')
call lammps_close (lmp)
call MPI_Finalize (error)
end program simple_fortran_callback