mirror of https://github.com/lammps/lammps.git
Updated docs and wrote unit tests for lmp_set_fix_external_callback; fixed typos
This commit is contained in:
Karl Hammond
parent
170c312a0c
commit
5f9956405a
|
|
@ -409,7 +409,7 @@ of the contents of the :f:mod:`LIBLAMMPS` Fortran interface to LAMMPS.
|
|||
USE LIBLAMMPS
|
||||
USE MPI_F08
|
||||
TYPE(lammps) :: lmp
|
||||
lmp = lammps(MPI_COMM_SELF%MPI_VAL)
|
||||
lmp = lammps(comm=MPI_COMM_SELF%MPI_VAL)
|
||||
END PROGRAM testmpi
|
||||
|
||||
.. f:type:: lammps_style
|
||||
|
|
@ -773,8 +773,8 @@ Procedures Bound to the :f:type:`lammps` Derived Type
|
|||
Note that this function actually does not return a pointer, but rather
|
||||
associates the pointer on the left side of the assignment to point
|
||||
to internal LAMMPS data. Pointers must be of the correct type, kind, and
|
||||
rank (e.g., ``INTEGER(c_int), DIMENSION(:)`` for "type", "mask", or "tag";
|
||||
``INTEGER(c_int64_t), DIMENSION(:)`` for "tag" if LAMMPS was compiled
|
||||
rank (e.g., ``INTEGER(c_int), DIMENSION(:)`` for "type", "mask", or "id";
|
||||
``INTEGER(c_int64_t), DIMENSION(:)`` for "id" if LAMMPS was compiled
|
||||
with the ``-DLAMMPS_BIGBIG`` flag; ``REAL(c_double), DIMENSION(:,:)`` for
|
||||
"x", "v", or "f"; and so forth). The pointer being associated with LAMMPS
|
||||
data is type-, kind-, and rank-checked at run-time.
|
||||
|
|
@ -2118,7 +2118,7 @@ Procedures Bound to the :f:type:`lammps` Derived Type
|
|||
ABSTRACT INTERFACE
|
||||
SUBROUTINE external_callback(caller, timestep, ids, x, fexternal)
|
||||
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double, c_int64_t
|
||||
CLASS(*), INTENT(IN) :: caller
|
||||
CLASS(*), INTENT(INOUT) :: caller
|
||||
INTEGER(c_bigint), INTENT(IN) :: timestep
|
||||
INTEGER(c_tagint), DIMENSION(:), INTENT(IN) :: ids
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
|
|
@ -2135,6 +2135,8 @@ Procedures Bound to the :f:type:`lammps` Derived Type
|
|||
calling function) and will be available as the first argument to the
|
||||
callback function. It can be your LAMMPS instance, which you might need if
|
||||
the callback function needs access to the library interface.
|
||||
The argument must be a scalar; to pass non-scalar data, wrap those data in
|
||||
a derived type and pass an instance of the derived type to *caller*.
|
||||
|
||||
The array *ids* is an array of length *nlocal* (as accessed from the
|
||||
:cpp:class:`Atom` class or through :f:func:`extract_global`). The arrays
|
||||
|
|
@ -2155,7 +2157,41 @@ Procedures Bound to the :f:type:`lammps` Derived Type
|
|||
:p callback: subroutine :doc:`fix external <fix_external>` should call
|
||||
:ptype callback: external
|
||||
:p class(*) caller [optional]: object you wish to pass to the callback
|
||||
procedure
|
||||
procedure (must be a scalar; see note)
|
||||
|
||||
.. note::
|
||||
|
||||
The interface for your callback function must match types precisely
|
||||
with the abstract interface block given above. **The compiler probably
|
||||
will not be able to check this for you.** In particular, the first
|
||||
argument ("caller") must be of type ``CLASS(*)`` or you will probably
|
||||
get a segmentation fault or at least a misinterpretation of whatever is
|
||||
in memory there. You can resolve the object using the ``SELECT TYPE``
|
||||
construct. An example callback function (assuming LAMMPS was compiled
|
||||
with ``-DLAMMPS_SMALLBIG``) that applies something akin to Hooke's Law
|
||||
(with each atom having a different *k* value) is shown below.
|
||||
|
||||
.. code-block:: Fortran
|
||||
|
||||
TYPE shield
|
||||
REAL(c_double), DIMENSION(:), ALLOCATABLE :: k
|
||||
! assume k gets allocated to dimension(3,nlocal) at some point
|
||||
END TYPE shield
|
||||
|
||||
SUBROUTINE my_callback(caller, timestep, ids, x, fexternal)
|
||||
CLASS(*), INTENT(INOUT) :: caller
|
||||
INTEGER(c_int), INTENT(IN) :: timestep
|
||||
INTEGER(c_int64_t), INTENT(IN) :: ids
|
||||
REAL(c_double), INTENT(IN) :: x(:,:)
|
||||
REAL(c_double), INTENT(OUT) :: fexternal(:,:)
|
||||
|
||||
SELECT TYPE (caller)
|
||||
TYPE IS (shield)
|
||||
fexternal = - caller%k * x
|
||||
CLASS DEFAULT
|
||||
WRITE(error_unit,*) 'UH OH...'
|
||||
END SELECT
|
||||
END SUBROUTINE my_callback
|
||||
|
||||
--------
|
||||
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ MODULE LIBLAMMPS
|
|||
LAMMPS_DOUBLE_2D = 3, & ! two-dimensional 64-bit double array
|
||||
LAMMPS_INT64 = 4, & ! 64-bit integer (or array)
|
||||
LAMMPS_INT64_2D = 5, & ! two-dimensional 64-bit integer array
|
||||
LAMMPS_STRING = 6, & ! C-String
|
||||
LAMMPS_STRING = 6, & ! string
|
||||
LMP_STYLE_GLOBAL = 0, & ! request global compute/fix/etc. data
|
||||
LMP_STYLE_ATOM = 1, & ! request per-atom compute/fix/etc. data
|
||||
LMP_STYLE_LOCAL = 2, & ! request local compute/fix/etc. data
|
||||
|
|
@ -64,7 +64,7 @@ MODULE LIBLAMMPS
|
|||
LMP_TYPE_ARRAY = 2, & ! request array
|
||||
LMP_SIZE_VECTOR = 3, & ! request size of vector
|
||||
LMP_SIZE_ROWS = 4, & ! request rows (actually columns)
|
||||
LMP_SIZE_COLS = 5, & ! request colums (actually rows)
|
||||
LMP_SIZE_COLS = 5, & ! request columns (actually rows)
|
||||
LMP_ERROR_WARNING = 0, & ! call Error::warning()
|
||||
LMP_ERROR_ONE = 1, & ! call Error::one() (from this MPI rank)
|
||||
LMP_ERROR_ALL = 2, & ! call Error::all() (from all MPI ranks)
|
||||
|
|
@ -268,7 +268,7 @@ MODULE LIBLAMMPS
|
|||
ABSTRACT INTERFACE
|
||||
SUBROUTINE external_callback_smallsmall(caller, timestep, ids, x, fexternal)
|
||||
IMPORT :: c_int, c_double
|
||||
CLASS(*), INTENT(IN) :: caller
|
||||
CLASS(*), INTENT(INOUT) :: caller
|
||||
INTEGER(c_int), INTENT(IN) :: timestep
|
||||
INTEGER(c_int), DIMENSION(:), INTENT(IN) :: ids
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
|
|
@ -276,7 +276,7 @@ MODULE LIBLAMMPS
|
|||
END SUBROUTINE external_callback_smallsmall
|
||||
SUBROUTINE external_callback_smallbig(caller, timestep, ids, x, fexternal)
|
||||
IMPORT :: c_int, c_double, c_int64_t
|
||||
CLASS(*), INTENT(IN) :: caller
|
||||
CLASS(*), INTENT(INOUT) :: caller
|
||||
INTEGER(c_int64_t), INTENT(IN) :: timestep
|
||||
INTEGER(c_int), DIMENSION(:), INTENT(IN) :: ids
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
|
|
@ -284,7 +284,7 @@ MODULE LIBLAMMPS
|
|||
END SUBROUTINE external_callback_smallbig
|
||||
SUBROUTINE external_callback_bigbig(caller, timestep, ids, x, fexternal)
|
||||
IMPORT :: c_double, c_int64_t
|
||||
CLASS(*), INTENT(IN) :: caller
|
||||
CLASS(*), INTENT(INOUT) :: caller
|
||||
INTEGER(c_int64_t), INTENT(IN) :: timestep
|
||||
INTEGER(c_int64_t), DIMENSION(:), INTENT(IN) :: ids
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
|
|
@ -836,28 +836,28 @@ CONTAINS
|
|||
INTEGER(c_int) :: i, c_comm, argc
|
||||
|
||||
IF (PRESENT(args)) THEN
|
||||
! convert fortran argument list to c style
|
||||
argc = SIZE(args)
|
||||
ALLOCATE(argv(argc))
|
||||
DO i=1, argc
|
||||
argv(i) = f2c_string(args(i))
|
||||
END DO
|
||||
! convert fortran argument list to c style
|
||||
argc = SIZE(args)
|
||||
ALLOCATE(argv(argc))
|
||||
DO i=1, argc
|
||||
argv(i) = f2c_string(args(i))
|
||||
END DO
|
||||
ELSE
|
||||
argc = 1
|
||||
ALLOCATE(argv(1))
|
||||
argv(1) = f2c_string("liblammps")
|
||||
argc = 1
|
||||
ALLOCATE(argv(1))
|
||||
argv(1) = f2c_string("liblammps")
|
||||
ENDIF
|
||||
|
||||
IF (PRESENT(comm)) THEN
|
||||
c_comm = comm
|
||||
lmp_open%handle = lammps_open(argc, argv, c_comm)
|
||||
c_comm = comm
|
||||
lmp_open%handle = lammps_open(argc, argv, c_comm)
|
||||
ELSE
|
||||
lmp_open%handle = lammps_open_no_mpi(argc, argv, c_null_ptr)
|
||||
lmp_open%handle = lammps_open_no_mpi(argc, argv, c_null_ptr)
|
||||
END IF
|
||||
|
||||
! Clean up allocated memory
|
||||
DO i=1, argc
|
||||
CALL lammps_free(argv(i))
|
||||
CALL lammps_free(argv(i))
|
||||
END DO
|
||||
DEALLOCATE(argv)
|
||||
|
||||
|
|
@ -883,10 +883,10 @@ CONTAINS
|
|||
CALL lammps_close(self%handle)
|
||||
|
||||
IF (PRESENT(finalize)) THEN
|
||||
IF (finalize) THEN
|
||||
CALL lammps_kokkos_finalize()
|
||||
CALL lammps_mpi_finalize()
|
||||
END IF
|
||||
IF (finalize) THEN
|
||||
CALL lammps_kokkos_finalize()
|
||||
CALL lammps_mpi_finalize()
|
||||
END IF
|
||||
END IF
|
||||
END SUBROUTINE lmp_close
|
||||
|
||||
|
|
@ -1054,7 +1054,7 @@ CONTAINS
|
|||
length = 3
|
||||
CASE DEFAULT
|
||||
length = 1
|
||||
! string cases doesn't use "length"
|
||||
! string cases do not use "length"
|
||||
END SELECT
|
||||
|
||||
Cname = f2c_string(name)
|
||||
|
|
|
|||
|
|
@ -104,6 +104,10 @@ if(CMAKE_Fortran_COMPILER)
|
|||
target_link_libraries(test_fortran_neighlist PRIVATE flammps lammps MPI::MPI_Fortran GTest::GMockMain)
|
||||
add_test(NAME FortranNeighlist COMMAND test_fortran_neighlist)
|
||||
|
||||
add_executable(test_fortran_fixexternal wrap_fixexternal.cpp test_fortran_fixexternal.f90)
|
||||
target_link_libraries(test_fortran_fixexternal PRIVATE flammps lammps MPI::MPI_Fortran GTest::GMockMain)
|
||||
add_test(NAME FortranFixExternal COMMAND test_fortran_fixexternal)
|
||||
|
||||
else()
|
||||
message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler")
|
||||
endif()
|
||||
|
|
|
|||
|
|
@ -0,0 +1,220 @@
|
|||
MODULE ext_stuff
|
||||
USE, INTRINSIC :: ISO_Fortran_ENV, ONLY : error_unit
|
||||
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int, c_int64_t, c_loc
|
||||
USE LIBLAMMPS
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL(c_double), SAVE :: direction = 1.0_c_double
|
||||
|
||||
CONTAINS
|
||||
|
||||
SUBROUTINE f_lammps_reverse_direction() BIND(C)
|
||||
direction = -direction
|
||||
END SUBROUTINE f_lammps_reverse_direction
|
||||
|
||||
SUBROUTINE f_callback_ss(instance, timestep, id, x, f)
|
||||
CLASS(*), INTENT(INOUT) :: instance
|
||||
INTEGER(c_int) :: timestep
|
||||
INTEGER(c_int), DIMENSION(:), INTENT(IN) :: id
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(OUT) :: f
|
||||
|
||||
WHERE (id == 1)
|
||||
f(1,:) = 1.0_c_double
|
||||
f(2,:) = -1.0_c_double
|
||||
f(3,:) = 1.25_c_double
|
||||
ELSEWHERE
|
||||
f(1,:) = -1.0_c_double
|
||||
f(2,:) = +1.0_c_double
|
||||
f(3,:) = -1.25_c_double
|
||||
END WHERE
|
||||
END SUBROUTINE f_callback_ss
|
||||
|
||||
SUBROUTINE f_callback_sb(instance, timestep, id, x, f)
|
||||
CLASS(*), INTENT(INOUT) :: instance
|
||||
INTEGER(c_int64_t) :: timestep
|
||||
INTEGER(c_int), DIMENSION(:), INTENT(IN) :: id
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(OUT) :: f
|
||||
|
||||
WHERE (id == 1_c_int)
|
||||
f(1,:) = 1.0_c_double
|
||||
f(2,:) = -1.0_c_double
|
||||
f(3,:) = 1.25_c_double
|
||||
ELSEWHERE
|
||||
f(1,:) = -1.0_c_double
|
||||
f(2,:) = +1.0_c_double
|
||||
f(3,:) = -1.25_c_double
|
||||
END WHERE
|
||||
END SUBROUTINE f_callback_sb
|
||||
|
||||
SUBROUTINE f_callback_bb(instance, timestep, id, x, f)
|
||||
CLASS(*), INTENT(INOUT) :: instance
|
||||
INTEGER(c_int64_t) :: timestep
|
||||
INTEGER(c_int64_t), DIMENSION(:), INTENT(IN) :: id
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(OUT) :: f
|
||||
|
||||
WHERE (id == 1_c_int64_t)
|
||||
f(1,:) = 1.0_c_double
|
||||
f(2,:) = -1.0_c_double
|
||||
f(3,:) = 1.25_c_double
|
||||
ELSEWHERE
|
||||
f(1,:) = -1.0_c_double
|
||||
f(2,:) = +1.0_c_double
|
||||
f(3,:) = -1.25_c_double
|
||||
END WHERE
|
||||
END SUBROUTINE f_callback_bb
|
||||
|
||||
SUBROUTINE f_callback2_ss(entity, timestep, id, x, f)
|
||||
CLASS(*), INTENT(INOUT), target :: entity
|
||||
INTEGER(c_int) :: timestep
|
||||
INTEGER(c_int), DIMENSION(:), INTENT(IN) :: id
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(OUT) :: f
|
||||
|
||||
SELECT TYPE (entity)
|
||||
TYPE IS (REAL(c_double))
|
||||
WHERE (id == 1_c_int)
|
||||
f(1,:) = SIGN(1.0_c_double, entity) * 2.0_c_double
|
||||
f(2,:) = SIGN(1.0_c_double, entity) * (-2.0_c_double)
|
||||
f(3,:) = SIGN(1.0_c_double, entity) * 2.5_c_double
|
||||
ELSEWHERE
|
||||
f(1,:) = SIGN(1.0_c_double, entity) * (-2.0_c_double)
|
||||
f(2,:) = SIGN(1.0_c_double, entity) * 2.0_c_double
|
||||
f(3,:) = SIGN(1.0_c_double, entity) * (-2.5_c_double)
|
||||
END WHERE
|
||||
CLASS DEFAULT
|
||||
WRITE(error_unit,'(A)') 'ERROR: Failed to resolve "entity" in&
|
||||
& f_callback2_ss'
|
||||
STOP 1
|
||||
END SELECT
|
||||
END SUBROUTINE f_callback2_ss
|
||||
|
||||
SUBROUTINE f_callback2_sb(entity, timestep, id, x, f)
|
||||
CLASS(*), INTENT(INOUT), target :: entity
|
||||
INTEGER(c_int64_t) :: timestep
|
||||
INTEGER(c_int), DIMENSION(:), INTENT(IN) :: id
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(OUT) :: f
|
||||
|
||||
SELECT TYPE (entity)
|
||||
TYPE IS (REAL(c_double))
|
||||
WHERE (id == 1_c_int)
|
||||
f(1,:) = SIGN(1.0_c_double, entity) * 2.0_c_double
|
||||
f(2,:) = SIGN(1.0_c_double, entity) * (-2.0_c_double)
|
||||
f(3,:) = SIGN(1.0_c_double, entity) * 2.5_c_double
|
||||
ELSEWHERE
|
||||
f(1,:) = SIGN(1.0_c_double, entity) * (-2.0_c_double)
|
||||
f(2,:) = SIGN(1.0_c_double, entity) * 2.0_c_double
|
||||
f(3,:) = SIGN(1.0_c_double, entity) * (-2.5_c_double)
|
||||
END WHERE
|
||||
CLASS DEFAULT
|
||||
WRITE(error_unit,'(A)') 'ERROR: Failed to resolve "entity" in&
|
||||
& f_callback2_sb'
|
||||
STOP 1
|
||||
END SELECT
|
||||
END SUBROUTINE f_callback2_sb
|
||||
|
||||
SUBROUTINE f_callback2_bb(entity, timestep, id, x, f)
|
||||
CLASS(*), INTENT(INOUT), target :: entity
|
||||
INTEGER(c_int64_t) :: timestep
|
||||
INTEGER(c_int64_t), DIMENSION(:), INTENT(IN) :: id
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
|
||||
REAL(c_double), DIMENSION(:,:), INTENT(OUT) :: f
|
||||
|
||||
SELECT TYPE (entity)
|
||||
TYPE IS (REAL(c_double))
|
||||
WHERE (id == 1_c_int64_t)
|
||||
f(1,:) = SIGN(1.0_c_double, entity) * 2.0_c_double
|
||||
f(2,:) = SIGN(1.0_c_double, entity) * (-2.0_c_double)
|
||||
f(3,:) = SIGN(1.0_c_double, entity) * 2.5_c_double
|
||||
ELSEWHERE
|
||||
f(1,:) = SIGN(1.0_c_double, entity) * (-2.0_c_double)
|
||||
f(2,:) = SIGN(1.0_c_double, entity) * 2.0_c_double
|
||||
f(3,:) = SIGN(1.0_c_double, entity) * (-2.5_c_double)
|
||||
END WHERE
|
||||
CLASS DEFAULT
|
||||
WRITE(error_unit,'(A)') 'ERROR: Failed to resolve "entity" in&
|
||||
& f_callback2_sb'
|
||||
STOP 1
|
||||
END SELECT
|
||||
END SUBROUTINE f_callback2_bb
|
||||
END MODULE ext_stuff
|
||||
|
||||
FUNCTION f_lammps_with_args() BIND(C)
|
||||
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr
|
||||
USE liblammps
|
||||
USE keepstuff, ONLY: lmp
|
||||
IMPLICIT NONE
|
||||
TYPE(c_ptr) :: f_lammps_with_args
|
||||
|
||||
CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = &
|
||||
[ CHARACTER(len=12) :: 'liblammps', '-log', 'none', &
|
||||
'-echo','screen','-nocite','-var','zpos','1.5','-var','x','2']
|
||||
|
||||
lmp = lammps(args)
|
||||
f_lammps_with_args = lmp%handle
|
||||
END FUNCTION f_lammps_with_args
|
||||
|
||||
SUBROUTINE f_lammps_close() BIND(C)
|
||||
USE ISO_C_BINDING, ONLY: c_null_ptr
|
||||
USE liblammps
|
||||
USE keepstuff, ONLY: lmp
|
||||
IMPLICIT NONE
|
||||
|
||||
CALL lmp%close()
|
||||
lmp%handle = c_null_ptr
|
||||
END SUBROUTINE f_lammps_close
|
||||
|
||||
SUBROUTINE f_lammps_setup_fix_external() BIND(C)
|
||||
USE LIBLAMMPS
|
||||
USE keepstuff, ONLY : lmp, demo_input, cont_input, pair_input
|
||||
IMPLICIT NONE
|
||||
|
||||
CALL lmp%commands_list(demo_input)
|
||||
CALL lmp%commands_list(cont_input)
|
||||
CALL lmp%commands_list(pair_input)
|
||||
CALL lmp%command('neigh_modify exclude group all all')
|
||||
CALL lmp%command('fix ext1 all external pf/callback 1 1')
|
||||
CALL lmp%command('fix ext2 all external pf/callback 1 1')
|
||||
END SUBROUTINE f_lammps_setup_fix_external
|
||||
|
||||
SUBROUTINE f_lammps_set_fix_external_callbacks() BIND(C)
|
||||
USE ISO_C_BINDING, ONLY : c_int
|
||||
USE LIBLAMMPS
|
||||
USE keepstuff, ONLY : lmp
|
||||
USE ext_stuff
|
||||
IMPLICIT NONE
|
||||
INTEGER :: size_bigint, size_tagint, nlocal
|
||||
|
||||
nlocal = lmp%extract_setting('nlocal')
|
||||
|
||||
size_bigint = lmp%extract_setting('bigint')
|
||||
size_tagint = lmp%extract_setting('tagint')
|
||||
IF (size_bigint == 4_c_int .AND. size_tagint == 4_c_int) THEN
|
||||
CALL lmp%set_fix_external_callback('ext1', f_callback_ss)
|
||||
CALL lmp%set_fix_external_callback('ext2', f_callback2_ss, direction)
|
||||
ELSE IF (size_bigint == 8_c_int .AND. size_tagint == 8_c_int) THEN
|
||||
CALL lmp%set_fix_external_callback('ext1', f_callback_bb)
|
||||
CALL lmp%set_fix_external_callback('ext2', f_callback2_bb, direction)
|
||||
ELSE
|
||||
CALL lmp%set_fix_external_callback('ext1', f_callback_sb)
|
||||
CALL lmp%set_fix_external_callback('ext2', f_callback2_sb, direction)
|
||||
END IF
|
||||
END SUBROUTINE f_lammps_set_fix_external_callbacks
|
||||
|
||||
SUBROUTINE f_lammps_get_force (i, ptr) BIND(C)
|
||||
USE ISO_C_BINDING, ONLY : c_int, c_double, c_ptr, C_F_POINTER
|
||||
USE LIBLAMMPS
|
||||
USE keepstuff, ONLY : lmp
|
||||
IMPLICIT NONE
|
||||
INTEGER(c_int), INTENT(IN), VALUE :: i
|
||||
TYPE(c_ptr), INTENT(IN), VALUE :: ptr
|
||||
REAL(c_double), DIMENSION(:,:), POINTER :: force => NULL()
|
||||
REAL(c_double), DIMENSION(:), POINTER :: f => NULL()
|
||||
|
||||
CALL C_F_POINTER(ptr, f, [3])
|
||||
force = lmp%extract_atom('f')
|
||||
f = force(:,i)
|
||||
END SUBROUTINE f_lammps_get_force
|
||||
|
|
@ -0,0 +1,75 @@
|
|||
|
||||
// unit tests for gathering and scattering data from a LAMMPS instance through
|
||||
// the Fortran wrapper
|
||||
|
||||
#include "lammps.h"
|
||||
#include "library.h"
|
||||
#include <cstdint>
|
||||
#include <cstdlib>
|
||||
#include <mpi.h>
|
||||
#include <string>
|
||||
|
||||
#include "gtest/gtest.h"
|
||||
|
||||
// prototypes for Fortran reverse wrapper functions
|
||||
extern "C" {
|
||||
void *f_lammps_with_args();
|
||||
void f_lammps_close();
|
||||
void f_lammps_setup_fix_external();
|
||||
void f_lammps_set_fix_external_callbacks();
|
||||
void f_lammps_get_force(int, double*);
|
||||
void f_lammps_reverse_direction();
|
||||
}
|
||||
|
||||
using namespace LAMMPS_NS;
|
||||
|
||||
class LAMMPS_fixexternal : public ::testing::Test {
|
||||
protected:
|
||||
LAMMPS_NS::LAMMPS *lmp;
|
||||
LAMMPS_fixexternal() = default;
|
||||
~LAMMPS_fixexternal() override = default;
|
||||
|
||||
void SetUp() override
|
||||
{
|
||||
::testing::internal::CaptureStdout();
|
||||
lmp = (LAMMPS_NS::LAMMPS *)f_lammps_with_args();
|
||||
std::string output = ::testing::internal::GetCapturedStdout();
|
||||
EXPECT_STREQ(output.substr(0, 8).c_str(), "LAMMPS (");
|
||||
}
|
||||
void TearDown() override
|
||||
{
|
||||
::testing::internal::CaptureStdout();
|
||||
f_lammps_close();
|
||||
std::string output = ::testing::internal::GetCapturedStdout();
|
||||
EXPECT_STREQ(output.substr(0, 16).c_str(), "Total wall time:");
|
||||
lmp = nullptr;
|
||||
}
|
||||
};
|
||||
|
||||
TEST_F(LAMMPS_fixexternal, callback)
|
||||
{
|
||||
f_lammps_setup_fix_external();
|
||||
f_lammps_set_fix_external_callbacks();
|
||||
lammps_command(lmp, "run 0");
|
||||
double f[3];
|
||||
f_lammps_get_force(1,f);
|
||||
EXPECT_DOUBLE_EQ(f[0], 3.0);
|
||||
EXPECT_DOUBLE_EQ(f[1], -3.0);
|
||||
EXPECT_DOUBLE_EQ(f[2], 3.75);
|
||||
f_lammps_get_force(2,f);
|
||||
EXPECT_DOUBLE_EQ(f[0], -3.0);
|
||||
EXPECT_DOUBLE_EQ(f[1], 3.0);
|
||||
EXPECT_DOUBLE_EQ(f[2], -3.75);
|
||||
|
||||
f_lammps_reverse_direction();
|
||||
f_lammps_set_fix_external_callbacks();
|
||||
lammps_command(lmp, "run 0");
|
||||
f_lammps_get_force(1,f);
|
||||
EXPECT_DOUBLE_EQ(f[0], -1.0);
|
||||
EXPECT_DOUBLE_EQ(f[1], 1.0);
|
||||
EXPECT_DOUBLE_EQ(f[2], -1.25);
|
||||
f_lammps_get_force(2,f);
|
||||
EXPECT_DOUBLE_EQ(f[0], 1.0);
|
||||
EXPECT_DOUBLE_EQ(f[1], -1.0);
|
||||
EXPECT_DOUBLE_EQ(f[2], 1.25);
|
||||
};
|
||||
Loading…
Reference in New Issue