ICODE-ADC/lammps
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Implemented, tested, and documented gather_atoms and variants; added RST docs for lammps_scatter_atoms and lammps_gather_atoms and variants (library.cpp); checked for missing atom map in lammps_gather_atoms_subset; fixed bug in keepstuff.f90; fixed docs for extract_variable

Browse Source
This commit is contained in:
Karl Hammond
2022-10-02 15:28:10 -05:00
parent 2f5e0646d9
commit c5c21bb36c
9 changed files with 796 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files

90
doc/src/Fortran.rst
View File

@ -1070,11 +1070,13 @@ Procedures Bound to the lammps Derived Type
data (if absent, use "all")
:r polymorphic: scalar of type ``REAL(c_double)`` (for *equal*-style
variables and others that are *equal*-compatible), vector of type
``REAL(c_double), DIMENSION(nlocal)`` for *atom*-style variables, or
``CHARACTER(LEN=*)`` for *string*-style and compatible variables. Strings
whose length is too short to hold the result will be truncated.
Allocatable strings must be allocated before this function is called;
see note at :f:func:`extract_global` regarding allocatable strings.
``REAL(c_double), DIMENSION(:), ALLOCATABLE`` for *atom*- or *vector*-style
variables, or ``CHARACTER(LEN=*)`` for *string*-style and compatible
variables. Strings whose length is too short to hold the result will be
truncated. Allocatable strings must be allocated before this function is
called; see note at :f:func:`extract_global` regarding allocatable strings.
Allocatable arrays (for *atom*- and *vector*-style data) will be
reallocated on assignment.
.. note::
@ -1086,6 +1088,84 @@ Procedures Bound to the lammps Derived Type
--------
.. f:function:: gather_atoms(name, count, data)
This function calls :c:func:`lammps_gather_atoms` to gather the named
atom-based entity for all atoms on all processors and return it in the
vector *data*. The vector *data* will be ordered by atom
ID, which requires consecutive atom IDs (1 to *natoms*).
.. versionadded:: TBD
If you need a similar array but have non-consecutive atom IDs, see
:f:func:`gather_atoms_concat`; for a similar array but for a subset
of atoms, see :f:func:`gather_atoms_subset`.
The *data* array will be ordered in groups of *count* values, sorted by atom
ID (e.g., if *name* is *x* and *count* = 3, then *data* = x[1][1], x[2][1],
x[3][1], x[1][2], x[2][2], x[3][2], x[1][3], :math:`\dots`);
*data* must be ``ALLOCATABLE`` and will be allocated to length
(*count* :math:`\times` *natoms*), as queried by
:f:func:`extract_setting`.
:p character(len=\*) name: desired quantity (e.g., *x* or *mask*)
:p integer(c_int) count: number of per-atom values you expect per atom
(e.g., 1 for *type*, *mask*, or *charge*; 3 for *x*, *v*, or *f*). Use
*count* = 3 with *image* if you want a single image flag unpacked into
*x*/*y*/*z* components.
:p real(c_double) data [dimension(:),allocatable]: array into which to store
the data. Array *must* have the ``ALLOCATABLE`` attribute and be of rank 1
(i.e., ``DIMENSION(:)``). If this array is already allocated, it will be
reallocated to fit the length of the incoming data.
.. note::
If you want data from this function to be accessible as a two-dimensional
array, you can declare a rank-2 pointer and reassign it, like so:
.. code-block:: Fortran
USE, INTRINSIC :: ISO_C_BINDING
USE LIBLAMMPS
TYPE(lammps) :: lmp
REAL(c_double), DIMENSION(:), ALLOCATABLE, TARGET :: xdata
REAL(c_double), DIMENSION(:,:), POINTER :: x
! other code to set up, etc.
CALL lmp%gather_atoms('x',3,xdata)
x(1:3,1:size(xdata)/3) => xdata
You can then access the *y*\ -component of atom 3 with ``x(2,3)``.
--------
.. f:function:: gather_atoms_concat(name, count, data)
This function calls :c:func:`lammps_gather_atoms_concat` to gather the named
atom-based entity for all atoms on all processors and return it in the
vector *data*.
.. versionadded:: TBD
The vector *data* will not be ordered by atom ID, and there is no
restriction on the IDs being consecutive. If you need the IDs, you can do
another :f:func:`gather_atoms_concat` with *name* set to ``id``.
If you need a similar array but have consecutive atom IDs, see
:f:func:`gather_atoms`; for a similar array but for a subset of atoms, see
:f:func:`gather_atoms_subset`.
:p character(len=\*) name: desired quantity (e.g., *x* or *mask*)
:p integer(c_int) count: number of per-atom values you expect per atom
(e.g., 1 for *type*, *mask*, or *charge*; 3 for *x*, *v*, or *f*). Use
*count* = 3 with *image* if you want a single image flag unpacked into
*x*/*y*/*z* components.
:p real(c_double) data [dimension(:),allocatable]: array into which to store
the data. Array *must* have the ``ALLOCATABLE`` attribute and be of rank 1
(i.e., ``DIMENSION(:)``). If this array is already allocated, it will be
reallocated to fit the length of the incoming data.
--------
.. f:function:: version()
This method returns the numeric LAMMPS version like

237
fortran/lammps.f90
View File

