Implemented extract_atom, updated docs, added some unit tests

doc/src/Fortran.rst

@@ -179,7 +179,6 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS.
 
    :f c_ptr handle: reference to the LAMMPS class
    :f subroutine close: :f:func:`close`
-   :f function version: :f:func:`version`
    :f subroutine file: :f:func:`file`
    :f subroutine command: :f:func:`command`
    :f subroutine commands_list: :f:func:`commands_list`
@@ -191,6 +190,8 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS.
    :f subroutine memory_usage: :f:func:`memory_usage`
    :f function extract_setting: :f:func:`extract_setting`
    :f function extract_global: :f:func:`extract_global`
+   :f function version: :f:func:`version`
+   :f function is_running: :f:func:`is_running`
 
 --------
 
@@ -223,10 +224,10 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS.
       .. code-block:: Fortran
 
          PROGRAM testmpi
-            USE LIBLAMMPS
+           USE LIBLAMMPS
-            USE MPI_F08
+           USE MPI_F08
-            TYPE(lammps) :: lmp
+           TYPE(lammps) :: lmp
-            lmp = lammps(MPI_COMM_SELF%MPI_VAL)
+           lmp = lammps(MPI_COMM_SELF%MPI_VAL)
          END PROGRAM testmpi
 
 Procedures Bound to the lammps Derived Type
@@ -236,18 +237,11 @@ Procedures Bound to the 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
+   has a value of ``.TRUE.``, then this subroutine also calls
    :cpp:func:`lammps_mpi_finalize`.
 
-   :o logical finalize [optional]: shut down the MPI environment of the LAMMPS library if true.
+   :o logical finalize [optional]: shut down the MPI environment of the LAMMPS
-
+    library if true.
---------
-
-.. f:function:: version()
-
-   This method returns the numeric LAMMPS version like :cpp:func:`lammps_version`
-
-   :r integer: LAMMPS version
 
 --------
 
@@ -422,8 +416,8 @@ Procedures Bound to the lammps Derived Type
    associates the pointer on the left side of the assignment to point
    to internal LAMMPS data (with the exception of string data, which are
    copied and returned as ordinary Fortran strings). Pointers must be of the
-   correct data type to point to said data (typically INTEGER(c_int),
+   correct data type to point to said data (typically integer(C_int),
-   INTEGER(c_int64_t), or REAL(c_double)) and have compatible kind and rank.
+   integer(C_int64_t), or real(C_double)) and have compatible kind and rank.
    The pointer being associated with LAMMPS data is type-, kind-, and
    rank-checked at run-time via an overloaded assignment operator.
    The pointers returned by this function are generally persistent; therefore
@@ -436,7 +430,7 @@ Procedures Bound to the lammps Derived Type
    .. code-block:: fortran
 
       PROGRAM demo
-       USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t
+       USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_int64_t, C_double
        USE LIBLAMMPS
        TYPE(lammps) :: lmp
        INTEGER(C_int), POINTER :: nlocal
@@ -457,13 +451,15 @@ Procedures Bound to the lammps Derived Type
    the size of the current time step, and the units being used into the
    variables *nlocal*, *ntimestep*, *dt*, and *units*, respectively.
 
-   *Note*: if this function returns a string, the string must have
+   .. note::
-   length greater than or equal to the length of the string (not including the
-   terminal NULL character) that LAMMPS returns. If the variable's length is
-   too short, the string will be truncated. As usual in Fortran, strings
-   are padded with spaces at the end.
 
-   :p character(len=\*) name: string with the name of the extracted property
+      If :f:func:`extract_global` returns a string, the string must have length
+      greater than or equal to the length of the string (not including the
+      terminal ``NULL`` character) that LAMMPS returns. If the variable's
+      length is too short, the string will be truncated. As usual in Fortran,
+      strings are padded with spaces at the end.
+
+   :p character(len=\*) name: string with the name of the property to extract
    :r polymorphic: pointer to LAMMPS data. The left-hand side of the assignment
     should be either a string (if expecting string data) or a C-interoperable
     pointer (e.g., ``INTEGER (c_int), POINTER :: nlocal``) to the extracted
