diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 610a1955d5..d47cfc5100 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -295,8 +295,18 @@ of the contents of the :f:mod:`LIBLAMMPS` Fortran interface to LAMMPS. :ftype scatter_atoms: subroutine :f scatter_atoms_subset: :f:subr:`scatter_atoms_subset` :ftype scatter_atoms_subset: subroutine + :f gather_bonds: :f:subr:`gather_bonds` + :ftype gather_bonds: subroutine :f create_atoms: :f:subr:`create_atoms` :ftype create_atoms: subroutine + :f find_pair_neighlist: :f:func:`find_pair_neighlist` + :ftype find_pair_neighlist: function + :f find_fix_neighlist: :f:func:`find_fix_neighlist` + :ftype find_fix_neighlist: function + :f find_compute_neighlist: :f:func:`find_compute_neighlist` + :ftype find_compute_neighlist: function + :f neighlist_num_elements: :f:func:`neighlist_num_elements` + :ftype neighlist_num_elements: function :f version: :f:func:`version` :ftype version: function :f get_os_info: :f:subr:`get_os_info` @@ -398,6 +408,10 @@ of the contents of the :f:mod:`LIBLAMMPS` Fortran interface to LAMMPS. and ``lmp%style%local``. These values are identical to the values described in :cpp:enum:`_LMP_STYLE_CONST` for the C library interface. + :f integer(c_int) global: used to request global data + :f integer(c_int) atom: used to request per-atom data + :f integer(c_int) local: used to request local data + .. f:type:: lammps_type This derived type is there to provide a convenient interface for the type @@ -407,6 +421,10 @@ of the contents of the :f:mod:`LIBLAMMPS` Fortran interface to LAMMPS. ``lmp%type%array``. These values are identical to the values described in :cpp:enum:`_LMP_TYPE_CONST` for the C library interface. + :f integer(c_int) scalar: used to request scalars + :f integer(c_int) vector: used to request vectors + :f integer(c_int) array: used to request arrays (matrices) + Procedures Bound to the :f:type:`lammps` Derived Type ===================================================== @@ -415,12 +433,15 @@ Procedures Bound to the :f:type:`lammps` Derived Type This method will close down the LAMMPS instance through calling :cpp:func:`lammps_close`. If the *finalize* argument is present and has a value of ``.TRUE.``, then this subroutine also calls + :cpp:func:`lammps_kokkos_finalize` and :cpp:func:`lammps_mpi_finalize`. :o finalize: shut down the MPI environment of the LAMMPS library if ``.TRUE.``. :otype finalize: logical,optional :to: :cpp:func:`lammps_close` + :to: :cpp:func:`lammps_mpi_finalize` + :to: :cpp:func:`lammps_kokkos_finalize` -------- @@ -784,7 +805,7 @@ Procedures Bound to the :f:type:`lammps` Derived Type REAL(c_double), DIMENSION(:,:), POINTER :: x => NULL() ! more code to setup, etc. x = lmp%extract_atom("x") - print '(f0.6)', x(2,6) + PRINT '(f0.6)', x(2,6) will print the *y*-coordinate of the sixth atom on this processor (note the transposition of the two indices). This is not a choice, but @@ -1388,6 +1409,51 @@ Procedures Bound to the :f:type:`lammps` Derived Type -------- +.. f:subroutine:: gather_bonds(data) + + Gather type and constituent atom information for all bonds. + + .. versionadded:: TBD + + This function copies the list of all bonds into an allocated array. + The array will be filled with (bond type, bond atom 1, bond atom 2) for each + bond. The array is allocated to the right length (i.e., three times the + number of bonds). The array *data* must be of the same type as the LAMMPS + ``tagint`` type, which is equivalent to either ``INTEGER(c_int)`` or + ``INTEGER(c_int64_t)``, depending on whether ``-DLAMMPS_BIGBIG`` was used + when LAMMPS was built. If the supplied array does not match, an error will + result at run-time. + + An example of how to use this routine is below: + + .. code-block:: Fortran + + PROGRAM bonds + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : OUTPUT_UNIT + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: bonds_array + INTEGER(c_int), DIMENSION(:,:), POINTER :: bonds + TYPE(lammps) :: lmp + INTEGER :: i + ! other commands to initialize LAMMPS, create bonds, etc. + CALL lmp%gather_bonds(bonds) + bonds(1:3,1:size(bonds)/3) => bonds_array + DO i = 1, size(bonds)/3 + WRITE(OUTPUT_UNIT,'(A,1X,I4,A,I4,1X,I4)') 'bond', bonds(1,i), & + '; type = ', bonds(2,i), bonds(3,i) + END DO + END PROGRAM bonds + + :p data: array into which to copy the result. \*The ``KIND`` parameter is + either ``c_int`` or, if LAMMPS was compiled with ``-DLAMMPS_BIGBIG``, + kind ``c_int64_t``. + :ptype data: integer(kind=\*),allocatable + :to: :cpp:func:`lammps_gather_bonds` + +-------- + .. f:subroutine:: create_atoms([id,] type, x, [v,] [image,] [bexpand]) This method calls :cpp:func:`lammps_create_atoms` to create additional atoms @@ -1440,6 +1506,93 @@ Procedures Bound to the :f:type:`lammps` Derived Type -------- +.. f:function:: find_pair_neighlist(style, exact, nsub, reqid) + + Find index of a neighbor list requested by a pair style. + + .. versionadded:: TBD + + This function determines which of the available neighbor lists for pair + styles matches the given conditions. It first matches the style name. + If *exact* is ``.TRUE.``, the name must match exactly; if ``.FALSE.``, a + regular expression or sub-string match is done. If the pair style is + *hybrid* or *hybrid/overlay*, the style is matched against the sub-styles + instead. If the same pair style is used multiple times as a sub-style, the + *nsub* argument must be :math:`> 0`; this argument represents the *n*\ th + instance of the sub-style (same as for the :doc:`pair_coeff ` + command, for example). In that case, *nsub*\ :math:`{} = 0` will not + produce a match, and the function will return :math:`-1`. + + The final condition to be checked is the request ID (\ *reqid*\ ). This + will usually be zero, but some pair styles request multiple neighbor + lists and set the request ID to a value greater than zero. + + :p character(len=\*) style: String used to search for pair style instance. + :p exact: Flag to control whther style should match exactly or only a + regular expression/sub-string match is applied. + :ptype exact: logical + :p integer(c_int) nsub: Match *nsub*\ th hybrid sub-style instance of + the same style + :p integer(c_int) reqid: Request ID to identify the neighbor list in + case there are multiple requests from the same pair style instance. + :to: :cpp:func:`lammps_find_pair_neighlist` + :r integer(c_int) index: Neighbor list index if found, otherwise + :math:`-1`. + +-------- + +.. f:function:: find_fix_neighlist() + + Find index of a neighbor list requested by a fix. + + .. versionadded:: TBD + + The neighbor list request from a fix is identified by the fix ID and the + request ID. The request ID is typically zero, but will be :math:`>0` for + fixes with multiple neighbor list requests. + + :p character(len=\*) id: Identifier of fix instance + :p integer(c_int) reqid: request ID to identify the neighbor list in cases + in which there are multiple requests from the same fix. + :to: :cpp:func:`lammps_find_fix_neighlist` + :r index: neighbor list index if found, otherwise :math:`-1` + :rtype index: integer(c_int) + +-------- + +.. f:function:: find_compute_neighlist() + + Find index of a neighbor list requested by a compute. + + .. versionadded:: TBD + + The neighbor list request from a compute is identified by the compute ID and + the request ID. The request ID is typically zero, but will be :math:`> 0` + in case a compute has multiple neighbor list requests. + + :p character(len=\*) id: Identifier of compute instance + :p integer(c_int) reqid: request ID to identify the neighbor list in cases + in which there are multiple requests from the same compute + :to: :cpp:func:`lammps_find_compute_neighlist` + :r index: neighbor list index if found, otherwise :math:`-1` + :rtype index: integer(c_int) + +-------- + +.. f:function:: neighlist_num_elements(idx) + + Return the number of entries in the neighbor list with the given index. + + .. versionadded:: TBD + + :p integer(c_int) idx: neighbor list index + :to: :cpp:func:`lammps_neighlist_num_elements` + :r inum: number of entries in neighbor list, or :math:`-1` if *idx* is not + a valid index. + :rtype inum: integer(c_int) + +-------- + .. f:function:: version() This method returns the numeric LAMMPS version like diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 62b2be7bbf..ef35dbd728 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -1,7 +1,7 @@ ! ------------------------------------------------------------------------- ! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator ! https://www.lammps.org/ Sandia National Laboratories -! Steve Plimpton, sjplimp@sandia.gov +! The LAMMPS Developers, developers@lammps.org ! ! Copyright (2003) Sandia Corporation. Under the terms of Contract ! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains @@ -44,11 +44,11 @@ MODULE LIBLAMMPS ! ! These are NOT part of the API (the part the user sees) INTEGER(c_int), PARAMETER :: & - LAMMPS_INT = 0, & ! 32-bit integer (array) + LAMMPS_INT = 0, & ! 32-bit integer (or array) LAMMPS_INT_2D = 1, & ! two-dimensional 32-bit integer array - LAMMPS_DOUBLE = 2, & ! 64-bit double (array) + LAMMPS_DOUBLE = 2, & ! 64-bit double (or array) LAMMPS_DOUBLE_2D = 3, & ! two-dimensional 64-bit double array - LAMMPS_INT64 = 4, & ! 64-bit integer (array) + LAMMPS_INT64 = 4, & ! 64-bit integer (or array) LAMMPS_INT64_2D = 5, & ! two-dimensional 64-bit integer array LAMMPS_STRING = 6, & ! C-String LMP_STYLE_GLOBAL = 0, & ! request global compute/fix/etc. data @@ -123,12 +123,20 @@ MODULE LIBLAMMPS PROCEDURE, PRIVATE :: lmp_scatter_atoms_subset_double GENERIC :: scatter_atoms_subset => lmp_scatter_atoms_subset_int, & lmp_scatter_atoms_subset_double + PROCEDURE, PRIVATE :: lmp_gather_bonds_small + PROCEDURE, PRIVATE :: lmp_gather_bonds_big + GENERIC :: gather_bonds => lmp_gather_bonds_small, & + lmp_gather_bonds_big ! PROCEDURE, PRIVATE :: lmp_create_atoms_int PROCEDURE, PRIVATE :: lmp_create_atoms_bigbig GENERIC :: create_atoms => lmp_create_atoms_int, & lmp_create_atoms_bigbig -! + PROCEDURE :: find_pair_neighlist => lmp_find_pair_neighlist + PROCEDURE :: find_fix_neighlist => lmp_find_fix_neighlist + PROCEDURE :: find_compute_neighlist => lmp_find_compute_neighlist + PROCEDURE :: neighlist_num_elements => lmp_neighlist_num_elements + PROCEDURE :: neighlist_element_neighbors => lmp_neighlist_num_elements PROCEDURE :: version => lmp_version PROCEDURE, NOPASS :: get_os_info => lmp_get_os_info PROCEDURE, NOPASS :: config_has_mpi_support => lmp_config_has_mpi_support @@ -470,7 +478,11 @@ MODULE LIBLAMMPS INTEGER(c_int), VALUE :: count, ndata, type END SUBROUTINE lammps_scatter_atoms_subset - !SUBROUTINE lammps_gather_bonds + SUBROUTINE lammps_gather_bonds(handle, data) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, data + END SUBROUTINE lammps_gather_bonds !SUBROUTINE lammps_gather @@ -480,23 +492,55 @@ MODULE LIBLAMMPS !SUBROUTINE lammps_scatter_subset - INTEGER(c_int) FUNCTION lammps_create_atoms(handle, n, id, type, x, v, & - image, bexpand) BIND(C) + FUNCTION lammps_create_atoms(handle, n, id, type, x, v, image, bexpand) & + BIND(C) IMPORT :: c_ptr, c_int IMPLICIT NONE TYPE(c_ptr), VALUE :: handle, id, type, x, v, image INTEGER(c_int), VALUE :: n, bexpand + INTEGER(c_int) :: lammps_create_atoms END FUNCTION lammps_create_atoms - !INTEGER(c_int) FUNCTION lammps_find_pair_neighlist + FUNCTION lammps_find_pair_neighlist(handle, style, exact, nsub, reqid) & + BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, style + INTEGER(c_int), VALUE :: exact, nsub, reqid + INTEGER(c_int) :: lammps_find_pair_neighlist + END FUNCTION lammps_find_pair_neighlist - !INTEGER(c_int) FUNCTION lammps_find_fix_neighlist + FUNCTION lammps_find_fix_neighlist(handle, id, reqid) BIND(C) + IMPORT :: c_int, c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, id + INTEGER(c_int), VALUE :: reqid + INTEGER(c_int) :: lammps_find_fix_neighlist + END FUNCTION lammps_find_fix_neighlist - !INTEGER(c_int) FUNCTION lammps_find_compute_neighlist + FUNCTION lammps_find_compute_neighlist(handle, id, reqid) BIND(C) + IMPORT :: c_int, c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, id + INTEGER(c_int), VALUE :: reqid + INTEGER(c_int) :: lammps_find_compute_neighlist + END FUNCTION lammps_find_compute_neighlist - !INTEGER(c_int) FUNCTION lammps_neighlist_num_elements + FUNCTION lammps_neighlist_num_elements(handle, idx) BIND(C) + IMPORT :: c_ptr, c_int + TYPE(c_ptr), VALUE :: handle + INTEGER(c_int), VALUE :: idx + INTEGER(c_int) :: lammps_neighlist_num_elements + END FUNCTION lammps_neighlist_num_elements - !SUBROUTINE lammps_neighlist_element_neighbors + SUBROUTINE lammps_neighlist_element_neighbors(handle, idx, element, & + iatom, numneigh, neighbors) BIND(C) + IMPORT :: c_ptr, c_int + TYPE(c_ptr), VALUE :: handle + INTEGER(c_int), VALUE :: idx, element + INTEGER(c_int) :: iatom, numneigh + TYPE(c_ptr) :: neighbors + END SUBROUTINE lammps_neighlist_element_neighbors FUNCTION lammps_version(handle) BIND(C) IMPORT :: c_ptr, c_int @@ -1606,6 +1650,48 @@ CONTAINS CALL lammps_free(Cname) END SUBROUTINE lmp_scatter_atoms_subset_double + ! equivalent function to lammps_gather_bonds (LAMMPS_SMALLSMALL or SMALLBIG) + SUBROUTINE lmp_gather_bonds_small(self, data) + CLASS(lammps), INTENT(IN) :: self + INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET, INTENT(OUT) :: data + INTEGER(c_int) :: size_tagint + INTEGER(c_int), POINTER :: nbonds + TYPE(c_ptr) :: Cdata + + size_tagint = lmp_extract_setting(self, 'tagint') + IF (size_tagint /= 4_c_int) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'Incompatible integer kind in gather_bonds [Fortran API]') + RETURN + END IF + nbonds = lmp_extract_global(self, 'nbonds') + IF (ALLOCATED(data)) DEALLOCATE(data) + ALLOCATE(data(3*nbonds)) + Cdata = C_LOC(data(1)) + CALL lammps_gather_bonds(self%handle, Cdata) + END SUBROUTINE lmp_gather_bonds_small + + ! equivalent function to lammps_gather_bonds (LAMMPS_BIGBIG) + SUBROUTINE lmp_gather_bonds_big(self, data) + CLASS(lammps), INTENT(IN) :: self + INTEGER(c_int64_t), DIMENSION(:), ALLOCATABLE, TARGET, INTENT(OUT) :: data + INTEGER(c_int) :: size_tagint + INTEGER(c_int64_t), POINTER :: nbonds + TYPE(c_ptr) :: Cdata + + size_tagint = lmp_extract_setting(self, 'tagint') + IF (size_tagint /= 8_c_int) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'Incompatible integer kind in gather_bonds [Fortran API]') + RETURN + END IF + nbonds = lmp_extract_global(self, 'nbonds') + IF (ALLOCATED(data)) DEALLOCATE(data) + ALLOCATE(data(3*nbonds)) + Cdata = C_LOC(data(1)) + CALL lammps_gather_bonds(self%handle, Cdata) + END SUBROUTINE lmp_gather_bonds_big + ! equivalent function to lammps_create_atoms (int ids or id absent) SUBROUTINE lmp_create_atoms_int(self, id, type, x, v, image, bexpand) CLASS(lammps), INTENT(IN) :: self @@ -1733,6 +1819,89 @@ CONTAINS END IF END SUBROUTINE lmp_create_atoms_bigbig + ! equivalent function to lammps_find_pair_neighlist + INTEGER(c_int) FUNCTION lmp_find_pair_neighlist(self, style, exact, nsub, & + reqid) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: style + LOGICAL, INTENT(IN) :: exact + INTEGER(c_int), INTENT(IN) :: nsub, reqid + TYPE(c_ptr) :: Cstyle + INTEGER(c_int) :: Cexact + + IF (exact) THEN + Cexact = 1_c_int + ELSE + Cexact = 0_c_int + END IF + Cstyle = f2c_string(style) + lmp_find_pair_neighlist = lammps_find_pair_neighlist(self%handle, Cstyle, & + Cexact, nsub, reqid) + IF (lmp_find_pair_neighlist < 0) THEN + CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, & + 'unable to find pair neighbor list [Fortran/find_pair_neighlist]') + END IF + CALL lammps_free(Cstyle) + END FUNCTION lmp_find_pair_neighlist + + ! equivalent function to lammps_find_fix_neighlist + INTEGER(c_int) FUNCTION lmp_find_fix_neighlist(self, id, reqid) RESULT(idx) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: id + INTEGER(c_int), INTENT(IN) :: reqid + TYPE(c_ptr) :: Cid + + Cid = f2c_string(id) + idx = lammps_find_fix_neighlist(self%handle, Cid, reqid) + IF (idx < 0) THEN + CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, & + 'neighbor list not found [Fortran/find_fix_neighlist]') + END IF + CALL lammps_free(Cid) + END FUNCTION lmp_find_fix_neighlist + + ! equivalent function to lammps_find_compute_neighlist + INTEGER(c_int) FUNCTION lmp_find_compute_neighlist(self, id, reqid) & + RESULT(idx) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: id + INTEGER(c_int), INTENT(IN) :: reqid + TYPE(c_ptr) :: Cid + + Cid = f2c_string(id) + idx = lammps_find_compute_neighlist(self%handle, Cid, reqid) + IF (idx < 0) THEN + CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, & + 'neighbor list not found [Fortran/find_compute_neighlist]') + END IF + CALL lammps_free(Cid) + END FUNCTION lmp_find_compute_neighlist + + INTEGER(c_int) FUNCTION lmp_neighlist_num_elements(self, idx) RESULT(inum) + CLASS(lammps), INTENT(IN) :: self + INTEGER(c_int), INTENT(IN) :: idx + + inum = lammps_neighlist_num_elements(self%handle, idx) + IF (inum < 0) THEN + CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, & + 'neighbor list not found [Fortran/neighlist_num_elements]') + END IF + END FUNCTION lmp_neighlist_num_elements + + SUBROUTINE lmp_neighlist_element_neighbors(self, idx, element, iatom, & + neighbors) + CLASS(lammps), INTENT(IN) :: self + INTEGER(c_int), INTENT(IN) :: idx, element + INTEGER(c_int), INTENT(OUT) :: iatom + INTEGER(c_int), DIMENSION(:), POINTER, INTENT(OUT) :: neighbors + INTEGER(c_int) :: numneigh + TYPE(c_ptr) :: Cneighbors + + CALL lammps_neighlist_element_neighbors(self%handle, idx, element, iatom, & + numneigh, Cneighbors) + CALL C_F_POINTER(Cneighbors, neighbors, [numneigh]) + END SUBROUTINE lmp_neighlist_element_neighbors + ! equivalent function to lammps_version INTEGER FUNCTION lmp_version(self) CLASS(lammps), INTENT(IN) :: self diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index 75c14626e9..42170e150f 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -86,6 +86,10 @@ if(CMAKE_Fortran_COMPILER) target_link_libraries(test_fortran_configuration PRIVATE flammps lammps MPI::MPI_Fortran GTest::GMockMain) add_test(NAME FortranConfiguration COMMAND test_fortran_configuration) + add_executable(test_fortran_neighlist wrap_neighlist.cpp test_fortran_neighlist.f90) + target_link_libraries(test_fortran_neighlist PRIVATE flammps lammps MPI::MPI_Fortran GTest::GMockMain) + add_test(NAME FortranNeighlist COMMAND test_fortran_neighlist) + else() message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler") endif() diff --git a/unittest/fortran/test_fortran_create_atoms.f90 b/unittest/fortran/test_fortran_create_atoms.f90 index 7ba20a00db..d5e2ffe280 100644 --- a/unittest/fortran/test_fortran_create_atoms.f90 +++ b/unittest/fortran/test_fortran_create_atoms.f90 @@ -1,5 +1,5 @@ FUNCTION f_lammps_with_args() BIND(C) - USE ISO_C_BINDING, ONLY: c_ptr + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr USE LIBLAMMPS USE keepstuff, ONLY: lmp IMPLICIT NONE @@ -13,7 +13,7 @@ FUNCTION f_lammps_with_args() BIND(C) END FUNCTION f_lammps_with_args SUBROUTINE f_lammps_close() BIND(C) - USE ISO_C_BINDING, ONLY: c_null_ptr + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_null_ptr USE liblammps USE keepstuff, ONLY: lmp IMPLICIT NONE @@ -34,7 +34,7 @@ SUBROUTINE f_lammps_setup_create_atoms() BIND(C) END SUBROUTINE f_lammps_setup_create_atoms SUBROUTINE f_lammps_create_three_atoms() BIND(C) - USE ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE @@ -73,7 +73,7 @@ SUBROUTINE f_lammps_create_three_atoms() BIND(C) END SUBROUTINE f_lammps_create_three_atoms SUBROUTINE f_lammps_create_two_more() BIND(C) - USE ISO_C_BINDING, ONLY: c_double, c_int + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double, c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE @@ -87,7 +87,7 @@ SUBROUTINE f_lammps_create_two_more() BIND(C) END SUBROUTINE f_lammps_create_two_more SUBROUTINE f_lammps_create_two_more_small() BIND(C) - USE ISO_C_BINDING, ONLY: c_double, c_int + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double, c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE @@ -105,7 +105,7 @@ SUBROUTINE f_lammps_create_two_more_small() BIND(C) END SUBROUTINE f_lammps_create_two_more_small SUBROUTINE f_lammps_create_two_more_big() BIND(C) - USE ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE @@ -123,7 +123,7 @@ SUBROUTINE f_lammps_create_two_more_big() BIND(C) END SUBROUTINE f_lammps_create_two_more_big SUBROUTINE f_lammps_create_two_more_small2() BIND(C) - USE ISO_C_BINDING, ONLY: c_double, c_int + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double, c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE @@ -139,7 +139,7 @@ SUBROUTINE f_lammps_create_two_more_small2() BIND(C) END SUBROUTINE f_lammps_create_two_more_small2 SUBROUTINE f_lammps_create_two_more_big2() BIND(C) - USE ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE diff --git a/unittest/fortran/test_fortran_neighlist.f90 b/unittest/fortran/test_fortran_neighlist.f90 new file mode 100644 index 0000000000..efab39607e --- /dev/null +++ b/unittest/fortran/test_fortran_neighlist.f90 @@ -0,0 +1,86 @@ +FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") + 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, name="f_lammps_close") + 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_neigh_tests() BIND(C) + USE LIBLAMMPS + USE keepstuff, ONLY : lmp, big_input, cont_input, pair_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(pair_input) + CALL lmp%command('compute c all rdf 100') + ! We create one of the fixes that requests a neighbor list, none of which + ! is part of LAMMPS without additional packages; as such, we only do this + ! if REPLICA is included + IF (lmp%config_has_package('REPLICA')) THEN + CALL lmp%command('fix f all hyper/global 1.0 0.3 0.8 300.0') + CALL lmp%command('compute event all event/displace 1.0') + CALL lmp%command('hyper 0 100 f event') ! using "run 0" here segfaults (?) + ELSE + CALL lmp%command('run 0 post no') ! otherwise neighlists won't be requested + END IF +END SUBROUTINE f_lammps_setup_neigh_tests + +FUNCTION f_lammps_pair_neighlist_test() BIND(C) RESULT(nlist_id) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: nlist_id + + nlist_id = lmp%find_pair_neighlist('lj/cut',.TRUE., 0, 0) +END FUNCTION f_lammps_pair_neighlist_test + +FUNCTION f_lammps_fix_neighlist_test() BIND(C) RESULT(nlist_id) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: nlist_id + + nlist_id = lmp%find_fix_neighlist('f',0) +END FUNCTION f_lammps_fix_neighlist_test + +FUNCTION f_lammps_compute_neighlist_test() BIND(C) RESULT(nlist_id) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: nlist_id + + nlist_id = lmp%find_compute_neighlist('c',0) +END FUNCTION f_lammps_compute_neighlist_test + +FUNCTION f_lammps_neighlist_num_elements(id) BIND(C) RESULT(nelements) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: id + INTEGER(c_int) :: nelements + + nelements = lmp%neighlist_num_elements(id) +END FUNCTION f_lammps_neighlist_num_elements diff --git a/unittest/fortran/wrap_neighlist.cpp b/unittest/fortran/wrap_neighlist.cpp new file mode 100644 index 0000000000..ce09dcccb6 --- /dev/null +++ b/unittest/fortran/wrap_neighlist.cpp @@ -0,0 +1,123 @@ +// unit tests for accessing neighbor lists in a LAMMPS instance through the Fortran wrapper + +#include "lammps.h" +#include "library.h" +#include "force.h" +#include "modify.h" +#include "neighbor.h" +#include "neigh_list.h" +#include "info.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_neigh_tests(); +int f_lammps_pair_neighlist_test(); +int f_lammps_fix_neighlist_test(); +int f_lammps_compute_neighlist_test(); +int f_lammps_neighlist_num_elements(int); +} + +namespace LAMMPS_NS { + +class LAMMPS_neighbors : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_neighbors() = default; + ~LAMMPS_neighbors() 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_neighbors, pair) +{ + f_lammps_setup_neigh_tests(); + int pair_neighlist = f_lammps_pair_neighlist_test(); + Pair *pair = lmp->force->pair_match("lj/cut",1,0); + int index = -2; + if (pair != nullptr) { + for (int i = 0; i < lmp->neighbor->nlist; i++) { + NeighList *list = lmp->neighbor->lists[i]; + if ((list->requestor_type == NeighList::PAIR) + and (pair == list->requestor) + and (list->id == 0)) { + index = i; + break; + } + } + } + EXPECT_EQ(index, pair_neighlist); +}; + +TEST_F(LAMMPS_neighbors, fix) +{ + if (not Info::has_package("REPLICA")) GTEST_SKIP(); + f_lammps_setup_neigh_tests(); + auto fix = lmp->modify->get_fix_by_id("f"); + EXPECT_NE(fix, nullptr); + int ilist = -2; + for (int i = 0; i < lmp->neighbor->nlist; i++) { + NeighList *list = lmp->neighbor->lists[i]; + if ( (list->requestor_type == NeighList::FIX) + and (fix == list->requestor) and (list->id == 0) ) { + ilist = i; + break; + } + } + EXPECT_EQ(ilist, f_lammps_fix_neighlist_test()); +}; + +TEST_F(LAMMPS_neighbors, compute) +{ + f_lammps_setup_neigh_tests(); + auto compute = lmp->modify->get_compute_by_id("c"); + EXPECT_NE(compute,nullptr); + int ilist = -2; + for (int i=0; i < lmp->neighbor->nlist; i++) { + NeighList *list = lmp->neighbor->lists[i]; + if ( (list->requestor_type == NeighList::COMPUTE) + and (compute == list->requestor) and (list->id == 0) ) { + ilist = i; + break; + } + } + EXPECT_EQ(ilist, f_lammps_compute_neighlist_test()); +}; + +TEST_F(LAMMPS_neighbors, numelements) +{ + f_lammps_setup_neigh_tests(); + int num_neigh = 0; + int pair_id = f_lammps_pair_neighlist_test(); + num_neigh = f_lammps_neighlist_num_elements(pair_id); + EXPECT_EQ(num_neigh, lammps_neighlist_num_elements(lmp, pair_id)); + if (Info::has_package("REPLICA")) { + int fix_id = f_lammps_fix_neighlist_test(); + num_neigh = f_lammps_neighlist_num_elements(fix_id); + EXPECT_EQ(num_neigh, lammps_neighlist_num_elements(lmp, fix_id)); + } + int compute_id = f_lammps_compute_neighlist_test(); + num_neigh = f_lammps_neighlist_num_elements(compute_id); + EXPECT_EQ(num_neigh, lammps_neighlist_num_elements(lmp, compute_id)); +}; + +} // LAMMPS_NS