@ -29,9 +29,9 @@
!
MODULE LIBLAMMPS
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_associated, &
c_loc, c_int, c_int64_t, c_char, c_null_char, c_double, c_size_t, &
c_f_pointer
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, C_ASSOCIATED, &
C_LOC, c_int, c_int64_t, c_char, c_null_char, c_double, c_size_t, &
C_F_POINTER
IMPLICIT NONE
PRIVATE
@ -103,6 +103,17 @@ MODULE LIBLAMMPS
PROCEDURE :: extract_fix => lmp_extract_fix
PROCEDURE :: extract_variable => lmp_extract_variable
PROCEDURE :: set_variable => lmp_set_variable
PROCEDURE, PRIVATE :: lmp_gather_atoms_int, lmp_gather_atoms_double
GENERIC :: gather_atoms => lmp_gather_atoms_int, &
lmp_gather_atoms_double
PROCEDURE, PRIVATE :: lmp_gather_atoms_concat_int
PROCEDURE, PRIVATE :: lmp_gather_atoms_concat_double
GENERIC :: gather_atoms_concat => lmp_gather_atoms_concat_int, &
lmp_gather_atoms_concat_double
PROCEDURE, PRIVATE :: lmp_gather_atoms_subset_int
PROCEDURE, PRIVATE :: lmp_gather_atoms_subset_double
GENERIC :: gather_atoms_subset => lmp_gather_atoms_subset_int, &
lmp_gather_atoms_subset_double
!
PROCEDURE :: version => lmp_version
PROCEDURE,NOPASS :: get_os_info => lmp_get_os_info
@ -394,11 +405,28 @@ MODULE LIBLAMMPS
INTEGER(c_int) :: lammps_set_variable
END FUNCTION lammps_set_variable
!SUBROUTINE lammps_gather_atoms
SUBROUTINE lammps_gather_atoms(handle, name, type, count, data) BIND(C)
IMPORT :: c_int, c_ptr
IMPLICIT NONE
TYPE(c_ptr), VALUE :: handle, name, data
INTEGER(c_int), VALUE :: type, count
END SUBROUTINE lammps_gather_atoms
!SUBROUTINE lammps_gather_atoms_concat
SUBROUTINE lammps_gather_atoms_concat(handle, name, type, count, data) &
BIND(C)
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(c_ptr), VALUE :: handle, name, data
INTEGER(c_int), VALUE :: type, count
END SUBROUTINE lammps_gather_atoms_concat
!SUBROUTINE lammps_gather_atoms_subset
SUBROUTINE lammps_gather_atoms_subset(handle, name, type, count, ndata, &
ids, data) BIND(C)
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(c_ptr), VALUE :: handle, name, ids, data
INTEGER(c_int), VALUE :: type, count, ndata
END SUBROUTINE lammps_gather_atoms_subset
!SUBROUTINE lammps_scatter_atoms
@ -1175,6 +1203,203 @@ CONTAINS
END IF
END SUBROUTINE lmp_set_variable
! equivalent function to lammps_gather_atoms (for integers)
SUBROUTINE lmp_gather_atoms_int(self, name, count, data)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER(c_int), INTENT(IN) :: count
INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET, INTENT(OUT) :: data
TYPE(c_ptr) :: Cdata, Cname
INTEGER(c_int) :: natoms
INTEGER(c_int), PARAMETER :: Ctype = 0_c_int
REAL(C_double) :: dnatoms
CHARACTER(LEN=80) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, 'gather_atoms&
& requires "count" to be 1 or 3 [Fortran/gather_atoms]')
END IF
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function gather_atoms with more than', &
HUGE(0_c_int), 'atoms [Fortran/gather_atoms]'
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, error_msg)
END IF
natoms = NINT(dnatoms, c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
ALLOCATE(data(natoms*count))
Cdata = C_LOC(data(1))
CALL lammps_gather_atoms(self%handle, Cname, Ctype, count, Cdata)
CALL lammps_free(Cname)
END SUBROUTINE lmp_gather_atoms_int
! equivalent function to lammps_gather_atoms (for doubles)
SUBROUTINE lmp_gather_atoms_double(self, name, count, data)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER(c_int), INTENT(IN) :: count
REAL(c_double), DIMENSION(:), ALLOCATABLE, TARGET, INTENT(OUT) :: data
TYPE(c_ptr) :: Cdata, Cname
INTEGER(c_int) :: natoms
INTEGER(c_int), PARAMETER :: Ctype = 1_c_int
REAL(C_double) :: dnatoms
CHARACTER(LEN=80) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, 'gather_atoms&
& requires "count" to be 1 or 3 [Fortran/gather_atoms]')
END IF
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function gather_atoms with more than', &
HUGE(0_c_int), 'atoms [Fortran/gather_atoms]'
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, error_msg)
END IF
natoms = NINT(dnatoms, c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
ALLOCATE(data(natoms*count))
Cdata = C_LOC(data(1))
CALL lammps_gather_atoms(self%handle, Cname, Ctype, count, Cdata)
CALL lammps_free(Cname)
END SUBROUTINE lmp_gather_atoms_double
! equivalent function to lammps_gather_atoms_concat (for integers)
SUBROUTINE lmp_gather_atoms_concat_int(self, name, count, data)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER(c_int), INTENT(IN) :: count
INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET, INTENT(OUT) :: data
TYPE(c_ptr) :: Cdata, Cname
INTEGER(c_int) :: natoms
INTEGER(c_int), PARAMETER :: Ctype = 0_c_int
REAL(C_double) :: dnatoms
CHARACTER(LEN=80) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'gather_atoms_concat requires "count" to be 1 or 3 &
&[Fortran/gather_atoms_concat]')
END IF
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function gather_atoms_concat with more than', &
HUGE(0_c_int), 'atoms [Fortran/gather_atoms_concat]'
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, error_msg)
END IF
natoms = NINT(dnatoms, c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
ALLOCATE(data(natoms*count))
Cdata = C_LOC(data(1))
CALL lammps_gather_atoms_concat(self%handle, Cname, Ctype, count, Cdata)
CALL lammps_free(Cname)
END SUBROUTINE lmp_gather_atoms_concat_int
! equivalent function to lammps_gather_atoms_concat (for doubles)
SUBROUTINE lmp_gather_atoms_concat_double(self, name, count, data)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER(c_int), INTENT(IN) :: count
REAL(c_double), DIMENSION(:), ALLOCATABLE, TARGET, INTENT(OUT) :: data
TYPE(c_ptr) :: Cdata, Cname
INTEGER(c_int) :: natoms
INTEGER(c_int), PARAMETER :: Ctype = 1_c_int
REAL(C_double) :: dnatoms
CHARACTER(LEN=80) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'gather_atoms_concat requires "count" to be 1 or 3 &
&[Fortran/gather_atoms_concat]')
END IF
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function gather_atoms_concat with more than', &
HUGE(0_c_int), 'atoms [Fortran/gather_atoms_concat]'
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, error_msg)
END IF
natoms = NINT(dnatoms, c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
ALLOCATE(data(natoms*count))
Cdata = C_LOC(data(1))
CALL lammps_gather_atoms_concat(self%handle, Cname, Ctype, count, Cdata)
CALL lammps_free(Cname)
END SUBROUTINE lmp_gather_atoms_concat_double
! equivalent function to lammps_gather_atoms_subset (for integers)
SUBROUTINE lmp_gather_atoms_subset_int(self, name, count, ids, data)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER(c_int), INTENT(IN) :: count
INTEGER(c_int), DIMENSION(:), TARGET, INTENT(IN) :: ids
INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET, INTENT(OUT) :: data
INTEGER(c_int) :: ndata
TYPE(c_ptr) :: Cdata, Cname, Cids
INTEGER(c_int), PARAMETER :: Ctype = 0_c_int
CHARACTER(LEN=80) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, 'gather_atoms&
& requires "count" to be 1 or 3 [Fortran/gather_atoms]')
END IF
ndata = SIZE(ids, KIND=c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
ALLOCATE(data(ndata*count))
data = -1_c_int
Cdata = C_LOC(data(1))
Cids = C_LOC(ids(1))
CALL lammps_gather_atoms_subset(self%handle, Cname, Ctype, count, &
ndata, Cids, Cdata)
CALL lammps_free(Cname)
END SUBROUTINE lmp_gather_atoms_subset_int
! equivalent function to lammps_gather_atoms_subset (for doubles)
SUBROUTINE lmp_gather_atoms_subset_double(self, name, count, ids, data)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER(c_int), INTENT(IN) :: count
INTEGER(c_int), DIMENSION(:), TARGET, INTENT(IN) :: ids
REAL(c_double), DIMENSION(:), ALLOCATABLE, TARGET, INTENT(OUT) :: data
INTEGER(c_int) :: ndata
TYPE(c_ptr) :: Cdata, Cname, Cids
INTEGER(c_int), PARAMETER :: Ctype = 1_c_int
CHARACTER(LEN=80) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, 'gather_atoms&
& requires "count" to be 1 or 3 [Fortran/gather_atoms]')
END IF
ndata = SIZE(ids, KIND=c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
ALLOCATE(data(ndata*count))
Cdata = C_LOC(data(1))
Cids = C_LOC(ids(1))
CALL lammps_gather_atoms_subset(self%handle, Cname, Ctype, count, &
ndata, Cids, Cdata)
CALL lammps_free(Cname)
END SUBROUTINE lmp_gather_atoms_subset_double
! equivalent function to lammps_version
INTEGER FUNCTION lmp_version(self)
CLASS(lammps), INTENT(IN) :: self

221
src/library.cpp
View File

@ -2222,21 +2222,38 @@ int lammps_set_variable(void *handle, char *name, char *str)
// Library functions for scatter/gather operations of data
// ----------------------------------------------------------------------
/** Gather the named atom-based entity for all atoms across all processors,
* in order.
*
\verbatim embed:rst
This subroutine gathers data for all atoms and stores them in a
one-dimensional array allocated by the user. The data will be ordered by
atom ID, which requires consecutive atom IDs (1 to *natoms*\ ). If you need
a similar array but have non-consecutive atom IDs, see
:cpp:func:`lammps_gather_atoms_concat`; for a similar array but for a subset
of atoms, see :cpp:func:`lammps_gather_atoms_subset`.
The *data* array will be ordered in groups of *count* values, sorted by atom ID
(e.g., if *name* is *x* and *count* = 3, then *data* = x[0][0], x[0][1],
x[0][2], x[1][0], x[1][1], x[1][2], x[2][0], :math:`\dots`);
*data* must be pre-allocated by the caller to length (*count* :math:`\times`
*natoms*), as queried by :cpp:func:`lammps_get_natoms`,
:cpp:func:`lammps_extract_global`, or :cpp:func:`lammps_extract_setting`.
\endverbatim
*
* \param handle pointer to a previously created LAMMPS instance
* \param name desired quantity (e.g., *x* or *charge*)
* \param type 0 for ``int`` values, 1 for ``double`` values
* \param count number of per-atom values (e.g., 1 for *type* or *charge*,
* 3 for *x* or *f*); use *count* = 3 with *image* if you want
* a single image flag unpacked into (*x*,*y*,*z*) components.
* \param data per-atom values packed in a 1-dimensional array of length
* *natoms* \* *count*.
*
*/
/* ----------------------------------------------------------------------
gather the named atom-based entity for all atoms
return it in user-allocated data
data will be ordered by atom ID
requirement for consecutive atom IDs (1 to N)
see gather_atoms_concat() to return data for all atoms, unordered
see gather_atoms_subset() to return data for only a subset of atoms
name = desired quantity (e.g., x or charge)
type = 0 for integer values, 1 for double values
count = # of per-atom values (e.g., 1 for type or charge, 3 for x or f)
use count = 3 with "image" if want single image flag unpacked into xyz
return atom-based values in 1d data, ordered by count, then by atom ID
(e.g., x[0][0],x[0][1],x[0][2],x[1][0],x[1][1],x[1][2],x[2][0],...);
data must be pre-allocated by caller to correct length
correct length = count*Natoms, as queried by get_natoms()
method:
alloc and zero count*Natom length vector
loop over Nlocal to fill vector with my values
@ -2357,23 +2374,43 @@ void lammps_gather_atoms(void *handle, char *name, int type, int count, void *da
END_CAPTURE
}
/** Gather the named atom-based entity for all atoms across all processors,
* unordered.
*
\verbatim embed:rst
This subroutine gathers data for all atoms and stores them in a
one-dimensional array allocated by the user. The data will be a concatenation
of chunks from each processor's owned atoms, in whatever order the atoms are
in on each processor. This process has no requirement that the atom IDs be
consecutive. If you need the ID of each atom, you can do another
:cpp:func:`lammps_gather_atoms_concat` call with *name* set to ``id``.
If you have consecutive IDs and want the data to be in order, use
:cpp:func:`lammps_gather_atoms`; for a similar array but for a subset
of atoms, use :cpp:func:`lammps_gather_atoms_subset`.
The *data* array will be in groups of *count* values, with *natoms*
groups total, but not in order by atom ID (e.g., if *name* is *x* and *count*
is 3, then *data* might be something like = x[10][0], x[10][1], x[10][2],
x[2][0], x[2][1], x[2][2], x[4][0], :math:`\dots`); *data* must be
pre-allocated by the caller to length (*count* :math:`\times` *natoms*), as
queried by :cpp:func:`lammps_get_natoms`,
:cpp:func:`lammps_extract_global`, or :cpp:func:`lammps_extract_setting`.
\endverbatim
*
* \param handle: pointer to a previously created LAMMPS instance
* \param name: desired quantity (e.g., *x* or *charge*\ )
* \param type: 0 for ``int`` values, 1 for ``double`` values
* \param count: number of per-atom values (e.g., 1 for *type* or *charge*,
* 3 for *x* or *f*); use *count* = 3 with "image" if you want
* single image flags unpacked into (*x*,*y*,*z*)
* \param data: per-atom values packed in a 1-dimensional array of length
* *natoms* \* *count*.
*
*/
/* ----------------------------------------------------------------------
gather the named atom-based entity for all atoms
return it in user-allocated data
data will be a concatenation of chunks of each proc's atoms,
in whatever order the atoms are on each proc
no requirement for consecutive atom IDs (1 to N)
can do a gather_atoms_concat for "id" if need to know atom IDs
see gather_atoms() to return data ordered by consecutive atom IDs
see gather_atoms_subset() to return data for only a subset of atoms
name = desired quantity (e.g., x or charge)
type = 0 for integer values, 1 for double values
count = # of per-atom values (e.g., 1 for type or charge, 3 for x or f)
use count = 3 with "image" if want single image flag unpacked into xyz
return atom-based values in 1d data, ordered by count, then by atom
(e.g., x[0][0],x[0][1],x[0][2],x[1][0],x[1][1],x[1][2],x[2][0],...)
data must be pre-allocated by caller to correct length
correct length = count*Natoms, as queried by get_natoms()
method:
Allgather Nlocal atoms from each proc into data
------------------------------------------------------------------------- */
@ -2503,23 +2540,38 @@ void lammps_gather_atoms_concat(void *handle, char *name, int type, int count, v
END_CAPTURE
}
/** Gather the named atom-based entity for a subset of atoms.
*
\verbatim embed:rst
This subroutine gathers data for the requested atom IDs and stores them in a
one-dimensional array allocated by the user. The data will be ordered by atom
ID, but there is no requirement that the IDs be consecutive. If you wish to
return a similar array for *all* the atoms, use :cpp:func:`lammps_gather_atoms`
or :cpp:func:`lammps_gather_atoms_concat`.
The *data* array will be in groups of *count* values, sorted by atom ID
(e.g., if *name* is *x* and *count* = 3, then *data* might look like
x[100][0], x[100][1], x[100][2], x[101][0], x[101][1], x[101][2], x[102][0],
:math:`\dots`); *data* must be pre-allocated by the caller to length (*count*
:math:`\times` *ndata*).
\endverbatim
*
* \param handle: pointer to a previously created LAMMPS instance
* \param name: desired quantity (e.g., *x* or *charge*)
* \param type: 0 for ``int`` values, 1 for ``double`` values
* \param count: number of per-atom values (e.g., 1 for *type* or *charge*,
* 3 for *x* or *f*); use *count* = 3 with "image" if you want
* single image flags unpacked into (*x*,*y*,*z*)
* \param ndata: number of atoms for which to return data (can be all of them)
* \param ids: list of *ndata* atom IDs for which to return data
* \param data: per-atom values packed in a 1-dimensional array of length
* *ndata* \* *count*.
*
*/
/* ----------------------------------------------------------------------
gather the named atom-based entity for a subset of atoms
return it in user-allocated data
data will be ordered by requested atom IDs
no requirement for consecutive atom IDs (1 to N)
see gather_atoms() to return data for all atoms, ordered by consecutive IDs
see gather_atoms_concat() to return data for all atoms, unordered
name = desired quantity (e.g., x or charge)
type = 0 for integer values, 1 for double values
count = # of per-atom values (e.g., 1 for type or charge, 3 for x or f)
use count = 3 with "image" if want single image flag unpacked into xyz
ndata = # of atoms to return data for (could be all atoms)
ids = list of Ndata atom IDs to return data for
return atom-based values in 1d data, ordered by count, then by atom
(e.g., x[0][0],x[0][1],x[0][2],x[1][0],x[1][1],x[1][2],x[2][0],...)
data must be pre-allocated by caller to correct length
correct length = count*Ndata
method:
alloc and zero count*Ndata length vector
loop over Ndata to fill vector with my values
@ -2540,12 +2592,13 @@ void lammps_gather_atoms_subset(void *handle, char *name, int type, int count,
int i,j,m,offset;
tagint id;
// error if tags are not defined
// error if tags are not defined or no atom map
// NOTE: test that name = image or ids is not a 64-bit int in code?
int flag = 0;
if (lmp->atom->tag_enable == 0) flag = 1;
if (lmp->atom->natoms > MAXSMALLINT) flag = 1;
if (lmp->atom->map_style == Atom::MAP_NONE) flag = 1;
if (flag) {
if (lmp->comm->me == 0)
lmp->error->warning(FLERR,"Library error in lammps_gather_atoms_subset");
@ -2649,18 +2702,35 @@ void lammps_gather_atoms_subset(void *handle, char *name, int type, int count,
END_CAPTURE
}
/** Scatter the named atom-based entities in *data* to all processors.
*
\verbatim embed:rst
This subroutine takes data stored in a one-dimensional array supplied by the
user and scatters them to all atoms on all processors. The data must be
ordered by atom ID, with the requirement that the IDs be consecutive.
Use :cpp:func:`lammps_scatter_atoms_subset` to scatter data for some (or all)
atoms, unordered.
The *data* array needs to be ordered in groups of *count* values, sorted by
atom ID (e.g., if *name* is *x* and *count* = 3, then
*data* = x[0][0], x[0][1], x[0][2], x[1][0], x[1][1], x[1][2], x[2][0],
:math:`\dots`); *data* must be of length (*count* :math:`\times` *natoms*).
\endverbatim
*
* \param handle pointer to a previously created LAMMPS instance
* \param name desired quantity (e.g., *x* or *charge*)
* \param type 0 for ``int`` values, 1 for ``double`` values
* \param count number of per-atom values (e.g., 1 for *type* or *charge*,
* 3 for *x* or *f*); use *count* = 3 with *image* if you have
* a single image flag packed into (*x*,*y*,*z*) components.
* \param data per-atom values packed in a 1-dimensional array of length
* *natoms* \* *count*.
*
*/
/* ----------------------------------------------------------------------
scatter the named atom-based entity in data to all atoms
data is ordered by atom ID
requirement for consecutive atom IDs (1 to N)
see scatter_atoms_subset() to scatter data for some (or all) atoms, unordered
name = desired quantity (e.g., x or charge)
type = 0 for integer values, 1 for double values
count = # of per-atom values (e.g., 1 for type or charge, 3 for x or f)
use count = 3 with "image" for xyz to be packed into single image flag
data = atom-based values in 1d data, ordered by count, then by atom ID
(e.g., x[0][0],x[0][1],x[0][2],x[1][0],x[1][1],x[1][2],x[2][0],...)
data must be correct length = count*Natoms, as queried by get_natoms()
method:
loop over Natoms, if I own atom ID, set its values from data
------------------------------------------------------------------------- */
@ -2765,6 +2835,38 @@ void lammps_scatter_atoms(void *handle, char *name, int type, int count, void *d
END_CAPTURE
}
/** Scatter the named atom-based entities in *data* from a subset of atoms
* to all processors.
*
\verbatim embed:rst
This subroutine takes data stored in a one-dimensional array supplied by the
user and scatters them to a subset of atoms on all processors. The array
*data* contains data associated with atom IDs, but there is no requirement that
the IDs be consecutive, as they are provided in a separate array.
Use :cpp:func:`lammps_scatter_atoms` to scatter data for all atoms, in order.
The *data* array needs to be organized in groups of *count* values, with the
groups in the same order as the array *ids*. For example, if you want *data*
to be the array {x[1][0], x[1][1], x[1][2], x[100][0], x[100][1], x[100][2],
x[57][0], x[57][1], x[57][2]}, then *count* = 3, *ndata* = 3, and *ids* would
be {1, 100, 57}.
\endverbatim
*
* \param handle: pointer to a previously created LAMMPS instance
* \param name: desired quantity (e.g., *x* or *charge*)
* \param type: 0 for ``int`` values, 1 for ``double`` values
* \param count: number of per-atom values (e.g., 1 for *type* or *charge*,
* 3 for *x* or *f*); use *count* = 3 with "image" if you have
* all the image flags packed into (*xyz*)
* \param ndata: number of atoms listed in *ids* and *data* arrays
* \param ids: list of *ndata* atom IDs to scatter data to
* \param data per-atom values packed in a 1-dimensional array of length
* *ndata* \* *count*.
*
*/
/* ----------------------------------------------------------------------
scatter the named atom-based entity in data to a subset of atoms
data is ordered by provided atom IDs
@ -3528,11 +3630,12 @@ void lammps_gather_subset(void *handle, char *name,
int i,j,m,offset,ltype;
tagint id;
// error if tags are not defined or not consecutive
// error if tags are not defined or no atom map
int flag = 0;
if (lmp->atom->tag_enable == 0) flag = 1;
if (lmp->atom->natoms > MAXSMALLINT) flag = 1;
if (lmp->atom->map_style == Atom::MAP_NONE) flag = 1;
if (flag) {
if (lmp->comm->me == 0)
lmp->error->warning(FLERR,"Library error in lammps_gather_subset");

4
unittest/fortran/CMakeLists.txt
View File

@ -74,6 +74,10 @@ if(CMAKE_Fortran_COMPILER)
target_link_libraries(test_fortran_extract_variable PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
add_test(NAME FortranExtractVariable COMMAND test_fortran_extract_variable)
add_executable(test_fortran_gather_scatter wrap_gather_scatter.cpp test_fortran_gather_scatter.f90)
target_link_libraries(test_fortran_gather_scatter PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
add_test(NAME FortranGatherScatter COMMAND test_fortran_gather_scatter)
else()
message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler")
endif()

14
unittest/fortran/keepstuff.f90
View File

@ -3,24 +3,26 @@ MODULE keepstuff
IMPLICIT NONE
TYPE(LAMMPS) :: lmp
INTEGER :: mycomm
CHARACTER(len=40), DIMENSION(3), PARAMETER :: demo_input = &
[ CHARACTER(len=40) :: &
CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = &
[ CHARACTER(LEN=40) :: &
'region box block 0 $x 0 2 0 2', &
'create_box 1 box', &
'create_atoms 1 single 1.0 1.0 ${zpos}' ]
CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: big_input = &
[ CHARACTER(len=40) :: &
[ CHARACTER(LEN=40) :: &
'region box block 0 $x 0 3 0 4', &
'create_box 1 box', &
'create_atoms 1 single 1.0 1.0 ${zpos}' ]
CHARACTER(len=40), DIMENSION(2), PARAMETER :: cont_input = &
[ CHARACTER(len=40) :: &
CHARACTER(LEN=40), DIMENSION(2), PARAMETER :: cont_input = &
[ CHARACTER(LEN=40) :: &
'create_atoms 1 single &', &
' 0.2 0.1 0.1' ]
CHARACTER(LEN=40), DIMENSION(1), PARAMETER :: more_input = &
[ CHARACTER(LEN=40) :: 'create_atoms 1 single 0.5 0.5 0.5' ]
CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: pair_input = &
[ CHARACTER(LEN=40) :: &
'pair_style lj/cut 2.5', &
'pair_coeff 1 1 1.0 1.0', &
'mass 1 1.0' ]
'mass 1 2.0' ]
END MODULE keepstuff

42
unittest/fortran/test_fortran_extract_atom.f90
View File

@ -1,26 +1,7 @@
MODULE keepatom
USE liblammps
TYPE(LAMMPS) :: lmp
CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = &
[ CHARACTER(len=40) :: &
'region box block 0 $x 0 3 0 4', &
'create_box 1 box', &
'create_atoms 1 single 1.0 1.0 ${zpos}' ]
CHARACTER(LEN=40), DIMENSION(2), PARAMETER :: cont_input = &
[ CHARACTER(len=40) :: &
'create_atoms 1 single &', &
' 0.2 0.1 0.1' ]
CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: pair_input = &
[ CHARACTER(LEN=40) :: &
'pair_style lj/cut 2.5', &
'pair_coeff 1 1 1.0 1.0', &
'mass 1 2.0' ]
END MODULE keepatom
FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args")
USE ISO_C_BINDING, ONLY: c_ptr
USE liblammps
USE keepatom, ONLY: lmp
USE keepstuff, ONLY: lmp
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_with_args
CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = &
@ -34,7 +15,7 @@ END FUNCTION f_lammps_with_args
SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close")
USE ISO_C_BINDING, ONLY: c_null_ptr
USE liblammps
USE keepatom, ONLY: lmp
USE keepstuff, ONLY: lmp
IMPLICIT NONE
CALL lmp%close()
@ -43,19 +24,18 @@ END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_extract_atom () BIND(C)
USE LIBLAMMPS
USE keepatom, ONLY : lmp, demo_input, cont_input, pair_input
USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input
IMPLICIT NONE
CALL lmp%commands_list(demo_input)
CALL lmp%commands_list(big_input)
CALL lmp%commands_list(cont_input)
CALL lmp%commands_list(pair_input)
! CALL lmp%command('run 0')
END SUBROUTINE f_lammps_setup_extract_atom
FUNCTION f_lammps_extract_atom_mass () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
USE LIBLAMMPS
USE keepatom, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL(C_double) :: f_lammps_extract_atom_mass
REAL(C_double), DIMENSION(:), POINTER :: mass => NULL()
@ -67,7 +47,7 @@ END FUNCTION f_lammps_extract_atom_mass
FUNCTION f_lammps_extract_atom_tag_int (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
INTEGER(C_int) :: f_lammps_extract_atom_tag_int
@ -80,7 +60,7 @@ END FUNCTION f_lammps_extract_atom_tag_int
FUNCTION f_lammps_extract_atom_tag_int64 (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int64_t
USE LIBLAMMPS
USE keepatom, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int64_t), INTENT(IN), VALUE :: i
INTEGER(C_int64_t) :: f_lammps_extract_atom_tag_int64
@ -93,7 +73,7 @@ END FUNCTION f_lammps_extract_atom_tag_int64
FUNCTION f_lammps_extract_atom_type(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
INTEGER(C_int) :: f_lammps_extract_atom_type
@ -106,7 +86,7 @@ END FUNCTION f_lammps_extract_atom_type
FUNCTION f_lammps_extract_atom_mask(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
INTEGER(C_int) :: f_lammps_extract_atom_mask
@ -119,7 +99,7 @@ END FUNCTION f_lammps_extract_atom_mask
SUBROUTINE f_lammps_extract_atom_x (i, x) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double), DIMENSION(3) :: x
@ -132,7 +112,7 @@ END SUBROUTINE f_lammps_extract_atom_x
SUBROUTINE f_lammps_extract_atom_v (i, v) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double), DIMENSION(3) :: v

43
unittest/fortran/test_fortran_extract_compute.f90
View File

@ -1,27 +1,7 @@
MODULE keepcompute
USE liblammps
TYPE(LAMMPS) :: lmp
CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = &
[ CHARACTER(len=40) :: &
'region box block 0 $x 0 3 0 4', &
'create_box 1 box', &
'create_atoms 1 single 1.0 1.0 ${zpos}' ]
CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: cont_input = &
[ CHARACTER(len=40) :: &
'create_atoms 1 single &', &
' 0.2 0.1 0.1', &
'create_atoms 1 single 0.5 0.5 0.5' ]
CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: pair_input = &
[ CHARACTER(LEN=40) :: &
'pair_style lj/cut 2.5', &
'pair_coeff 1 1 1.0 1.0', &
'mass 1 2.0' ]
END MODULE keepcompute
FUNCTION f_lammps_with_args() BIND(C)
USE ISO_C_BINDING, ONLY: c_ptr
USE liblammps
USE keepcompute, ONLY: lmp
USE keepstuff, ONLY: lmp
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_with_args
CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = &
@ -35,7 +15,7 @@ END FUNCTION f_lammps_with_args
SUBROUTINE f_lammps_close() BIND(C)
USE ISO_C_BINDING, ONLY: c_null_ptr
USE liblammps
USE keepcompute, ONLY: lmp
USE keepstuff, ONLY: lmp
IMPLICIT NONE
CALL lmp%close()
@ -44,11 +24,12 @@ END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_extract_compute () BIND(C)
USE LIBLAMMPS
USE keepcompute, ONLY : lmp, demo_input, cont_input, pair_input
USE keepstuff, ONLY : lmp, big_input, cont_input, more_input, pair_input
IMPLICIT NONE
CALL lmp%commands_list(demo_input)
CALL lmp%commands_list(big_input)
CALL lmp%commands_list(cont_input)
CALL lmp%commands_list(more_input)
CALL lmp%commands_list(pair_input)
CALL lmp%command("compute peratompe all pe/atom") ! per-atom vector
call lmp%command("compute stress all stress/atom thermo_temp") ! per-atom array
@ -64,7 +45,7 @@ END SUBROUTINE f_lammps_setup_extract_compute
FUNCTION f_lammps_extract_compute_peratom_vector (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepcompute, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double) :: f_lammps_extract_compute_peratom_vector
@ -77,7 +58,7 @@ END FUNCTION f_lammps_extract_compute_peratom_vector
FUNCTION f_lammps_extract_compute_peratom_array (i,j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepcompute, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i, j
REAL(C_double) :: f_lammps_extract_compute_peratom_array
@ -90,7 +71,7 @@ END FUNCTION f_lammps_extract_compute_peratom_array
FUNCTION f_lammps_extract_compute_global_scalar () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepcompute, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL(C_double) :: f_lammps_extract_compute_global_scalar
REAL(C_double), POINTER :: scalar
@ -102,7 +83,7 @@ END FUNCTION f_lammps_extract_compute_global_scalar
FUNCTION f_lammps_extract_compute_global_vector (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepcompute, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(C_double) :: f_lammps_extract_compute_global_vector
@ -115,7 +96,7 @@ END FUNCTION f_lammps_extract_compute_global_vector
FUNCTION f_lammps_extract_compute_global_array (i,j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepcompute, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i, j
REAL(C_double) :: f_lammps_extract_compute_global_array
@ -128,7 +109,7 @@ END FUNCTION f_lammps_extract_compute_global_array
FUNCTION f_lammps_extract_compute_local_vector (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepcompute, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(C_double) :: f_lammps_extract_compute_local_vector
@ -141,7 +122,7 @@ END FUNCTION f_lammps_extract_compute_local_vector
FUNCTION f_lammps_extract_compute_local_array (i, j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepcompute, ONLY : lmp
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i, j
REAL(C_double) :: f_lammps_extract_compute_local_array

143
unittest/fortran/test_fortran_gather_scatter.f90 Normal file
View File

@ -0,0 +1,143 @@
FUNCTION f_lammps_with_args() BIND(C)
USE ISO_C_BINDING, ONLY: c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY: lmp
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_with_args
CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = &
[ CHARACTER(len=12) :: 'liblammps', '-log', 'none', &
'-echo','screen','-nocite','-var','zpos','1.5','-var','x','2']
lmp = lammps(args)
f_lammps_with_args = lmp%handle
END FUNCTION f_lammps_with_args
SUBROUTINE f_lammps_close() BIND(C)
USE ISO_C_BINDING, ONLY: c_null_ptr
USE liblammps
USE keepstuff, ONLY: lmp
IMPLICIT NONE
CALL lmp%close()
lmp%handle = c_null_ptr
END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_gather_scatter () BIND(C)
USE LIBLAMMPS
USE keepstuff, ONLY : lmp, big_input, cont_input, more_input
IMPLICIT NONE
CALL lmp%command('atom_modify map array')
CALL lmp%commands_list(big_input)
CALL lmp%commands_list(cont_input)
CALL lmp%commands_list(more_input)
END SUBROUTINE f_lammps_setup_gather_scatter
FUNCTION f_lammps_gather_mask (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
INTEGER(c_int) :: f_lammps_gather_mask
INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask
CALL lmp%gather_atoms('mask', 1_c_int, mask)
f_lammps_gather_mask = mask(i)
END FUNCTION f_lammps_gather_mask
FUNCTION f_lammps_gather_position (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(c_double) :: f_lammps_gather_position
REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions
CALL lmp%gather_atoms('x', 3_c_int, positions)
f_lammps_gather_position = positions(i)
END FUNCTION f_lammps_gather_position
FUNCTION f_lammps_gather_concat_mask (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
INTEGER(c_int) :: f_lammps_gather_concat_mask
INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask, tag
INTEGER :: j
CALL lmp%gather_atoms_concat('mask', 1_c_int, mask)
CALL lmp%gather_atoms_concat('id', 1_c_int, tag)
DO j = 1, SIZE(tag)
IF ( tag(j) == i ) THEN
f_lammps_gather_concat_mask = mask(j)
RETURN
END IF
END DO
f_lammps_gather_concat_mask = -1
END FUNCTION f_lammps_gather_concat_mask
FUNCTION f_lammps_gather_concat_position (xyz, id) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: id, xyz
REAL(c_double) :: f_lammps_gather_concat_position
REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions
INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: tag
INTEGER :: j
CALL lmp%gather_atoms_concat('x', 3_c_int, positions)
CALL lmp%gather_atoms_concat('id', 1_c_int, tag)
DO j = 1, SIZE(tag)
IF ( tag(j) == id ) THEN
f_lammps_gather_concat_position = positions((j-1)*3 + xyz)
END IF
END DO
END FUNCTION f_lammps_gather_concat_position
FUNCTION f_lammps_gather_subset_mask (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
INTEGER(c_int) :: f_lammps_gather_subset_mask
INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask
INTEGER :: j
INTEGER(c_int), DIMENSION(*), PARAMETER :: tag = [3,2]
CALL lmp%gather_atoms_subset('mask', 1_c_int, tag, mask)
DO j = 1, SIZE(tag)
IF ( tag(j) == i ) THEN
f_lammps_gather_subset_mask = mask(j)
RETURN
END IF
END DO
f_lammps_gather_subset_mask = -1
END FUNCTION f_lammps_gather_subset_mask
FUNCTION f_lammps_gather_subset_position (xyz,id) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: id, xyz
REAL(c_double) :: f_lammps_gather_subset_position
REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions
INTEGER(c_int), DIMENSION(*), PARAMETER :: tag = [3,2]
INTEGER :: j
CALL lmp%gather_atoms_subset('x', 3_c_int, tag, positions)
DO j = 1, SIZE(tag)
IF ( tag(j) == id ) THEN
f_lammps_gather_subset_position = positions((j-1)*3 + xyz)
RETURN
END IF
END DO
f_lammps_gather_subset_position = -1.0D0
END FUNCTION f_lammps_gather_subset_position

140
unittest/fortran/wrap_gather_scatter.cpp Normal file
View File

@ -0,0 +1,140 @@
// unit tests for gathering and scattering data from a LAMMPS instance through
// the Fortran wrapper
#include "lammps.h"
#include "library.h"
#include <mpi.h>
#include <string>
#include <cstdlib>
#include <cstdint>
#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_gather_scatter();
int f_lammps_gather_mask(int);
double f_lammps_gather_position(int);
int f_lammps_gather_concat_mask(int);
double f_lammps_gather_concat_position(int,int);
int f_lammps_gather_subset_mask(int);
double f_lammps_gather_subset_position(int,int);
}
class LAMMPS_gather_scatter : public ::testing::Test {
protected:
LAMMPS_NS::LAMMPS *lmp;
LAMMPS_gather_scatter() = default;
~LAMMPS_gather_scatter() 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_gather_scatter, gather_masks)
{
f_lammps_setup_gather_scatter();
EXPECT_EQ(f_lammps_gather_mask(1), 1);
EXPECT_EQ(f_lammps_gather_mask(2), 1);
EXPECT_EQ(f_lammps_gather_mask(3), 1);
lammps_command(lmp, "group special id 1");
lammps_command(lmp, "group other id 2");
lammps_command(lmp, "group spiffy id 3");
EXPECT_EQ(f_lammps_gather_mask(1), 3);
EXPECT_EQ(f_lammps_gather_mask(2), 5);
EXPECT_EQ(f_lammps_gather_mask(3), 9);
lammps_command(lmp, "group other id 1");
EXPECT_EQ(f_lammps_gather_mask(1), 7);
EXPECT_EQ(f_lammps_gather_mask(2), 5);
EXPECT_EQ(f_lammps_gather_mask(3), 9);
};
TEST_F(LAMMPS_gather_scatter, gather_positions)
{
f_lammps_setup_gather_scatter();
EXPECT_EQ(f_lammps_gather_position(1), 1.0);
EXPECT_EQ(f_lammps_gather_position(2), 1.0);
EXPECT_EQ(f_lammps_gather_position(3), 1.5);
EXPECT_EQ(f_lammps_gather_position(4), 0.2);
EXPECT_EQ(f_lammps_gather_position(5), 0.1);
EXPECT_EQ(f_lammps_gather_position(6), 0.1);
EXPECT_EQ(f_lammps_gather_position(7), 0.5);
EXPECT_EQ(f_lammps_gather_position(8), 0.5);
EXPECT_EQ(f_lammps_gather_position(9), 0.5);
};
TEST_F(LAMMPS_gather_scatter, gather_masks_concat)
{
f_lammps_setup_gather_scatter();
EXPECT_EQ(f_lammps_gather_concat_mask(1), 1);
EXPECT_EQ(f_lammps_gather_concat_mask(2), 1);
EXPECT_EQ(f_lammps_gather_concat_mask(3), 1);
lammps_command(lmp, "group special id 1");
lammps_command(lmp, "group other id 2");
lammps_command(lmp, "group spiffy id 3");
EXPECT_EQ(f_lammps_gather_concat_mask(1), 3);
EXPECT_EQ(f_lammps_gather_concat_mask(2), 5);
EXPECT_EQ(f_lammps_gather_concat_mask(3), 9);
lammps_command(lmp, "group other id 1");
EXPECT_EQ(f_lammps_gather_concat_mask(1), 7);
EXPECT_EQ(f_lammps_gather_concat_mask(2), 5);
EXPECT_EQ(f_lammps_gather_concat_mask(3), 9);
};
TEST_F(LAMMPS_gather_scatter, gather_positions_concat)
{
f_lammps_setup_gather_scatter();
EXPECT_EQ(f_lammps_gather_concat_position(1,1), 1.0);
EXPECT_EQ(f_lammps_gather_concat_position(2,1), 1.0);
EXPECT_EQ(f_lammps_gather_concat_position(3,1), 1.5);
EXPECT_EQ(f_lammps_gather_concat_position(1,2), 0.2);
EXPECT_EQ(f_lammps_gather_concat_position(2,2), 0.1);
EXPECT_EQ(f_lammps_gather_concat_position(3,2), 0.1);
EXPECT_EQ(f_lammps_gather_concat_position(1,3), 0.5);
EXPECT_EQ(f_lammps_gather_concat_position(2,3), 0.5);
EXPECT_EQ(f_lammps_gather_concat_position(3,3), 0.5);
};
TEST_F(LAMMPS_gather_scatter, gather_masks_subset)
{
f_lammps_setup_gather_scatter();
EXPECT_EQ(f_lammps_gather_subset_mask(2), 1);
EXPECT_EQ(f_lammps_gather_subset_mask(3), 1);
lammps_command(lmp, "group special id 1");
lammps_command(lmp, "group other id 2");
lammps_command(lmp, "group spiffy id 3");
EXPECT_EQ(f_lammps_gather_subset_mask(2), 5);
EXPECT_EQ(f_lammps_gather_subset_mask(3), 9);
lammps_command(lmp, "group other id 3");
EXPECT_EQ(f_lammps_gather_subset_mask(2), 5);
EXPECT_EQ(f_lammps_gather_subset_mask(3), 13);
};
TEST_F(LAMMPS_gather_scatter, gather_positions_subset)
{
f_lammps_setup_gather_scatter();
// EXPECT_EQ(f_lammps_gather_subset_position(1,1), 1.0);
// EXPECT_EQ(f_lammps_gather_subset_position(2,1), 1.0);
// EXPECT_EQ(f_lammps_gather_subset_position(3,1), 1.5);
EXPECT_EQ(f_lammps_gather_subset_position(1,2), 0.2);
EXPECT_EQ(f_lammps_gather_subset_position(2,2), 0.1);
EXPECT_EQ(f_lammps_gather_subset_position(3,2), 0.1);
EXPECT_EQ(f_lammps_gather_subset_position(1,3), 0.5);
EXPECT_EQ(f_lammps_gather_subset_position(2,3), 0.5);
EXPECT_EQ(f_lammps_gather_subset_position(3,3), 0.5);
};