@@ -477,3 +473,83 @@ Procedures Bound to the lammps Derived Type
        to use a LAMMPS input command that sets or changes these parameters.
        Those will take care of all side effects and necessary updates of
        settings derived from such settings.
+
+--------
+
+.. f:function:: extract_atom(name)
+
+   This function calls :c:func:`lammps_extract_atom` and returns a pointer to
+   LAMMPS data tied to the :cpp:class:`Atom` class, depending on the data
+   requested through *name*.
+
+   Note that this function actually does not return a pointer, but rather
+   associates the pointer on the left side of the assignment to point
+   to internal LAMMPS data. Pointers must be of the correct type, kind, and
+   rank (e.g., integer(C_int), dimension(:) for "type" or "mask";
+   integer(C_int64_t), dimension(:) for "tag", assuming LAMMPS was not compiled
+   with the -DLAMMPS_SMALL_SMALL flag; real(C_double), dimension(:,:) for "x"
+   or "f"; and so forth). The pointer being associated with LAMMPS data is
+   type-, kind-, and rank-checked at run-time. Pointers returned by this
+   function are generally persistent; therefore, it is not necessary to call
+   the function again unless the underlying LAMMPS data are destroyed, such as
+   through the :doc:`clear` command.
+
+   :p character(len=\*) name: string with the name of the property to extract
+   :r polymorphic: pointer to LAMMPS data. The left-hand side of the assignment
+    should be a C-interoperable pointer
+    (e.g., ``INTEGER (c_int), POINTER :: mask``) to the extracted
+    property. If expecting vector data, the pointer should have dimension ":";
+    if expecting matrix data, the pointer should have dimension ":,:".
+
+    .. note::
+
+       Two-dimensional arrays returned from :f:func:`extract_atom` will be
+       **transposed** from equivalent arrays in C, and they will be indexed
+       from 1 instead of 0. For example, in C,
+       
+       .. code-block:: C
+
+          void *lmp;
+          double **x;
+          /* more code to setup, etc. */
+          x = lammps_extract_atom(lmp, "x");
+          printf("%f\n", x[5][1]);
+
+       will print the *y*-coordinate of the sixth atom on this processor.
+       Conversely,
+
+       .. code-block:: Fortran
+
+          TYPE(lammps) :: lmp
+          REAL(C_double), DIMENSION(:,:), POINTER :: x
+          ! more code to setup, etc.
+          x = lmp%extract_atom("x")
+          print '(f0.6)', x(2,6)
+
+       will print the *y*-coordinate of the third atom on this processor
+       (note the transposition of the two indices). This is not a choice, but
+       rather a consequence of the different conventions adopted by the Fortran
+       and C standards decades ago.
+
+       If you would like the indices to start at 0 instead of 1 (which follows
+       typical notation in C and C++, but not Fortran), you can create another
+       pointer and associate it thus:
+       
+       .. code-block:: Fortran
+
+          REAL(C_double), DIMENSION(:,:), POINTER :: x, x0
+          x = lmp%extract_atom("x")
+          x0(0:,0:) => x
+  
+       The above would cause the dimensions of *x* to be (1:3, 1:nlocal)
+       and those of *x0* to be (0:2, 0:nlocal-1).
+
+--------
+
+.. f:function:: version()
+
+   This method returns the numeric LAMMPS version like
+   :cpp:func:`lammps_version` does.
+
+   :r integer: LAMMPS version
+

fortran/lammps.f90

@@ -68,6 +68,7 @@ MODULE LIBLAMMPS
       PROCEDURE :: get_mpi_comm       => lmp_get_mpi_comm
       PROCEDURE :: extract_setting    => lmp_extract_setting
       PROCEDURE :: extract_global     => lmp_extract_global
+      PROCEDURE :: extract_atom       => lmp_extract_atom
       PROCEDURE :: version            => lmp_version
       PROCEDURE :: is_running         => lmp_is_running
   END TYPE lammps
@@ -94,6 +95,7 @@ MODULE LIBLAMMPS
     INTEGER(c_int64_t), DIMENSION(:), POINTER :: i64_vec
     REAL(c_double), POINTER :: r64
     REAL(c_double), DIMENSION(:), POINTER :: r64_vec
