diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index ec54a594d1..12d39e8af7 100644 --- a/doc/src/Fortran.rst +++ b/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 ` instance + with the given ID. + + .. versionadded:: TBD + + Fix :doc:`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 `. The + alternative is *array* mode, where one calls + :f:func:`fix_external_get_force`. + + Please see the documentation for :doc:`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 ` instance + :p callback: subroutine :doc:`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 diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 02664c54db..eb32dcd266 100644 --- a/fortran/lammps.f90 +++ b/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 - - size_tagint = lmp_extract_setting(self, 'tagint') - size_bigint = lmp_extract_setting(self, 'bigint') + INTEGER :: i, this_fix 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)