Fixed oversight in set_fix_external_callback and wrote its documentation

doc/src/Fortran.rst

@@ -358,6 +358,8 @@ of the contents of the :f:mod:`LIBLAMMPS` Fortran interface to LAMMPS.
    :ftype encode_image_flags: function
    :f decode_image_flags: :f:subr:`decode_image_flags`
    :ftype decode_image_flags: subroutine
+   :f set_fix_external_callback: :f:subr:`set_fix_external_callback`
+   :ftype set_fix_external_callback: subroutine
    :f flush_buffers: :f:subr:`flush_buffers`
    :ftype flush_buffers: subroutine
    :f is_running: :f:func:`is_running`
@@ -2096,6 +2098,67 @@ Procedures Bound to the :f:type:`lammps` Derived Type
 
 --------
 
+.. f:subroutine:: set_fix_external_callback(id, callback, caller)
+
+   Set the callback function for a :doc:`fix external <fix_external>` instance
+   with the given ID.
+
+   .. versionadded:: TBD
+
+   Fix :doc:`external <fix_external>` allows programs that are running LAMMPS
+   through its library interface to modify certain LAMMPS properties on
+   specific time steps, similar to the way other fixes do.
+
+   This subroutine sets the callback function for use with the "pf/callback"
+   mode. The function should have Fortran language bindings with the following
+   interface, which depends on how LAMMPS was compiled:
+
+   .. code-block:: Fortran
+
+      ABSTRACT INTERFACE
+        SUBROUTINE external_callback(caller, timestep, ids, x, fexternal)
+          USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double, c_int64_t
+          CLASS(*), INTENT(IN) :: caller
+          INTEGER(c_bigint), INTENT(IN) :: timestep
+          INTEGER(c_tagint), DIMENSION(:), INTENT(IN) :: ids
+          REAL(c_double), DIMENSION(:,:), INTENT(IN) :: x
+          REAL(c_double), DIMENSION(:,:), INTENT(OUT) :: fexternal
+        END SUBROUTINE external_callback
+      END INTERFACE
+
+   where ``c_bigint`` is ``c_int`` if ``-DLAMMPS_SMALLSMALL`` was used and
+   ``c_int64_t`` otherwise; and ``c_tagint`` is ``c_int64_t`` if
+   ``-DLAMMPS_BIGBIG`` was used and ``c_int`` otherwise.
+
+   The argument *caller* to :f:subr:`set_fix_external_callback` is unlimited
+   polymorphic (i.e., it can be any Fortran object you want to pass to the
+   calling function) and will be available as the first argument to the
+   callback function. It can be your LAMMPS instance, which you might need if
+   the callback function needs access to the library interface.
+
+   The array *ids* is an array of length *nlocal* (as accessed from the
+   :cpp:class:`Atom` class or through :f:func:`extract_global`). The arrays
+   *x* and *fexternal* are :math:`3 \times {}`\ *nlocal* arrays; these are
+   transposed from what they would look like in C (see note about array index
+   order at :f:func:`extract_atom`).
+
+   The callback mechanism is one of two ways that forces can be applied to a
+   simulation with the help of :doc:`fix external <fix_external>`. The
+   alternative is *array* mode, where one calls
+   :f:func:`fix_external_get_force`.
+
+   Please see the documentation for :doc:`fix external <fix_external>` for
+   more information about how to use the fix and couple it with external
+   programs.
+
+   :p character(len=*) id: ID of :doc:`fix external <fix_external>` instance
+   :p callback: subroutine :doc:`fix external <fix_external>` should call
+   :ptype callback: external
+   :p class(*) caller [optional]: object you wish to pass to the callback
+    procedure
+
+--------
+
 .. f:subroutine:: flush_buffers()
 
    This function calls :cpp:func:`lammps_flush_buffers`, which flushes buffered

fortran/lammps.f90

@@ -75,6 +75,9 @@ MODULE LIBLAMMPS
     LMP_VAR_VECTOR = 2, &     ! vector variables
     LMP_VAR_STRING = 3        ! string variables (everything else)
 
+  ! Constants we set once (in the constructor) and never need to check again
+  INTEGER(c_int), SAVE :: SIZE_TAGINT, SIZE_BIGINT, SIZE_IMAGEINT
+
   ! "Constants" to use with extract_compute and friends
   TYPE lammps_style
     INTEGER(c_int) :: global, atom, local
@@ -865,6 +868,11 @@ CONTAINS
     lmp_open%type%scalar = LMP_TYPE_SCALAR
     lmp_open%type%vector = LMP_TYPE_VECTOR
     lmp_open%type%array = LMP_TYPE_ARRAY
+
+    ! Assign constants for bigint and tagint for use elsewhere
+    SIZE_TAGINT = lmp_extract_setting(lmp_open, 'tagint')
+    SIZE_BIGINT = lmp_extract_setting(lmp_open, 'bigint')
+    SIZE_IMAGEINT = lmp_extract_setting(lmp_open, 'imageint')
   END FUNCTION lmp_open
 
   ! Combined Fortran wrapper around lammps_close() and lammps_mpi_finalize()