+    REAL(c_double), DIMENSION(:,:), POINTER :: r64_mat
     CHARACTER(LEN=:), ALLOCATABLE :: str
   END TYPE lammps_data
 
@@ -105,8 +107,9 @@ MODULE LIBLAMMPS
   ! LAMMPS data (after checking type-compatibility)
   INTERFACE ASSIGNMENT(=)
     MODULE PROCEDURE assign_int_to_lammps_data, assign_int64_to_lammps_data, &
-      assign_intvec_to_lammps_data, &
+      assign_intvec_to_lammps_data, assign_int64vec_to_lammps_data, &
       assign_double_to_lammps_data, assign_doublevec_to_lammps_data, &
+      assign_doublemat_to_lammps_data, &
       assign_string_to_lammps_data
   END INTERFACE
 
@@ -246,9 +249,19 @@ MODULE LIBLAMMPS
       TYPE(c_ptr) :: lammps_extract_global
     END FUNCTION lammps_extract_global
 
-    !INTEGER (c_int) FUNCTION lammps_extract_atom_datatype
+    FUNCTION lammps_extract_atom_datatype(handle, name) BIND(C)
+      IMPORT :: c_ptr, c_int
+      IMPLICIT NONE
+      TYPE(c_ptr), VALUE :: handle, name
+      INTEGER(c_int) :: lammps_extract_atom_datatype
+    END FUNCTION lammps_extract_atom_datatype
 
-    !(generic) lammps_extract_atom
+    FUNCTION lammps_extract_atom(handle, name) BIND(C)
+      IMPORT :: c_ptr
+      IMPLICIT NONE
+      TYPE(c_ptr), VALUE :: handle, name
+      TYPE(c_ptr) :: lammps_extract_atom
+    END FUNCTION lammps_extract_atom
 
     !(generic) lammps_extract_compute
 
@@ -632,6 +645,72 @@ CONTAINS
     END SELECT
   END FUNCTION
 
+  ! equivalent function to lammps_extract_atom
+  ! the assignment is actually overloaded so as to bind the pointers to
+  ! lammps data based on the information available from LAMMPS
+  FUNCTION lmp_extract_atom (self, name) RESULT (peratom_data)
+    CLASS(lammps), INTENT(IN) :: self
+    CHARACTER(LEN=*), INTENT(IN) :: name
+    TYPE(lammps_data) :: peratom_data
+
+    INTEGER(c_int) :: datatype
+    TYPE(c_ptr) :: Cname, Cptr
+    INTEGER(c_int) :: ntypes, nmax
+    INTEGER :: nrows, ncols
+    REAL(c_double), DIMENSION(:), POINTER :: dummy
+    TYPE(c_ptr), DIMENSION(:), POINTER :: Catomptr
+
+    nmax = lmp_extract_setting(self, 'nmax')
+    ntypes = lmp_extract_setting(self, 'ntypes')
+    Cname = f2c_string(name)
+    datatype = lammps_extract_atom_datatype(self%handle, Cname)
+    Cptr = lammps_extract_atom(self%handle, Cname)
+    CALL lammps_free(Cname)
+
+    SELECT CASE (name)
+      CASE ('mass')
+        ncols = ntypes + 1
+        nrows = 1
+      CASE ('x','v','f','mu','omega','torque','angmom')
+        ncols = nmax
+        nrows = 3
+      CASE DEFAULT
+        ncols = nmax
+        nrows = 1
+    END SELECT
+
+    SELECT CASE (datatype)
+      CASE (LAMMPS_INT)
+        peratom_data%datatype = DATA_INT_1D
+        CALL C_F_POINTER(Cptr, peratom_data%i32_vec, [ncols])
+      CASE (LAMMPS_INT64)
+        peratom_data%datatype = DATA_INT64_1D
+        CALL C_F_POINTER(Cptr, peratom_data%i64_vec, [ncols])
+      CASE (LAMMPS_DOUBLE)
+        peratom_data%datatype = DATA_DOUBLE_1D
+        IF ( name == 'mass' ) THEN
+          CALL C_F_POINTER(Cptr, dummy, [ncols])
+          peratom_data%r64_vec(0:) => dummy
+        ELSE
+          CALL C_F_POINTER(Cptr, peratom_data%r64_vec, [ncols])
+        END IF
+      CASE (LAMMPS_DOUBLE_2D)
+        peratom_data%datatype = DATA_DOUBLE_2D
+        ! First, we dereference the void** pointer to point to the void*
+        CALL C_F_POINTER(Cptr, Catomptr, [ncols])
+        ! Catomptr(1) now points to the first element of the array
+        CALL C_F_POINTER(Catomptr(1), peratom_data%r64_mat, [nrows,ncols])
+      CASE (-1)
+        WRITE(ERROR_UNIT,'(A)') 'ERROR: per-atom property "' // name // &
+          '" not found.'
+        STOP 2
+      CASE DEFAULT
+        WRITE(ERROR_UNIT,'(A,I0,A)') 'ERROR: return value ', datatype, &
+          ' from lammps_extract_atom_datatype not known'
+        STOP 1
+    END SELECT
+  END FUNCTION lmp_extract_atom
+
   ! equivalent function to lammps_version()
   INTEGER FUNCTION lmp_version(self)
     CLASS(lammps) :: self
