From c5c21bb36c552c9cb07fa5a0ee1a3cfc30d46769 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Sun, 2 Oct 2022 15:28:10 -0500 Subject: [PATCH] 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 --- doc/src/Fortran.rst | 90 ++++++- fortran/lammps.f90 | 237 +++++++++++++++++- src/library.cpp | 221 +++++++++++----- unittest/fortran/CMakeLists.txt | 4 + unittest/fortran/keepstuff.f90 | 14 +- .../fortran/test_fortran_extract_atom.f90 | 42 +--- .../fortran/test_fortran_extract_compute.f90 | 43 +--- .../fortran/test_fortran_gather_scatter.f90 | 143 +++++++++++ unittest/fortran/wrap_gather_scatter.cpp | 140 +++++++++++ 9 files changed, 796 insertions(+), 138 deletions(-) create mode 100644 unittest/fortran/test_fortran_gather_scatter.f90 create mode 100644 unittest/fortran/wrap_gather_scatter.cpp diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index c17c39db72..12056df995 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -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 diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 0ec58c7914..ad90d45aa4 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -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 diff --git a/src/library.cpp b/src/library.cpp index 1e0c438984..0851980207 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -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"); diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index 0c813573f5..d3c18c9941 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -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() diff --git a/unittest/fortran/keepstuff.f90 b/unittest/fortran/keepstuff.f90 index e0e0725c69..6838d78955 100644 --- a/unittest/fortran/keepstuff.f90 +++ b/unittest/fortran/keepstuff.f90 @@ -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 diff --git a/unittest/fortran/test_fortran_extract_atom.f90 b/unittest/fortran/test_fortran_extract_atom.f90 index 5f899f80e0..eb55754561 100644 --- a/unittest/fortran/test_fortran_extract_atom.f90 +++ b/unittest/fortran/test_fortran_extract_atom.f90 @@ -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 diff --git a/unittest/fortran/test_fortran_extract_compute.f90 b/unittest/fortran/test_fortran_extract_compute.f90 index 64b5068171..8f5bbdfd51 100644 --- a/unittest/fortran/test_fortran_extract_compute.f90 +++ b/unittest/fortran/test_fortran_extract_compute.f90 @@ -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 diff --git a/unittest/fortran/test_fortran_gather_scatter.f90 b/unittest/fortran/test_fortran_gather_scatter.f90 new file mode 100644 index 0000000000..86870721ba --- /dev/null +++ b/unittest/fortran/test_fortran_gather_scatter.f90 @@ -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 diff --git a/unittest/fortran/wrap_gather_scatter.cpp b/unittest/fortran/wrap_gather_scatter.cpp new file mode 100644 index 0000000000..4fd733a167 --- /dev/null +++ b/unittest/fortran/wrap_gather_scatter.cpp @@ -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 +#include +#include +#include + +#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); +};