@@ -1731,19 +1739,16 @@ CONTAINS
   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, size_bigint
     INTEGER(c_int), POINTER :: nbonds_small
     INTEGER(c_int64_t), POINTER :: nbonds_big
     TYPE(c_ptr) :: Cdata
 
-    size_tagint = lmp_extract_setting(self, 'tagint')
+    IF (SIZE_TAGINT /= 4_c_int) THEN
-    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]')
     END IF
     IF (ALLOCATED(data)) DEALLOCATE(data)
-    size_bigint = lmp_extract_setting(self, 'bigint')
+    IF (SIZE_BIGINT == 4_c_int) THEN
-    IF (size_bigint == 4_c_int) THEN
       nbonds_small = lmp_extract_global(self, 'nbonds')
       ALLOCATE(data(3*nbonds_small))
     ELSE
@@ -1758,12 +1763,10 @@ CONTAINS
   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
-    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]')
     END IF
@@ -2385,10 +2388,7 @@ CONTAINS
     CLASS(*), INTENT(IN), TARGET, OPTIONAL :: caller
     TYPE(c_ptr) :: c_id, c_caller
     TYPE(c_funptr) :: c_callback
-    INTEGER :: i, this_fix, size_tagint, size_bigint
+    INTEGER :: i, this_fix
-
-    size_tagint = lmp_extract_setting(self, 'tagint')
-    size_bigint = lmp_extract_setting(self, 'bigint')
 
     c_id = f2c_string(id)
     IF (ALLOCATED(ext_data)) THEN
@@ -2400,7 +2400,10 @@ CONTAINS
         END IF
       END DO
       IF (this_fix > SIZE(ext_data)) THEN
+        ! reallocates ext_data; this requires us to re-bind "caller" on the C
+        ! side to the new data structure, which likely moved to a new address
         ext_data = [ext_data, fix_external_data()] ! extends ext_data by 1
+        CALL rebind_external_callback_data()
       END IF
     ELSE
       ALLOCATE(ext_data(1))
@@ -2409,11 +2412,11 @@ CONTAINS
     ext_data(this_fix)%id = id
     ext_data(this_fix)%lammps_instance => self
 
-    IF (size_tagint == 4_c_int .AND. size_bigint == 4_c_int) THEN
+    IF (SIZE_TAGINT == 4_c_int .AND. SIZE_BIGINT == 4_c_int) THEN
       ! -DSMALLSMALL
       c_callback = C_FUNLOC(callback_wrapper_smallsmall)
       CALL set_fix_external_callback_smallsmall(this_fix, callback)
-    ELSE IF (size_tagint == 8_c_int .AND. size_bigint == 8_c_int) THEN
+    ELSE IF (SIZE_TAGINT == 8_c_int .AND. SIZE_BIGINT == 8_c_int) THEN
       ! -DBIGBIG
       c_callback = C_FUNLOC(callback_wrapper_bigbig)
       CALL set_fix_external_callback_bigbig(this_fix, callback)
@@ -2431,6 +2434,7 @@ CONTAINS
     c_caller = C_LOC(ext_data(this_fix))
     CALL lammps_set_fix_external_callback(self%handle, c_id, c_callback, &
       c_caller)
+    CALL lammps_free(c_id)
   END SUBROUTINE lmp_set_fix_external_callback
 
   ! Wrappers to assign callback pointers with explicit interfaces
@@ -2455,6 +2459,28 @@ CONTAINS
     ext_data(id)%callback_bigbig => callback
   END SUBROUTINE set_fix_external_callback_bigbig
 
+  ! subroutine that re-binds all external callback data after a reallocation
+  SUBROUTINE rebind_external_callback_data()
+    INTEGER :: i
+    TYPE(c_ptr) :: c_id, c_caller
+    TYPE(c_funptr) :: c_callback
+
+    DO i = 1, SIZE(ext_data) - 1
+      c_id = f2c_string(ext_data(i)%id)
+      c_caller = C_LOC(ext_data(i))
+      IF (SIZE_TAGINT == 4_c_int .AND. SIZE_BIGINT == 4_c_int) THEN
+        c_callback = C_FUNLOC(callback_wrapper_smallsmall)
+      ELSE IF (SIZE_TAGINT == 8_c_int .AND. SIZE_BIGINT == 8_c_int) THEN
+        c_callback = C_FUNLOC(callback_wrapper_bigbig)
+      ELSE
+        c_callback = C_FUNLOC(callback_wrapper_smallbig)
+      END IF
+      CALL lammps_set_fix_external_callback( &
+        ext_data(i)%lammps_instance%handle, c_id, c_callback, c_caller)
+      CALL lammps_free(c_id)
+    END DO
+  END SUBROUTINE rebind_external_callback_data
+
   ! companions to lmp_set_fix_external_callback to change interface
   SUBROUTINE callback_wrapper_smallsmall(caller, timestep, nlocal, ids, x, &
       fexternal) BIND(C)