@@ -682,6 +761,17 @@ CONTAINS
     END IF
   END SUBROUTINE assign_intvec_to_lammps_data
 
+  SUBROUTINE assign_int64vec_to_lammps_data (lhs, rhs)
+    INTEGER(c_int64_t), DIMENSION(:), INTENT(OUT), POINTER :: lhs
+    CLASS(lammps_data), INTENT(IN) :: rhs
+
+    IF ( rhs%datatype == DATA_INT64_1D ) THEN
+      lhs => rhs%i64_vec
+    ELSE
+      CALL assignment_error(rhs%datatype, 'vector of long ints')
+    END IF
+  END SUBROUTINE assign_int64vec_to_lammps_data
+
   SUBROUTINE assign_double_to_lammps_data (lhs, rhs)
     REAL(c_double), INTENT(OUT), POINTER :: lhs
     CLASS(lammps_data), INTENT(IN) :: rhs
@@ -704,6 +794,17 @@ CONTAINS
     END IF
   END SUBROUTINE assign_doublevec_to_lammps_data
 
+  SUBROUTINE assign_doublemat_to_lammps_data (lhs, rhs)
+    REAL(c_double), DIMENSION(:,:), INTENT(OUT), POINTER :: lhs
+    CLASS(lammps_data), INTENT(IN) :: rhs
+
+    IF ( rhs%datatype == DATA_DOUBLE_2D ) THEN
+      lhs => rhs%r64_mat
+    ELSE
+      CALL assignment_error(rhs%datatype, 'matrix of doubles')
+    END IF
+  END SUBROUTINE assign_doublemat_to_lammps_data
+
   SUBROUTINE assign_string_to_lammps_data (lhs, rhs)
     CHARACTER(LEN=*), INTENT(OUT) :: lhs
     CLASS(lammps_data), INTENT(IN) :: rhs
@@ -743,7 +844,8 @@ CONTAINS
       CASE DEFAULT
         str1 = 'that type'
     END SELECT
-    WRITE (ERROR_UNIT,'(A)') 'Cannot associate ' // str1 // ' with ' // type2
+    WRITE (ERROR_UNIT,'(A)') 'ERROR (Fortran API): cannot associate ' &
+      // str1 // ' with ' // type2
     STOP ERROR_CODE
   END SUBROUTINE assignment_error
 

unittest/fortran/CMakeLists.txt

@@ -57,6 +57,10 @@ if(CMAKE_Fortran_COMPILER)
   target_link_libraries(test_fortran_extract_global PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
   add_test(NAME FortranExtractGlobal COMMAND test_fortran_extract_global)
 
+  add_executable(test_fortran_extract_atom wrap_extract_atom.cpp test_fortran_extract_atom.f90)
+  target_link_libraries(test_fortran_extract_atom PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
+  add_test(NAME FortranExtractAtom COMMAND test_fortran_extract_atom)
+
 else()
   message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler")
 endif()