diff --git a/doc/src/Build_manual.rst b/doc/src/Build_manual.rst index a920688923..c71c536e10 100644 --- a/doc/src/Build_manual.rst +++ b/doc/src/Build_manual.rst @@ -216,7 +216,7 @@ be multiple tests run automatically: - A test that only standard, printable ASCII text characters are used. This runs the command ``env LC_ALL=C grep -n '[^ -~]' src/*.rst`` and thus prints all offending lines with filename and line number - prepended to the screen. Special characters like greek letters + prepended to the screen. Special characters like Greek letters (:math:`\alpha~~\sigma~~\epsilon`), super- or subscripts (:math:`x^2~~\mathrm{U}_{LJ}`), mathematical expressions (:math:`\frac{1}{2}\mathrm{N}~~x\to\infty`), or the Angstrom symbol diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 77ab447c7c..28254e056c 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -1,16 +1,16 @@ The ``LIBLAMMPS`` Fortran Module ******************************** -The ``LIBLAMMPS`` module provides an interface to call LAMMPS from a -Fortran code. It is based on the LAMMPS C-library interface and -requires a Fortran 2003 compatible compiler to be compiled. It is +The ``LIBLAMMPS`` module provides an interface to call LAMMPS from Fortran. +It is based on the LAMMPS C library interface and +requires a Fortran 2003-compatible compiler to be compiled. It is designed to be self-contained and not require any support functions -written in C, C++, or Fortran. +written in C, C++, or Fortran other than those in the C library interface. While C libraries have a defined binary interface (ABI) and can thus be -used from multiple compiler versions from different vendors for as long +used from multiple compiler versions from different vendors as long as they are compatible with the hosting operating system, the same is -not true for Fortran codes. Thus the LAMMPS Fortran module needs to be +not true for Fortran programs. Thus, the LAMMPS Fortran module needs to be compiled alongside the code using it from the source code in ``fortran/lammps.f90``. When linking, you also need to :doc:`link to the LAMMPS library `. A typical command line @@ -18,23 +18,23 @@ for a simple program using the Fortran interface would be: .. code-block:: bash - mpifort -o testlib.x lammps.f90 testlib.f90 -L. -llammps + mpifort -o testlib.x lammps.f90 testlib.f90 -L. -llammps -Please note, that the MPI compiler wrapper is only required when the -calling the library from an MPI parallel code. Otherwise, using the +Please note that the MPI compiler wrapper is only required when the +calling the library from an MPI-parallelized program. Otherwise, using the fortran compiler (gfortran, ifort, flang, etc.) will suffice. It may be -necessary to link to additional libraries depending on how LAMMPS was +necessary to link to additional libraries, depending on how LAMMPS was configured and whether the LAMMPS library :doc:`was compiled as a static -or shared library `. +or dynamic library `. If the LAMMPS library itself has been compiled with MPI support, the resulting executable will still be able to run LAMMPS in parallel with -``mpirun`` or equivalent. Please also note that the order of the source -files matters: the ``lammps.f90`` file needs to be compiled first, since -it provides the ``LIBLAMMPS`` module that is imported by the Fortran -code using the interface. A working example code can be found together -with equivalent examples in C and C++ in the ``examples/COUPLE/simple`` -folder of the LAMMPS distribution. +``mpirun``, ``mpiexec`` or equivalent. Please also note that the order +of the source files matters: the ``lammps.f90`` file needs to be +compiled first, since it provides the ``LIBLAMMPS`` module that is +imported by the Fortran code that uses the interface. A working example +can be found together with equivalent examples in C and C++ in the +``examples/COUPLE/simple`` folder of the LAMMPS distribution. .. versionadded:: 9Oct2020 @@ -49,7 +49,7 @@ folder of the LAMMPS distribution. .. note:: A contributed (and more complete!) Fortran interface that more - closely resembles the C-library interface is available in the + closely resembles the C library interface is available in the ``examples/COUPLE/fortran2`` folder. Please see the ``README`` file in that folder for more information about it and how to contact its author and maintainer. @@ -62,32 +62,31 @@ Creating or deleting a LAMMPS object With the Fortran interface, the creation of a :cpp:class:`LAMMPS ` instance is included in the constructor for creating the :f:func:`lammps` derived type. To import the definition of -that type and its type bound procedures, you need to add a ``USE -LIBLAMMPS`` statement. Internally it will call either +that type and its type-bound procedures, you need to add a ``USE LIBLAMMPS`` +statement. Internally, it will call either :cpp:func:`lammps_open_fortran` or :cpp:func:`lammps_open_no_mpi` from the C library API to create the class instance. All arguments are -optional and :cpp:func:`lammps_mpi_init` will be called automatically, +optional and :cpp:func:`lammps_mpi_init` will be called automatically if it is needed. Similarly, a possible call to :cpp:func:`lammps_mpi_finalize` is integrated into the :f:func:`close` function and triggered with the optional logical argument set to -``.true.``. Here is a simple example: +``.TRUE.``. Here is a simple example: .. code-block:: fortran PROGRAM testlib USE LIBLAMMPS ! include the LAMMPS library interface IMPLICIT NONE - TYPE(lammps) :: lmp ! derived type to hold LAMMPS instance - CHARACTER(len=*), PARAMETER :: args(3) = & - [ CHARACTER(len=12) :: 'liblammps', '-log', 'none' ] + TYPE(lammps) :: lmp ! derived type to hold LAMMPS instance + CHARACTER(LEN=*), PARAMETER :: args(3) = & + [ CHARACTER(LEN=12) :: 'liblammps', '-log', 'none' ] ! create a LAMMPS instance (and initialize MPI) lmp = lammps(args) ! get and print numerical version code PRINT*, 'LAMMPS Version: ', lmp%version() - ! delete LAMMPS instance (and shuts down MPI) - CALL lmp%close(.true.) - + ! delete LAMMPS instance (and shutdown MPI) + CALL lmp%close(.TRUE.) END PROGRAM testlib It is also possible to pass command line flags from Fortran to C/C++ and @@ -103,8 +102,8 @@ version of the previous example: PROGRAM testlib2 USE LIBLAMMPS ! include the LAMMPS library interface IMPLICIT NONE - TYPE(lammps) :: lmp ! derived type to hold LAMMPS instance - CHARACTER(len=128), ALLOCATABLE :: command_args(:) + TYPE(lammps) :: lmp ! derived type to hold LAMMPS instance + CHARACTER(LEN=128), ALLOCATABLE :: command_args(:) INTEGER :: i, argc ! copy command line flags to `command_args()` @@ -122,7 +121,6 @@ version of the previous example: ! delete LAMMPS instance (and shuts down MPI) CALL lmp%close(.TRUE.) DEALLOCATE(command_args) - END PROGRAM testlib2 -------------------- @@ -133,9 +131,9 @@ Executing LAMMPS commands Once a LAMMPS instance is created, it is possible to "drive" the LAMMPS simulation by telling LAMMPS to read commands from a file or to pass individual or multiple commands from strings or lists of strings. This -is done similarly to how it is implemented in the :doc:`C-library +is done similarly to how it is implemented in the :doc:`C library interface `. Before handing off the calls to the -C-library interface, the corresponding Fortran versions of the calls +C library interface, the corresponding Fortran versions of the calls (:f:func:`file`, :f:func:`command`, :f:func:`commands_list`, and :f:func:`commands_string`) have to make a copy of the strings passed as arguments so that they can be modified to be compatible with the @@ -159,9 +157,9 @@ Below is a small demonstration of the uses of the different functions: ! define 10 groups of 10 atoms each ALLOCATE(cmdlist(10)) DO i=1, 10 - WRITE(trimmed,'(I10)') 10*i - WRITE(cmdlist(i),'(A,I1,A,I10,A,A)') & - 'group g', i-1, ' id ', 10*(i-1)+1, ':', ADJUSTL(trimmed) + WRITE(trimmed,'(I10)') 10*i + WRITE(cmdlist(i),'(A,I1,A,I10,A,A)') & + 'group g', i-1, ' id ', 10*(i-1)+1, ':', ADJUSTL(trimmed) END DO CALL lmp%commands_list(cmdlist) ! run multiple commands from multi-line string @@ -171,7 +169,6 @@ Below is a small demonstration of the uses of the different functions: 'create_atoms 1 single 1.0 1.0 ${zpos}' CALL lmp%commands_string(cmds) CALL lmp%close(.TRUE.) - END PROGRAM testcmd --------------- @@ -179,13 +176,15 @@ Below is a small demonstration of the uses of the different functions: Accessing system properties *************************** -The C-library interface allows the :doc:`extraction of different kinds +The C library interface allows the :doc:`extraction of different kinds of information ` about the active simulation -instance and also - in some cases - to apply modifications to it. In -some cases, the C-library interface makes pointers to internal data -structures accessible, thus when accessing them from Fortran, special -care is needed to avoid data corruption and crashes. Thus please see -the documentation of the individual type bound procedures for details. +instance and also---in some cases---to apply modifications to it, and the +Fortran interface provides access to the same data using Fortran-style, +C-interoperable data types. In some cases, the Fortran library interface makes +pointers to internal LAMMPS data structures accessible; when accessing them +through the library interfaces, special care is needed to avoid data corruption +and crashes. Please see the documentation of the individual type-bound +procedures for details. Below is an example demonstrating some of the possible uses. @@ -194,35 +193,36 @@ Below is an example demonstrating some of the possible uses. PROGRAM testprop USE LIBLAMMPS USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int64_t - TYPE(lammps) :: lmp - INTEGER(kind=8) :: natoms - REAL(c_double), POINTER :: dt - INTEGER(c_int64_t), POINTER :: ntimestep - REAL(kind=8) :: pe, ke + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : OUTPUT_UNIT + TYPE(lammps) :: lmp + INTEGER(KIND=c_int64_t), POINTER :: natoms + REAL(KIND=c_double), POINTER :: dt + INTEGER(KIND=c_int64_t), POINTER :: ntimestep + REAL(KIND=c_double) :: pe, ke lmp = lammps() CALL lmp%file('in.sysinit') - natoms = INT(lmp%get_natoms(),8) - WRITE(6,'(A,I8,A)') 'Running a simulation with', natoms, ' atoms' - WRITE(6,'(I8,A,I8,A,I3,A)') lmp%extract_setting('nlocal'), ' local and', & - lmp%extract_setting('nghost'), ' ghost atom. ', & + natoms = lmp%extract_global('natoms') + WRITE(OUTPUT_UNIT,'(A,I0,A)') 'Running a simulation with ', natoms, ' atoms' + WRITE(OUTPUT_UNIT,'(I0,A,I0,A,I0,A)') lmp%extract_setting('nlocal'), & + ' local and ', lmp%extract_setting('nghost'), ' ghost atoms. ', & lmp%extract_setting('ntypes'), ' atom types' CALL lmp%command('run 2 post no') dt = lmp%extract_global('dt') ntimestep = lmp%extract_global('ntimestep') - WRITE(6,'(A,I4,A,F4.1,A)') 'At step:', ntimestep, ' Changing timestep from', dt, ' to 0.5' - dt = 0.5 + WRITE(OUTPUT_UNIT,'(A,I0,A,F4.1,A)') 'At step: ', ntimestep, & + ' Changing timestep from', dt, ' to 0.5' + dt = 0.5_c_double CALL lmp%command('run 2 post no') - WRITE(6,'(A,I4)') 'At step:', ntimestep + WRITE(OUTPUT_UNIT,'(A,I0)') 'At step: ', ntimestep pe = lmp%get_thermo('pe') ke = lmp%get_thermo('ke') PRINT*, 'PE = ', pe PRINT*, 'KE = ', ke CALL lmp%close(.TRUE.) - END PROGRAM testprop --------------- @@ -240,9 +240,10 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. class instance that any of the included calls are forwarded to. :f c_ptr handle: reference to the LAMMPS class + :f type(lammps_style) style: derived type to access lammps style constants + :f type(lammps_type) type: derived type to access lammps type constants :f subroutine close: :f:func:`close` :f subroutine error: :f:func:`error` - :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` @@ -252,8 +253,23 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :f subroutine extract_box: :f:func:`extract_box` :f subroutine reset_box: :f:func:`reset_box` :f subroutine memory_usage: :f:func:`memory_usage` + :f function get_mpi_comm: :f:func:`get_mpi_comm` :f function extract_setting: :f:func:`extract_setting` :f function extract_global: :f:func:`extract_global` + :f function extract_atom: :f:func:`extract_atom` + :f function extract_compute: :f:func:`extract_compute` + :f function extract_fix: :f:func:`extract_fix` + :f function extract_variable: :f:func:`extract_variable` + :f subroutine gather_atoms: :f:func:`gather_atoms` + :f subroutine gather_atoms_concat: :f:func:`gather_atoms_concat` + :f subroutine gather_atoms_subset: :f:func:`gather_atoms_subset` + :f subroutine scatter_atoms: :f:func:`scatter_atoms` + :f subroutine scatter_atoms_subset: :f:func:`scatter_atoms_subset` + :f function version: :f:func:`version` + :f subroutine flush_buffers: :f:func:`flush_buffers` + :f function is_running: :f:func:`is_running` + :f function has_error: :f:func:`has_error` + :f subroutine get_last_error_message: :f:func:`get_last_error_message` -------- @@ -286,12 +302,30 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. .. code-block:: Fortran PROGRAM testmpi - USE LIBLAMMPS - USE MPI_F08 - TYPE(lammps) :: lmp - lmp = lammps(MPI_COMM_SELF%MPI_VAL) + USE LIBLAMMPS + USE MPI_F08 + TYPE(lammps) :: lmp + lmp = lammps(MPI_COMM_SELF%MPI_VAL) END PROGRAM testmpi +.. f:type:: lammps_style + + This derived type is there to provide a convenient interface for the style + constants used with :f:func:`extract_compute`, :f:func:`extract_fix`, and + :f:func:`extract_variable`. Assuming your LAMMPS instance is called ``lmp``, + these constants will be ``lmp%style%global``, ``lmp%style%atom``, + and ``lmp%style%local``. These values are identical to the values described + in :cpp:enum:`_LMP_STYLE_CONST` for the C library interface. + +.. f:type:: lammps_type + + This derived type is there to provide a convenient interface for the type + constants used with :f:func:`extract_compute`, :f:func:`extract_fix`, and + :f:func:`extract_variable`. Assuming your LAMMPS instance is called ``lmp``, + these constants will be ``lmp%type%scalar``, ``lmp%type%vector``, and + ``lmp%type%array``. These values are identical to the values described + in :cpp:enum:`_LMP_TYPE_CONST` for the C library interface. + Procedures Bound to the lammps Derived Type =========================================== @@ -299,17 +333,18 @@ 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:subroutine:: error(error_type, error_text) - This method is a wrapper around the :cpp:func:`lammps_error` function and will dispatch - an error through the LAMMPS Error class. + This method is a wrapper around the :cpp:func:`lammps_error` function and + will dispatch an error through the LAMMPS Error class. .. versionadded:: TBD @@ -318,14 +353,6 @@ Procedures Bound to the lammps Derived Type -------- -.. f:function:: version() - - This method returns the numeric LAMMPS version like :cpp:func:`lammps_version` - - :r integer: LAMMPS version - --------- - .. f:subroutine:: file(filename) This method will call :cpp:func:`lammps_file` to have LAMMPS read @@ -369,6 +396,12 @@ Procedures Bound to the lammps Derived Type :r real(c_double): number of atoms + .. note:: + + If you would prefer to get the number of atoms in its native format + (i.e., as a 32- or 64-bit integer, depending on how LAMMPS was compiled), + this can be extracted with :f:func:`extract_global`. + -------- .. f:function:: get_thermo(name) @@ -471,7 +504,7 @@ Procedures Bound to the lammps Derived Type .. note:: - The `MPI_F08` module, which defines Fortran 2008 bindings for MPI, + The ``MPI_F08`` module, which defines Fortran 2008 bindings for MPI, is not directly supported by this function. However, you should be able to convert between the two using the `MPI_VAL` member of the communicator. For example, @@ -480,12 +513,12 @@ Procedures Bound to the lammps Derived Type USE MPI_F08 USE LIBLAMMPS - TYPE (LAMMPS) :: lmp + TYPE (lammps) :: lmp TYPE (MPI_Comm) :: comm ! ... [commands to set up LAMMPS/etc.] comm%MPI_VAL = lmp%get_mpi_comm() - should assign an `MPI_F08` communicator properly. + should assign an ``MPI_F08`` communicator properly. -------- @@ -528,21 +561,21 @@ Procedures Bound to the lammps Derived Type .. code-block:: fortran PROGRAM demo - USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t - USE LIBLAMMPS - TYPE(lammps) :: lmp - INTEGER(c_int), POINTER :: nlocal - INTEGER(c_int64_t), POINTER :: ntimestep - CHARACTER(LEN=10) :: units - REAL(c_double), POINTER :: dt - lmp = lammps() - ! other commands - nlocal = lmp%extract_global('nlocal') - ntimestep = lmp%extract_global('ntimestep') - dt = lmp%extract_global('dt') - units = lmp%extract_global('units') - ! more commands - lmp.close(.TRUE.) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t, c_int, c_double + USE LIBLAMMPS + TYPE(lammps) :: lmp + INTEGER(c_int), POINTER :: nlocal => NULL() + INTEGER(c_int64_t), POINTER :: ntimestep => NULL() + REAL(c_double), POINTER :: dt => NULL() + CHARACTER(LEN=10) :: units + lmp = lammps() + ! other commands + nlocal = lmp%extract_global('nlocal') + ntimestep = lmp%extract_global('ntimestep') + dt = lmp%extract_global('dt') + units = lmp%extract_global('units') + ! more commands + lmp.close(.TRUE.) END PROGRAM demo would extract the number of atoms on this processor, the current time step, @@ -551,23 +584,957 @@ Procedures Bound to the lammps Derived Type .. note:: - if this function 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. + 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. If you use an allocatable + string, the string **must be allocated** prior to calling this function, + but you can automatically reallocate it to the correct length after the + function returns, viz., - :p character(len=\*) name: string with the name of the extracted property + .. code-block :: Fortran + + PROGRAM test + USE LIBLAMMPS + TYPE(lammps) :: lmp + CHARACTER(LEN=:), ALLOCATABLE :: str + lmp = lammps() + CALL lmp%command('units metal') + ALLOCATE ( CHARACTER(LEN=80) :: str ) + str = lmp%extract_global('units') + str = TRIM(str) ! re-allocates to length len_trim(str) here + PRINT*, LEN(str), LEN_TRIM(str) + END PROGRAM test + + will print the number 5 (the length of the word "metal") twice. + + :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-compatible pointer (e.g., ``INTEGER (c_int), POINTER :: nlocal``) to the extracted property. If expecting vector data, the pointer should have dimension ":". -.. warning:: + .. warning:: - Modifying the data in the location pointed to by the returned pointer - may lead to inconsistent internal data and thus may cause failures or - crashes or bogus simulations. In general it is thus usually better - 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. + Modifying the data in the location pointed to by the returned pointer + may lead to inconsistent internal data and thus may cause failures, + crashes, or bogus simulations. In general, it is much better + to use a LAMMPS input command that sets or changes these parameters. + Using an input command 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*. + + .. versionadded:: TBD + + 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", "mask", or "tag"; + ``INTEGER(c_int64_t), DIMENSION(:)`` for "tag" if LAMMPS was compiled + with the ``-DLAMMPS_BIGBIG`` flag; ``REAL(c_double), DIMENSION(:,:)`` for + "x", "v", 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 of appropriate kind and rank + (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 ":,:". + + .. admonition:: Array index order + + 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 => NULL() + ! more code to setup, etc. + x = lmp%extract_atom("x") + 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 + rather a consequence of the different conventions adopted by the Fortran + and C standards decades ago: in C, the block of data + + .. parsed-literal:: + + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 + + interpreted as a :math:`4\times4` matrix would be + + .. math:: + + \begin{bmatrix} + 1 & 2 & 3 & 4 \\ + 5 & 6 & 7 & 8 \\ + 9 & 10 & 11 & 12 \\ + 13 & 14 & 15 & 16 + \end{bmatrix}, + + that is, in row-major order. In Fortran, the same block of data is + interpreted in column-major order, namely, + + .. math:: + + \begin{bmatrix} + 1 & 5 & 9 & 13 \\ + 2 & 6 & 10 & 14 \\ + 3 & 7 & 11 & 15 \\ + 4 & 8 & 12 & 16 + \end{bmatrix}. + + This difference in interpretation of the same block of data by the two + languages means, in effect, that matrices from C or C++ will be + transposed when interpreted in Fortran. + + .. note:: + + 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:nmax) + and those of *x0* to be (0:2, 0:nmax-1). + +-------- + +.. f:function:: extract_compute(id, style, type) + + This function calls :c:func:`lammps_extract_compute` and returns a pointer + to LAMMPS data tied to the :cpp:class:`Compute` class, specifically data + provided by the compute identified by *id*. Computes may provide global, + per-atom, or local data, and those data may be a scalar, a vector, or an + array. Since computes may provide multiple kinds of data, the user is + required to specify which set of data is to be returned through the + *style* and *type* variables. + + .. versionadded:: TBD + + Note that this function actually does not return a value, but rather + associates the pointer on the left side of the assignment to point to + internal LAMMPS data. Pointers must be of the correct data type to point to + said data (i.e., ``REAL(c_double)``) and have compatible rank. The pointer + being associated with LAMMPS data is type-, kind-, and rank-checked at + run-time via an overloaded assignment operator. + + For example, + + .. code-block:: Fortran + + TYPE(lammps) :: lmp + REAL(c_double), DIMENSION(:), POINTER :: COM + ! code to setup, create atoms, etc. + CALL lmp%compute('compute COM all com') + COM = lmp%extract_compute('COM', lmp%style%global, lmp%style%type) + + will bind the variable *COM* to the center of mass of the atoms created in + your simulation. The vector in this case has length 3; the length (or, in + the case of array data, the number of rows and columns) is determined for + you based on data from the :cpp:class:`Compute` class. + + .. admonition:: Array index order + + Two-dimensional arrays returned from :f:func:`extract_compute` will be + **transposed** from equivalent arrays in C, and they will be indexed + from 1 instead of 0. See the note at :f:func:`extract_atom` for + further details. + + The following combinations are possible (assuming ``lmp`` is the name of + your LAMMPS instance): + + .. list-table:: + :header-rows: 1 + :widths: auto + + * - Style + - Type + - Type to assign to + - Returned data + * - ``lmp%style%global`` + - ``lmp%type%scalar`` + - ``REAL(c_double), POINTER`` + - Global scalar + * - ``lmp%style%global`` + - ``lmp%type%vector`` + - ``REAL(c_double), DIMENSION(:), POINTER`` + - Global vector + * - ``lmp%style%global`` + - ``lmp%type%array`` + - ``REAL(c_double), DIMENSION(:,:), POINTER`` + - Global array + * - ``lmp%style%atom`` + - ``lmp%type%vector`` + - ``REAL(c_double), DIMENSION(:), POINTER`` + - Per-atom vector + * - ``lmp%style%atom`` + - ``lmp%type%array`` + - ``REAL(c_double), DIMENSION(:,:), POINTER`` + - Per-atom array + * - ``lmp%style%local`` + - ``lmp%type%vector`` + - ``REAL(c_double), DIMENSION(:), POINTER`` + - Local vector + * - ``lmp%style%local`` + - ``lmp%type%array`` + - ``REAL(c_double), DIMENSION(:,:), POINTER`` + - Local array + + :p character(len=\*) id: compute ID from which to extract data + :p integer(c_int) style: value indicating the style of data to extract + (global, per-atom, or local) + :p integer(c_int) type: value indicating the type of data to extract + (scalar, vector, or array) + :r polymorphic: pointer to LAMMPS data. The left-hand side of the assignment + should be a C-compatible pointer (e.g., ``REAL (c_double), POINTER :: x``) + to the extracted property. If expecting vector data, the pointer should + have dimension ":"; if expecting array (matrix) data, the pointer should + have dimension ":,:". + + .. note:: + + If the compute's data are not already computed for the current step, the + compute will be invoked. LAMMPS cannot easily check at that time if it is + valid to invoke a compute, so it may fail with an error. The caller has + to check to avoid such an error. + + .. warning:: + + The pointers returned by this function are generally not persistent, + since the computed data may be re-distributed, re-allocated, and + re-ordered at every invocation. It is advisable to re-invoke this + function before the data are accessed or make a copy if the data are to + be used after other LAMMPS commands have been issued. Do **not** modify + the data returned by this function. + +-------- + +.. f:function:: extract_fix(id, style, type[, nrow][, ncol]) + + This function calls :c:func:`lammps_extract_fix` and returns a pointer to + LAMMPS data tied to the :cpp:class:`Fix` class, specifically data provided + by the fix identified by *id*. Fixes may provide global, per-atom, or + local data, and those data may be a scalar, a vector, or an array. Since + many fixes provide multiple kinds of data, the user is required to specify + which set of data is to be returned through the *style* and *type* + variables. + + .. versionadded:: TBD + + Global data are calculated at the time they are requested and are only + available element-by-element. As such, the user is expected to provide + the *nrow* variable to specify which element of a global vector or the + *nrow* and *ncol* variables to specify which element of a global array the + user wishes LAMMPS to return. The *ncol* variable is optional for global + scalar or vector data, and both *nrow* and *ncol* are optional when a + global scalar is requested, as well as when per-atom or local data are + requested. The following combinations are possible (assuming ``lmp`` is the + name of your LAMMPS instance): + + .. list-table:: + :header-rows: 1 + :widths: auto + + * - Style + - Type + - nrow + - ncol + - Type to assign to + - Returned data + * - ``lmp%style%global`` + - ``lmp%type%scalar`` + - Ignored + - Ignored + - ``REAL(c_double)`` + - Global scalar + * - ``lmp%style%global`` + - ``lmp%type%vector`` + - Required + - Ignored + - ``REAL(c_double)`` + - Element of global vector + * - ``lmp%style%global`` + - ``lmp%type%array`` + - Required + - Required + - ``REAL(c_double)`` + - Element of global array + * - ``lmp%style%atom`` + - ``lmp%type%scalar`` + - + - + - + - (not allowed) + * - ``lmp%style%atom`` + - ``lmp%type%vector`` + - Ignored + - Ignored + - ``REAL(c_double), DIMENSION(:), POINTER`` + - Per-atom vector + * - ``lmp%style%atom`` + - ``lmp%type%array`` + - Ignored + - Ignored + - ``REAL(c_double), DIMENSION(:,:), POINTER`` + - Per-atom array + * - ``lmp%style%local`` + - ``lmp%type%scalar`` + - + - + - + - (not allowed) + * - ``lmp%style%local`` + - ``lmp%type%vector`` + - Ignored + - Ignored + - ``REAL(c_double), DIMENSION(:), POINTER`` + - Per-atom vector + * - ``lmp%style%local`` + - ``lmp%type%array`` + - Ignored + - Ignored + - ``REAL(c_double), DIMENSION(:,:), POINTER`` + - Per-atom array + + In the case of global data, this function returns a value of type + ``real(c_double)``. For per-atom or local data, this function does not + return a value but instead associates the pointer on the left side of the + assignment to point to internal LAMMPS data. Pointers must be of the correct + data type to point to said data (i.e., ``REAL(c_double)``) and have + compatible rank. The pointer being associated with LAMMPS data is type-, + kind-, and rank-checked at run-time via an overloaded assignment operator. + + For example, + + .. code-block:: Fortran + + TYPE(lammps) :: lmp + REAL(c_double) :: dr, dx, dy, dz + ! more code to set up, etc. + lmp%command('fix george all recenter 2 2 2') + ! more code + dr = lmp%extract_fix("george", lmp%style%global, lmp%style%scalar) + dx = lmp%extract_fix("george", lmp%style%global, lmp%style%vector, 1) + dy = lmp%extract_fix("george", lmp%style%global, lmp%style%vector, 2) + dz = lmp%extract_fix("george", lmp%style%global, lmp%style%vector, 3) + + will extract the global scalar calculated by + :doc:`fix recenter ` into the variable *dr* and the + three elements of the global vector calculated by fix recenter into the + variables *dx*, *dy*, and *dz*, respectively. + + If asked for per-atom or local data, :f:func:`extract_compute` returns a + pointer to actual LAMMPS data. The pointer so returned will have the + appropriate size to match the internal data, and will be + type/kind/rank-checked at the time of the assignment. For example, + + .. code-block:: Fortran + + TYPE(lammps) :: lmp + REAL(c_double), DIMENSION(:), POINTER :: r + ! more code to set up, etc. + lmp%command('fix state all store/state 0 x y z') + ! more code + r = lmp%extract_fix('state', lmp%style%atom, lmp%type%array) + + will bind the pointer *r* to internal LAMMPS data representing the per-atom + array computed by :doc:`fix store/state ` when three + inputs are specified. Similarly, + + .. code-block:: Fortran + + TYPE(lammps) :: lmp + REAL(c_double), DIMENSION(:), POINTER :: x + ! more code to set up, etc. + lmp%command('fix state all store/state 0 x') + ! more code + x = lmp%extract_fix('state', lmp%style%atom, lmp%type%vector) + + will associate the pointer *x* with internal LAMMPS data corresponding to + the per-atom vector computed by :doc:`fix store/state ` + when only one input is specified. Similar examples with ``lmp%style%atom`` + replaced by ``lmp%style%local`` will extract local data from fixes that + define local vectors and/or arrays. + + .. warning:: + + The pointers returned by this function for per-atom or local data are + generally not persistent, since the computed data may be redistributed, + reallocated, and reordered at every invocation of the fix. It is thus + advisable to re-invoke this function before the data are accessed or to + make a copy if the data are to be used after other LAMMPS commands have + been issued. + + .. note:: + + LAMMPS cannot easily check if it is valid to access the data, so it + may fail with an error. The caller has to avoid such an error. + + :p character(len=\*) id: string with the name of the fix from which + to extract data + :p integer(c_int) style: value indicating the style of data to extract + (global, per-atom, or local) + :p integer(c_int) type: value indicating the type of data to extract + (scalar, vector, or array) + :p integer(c_int) nrow: row index (used only for global vectors and arrays) + :p integer(c_int) ncol: column index (only used for global arrays) + :r polymorphic: LAMMPS data (for global data) or a pointer to LAMMPS data + (for per-atom or local data). The left-hand side of the assignment should + be of type ``REAL(c_double)`` and have appropriate rank (i.e., + ``DIMENSION(:)`` if expecting per-atom or local vector data and + ``DIMENSION(:,:)`` if expecting per-atom or local array data). If expecting + local or per-atom data, it should have the ``POINTER`` attribute, but + if expecting global data, it should be an ordinary (non-``POINTER``) + variable. + + .. admonition:: Array index order + + Two-dimensional global, per-atom, or local array data from + :f:func:`extract_fix` will be **transposed** from equivalent arrays in + C (or in the ordinary LAMMPS interface accessed through thermodynamic + output), and they will be indexed from 1, not 0. This is true even for + global data, which are returned as scalars---this is done primarily so + the interface is consistent, as there is no choice but to transpose the + indices for per-atom or local array data. See the similar note under + :f:func:`extract_atom` for further details. + +-------- + +.. f:function:: extract_variable(name[,group]) + + This function calls :c:func:`lammps_extract_variable` and returns a scalar, + vector, or string containing the value of the variable identified by + *name*. When the variable is an *equal*-style variable (or one compatible + with that style such as *internal*), the variable is evaluated and the + corresponding value returned. When the variable is an *atom*-style variable, + the variable is evaluated and a vector of values is returned. With all + other variables, a string is returned. The *group* argument is only used + for *atom* style variables and is ignored otherwise. If *group* is absent + for *atom*-style variables, the group is assumed to be "all". + + .. versionadded:: TBD + + This function returns the values of the variables, not pointers to them. + Vectors pointing to *atom*-style variables should be of type + ``REAL(c_double)``, be of rank 1 (i.e., ``DIMENSION(:)``), and have the + ``ALLOCATABLE`` attribute. + + .. note:: + + Unlike the C library interface, the Fortran interface does not require + you to deallocate memory when you are through; this is done for you, + behind the scenes. + + For example, + + .. code-block:: Fortran + + TYPE(lammps) :: lmp + REAL(c_double) :: area + ! more code to set up, etc. + lmp%command('variable A equal lx*ly') + ! more code + area = lmp%extract_variable("A") + + will extract the *x*\ --*y* cross-sectional area of the simulation into the + variable *area*. + + :p character(len=\*) name: variable name to evaluate + :o character(len=\*) group [optional]: group for which to extract per-atom + 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(:), 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:: + + LAMMPS cannot easily check if it is valid to access the data + referenced by the variables (e.g., computes, fixes, or thermodynamic + info), so it may fail with an error. The caller has to make certain + that the data are extracted only when it is safe to evaluate the variable + and thus an error and crash are avoided. + +-------- + +.. f:subroutine:: 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)``. + See the note about array index order at :f:func:`extract_atom`. + +-------- + +.. f:subroutine:: 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:subroutine:: gather_atoms_subset(name, count, ids, data) + + This function calls :c:func:`lammps_gather_atoms_subset` to gather the named + atom-based entity for the atoms in the array *ids* from all processors and + return it in the vector *data*. + + .. versionadded: TBD + + 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 + :f:func:`gather_atoms` or :f:func:`gather_atoms_concat`. + + The *data* array will be in groups of *count* values, sorted by atom ID + in the same order as the array *ids* (e.g., if *name* is *x*, *count* = 3, + and *ids* is [100, 57, 210], then *data* might look like + [x(1,100), x(2,100), x(3,100), x(1,57), x(2,57), x(3,57), x(1,210), + :math:`\dots`]; *ids* must be provided by the user, and *data* must be + of rank 1 (i.e., ``DIMENSION(:)``) and have the ``ALLOCATABLE`` attribute. + + :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 integer(c_int) ids [dimension(:)]: atom IDs corresponding to the atoms + to be gathered + :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:subroutine:: scatter_atoms(name, data) + + This function calls :c:func:`lammps_scatter_atoms` to scatter the named + atom-based entities in *data* to all processors. + + .. versionadded:: TBD + + 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 :f:func:`scatter_atoms_subset` to scatter data for some (or all) + atoms, in any order. + + 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(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 of length (*count* :math:`\times` *natoms*). + + :p character(len=\*) name: quantity to be scattered (e.g., *x* or *charge*) + :p polymorphic data [dimension(:)]: per-atom values packed in a one-dimensional array + containing the data to be scattered. This array must have length *natoms* + (e.g., for *type* or *charge*) or length *natoms*\ :math:`\times 3` + (e.g., for *x* or *f*). The array *data* must be rank 1 (i.e., + ``DIMENSION(:)``) and be of type ``INTEGER(c_int)`` (e.g., for *mask* or + *type*) or of type ``REAL(c_double)`` (e.g., for *x* or *charge* or *f*). + +-------- + +.. f:subroutine:: scatter_atoms_subset(name, ids, data) + + This function calls :c:func:`lammps_scatter_atoms_subset` to scatter the + named atom-based entities in *data* to all processors. + + .. versionadded:: TBD + + 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, + *ids*. Use :f:func:`scatter_atoms` to scatter data for all atoms, in order. + + The *data* array needs to be organized in groups of 1 or 3 values, + depending on which quantity is being scattered, with the groups in the same + order as the array *ids*. For example, if you want *data* to be the array + [x(1,1) x(2,1) x(3,1) x(1,100) x(2,100) x(3,100) x(1,57) x(2,57) x(3,57)], + then *ids* would be [1 100 57] and *name* would be *x*. + + :p character(len=\*) name: quantity to be scattered (e.g., *x* or *charge*) + :p integer(c_int) ids [dimension(:)]: atom IDs corresponding to the atoms + being scattered + :p polymorphic data [dimension(:)]: per-atom values packed into a + one-dimensional array containing the data to be scattered. This array must + have either the same length as *ids* (for *mask*, *type*, etc.) or three + times its length (for *x*, *f*, etc.); the array must be rank 1 + and be of type ``INTEGER(c_int)`` (e.g., for *mask* or *type*) or of type + ``REAL(c_double)`` (e.g., *charge*, *x*, or *f*). + +-------- + +.. f:function:: version() + + This method returns the numeric LAMMPS version like + :cpp:func:`lammps_version` does. + + :r integer: LAMMPS version + +-------- + +.. f:subroutine:: get_os_info(buffer) + + This function can be used to retrieve detailed information about the hosting + operating system and compiler/runtime environment. + + .. versionadded:: TBD + + A suitable buffer has to be provided. The assembled text will be truncated + so as not to overflow this buffer. The string is typically a few hundred + bytes long. + +-------- + +.. f:function:: config_has_mpi_support() + + This function is used to query whether LAMMPS was compiled with a real MPI + library or in serial. + + .. versionadded:: TBD + + :r logical: ``.FALSE.`` when compiled with STUBS, ``.TRUE.`` if complied + with MPI. + +-------- + +.. f:function:: config_has_gzip_support() + + Check if the LAMMPS library supports reading or writing compressed + files via a pipe to gzip or similar compression programs. + + .. versionadded:: TBD + + Several LAMMPS commands (e.g., :doc:`read_data`, :doc:`write_data`, + :doc:`dump styles atom, custom, and xyz `) support reading and writing + compressed files via creating a pipe to the ``gzip`` program. This function + checks whether this feature was :ref:`enabled at compile time `. + It does **not** check whether ``gzip`` or any other supported compression + programs themselves are installed and usable. + + :r logical: + +-------- + +.. f:function:: config_has_png_support() + + Check if the LAMMPS library supports writing PNG format images. + + .. versionadded:: TBD + + The LAMMPS :doc:`dump style image ` supports writing multiple + image file formats. Most of them, however, need support from an external + library, and using that has to be :ref:`enabled at compile time `. + This function checks whether support for the `PNG image file format + `_ is available + in the current LAMMPS library. + + :r logical: + +-------- + +.. f:function:: config_has_jpeg_support() + + Check if the LAMMPS library supports writing JPEG format images. + + .. versionadded:: TBD + + The LAMMPS :doc:`dump style image ` supports writing multiple + image file formats. Most of them, however, need support from an external + library, and using that has to be :ref:`enabled at compile time `. + This function checks whether support for the `JPEG image file format + `_ is available in the current LAMMPS library. + + :r logical: + +-------- + +.. f:function:: config_has_ffmpeg_support() + + Check if the LAMMPS library supports creating movie files via a pipe to + ffmpeg. + + .. versionadded:: TBD + + The LAMMPS :doc:`dump style movie ` supports generating movies + from images on-the-fly via creating a pipe to the + `ffmpeg `_ program. + This function checks whether this feature was + :ref:`enabled at compile time `. + It does **not** check whether the ``ffmpeg`` itself is installed and usable. + + :r logical: + +-------- + +.. f:function:: config_has_exceptions() + + Check whether LAMMPS errors will throw C++ exceptions. + + .. versionadded:: TBD + + In case of an error, LAMMPS will either abort or throw a C++ exception. + The latter has to be :ref:`enabled at compile time `. + This function checks if exceptions were enabled. + + When using the library interface with C++ exceptions enabled, the library + interface functions will "catch" them, and the error status can then be + checked by calling :f:func:`has_error`. The most recent error message can be + retrieved via :f:func:`get_last_error_message`. + This can allow one to restart a calculation or delete and recreate + the LAMMPS instance when a C++ exception occurs. One application + of using exceptions this way is the :ref:`lammps_shell`. If C++ + exceptions are disabled and an error happens during a call to + LAMMPS or the Fortran API, the application will terminate. + + :r logical: + +-------- + +.. f:function:: config_has_package(name) + + Check whether a specific package has been included in LAMMPS + + .. versionadded:: TBD + + This function checks whether the LAMMPS library in use includes the specific + :doc:`LAMMPS package ` provided as argument. + + :r logical: + +-------- + +.. f:function:: config_package_count() + + Count the number of installed packages in the LAMMPS library. + + .. versionadded:: TBD + + This function counts how many :doc:`LAMMPS packages ` are + included in the LAMMPS library in use. It directly calls the C library + function :cpp:func:`lammps_config_package_count`. + + :r integer(c_int): number of packages installed + +-------- + +.. f:subroutine:: config_package_name(idx, buffer) + + Get the name of a package in the list of installed packages in the LAMMPS + library. + + .. versionadded:: TBD + + This subroutine copies the name of the package with the index *idx* into the + provided string *buffer*. If the name of the package exceeds the length of + the buffer, it will be truncated accordingly. If the index is out of range, + *buffer* is set to an empty string. + + :p integer(c_int) idx: index of the package in the list of included packages + :math:`(0 \le idx < \text{package count})` + :p character(len=\*) buffer: string to hold the name of the package + +-------- + +.. f:subroutine:: installed_packages(package[, length]) + + Obtain a list of the names of enabled packages in the LAMMPS shared library + and store it in *package*. + + This function is analogous to the :py:func`installed_packages` function in + the Python API. The optional argument *length* sets the length of each + string in the vector *package* (default: 31). + + :p character(len=:) package [dimension(:),allocatable]: list of packages; + *must* have the ``ALLOCATABLE`` attribute and be of rank-1 + (``DIMENSION(:)``) with allocatable length. + :o integer length [optional]: length of each string in the list. + Default: 31. + +-------- + +.. f:subroutine:: flush_buffers() + + This function calls :cpp:func:`lammps_flush_buffers`, which flushes buffered + output to be written to screen and logfile. This can simplify capturing + output from LAMMPS library calls. + + .. versionadded:: TBD + +-------- + +.. f:function:: is_running() + + Check if LAMMPS is currently inside a run or minimization. + + .. versionadded:: TBD + + This function can be used from signal handlers or multi-threaded + applications to determine if the LAMMPS instance is currently active. + + :r logical: ``.FALSE.`` if idle or ``.TRUE.`` if active + +-------- + +.. f:subroutine:: force_timeout() + + Force a timeout to stop an ongoing run cleanly. + + .. versionadded:: TBD + + This function can be used from signal handlers or multi-threaded + applications to cleanly terminate an ongoing run. + +-------- + +.. f:function:: has_error() + + Check if there is a (new) error message available. + + .. versionadded:: TBD + + This function can be used to query if an error inside of LAMMPS + has thrown a :ref:`C++ exception `. + + .. note:: + + This function will always report "no error" when the LAMMPS library + has been compiled without ``-DLAMMPS_EXCEPTIONS``, which turns fatal + errors aborting LAMMPS into C++ exceptions. You can use the library + function :cpp:func:`lammps_config_has_exceptions` to check if this is + the case. + + :r logical: ``.TRUE.`` if there is an error. + +-------- + +.. f:subroutine:: get_last_error_message(buffer[,status]) + + Copy the last error message into the provided buffer. + + .. versionadded:: TBD + + This function can be used to retrieve the error message that was set + in the event of an error inside of LAMMPS that resulted in a + :ref:`C++ exception `. A suitable buffer for a string has + to be provided. If the internally-stored error message is longer than the + string and the string does not have ``ALLOCATABLE`` length, it will be + truncated accordingly. The optional argument *status* indicates the + kind of error: a "1" indicates an error that occurred on all MPI ranks and + is often recoverable, while a "2" indicates an abort that would happen only + in a single MPI rank and thus may not be recoverable, as other MPI ranks may + be waiting on the failing MPI rank(s) to send messages. + + .. note:: + + This function will do nothing when the LAMMPS library has been + compiled without ``-DLAMMPS_EXCEPTIONS``, which turns errors aborting + LAMMPS into C++ exceptions. You can use the function + :f:func:`config_has_exceptions` to check whether this is the case. + + :p character(len=\*) buffer: string buffer to copy the error message into + :o integer(c_int) status [optional]: 1 when all ranks had the error, + 2 on a single-rank error. diff --git a/doc/src/Library_objects.rst b/doc/src/Library_objects.rst index eed14b3a05..8ebecfcc94 100644 --- a/doc/src/Library_objects.rst +++ b/doc/src/Library_objects.rst @@ -6,6 +6,7 @@ fixes, or variables in LAMMPS using the following functions: - :cpp:func:`lammps_extract_compute` - :cpp:func:`lammps_extract_fix` +- :cpp:func:`lammps_extract_variable_datatype` - :cpp:func:`lammps_extract_variable` - :cpp:func:`lammps_set_variable` @@ -21,6 +22,11 @@ fixes, or variables in LAMMPS using the following functions: ----------------------- +.. doxygenfunction:: lammps_extract_variable_datatype + :project: progguide + +----------------------- + .. doxygenfunction:: lammps_extract_variable :project: progguide @@ -36,3 +42,5 @@ fixes, or variables in LAMMPS using the following functions: .. doxygenenum:: _LMP_STYLE_CONST .. doxygenenum:: _LMP_TYPE_CONST + +.. doxygenenum:: _LMP_VAR_CONST diff --git a/doc/src/Library_properties.rst b/doc/src/Library_properties.rst index a5c9c79c64..dfd72adc95 100644 --- a/doc/src/Library_properties.rst +++ b/doc/src/Library_properties.rst @@ -16,8 +16,8 @@ This section documents the following functions: -------------------- The library interface allows the extraction of different kinds of -information about the active simulation instance and also - in some -cases - to apply modifications to it. This enables combining of a +information about the active simulation instance and also---in some +cases---to apply modifications to it. This enables combining of a LAMMPS simulation with other processing and simulation methods computed by the calling code, or by another code that is coupled to LAMMPS via the library interface. In some cases the data returned is direct @@ -25,9 +25,9 @@ reference to the original data inside LAMMPS, cast to a void pointer. In that case the data needs to be cast to a suitable pointer for the calling program to access it, and you may need to know the correct dimensions and lengths. This also means you can directly change those -value(s) from the calling program, e.g. to modify atom positions. Of -course, this should be done with care. When accessing per-atom data, -please note that this data is the per-processor **local** data and is +value(s) from the calling program (e.g., to modify atom positions). Of +course, changing values should be done with care. When accessing per-atom +data, please note that these data are the per-processor **local** data and are indexed accordingly. Per-atom data can change sizes and ordering at every neighbor list rebuild or atom sort event as atoms migrate between sub-domains and processors. diff --git a/doc/src/Run_basics.rst b/doc/src/Run_basics.rst index 5f1211d093..d2810f5986 100644 --- a/doc/src/Run_basics.rst +++ b/doc/src/Run_basics.rst @@ -30,12 +30,13 @@ executable itself can be placed elsewhere. .. note:: - The redirection operator "<" will not always work when running - in parallel with mpirun or mpiexec; for those systems the -in form is required. + The redirection operator "<" will not always work when running in + parallel with ``mpirun`` or ``mpiexec``; for those systems the -in + form is required. As LAMMPS runs it prints info to the screen and a logfile named -*log.lammps*\ . More info about output is given on the -:doc:`screen and logfile output ` page. +*log.lammps*\ . More info about output is given on the :doc:`screen and +logfile output ` page. If LAMMPS encounters errors in the input script or while running a simulation it will print an ERROR message and stop or a WARNING diff --git a/doc/src/Run_options.rst b/doc/src/Run_options.rst index f3c7973197..f7bb652ea9 100644 --- a/doc/src/Run_options.rst +++ b/doc/src/Run_options.rst @@ -93,13 +93,13 @@ switch is not set (the default), LAMMPS will operate as if the KOKKOS package were not installed; i.e. you can run standard LAMMPS or with the GPU or OPENMP packages, for testing or benchmarking purposes. -Additional optional keyword/value pairs can be specified which -determine how Kokkos will use the underlying hardware on your -platform. These settings apply to each MPI task you launch via the -"mpirun" or "mpiexec" command. You may choose to run one or more MPI -tasks per physical node. Note that if you are running on a desktop -machine, you typically have one physical node. On a cluster or -supercomputer there may be dozens or 1000s of physical nodes. +Additional optional keyword/value pairs can be specified which determine +how Kokkos will use the underlying hardware on your platform. These +settings apply to each MPI task you launch via the ``mpirun`` or +``mpiexec`` command. You may choose to run one or more MPI tasks per +physical node. Note that if you are running on a desktop machine, you +typically have one physical node. On a cluster or supercomputer there +may be dozens or 1000s of physical nodes. Either the full word or an abbreviation can be used for the keywords. Note that the keywords do not use a leading minus sign. I.e. the @@ -148,9 +148,9 @@ one of these 4 environment variables MV2_COMM_WORLD_LOCAL_RANK (Mvapich) OMPI_COMM_WORLD_LOCAL_RANK (OpenMPI) -which are initialized by the "srun", "mpirun" or "mpiexec" commands. -The environment variable setting for each MPI rank is used to assign a -unique GPU ID to the MPI task. +which are initialized by the ``srun``, ``mpirun``, or ``mpiexec`` +commands. The environment variable setting for each MPI rank is used to +assign a unique GPU ID to the MPI task. .. parsed-literal:: diff --git a/doc/src/Speed_gpu.rst b/doc/src/Speed_gpu.rst index 883bc9c7e3..e95787ebee 100644 --- a/doc/src/Speed_gpu.rst +++ b/doc/src/Speed_gpu.rst @@ -76,10 +76,11 @@ instructions. **Run with the GPU package from the command line:** -The mpirun or mpiexec command sets the total number of MPI tasks used -by LAMMPS (one or multiple per compute node) and the number of MPI -tasks used per node. E.g. the mpirun command in MPICH does this via -its -np and -ppn switches. Ditto for OpenMPI via -np and -npernode. +The ``mpirun`` or ``mpiexec`` command sets the total number of MPI tasks +used by LAMMPS (one or multiple per compute node) and the number of MPI +tasks used per node. E.g. the ``mpirun`` command in MPICH does this via +its ``-np`` and ``-ppn`` switches. Ditto for OpenMPI via ``-np`` and +``-npernode``. When using the GPU package, you cannot assign more than one GPU to a single MPI task. However multiple MPI tasks can share the same GPU, @@ -129,8 +130,8 @@ GPU package pair styles. **Or run with the GPU package by editing an input script:** -The discussion above for the mpirun/mpiexec command, MPI tasks/node, -and use of multiple MPI tasks/GPU is the same. +The discussion above for the ``mpirun`` or ``mpiexec`` command, MPI +tasks/node, and use of multiple MPI tasks/GPU is the same. Use the :doc:`suffix gpu ` command, or you can explicitly add an "gpu" suffix to individual styles in your input script, e.g. diff --git a/doc/src/Speed_kokkos.rst b/doc/src/Speed_kokkos.rst index 8b9b2e99af..73345b7e88 100644 --- a/doc/src/Speed_kokkos.rst +++ b/doc/src/Speed_kokkos.rst @@ -72,12 +72,12 @@ See the :ref:`Build extras ` page for instructions. Running LAMMPS with the KOKKOS package """""""""""""""""""""""""""""""""""""" -All Kokkos operations occur within the context of an individual MPI -task running on a single node of the machine. The total number of MPI -tasks used by LAMMPS (one or multiple per compute node) is set in the -usual manner via the mpirun or mpiexec commands, and is independent of -Kokkos. E.g. the mpirun command in OpenMPI does this via its -np and --npernode switches. Ditto for MPICH via -np and -ppn. +All Kokkos operations occur within the context of an individual MPI task +running on a single node of the machine. The total number of MPI tasks +used by LAMMPS (one or multiple per compute node) is set in the usual +manner via the ``mpirun`` or ``mpiexec`` commands, and is independent of +Kokkos. E.g. the mpirun command in OpenMPI does this via its ``-np`` and +``-npernode`` switches. Ditto for MPICH via ``-np`` and ``-ppn``. Running on a multi-core CPU ^^^^^^^^^^^^^^^^^^^^^^^^^^^ @@ -168,7 +168,7 @@ for your MPI installation), binding can be forced with these flags: .. parsed-literal:: - OpenMPI 1.8: mpirun -np 2 --bind-to socket --map-by socket ./lmp_openmpi ... + OpenMPI 1.8: mpirun -np 2 --bind-to socket --map-by socket ./lmp_openmpi ... Mvapich2 2.0: mpiexec -np 2 --bind-to socket --map-by socket ./lmp_mvapich ... For binding threads with KOKKOS OpenMP, use thread affinity environment @@ -310,7 +310,8 @@ Alternatively the effect of the "-sf" or "-pk" switches can be duplicated by adding the :doc:`package kokkos ` or :doc:`suffix kk ` commands to your input script. The discussion above for building LAMMPS with the KOKKOS package, the -mpirun/mpiexec command, and setting appropriate thread are the same. +``mpirun`` or ``mpiexec`` command, and setting appropriate thread +properties are the same. You must still use the "-k on" :doc:`command-line switch ` to enable the KOKKOS package, and specify its additional arguments for diff --git a/doc/src/Speed_omp.rst b/doc/src/Speed_omp.rst index 29c55df62f..7f8913d20f 100644 --- a/doc/src/Speed_omp.rst +++ b/doc/src/Speed_omp.rst @@ -33,8 +33,8 @@ These examples assume one or more 16-core nodes. mpirun -np 4 lmp_omp -sf omp -pk omp 4 -in in.script # 4 MPI tasks, 4 threads/task mpirun -np 32 -ppn 4 lmp_omp -sf omp -pk omp 4 -in in.script # 8 nodes, 4 MPI tasks/node, 4 threads/task -The mpirun or mpiexec command sets the total number of MPI tasks used -by LAMMPS (one or multiple per compute node) and the number of MPI +The ``mpirun`` or ``mpiexec`` command sets the total number of MPI tasks +used by LAMMPS (one or multiple per compute node) and the number of MPI tasks used per node. E.g. the mpirun command in MPICH does this via its -np and -ppn switches. Ditto for OpenMPI via -np and -npernode. @@ -58,8 +58,8 @@ OMP_NUM_THREADS environment variable. Or run with the OPENMP package by editing an input script """"""""""""""""""""""""""""""""""""""""""""""""""""""""""" -The discussion above for the mpirun/mpiexec command, MPI tasks/node, -and threads/MPI task is the same. +The discussion above for the ``mpirun`` or ``mpiexec`` command, MPI +tasks/node, and threads/MPI task is the same. Use the :doc:`suffix omp ` command, or you can explicitly add an "omp" suffix to individual styles in your input script, e.g. diff --git a/doc/utils/sphinx-config/false_positives.txt b/doc/utils/sphinx-config/false_positives.txt index 1ab3e0f5e2..1e6add76fc 100644 --- a/doc/utils/sphinx-config/false_positives.txt +++ b/doc/utils/sphinx-config/false_positives.txt @@ -78,6 +78,7 @@ Alexey ali aliceblue Allinger +allocatable allocator allocators allosws @@ -657,6 +658,7 @@ Dcut de dE De +deallocate deallocated debye Debye @@ -691,6 +693,7 @@ dequidt Dequidt der dereference +dereferenced derekt Deresiewicz Derjagin @@ -1486,6 +1489,7 @@ interfacial interial interlayer intermolecular +interoperable Interparticle interstitials intertube @@ -3621,6 +3625,7 @@ Universite unix unmaintained unoptimized +unordered unpadded unphysical unphysically diff --git a/fortran/README b/fortran/README index 57d163e197..6a19cd7dc2 100644 --- a/fortran/README +++ b/fortran/README @@ -1,9 +1,9 @@ -This directory contains Fortran code which interface LAMMPS as a library -and allows the LAMMPS library interface to be invoked from Fortran codes. -It requires a Fortran compiler that supports the Fortran 2003 standard. +This directory contains Fortran code that acts as an interface to LAMMPS as a +library and allows the LAMMPS library interface to be invoked from Fortran +code. It requires a Fortran compiler that supports the Fortran 2003 standard. This interface is based on and supersedes the previous Fortran interfaces -in the examples/COUPLE/fortran* folders, but is fully supported by the +in the examples/COUPLE/fortran* folders, but it is fully supported by the LAMMPS developers and included in the documentation and unit testing. Details on this Fortran interface and how to build programs using it diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 98378c833a..3355db5209 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_loc, & - c_int, c_int64_t, c_char, c_null_char, c_double, c_size_t, c_f_pointer - USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : ERROR_UNIT + 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 @@ -42,35 +42,107 @@ MODULE LIBLAMMPS ! Must be kept in sync with the equivalent declarations in ! src/library.h and python/lammps/constants.py ! - ! NOT part of the API (the part the user sees) - INTEGER (c_int), PARAMETER :: & - LAMMPS_INT = 0, & ! 32-bit integer (array) - LAMMPS_INT_2D = 1, & ! two-dimensional 32-bit integer array - LAMMPS_DOUBLE = 2, & ! 64-bit double (array) - LAMMPS_DOUBLE_2D = 3, & ! two-dimensional 64-bit double array - LAMMPS_INT64 = 4, & ! 64-bit integer (array) - LAMMPS_INT64_2D = 5, & ! two-dimensional 64-bit integer array - LAMMPS_STRING = 6 ! C-String + ! 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_2D = 1, & ! two-dimensional 32-bit integer array + LAMMPS_DOUBLE = 2, & ! 64-bit double (array) + LAMMPS_DOUBLE_2D = 3, & ! two-dimensional 64-bit double array + LAMMPS_INT64 = 4, & ! 64-bit integer (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 + LMP_STYLE_ATOM = 1, & ! request per-atom compute/fix/etc. data + LMP_STYLE_LOCAL = 2, & ! request local compute/fix/etc. data + LMP_TYPE_SCALAR = 0, & ! request scalar + LMP_TYPE_VECTOR = 1, & ! request vector + LMP_TYPE_ARRAY = 2, & ! request array + LMP_SIZE_VECTOR = 3, & ! request size of vector + LMP_SIZE_ROWS = 4, & ! request rows (actually columns) + LMP_SIZE_COLS = 5, & ! request colums (actually rows) + LMP_ERROR_WARNING = 0, & ! call Error::warning() + LMP_ERROR_ONE = 1, & ! call Error::one() (from this MPI rank) + LMP_ERROR_ALL = 2, & ! call Error::all() (from all MPI ranks) + LMP_ERROR_WORLD = 4, & ! error on comm->world + LMP_ERROR_UNIVERSE = 8, & ! error on comm->universe + LMP_VAR_EQUAL = 0, & ! equal-style variables (and compatible) + LMP_VAR_ATOM = 1, & ! atom-style variables + LMP_VAR_VECTOR = 2, & ! vector variables + LMP_VAR_STRING = 3 ! string variables (everything else) + + ! "Constants" to use with extract_compute and friends + TYPE lammps_style + INTEGER(c_int) :: global, atom, local + END TYPE lammps_style + + TYPE lammps_type + INTEGER(c_int) :: scalar, vector, array + END TYPE lammps_type TYPE lammps - TYPE(c_ptr) :: handle - CONTAINS - PROCEDURE :: close => lmp_close - PROCEDURE :: error => lmp_error - PROCEDURE :: file => lmp_file - PROCEDURE :: command => lmp_command - PROCEDURE :: commands_list => lmp_commands_list - PROCEDURE :: commands_string => lmp_commands_string - PROCEDURE :: get_natoms => lmp_get_natoms - PROCEDURE :: get_thermo => lmp_get_thermo - PROCEDURE :: extract_box => lmp_extract_box - PROCEDURE :: reset_box => lmp_reset_box - PROCEDURE :: memory_usage => lmp_memory_usage - PROCEDURE :: get_mpi_comm => lmp_get_mpi_comm - PROCEDURE :: extract_setting => lmp_extract_setting - PROCEDURE :: extract_global => lmp_extract_global - PROCEDURE :: version => lmp_version - PROCEDURE :: is_running => lmp_is_running + TYPE(c_ptr) :: handle = c_null_ptr + TYPE(lammps_style) :: style + TYPE(lammps_type) :: type + CONTAINS + PROCEDURE :: close => lmp_close + PROCEDURE :: error => lmp_error + PROCEDURE :: file => lmp_file + PROCEDURE :: command => lmp_command + PROCEDURE :: commands_list => lmp_commands_list + PROCEDURE :: commands_string => lmp_commands_string + PROCEDURE :: get_natoms => lmp_get_natoms + PROCEDURE :: get_thermo => lmp_get_thermo + PROCEDURE :: extract_box => lmp_extract_box + PROCEDURE :: reset_box => lmp_reset_box + PROCEDURE :: memory_usage => lmp_memory_usage + 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 :: extract_compute => lmp_extract_compute + PROCEDURE :: extract_fix => lmp_extract_fix + PROCEDURE :: extract_variable => lmp_extract_variable + PROCEDURE :: set_variable => lmp_set_variable + PROCEDURE, PRIVATE :: lmp_gather_atoms_int + PROCEDURE, PRIVATE :: 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, PRIVATE :: lmp_scatter_atoms_int + PROCEDURE, PRIVATE :: lmp_scatter_atoms_double + GENERIC :: scatter_atoms => lmp_scatter_atoms_int, & + lmp_scatter_atoms_double +! + PROCEDURE, PRIVATE :: lmp_scatter_atoms_subset_int + PROCEDURE, PRIVATE :: lmp_scatter_atoms_subset_double + GENERIC :: scatter_atoms_subset => lmp_scatter_atoms_subset_int, & + lmp_scatter_atoms_subset_double + PROCEDURE :: version => lmp_version + PROCEDURE,NOPASS :: get_os_info => lmp_get_os_info + PROCEDURE,NOPASS :: config_has_mpi_support => lmp_config_has_mpi_support + PROCEDURE,NOPASS :: config_has_gzip_support => lmp_config_has_gzip_support + PROCEDURE,NOPASS :: config_has_png_support => lmp_config_has_png_support + PROCEDURE,NOPASS :: config_has_jpeg_support => lmp_config_has_jpeg_support + PROCEDURE,NOPASS :: config_has_ffmpeg_support & + => lmp_config_has_ffmpeg_support + PROCEDURE,NOPASS :: config_has_exceptions => lmp_config_has_exceptions + PROCEDURE,NOPASS :: config_has_package => lmp_config_has_package + PROCEDURE,NOPASS :: config_package_count => lammps_config_package_count + PROCEDURE,NOPASS :: config_package_name => lmp_config_package_name + PROCEDURE,NOPASS :: installed_packages => lmp_installed_packages +! + PROCEDURE :: flush_buffers => lmp_flush_buffers + PROCEDURE :: is_running => lmp_is_running + PROCEDURE :: force_timeout => lmp_force_timeout + PROCEDURE :: has_error => lmp_has_error + PROCEDURE :: get_last_error_message => lmp_get_last_error_message END TYPE lammps INTERFACE lammps @@ -85,30 +157,66 @@ MODULE LIBLAMMPS ENUMERATOR :: DATA_STRING END ENUM + ! Base class for receiving LAMMPS data (to reduce code duplication) + TYPE lammps_data_baseclass + INTEGER(c_int) :: datatype = -1_c_int + ! in case we need to call the Error class in an assignment + CLASS(lammps), POINTER, PRIVATE :: lammps_instance => NULL() + END TYPE lammps_data_baseclass + ! Derived type for receiving LAMMPS data (in lieu of the ability to type cast - ! pointers) - TYPE lammps_data - INTEGER(c_int) :: datatype - INTEGER(c_int), POINTER :: i32 - INTEGER(c_int), DIMENSION(:), POINTER :: i32_vec - INTEGER(c_int64_t), POINTER :: i64 - INTEGER(c_int64_t), DIMENSION(:), POINTER :: i64_vec - REAL(c_double), POINTER :: r64 - REAL(c_double), DIMENSION(:), POINTER :: r64_vec + ! pointers). Used for extract_compute, extract_atom + TYPE, EXTENDS(lammps_data_baseclass) :: lammps_data + INTEGER(c_int), POINTER :: i32 => NULL() + INTEGER(c_int), DIMENSION(:), POINTER :: i32_vec => NULL() + INTEGER(c_int64_t), POINTER :: i64 => NULL() + INTEGER(c_int64_t), DIMENSION(:), POINTER :: i64_vec => NULL() + REAL(c_double), POINTER :: r64 => NULL() + REAL(c_double), DIMENSION(:), POINTER :: r64_vec => NULL() + REAL(c_double), DIMENSION(:,:), POINTER :: r64_mat => NULL() CHARACTER(LEN=:), ALLOCATABLE :: str END TYPE lammps_data + ! Derived type for holding LAMMPS fix data + ! Done this way because fix global data are not pointers, but computed + ! on-the-fly, whereas per-atom and local data are pointers to the actual + ! array. Doing it this way saves the user from having to explicitly + ! deallocate all of the pointers. + TYPE, EXTENDS(lammps_data_baseclass) :: lammps_fix_data + REAL(c_double) :: r64 + REAL(c_double), DIMENSION(:), POINTER :: r64_vec => NULL() + REAL(c_double), DIMENSION(:,:), POINTER :: r64_mat => NULL() + END TYPE lammps_fix_data + + ! Derived type for holding LAMMPS variable data + ! Done this way because extract_variable calculates variable values, it does + ! not return pointers to LAMMPS data. + TYPE, EXTENDS(lammps_data_baseclass) :: lammps_variable_data + REAL(c_double) :: r64 + REAL(c_double), DIMENSION(:), ALLOCATABLE :: r64_vec + CHARACTER(LEN=:), ALLOCATABLE :: str + END TYPE lammps_variable_data + ! This overloads the assignment operator (=) so that assignments of the ! form ! nlocal = extract_global('nlocal') ! which are of the form "pointer to double = type(lammps_data)" result in ! re-associating the pointer on the left with the appropriate piece of - ! LAMMPS data (after checking type-compatibility) + ! LAMMPS data (after checking type-kind-rank 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 + ! We handle fix data (slightly) differently + MODULE PROCEDURE assign_double_to_lammps_fix_data, & + assign_doublevec_to_lammps_fix_data, & + assign_doublemat_to_lammps_fix_data + ! Variables, too + MODULE PROCEDURE assign_double_to_lammps_variable_data, & + assign_doublevec_to_lammps_variable_data, & + assign_string_to_lammps_variable_data END INTERFACE ! interface definitions for calling functions in library.cpp @@ -163,29 +271,29 @@ MODULE LIBLAMMPS SUBROUTINE lammps_command(handle, cmd) BIND(C) IMPORT :: c_ptr IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: cmd + TYPE(c_ptr), INTENT(IN), VALUE :: handle + TYPE(c_ptr), INTENT(IN), VALUE :: cmd END SUBROUTINE lammps_command SUBROUTINE lammps_commands_list(handle, ncmd, cmds) BIND(C) IMPORT :: c_ptr, c_int IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - INTEGER(c_int), VALUE, INTENT(IN) :: ncmd + TYPE(c_ptr), INTENT(IN), VALUE :: handle + INTEGER(c_int), INTENT(IN), VALUE :: ncmd TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: cmds END SUBROUTINE lammps_commands_list SUBROUTINE lammps_commands_string(handle, str) BIND(C) IMPORT :: c_ptr IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: str + TYPE(c_ptr), INTENT(IN), VALUE :: handle + TYPE(c_ptr), INTENT(IN), VALUE :: str END SUBROUTINE lammps_commands_string FUNCTION lammps_get_natoms(handle) BIND(C) IMPORT :: c_ptr, c_double IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), INTENT(IN), VALUE :: handle REAL(c_double) :: lammps_get_natoms END FUNCTION lammps_get_natoms @@ -193,89 +301,156 @@ MODULE LIBLAMMPS IMPORT :: c_ptr, c_double IMPLICIT NONE REAL(c_double) :: lammps_get_thermo - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: name + TYPE(c_ptr), INTENT(IN), VALUE :: handle + TYPE(c_ptr), INTENT(IN), VALUE :: name END FUNCTION lammps_get_thermo SUBROUTINE lammps_extract_box(handle,boxlo,boxhi,xy,yz,xz,pflags, & boxflag) BIND(C) IMPORT :: c_ptr, c_double, c_int IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle, boxlo, boxhi, xy, yz, xz, pflags, & - boxflag + TYPE(c_ptr), INTENT(IN), VALUE :: handle, boxlo, boxhi, xy, yz, xz, & + pflags, boxflag END SUBROUTINE lammps_extract_box SUBROUTINE lammps_reset_box(handle,boxlo,boxhi,xy,yz,xz) BIND(C) IMPORT :: c_ptr, c_double IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - REAL(c_double), DIMENSION(3) :: boxlo, boxhi - REAL(c_double), VALUE :: xy, yz, xz + TYPE(c_ptr), INTENT(IN), VALUE :: handle + REAL(c_double), DIMENSION(3), INTENT(IN) :: boxlo, boxhi + REAL(c_double), INTENT(IN), VALUE :: xy, yz, xz END SUBROUTINE lammps_reset_box SUBROUTINE lammps_memory_usage(handle,meminfo) BIND(C) IMPORT :: c_ptr, c_double IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - REAL(c_double), DIMENSION(*) :: meminfo + TYPE(c_ptr), INTENT(IN), VALUE :: handle + REAL(c_double), DIMENSION(*), INTENT(OUT) :: meminfo END SUBROUTINE lammps_memory_usage FUNCTION lammps_get_mpi_comm(handle) BIND(C) IMPORT :: c_ptr, c_int IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), INTENT(IN), VALUE :: handle INTEGER(c_int) :: lammps_get_mpi_comm END FUNCTION lammps_get_mpi_comm FUNCTION lammps_extract_setting(handle,keyword) BIND(C) IMPORT :: c_ptr, c_int IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle, keyword + TYPE(c_ptr), INTENT(IN), VALUE :: handle, keyword INTEGER(c_int) :: lammps_extract_setting END FUNCTION lammps_extract_setting FUNCTION lammps_extract_global_datatype(handle,name) BIND(C) IMPORT :: c_ptr, c_int IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle, name + TYPE(c_ptr), INTENT(IN), VALUE :: handle, name INTEGER(c_int) :: lammps_extract_global_datatype END FUNCTION lammps_extract_global_datatype - FUNCTION c_strlen (str) BIND(C,name='strlen') + FUNCTION c_strlen(str) BIND(C,name='strlen') IMPORT :: c_ptr, c_size_t IMPLICIT NONE - TYPE(c_ptr), VALUE :: str + TYPE(c_ptr), INTENT(IN), VALUE :: str INTEGER(c_size_t) :: c_strlen END FUNCTION c_strlen FUNCTION lammps_extract_global(handle, name) BIND(C) IMPORT :: c_ptr IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle, name + TYPE(c_ptr), INTENT(IN), VALUE :: handle, name 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), INTENT(IN), 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), INTENT(IN), VALUE :: handle, name + TYPE(c_ptr) :: lammps_extract_atom + END FUNCTION lammps_extract_atom - !(generic) lammps_extract_compute + FUNCTION lammps_extract_compute(handle, id, style, type) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), INTENT(IN), VALUE :: handle, id + INTEGER(c_int), INTENT(IN), VALUE :: style, type + TYPE(c_ptr) :: lammps_extract_compute + END FUNCTION lammps_extract_compute - !(generic) lammps_extract_fix + FUNCTION lammps_extract_fix(handle, id, style, type, nrow, ncol) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), INTENT(IN), VALUE :: handle, id + INTEGER(c_int), INTENT(IN), VALUE :: style, type, nrow, ncol + TYPE(c_ptr) :: lammps_extract_fix + END FUNCTION lammps_extract_fix - !(generic) lammps_extract_variable + FUNCTION lammps_extract_variable_datatype(handle,name) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), INTENT(IN), VALUE :: handle, name + INTEGER(c_int) :: lammps_extract_variable_datatype + END FUNCTION lammps_extract_variable_datatype - !INTEGER (c_int) lammps_set_variable + FUNCTION lammps_extract_variable(handle, name, group) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), INTENT(IN), VALUE :: handle, name, group + TYPE(c_ptr) :: lammps_extract_variable + END FUNCTION lammps_extract_variable - !SUBROUTINE lammps_gather_atoms + FUNCTION lammps_set_variable(handle, name, str) BIND(C) + IMPORT :: c_int, c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, name, str + INTEGER(c_int) :: lammps_set_variable + END FUNCTION lammps_set_variable - !SUBROUTINE lammps_gather_atoms_concat + 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_subset + 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_scatter_atoms + 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_subset + SUBROUTINE lammps_scatter_atoms(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_scatter_atoms + + SUBROUTINE lammps_scatter_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 :: count, ndata, type + END SUBROUTINE lammps_scatter_atoms_subset !SUBROUTINE lammps_gather_bonds @@ -288,15 +463,15 @@ MODULE LIBLAMMPS !SUBROUTINE lammps_scatter_subset !(generic / id, type, and image are special) / requires LAMMPS_BIGBIG - !INTEGER (C_int) FUNCTION lammps_create_atoms + !INTEGER(c_int) FUNCTION lammps_create_atoms - !INTEGER (C_int) FUNCTION lammps_find_pair_neighlist + !INTEGER(c_int) FUNCTION lammps_find_pair_neighlist - !INTEGER (C_int) FUNCTION lammps_find_fix_neighlist + !INTEGER(c_int) FUNCTION lammps_find_fix_neighlist - !INTEGER (C_int) FUNCTION lammps_find_compute_neighlist + !INTEGER(c_int) FUNCTION lammps_find_compute_neighlist - !INTEGER (C_int) FUNCTION lammps_neighlist_num_elements + !INTEGER(c_int) FUNCTION lammps_neighlist_num_elements !SUBROUTINE lammps_neighlist_element_neighbors @@ -307,35 +482,87 @@ MODULE LIBLAMMPS INTEGER(c_int) :: lammps_version END FUNCTION lammps_version - !SUBROUTINE lammps_get_os_info + SUBROUTINE lammps_get_os_info(buffer, buf_size) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: buffer + INTEGER(c_int), VALUE :: buf_size + END SUBROUTINE lammps_get_os_info - !LOGICAL FUNCTION lammps_config_has_mpi_support - !LOGICAL FUNCTION lammps_config_has_gzip_support - !LOGICAL FUNCTION lammps_config_has_png_support - !LOGICAL FUNCTION lammps_config_has_jpeg_support - !LOGICAL FUNCTION lammps_config_has_ffmpeg_support - !LOGICAL FUNCTION lammps_config_has_exceptions - !LOGICAL FUNCTION lammps_config_has_package - !INTEGER (C_int) FUNCTION lammps_config_package_count - !SUBROUTINE lammps_config_package_name + FUNCTION lammps_config_has_mpi_support() BIND(C) + IMPORT :: c_int + IMPLICIT NONE + INTEGER(c_int) :: lammps_config_has_mpi_support + END FUNCTION lammps_config_has_mpi_support + + FUNCTION lammps_config_has_gzip_support() BIND(C) + IMPORT :: c_int + IMPLICIT NONE + INTEGER(c_int) :: lammps_config_has_gzip_support + END FUNCTION lammps_config_has_gzip_support + + FUNCTION lammps_config_has_png_support() BIND(C) + IMPORT :: c_int + IMPLICIT NONE + INTEGER(c_int) :: lammps_config_has_png_support + END FUNCTION lammps_config_has_png_support + + FUNCTION lammps_config_has_jpeg_support() BIND(C) + IMPORT :: c_int + IMPLICIT NONE + INTEGER(c_int) :: lammps_config_has_jpeg_support + END FUNCTION lammps_config_has_jpeg_support + + FUNCTION lammps_config_has_ffmpeg_support() BIND(C) + IMPORT :: c_int + IMPLICIT NONE + INTEGER(c_int) :: lammps_config_has_ffmpeg_support + END FUNCTION lammps_config_has_ffmpeg_support + + FUNCTION lammps_config_has_exceptions() BIND(C) + IMPORT :: c_int + IMPLICIT NONE + INTEGER(c_int) :: lammps_config_has_exceptions + END FUNCTION lammps_config_has_exceptions + + FUNCTION lammps_config_has_package(name) BIND(C) + IMPORT :: c_int, c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: name + INTEGER(c_int) :: lammps_config_has_package + END FUNCTION lammps_config_has_package + + FUNCTION lammps_config_package_count() BIND(C) + IMPORT :: c_int + IMPLICIT NONE + INTEGER(c_int) :: lammps_config_package_count + END FUNCTION lammps_config_package_count + + FUNCTION lammps_config_package_name(idx, buffer, buf_size) BIND(C) + IMPORT :: c_int, c_ptr + IMPLICIT NONE + INTEGER(c_int) :: lammps_config_package_name + INTEGER(c_int), VALUE :: idx, buf_size + TYPE(c_ptr), VALUE :: buffer + END FUNCTION lammps_config_package_name !LOGICAL FUNCTION lammps_config_accelerator !LOGICAL FUNCTION lammps_has_gpu_device !SUBROUTINE lammps_get_gpu_device !LOGICAL FUNCTION lammps_has_id - !INTEGER (C_int) FUNCTION lammps_id_count + !INTEGER(c_int) FUNCTION lammps_id_count !SUBROUTINE lammps_id_name - !INTEGER (C_int) FUNCTION lammps_plugin_count + !INTEGER(c_int) FUNCTION lammps_plugin_count !SUBROUTINE lammps_plugin_name !Both of these use LAMMPS_BIGBIG - !INTEGER (LAMMPS_imageint) FUNCTION lammps_encode_image_flags + !INTEGER(LAMMPS_imageint) FUNCTION lammps_encode_image_flags !SUBROUTINE lammps_decode_image_flags !SUBROUTINE lammps_set_fix_external_callback ! may have trouble.... - !FUNCTION lammps_fix_external_get_force() ! returns real(c_double) (:) + !FUNCTION lammps_fix_external_get_force() ! returns real(c_double)(:) !SUBROUTINE lammps_fix_external_set_energy_global !SUBROUTINE lammps_fix_external_set_energy_peratom @@ -344,7 +571,11 @@ MODULE LIBLAMMPS !SUBROUTINE lammps_fix_external_set_vector_length !SUBROUTINE lammps_fix_external_set_vector - !SUBROUTINE lammps_flush_buffers + SUBROUTINE lammps_flush_buffers(handle) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + END SUBROUTINE lammps_flush_buffers FUNCTION lammps_malloc(size) BIND(C, name='malloc') IMPORT :: c_ptr, c_size_t @@ -365,11 +596,25 @@ MODULE LIBLAMMPS TYPE(c_ptr), VALUE :: handle END FUNCTION lammps_is_running - !SUBROUTINE lammps_force_timeout + SUBROUTINE lammps_force_timeout(handle) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + END SUBROUTINE lammps_force_timeout - !LOGICAL FUNCTION lammps_has_error + INTEGER(c_int) FUNCTION lammps_has_error(handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + END FUNCTION lammps_has_error - !INTEGER (c_int) FUNCTION lammps_get_last_error_message + INTEGER(c_int) FUNCTION lammps_get_last_error_message & + (handle, buffer, buf_size) BIND(C) + IMPORT :: c_ptr, c_int, c_char + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, buffer + INTEGER(c_int), VALUE :: buf_size + END FUNCTION lammps_get_last_error_message END INTERFACE @@ -409,11 +654,19 @@ CONTAINS CALL lammps_free(argv(i)) END DO DEALLOCATE(argv) + + ! Assign style and type members so lmp_open%style%global and such work + lmp_open%style%global = LMP_STYLE_GLOBAL + lmp_open%style%atom = LMP_STYLE_ATOM + lmp_open%style%local = LMP_STYLE_LOCAL + lmp_open%type%scalar = LMP_TYPE_SCALAR + lmp_open%type%vector = LMP_TYPE_VECTOR + lmp_open%type%array = LMP_TYPE_ARRAY END FUNCTION lmp_open ! Combined Fortran wrapper around lammps_close() and lammps_mpi_finalize() SUBROUTINE lmp_close(self, finalize) - CLASS(lammps) :: self + CLASS(lammps), INTENT(IN) :: self LOGICAL, INTENT(IN), OPTIONAL :: finalize CALL lammps_close(self%handle) @@ -440,7 +693,7 @@ CONTAINS ! equivalent function to lammps_file() SUBROUTINE lmp_file(self, filename) - CLASS(lammps) :: self + CLASS(lammps), INTENT(IN) :: self CHARACTER(len=*) :: filename TYPE(c_ptr) :: str @@ -451,7 +704,7 @@ CONTAINS ! equivalent function to lammps_command() SUBROUTINE lmp_command(self, cmd) - CLASS(lammps) :: self + CLASS(lammps), INTENT(IN) :: self CHARACTER(len=*) :: cmd TYPE(c_ptr) :: str @@ -462,7 +715,7 @@ CONTAINS ! equivalent function to lammps_commands_list() SUBROUTINE lmp_commands_list(self, cmds) - CLASS(lammps) :: self + CLASS(lammps), INTENT(IN) :: self CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cmds(:) TYPE(c_ptr), ALLOCATABLE :: cmdv(:) INTEGER :: i, ncmd @@ -485,7 +738,7 @@ CONTAINS ! equivalent function to lammps_commands_string() SUBROUTINE lmp_commands_string(self, str) - CLASS(lammps) :: self + CLASS(lammps), INTENT(IN) :: self CHARACTER(len=*) :: str TYPE(c_ptr) :: tmp @@ -495,17 +748,17 @@ CONTAINS END SUBROUTINE lmp_commands_string ! equivalent function to lammps_get_natoms - DOUBLE PRECISION FUNCTION lmp_get_natoms(self) + REAL(c_double) FUNCTION lmp_get_natoms(self) CLASS(lammps) :: self lmp_get_natoms = lammps_get_natoms(self%handle) END FUNCTION lmp_get_natoms ! equivalent function to lammps_get_thermo - REAL (C_double) FUNCTION lmp_get_thermo(self,name) + REAL(c_double) FUNCTION lmp_get_thermo(self,name) CLASS(lammps), INTENT(IN) :: self CHARACTER(LEN=*) :: name - TYPE(C_ptr) :: Cname + TYPE(c_ptr) :: Cname Cname = f2c_string(name) lmp_get_thermo = lammps_get_thermo(self%handle, Cname) @@ -518,27 +771,27 @@ CONTAINS REAL(c_double), INTENT(OUT), TARGET, OPTIONAL :: boxlo(3), boxhi(3) REAL(c_double), INTENT(OUT), TARGET, OPTIONAL :: xy, yz, xz LOGICAL, INTENT(OUT), OPTIONAL :: pflags(3), boxflag - INTEGER(c_int), TARGET :: C_pflags(3), C_boxflag - TYPE (c_ptr) :: ptr(7) + INTEGER(c_int), TARGET :: c_pflags(3), c_boxflag + TYPE(c_ptr) :: ptr(7) ptr = c_null_ptr - IF ( PRESENT(boxlo) ) ptr(1) = C_LOC(boxlo(1)) - IF ( PRESENT(boxhi) ) ptr(2) = C_LOC(boxhi(1)) - IF ( PRESENT(xy) ) ptr(3) = C_LOC(xy) - IF ( PRESENT(yz) ) ptr(4) = C_LOC(yz) - IF ( PRESENT(xz) ) ptr(5) = C_LOC(xz) - IF ( PRESENT(pflags) ) ptr(6) = C_LOC(C_pflags(1)) - IF ( PRESENT(boxflag) ) ptr(7) = C_LOC(C_boxflag) + IF (PRESENT(boxlo)) ptr(1) = C_LOC(boxlo(1)) + IF (PRESENT(boxhi)) ptr(2) = C_LOC(boxhi(1)) + IF (PRESENT(xy)) ptr(3) = C_LOC(xy) + IF (PRESENT(yz)) ptr(4) = C_LOC(yz) + IF (PRESENT(xz)) ptr(5) = C_LOC(xz) + IF (PRESENT(pflags)) ptr(6) = C_LOC(c_pflags(1)) + IF (PRESENT(boxflag)) ptr(7) = C_LOC(c_boxflag) CALL lammps_extract_box(self%handle, ptr(1), ptr(2), ptr(3), ptr(4), & ptr(5), ptr(6), ptr(7)) - IF ( PRESENT(pflags) ) pflags = ( C_pflags /= 0_C_int ) - IF ( PRESENT(boxflag) ) boxflag = ( C_boxflag /= 0_C_int ) + IF (PRESENT(pflags)) pflags = (c_pflags /= 0_c_int) + IF (PRESENT(boxflag)) boxflag = (c_boxflag /= 0_c_int) END SUBROUTINE lmp_extract_box ! equivalent function to lammps_reset_box SUBROUTINE lmp_reset_box(self, boxlo, boxhi, xy, yz, xz) CLASS(lammps), INTENT(IN) :: self - REAL(C_double), INTENT(IN) :: boxlo(3), boxhi(3), xy, yz, xz + REAL(c_double), INTENT(IN) :: boxlo(3), boxhi(3), xy, yz, xz CALL lammps_reset_box(self%handle, boxlo, boxhi, xy, yz, xz) END SUBROUTINE lmp_reset_box @@ -547,7 +800,7 @@ CONTAINS SUBROUTINE lmp_memory_usage(self,meminfo) CLASS(lammps), INTENT(IN) :: self INTEGER, PARAMETER :: MEMINFO_ELEM = 3 - REAL (c_double), DIMENSION(MEMINFO_ELEM), INTENT(OUT) :: meminfo + REAL(c_double), DIMENSION(MEMINFO_ELEM), INTENT(OUT) :: meminfo CALL lammps_memory_usage(self%handle,meminfo) END SUBROUTINE lmp_memory_usage @@ -560,7 +813,7 @@ CONTAINS END FUNCTION lmp_get_mpi_comm ! equivalent function to lammps_extract_setting - INTEGER (c_int) FUNCTION lmp_extract_setting(self, keyword) + INTEGER(c_int) FUNCTION lmp_extract_setting(self, keyword) CLASS(lammps), INTENT(IN) :: self CHARACTER(LEN=*), INTENT(IN) :: keyword TYPE(c_ptr) :: Ckeyword @@ -573,8 +826,8 @@ CONTAINS ! equivalent function to lammps_extract_global ! the assignment is actually overloaded so as to bind the pointers to ! lammps data based on the information available from LAMMPS - FUNCTION lmp_extract_global(self, name) RESULT (global_data) - CLASS(lammps), INTENT(IN) :: self + FUNCTION lmp_extract_global(self, name) RESULT(global_data) + CLASS(lammps), INTENT(IN), TARGET :: self CHARACTER(LEN=*), INTENT(IN) :: name TYPE(lammps_data) :: global_data @@ -601,9 +854,10 @@ CONTAINS Cptr = lammps_extract_global(self%handle, Cname) CALL lammps_free(Cname) + global_data%lammps_instance => self SELECT CASE (datatype) CASE (LAMMPS_INT) - IF ( length == 1 ) THEN + IF (length == 1) THEN global_data%datatype = DATA_INT CALL C_F_POINTER(Cptr, global_data%i32) ELSE @@ -611,7 +865,7 @@ CONTAINS CALL C_F_POINTER(Cptr, global_data%i32_vec, [length]) END IF CASE (LAMMPS_INT64) - IF ( length == 1 ) THEN + IF (length == 1) THEN global_data%datatype = DATA_INT64 CALL C_F_POINTER(Cptr, global_data%i64) ELSE @@ -619,7 +873,7 @@ CONTAINS CALL C_F_POINTER(Cptr, global_data%i64_vec, [length]) END IF CASE (LAMMPS_DOUBLE) - IF ( length == 1 ) THEN + IF (length == 1) THEN global_data%datatype = DATA_DOUBLE CALL C_F_POINTER(Cptr, global_data%r64) ELSE @@ -630,129 +884,1052 @@ CONTAINS global_data%datatype = DATA_STRING length = c_strlen(Cptr) CALL C_F_POINTER(Cptr, Fptr, [length]) - ALLOCATE ( CHARACTER(LEN=length) :: global_data%str ) - FORALL ( I=1:length ) + ALLOCATE(CHARACTER(LEN=length) :: global_data%str) + DO i = 1, length global_data%str(i:i) = Fptr(i) - END FORALL - CASE DEFAULT - ! FIXME convert to use symbolic constants later - CALL lmp_error(self, 6, 'Unknown pointer type in extract_global') + END DO + CASE DEFAULT + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'Unknown pointer type in extract_global') END SELECT END FUNCTION - ! equivalent function to lammps_version() + ! 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), TARGET :: 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 + CHARACTER(LEN=:), ALLOCATABLE :: error_msg + + 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 + + peratom_data%lammps_instance => self + 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) + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'per-atom property ' // name // 'not found in extract_setting') + CASE DEFAULT + WRITE(error_msg,'(A,I0,A)') 'return value ', datatype, & + ' from lammps_extract_atom_datatype not known [Fortran/extract_atom]' + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, error_msg) + END SELECT + END FUNCTION lmp_extract_atom + + ! equivalent function to lammps_extract_compute + ! the assignment operator is overloaded so as to bind the pointers to + ! lammps data based on the information available from LAMMPS + FUNCTION lmp_extract_compute(self, id, style, type) RESULT(compute_data) + CLASS(lammps), INTENT(IN), TARGET :: self + CHARACTER(LEN=*), INTENT(IN) :: id + INTEGER(c_int), INTENT(IN) :: style, type + TYPE(lammps_data) :: compute_data + + TYPE(c_ptr) :: Cid, Cptr, Ctemp + INTEGER :: nrows, ncols, length + INTEGER(c_int), POINTER :: temp + TYPE(c_ptr), DIMENSION(:), POINTER :: Ccomputeptr + + Cid = f2c_string(id) + Cptr = lammps_extract_compute(self%handle, Cid, style, type) + + IF (.NOT. C_ASSOCIATED(Cptr)) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'Pointer from LAMMPS is NULL [Fortran/extract_compute]') + END IF + + ! Remember that rows and columns in C are transposed in Fortran! + compute_data%lammps_instance => self + SELECT CASE (type) + CASE (LMP_TYPE_SCALAR) + compute_data%datatype = DATA_DOUBLE + length = 1 + nrows = 1 + ncols = 1 + CALL C_F_POINTER(Cptr, compute_data%r64) + CASE (LMP_TYPE_VECTOR) + compute_data%datatype = DATA_DOUBLE_1D + IF (style == LMP_STYLE_ATOM) THEN + length = self%extract_setting('nmax') + ELSE + Ctemp = lammps_extract_compute(self%handle,Cid,style,LMP_SIZE_VECTOR) + CALL C_F_POINTER(Ctemp, temp) + length = temp + END IF + CALL C_F_POINTER(Cptr, compute_data%r64_vec, [length]) + CASE (LMP_TYPE_ARRAY) + compute_data%datatype = DATA_DOUBLE_2D + IF (style == LMP_STYLE_ATOM) THEN + ncols = self%extract_setting('nmax') + Ctemp = lammps_extract_compute(self%handle,Cid,style,LMP_SIZE_COLS) + CALL C_F_POINTER(Ctemp, temp) + nrows = temp + ELSE + Ctemp = lammps_extract_compute(self%handle,Cid,style,LMP_SIZE_ROWS) + CALL C_F_POINTER(Ctemp, temp) + ncols = temp + Ctemp = lammps_extract_compute(self%handle,Cid,style,LMP_SIZE_COLS) + CALL C_F_POINTER(Ctemp, temp) + nrows = temp + END IF + ! First, we dereference the void** pointer to point to a void* pointer + CALL C_F_POINTER(Cptr, Ccomputeptr, [ncols]) + ! Ccomputeptr(1) now points to the first element of the array + CALL C_F_POINTER(Ccomputeptr(1), compute_data%r64_mat, [nrows, ncols]) + CASE DEFAULT + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'unknown type value passed to extract_compute [Fortran API]') + END SELECT + CALL lammps_free(Cid) + END FUNCTION lmp_extract_compute + + FUNCTION lmp_extract_fix(self, id, style, type, nrow, ncol) RESULT(fix_data) + CLASS(lammps), INTENT(IN), TARGET :: self + CHARACTER(LEN=*), INTENT(IN) :: id + INTEGER(c_int), INTENT(IN) :: style, type + INTEGER(c_int), INTENT(IN), OPTIONAL :: nrow, ncol + TYPE(lammps_fix_data) :: fix_data + + TYPE(c_ptr) :: Cid, Cptr, Ctemp + TYPE(c_ptr), DIMENSION(:), POINTER :: Cfixptr + INTEGER(c_int) :: Cnrow, Cncol + REAL(c_double), POINTER :: Fptr + INTEGER :: nrows, ncols + INTEGER(c_int), POINTER :: temp + + ! We transpose ncol and nrow so the array appears to be transposed for + ! global data, as it would be if we could access the C++ array directly + Cnrow = -1 + Cncol = -1 + IF (PRESENT(nrow)) THEN + IF (.NOT. PRESENT(ncol)) THEN + ! Presumably the argument that's there is the vector length + Cnrow = nrow - 1_c_int + Cncol = -1_c_int + ELSE + ! Otherwise, the array is transposed, so...reverse the indices + Cncol = nrow - 1_c_int + END IF + END IF + + IF (PRESENT(ncol)) Cnrow = ncol - 1_c_int + + Cid = f2c_string(id) + Cptr = lammps_extract_fix(self%handle, Cid, style, type, Cnrow, Cncol) + IF (.NOT. C_ASSOCIATED(Cptr)) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'Pointer from LAMMPS is NULL for fix id "' // id & + // '" [Fortran/extract_fix]') + END IF + + fix_data%lammps_instance => self + SELECT CASE (style) + CASE (LMP_STYLE_GLOBAL) + fix_data%datatype = DATA_DOUBLE + CALL C_F_POINTER(Cptr, Fptr) + fix_data%r64 = Fptr + CALL lammps_free(Cptr) + CASE (LMP_STYLE_ATOM, LMP_STYLE_LOCAL) + SELECT CASE (type) + CASE (LMP_TYPE_SCALAR) + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'There is no such thing as a per-atom or local scalar& + & [Fortran/extract_fix]') + CASE (LMP_TYPE_VECTOR) + fix_data%datatype = DATA_DOUBLE_1D + IF (STYLE == LMP_STYLE_ATOM) THEN + nrows = self%extract_setting('nmax') + ELSE + Ctemp = lammps_extract_fix(self%handle, Cid, style, & + LMP_SIZE_VECTOR, 0_c_int,0_c_int) + CALL C_F_POINTER(Ctemp, temp) + nrows = temp + END IF + CALL C_F_POINTER(Cptr, fix_data%r64_vec, [nrows]) + CASE (LMP_TYPE_ARRAY) + fix_data%datatype = DATA_DOUBLE_2D + IF (STYLE == LMP_STYLE_ATOM) THEN + ! Fortran array is transposed relative to C + ncols = self%extract_setting('nmax') + Ctemp = lammps_extract_fix(self%handle, Cid, style, & + LMP_SIZE_COLS, 0_c_int,0_c_int) + CALL C_F_POINTER(Ctemp, temp) + nrows = temp + ELSE + ! Fortran array is transposed relative to C + Ctemp = lammps_extract_fix(self%handle, Cid, style, & + LMP_SIZE_COLS, 0_c_int,0_c_int) + CALL C_F_POINTER(Ctemp, temp) + nrows = temp + Ctemp = lammps_extract_fix(self%handle, Cid, style, & + LMP_SIZE_ROWS, 0_c_int,0_c_int) + CALL C_F_POINTER(Ctemp, temp) + ncols = temp + END IF + ! First, we dereference the void** to point to a void* pointer + CALL C_F_POINTER(Cptr, Cfixptr, [ncols]) + ! Cfixptr(1) now points to the first element of the array + CALL C_F_POINTER(Cfixptr(1), fix_data%r64_mat, [nrows, ncols]) + CASE DEFAULT + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'unknown type value passed to extract_fix [Fortran API]') + END SELECT + CASE DEFAULT + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'unknown style value passed to extract_fix [Fortran API]') + END SELECT + CALL lammps_free(Cid) + END FUNCTION lmp_extract_fix + + ! equivalent function to lammps_extract_variable + FUNCTION lmp_extract_variable(self, name, group) RESULT(variable_data) + CLASS(lammps), INTENT(IN), TARGET :: self + CHARACTER(LEN=*), INTENT(IN) :: name + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: group + TYPE(lammps_variable_data) :: variable_data + + TYPE(c_ptr) :: Cptr, Cname, Cgroup, Cveclength + INTEGER(c_size_t) :: length, i + CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Cstring + INTEGER(c_int) :: datatype + REAL(c_double), POINTER :: double => NULL() + REAL(c_double), DIMENSION(:), POINTER :: double_vec => NULL() + INTEGER(c_int), POINTER :: Clength => NULL() + + Cname = f2c_string(name) + IF (PRESENT(group)) THEN + Cgroup = f2c_string(group) + ELSE + Cgroup = c_null_ptr + END IF + datatype = lammps_extract_variable_datatype(self%handle, Cname) + Cptr = lammps_extract_variable(self%handle, Cname, Cgroup) + CALL lammps_free(Cname) + CALL lammps_free(Cgroup) + + variable_data%lammps_instance => self + SELECT CASE (datatype) + CASE (LMP_VAR_EQUAL) + variable_data%datatype = DATA_DOUBLE + CALL C_F_POINTER(Cptr, double) + variable_data%r64 = double + CALL lammps_free(Cptr) + CASE (LMP_VAR_ATOM) + variable_data%datatype = DATA_DOUBLE_1D + length = lmp_extract_setting(self, 'nlocal') + CALL C_F_POINTER(Cptr, double_vec, [length]) + IF (ALLOCATED(variable_data%r64_vec)) DEALLOCATE(variable_data%r64_vec) + ALLOCATE(variable_data%r64_vec(length)) + variable_data%r64_vec = double_vec + CALL lammps_free(Cptr) + CASE (LMP_VAR_VECTOR) + variable_data%datatype = DATA_DOUBLE_1D + Cgroup = f2c_string('LMP_SIZE_VECTOR') ! must match library.cpp + Cname = f2c_string(name) + Cveclength = lammps_extract_variable(self%handle, Cname, Cgroup) + CALL C_F_POINTER(Cveclength, Clength) + length = Clength + CALL lammps_free(Cgroup) + CALL lammps_free(Cname) + CALL lammps_free(Cveclength) + CALL C_F_POINTER(Cptr, double_vec, [length]) + IF (ALLOCATED(variable_data%r64_vec)) & + DEALLOCATE(variable_data%r64_vec) + ALLOCATE(variable_data%r64_vec(length)) + variable_data%r64_vec = double_vec + ! DO NOT deallocate the C pointer + CASE (LMP_VAR_STRING) + variable_data%datatype = DATA_STRING + length = c_strlen(Cptr) + CALL C_F_POINTER(Cptr, Cstring, [length]) + ALLOCATE(CHARACTER(LEN=length) :: variable_data%str) + DO i = 1, length + variable_data%str(i:i) = Cstring(i) + END DO + ! DO NOT deallocate the C pointer + CASE (-1) + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'Variable "' // TRIM(name) // & + '" not found [Fortran/extract_variable]') + CASE DEFAULT + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'Unknown variable type returned from & + &lammps_extract_variable_datatype [Fortran/extract_variable]') + END SELECT + END FUNCTION lmp_extract_variable + + ! equivalent function to lammps_set_variable + SUBROUTINE lmp_set_variable(self, name, str) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name, str + INTEGER :: err + TYPE(c_ptr) :: Cstr, Cname + + Cstr = f2c_string(str) + Cname = f2c_string(name) + err = lammps_set_variable(self%handle, Cname, Cstr) + CALL lammps_free(Cname) + CALL lammps_free(Cstr) + IF (err /= 0) THEN + CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, & + 'WARNING: unable to set string variable "' // name & + // '" [Fortran/set_variable]') + 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=100) :: 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=100) :: 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=100) :: 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=100) :: 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 + + IF (count /= 1 .AND. count /= 3) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'gather_atoms_subset 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 + + IF (count /= 1 .AND. count /= 3) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'gather_atoms_subset 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_scatter_atoms (for integers) + SUBROUTINE lmp_scatter_atoms_int(self, name, data) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(c_int), DIMENSION(:), TARGET :: data + INTEGER(c_int) :: natoms, Ccount + INTEGER(c_int), PARAMETER :: Ctype = 0_c_int + TYPE(c_ptr) :: Cname, Cdata + REAL(c_double) :: dnatoms + CHARACTER(LEN=100) :: error_msg + + dnatoms = lmp_get_natoms(self) + IF (dnatoms > HUGE(1_c_int)) THEN + WRITE(error_msg,'(A,1X,I0,1X,A)') & + 'Cannot use library function scatter_atoms with more than', & + HUGE(0_c_int), 'atoms [Fortran/scatter_atoms]' + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, error_msg) + END IF + natoms = NINT(dnatoms, c_int) + + Cname = f2c_string(name) + Cdata = C_LOC(data(1)) + Ccount = SIZE(data) / natoms + + IF (Ccount /= 1 .AND. Ccount /= 3) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'lammps_scatter_atoms requires either 1 or 3 data per atom') + END IF + CALL lammps_scatter_atoms(self%handle, Cname, Ctype, Ccount, Cdata) + CALL lammps_free(Cname) + END SUBROUTINE lmp_scatter_atoms_int + + ! equivalent function to lammps_scatter_atoms (for doubles) + SUBROUTINE lmp_scatter_atoms_double(self, name, data) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + REAL(c_double), DIMENSION(:), TARGET :: data + INTEGER(c_int) :: natoms, Ccount + INTEGER(c_int), PARAMETER :: Ctype = 1_c_int + TYPE(c_ptr) :: Cname, Cdata + REAL(c_double) :: dnatoms + CHARACTER(LEN=100) :: error_msg + + dnatoms = lmp_get_natoms(self) + IF (dnatoms > HUGE(1_c_int)) THEN + WRITE(error_msg,'(A,1X,I0,1X,A)') & + 'Cannot use library function scatter_atoms with more than', & + HUGE(0_c_int), 'atoms [Fortran/scatter_atoms]' + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, error_msg) + END IF + natoms = NINT(dnatoms, c_int) + + Cname = f2c_string(name) + Cdata = C_LOC(data(1)) + Ccount = SIZE(data) / natoms + + IF (Ccount /= 1 .AND. Ccount /= 3) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'scatter_atoms requires either 1 or 3 data per atom & + &[Fortran/scatter_atoms]') + END IF + CALL lammps_scatter_atoms(self%handle, Cname, Ctype, Ccount, Cdata) + CALL lammps_free(Cname) + END SUBROUTINE lmp_scatter_atoms_double + + SUBROUTINE lmp_scatter_atoms_subset_int(self, name, ids, data) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(c_int), DIMENSION(:), TARGET :: ids + INTEGER(c_int), DIMENSION(:), TARGET :: data + INTEGER(c_int), PARAMETER :: Ctype = 0_c_int + INTEGER(c_int) :: Cndata, Ccount + TYPE(c_ptr) :: Cdata, Cname, Cids + + Cndata = SIZE(ids, KIND=c_int) + Ccount = SIZE(data, KIND=c_int) / Cndata + IF (Ccount /= 1 .AND. Ccount /= 3) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'scatter_atoms_subset requires either 1 or 3 data per atom') + END IF + + Cname = f2c_string(name) + Cdata = C_LOC(data(1)) + Cids = C_LOC(ids(1)) + CALL lammps_scatter_atoms_subset(self%handle, Cname, Ctype, Ccount, & + Cndata, Cids, Cdata) + CALL lammps_free(Cname) + END SUBROUTINE lmp_scatter_atoms_subset_int + + SUBROUTINE lmp_scatter_atoms_subset_double(self, name, ids, data) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(c_int), DIMENSION(:), TARGET :: ids + REAL(c_double), DIMENSION(:), TARGET :: data + INTEGER(c_int), PARAMETER :: Ctype = 1_c_int + INTEGER(c_int) :: Cndata, Ccount + TYPE(c_ptr) :: Cdata, Cname, Cids + + Cndata = SIZE(ids, KIND=c_int) + Ccount = SIZE(data, KIND=c_int) / Cndata + IF (Ccount /= 1 .AND. Ccount /= 3) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'scatter_atoms_subset requires either 1 or 3 data per atom') + END IF + + Cname = f2c_string(name) + Cdata = C_LOC(data(1)) + Cids = C_LOC(ids(1)) + CALL lammps_scatter_atoms_subset(self%handle, Cname, Ctype, Ccount, & + Cndata, Cids, Cdata) + CALL lammps_free(Cname) + END SUBROUTINE lmp_scatter_atoms_subset_double + + ! equivalent function to lammps_version INTEGER FUNCTION lmp_version(self) - CLASS(lammps) :: self + CLASS(lammps), INTENT(IN) :: self lmp_version = lammps_version(self%handle) END FUNCTION lmp_version + ! equivalent function to lammps_get_os_info + SUBROUTINE lmp_get_os_info(buffer) + CHARACTER(LEN=*) :: buffer + INTEGER(c_int) :: buf_size + CHARACTER(LEN=1,KIND=c_char), DIMENSION(LEN(buffer)), TARGET :: Cbuffer + TYPE(c_ptr) :: ptr + INTEGER :: i + + buffer = ' ' + ptr = C_LOC(Cbuffer(1)) + buf_size = LEN(buffer) + CALL lammps_get_os_info(ptr, buf_size) + DO i=1,buf_size + IF (Cbuffer(i) == c_null_char) EXIT + buffer(i:i) = Cbuffer(i) + END DO + END SUBROUTINE lmp_get_os_info + + ! equivalent function to lammps_config_has_mpi_support + LOGICAL FUNCTION lmp_config_has_mpi_support() + INTEGER(c_int) :: has_mpi_support + + has_mpi_support = lammps_config_has_mpi_support() + lmp_config_has_mpi_support = (has_mpi_support /= 0_c_int) + END FUNCTION lmp_config_has_mpi_support + + ! equivalent function to lammps_config_has_gzip_support + LOGICAL FUNCTION lmp_config_has_gzip_support() + INTEGER(c_int) :: has_gzip_support + + has_gzip_support = lammps_config_has_gzip_support() + lmp_config_has_gzip_support = (has_gzip_support /= 0_c_int) + END FUNCTION lmp_config_has_gzip_support + + ! equivalent function to lammps_config_has_png_support + LOGICAL FUNCTION lmp_config_has_png_support() + INTEGER(c_int) :: has_png_support + + has_png_support = lammps_config_has_png_support() + lmp_config_has_png_support = (has_png_support /= 0_c_int) + END FUNCTION lmp_config_has_png_support + + ! equivalent function to lammps_config_has_jpeg_support + LOGICAL FUNCTION lmp_config_has_jpeg_support() + INTEGER(c_int) :: has_jpeg_support + + has_jpeg_support = lammps_config_has_jpeg_support() + lmp_config_has_jpeg_support = (has_jpeg_support /= 0_c_int) + END FUNCTION lmp_config_has_jpeg_support + + ! equivalent function to lammps_config_has_ffmpeg_support + LOGICAL FUNCTION lmp_config_has_ffmpeg_support() + INTEGER(c_int) :: has_ffmpeg_support + + has_ffmpeg_support = lammps_config_has_ffmpeg_support() + lmp_config_has_ffmpeg_support = (has_ffmpeg_support /= 0_c_int) + END FUNCTION lmp_config_has_ffmpeg_support + + ! equivalent function to lammps_config_has_exceptions + LOGICAL FUNCTION lmp_config_has_exceptions() + INTEGER(c_int) :: has_exceptions + + has_exceptions = lammps_config_has_exceptions() + lmp_config_has_exceptions = (has_exceptions /= 0_c_int) + END FUNCTION lmp_config_has_exceptions + + ! equivalent function to lammps_config_has_package + LOGICAL FUNCTION lmp_config_has_package(name) + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(c_int) :: has_package + TYPE(c_ptr) :: Cname + + Cname = f2c_string(name) + has_package = lammps_config_has_package(Cname) + lmp_config_has_package = (has_package /= 0_c_int) + CALL lammps_free(Cname) + END FUNCTION lmp_config_has_package + + ! equivalent subroutine to lammps_config_package_name + SUBROUTINE lmp_config_package_name(idx, buffer) + INTEGER, INTENT(IN) :: idx + CHARACTER(LEN=*), INTENT(OUT) :: buffer + INTEGER(c_int) :: Cidx, Csuccess + TYPE(c_ptr) :: Cptr + CHARACTER(LEN=1,KIND=c_char), TARGET :: Cbuffer(LEN(buffer)+1) + INTEGER(c_size_t) :: i, strlen + + Cidx = idx - 1 + Cptr = C_LOC(Cbuffer(1)) + Csuccess = lammps_config_package_name(Cidx, Cptr, LEN(buffer)+1) + buffer = ' ' + IF (Csuccess /= 0_c_int) THEN + strlen = c_strlen(Cptr) + DO i = 1, strlen + buffer(i:i) = Cbuffer(i) + END DO + END IF + END SUBROUTINE lmp_config_package_name + + ! equivalent function to Python routine .installed_packages() + SUBROUTINE lmp_installed_packages(package, length) + CHARACTER(LEN=:), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: package + INTEGER, INTENT(IN), OPTIONAL :: length + INTEGER, PARAMETER :: MAX_BUFFER_LENGTH = 31 + INTEGER :: i, npackage, buf_length + + IF (PRESENT(length)) THEN + buf_length = length + ELSE + buf_length = MAX_BUFFER_LENGTH + END IF + + IF (ALLOCATED(package)) DEALLOCATE(package) + npackage = lammps_config_package_count() + ALLOCATE(CHARACTER(LEN=MAX_BUFFER_LENGTH) :: package(npackage)) + DO i=1, npackage + CALL lmp_config_package_name(i, package(i)) + END DO + END SUBROUTINE lmp_installed_packages + + ! equivalent function to lammps_flush_buffers + SUBROUTINE lmp_flush_buffers(self) + CLASS(lammps), INTENT(IN) :: self + + CALL lammps_flush_buffers(self%handle) + END SUBROUTINE lmp_flush_buffers + ! equivalent function to lammps_is_running LOGICAL FUNCTION lmp_is_running(self) - CLASS(lammps) :: self + CLASS(lammps), INTENT(IN) :: self - lmp_is_running = ( lammps_is_running(self%handle) /= 0_C_int ) + lmp_is_running = (lammps_is_running(self%handle) /= 0_c_int) END FUNCTION lmp_is_running + ! equivalent function to lammps_force_timeout + SUBROUTINE lmp_force_timeout(self) + CLASS(lammps), INTENT(IN) :: self + + CALL lammps_force_timeout(self%handle) + END SUBROUTINE + + ! equivalent function to lammps_has_error + LOGICAL FUNCTION lmp_has_error(self) + CLASS(lammps), INTENT(IN) :: self + INTEGER(c_int) :: has_error + + has_error = lammps_has_error(self%handle) + lmp_has_error = (has_error /= 0_c_int) + END FUNCTION lmp_has_error + + ! equivalent function to lammps_get_last_error_message + SUBROUTINE lmp_get_last_error_message(self, buffer, status) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(OUT) :: buffer + INTEGER, INTENT(OUT), OPTIONAL :: status + INTEGER(c_int) :: buflen, Cstatus + INTEGER(c_size_t) :: i, length + TYPE(c_ptr) :: Cptr + CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:) + + buffer = ' ' + IF (lmp_has_error(self)) THEN + buflen = LEN(buffer) + length = buflen + Cptr = lammps_malloc(length) + Cstatus = lammps_get_last_error_message(self%handle, Cptr, buflen) + CALL C_F_POINTER(Cptr, c_string, [1]) + DO i=1, length + buffer(i:i) = c_string(i) + IF (c_string(i) == c_null_char) EXIT + END DO + IF (PRESENT(status)) THEN + status = Cstatus + END IF + CALL lammps_free(Cptr) + ELSE + buffer = ' ' + IF (PRESENT(status)) THEN + status = 0 + END IF + END IF + END SUBROUTINE lmp_get_last_error_message + ! ---------------------------------------------------------------------- ! functions to assign user-space pointers to LAMMPS data ! ---------------------------------------------------------------------- - SUBROUTINE assign_int_to_lammps_data (lhs, rhs) + SUBROUTINE assign_int_to_lammps_data(lhs, rhs) INTEGER(c_int), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs - IF ( rhs%datatype == DATA_INT ) THEN + IF (rhs%datatype == DATA_INT) THEN lhs => rhs%i32 ELSE - CALL assignment_error(rhs%datatype, 'scalar int') + CALL assignment_error(rhs, 'scalar int') END IF END SUBROUTINE assign_int_to_lammps_data - SUBROUTINE assign_int64_to_lammps_data (lhs, rhs) + SUBROUTINE assign_int64_to_lammps_data(lhs, rhs) INTEGER(c_int64_t), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs - IF ( rhs%datatype == DATA_INT64 ) THEN + IF (rhs%datatype == DATA_INT64) THEN lhs => rhs%i64 ELSE - CALL assignment_error(rhs%datatype, 'scalar long int') + CALL assignment_error(rhs, 'scalar long int') END IF END SUBROUTINE assign_int64_to_lammps_data - SUBROUTINE assign_intvec_to_lammps_data (lhs, rhs) + SUBROUTINE assign_intvec_to_lammps_data(lhs, rhs) INTEGER(c_int), DIMENSION(:), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs - IF ( rhs%datatype == DATA_INT_1D ) THEN + IF (rhs%datatype == DATA_INT_1D) THEN lhs => rhs%i32_vec ELSE - CALL assignment_error(rhs%datatype, 'vector of ints') + CALL assignment_error(rhs, 'vector of ints') END IF END SUBROUTINE assign_intvec_to_lammps_data - SUBROUTINE assign_double_to_lammps_data (lhs, rhs) + 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, '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 - IF ( rhs%datatype == DATA_DOUBLE ) THEN + IF (rhs%datatype == DATA_DOUBLE) THEN lhs => rhs%r64 ELSE - CALL assignment_error(rhs%datatype, 'scalar double') + CALL assignment_error(rhs, 'scalar double') END IF END SUBROUTINE assign_double_to_lammps_data - SUBROUTINE assign_doublevec_to_lammps_data (lhs, rhs) + SUBROUTINE assign_doublevec_to_lammps_data(lhs, rhs) REAL(c_double), DIMENSION(:), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs - IF ( rhs%datatype == DATA_DOUBLE_1D ) THEN + IF (rhs%datatype == DATA_DOUBLE_1D) THEN lhs => rhs%r64_vec ELSE - CALL assignment_error(rhs%datatype, 'vector of doubles') + CALL assignment_error(rhs, 'vector of doubles') END IF END SUBROUTINE assign_doublevec_to_lammps_data - SUBROUTINE assign_string_to_lammps_data (lhs, rhs) + 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, '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 - IF ( rhs%datatype == DATA_STRING ) THEN + IF (rhs%datatype == DATA_STRING) THEN lhs = rhs%str + IF (LEN_TRIM(rhs%str) > LEN(lhs)) THEN + CALL lmp_error(rhs%lammps_instance, LMP_ERROR_WARNING, & + 'String provided by user required truncation [Fortran API]') + END IF ELSE - CALL assignment_error(rhs%datatype, 'string') + CALL assignment_error(rhs, 'string') END IF END SUBROUTINE assign_string_to_lammps_data - SUBROUTINE assignment_error (type1, type2) - INTEGER (c_int) :: type1 - CHARACTER (LEN=*) :: type2 - INTEGER, PARAMETER :: ERROR_CODE = 1 - CHARACTER (LEN=:), ALLOCATABLE :: str1 + ! ---------------------------------------------------------------------- + ! functions to assign user-space pointers to LAMMPS *fix* data + ! ---------------------------------------------------------------------- + SUBROUTINE assign_double_to_lammps_fix_data(lhs, rhs) + REAL(c_double), INTENT(OUT) :: lhs + CLASS(lammps_fix_data), INTENT(IN) :: rhs - SELECT CASE (type1) - CASE (DATA_INT) + IF (rhs%datatype == DATA_DOUBLE) THEN + lhs = rhs%r64 + ELSE + CALL assignment_error(rhs, 'scalar double') + END IF + END SUBROUTINE assign_double_to_lammps_fix_data + + SUBROUTINE assign_doublevec_to_lammps_fix_data(lhs, rhs) + REAL(c_double), DIMENSION(:), INTENT(OUT), POINTER :: lhs + CLASS(lammps_fix_data), INTENT(IN) :: rhs + + IF (rhs%datatype == DATA_DOUBLE_1D) THEN + lhs => rhs%r64_vec + ELSE + CALL assignment_error(rhs, 'vector of doubles') + END IF + END SUBROUTINE assign_doublevec_to_lammps_fix_data + + SUBROUTINE assign_doublemat_to_lammps_fix_data(lhs, rhs) + REAL(c_double), DIMENSION(:,:), INTENT(OUT), POINTER :: lhs + CLASS(lammps_fix_data), INTENT(IN) :: rhs + + IF (rhs%datatype == DATA_DOUBLE_2D) THEN + lhs => rhs%r64_mat + ELSE + CALL assignment_error(rhs, 'matrix of doubles') + END IF + END SUBROUTINE assign_doublemat_to_lammps_fix_data + + ! ---------------------------------------------------------------------- + ! functions to assign user-space pointers to LAMMPS *variable* data + ! ---------------------------------------------------------------------- + SUBROUTINE assign_double_to_lammps_variable_data(lhs, rhs) + REAL(c_double), INTENT(OUT) :: lhs + CLASS(lammps_variable_data), INTENT(IN) :: rhs + + IF (rhs%datatype == DATA_DOUBLE) THEN + lhs = rhs%r64 + ELSE + CALL assignment_error(rhs, 'scalar double') + END IF + END SUBROUTINE assign_double_to_lammps_variable_data + + SUBROUTINE assign_doublevec_to_lammps_variable_data(lhs, rhs) + REAL(c_double), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: lhs + CLASS(lammps_variable_data), INTENT(IN) :: rhs + + IF (rhs%datatype == DATA_DOUBLE_1D) THEN + IF (ALLOCATED(lhs)) DEALLOCATE(lhs) + ALLOCATE(lhs(SIZE(rhs%r64_vec))) + lhs = rhs%r64_vec + ELSE + CALL assignment_error(rhs, 'vector of doubles') + END IF + END SUBROUTINE assign_doublevec_to_lammps_variable_data + + SUBROUTINE assign_string_to_lammps_variable_data(lhs, rhs) + CHARACTER(LEN=*), INTENT(OUT) :: lhs + CLASS(lammps_variable_data), INTENT(IN) :: rhs + + IF (rhs%datatype == DATA_STRING) THEN + lhs = rhs%str + IF (LEN_TRIM(rhs%str) > LEN(lhs)) THEN + CALL lmp_error(rhs%lammps_instance, LMP_ERROR_WARNING, & + 'String provided by user required truncation [Fortran API]') + END IF + ELSE + CALL assignment_error(rhs, 'string') + END IF + END SUBROUTINE assign_string_to_lammps_variable_data + + ! ---------------------------------------------------------------------- + ! Generic function to catch all errors in assignments of LAMMPS data to + ! user-space variables/pointers + ! ---------------------------------------------------------------------- + SUBROUTINE assignment_error(type1, str2) + CLASS(lammps_data_baseclass), INTENT(IN) :: type1 + CHARACTER(LEN=*), INTENT(IN) :: str2 + CHARACTER(LEN=:), ALLOCATABLE :: str1 + + SELECT CASE(type1%datatype) + CASE(DATA_INT) str1 = 'scalar int' - CASE (DATA_INT_1D) + CASE(DATA_INT_1D) str1 = 'vector of ints' - CASE (DATA_INT_2D) + CASE(DATA_INT_2D) str1 = 'matrix of ints' - CASE (DATA_INT64) + CASE(DATA_INT64) str1 = 'scalar long int' - CASE (DATA_INT64_1D) + CASE(DATA_INT64_1D) str1 = 'vector of long ints' - CASE (DATA_INT64_2D) + CASE(DATA_INT64_2D) str1 = 'matrix of long ints' - CASE (DATA_DOUBLE) + CASE(DATA_DOUBLE) str1 = 'scalar double' - CASE (DATA_DOUBLE_1D) + CASE(DATA_DOUBLE_1D) str1 = 'vector of doubles' - CASE (DATA_DOUBLE_2D) + CASE(DATA_DOUBLE_2D) str1 = 'matrix of doubles' + CASE(DATA_STRING) + str1 = 'string' CASE DEFAULT str1 = 'that type' END SELECT - WRITE (ERROR_UNIT,'(A)') 'Cannot associate ' // str1 // ' with ' // type2 - STOP ERROR_CODE + CALL lmp_error(type1%lammps_instance, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'cannot associate ' // str1 // ' with ' // str2 // ' [Fortran API]') END SUBROUTINE assignment_error ! ---------------------------------------------------------------------- diff --git a/python/examples/mc.py b/python/examples/mc.py index fe7f6838c8..c12b4bd6bc 100755 --- a/python/examples/mc.py +++ b/python/examples/mc.py @@ -60,7 +60,7 @@ lmp.command("thermo_style custom step v_emin v_elast pe") lmp.command("run 0") x = lmp.extract_atom("x") lmp.command("variable elast equal $e") - + estart = lmp.extract_compute("thermo_pe", LMP_STYLE_GLOBAL, LAMMPS_INT) / natoms # loop over Monte Carlo moves @@ -92,7 +92,7 @@ for i in range(nloop): else: x[iatom][0] = x0 x[iatom][1] = y0 - + # final energy and stats lmp.command("variable nbuild equal nbuild") diff --git a/python/examples/pizza/gl.py b/python/examples/pizza/gl.py index 7c5633ac55..c567c0805f 100644 --- a/python/examples/pizza/gl.py +++ b/python/examples/pizza/gl.py @@ -3,7 +3,7 @@ # # Copyright (2005) Sandia Corporation. Under the terms of Contract # DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -# certain rights in this software. This software is distributed under +# certain rights in this software. This software is distributed under # the GNU General Public License. # for python3 compatibility @@ -19,8 +19,8 @@ g = gl(d) create OpenGL display for data in d d = atom snapshot object (dump, data) g.bg("black") set background color (def = "black") -g.size(N) set image size to NxN -g.size(N,M) set image size to NxM +g.size(N) set image size to NxN +g.size(N,M) set image size to NxM g.rotate(60,135) view from z theta and azimuthal phi (def = 60,30) g.shift(x,y) translate by x,y pixels in view window (def = 0,0) g.zoom(0.5) scale image by factor (def = 1) @@ -30,7 +30,7 @@ g.box(0/1/2,"red",4) set box edge thickness g.file = "image" file prefix for created images (def = "image") g.show(N) show image of snapshot at timestep N - + g.all() make images of all selected snapshots g.all(P) images of all, start file label at P g.all(N,M,P) make M images of snapshot N, start label at P @@ -43,12 +43,12 @@ g.pan() no pan during all() (default) g.select = "$x > %g*3.0" string to pass to d.aselect.test() during all() g.select = "" no extra aselect (default) - + %g varies from 0.0 to 1.0 from beginning to end of all() - -g.acol(2,"green") set atom colors by atom type (1-N) -g.acol([2,4],["red","blue"]) 1st arg = one type or list of types -g.acol(0,"blue") 2nd arg = one color or list of colors + +g.acol(2,"green") set atom colors by atom type (1-N) +g.acol([2,4],["red","blue"]) 1st arg = one type or list of types +g.acol(0,"blue") 2nd arg = one color or list of colors g.acol(range(20),["red","blue"]) if list lengths unequal, interpolate g.acol(range(10),"loop") assign colors in loop, randomly ordered @@ -58,23 +58,23 @@ g.acol(range(10),"loop") assign colors in loop, randomly ordered g.arad([1,2],[0.5,0.3]) set atom radii, same rules as acol() -g.bcol() set bond color, same args as acol() -g.brad() set bond thickness, same args as arad() +g.bcol() set bond color, same args as acol() +g.brad() set bond thickness, same args as arad() -g.tcol() set triangle color, same args as acol() -g.tfill() set triangle fill, 0 fill, 1 line, 2 both +g.tcol() set triangle color, same args as acol() +g.tfill() set triangle fill, 0 fill, 1 line, 2 both g.lcol() set line color, same args as acol() g.lrad() set line thickness, same args as arad() g.adef() set atom/bond/tri/line properties to default -g.bdef() default = "loop" for colors, 0.45 for radii -g.tdef() default = 0.25 for bond/line thickness -g.ldef() default = 0 fill +g.bdef() default = "loop" for colors, 0.45 for radii +g.tdef() default = 0.25 for bond/line thickness +g.ldef() default = 0 fill by default 100 types are assigned if atom/bond/tri/line has type > # defined properties, is an error - + from vizinfo import colors access color list print(colors) list defined color names and RGB values colors["nickname"] = [R,G,B] set new RGB values from 0 to 255 @@ -148,7 +148,7 @@ class gl: self.azphi = 30 self.scale = 1.0 self.xshift = self.yshift = 0 - + self.file = "image" self.boxflag = 0 self.bxcol = [1,1,0] @@ -165,7 +165,7 @@ class gl: self.nsides = 10 self.theta_amplify = 2 self.shiny = 2 - + self.clipflag = 0 self.clipxlo = self.clipylo = self.clipzlo = 0.0 self.clipxhi = self.clipyhi = self.clipzhi = 1.0 @@ -189,7 +189,7 @@ class gl: self.bdef() self.tdef() self.ldef() - + self.center = 3*[0] self.view = 3*[0] self.up = 3*[0] @@ -211,7 +211,7 @@ class gl: if not ynew: self.ypixels = self.xpixels else: self.ypixels = ynew self.create_window() - + # -------------------------------------------------------------------- def axis(self,value): @@ -223,7 +223,7 @@ class gl: def create_window(self): if self.root: self.root.destroy() - + from __main__ import tkroot self.root = Toplevel(tkroot) self.root.title('Pizza.py gl tool') @@ -232,7 +232,7 @@ class gl: double=1,depth=1) self.w.pack(expand=YES) # self.w.pack(expand=YES,fill=BOTH) - + glViewport(0,0,self.xpixels,self.ypixels) glEnable(GL_LIGHTING); glEnable(GL_LIGHT0); @@ -247,7 +247,7 @@ class gl: self.w.parent = self self.w.tkRedraw() tkroot.update_idletasks() # force window to appear - + # -------------------------------------------------------------------- def clip(self,which,value): @@ -314,7 +314,7 @@ class gl: self.up[1] = sin(pi*self.azphi/180) self.up[2] = 0.0 else: - dot = self.view[2] # dot = (0,0,1) . view + dot = self.view[2] # dot = (0,0,1) . view self.up[0] = -dot*self.view[0] # up projected onto v = dot * v self.up[1] = -dot*self.view[1] # up perp to v = up - dot * v self.up[2] = 1.0 - dot*self.view[2] @@ -325,7 +325,7 @@ class gl: # -------------------------------------------------------------------- # reset ztheta,azphi and thus view,up.right # called as function from Pizza.py - + def rotate(self,ztheta,azphi): self.ztheta = ztheta self.azphi = azphi @@ -366,11 +366,11 @@ class gl: # rotate view,up around axis of rotation = old x new # right = up x view # reset ztheta,azphi from view - + def mouse_rotate(self,xnew,ynew,xold,yold): # change y pixels to measure from bottom of window instead of top - + yold = self.ypixels - yold ynew = self.ypixels - ynew @@ -407,7 +407,7 @@ class gl: axis[1] = rot[0]*self.right[1] + rot[1]*self.up[1] + rot[2]*self.view[1] axis[2] = rot[0]*self.right[2] + rot[1]*self.up[2] + rot[2]*self.view[2] axis = vecnorm(axis) - + # view is changed by (axis x view) scaled by theta # up is changed by (axis x up) scaled by theta # force up to be perp to view via up_perp = up - (up . view) view @@ -468,14 +468,14 @@ class gl: # output: eye = distance to view scene from # xto,yto,zto = point to look to # xfrom,yfrom,zfrom = point to look from - + def setview(self): if not self.ready: return # no distance since no scene yet - + self.eye = 3 * self.distance / self.scale xfactor = 0.5*self.eye*self.xshift/self.xpixels yfactor = 0.5*self.eye*self.yshift/self.ypixels - + self.xto = self.center[0] - xfactor*self.right[0] - yfactor*self.up[0] self.yto = self.center[1] - xfactor*self.right[1] - yfactor*self.up[1] self.zto = self.center[2] - xfactor*self.right[2] - yfactor*self.up[2] @@ -486,7 +486,7 @@ class gl: # -------------------------------------------------------------------- # box attributes, also used for triangle lines - + def box(self,*args): self.boxflag = args[0] if len(args) > 1: @@ -500,7 +500,7 @@ class gl: # -------------------------------------------------------------------- # grab all selected snapshots from data object # add GL-specific info to each bond - + def reload(self): print("Loading data into gl tool ...") data = self.data @@ -529,7 +529,7 @@ class gl: self.bondframes.append(bonds) self.triframes.append(tris) self.lineframes.append(lines) - + print(time,end='') sys.stdout.flush() print() @@ -545,11 +545,11 @@ class gl: def nolabel(self): self.cachelist = -self.cachelist self.labels = [] - + # -------------------------------------------------------------------- # show a single snapshot # distance from snapshot box or max box for all selected steps - + def show(self,ntime): data = self.data which = data.findtime(ntime) @@ -571,7 +571,7 @@ class gl: self.cachelist = -self.cachelist self.w.tkRedraw() self.save() - + # -------------------------------------------------------------------- def pan(self,*list): @@ -584,7 +584,7 @@ class gl: self.ztheta_stop = list[3] self.azphi_stop = list[4] self.scale_stop = list[5] - + # -------------------------------------------------------------------- def all(self,*list): @@ -615,7 +615,7 @@ class gl: if flag == -1: break fraction = float(i) / (ncount-1) - + if self.select != "": newstr = self.select % fraction data.aselect.test(newstr,time) @@ -653,7 +653,7 @@ class gl: self.cachelist = -self.cachelist self.w.tkRedraw() self.save(file) - + print(time,end='') sys.stdout.flush() i += 1 @@ -731,19 +731,19 @@ class gl: # -------------------------------------------------------------------- # draw the GL scene - + def redraw(self,o): # clear window to background color - + glClearColor(self.bgcol[0],self.bgcol[1],self.bgcol[2],0) glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT) # not ready if no scene yet - + if not self.ready: return # set view from eye, distance, 3 lookat vectors (from,to,up) - + glMatrixMode(GL_PROJECTION) glLoadIdentity() if self.orthoflag: @@ -759,14 +759,14 @@ class gl: # draw scene from display list if caching allowed and list hasn't changed # else redraw and store as new display list if caching allowed - + if self.cache and self.cachelist > 0: glCallList(self.cachelist); else: if self.cache: if self.cachelist < 0: glDeleteLists(-self.cachelist,1) self.cachelist = glGenLists(1) glNewList(self.cachelist,GL_COMPILE_AND_EXECUTE) - + # draw box, clip-box, xyz axes, lines glDisable(GL_LIGHTING) @@ -842,7 +842,7 @@ class gl: if self.tridraw: fillflag = self.vizinfo.tfill[int(self.tridraw[0][1])] - + if fillflag != 1: if fillflag: glEnable(GL_POLYGON_OFFSET_FILL) @@ -921,7 +921,7 @@ class gl: gluCylinder(obj,rad,rad,bond[10],self.nsides,self.nsides) glPopMatrix() - if self.tridraw: + if self.tridraw: fillflag = self.vizinfo.tfill[int(self.tridraw[0][1])] if fillflag != 1: @@ -975,7 +975,7 @@ class gl: glEnd() glEnable(GL_LIGHTING) glPolygonMode(GL_FRONT_AND_BACK,GL_FILL) - + if self.cache: glEndList() glFlush() @@ -983,16 +983,16 @@ class gl: # -------------------------------------------------------------------- # make new call list for each atom type # called when atom color/rad/quality is changed - + def make_atom_calllist(self): # extend calllist array if necessary - + if self.vizinfo.nacolor > self.nclist: for i in range(self.vizinfo.nacolor-self.nclist): self.calllist.append(0) self.nclist = self.vizinfo.nacolor # create new calllist for each atom type - + for itype in xrange(1,self.vizinfo.nacolor+1): if self.calllist[itype]: glDeleteLists(self.calllist[itype],1) ilist = glGenLists(1) @@ -1001,12 +1001,12 @@ class gl: red,green,blue = self.vizinfo.acolor[itype] rad = self.vizinfo.arad[itype] glColor3f(red,green,blue); - + # glPointSize(10.0*rad) # glBegin(GL_POINTS) # glVertex3f(0.0,0.0,0.0) # glEnd() - + glMaterialfv(GL_FRONT,GL_EMISSION,[red,green,blue,1.0]); glMaterialf(GL_FRONT,GL_SHININESS,self.shiny); glutSolidSphere(rad,self.nslices,self.nstacks) @@ -1015,7 +1015,7 @@ class gl: # -------------------------------------------------------------------- # augment bond info returned by viz() with info needed for GL draw # info = length, theta, -dy, dx for bond orientation - + def bonds_augment(self,bonds): for bond in bonds: dx = bond[5] - bond[2] @@ -1046,7 +1046,7 @@ class gl: glLineWidth(self.bxthick) glColor3f(self.bxcol[0],self.bxcol[1],self.bxcol[2]) - + glBegin(GL_LINE_LOOP) glVertex3f(xlo,ylo,zlo) glVertex3f(xhi,ylo,zlo) @@ -1081,7 +1081,7 @@ class gl: if yhi-ylo > delta: delta = yhi-ylo if zhi-zlo > delta: delta = zhi-zlo delta *= 0.1 - + glLineWidth(self.bxthick) glBegin(GL_LINES) @@ -1100,7 +1100,7 @@ class gl: def save(self,file=None): self.w.update() # force image on screen to be current before saving it - + pstring = glReadPixels(0,0,self.xpixels,self.ypixels, GL_RGBA,GL_UNSIGNED_BYTE) snapshot = Image.fromstring("RGBA",(self.xpixels,self.ypixels),pstring) @@ -1110,14 +1110,14 @@ class gl: snapshot.save(file + ".png") # -------------------------------------------------------------------- - + def adef(self): self.vizinfo.setcolors("atom",range(100),"loop") self.vizinfo.setradii("atom",range(100),0.45) self.make_atom_calllist() self.cachelist = -self.cachelist self.w.tkRedraw() - + # -------------------------------------------------------------------- def bdef(self): @@ -1130,14 +1130,14 @@ class gl: def tdef(self): self.vizinfo.setcolors("tri",range(100),"loop") - self.vizinfo.setfills("tri",range(100),0) + self.vizinfo.setfills("tri",range(100),0) self.cachelist = -self.cachelist self.w.tkRedraw() # -------------------------------------------------------------------- def ldef(self): - self.vizinfo.setcolors("line",range(100),"loop") + self.vizinfo.setcolors("line",range(100),"loop") self.vizinfo.setradii("line",range(100),0.25) self.cachelist = -self.cachelist self.w.tkRedraw() @@ -1149,29 +1149,29 @@ class gl: self.make_atom_calllist() self.cachelist = -self.cachelist self.w.tkRedraw() - + # -------------------------------------------------------------------- def arad(self,atypes,radii): - self.vizinfo.setradii("atom",atypes,radii) + self.vizinfo.setradii("atom",atypes,radii) self.make_atom_calllist() self.cachelist = -self.cachelist self.w.tkRedraw() - + # -------------------------------------------------------------------- def bcol(self,btypes,colors): self.vizinfo.setcolors("bond",btypes,colors) self.cachelist = -self.cachelist self.w.tkRedraw() - + # -------------------------------------------------------------------- def brad(self,btypes,radii): self.vizinfo.setradii("bond",btypes,radii) self.cachelist = -self.cachelist self.w.tkRedraw() - + # -------------------------------------------------------------------- def tcol(self,ttypes,colors): @@ -1210,10 +1210,10 @@ class MyOpengl(Opengl): args = (self,master,cnf) Opengl.__init__(*args,**kw) Opengl.autospin_allowed = 0 - + # redraw Opengl scene # call parent redraw() method - + def tkRedraw(self,*dummy): if not self.initialised: return self.tk.call(self._w,'makecurrent') @@ -1222,7 +1222,7 @@ class MyOpengl(Opengl): # left button translate # access parent xshift/yshift and call parent trans() method - + def tkTranslate(self,event): dx = event.x - self.xmouse dy = event.y - self.ymouse @@ -1242,7 +1242,7 @@ class MyOpengl(Opengl): # right button zoom # access parent scale and call parent zoom() method - + def tkScale(self,event): scale = 1 - 0.01 * (event.y - self.ymouse) if scale < 0.001: scale = 0.001 diff --git a/python/examples/pizza/vizinfo.py b/python/examples/pizza/vizinfo.py index a150a9c84f..e3a05d71ce 100644 --- a/python/examples/pizza/vizinfo.py +++ b/python/examples/pizza/vizinfo.py @@ -3,7 +3,7 @@ # # Copyright (2005) Sandia Corporation. Under the terms of Contract # DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -# certain rights in this software. This software is distributed under +# certain rights in this software. This software is distributed under # the GNU General Public License. # vizinfo class, not a top-level Pizza.py tool @@ -25,7 +25,7 @@ import types class vizinfo: """ Information holder for Pizza.py visualization tools - + acolor,bcolor,tcolor,lcolor = RGB values for each atom/bond/tri/line type arad = radius of each atom type brad,lrad = thickness of each bond/line type @@ -41,7 +41,7 @@ class vizinfo: setfill() = set triangle fill factor extend() = grow an array """ - + # -------------------------------------------------------------------- def __init__(self): @@ -57,15 +57,15 @@ class vizinfo: self.nbcolor = self.nbrad = 0 self.ntcolor = self.ntfill = 0 self.nlcolor = self.nlrad = 0 - + # -------------------------------------------------------------------- # set color RGB for which = atoms, bonds, triangles - + def setcolors(self,which,ids,rgbs): # convert args into lists if single values # if arg = 0, convert to full-range list - + if type(ids) is types.IntType and ids == 0: if which == "atom": ids = range(self.nacolor) if which == "bond": ids = range(self.nbcolor) @@ -101,11 +101,11 @@ class vizinfo: if max(ids) > self.nlcolor: self.nlcolor = self.extend(self.lcolor,max(ids)) self.nlcolor = self.extend(self.lrad,max(ids)) - + # set color for each type # if list lengths match, set directly, else interpolate # convert final color from 0-255 to 0.0-1.0 - + ntypes = len(ids) nrgbs = len(rgbs) @@ -135,7 +135,7 @@ class vizinfo: if which == "bond": self.bcolor[id] = color if which == "tri": self.tcolor[id] = color if which == "line": self.lcolor[id] = color - + # -------------------------------------------------------------------- # set radii for which = atoms, bonds, lines @@ -143,7 +143,7 @@ class vizinfo: # convert args into lists if single values # if arg = 0, convert to full-range list - + if type(ids) is types.IntType and ids == 0: if which == "atom": ids = range(self.narad) if which == "bond": ids = range(self.nbrad) @@ -199,16 +199,16 @@ class vizinfo: if which == "atom": self.arad[id] = rad if which == "bond": self.brad[id] = rad if which == "line": self.lrad[id] = rad - + # -------------------------------------------------------------------- # set triangle fill style # 0 = fill only, 1 = line only, 2 = fill and line - + def setfills(self,which,ids,fills): # convert args into lists if single values # if arg = 0, convert to full-range list - + if type(ids) is types.IntType and ids == 0: ids = range(self.ntfill) if type(ids) is not types.ListType and type(ids) is not types.TupleType: @@ -237,7 +237,7 @@ class vizinfo: for i in range(len(ids)): self.tfill[ids[i]] = int(fills[i]) else: for id in ids: self.tfill[id] = int(fills[0]) - + # -------------------------------------------------------------------- def extend(self,array,n): diff --git a/python/examples/pizza/vmd.py b/python/examples/pizza/vmd.py index 00b8615092..5c8461f6ca 100644 --- a/python/examples/pizza/vmd.py +++ b/python/examples/pizza/vmd.py @@ -3,7 +3,7 @@ # # Copyright (2005) Sandia Corporation. Under the terms of Contract # DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -# certain rights in this software. This software is distributed under +# certain rights in this software. This software is distributed under # the GNU General Public License. # for python3 compatibility @@ -20,24 +20,24 @@ from __future__ import print_function oneline = "Control VMD from python" docstr = """ -v = vmd() start up VMD -v.stop() shut down VMD instance -v.clear() delete all visualizations +v = vmd() start up VMD +v.stop() shut down VMD instance +v.clear() delete all visualizations -v.rep(style) set default representation style. One of - (Lines|VDW|Licorice|DynamicBonds|Points|CPK) -v.new(file[,type]) load new file (default file type 'lammpstrj') +v.rep(style) set default representation style. One of + (Lines|VDW|Licorice|DynamicBonds|Points|CPK) +v.new(file[,type]) load new file (default file type 'lammpstrj') v.data(file[,atomstyle]) load new data file (default atom style 'full') -v.replace(file[,type]) replace current frames with new file -v.append(file[,type]) append file to current frame(s) +v.replace(file[,type]) replace current frames with new file +v.append(file[,type]) append file to current frame(s) v.set(snap,x,y,z,(True|False)) set coordinates from a pizza.py snapshot to new or current frame -v.frame(frame) set current frame -v.flush() flush pending input to VMD and update GUI -v.read(file) read Tcl script file (e.g. saved state) - -v.enter() enter interactive shell -v.debug([True|False]) display generated VMD script commands? +v.frame(frame) set current frame +v.flush() flush pending input to VMD and update GUI +v.read(file) read Tcl script file (e.g. saved state) + +v.enter() enter interactive shell +v.debug([True|False]) display generated VMD script commands? """ # History @@ -71,7 +71,7 @@ except ImportError: # Class definition class vmd: - + # -------------------------------------------------------------------- def __init__(self): @@ -103,7 +103,7 @@ class vmd: # open pipe to vmd and wait until we have a prompt self.VMD = pexpect.spawn(self.vmdexe) self.VMD.expect('vmd >') - + # -------------------------------------------------------------------- # post command to vmd and wait until the prompt returns. def __call__(self,command): @@ -113,7 +113,7 @@ class vmd: if self.debugme: print("call+result:"+self.VMD.before) return - + # -------------------------------------------------------------------- # exit VMD def stop(self): @@ -198,7 +198,7 @@ class vmd: self.__call__('mol addfile ' + filename + ' mol $tmol type ' + filetype + ' waitfor all') self.__call__('foreach mol [molinfo list] { molinfo $mol set {center_matrix rotate_matrix scale_matrix global_matrix} $viewpoints($mol)}') self.flush() - + # -------------------------------------------------------------------- # replace all frames of a molecule with those from a given file def update(self,filename,filetype='lammpstrj'): @@ -209,7 +209,7 @@ class vmd: self.__call__('mol addfile ' + filename + ' mol $tmol type ' + filetype + ' waitfor all') self.__call__('foreach mol [molinfo list] {molinfo $mol set {center_matrix rotate_matrix scale_matrix global_matrix} $viewpoints($mol)}') self.flush() - + # -------------------------------------------------------------------- # add or overwrite coordinates with coordinates in a snapshot def set(self,snap,x,y,z,append=True): diff --git a/python/examples/pylammps/elastic/README b/python/examples/pylammps/elastic/README index 8d1712cd10..40ba34fa62 100644 --- a/python/examples/pylammps/elastic/README +++ b/python/examples/pylammps/elastic/README @@ -1,4 +1,4 @@ conversion of lammps scripts to python code using PyLammps interface -Example for elastic.py +Example for elastic.py python elastic.py Au.data EAM_Dynamo_Ackland_1987_Au__MO_754413982908_000 Au diff --git a/python/examples/split.py b/python/examples/split.py index bd2896c004..2e63d57621 100755 --- a/python/examples/split.py +++ b/python/examples/split.py @@ -32,7 +32,7 @@ nprocs = comm.Get_size() if me < nprocs // 2: color = 0 else: color = 1 - + split = comm.Split(color,key=0) if color == 0: @@ -69,12 +69,12 @@ else: # could run a 2nd calculation on second partition # with different LAMMPS instance or another code # in this case, just sleep on second partition - + import time time.sleep(2) print("Calculation on partition 1 complete") # shutdown mpi4py - + comm.Barrier() MPI.Finalize() diff --git a/python/examples/viz_gl.py b/python/examples/viz_gl.py index 6266682b9c..ab527e0329 100755 --- a/python/examples/viz_gl.py +++ b/python/examples/viz_gl.py @@ -50,7 +50,7 @@ ntimestep = 0 if me == 0: tkroot = None - try: + try: import Tkinter except: import tkinter as Tkinter diff --git a/python/examples/viz_pymol.py b/python/examples/viz_pymol.py index b5061d4c20..1b139dc37e 100755 --- a/python/examples/viz_pymol.py +++ b/python/examples/viz_pymol.py @@ -63,7 +63,7 @@ if me == 0: p.single(ntimestep) pm.load("tmp.pdb") pm.show("spheres","tmp") - + # run nfreq steps at a time w/out pre/post, read dump snapshot, display it while ntimestep < nsteps: @@ -75,7 +75,7 @@ while ntimestep < nsteps: p.single(ntimestep) pm.load("tmp.pdb") pm.forward() - + lmp.command("run 0 pre no post yes") # uncomment if running in parallel via mpi4py diff --git a/python/lammps/constants.py b/python/lammps/constants.py index 26bb92626a..6fe7750326 100644 --- a/python/lammps/constants.py +++ b/python/lammps/constants.py @@ -22,7 +22,8 @@ LAMMPS_INT64 = 4 LAMMPS_INT64_2D = 5 LAMMPS_STRING = 6 -# these must be kept in sync with the enums in library.h +# these must be kept in sync with the enums in src/library.h, tools/swig/lammps.i +# and the constants in fortran/lammps.f90 LMP_STYLE_GLOBAL = 0 LMP_STYLE_ATOM = 1 LMP_STYLE_LOCAL = 2 @@ -42,6 +43,8 @@ LMP_ERROR_UNIVERSE = 8 LMP_VAR_EQUAL = 0 LMP_VAR_ATOM = 1 +LMP_VAR_VECTOR = 2 +LMP_VAR_STRING = 3 # ------------------------------------------------------------------------- diff --git a/python/lammps/core.py b/python/lammps/core.py index aa4aae13db..074e579d13 100644 --- a/python/lammps/core.py +++ b/python/lammps/core.py @@ -301,6 +301,8 @@ class lammps(object): self.lib.lammps_extract_fix.argtypes = [c_void_p, c_char_p, c_int, c_int, c_int, c_int] self.lib.lammps_extract_variable.argtypes = [c_void_p, c_char_p, c_char_p] + self.lib.lammps_extract_variable_datatype.argtypes = [c_void_p, c_char_p] + self.lib.lammps_extract_variable_datatype.restype = c_int self.lib.lammps_fix_external_get_force.argtypes = [c_void_p, c_char_p] self.lib.lammps_fix_external_get_force.restype = POINTER(POINTER(c_double)) @@ -1083,21 +1085,23 @@ class lammps(object): # for vector, must copy nlocal returned values to local c_double vector # memory was allocated by library interface function - def extract_variable(self, name, group=None, vartype=LMP_VAR_EQUAL): + def extract_variable(self, name, group=None, vartype=None): """ Evaluate a LAMMPS variable and return its data This function is a wrapper around the function - :cpp:func:`lammps_extract_variable` of the C-library interface, + :cpp:func:`lammps_extract_variable` of the C library interface, evaluates variable name and returns a copy of the computed data. The memory temporarily allocated by the C-interface is deleted after the data is copied to a Python variable or list. The variable must be either an equal-style (or equivalent) - variable or an atom-style variable. The variable type has to - provided as ``vartype`` parameter which may be one of two constants: - ``LMP_VAR_EQUAL`` or ``LMP_VAR_ATOM``; it defaults to - equal-style variables. - The group parameter is only used for atom-style variables and - defaults to the group "all" if set to ``None``, which is the default. + variable or an atom-style variable. The variable type can be + provided as the ``vartype`` parameter, which may be one of several + constants: ``LMP_VAR_EQUAL``, ``LMP_VAR_ATOM``, ``LMP_VAR_VECTOR``, + or ``LMP_VAR_STRING``. If omitted or ``None``, LAMMPS will determine its + value for you based on a call to + :cpp:func:`lammps_extract_variable_datatype` from the C library interface. + The group parameter is only used for atom-style variables and defaults to + the group "all". :param name: name of the variable to execute :type name: string @@ -1111,6 +1115,8 @@ class lammps(object): if name: name = name.encode() else: return None if group: group = group.encode() + if vartype is None : + vartype = self.lib.lammps_extract_variable_datatype(self.lmp, name) if vartype == LMP_VAR_EQUAL: self.lib.lammps_extract_variable.restype = POINTER(c_double) with ExceptionCheck(self): @@ -1130,6 +1136,31 @@ class lammps(object): self.lib.lammps_free(ptr) else: return None return result + elif vartype == LMP_VAR_VECTOR : + nvector = 0 + self.lib.lammps_extract_variable.restype = POINTER(c_int) + ptr = self.lib.lammps_extract_variable(self.lmp,name, + 'LMP_SIZE_VECTOR'.encode()) + if ptr : + nvector = ptr[0] + self.lib.lammps_free(ptr) + else : + return None + self.lib.lammps_extract_variable.restype = POINTER(c_double) + result = (c_double*nvector)() + values = self.lib.lammps_extract_variable(self.lmp,name,group) + if values : + for i in range(nvector) : + result[i] = values[i] + # do NOT free the values pointer (points to internal vector data) + return result + else : + return None + elif vartype == LMP_VAR_STRING : + self.lib.lammps_extract_variable.restype = c_char_p + with ExceptionCheck(self) : + ptr = self.lib.lammps_extract_variable(self.lmp, name, group) + return ptr.decode('utf-8') return None # ------------------------------------------------------------------------- diff --git a/src/library.cpp b/src/library.cpp index 16381a089d..03f6c0e211 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -949,7 +949,8 @@ int lammps_get_mpi_comm(void *handle) This function will retrieve or compute global properties. In contrast to :cpp:func:`lammps_get_thermo` this function returns an ``int``. The following tables list the currently supported keyword. If a keyword is -not recognized, the function returns -1. +not recognized, the function returns -1. The integer sizes functions may +be called without a valid LAMMPS object handle (it is ignored). * :ref:`Integer sizes ` * :ref:`System status ` @@ -1145,7 +1146,7 @@ int lammps_extract_setting(void *handle, const char *keyword) This function returns an integer that encodes the data type of the global property with the specified name. See :cpp:enum:`_LMP_DATATYPE_CONST` for valid values. Callers of :cpp:func:`lammps_extract_global` can use this information -to then decide how to cast the (void*) pointer and access the data. +to then decide how to cast the ``void *`` pointer and access the data. .. versionadded:: 18Sep2020 @@ -1622,7 +1623,7 @@ void *lammps_extract_global(void *handle, const char *name) This function returns an integer that encodes the data type of the per-atom property with the specified name. See :cpp:enum:`_LMP_DATATYPE_CONST` for valid values. Callers of :cpp:func:`lammps_extract_atom` can use this information -to then decide how to cast the (void*) pointer and access the data. +to then decide how to cast the ``void *`` pointer and access the data. .. versionadded:: 18Sep2020 @@ -2043,16 +2044,19 @@ void *lammps_extract_fix(void *handle, const char *id, int style, int type, This function returns a pointer to data from a LAMMPS :doc:`variable` identified by its name. When the variable is either an *equal*\ -style -compatible or an *atom*\ -style variable the variable is evaluated and -the corresponding value(s) returned. Variables of style *internal* -are compatible with *equal*\ -style variables and so are *python*\ --style variables, if they return a numeric value. For other -variable styles their string value is returned. The function returns +compatible variable, a *vector*\ -style variable, or an *atom*\ -style +variable, the variable is evaluated and the corresponding value(s) returned. +Variables of style *internal* are compatible with *equal*\ -style variables and +so are *python*\ -style variables, if they return a numeric value. For other +variable styles, their string value is returned. The function returns ``NULL`` when a variable of the provided *name* is not found or of an incompatible style. The *group* argument is only used for *atom*\ --style variables and ignored otherwise. If set to ``NULL`` when -extracting data from and *atom*\ -style variable, the group is assumed -to be "all". +-style variables and ignored otherwise, with one exception: for style *vector*, +if *group* is "GET_VECTOR_SIZE", the returned pointer will yield the length +of the vector to be returned when dereferenced. This pointer must be +deallocated after the value is read to avoid a memory leak. +If *group* is set to ``NULL`` when extracting data from an *atom*\ -style +variable, the group is assumed to be "all". When requesting data from an *equal*\ -style or compatible variable this function allocates storage for a single double value, copies the @@ -2066,15 +2070,23 @@ use to avoid a memory leak. Example: double value = *dptr; lammps_free((void *)dptr); -For *atom*\ -style variables the data returned is a pointer to an +For *atom*\ -style variables, the return value is a pointer to an allocated block of storage of double of the length ``atom->nlocal``. -Since the data is returned a copy, the location will persist, but its -content will not be updated, in case the variable is re-evaluated. -To avoid a memory leak this pointer needs to be freed after use in +Since the data returned are a copy, the location will persist, but its +content will not be updated in case the variable is re-evaluated. +To avoid a memory leak, this pointer needs to be freed after use in the calling program. +For *vector*\ -style variables, the returned pointer is to actual LAMMPS data. +The pointer should not be deallocated. Its length depends on the variable, +compute, or fix data used to construct the *vector*\ -style variable. +This length can be fetched by calling this function with *group* set to the +constant "LMP_SIZE_VECTOR", which returns a ``void *`` pointer that can be +dereferenced to an integer that is the length of the vector. This pointer +needs to be deallocated when finished with it to avoid memory leaks. + For other variable styles the returned pointer needs to be cast to -a char pointer. +a char pointer. It should not be deallocated. .. code-block:: c @@ -2084,10 +2096,10 @@ a char pointer. .. note:: LAMMPS cannot easily check if it is valid to access the data - referenced by the variables, e.g. computes or fixes or thermodynamic - info, so it may fail with an error. The caller has to make certain, - that the data is extracted only when it safe to evaluate the variable - and thus an error and crash is avoided. + referenced by the variables (e.g., computes, fixes, or thermodynamic + info), so it may fail with an error. The caller has to make certain + that the data are extracted only when it safe to evaluate the variable + and thus an error or crash are avoided. \endverbatim * @@ -2118,6 +2130,15 @@ void *lammps_extract_variable(void *handle, const char *name, const char *group) auto vector = (double *) malloc(nlocal*sizeof(double)); lmp->input->variable->compute_atom(ivar,igroup,vector,1,0); return (void *) vector; + } else if (lmp->input->variable->vectorstyle(ivar)) { + double *values = nullptr; + int nvector = lmp->input->variable->compute_vector(ivar, &values); + if ( group != nullptr && strcmp(group,"LMP_SIZE_VECTOR") == 0 ) { + int* nvecptr = (int *) malloc(sizeof(int)); + *nvecptr = nvector; + return (void *) nvecptr; + } else + return (void *) values; } else { return lmp->input->variable->retrieve(name); } @@ -2130,6 +2151,49 @@ void *lammps_extract_variable(void *handle, const char *name, const char *group) /* ---------------------------------------------------------------------- */ +/** Get data type of a LAMMPS variable. + * +\verbatim embed:rst + +This function returns an integer that encodes the data type of the variable +with the specified name. See :cpp:enum:`_LMP_VAR_CONST` for valid values. +Callers of :cpp:func:`lammps_extract_variable` can use this information to +decide how to cast the ``void *`` pointer and access the data. + +.. versionadded:: TBD + +\endverbatim + * + * \param handle pointer to a previously created LAMMPS instance + * \param name string with the name of the extracted variable + * \return integer constant encoding the data type of the property + * or -1 if not found. + **/ + +int lammps_extract_variable_datatype(void *handle, const char *name) +{ + auto lmp = (LAMMPS*) handle; + + BEGIN_CAPTURE + { + int ivar = lmp->input->variable->find(name); + if ( ivar < 0 ) return -1; + + if (lmp->input->variable->equalstyle(ivar)) + return LMP_VAR_EQUAL; + else if (lmp->input->variable->atomstyle(ivar)) + return LMP_VAR_ATOM; + else if (lmp->input->variable->vectorstyle(ivar)) + return LMP_VAR_VECTOR; + else + return LMP_VAR_STRING; + } + END_CAPTURE + return -1; +} + +/* ---------------------------------------------------------------------- */ + /** Set the value of a string-style variable. * * This function assigns a new value from the string str to the @@ -2159,21 +2223,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 @@ -2294,23 +2375,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 ------------------------------------------------------------------------- */ @@ -2440,23 +2541,40 @@ 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 +in the same order as the array *ids* (e.g., if *name* is *x*, *count* = 3, and +*ids* is {100, 57, 210}, then *data* might look like {x[100][0], x[100][1], +x[100][2], x[57][0], x[57][1], x[57][2], x[210][0], :math:`\dots`); +*ids* must be provided by the user with length *ndata*, and +*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 @@ -2477,15 +2595,16 @@ 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"); + lmp->error->warning(FLERR,"Library error in lammps_gather_atoms_subset: atoms must have mappable ids"); return; } @@ -2586,18 +2705,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 ------------------------------------------------------------------------- */ @@ -2624,7 +2760,7 @@ void lammps_scatter_atoms(void *handle, char *name, int type, int count, void *d 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_scatter_atoms"); + lmp->error->warning(FLERR,"Library error in lammps_scatter_atoms: ids must exist, be consecutive, and be mapped"); return; } @@ -2702,19 +2838,51 @@ 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 no requirement for consecutive atom IDs (1 to N) see scatter_atoms() to scatter data for all atoms, ordered by consecutive IDs - name = desired quantity, e.g. x or charge + 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 + 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 ndata = # of atoms in ids and data (could be all atoms) ids = list of Ndata atom IDs to scatter data to 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],... + (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*Ndata method: loop over Ndata, if I own atom ID, set its values from data @@ -2743,7 +2911,7 @@ void lammps_scatter_atoms_subset(void *handle, char *name, int type, int count, 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_scatter_atoms_subset"); + lmp->error->warning(FLERR,"Library error in lammps_scatter_atoms_subset: atoms must have mapped ids"); return; } @@ -2904,7 +3072,7 @@ Below is a brief C code demonstrating accessing this collected bond information. void lammps_gather_bonds(void *handle, void *data) { - auto lmp = (LAMMPS *)handle; + auto lmp = (LAMMPS *) handle; BEGIN_CAPTURE { void *val = lammps_extract_global(handle,"nbonds"); bigint nbonds = *(bigint *)val; @@ -2951,10 +3119,10 @@ void lammps_gather_bonds(void *handle, void *data) "d2_name" or "i2_name" for fix property/atom arrays with count > 1 will return error if fix/compute isn't atom-based 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 + 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],... + (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: @@ -3186,10 +3354,10 @@ void lammps_gather(void *handle, char *name, int type, int count, void *data) "d2_name" or "i2_name" for fix property/atom arrays with count > 1 will return error if fix/compute isn't atom-based 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 + 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],... + (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: @@ -3438,10 +3606,10 @@ void lammps_gather_concat(void *handle, char *name, int type, int count, void *d "d2_name" or "i2_name" for fix property/atom arrays with count > 1 will return error if fix/compute isn't atom-based 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 + 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],... + (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: @@ -3465,11 +3633,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"); @@ -3686,10 +3855,10 @@ void lammps_gather_subset(void *handle, char *name, "d2_name" or "i2_name" for fix property/atom arrays with count > 1 will return error if fix/compute isn't atom-based 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 + 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],... + (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: @@ -3904,12 +4073,12 @@ void lammps_scatter(void *handle, char *name, int type, int count, void *data) "f_fix", "c_compute" for fixes / computes will return error if fix/compute doesn't isn't atom-based 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 + 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 ndata = # of atoms in ids and data (could be all atoms) ids = list of Ndata atom IDs to scatter data to 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],... + (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*Ndata method: loop over Ndata, if I own atom ID, set its values from data @@ -4152,8 +4321,8 @@ boundaries atoms will be wrapped back into the simulation cell and its image flags adjusted accordingly, unless explicit image flags are provided. -The function returns the number of atoms created or -1 on failure, e.g. -when called before as box has been created. +The function returns the number of atoms created or -1 on failure (e.g., +when called before as box has been created). Coordinates and velocities have to be given in a 1d-array in the order X(1),Y(1),Z(1),X(2),Y(2),Z(2),...,X(N),Y(N),Z(N). @@ -4358,7 +4527,7 @@ int lammps_find_fix_neighlist(void *handle, const char *id, int reqid) { * multiple requests from the same compute * \return return neighbor list index if found, otherwise -1 */ -int lammps_find_compute_neighlist(void* handle, const char *id, int reqid) { +int lammps_find_compute_neighlist(void *handle, const char *id, int reqid) { auto lmp = (LAMMPS *) handle; auto compute = lmp->modify->get_compute_by_id(id); if (!compute) return -1; @@ -4511,7 +4680,7 @@ int lammps_config_has_mpi_support() * files via a pipe to gzip or similar compression programs \verbatim embed:rst -Several LAMMPS commands (e.g. :doc:`read_data`, :doc:`write_data`, +Several LAMMPS commands (e.g., :doc:`read_data`, :doc:`write_data`, :doc:`dump styles atom, custom, and xyz `) support reading and writing compressed files via creating a pipe to the ``gzip`` program. This function checks whether this feature was :ref:`enabled at compile @@ -4531,8 +4700,8 @@ int lammps_config_has_gzip_support() { \verbatim embed:rst The LAMMPS :doc:`dump style image ` supports writing multiple -image file formats. Most of them need, however, support from an external -library and using that has to be :ref:`enabled at compile time `. +image file formats. Most of them, however, need support from an external +library, and using that has to be :ref:`enabled at compile time `. This function checks whether support for the `PNG image file format `_ is available in the current LAMMPS library. @@ -4550,8 +4719,8 @@ int lammps_config_has_png_support() { \verbatim embed:rst The LAMMPS :doc:`dump style image ` supports writing multiple -image file formats. Most of them need, however, support from an external -library and using that has to be :ref:`enabled at compile time `. +image file formats. Most of them, however, need support from an external +library, and using that has to be :ref:`enabled at compile time `. This function checks whether support for the `JPEG image file format `_ is available in the current LAMMPS library. \endverbatim @@ -4568,7 +4737,7 @@ int lammps_config_has_jpeg_support() { \verbatim embed:rst The LAMMPS :doc:`dump style movie ` supports generating movies -from images on-the-fly via creating a pipe to the +from images on-the-fly via creating a pipe to the `ffmpeg `_ program. This function checks whether this feature was :ref:`enabled at compile time `. It does **not** check whether the ``ffmpeg`` itself is installed and usable. @@ -4582,14 +4751,14 @@ int lammps_config_has_ffmpeg_support() { /* ---------------------------------------------------------------------- */ -/** Check whether LAMMPS errors will throw a C++ exception +/** Check whether LAMMPS errors will throw C++ exceptions. * \verbatim embed:rst -In case of errors LAMMPS will either abort or throw a C++ exception. +In case of an error, LAMMPS will either abort or throw a C++ exception. The latter has to be :ref:`enabled at compile time `. This function checks if exceptions were enabled. -When using the library interface and C++ exceptions are enabled, +When using the library interface with C++ exceptions enabled, the library interface functions will "catch" them and the error status can then be checked by calling :cpp:func:`lammps_has_error` and the most recent error message @@ -4608,10 +4777,10 @@ int lammps_config_has_exceptions() { /* ---------------------------------------------------------------------- */ -/** Check if a specific package has been included in LAMMPS +/** Check whether a specific package has been included in LAMMPS * \verbatim embed:rst -This function checks if the LAMMPS library in use includes the +This function checks whether the LAMMPS library in use includes the specific :doc:`LAMMPS package ` provided as argument. \endverbatim * @@ -5183,8 +5352,8 @@ data structures can change as well as the order of atom as they migrate between MPI processes because of the domain decomposition parallelization, this function should be always called immediately before the forces are going to be set to get an up-to-date pointer. - You can use e.g. :cpp:func:`lammps_get_natoms` to obtain the number -of local atoms `nlocal` and then assume the dimensions of the returned +You can use, for example, :cpp:func:`lammps_extract_setting` to obtain the +number of local atoms `nlocal` and then assume the dimensions of the returned force array as ``double force[nlocal][3]``. This is an alternative to the callback mechanism in fix external set up by @@ -5470,7 +5639,7 @@ void lammps_fix_external_set_vector_length(void *handle, const char *id, int len This is a companion function to :cpp:func:`lammps_set_fix_external_callback` and :cpp:func:`lammps_fix_external_get_force` to set the values of a global vector of properties that will be stored with the fix. And can be accessed from -within LAMMPS input commands (e.g. fix ave/time or variables) when used +within LAMMPS input commands (e.g., fix ave/time or variables) when used in a vector context. This function needs to be called **after** a call to @@ -5568,7 +5737,7 @@ int lammps_is_running(void *handle) return lmp->update->whichflag; } -/** Force a timeout to cleanly stop an ongoing run +/** Force a timeout to stop an ongoing run cleanly. * * This function can be used from signal handlers or multi-threaded * applications to cleanly terminate an ongoing run. @@ -5594,9 +5763,9 @@ has thrown a :ref:`C++ exception `. .. note:: This function will always report "no error" when the LAMMPS library - has been compiled without ``-DLAMMPS_EXCEPTIONS`` which turns fatal - errors aborting LAMMPS into a C++ exceptions. You can use the library - function :cpp:func:`lammps_config_has_exceptions` to check if this is + has been compiled without ``-DLAMMPS_EXCEPTIONS``, which turns fatal + errors aborting LAMMPS into C++ exceptions. You can use the library + function :cpp:func:`lammps_config_has_exceptions` to check whether this is the case. \endverbatim * @@ -5605,8 +5774,8 @@ has thrown a :ref:`C++ exception `. */ int lammps_has_error(void *handle) { #ifdef LAMMPS_EXCEPTIONS - LAMMPS * lmp = (LAMMPS *) handle; - Error * error = lmp->error; + LAMMPS *lmp = (LAMMPS *) handle; + Error *error = lmp->error; return (error->get_last_error().empty()) ? 0 : 1; #else return 0; @@ -5626,15 +5795,15 @@ error message is longer, it will be truncated accordingly. The return value of the function corresponds to the kind of error: a "1" indicates an error that occurred on all MPI ranks and is often recoverable, while a "2" indicates an abort that would happen only in a single MPI rank -and thus may not be recoverable as other MPI ranks may be waiting on +and thus may not be recoverable, as other MPI ranks may be waiting on the failing MPI ranks to send messages. .. note:: This function will do nothing when the LAMMPS library has been - compiled without ``-DLAMMPS_EXCEPTIONS`` which turns errors aborting - LAMMPS into a C++ exceptions. You can use the library function - :cpp:func:`lammps_config_has_exceptions` to check if this is the case. + compiled without ``-DLAMMPS_EXCEPTIONS``, which turns errors aborting + LAMMPS into C++ exceptions. You can use the library function + :cpp:func:`lammps_config_has_exceptions` to check whether this is the case. \endverbatim * * \param handle pointer to a previously created LAMMPS instance cast to ``void *``. diff --git a/src/library.h b/src/library.h index 1eec57898e..814c24210d 100644 --- a/src/library.h +++ b/src/library.h @@ -40,7 +40,8 @@ /** Data type constants for extracting data from atoms, computes and fixes * - * Must be kept in sync with the equivalent constants in lammps/constants.py */ + * Must be kept in sync with the equivalent constants in python/lammps/constants.py, + * fortran/lammps.f90, and tools/swig/lammps.i */ enum _LMP_DATATYPE_CONST { LAMMPS_INT = 0, /*!< 32-bit integer (array) */ @@ -54,7 +55,8 @@ enum _LMP_DATATYPE_CONST { /** Style constants for extracting data from computes and fixes. * - * Must be kept in sync with the equivalent constants in lammps/constants.py */ + * Must be kept in sync with the equivalent constants in python/lammps/constants.py, + * fortran/lammps.f90, and tools/swig/lammps.i */ enum _LMP_STYLE_CONST { LMP_STYLE_GLOBAL = 0, /*!< return global data */ @@ -64,7 +66,8 @@ enum _LMP_STYLE_CONST { /** Type and size constants for extracting data from computes and fixes. * - * Must be kept in sync with the equivalent constants in lammps/constants.py */ + * Must be kept in sync with the equivalent constants in python/lammps/constants.py, + * fortran/lammps.f90, and tools/swig/lammps.i */ enum _LMP_TYPE_CONST { LMP_TYPE_SCALAR = 0, /*!< return scalar */ @@ -77,7 +80,8 @@ enum _LMP_TYPE_CONST { /** Error codes to select the suitable function in the Error class * - * Must be kept in sync with the equivalent constants in lammps/constants.py */ + * Must be kept in sync with the equivalent constants in python/lammps/constants.py, + * fortran/lammps.f90, and tools/swig/lammps.i */ enum _LMP_ERROR_CONST { LMP_ERROR_WARNING = 0, /*!< call Error::warning() */ @@ -87,6 +91,18 @@ enum _LMP_ERROR_CONST { LMP_ERROR_UNIVERSE = 8 /*!< error on Comm::universe */ }; +/** Variable style constants for extracting data from variables. + * + * Must be kept in sync with the equivalent constants in python/lammps/constants.py, + * fortran/lammps.f90, and tools/swig/lammps.i */ + +enum _LMP_VAR_CONST { + LMP_VAR_EQUAL = 0, /*!< compatible with equal-style variables */ + LMP_VAR_ATOM = 1, /*!< compatible with atom-style variables */ + LMP_VAR_VECTOR = 2, /*!< compatible with vector-style variables */ + LMP_VAR_STRING = 3 /*!< return value will be a string (catch-all) */ +}; + /* Ifdefs to allow this file to be included in C and C++ programs */ #ifdef __cplusplus @@ -153,6 +169,7 @@ void *lammps_extract_atom(void *handle, const char *name); void *lammps_extract_compute(void *handle, const char *, int, int); void *lammps_extract_fix(void *handle, const char *, int, int, int, int); void *lammps_extract_variable(void *handle, const char *, const char *); +int lammps_extract_variable_datatype(void *handle, const char *name); int lammps_set_variable(void *, char *, char *); /* ---------------------------------------------------------------------- diff --git a/tools/coding_standard/whitespace.py b/tools/coding_standard/whitespace.py index be53f60380..1c980717d6 100644 --- a/tools/coding_standard/whitespace.py +++ b/tools/coding_standard/whitespace.py @@ -24,11 +24,13 @@ include: - cmake/** - doc - doc/src/** - - python + - fortran/** + - python/** - src/** - lib/** - tools/coding_standard - tools/python + - unittest/** exclude: - lib/colvars/Install.py - lib/gpu/geryon/file_to_cstr.sh diff --git a/tools/swig/lammps.i b/tools/swig/lammps.i index fb4322af34..3c5f43ac2d 100644 --- a/tools/swig/lammps.i +++ b/tools/swig/lammps.i @@ -22,37 +22,69 @@ %{ +/** Data type constants for extracting data from atoms, computes and fixes + * + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ + enum _LMP_DATATYPE_CONST { - LAMMPS_INT = 0, /*!< 32-bit integer (array) */ - LAMMPS_INT_2D = 1, /*!< two-dimensional 32-bit integer array */ - LAMMPS_DOUBLE = 2, /*!< 64-bit double (array) */ - LAMMPS_DOUBLE_2D = 3, /*!< two-dimensional 64-bit double array */ - LAMMPS_INT64 = 4, /*!< 64-bit integer (array) */ - LAMMPS_INT64_2D = 5, /*!< two-dimensional 64-bit integer array */ - LAMMPS_STRING = 6 /*!< C-String */ + LAMMPS_INT = 0, /*!< 32-bit integer (array) */ + LAMMPS_INT_2D = 1, /*!< two-dimensional 32-bit integer array */ + LAMMPS_DOUBLE = 2, /*!< 64-bit double (array) */ + LAMMPS_DOUBLE_2D = 3, /*!< two-dimensional 64-bit double array */ + LAMMPS_INT64 = 4, /*!< 64-bit integer (array) */ + LAMMPS_INT64_2D = 5, /*!< two-dimensional 64-bit integer array */ + LAMMPS_STRING = 6 /*!< C-String */ }; /** Style constants for extracting data from computes and fixes. * - * Must be kept in sync with the equivalent constants in lammps/constants.py */ + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ enum _LMP_STYLE_CONST { - LMP_STYLE_GLOBAL=0, /*!< return global data */ - LMP_STYLE_ATOM =1, /*!< return per-atom data */ - LMP_STYLE_LOCAL =2 /*!< return local data */ + LMP_STYLE_GLOBAL = 0, /*!< return global data */ + LMP_STYLE_ATOM = 1, /*!< return per-atom data */ + LMP_STYLE_LOCAL = 2 /*!< return local data */ }; /** Type and size constants for extracting data from computes and fixes. * - * Must be kept in sync with the equivalent constants in lammps/constants.py */ + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ enum _LMP_TYPE_CONST { - LMP_TYPE_SCALAR=0, /*!< return scalar */ - LMP_TYPE_VECTOR=1, /*!< return vector */ - LMP_TYPE_ARRAY =2, /*!< return array */ - LMP_SIZE_VECTOR=3, /*!< return length of vector */ - LMP_SIZE_ROWS =4, /*!< return number of rows */ - LMP_SIZE_COLS =5 /*!< return number of columns */ + LMP_TYPE_SCALAR = 0, /*!< return scalar */ + LMP_TYPE_VECTOR = 1, /*!< return vector */ + LMP_TYPE_ARRAY = 2, /*!< return array */ + LMP_SIZE_VECTOR = 3, /*!< return length of vector */ + LMP_SIZE_ROWS = 4, /*!< return number of rows */ + LMP_SIZE_COLS = 5 /*!< return number of columns */ +}; + +/** Error codes to select the suitable function in the Error class + * + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ + +enum _LMP_ERROR_CONST { + LMP_ERROR_WARNING = 0, /*!< call Error::warning() */ + LMP_ERROR_ONE = 1, /*!< called from one MPI rank */ + LMP_ERROR_ALL = 2, /*!< called from all MPI ranks */ + LMP_ERROR_WORLD = 4, /*!< error on Comm::world */ + LMP_ERROR_UNIVERSE = 8 /*!< error on Comm::universe */ +}; + +/** Variable style constants for extracting data from variables. + * + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ + +enum _LMP_VAR_CONST { + LMP_VAR_EQUAL = 0, /*!< compatible with equal-style variables */ + LMP_VAR_ATOM = 1, /*!< compatible with atom-style variables */ + LMP_VAR_VECTOR = 2, /*!< compatible with vector-style variables */ + LMP_VAR_STRING = 3 /*!< return value will be a string (catch-all) */ }; /* @@ -65,10 +97,13 @@ extern void lammps_mpi_init(); extern void lammps_mpi_finalize(); extern void lammps_kokkos_finalize(); extern void lammps_python_finalize(); +extern void lammps_error(void *handle, int error_type, const char *error_text); + extern void lammps_file(void *handle, const char *file); extern char *lammps_command(void *handle, const char *cmd); extern void lammps_commands_list(void *handle, int ncmd, const char **cmds); extern void lammps_commands_string(void *handle, const char *str); + extern double lammps_get_natoms(void *handle); extern double lammps_get_thermo(void *handle, const char *keyword); extern void lammps_extract_box(void *handle, double *boxlo, double *boxhi, @@ -81,12 +116,16 @@ extern int lammps_get_mpi_comm(void *handle); extern int lammps_extract_setting(void *handle, const char *keyword); extern int lammps_extract_global_datatype(void *handle, const char *name); extern void *lammps_extract_global(void *handle, const char *name); + extern int lammps_extract_atom_datatype(void *handle, const char *name); extern void *lammps_extract_atom(void *handle, const char *name); + extern void *lammps_extract_compute(void *handle, char *id, int, int); extern void *lammps_extract_fix(void *handle, char *, int, int, int, int); extern void *lammps_extract_variable(void *handle, char *, char *); +extern int lammps_extract_variable_datatype(void *handle, const char *name); extern int lammps_set_variable(void *, char *, char *); + extern void lammps_gather_atoms(void *, char *, int, int, void *); extern void lammps_gather_atoms_concat(void *, char *, int, int, void *); extern void lammps_gather_atoms_subset(void *, char *, int, int, int, int *, void *); @@ -107,6 +146,7 @@ extern int lammps_find_fix_neighlist(void*, char *, int); extern int lammps_find_compute_neighlist(void*, char *, int); extern int lammps_neighlist_num_elements(void*, int); extern void lammps_neighlist_element_neighbors(void *, int, int, int *, int *, int ** ); + extern int lammps_version(void *handle); extern void lammps_get_os_info(char *buffer, int buf_size); extern int lammps_config_has_mpi_support(); @@ -151,46 +191,79 @@ extern void lammps_fix_external_set_virial_global(void *handle, const char *id extern void lammps_fix_external_set_vector_length(void *handle, const char *id, int len); extern void lammps_fix_external_set_vector(void *handle, const char *id, int idx, double val); +extern void lammps_flush_buffers(void *ptr); extern void lammps_free(void *ptr); extern int lammps_is_running(void *handle); extern void lammps_force_timeout(void *handle); extern int lammps_has_error(void *handle); extern int lammps_get_last_error_message(void *handle, char *buffer, int buf_size); +extern int lammps_python_api_version(); -extern void lammps_flush_buffers(void *ptr); %} +/** Data type constants for extracting data from atoms, computes and fixes + * + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ + enum _LMP_DATATYPE_CONST { - LAMMPS_INT = 0, /*!< 32-bit integer (array) */ - LAMMPS_INT_2D = 1, /*!< two-dimensional 32-bit integer array */ - LAMMPS_DOUBLE = 2, /*!< 64-bit double (array) */ - LAMMPS_DOUBLE_2D = 3, /*!< two-dimensional 64-bit double array */ - LAMMPS_INT64 = 4, /*!< 64-bit integer (array) */ - LAMMPS_INT64_2D = 5, /*!< two-dimensional 64-bit integer array */ - LAMMPS_STRING = 6 /*!< C-String */ + LAMMPS_INT = 0, /*!< 32-bit integer (array) */ + LAMMPS_INT_2D = 1, /*!< two-dimensional 32-bit integer array */ + LAMMPS_DOUBLE = 2, /*!< 64-bit double (array) */ + LAMMPS_DOUBLE_2D = 3, /*!< two-dimensional 64-bit double array */ + LAMMPS_INT64 = 4, /*!< 64-bit integer (array) */ + LAMMPS_INT64_2D = 5, /*!< two-dimensional 64-bit integer array */ + LAMMPS_STRING = 6 /*!< C-String */ }; /** Style constants for extracting data from computes and fixes. * - * Must be kept in sync with the equivalent constants in lammps/constants.py */ + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ enum _LMP_STYLE_CONST { - LMP_STYLE_GLOBAL=0, /*!< return global data */ - LMP_STYLE_ATOM =1, /*!< return per-atom data */ - LMP_STYLE_LOCAL =2 /*!< return local data */ + LMP_STYLE_GLOBAL = 0, /*!< return global data */ + LMP_STYLE_ATOM = 1, /*!< return per-atom data */ + LMP_STYLE_LOCAL = 2 /*!< return local data */ }; /** Type and size constants for extracting data from computes and fixes. * - * Must be kept in sync with the equivalent constants in lammps/constants.py */ + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ enum _LMP_TYPE_CONST { - LMP_TYPE_SCALAR=0, /*!< return scalar */ - LMP_TYPE_VECTOR=1, /*!< return vector */ - LMP_TYPE_ARRAY =2, /*!< return array */ - LMP_SIZE_VECTOR=3, /*!< return length of vector */ - LMP_SIZE_ROWS =4, /*!< return number of rows */ - LMP_SIZE_COLS =5 /*!< return number of columns */ + LMP_TYPE_SCALAR = 0, /*!< return scalar */ + LMP_TYPE_VECTOR = 1, /*!< return vector */ + LMP_TYPE_ARRAY = 2, /*!< return array */ + LMP_SIZE_VECTOR = 3, /*!< return length of vector */ + LMP_SIZE_ROWS = 4, /*!< return number of rows */ + LMP_SIZE_COLS = 5 /*!< return number of columns */ +}; + +/** Error codes to select the suitable function in the Error class + * + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ + +enum _LMP_ERROR_CONST { + LMP_ERROR_WARNING = 0, /*!< call Error::warning() */ + LMP_ERROR_ONE = 1, /*!< called from one MPI rank */ + LMP_ERROR_ALL = 2, /*!< called from all MPI ranks */ + LMP_ERROR_WORLD = 4, /*!< error on Comm::world */ + LMP_ERROR_UNIVERSE = 8 /*!< error on Comm::universe */ +}; + +/** Variable style constants for extracting data from variables. + * + * Must be kept in sync with the equivalent constants in src/library.h, + * python/lammps/constants.py, and fortran/lammps.f90 */ + +enum _LMP_VAR_CONST { + LMP_VAR_EQUAL = 0, /*!< compatible with equal-style variables */ + LMP_VAR_ATOM = 1, /*!< compatible with atom-style variables */ + LMP_VAR_VECTOR = 2, /*!< compatible with vector-style variables */ + LMP_VAR_STRING = 3 /*!< return value will be a string (catch-all) */ }; /* @@ -203,10 +276,13 @@ extern void lammps_mpi_init(); extern void lammps_mpi_finalize(); extern void lammps_kokkos_finalize(); extern void lammps_python_finalize(); +extern void lammps_error(void *handle, int error_type, const char *error_text); + extern void lammps_file(void *handle, const char *file); extern char *lammps_command(void *handle, const char *cmd); extern void lammps_commands_list(void *handle, int ncmd, const char **cmds); extern void lammps_commands_string(void *handle, const char *str); + extern double lammps_get_natoms(void *handle); extern double lammps_get_thermo(void *handle, const char *keyword); extern void lammps_extract_box(void *handle, double *boxlo, double *boxhi, @@ -219,12 +295,16 @@ extern int lammps_get_mpi_comm(void *handle); extern int lammps_extract_setting(void *handle, const char *keyword); extern int lammps_extract_global_datatype(void *handle, const char *name); extern void *lammps_extract_global(void *handle, const char *name); + extern int lammps_extract_atom_datatype(void *handle, const char *name); extern void *lammps_extract_atom(void *handle, const char *name); + extern void *lammps_extract_compute(void *handle, char *id, int, int); extern void *lammps_extract_fix(void *handle, char *, int, int, int, int); extern void *lammps_extract_variable(void *handle, char *, char *); +extern int lammps_extract_variable_datatype(void *handle, const char *name); extern int lammps_set_variable(void *, char *, char *); + extern void lammps_gather_atoms(void *, char *, int, int, void *); extern void lammps_gather_atoms_concat(void *, char *, int, int, void *); extern void lammps_gather_atoms_subset(void *, char *, int, int, int, int *, void *); @@ -245,6 +325,7 @@ extern int lammps_find_fix_neighlist(void*, char *, int); extern int lammps_find_compute_neighlist(void*, char *, int); extern int lammps_neighlist_num_elements(void*, int); extern void lammps_neighlist_element_neighbors(void *, int, int, int *, int *, int ** ); + extern int lammps_version(void *handle); extern void lammps_get_os_info(char *buffer, int buf_size); extern int lammps_config_has_mpi_support(); @@ -268,14 +349,20 @@ extern int lammps_id_name(void *, const char *, int, char *buffer, int buf_si extern int lammps_plugin_count(); extern int lammps_plugin_name(int, char *, char *, int); /* -extern int lammps_encode_image_flags(int ix, int iy, int iz); -extern void lammps_decode_image_flags(int image, int *flags); -extern int64_t lammps_encode_image_flags(int ix, int iy, int iz); -extern void lammps_decode_image_flags(int64_t image, int *flags); -typedef void (*FixExternalFnPtr)(void *, int64_t, int, int64_t *, double **, double **); -extern void lammps_set_fix_external_callback(void *handle, const char *id, FixExternalFnPtr funcptr, void *ptr); -extern void lammps_fix_external_set_energy_peratom(void *handle, const char *id, double *eng); -extern void lammps_fix_external_set_virial_peratom(void *handle, const char *id, double **virial); + * Have not found a good way to map these functions in a general way. + * So some individual customization for the specific use case and compilation is needed. + * + extern int lammps_encode_image_flags(int ix, int iy, int iz); + extern void lammps_decode_image_flags(int image, int *flags); + extern int64_t lammps_encode_image_flags(int ix, int iy, int iz); + extern void lammps_decode_image_flags(int64_t image, int *flags); + + * Supporting the fix external callback mechanism will require extra code specific to the application. + typedef void (*FixExternalFnPtr)(void *, int64_t, int, int64_t *, double **, double **); + extern void lammps_set_fix_external_callback(void *handle, const char *id, FixExternalFnPtr funcptr, void *ptr); + * these two functions can only be used from the callback, so we don't support them either + extern void lammps_fix_external_set_energy_peratom(void *handle, const char *id, double *eng); + extern void lammps_fix_external_set_virial_peratom(void *handle, const char *id, double **virial); */ extern double **lammps_fix_external_get_force(void *handle, const char *id); extern void lammps_fix_external_set_energy_global(void *handle, const char *id, double eng); @@ -283,12 +370,12 @@ extern void lammps_fix_external_set_virial_global(void *handle, const char *id extern void lammps_fix_external_set_vector_length(void *handle, const char *id, int len); extern void lammps_fix_external_set_vector(void *handle, const char *id, int idx, double val); +extern void lammps_flush_buffers(void *ptr); extern void lammps_free(void *ptr); extern int lammps_is_running(void *handle); extern void lammps_force_timeout(void *handle); extern int lammps_has_error(void *handle); extern int lammps_get_last_error_message(void *handle, char *buffer, int buf_size); +extern int lammps_python_api_version(); -extern void lammps_flush_buffers(void *ptr); - -/* last revised on 4 February 2022 */ +/* last revised on 3 October 2022 */ diff --git a/unittest/c-library/test_library_properties.cpp b/unittest/c-library/test_library_properties.cpp index 56c89a6c13..bbb363dfab 100644 --- a/unittest/c-library/test_library_properties.cpp +++ b/unittest/c-library/test_library_properties.cpp @@ -434,6 +434,33 @@ TEST_F(LibraryProperties, neighlist) } }; +TEST_F(LibraryProperties, has_error) +{ + // need errors to throw exceptions to be able to intercept them. + if (!lammps_config_has_exceptions()) GTEST_SKIP(); + + EXPECT_EQ(lammps_has_error(lmp), 0); + + // trigger an error, but hide output + ::testing::internal::CaptureStdout(); + lammps_command(lmp, "this_is_not_a_known_command"); + ::testing::internal::GetCapturedStdout(); + + EXPECT_EQ(lammps_has_error(lmp), 1); + + // retrieve error message + char errmsg[1024]; + int err = lammps_get_last_error_message(lmp, errmsg, 1024); + EXPECT_EQ(err, 1); + EXPECT_THAT(errmsg, HasSubstr("ERROR: Unknown command: this_is_not_a_known_command")); + + // retrieving the error message clear the error status + EXPECT_EQ(lammps_has_error(lmp), 0); + err = lammps_get_last_error_message(lmp, errmsg, 1024); + EXPECT_EQ(err, 0); + EXPECT_THAT(errmsg, StrEq("")); +}; + class AtomProperties : public ::testing::Test { protected: void *lmp; diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index a90df90fb3..70ab462053 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -50,13 +50,34 @@ if(CMAKE_Fortran_COMPILER) add_test(NAME FortranBox COMMAND test_fortran_box) add_executable(test_fortran_properties wrap_properties.cpp test_fortran_properties.f90 test_fortran_commands.f90) - target_link_libraries(test_fortran_properties PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + target_link_libraries(test_fortran_properties PRIVATE flammps lammps MPI::MPI_Fortran GTest::GMockMain) add_test(NAME FortranProperties COMMAND test_fortran_properties) add_executable(test_fortran_extract_global wrap_extract_global.cpp test_fortran_extract_global.f90) 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) + + add_executable(test_fortran_extract_compute wrap_extract_compute.cpp test_fortran_extract_compute.f90) + target_link_libraries(test_fortran_extract_compute PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranExtractCompute COMMAND test_fortran_extract_compute) + + add_executable(test_fortran_extract_fix wrap_extract_fix.cpp test_fortran_extract_fix.f90) + target_link_libraries(test_fortran_extract_fix PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranExtractFix COMMAND test_fortran_extract_fix) + + add_executable(test_fortran_extract_variable wrap_extract_variable.cpp test_fortran_extract_variable.f90) + target_compile_definitions(test_fortran_extract_variable PRIVATE -DTEST_INPUT_FOLDER=${CMAKE_CURRENT_SOURCE_DIR}) + 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/atomdata.txt b/unittest/fortran/atomdata.txt new file mode 100644 index 0000000000..83a34e9f2b --- /dev/null +++ b/unittest/fortran/atomdata.txt @@ -0,0 +1,8 @@ +3 +2 1.6 +1 5.2 +3 -1.4 + +2 +3 2.5 +1 -1.1 diff --git a/unittest/fortran/greetings.txt b/unittest/fortran/greetings.txt new file mode 100644 index 0000000000..9cccccc35d --- /dev/null +++ b/unittest/fortran/greetings.txt @@ -0,0 +1,9 @@ +hello +god_dag +hola +bonjour +guten_Tag +konnichiwa +shalom +salve +goedendag 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_box.f90 b/unittest/fortran/test_fortran_box.f90 index 2123ae0c15..164a8a97b1 100644 --- a/unittest/fortran/test_fortran_box.f90 +++ b/unittest/fortran/test_fortran_box.f90 @@ -23,7 +23,7 @@ SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close") lmp%handle = c_null_ptr END SUBROUTINE f_lammps_close -SUBROUTINE f_lammps_box_setup () BIND(C) +SUBROUTINE f_lammps_box_setup() BIND(C) USE liblammps USE keepstuff, ONLY : lmp, demo_input IMPLICIT NONE @@ -39,84 +39,84 @@ SUBROUTINE f_lammps_delete_everything() BIND(C) CALL lmp%command("delete_atoms group all"); END SUBROUTINE f_lammps_delete_everything -FUNCTION f_lammps_extract_box_xlo () BIND(C) +FUNCTION f_lammps_extract_box_xlo() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_extract_box_xlo - REAL (c_double) :: boxdim(3) + REAL(c_double) :: f_lammps_extract_box_xlo + REAL(c_double) :: boxdim(3) CALL lmp%extract_box(boxlo=boxdim) f_lammps_extract_box_xlo = boxdim(1) END FUNCTION f_lammps_extract_box_xlo -FUNCTION f_lammps_extract_box_xhi () BIND(C) +FUNCTION f_lammps_extract_box_xhi() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_extract_box_xhi - REAL (c_double) :: boxdim(3) + REAL(c_double) :: f_lammps_extract_box_xhi + REAL(c_double) :: boxdim(3) CALL lmp%extract_box(boxhi=boxdim) f_lammps_extract_box_xhi = boxdim(1) END FUNCTION f_lammps_extract_box_xhi -FUNCTION f_lammps_extract_box_ylo () BIND(C) +FUNCTION f_lammps_extract_box_ylo() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_extract_box_ylo - REAL (c_double) :: boxdim(3) + REAL(c_double) :: f_lammps_extract_box_ylo + REAL(c_double) :: boxdim(3) CALL lmp%extract_box(boxlo=boxdim) f_lammps_extract_box_ylo = boxdim(2) END FUNCTION f_lammps_extract_box_ylo -FUNCTION f_lammps_extract_box_yhi () BIND(C) +FUNCTION f_lammps_extract_box_yhi() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_extract_box_yhi - REAL (c_double) :: boxdim(3) + REAL(c_double) :: f_lammps_extract_box_yhi + REAL(c_double) :: boxdim(3) CALL lmp%extract_box(boxhi=boxdim) f_lammps_extract_box_yhi = boxdim(2) END FUNCTION f_lammps_extract_box_yhi -FUNCTION f_lammps_extract_box_zlo () BIND(C) +FUNCTION f_lammps_extract_box_zlo() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_extract_box_zlo - REAL (c_double) :: boxdim(3) + REAL(c_double) :: f_lammps_extract_box_zlo + REAL(c_double) :: boxdim(3) CALL lmp%extract_box(boxlo=boxdim) f_lammps_extract_box_zlo = boxdim(2) END FUNCTION f_lammps_extract_box_zlo -FUNCTION f_lammps_extract_box_zhi () BIND(C) +FUNCTION f_lammps_extract_box_zhi() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_extract_box_zhi - REAL (c_double) :: boxdim(3) + REAL(c_double) :: f_lammps_extract_box_zhi + REAL(c_double) :: boxdim(3) CALL lmp%extract_box(boxhi=boxdim) f_lammps_extract_box_zhi = boxdim(2) END FUNCTION f_lammps_extract_box_zhi -SUBROUTINE f_lammps_reset_box_2x () BIND(C) +SUBROUTINE f_lammps_reset_box_2x() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: newlo(3), newhi(3), xy, yz, xz + REAL(c_double) :: newlo(3), newhi(3), xy, yz, xz xy = 0.0_c_double yz = 0.0_c_double diff --git a/unittest/fortran/test_fortran_extract_atom.f90 b/unittest/fortran/test_fortran_extract_atom.f90 new file mode 100644 index 0000000000..262e5de47d --- /dev/null +++ b/unittest/fortran/test_fortran_extract_atom.f90 @@ -0,0 +1,123 @@ +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_extract_atom() BIND(C) + USE LIBLAMMPS + USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input + IMPLICIT NONE + + CALL lmp%commands_list(big_input) + CALL lmp%commands_list(cont_input) + CALL lmp%commands_list(pair_input) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + REAL(c_double) :: f_lammps_extract_atom_mass + REAL(c_double), DIMENSION(:), POINTER :: mass => NULL() + + mass = lmp%extract_atom('mass') + f_lammps_extract_atom_mass = mass(1) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + INTEGER(c_int) :: f_lammps_extract_atom_tag_int + INTEGER(c_int), DIMENSION(:), POINTER :: tag => NULL() + + tag = lmp%extract_atom('id') + f_lammps_extract_atom_tag_int = tag(i) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int64_t), INTENT(IN), VALUE :: i + INTEGER(c_int64_t) :: f_lammps_extract_atom_tag_int64 + INTEGER(c_int64_t), DIMENSION(:), POINTER :: tag => NULL() + + tag = lmp%extract_atom('id') + f_lammps_extract_atom_tag_int64 = tag(i) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + INTEGER(c_int) :: f_lammps_extract_atom_type + INTEGER(c_int), DIMENSION(:), POINTER :: atype => NULL() + + atype = lmp%extract_atom('type') + f_lammps_extract_atom_type = atype(i) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + INTEGER(c_int) :: f_lammps_extract_atom_mask + INTEGER(c_int), DIMENSION(:), POINTER :: mask => NULL() + + mask = lmp%extract_atom('mask') + f_lammps_extract_atom_mask = mask(i) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double), DIMENSION(3) :: x + REAL(c_double), DIMENSION(:,:), POINTER :: xptr => NULL() + + xptr = lmp%extract_atom('x') + x = xptr(:,i) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double), DIMENSION(3) :: v + REAL(c_double), DIMENSION(:,:), POINTER :: vptr => NULL() + + vptr = lmp%extract_atom('v') + v = vptr(:,i) +END SUBROUTINE f_lammps_extract_atom_v diff --git a/unittest/fortran/test_fortran_extract_compute.f90 b/unittest/fortran/test_fortran_extract_compute.f90 new file mode 100644 index 0000000000..e3515f2a7a --- /dev/null +++ b/unittest/fortran/test_fortran_extract_compute.f90 @@ -0,0 +1,133 @@ +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_extract_compute() BIND(C) + USE LIBLAMMPS + USE keepstuff, ONLY : lmp, big_input, cont_input, more_input, pair_input + IMPLICIT NONE + + 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 + CALL lmp%command("compute totalpe all reduce sum c_peratompe") ! global scalar + CALL lmp%command("compute COM all com") ! global vector + CALL lmp%command("compute RDF all rdf 100") ! global array + CALL lmp%command("compute pairdist all pair/local dist") ! local vector + CALL lmp%command("compute pairlocal all pair/local dist dx dy dz") ! local array + CALL lmp%command("thermo_style custom step pe c_totalpe c_COM[1]") + CALL lmp%command("run 0") ! must be here, otherwise will SEGFAULT +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double) :: f_lammps_extract_compute_peratom_vector + REAL(c_double), DIMENSION(:), POINTER :: vector => NULL() + + vector = lmp%extract_compute('peratompe', lmp%style%atom, lmp%type%vector) + f_lammps_extract_compute_peratom_vector = vector(i) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i, j + REAL(c_double) :: f_lammps_extract_compute_peratom_array + REAL(c_double), DIMENSION(:,:), POINTER :: array => NULL() + + array = lmp%extract_compute('stress', lmp%style%atom, lmp%type%array) + f_lammps_extract_compute_peratom_array = array(i,j) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + REAL(c_double) :: f_lammps_extract_compute_global_scalar + REAL(c_double), POINTER :: scalar + + scalar = lmp%extract_compute('totalpe', lmp%style%global, lmp%type%scalar) + f_lammps_extract_compute_global_scalar = scalar +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double) :: f_lammps_extract_compute_global_vector + REAL(c_double), DIMENSION(:), POINTER :: vector + + vector = lmp%extract_compute('COM', lmp%style%global, lmp%type%vector) + f_lammps_extract_compute_global_vector = vector(i) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i, j + REAL(c_double) :: f_lammps_extract_compute_global_array + REAL(c_double), DIMENSION(:,:), POINTER :: array + + array = lmp%extract_compute('RDF', lmp%style%global, lmp%type%array) + f_lammps_extract_compute_global_array = array(i,j) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double) :: f_lammps_extract_compute_local_vector + REAL(c_double), DIMENSION(:), POINTER :: vector + + vector = lmp%extract_compute('pairdist', lmp%style%local, lmp%type%vector) + f_lammps_extract_compute_local_vector = vector(i) +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 keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i, j + REAL(c_double) :: f_lammps_extract_compute_local_array + REAL(c_double), DIMENSION(:,:), POINTER :: array + + array = lmp%extract_compute('pairlocal', lmp%style%local, lmp%type%array) + f_lammps_extract_compute_local_array = array(i,j) +END FUNCTION f_lammps_extract_compute_local_array diff --git a/unittest/fortran/test_fortran_extract_fix.f90 b/unittest/fortran/test_fortran_extract_fix.f90 new file mode 100644 index 0000000000..24f90553a5 --- /dev/null +++ b/unittest/fortran/test_fortran_extract_fix.f90 @@ -0,0 +1,99 @@ +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_extract_fix() BIND(C) + USE LIBLAMMPS + USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input, more_input + IMPLICIT NONE + + 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("fix state all store/state 0 z") ! per-atom vector + CALL lmp%command("fix move all move linear 0 0 0") ! for per-atom array + CALL lmp%command("fix recenter all recenter 1 1 1") ! global scalar, vector + CALL lmp%command("variable natoms equal count(all)") + CALL lmp%command("variable ts equal step") + CALL lmp%command("fix vec all vector 1 v_natoms v_ts") ! global array + CALL lmp%command("run 1") ! must be 1, otherwise move/recenter won't happen +END SUBROUTINE f_lammps_setup_extract_fix + +FUNCTION f_lammps_extract_fix_global_scalar() BIND(C) RESULT(scalar) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + REAL(c_double) :: scalar + + scalar = lmp%extract_fix("recenter", lmp%style%global, lmp%type%scalar) +END FUNCTION f_lammps_extract_fix_global_scalar + +FUNCTION f_lammps_extract_fix_global_vector(i) BIND(C) RESULT(element) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double) :: element + + element = lmp%extract_fix("recenter", lmp%style%global, lmp%type%vector, i) +END FUNCTION f_lammps_extract_fix_global_vector + +FUNCTION f_lammps_extract_fix_global_array(i,j) BIND(C) RESULT(element) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i, j + REAL(c_double) :: element + + element = lmp%extract_fix("vec", lmp%style%global, lmp%type%array, i, j) +END FUNCTION f_lammps_extract_fix_global_array + +FUNCTION f_lammps_extract_fix_peratom_vector(i) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double) :: f_lammps_extract_fix_peratom_vector + REAL(c_double), DIMENSION(:), POINTER :: vector + + vector = lmp%extract_fix("state", lmp%style%atom, lmp%type%vector, -1, -1) + f_lammps_extract_fix_peratom_vector = vector(i) +END FUNCTION f_lammps_extract_fix_peratom_vector + +FUNCTION f_lammps_extract_fix_peratom_array(i,j) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i, j + REAL(c_double) :: f_lammps_extract_fix_peratom_array + REAL(c_double), DIMENSION(:,:), POINTER :: array + + array = lmp%extract_fix("move", lmp%style%atom, lmp%type%array, -1, -1) + f_lammps_extract_fix_peratom_array = array(i,j) +END FUNCTION f_lammps_extract_fix_peratom_array diff --git a/unittest/fortran/test_fortran_extract_global.f90 b/unittest/fortran/test_fortran_extract_global.f90 index f89087869c..5add92c1be 100644 --- a/unittest/fortran/test_fortran_extract_global.f90 +++ b/unittest/fortran/test_fortran_extract_global.f90 @@ -22,7 +22,7 @@ SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close") lmp%handle = c_null_ptr END SUBROUTINE f_lammps_close -SUBROUTINE f_lammps_setup_extract_global () BIND(C) +SUBROUTINE f_lammps_setup_extract_global() BIND(C) USE LIBLAMMPS USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input IMPLICIT NONE @@ -33,12 +33,12 @@ SUBROUTINE f_lammps_setup_extract_global () BIND(C) CALL lmp%command('run 0') END SUBROUTINE f_lammps_setup_extract_global -SUBROUTINE f_lammps_setup_full_extract_global () BIND(C) +SUBROUTINE f_lammps_setup_full_extract_global() BIND(C) USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE INTERFACE - SUBROUTINE f_lammps_setup_extract_global () BIND(C) + SUBROUTINE f_lammps_setup_extract_global() BIND(C) END SUBROUTINE f_lammps_setup_extract_global END INTERFACE @@ -50,422 +50,428 @@ SUBROUTINE f_lammps_setup_full_extract_global () BIND(C) CALL lmp%command('run 0') END SUBROUTINE f_lammps_setup_full_extract_global -FUNCTION f_lammps_extract_global_units () BIND(C) RESULT(success) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_units() BIND(C) RESULT(success) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE - INTEGER (C_int) :: success - CHARACTER (LEN=16) :: units + INTEGER(c_int) :: success + CHARACTER(LEN=16) :: units ! passing strings from Fortran to C is icky, so we do the test here and ! report the result instead units = lmp%extract_global('units') - IF ( TRIM(units) == 'lj' ) THEN - success = 1_C_int + IF (TRIM(units) == 'lj') THEN + success = 1_c_int ELSE - success = 0_C_int + success = 0_c_int END IF END FUNCTION f_lammps_extract_global_units -FUNCTION f_lammps_extract_global_ntimestep () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_ntimestep() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: ntimestep - INTEGER (C_int) :: f_lammps_extract_global_ntimestep + INTEGER(c_int), POINTER :: ntimestep + INTEGER(c_int) :: f_lammps_extract_global_ntimestep ntimestep = lmp%extract_global("ntimestep") f_lammps_extract_global_ntimestep = ntimestep END FUNCTION f_lammps_extract_global_ntimestep -FUNCTION f_lammps_extract_global_ntimestep_big () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + +FUNCTION f_lammps_extract_global_ntimestep_big() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int64_t), POINTER :: ntimestep - INTEGER (C_int64_t) :: f_lammps_extract_global_ntimestep_big + INTEGER(c_int64_t), POINTER :: ntimestep + INTEGER(c_int64_t) :: f_lammps_extract_global_ntimestep_big ntimestep = lmp%extract_global("ntimestep") f_lammps_extract_global_ntimestep_big = ntimestep END FUNCTION f_lammps_extract_global_ntimestep_big -FUNCTION f_lammps_extract_global_dt () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_dt() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double), POINTER :: dt - REAL (C_double) :: f_lammps_extract_global_dt + REAL(c_double), POINTER :: dt + REAL(c_double) :: f_lammps_extract_global_dt dt = lmp%extract_global("dt") f_lammps_extract_global_dt = dt END FUNCTION f_lammps_extract_global_dt -SUBROUTINE f_lammps_extract_global_boxlo (C_boxlo) BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +SUBROUTINE f_lammps_extract_global_boxlo(C_boxlo) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double), DIMENSION(3) :: C_boxlo - REAL (C_double), DIMENSION(:), POINTER :: boxlo + REAL(c_double), DIMENSION(3) :: C_boxlo + REAL(c_double), DIMENSION(:), POINTER :: boxlo boxlo = lmp%extract_global("boxlo") C_boxlo = boxlo END SUBROUTINE f_lammps_extract_global_boxlo -SUBROUTINE f_lammps_extract_global_boxhi (C_boxhi) BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +SUBROUTINE f_lammps_extract_global_boxhi(C_boxhi) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double), DIMENSION(3) :: C_boxhi - REAL (C_double), DIMENSION(:), POINTER :: boxhi + REAL(c_double), DIMENSION(3) :: C_boxhi + REAL(c_double), DIMENSION(:), POINTER :: boxhi boxhi = lmp%extract_global("boxhi") C_boxhi = boxhi END SUBROUTINE f_lammps_extract_global_boxhi -FUNCTION f_lammps_extract_global_boxxlo () BIND(C) RESULT(C_boxxlo) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_boxxlo() BIND(C) RESULT(C_boxxlo) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_boxxlo - REAL (C_double), POINTER :: boxxlo + REAL(c_double) :: C_boxxlo + REAL(c_double), POINTER :: boxxlo boxxlo = lmp%extract_global("boxxlo") C_boxxlo = boxxlo END FUNCTION f_lammps_extract_global_boxxlo -FUNCTION f_lammps_extract_global_boxxhi () BIND(C) RESULT(C_boxxhi) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_boxxhi() BIND(C) RESULT(C_boxxhi) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_boxxhi - REAL (C_double), POINTER :: boxxhi + REAL(c_double) :: C_boxxhi + REAL(c_double), POINTER :: boxxhi boxxhi = lmp%extract_global("boxxhi") C_boxxhi = boxxhi END FUNCTION f_lammps_extract_global_boxxhi -FUNCTION f_lammps_extract_global_boxylo () BIND(C) RESULT(C_boxylo) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_boxylo() BIND(C) RESULT(C_boxylo) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_boxylo - REAL (C_double), POINTER :: boxylo + REAL(c_double) :: C_boxylo + REAL(c_double), POINTER :: boxylo boxylo = lmp%extract_global("boxylo") C_boxylo = boxylo END FUNCTION f_lammps_extract_global_boxylo -FUNCTION f_lammps_extract_global_boxyhi () BIND(C) RESULT(C_boxyhi) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_boxyhi() BIND(C) RESULT(C_boxyhi) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_boxyhi - REAL (C_double), POINTER :: boxyhi + REAL(c_double) :: C_boxyhi + REAL(c_double), POINTER :: boxyhi boxyhi = lmp%extract_global("boxyhi") C_boxyhi = boxyhi END FUNCTION f_lammps_extract_global_boxyhi -FUNCTION f_lammps_extract_global_boxzlo () BIND(C) RESULT(C_boxzlo) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_boxzlo() BIND(C) RESULT(C_boxzlo) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_boxzlo - REAL (C_double), POINTER :: boxzlo + REAL(c_double) :: C_boxzlo + REAL(c_double), POINTER :: boxzlo boxzlo = lmp%extract_global("boxzlo") C_boxzlo = boxzlo END FUNCTION f_lammps_extract_global_boxzlo -FUNCTION f_lammps_extract_global_boxzhi () BIND(C) RESULT(C_boxzhi) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_boxzhi() BIND(C) RESULT(C_boxzhi) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_boxzhi - REAL (C_double), POINTER :: boxzhi + REAL(c_double) :: C_boxzhi + REAL(c_double), POINTER :: boxzhi boxzhi = lmp%extract_global("boxzhi") C_boxzhi = boxzhi END FUNCTION f_lammps_extract_global_boxzhi -SUBROUTINE f_lammps_extract_global_periodicity (C_periodicity) BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +SUBROUTINE f_lammps_extract_global_periodicity(C_periodicity) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), DIMENSION(3) :: C_periodicity - INTEGER (C_int), DIMENSION(:), POINTER :: periodicity + INTEGER(c_int), DIMENSION(3) :: C_periodicity + INTEGER(c_int), DIMENSION(:), POINTER :: periodicity periodicity = lmp%extract_global("periodicity") C_periodicity = periodicity END SUBROUTINE f_lammps_extract_global_periodicity -FUNCTION f_lammps_extract_global_triclinic () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_triclinic() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: triclinic - INTEGER (C_int) :: f_lammps_extract_global_triclinic + INTEGER(c_int), POINTER :: triclinic + INTEGER(c_int) :: f_lammps_extract_global_triclinic triclinic = lmp%extract_global("triclinic") f_lammps_extract_global_triclinic = triclinic END FUNCTION f_lammps_extract_global_triclinic -FUNCTION f_lammps_extract_global_xy () BIND(C) RESULT(C_xy) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_xy() BIND(C) RESULT(C_xy) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_xy - REAL (C_double), POINTER :: xy + REAL(c_double) :: C_xy + REAL(c_double), POINTER :: xy xy = lmp%extract_global("xy") C_xy = xy END FUNCTION f_lammps_extract_global_xy -FUNCTION f_lammps_extract_global_xz () BIND(C) RESULT(C_xz) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_xz() BIND(C) RESULT(C_xz) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_xz - REAL (C_double), POINTER :: xz + REAL(c_double) :: C_xz + REAL(c_double), POINTER :: xz xz = lmp%extract_global("xz") C_xz = xz END FUNCTION f_lammps_extract_global_xz -FUNCTION f_lammps_extract_global_yz () BIND(C) RESULT(C_yz) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_yz() BIND(C) RESULT(C_yz) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_yz - REAL (C_double), POINTER :: yz + REAL(c_double) :: C_yz + REAL(c_double), POINTER :: yz yz = lmp%extract_global("yz") C_yz = yz END FUNCTION f_lammps_extract_global_yz -FUNCTION f_lammps_extract_global_natoms () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_natoms() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: natoms - INTEGER (C_int) :: f_lammps_extract_global_natoms + INTEGER(c_int), POINTER :: natoms + INTEGER(c_int) :: f_lammps_extract_global_natoms natoms = lmp%extract_global("natoms") f_lammps_extract_global_natoms = natoms END FUNCTION f_lammps_extract_global_natoms -FUNCTION f_lammps_extract_global_natoms_big () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + +FUNCTION f_lammps_extract_global_natoms_big() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int64_t), POINTER :: natoms - INTEGER (C_int64_t) :: f_lammps_extract_global_natoms_big + INTEGER(c_int64_t), POINTER :: natoms + INTEGER(c_int64_t) :: f_lammps_extract_global_natoms_big natoms = lmp%extract_global("natoms") f_lammps_extract_global_natoms_big = natoms END FUNCTION f_lammps_extract_global_natoms_big -FUNCTION f_lammps_extract_global_nbonds () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_nbonds() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: nbonds - INTEGER (C_int) :: f_lammps_extract_global_nbonds + INTEGER(c_int), POINTER :: nbonds + INTEGER(c_int) :: f_lammps_extract_global_nbonds nbonds = lmp%extract_global("nbonds") f_lammps_extract_global_nbonds = nbonds END FUNCTION f_lammps_extract_global_nbonds -FUNCTION f_lammps_extract_global_nbonds_big () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + +FUNCTION f_lammps_extract_global_nbonds_big() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int64_t), POINTER :: nbonds - INTEGER (C_int64_t) :: f_lammps_extract_global_nbonds_big + INTEGER(c_int64_t), POINTER :: nbonds + INTEGER(c_int64_t) :: f_lammps_extract_global_nbonds_big nbonds = lmp%extract_global("nbonds") f_lammps_extract_global_nbonds_big = nbonds END FUNCTION f_lammps_extract_global_nbonds_big -FUNCTION f_lammps_extract_global_nangles () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_nangles() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: nangles - INTEGER (C_int) :: f_lammps_extract_global_nangles + INTEGER(c_int), POINTER :: nangles + INTEGER(c_int) :: f_lammps_extract_global_nangles nangles = lmp%extract_global("nangles") f_lammps_extract_global_nangles = nangles END FUNCTION f_lammps_extract_global_nangles -FUNCTION f_lammps_extract_global_nangles_big () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + +FUNCTION f_lammps_extract_global_nangles_big() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int64_t), POINTER :: nangles - INTEGER (C_int64_t) :: f_lammps_extract_global_nangles_big + INTEGER(c_int64_t), POINTER :: nangles + INTEGER(c_int64_t) :: f_lammps_extract_global_nangles_big nangles = lmp%extract_global("nangles") f_lammps_extract_global_nangles_big = nangles END FUNCTION f_lammps_extract_global_nangles_big -FUNCTION f_lammps_extract_global_ndihedrals () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_ndihedrals() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: ndihedrals - INTEGER (C_int) :: f_lammps_extract_global_ndihedrals + INTEGER(c_int), POINTER :: ndihedrals + INTEGER(c_int) :: f_lammps_extract_global_ndihedrals ndihedrals = lmp%extract_global("ndihedrals") f_lammps_extract_global_ndihedrals = ndihedrals END FUNCTION f_lammps_extract_global_ndihedrals -FUNCTION f_lammps_extract_global_ndihedrals_big () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + +FUNCTION f_lammps_extract_global_ndihedrals_big() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int64_t), POINTER :: ndihedrals - INTEGER (C_int64_t) :: f_lammps_extract_global_ndihedrals_big + INTEGER(c_int64_t), POINTER :: ndihedrals + INTEGER(c_int64_t) :: f_lammps_extract_global_ndihedrals_big ndihedrals = lmp%extract_global("ndihedrals") f_lammps_extract_global_ndihedrals_big = ndihedrals END FUNCTION f_lammps_extract_global_ndihedrals_big -FUNCTION f_lammps_extract_global_nimpropers () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_nimpropers() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: nimpropers - INTEGER (C_int) :: f_lammps_extract_global_nimpropers + INTEGER(c_int), POINTER :: nimpropers + INTEGER(c_int) :: f_lammps_extract_global_nimpropers nimpropers = lmp%extract_global("nimpropers") f_lammps_extract_global_nimpropers = nimpropers END FUNCTION f_lammps_extract_global_nimpropers -FUNCTION f_lammps_extract_global_nimpropers_big () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + +FUNCTION f_lammps_extract_global_nimpropers_big() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int64_t), POINTER :: nimpropers - INTEGER (C_int64_t) :: f_lammps_extract_global_nimpropers_big + INTEGER(c_int64_t), POINTER :: nimpropers + INTEGER(c_int64_t) :: f_lammps_extract_global_nimpropers_big nimpropers = lmp%extract_global("nimpropers") f_lammps_extract_global_nimpropers_big = nimpropers END FUNCTION f_lammps_extract_global_nimpropers_big -FUNCTION f_lammps_extract_global_ntypes () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_ntypes() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: ntypes - INTEGER (C_int) :: f_lammps_extract_global_ntypes + INTEGER(c_int), POINTER :: ntypes + INTEGER(c_int) :: f_lammps_extract_global_ntypes ntypes = lmp%extract_global("ntypes") f_lammps_extract_global_ntypes = ntypes END FUNCTION f_lammps_extract_global_ntypes -FUNCTION f_lammps_extract_global_nlocal () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_nlocal() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: nlocal - INTEGER (C_int) :: f_lammps_extract_global_nlocal + INTEGER(c_int), POINTER :: nlocal + INTEGER(c_int) :: f_lammps_extract_global_nlocal nlocal = lmp%extract_global("nlocal") f_lammps_extract_global_nlocal = nlocal END FUNCTION f_lammps_extract_global_nlocal -FUNCTION f_lammps_extract_global_nghost () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_nghost() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: nghost - INTEGER (C_int) :: f_lammps_extract_global_nghost + INTEGER(c_int), POINTER :: nghost + INTEGER(c_int) :: f_lammps_extract_global_nghost nghost = lmp%extract_global("nghost") f_lammps_extract_global_nghost = nghost END FUNCTION f_lammps_extract_global_nghost -FUNCTION f_lammps_extract_global_nmax () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_extract_global_nmax() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int), POINTER :: nmax - INTEGER (C_int) :: f_lammps_extract_global_nmax + INTEGER(c_int), POINTER :: nmax + INTEGER(c_int) :: f_lammps_extract_global_nmax nmax = lmp%extract_global("nmax") f_lammps_extract_global_nmax = nmax END FUNCTION f_lammps_extract_global_nmax -FUNCTION f_lammps_extract_global_boltz () BIND(C) RESULT(C_k_B) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_boltz() BIND(C) RESULT(C_k_B) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_k_B - REAL (C_double), POINTER :: k_B + REAL(c_double) :: C_k_B + REAL(c_double), POINTER :: k_B k_B = lmp%extract_global("boltz") C_k_B = k_B END FUNCTION f_lammps_extract_global_boltz -FUNCTION f_lammps_extract_global_hplanck () BIND(C) RESULT(C_h) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_hplanck() BIND(C) RESULT(C_h) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: C_h - REAL (C_double), POINTER :: h + REAL(c_double) :: C_h + REAL(c_double), POINTER :: h h = lmp%extract_global("boltz") C_h = h END FUNCTION f_lammps_extract_global_hplanck -FUNCTION f_lammps_extract_global_angstrom () BIND(C) RESULT(Angstrom) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_angstrom() BIND(C) RESULT(Angstrom) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: Angstrom - REAL (C_double), POINTER :: A + REAL(c_double) :: Angstrom + REAL(c_double), POINTER :: A A = lmp%extract_global("angstrom") Angstrom = A END FUNCTION f_lammps_extract_global_angstrom -FUNCTION f_lammps_extract_global_femtosecond () BIND(C) RESULT(fs) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +FUNCTION f_lammps_extract_global_femtosecond() BIND(C) RESULT(fs) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - REAL (C_double) :: fs - REAL (C_double), POINTER :: femtosecond + REAL(c_double) :: fs + REAL(c_double), POINTER :: femtosecond femtosecond = lmp%extract_global("femtosecond") fs = femtosecond diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 new file mode 100644 index 0000000000..c10e3eaa04 --- /dev/null +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -0,0 +1,426 @@ +MODULE keepvar + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, c_size_t, c_char + USE liblammps + IMPLICIT NONE + + INTERFACE + FUNCTION c_path_join(a, b) BIND(C) + IMPORT :: c_ptr + TYPE(c_ptr), VALUE :: a, b + TYPE(c_ptr) :: c_path_join + END FUNCTION c_path_join + + FUNCTION c_strlen(str) BIND(C,name='strlen') + IMPORT :: c_ptr, c_size_t + IMPLICIT NONE + TYPE(c_ptr), INTENT(IN), VALUE :: str + INTEGER(c_size_t) :: c_strlen + END FUNCTION c_strlen + + SUBROUTINE c_free(ptr) BIND(C,name='free') + IMPORT :: c_ptr + TYPE(c_ptr), VALUE :: ptr + END SUBROUTINE c_free + END INTERFACE + +CONTAINS + + FUNCTION absolute_path(filename) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, c_size_t, c_char, C_F_POINTER + USE keepstuff, ONLY : lmp + CHARACTER(LEN=:), ALLOCATABLE :: absolute_path + CHARACTER(LEN=*), INTENT(IN) :: filename + CHARACTER(LEN=256) :: test_input_directory + TYPE(c_ptr) :: c_test_input_directory, c_absolute_path, c_filename + CHARACTER(LEN=1,KIND=c_char), DIMENSION(:), POINTER :: F_absolute_path + INTEGER(c_size_t) :: i, length + + test_input_directory = lmp%extract_variable('input_dir') + c_test_input_directory = f2c_string(test_input_directory) + c_filename = f2c_string(filename) + c_absolute_path = c_path_join(c_test_input_directory, c_filename) + length = c_strlen(c_absolute_path) + CALL C_F_POINTER(c_absolute_path, F_absolute_path, [length]) + ALLOCATE(CHARACTER(LEN=length) :: absolute_path) + DO i = 1, length + absolute_path(i:i) = F_absolute_path(i) + END DO + CALL c_free(c_filename) + CALL c_free(c_test_input_directory) + CALL c_free(c_absolute_path) + END FUNCTION absolute_path + + FUNCTION f2c_string(f_string) RESULT(ptr) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_char, c_ptr, c_size_t, & + c_null_char, C_F_POINTER + CHARACTER(LEN=*), INTENT(IN) :: f_string + CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:) + TYPE(c_ptr) :: ptr + INTEGER(c_size_t) :: i, n + + INTERFACE + FUNCTION lammps_malloc(size) BIND(C, name='malloc') + IMPORT :: c_ptr, c_size_t + IMPLICIT NONE + INTEGER(c_size_t), VALUE :: size + TYPE(c_ptr) :: lammps_malloc + END FUNCTION lammps_malloc + END INTERFACE + + n = LEN_TRIM(f_string) + ptr = lammps_malloc(n+1) + CALL C_F_POINTER(ptr, c_string, [1]) + DO i=1, n + c_string(i) = f_string(i:i) + END DO + c_string(n+1) = c_null_char + END FUNCTION f2c_string + +END MODULE keepvar + +FUNCTION f_lammps_with_C_args(argc, argv) BIND(C) + USE ISO_C_BINDING, ONLY: c_ptr, c_char, c_int, c_size_t, C_F_POINTER + USE liblammps + USE keepstuff, ONLY: lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: argc + TYPE(c_ptr), VALUE :: argv + TYPE(c_ptr), DIMENSION(:), POINTER :: Fargv + INTEGER, PARAMETER :: ARG_LENGTH = 256 + TYPE(c_ptr) :: f_lammps_with_C_args + CHARACTER(LEN=ARG_LENGTH), DIMENSION(argc) :: args + CHARACTER(LEN=1,KIND=c_char), DIMENSION(:), POINTER :: Cstr + INTEGER(c_size_t):: i, length, j + + INTERFACE + FUNCTION c_strlen(str) BIND(C,name='strlen') + IMPORT :: c_ptr, c_size_t + IMPLICIT NONE + TYPE(c_ptr), INTENT(IN), VALUE :: str + INTEGER(c_size_t) :: c_strlen + END FUNCTION c_strlen + END INTERFACE + + CALL C_F_POINTER(argv, Fargv, [argc]) + DO i = 1, argc + args(i) = '' + length = c_strlen(Fargv(i)) + CALL C_F_POINTER(Fargv(i), Cstr, [length]) + DO j = 1, length + args(i)(j:j) = Cstr(j) + END DO + END DO + + lmp = lammps(args) + f_lammps_with_C_args = lmp%handle +END FUNCTION f_lammps_with_C_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_extract_variable() BIND(C) + USE LIBLAMMPS + USE keepstuff, ONLY : lmp, big_input, cont_input, more_input, pair_input + USE keepvar, ONLY : absolute_path + IMPLICIT NONE + + ! Had to do this one as one string because lammps_commands_list and + ! lammps_commands_string do not play well with triple quotes + CHARACTER(LEN=256), PARAMETER :: py_input = & + 'python square_it input 1 v_lp return v_py format ff here """' & + // NEW_LINE(' ') // 'def square_it(N) :' & + // NEW_LINE(' ') // ' return N*N' & + // NEW_LINE(' ') // '"""' + + 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) + CALL lmp%commands_list(pair_input) + CALL lmp%command('variable idx index "hello" "goodbye"') + CALL lmp%command('variable lp loop 10') + CALL lmp%command('variable lp_pad loop 10 pad') + CALL lmp%command('variable wld world "group1"') + CALL lmp%command('variable uni universe "universe1" "universeA"') + CALL lmp%command('variable ulp uloop 2') + CALL lmp%command('variable str string "this is a string"') + CALL lmp%command('variable ex equal exp(v_lp)') + CALL lmp%command('variable fmt format ex %.6G') + CALL lmp%command('variable fmt_pad format ex %08.6g') + CALL lmp%command('variable username getenv FORTRAN_USER') + CALL lmp%command('variable greeting file ' // absolute_path('greetings.txt')) + CALL lmp%command('variable atfile atomfile ' & + // absolute_path('atomdata.txt')) + IF (lmp%config_has_package('PYTHON')) THEN + CALL lmp%command(py_input) + CALL lmp%command('variable py python square_it') + END IF + CALL lmp%command('variable time timer') + CALL lmp%command('variable int internal 4') + CALL lmp%command('variable at_z atom z') + CALL lmp%command("compute COM all com") ! defines a global vector + CALL lmp%command("variable center vector c_COM") + ! make sure COM is computable... + CALL lmp%command("thermo_style custom step pe c_COM[1] v_center[1]") + CALL lmp%command("run 0") ! so c_COM and v_center have values +END SUBROUTINE f_lammps_setup_extract_variable + +FUNCTION f_lammps_extract_variable_index_1() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_extract_variable_index_1 + CHARACTER(LEN=256) :: str + + str = lmp%extract_variable("idx") + IF (trim(str) == 'hello') THEN + f_lammps_extract_variable_index_1 = 1_c_int + ELSE + f_lammps_extract_variable_index_1 = 0_c_int + END IF +END FUNCTION f_lammps_extract_variable_index_1 + +FUNCTION f_lammps_extract_variable_index_2() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_extract_variable_index_2 + CHARACTER(LEN=256) :: str + + str = lmp%extract_variable("idx") + IF (trim(str) == 'goodbye') THEN + f_lammps_extract_variable_index_2 = 1_c_int + ELSE + f_lammps_extract_variable_index_2 = 0_c_int + END IF +END FUNCTION f_lammps_extract_variable_index_2 + +FUNCTION f_lammps_extract_variable_loop() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_extract_variable_loop + CHARACTER(LEN=256) :: loop + + loop = lmp%extract_variable('lp') + READ(loop,*) f_lammps_extract_variable_loop +END FUNCTION f_lammps_extract_variable_loop + +FUNCTION f_lammps_extract_variable_loop_pad() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_loop_pad + CHARACTER(LEN=20) :: loop + + loop = lmp%extract_variable('lp_pad') + f_lammps_extract_variable_loop_pad = f2c_string(loop) +END FUNCTION f_lammps_extract_variable_loop_pad + +FUNCTION f_lammps_extract_variable_world() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_world + CHARACTER(LEN=20) :: world + + world = lmp%extract_variable('wld') + f_lammps_extract_variable_world = f2c_string(world) +END FUNCTION f_lammps_extract_variable_world + +FUNCTION f_lammps_extract_variable_universe() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_universe + CHARACTER(LEN=20) :: universe + + universe = lmp%extract_variable('uni') + f_lammps_extract_variable_universe = f2c_string(universe) +END FUNCTION f_lammps_extract_variable_universe + +FUNCTION f_lammps_extract_variable_uloop() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_extract_variable_uloop + CHARACTER(LEN=256) :: uloop + + uloop = lmp%extract_variable('ulp') + READ(uloop,*) f_lammps_extract_variable_uloop +END FUNCTION f_lammps_extract_variable_uloop + +FUNCTION f_lammps_extract_variable_string() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_string + CHARACTER(LEN=256) :: string + + string = lmp%extract_variable('str') + f_lammps_extract_variable_string = f2c_string(string) +END FUNCTION f_lammps_extract_variable_string + +FUNCTION f_lammps_extract_variable_format() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_format + CHARACTER(LEN=20) :: form + + form = lmp%extract_variable('fmt') + f_lammps_extract_variable_format = f2c_string(form) +END FUNCTION f_lammps_extract_variable_format + +FUNCTION f_lammps_extract_variable_format_pad() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_format_pad + CHARACTER(LEN=20) :: form + + form = lmp%extract_variable('fmt_pad') + f_lammps_extract_variable_format_pad = f2c_string(form) +END FUNCTION f_lammps_extract_variable_format_pad + +FUNCTION f_lammps_extract_variable_getenv() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_getenv + CHARACTER(LEN=40) :: string + + string = lmp%extract_variable('username') + f_lammps_extract_variable_getenv = f2c_string(string) +END FUNCTION f_lammps_extract_variable_getenv + +FUNCTION f_lammps_extract_variable_file() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_file + CHARACTER(LEN=40) :: string + + string = lmp%extract_variable('greeting') + f_lammps_extract_variable_file = f2c_string(string) +END FUNCTION f_lammps_extract_variable_file + +FUNCTION f_lammps_extract_variable_atomfile(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_extract_variable_atomfile + REAL(c_double), DIMENSION(:), ALLOCATABLE :: atom_data + + atom_data = lmp%extract_variable('atfile') + f_lammps_extract_variable_atomfile = atom_data(i) +END FUNCTION f_lammps_extract_variable_atomfile + +FUNCTION f_lammps_extract_variable_python() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + REAL(c_double) :: f_lammps_extract_variable_python + + f_lammps_extract_variable_python = lmp%extract_variable('py') +END FUNCTION f_lammps_extract_variable_python + +FUNCTION f_lammps_extract_variable_timer() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + REAL(c_double) :: f_lammps_extract_variable_timer + + f_lammps_extract_variable_timer = lmp%extract_variable('time') +END FUNCTION f_lammps_extract_variable_timer + +FUNCTION f_lammps_extract_variable_internal() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + REAL(c_double) :: f_lammps_extract_variable_internal + + f_lammps_extract_variable_internal = lmp%extract_variable('int') +END FUNCTION f_lammps_extract_variable_internal + +FUNCTION f_lammps_extract_variable_equal() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + REAL(c_double) :: f_lammps_extract_variable_equal + + f_lammps_extract_variable_equal = lmp%extract_variable('ex') +END FUNCTION f_lammps_extract_variable_equal + +FUNCTION f_lammps_extract_variable_atom(i) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double) :: f_lammps_extract_variable_atom + REAL(c_double), DIMENSION(:), ALLOCATABLE :: atom + + atom = lmp%extract_variable('at_z') ! z-coordinates + f_lammps_extract_variable_atom = atom(i) +END FUNCTION f_lammps_extract_variable_atom + +FUNCTION f_lammps_extract_variable_vector(i) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double) :: f_lammps_extract_variable_vector + REAL(c_double), DIMENSION(:), ALLOCATABLE :: vector + + vector = lmp%extract_variable('center') ! z-coordinates + f_lammps_extract_variable_vector = vector(i) +END FUNCTION f_lammps_extract_variable_vector + +SUBROUTINE f_lammps_set_variable_string() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string + IMPLICIT NONE + CHARACTER(LEN=40) :: string + + string = "this is the new string" + CALL lmp%set_variable('str', string) +END SUBROUTINE f_lammps_set_variable_string + +! vim: sts=2 ts=2 sw=2 et diff --git a/unittest/fortran/test_fortran_gather_scatter.f90 b/unittest/fortran/test_fortran_gather_scatter.f90 new file mode 100644 index 0000000000..ec1880c908 --- /dev/null +++ b/unittest/fortran/test_fortran_gather_scatter.f90 @@ -0,0 +1,201 @@ +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_atoms_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_atoms_mask + INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask + + CALL lmp%gather_atoms('mask', 1_c_int, mask) + f_lammps_gather_atoms_mask = mask(i) +END FUNCTION f_lammps_gather_atoms_mask + +FUNCTION f_lammps_gather_atoms_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_atoms_position + REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions + + CALL lmp%gather_atoms('x', 3_c_int, positions) + f_lammps_gather_atoms_position = positions(i) +END FUNCTION f_lammps_gather_atoms_position + +FUNCTION f_lammps_gather_atoms_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_atoms_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_atoms_concat_mask = mask(j) + RETURN + END IF + END DO + f_lammps_gather_atoms_concat_mask = -1 +END FUNCTION f_lammps_gather_atoms_concat_mask + +FUNCTION f_lammps_gather_atoms_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_atoms_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_atoms_concat_position = positions((j-1)*3 + xyz) + END IF + END DO +END FUNCTION f_lammps_gather_atoms_concat_position + +FUNCTION f_lammps_gather_atoms_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_atoms_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_atoms_subset_mask = mask(j) + RETURN + END IF + END DO + f_lammps_gather_atoms_subset_mask = -1 +END FUNCTION f_lammps_gather_atoms_subset_mask + +FUNCTION f_lammps_gather_atoms_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_atoms_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_atoms_subset_position = positions((j-1)*3 + xyz) + RETURN + END IF + END DO + f_lammps_gather_atoms_subset_position = -1.0D0 +END FUNCTION f_lammps_gather_atoms_subset_position + +SUBROUTINE f_lammps_scatter_atoms_masks() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: masks + INTEGER(c_int) :: swap + + CALL lmp%gather_atoms('mask', 1_c_int, masks) + + ! swap masks of atoms 1 and 3 + swap=masks(1) + masks(1) = masks(3) + masks(3) = swap + + CALL lmp%scatter_atoms('mask', masks) ! push the swap back to LAMMPS +END SUBROUTINE f_lammps_scatter_atoms_masks + +SUBROUTINE f_lammps_scatter_atoms_positions() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: tags + REAL(c_double), DIMENSION(:), ALLOCATABLE, TARGET :: xvec + REAL(c_double), DIMENSION(:,:), POINTER :: x + REAL(c_double) :: swap(3) + + CALL lmp%gather_atoms('id',1_c_int,tags) + CALL lmp%gather_atoms('x',3_c_int,xvec) + x(1:3,1:SIZE(xvec)/3) => xvec + + ! swap positions of atoms 1 and 3 + swap=x(:,1) + x(:,1) = x(:,3) + x(:,3) = swap + + CALL lmp%scatter_atoms('x', xvec) ! push the swap back to LAMMPS +END SUBROUTINE f_lammps_scatter_atoms_positions + +SUBROUTINE f_lammps_scatter_atoms_subset_mask() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double + USE LIBLAMMPS + USE keepstuff, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: all_masks + INTEGER(c_int), DIMENSION(*), PARAMETER :: tags = [3,1] + INTEGER(c_int), DIMENSION(2) :: masks + + CALL lmp%gather_atoms('mask', 1_c_int, all_masks) + + ! swap masks of atoms 1 and 3 in the new array (because 'tags' is reversed) + masks(1) = all_masks(1) + masks(2) = all_masks(3) + + CALL lmp%scatter_atoms_subset('mask', tags, masks) ! push the swap to LAMMPS +END SUBROUTINE f_lammps_scatter_atoms_subset_mask diff --git a/unittest/fortran/test_fortran_get_thermo.f90 b/unittest/fortran/test_fortran_get_thermo.f90 index d1b193e188..7911ab07d5 100644 --- a/unittest/fortran/test_fortran_get_thermo.f90 +++ b/unittest/fortran/test_fortran_get_thermo.f90 @@ -23,7 +23,7 @@ SUBROUTINE f_lammps_close() BIND(C) lmp%handle = c_null_ptr END SUBROUTINE f_lammps_close -SUBROUTINE f_lammps_get_thermo_setup () BIND(C) +SUBROUTINE f_lammps_get_thermo_setup() BIND(C) USE liblammps USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input IMPLICIT NONE @@ -33,122 +33,122 @@ SUBROUTINE f_lammps_get_thermo_setup () BIND(C) CALL lmp%commands_list(pair_input) END SUBROUTINE f_lammps_get_thermo_setup -FUNCTION f_lammps_get_thermo_natoms () BIND(C) +FUNCTION f_lammps_get_thermo_natoms() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_natoms + REAL(c_double) :: f_lammps_get_thermo_natoms f_lammps_get_thermo_natoms = lmp%get_thermo('atoms') END FUNCTION f_lammps_get_thermo_natoms -FUNCTION f_lammps_get_thermo_dt () BIND (C) +FUNCTION f_lammps_get_thermo_dt() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_dt + REAL(c_double) :: f_lammps_get_thermo_dt f_lammps_get_thermo_dt = lmp%get_thermo('dt') END FUNCTION f_lammps_get_thermo_dt -FUNCTION f_lammps_get_thermo_vol () BIND (C) +FUNCTION f_lammps_get_thermo_vol() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_vol + REAL(c_double) :: f_lammps_get_thermo_vol f_lammps_get_thermo_vol = lmp%get_thermo('vol') END FUNCTION f_lammps_get_thermo_vol -FUNCTION f_lammps_get_thermo_lx () BIND (C) +FUNCTION f_lammps_get_thermo_lx() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_lx + REAL(c_double) :: f_lammps_get_thermo_lx f_lammps_get_thermo_lx = lmp%get_thermo('lx') END FUNCTION f_lammps_get_thermo_lx -FUNCTION f_lammps_get_thermo_ly () BIND (C) +FUNCTION f_lammps_get_thermo_ly() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_ly + REAL(c_double) :: f_lammps_get_thermo_ly f_lammps_get_thermo_ly = lmp%get_thermo('ly') END FUNCTION f_lammps_get_thermo_ly -FUNCTION f_lammps_get_thermo_lz () BIND (C) +FUNCTION f_lammps_get_thermo_lz() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_lz + REAL(c_double) :: f_lammps_get_thermo_lz f_lammps_get_thermo_lz = lmp%get_thermo('lz') END FUNCTION f_lammps_get_thermo_lz -FUNCTION f_lammps_get_thermo_xlo () BIND (C) +FUNCTION f_lammps_get_thermo_xlo() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_xlo + REAL(c_double) :: f_lammps_get_thermo_xlo f_lammps_get_thermo_xlo = lmp%get_thermo('xlo') END FUNCTION f_lammps_get_thermo_xlo -FUNCTION f_lammps_get_thermo_xhi () BIND (C) +FUNCTION f_lammps_get_thermo_xhi() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_xhi + REAL(c_double) :: f_lammps_get_thermo_xhi f_lammps_get_thermo_xhi = lmp%get_thermo('xhi') END FUNCTION f_lammps_get_thermo_xhi -FUNCTION f_lammps_get_thermo_ylo () BIND (C) +FUNCTION f_lammps_get_thermo_ylo() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_ylo + REAL(c_double) :: f_lammps_get_thermo_ylo f_lammps_get_thermo_ylo = lmp%get_thermo('ylo') END FUNCTION f_lammps_get_thermo_ylo -FUNCTION f_lammps_get_thermo_yhi () BIND (C) +FUNCTION f_lammps_get_thermo_yhi() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_yhi + REAL(c_double) :: f_lammps_get_thermo_yhi f_lammps_get_thermo_yhi = lmp%get_thermo('yhi') END FUNCTION f_lammps_get_thermo_yhi -FUNCTION f_lammps_get_thermo_zlo () BIND (C) +FUNCTION f_lammps_get_thermo_zlo() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_zlo + REAL(c_double) :: f_lammps_get_thermo_zlo f_lammps_get_thermo_zlo = lmp%get_thermo('zlo') END FUNCTION f_lammps_get_thermo_zlo -FUNCTION f_lammps_get_thermo_zhi () BIND (C) +FUNCTION f_lammps_get_thermo_zhi() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (c_double) :: f_lammps_get_thermo_zhi + REAL(c_double) :: f_lammps_get_thermo_zhi f_lammps_get_thermo_zhi = lmp%get_thermo('zhi') END FUNCTION f_lammps_get_thermo_zhi diff --git a/unittest/fortran/test_fortran_properties.f90 b/unittest/fortran/test_fortran_properties.f90 index ab1c32738b..39606937a4 100644 --- a/unittest/fortran/test_fortran_properties.f90 +++ b/unittest/fortran/test_fortran_properties.f90 @@ -1,52 +1,89 @@ -FUNCTION f_lammps_version () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_version() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - INTEGER (C_int) :: f_lammps_version + INTEGER(c_int) :: f_lammps_version f_lammps_version = lmp%version() END FUNCTION f_lammps_version -SUBROUTINE f_lammps_memory_usage (meminfo) BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double +SUBROUTINE f_lammps_memory_usage(meminfo) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - REAL (C_double), DIMENSION(3), INTENT(OUT) :: meminfo + REAL(c_double), DIMENSION(3), INTENT(OUT) :: meminfo CALL lmp%memory_usage(meminfo) END SUBROUTINE f_lammps_memory_usage -FUNCTION f_lammps_get_mpi_comm () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int +FUNCTION f_lammps_get_mpi_comm() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE liblammps USE keepstuff, ONLY : lmp IMPLICIT NONE - INTEGER (C_int) :: f_lammps_get_mpi_comm + INTEGER(c_int) :: f_lammps_get_mpi_comm f_lammps_get_mpi_comm = lmp%get_mpi_comm() END FUNCTION f_lammps_get_mpi_comm -FUNCTION f_lammps_extract_setting (Cstr) BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_char +FUNCTION f_lammps_extract_setting(Cstr) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_char USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE - INTEGER (C_int) :: f_lammps_extract_setting - CHARACTER (KIND=C_char, LEN=1), DIMENSION(*), INTENT(IN) :: Cstr + INTEGER(c_int) :: f_lammps_extract_setting + CHARACTER(KIND=c_char, LEN=1), DIMENSION(*), INTENT(IN) :: Cstr INTEGER :: strlen, i - CHARACTER (LEN=:), ALLOCATABLE :: Fstr + CHARACTER(LEN=:), ALLOCATABLE :: Fstr i = 1 DO WHILE (Cstr(i) /= ACHAR(0)) i = i + 1 END DO strlen = i - allocate ( CHARACTER(LEN=strlen) :: Fstr) - FORALL (i=1:strlen) + ALLOCATE(CHARACTER(LEN=strlen) :: Fstr) + DO i = 1, strlen Fstr(i:i) = Cstr(i) - END FORALL + END DO f_lammps_extract_setting = lmp%extract_setting(Fstr) - deallocate (Fstr) + DEALLOCATE(Fstr) END FUNCTION f_lammps_extract_setting + +FUNCTION f_lammps_has_error() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE keepstuff, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_has_error + + IF (lmp%has_error()) THEN + f_lammps_has_error = 1_c_int + ELSE + f_lammps_has_error = 0_c_int + END IF +END FUNCTION f_lammps_has_error + +FUNCTION f_lammps_get_last_error_message(errmesg, errlen) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_char, c_ptr, C_F_POINTER + USE keepstuff, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_get_last_error_message + CHARACTER(KIND=c_char), DIMENSION(*) :: errmesg + INTEGER(c_int), VALUE, INTENT(IN) :: errlen + CHARACTER(LEN=:), ALLOCATABLE :: buffer + INTEGER :: status, i + + ! copy error message to buffer + ALLOCATE(CHARACTER(errlen) :: buffer) + CALL lmp%get_last_error_message(buffer, status) + f_lammps_get_last_error_message = status + ! and copy to C style string + DO i=1, errlen + errmesg(i) = buffer(i:i) + IF (buffer(i:i) == ACHAR(0)) EXIT + END DO + DEALLOCATE(buffer) +END FUNCTION f_lammps_get_last_error_message diff --git a/unittest/fortran/wrap_box.cpp b/unittest/fortran/wrap_box.cpp index 8678816658..5eb9a6b18d 100644 --- a/unittest/fortran/wrap_box.cpp +++ b/unittest/fortran/wrap_box.cpp @@ -55,10 +55,10 @@ TEST_F(LAMMPS_commands, get_thermo) EXPECT_DOUBLE_EQ(f_lammps_extract_box_zhi(), 2.0); f_lammps_delete_everything(); f_lammps_reset_box_2x(); - EXPECT_DOUBLE_EQ(f_lammps_extract_box_xlo(),-1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_xlo(), -1.0); EXPECT_DOUBLE_EQ(f_lammps_extract_box_xhi(), 3.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_box_ylo(),-1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_ylo(), -1.0); EXPECT_DOUBLE_EQ(f_lammps_extract_box_yhi(), 3.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_box_zlo(),-1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_zlo(), -1.0); EXPECT_DOUBLE_EQ(f_lammps_extract_box_zhi(), 3.0); }; diff --git a/unittest/fortran/wrap_extract_atom.cpp b/unittest/fortran/wrap_extract_atom.cpp new file mode 100644 index 0000000000..2552d6a10f --- /dev/null +++ b/unittest/fortran/wrap_extract_atom.cpp @@ -0,0 +1,120 @@ +// unit tests for extracting Atom class 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_extract_atom(); +double f_lammps_extract_atom_mass(); +int f_lammps_extract_atom_tag_int(int); +int64_t f_lammps_extract_atom_tag_int64(int64_t); +int f_lammps_extract_atom_type(int); +int f_lammps_extract_atom_mask(int); +void f_lammps_extract_atom_x(int, double *); +void f_lammps_extract_atom_v(int, double *); +} + +class LAMMPS_extract_atom : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_extract_atom() = default; + ~LAMMPS_extract_atom() 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_extract_atom, mass) +{ + f_lammps_setup_extract_atom(); + EXPECT_DOUBLE_EQ(f_lammps_extract_atom_mass(), 2.0); +}; + +TEST_F(LAMMPS_extract_atom, tag) +{ + f_lammps_setup_extract_atom(); +#if defined(LAMMPS_BIGBIG) + EXPECT_EQ(f_lammps_extract_atom_tag_int64(1l), 1l); + EXPECT_EQ(f_lammps_extract_atom_tag_int64(2l), 2l); +#else + EXPECT_EQ(f_lammps_extract_atom_tag_int(1), 1); + EXPECT_EQ(f_lammps_extract_atom_tag_int(2), 2); +#endif +}; + +TEST_F(LAMMPS_extract_atom, type) +{ + f_lammps_setup_extract_atom(); + EXPECT_EQ(f_lammps_extract_atom_type(1), 1); + EXPECT_EQ(f_lammps_extract_atom_type(2), 1); +}; + +TEST_F(LAMMPS_extract_atom, mask) +{ + f_lammps_setup_extract_atom(); + EXPECT_EQ(f_lammps_extract_atom_mask(1), 1); + EXPECT_EQ(f_lammps_extract_atom_mask(2), 1); + lammps_command(lmp, "group 1 id 1"); + lammps_command(lmp, "group 2 id 2"); + EXPECT_EQ(f_lammps_extract_atom_mask(1), 3); + EXPECT_EQ(f_lammps_extract_atom_mask(2), 5); +}; + +TEST_F(LAMMPS_extract_atom, x) +{ + f_lammps_setup_extract_atom(); + double x1[3]; + double x2[3]; + f_lammps_extract_atom_x(1, x1); + EXPECT_DOUBLE_EQ(x1[0], 1.0); + EXPECT_DOUBLE_EQ(x1[1], 1.0); + EXPECT_DOUBLE_EQ(x1[2], 1.5); + f_lammps_extract_atom_x(2, x2); + EXPECT_DOUBLE_EQ(x2[0], 0.2); + EXPECT_DOUBLE_EQ(x2[1], 0.1); + EXPECT_DOUBLE_EQ(x2[2], 0.1); +} + +TEST_F(LAMMPS_extract_atom, v) +{ + f_lammps_setup_extract_atom(); + double v1[3]; + double v2[3]; + f_lammps_extract_atom_v(1, v1); + EXPECT_DOUBLE_EQ(v1[0], 0.0); + EXPECT_DOUBLE_EQ(v1[1], 0.0); + EXPECT_DOUBLE_EQ(v1[2], 0.0); + f_lammps_extract_atom_v(2, v2); + EXPECT_DOUBLE_EQ(v2[0], 0.0); + EXPECT_DOUBLE_EQ(v2[1], 0.0); + EXPECT_DOUBLE_EQ(v2[2], 0.0); + lammps_command(lmp, "group one id 1"); + lammps_command(lmp, "velocity one set 1 2 3"); + f_lammps_extract_atom_v(1, v1); + EXPECT_DOUBLE_EQ(v1[0], 1.0); + EXPECT_DOUBLE_EQ(v1[1], 2.0); + EXPECT_DOUBLE_EQ(v1[2], 3.0); +} diff --git a/unittest/fortran/wrap_extract_compute.cpp b/unittest/fortran/wrap_extract_compute.cpp new file mode 100644 index 0000000000..5d6e8b1978 --- /dev/null +++ b/unittest/fortran/wrap_extract_compute.cpp @@ -0,0 +1,168 @@ +// unit tests for extracting compute 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_extract_compute(); +double f_lammps_extract_compute_peratom_vector(int); +double f_lammps_extract_compute_peratom_array(int, int); +double f_lammps_extract_compute_global_scalar(); +double f_lammps_extract_compute_global_vector(int); +double f_lammps_extract_compute_global_array(int, int); +double f_lammps_extract_compute_local_vector(int); +double f_lammps_extract_compute_local_array(int, int); +} + +class LAMMPS_extract_compute : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_extract_compute() = default; + ~LAMMPS_extract_compute() 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_extract_compute, peratom_vector) +{ + f_lammps_setup_extract_compute(); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_vector(1), -0.599703102447981); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_vector(2), 391.817623795857); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_vector(3), 391.430665759871); +}; + +TEST_F(LAMMPS_extract_compute, peratom_array) +{ + f_lammps_setup_extract_compute(); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(1, 1), 0.8837067009319107); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(2, 1), 0.3588584939803668); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(3, 1), 1.2799807127711049); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(4, 1), 0.20477632346642258); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(5, 1), 0.400429511840588); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(6, 1), 0.673995757699694); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(1, 2), -1070.0291234709418); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(2, 2), -1903.651817128683); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(3, 2), -1903.5121520875714); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(4, 2), -1427.867483013); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(5, 2), -1427.8560790941347); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_peratom_array(6, 2), -1903.5971655908565); +}; + +TEST_F(LAMMPS_extract_compute, global_scalar) +{ + f_lammps_setup_extract_compute(); + double *scalar; + scalar = (double *)lammps_extract_compute(lmp, "totalpe", LMP_STYLE_GLOBAL, LMP_TYPE_SCALAR); + // EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_scalar(), 782.64858645328); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_scalar(), *scalar); +}; + +TEST_F(LAMMPS_extract_compute, global_vector) +{ + f_lammps_setup_extract_compute(); + double *vector; + vector = (double *)lammps_extract_compute(lmp, "COM", LMP_STYLE_GLOBAL, LMP_TYPE_VECTOR); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_vector(1), vector[0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_vector(2), vector[1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_vector(3), vector[2]); +}; + +TEST_F(LAMMPS_extract_compute, global_array) +{ + f_lammps_setup_extract_compute(); + double **array; + array = (double **)lammps_extract_compute(lmp, "RDF", LMP_STYLE_GLOBAL, LMP_TYPE_ARRAY); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_array(1, 1), array[0][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_array(2, 1), array[0][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_array(1, 2), array[1][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_array(2, 2), array[1][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_array(1, 3), array[2][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_global_array(1, 4), array[3][0]); +}; +TEST_F(LAMMPS_extract_compute, local_vector) +{ + f_lammps_setup_extract_compute(); + double *vector; + vector = (double *)lammps_extract_compute(lmp, "pairdist", LMP_STYLE_LOCAL, LMP_TYPE_VECTOR); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(1), vector[0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(2), vector[1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(3), vector[2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(4), vector[3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(5), vector[4]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(6), vector[5]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(7), vector[6]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(8), vector[7]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(9), vector[8]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_vector(10), vector[9]); +}; + +TEST_F(LAMMPS_extract_compute, local_array) +{ + f_lammps_setup_extract_compute(); + double **array; + array = (double **)lammps_extract_compute(lmp, "pairlocal", LMP_STYLE_LOCAL, LMP_TYPE_ARRAY); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 1), array[0][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 1), array[0][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 1), array[0][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 1), array[0][3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 2), array[1][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 2), array[1][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 2), array[1][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 2), array[1][3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 3), array[2][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 3), array[2][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 3), array[2][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 3), array[2][3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 4), array[3][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 4), array[3][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 4), array[3][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 4), array[3][3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 5), array[4][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 5), array[4][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 5), array[4][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 5), array[4][3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 6), array[5][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 6), array[5][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 6), array[5][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 6), array[5][3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 7), array[6][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 7), array[6][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 7), array[6][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 7), array[6][3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 8), array[7][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 8), array[7][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 8), array[7][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 8), array[7][3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 9), array[8][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 9), array[8][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 9), array[8][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 9), array[8][3]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(1, 10), array[9][0]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(2, 10), array[9][1]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(3, 10), array[9][2]); + EXPECT_DOUBLE_EQ(f_lammps_extract_compute_local_array(4, 10), array[9][3]); +}; diff --git a/unittest/fortran/wrap_extract_fix.cpp b/unittest/fortran/wrap_extract_fix.cpp new file mode 100644 index 0000000000..bbb535c1e7 --- /dev/null +++ b/unittest/fortran/wrap_extract_fix.cpp @@ -0,0 +1,107 @@ +// unit tests for extracting compute data from a LAMMPS instance through the +// Fortran wrapper +#include + +#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_extract_fix(); +double f_lammps_extract_fix_global_scalar(); +double f_lammps_extract_fix_global_vector(int); +double f_lammps_extract_fix_global_array(int, int); +double f_lammps_extract_fix_peratom_vector(int); +double f_lammps_extract_fix_peratom_array(int, int); +double f_lammps_extract_fix_local_vector(int); +double f_lammps_extract_fix_local_array(int, int); +} + +class LAMMPS_extract_fix : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_extract_fix() = default; + ~LAMMPS_extract_fix() 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_extract_fix, global_scalar) +{ + f_lammps_setup_extract_fix(); + double *scalar = + (double *)lammps_extract_fix(lmp, "recenter", LMP_STYLE_GLOBAL, LMP_TYPE_SCALAR, -1, -1); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_global_scalar(), *scalar); + lammps_free(scalar); +}; + +TEST_F(LAMMPS_extract_fix, global_vector) +{ + f_lammps_setup_extract_fix(); + double *x = + (double *)lammps_extract_fix(lmp, "recenter", LMP_STYLE_GLOBAL, LMP_TYPE_VECTOR, 0, -1); + double *y = + (double *)lammps_extract_fix(lmp, "recenter", LMP_STYLE_GLOBAL, LMP_TYPE_VECTOR, 1, -1); + double *z = + (double *)lammps_extract_fix(lmp, "recenter", LMP_STYLE_GLOBAL, LMP_TYPE_VECTOR, 2, -1); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_global_vector(1), *x); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_global_vector(2), *y); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_global_vector(3), *z); + lammps_free(x); + lammps_free(y); + lammps_free(z); +}; + +TEST_F(LAMMPS_extract_fix, global_array) +{ + f_lammps_setup_extract_fix(); + double natoms = lammps_get_natoms(lmp); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_global_array(1, 1), natoms); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_global_array(1, 2), natoms); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_global_array(2, 1), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_global_array(2, 2), 1.0); +}; + +TEST_F(LAMMPS_extract_fix, peratom_vector) +{ + f_lammps_setup_extract_fix(); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_vector(1), 1.5); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_vector(2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_vector(3), 0.5); +}; + +TEST_F(LAMMPS_extract_fix, peratom_array) +{ + f_lammps_setup_extract_fix(); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_array(1, 1), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_array(2, 1), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_array(3, 1), 1.5); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_array(1, 2), 0.2); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_array(2, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_array(3, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_array(1, 3), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_array(2, 3), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_extract_fix_peratom_array(3, 3), 0.5); +}; diff --git a/unittest/fortran/wrap_extract_global.cpp b/unittest/fortran/wrap_extract_global.cpp index adf3986073..bf442279a1 100644 --- a/unittest/fortran/wrap_extract_global.cpp +++ b/unittest/fortran/wrap_extract_global.cpp @@ -3,10 +3,10 @@ #include "lammps.h" #include "library.h" +#include +#include #include #include -#include -#include #include "gtest/gtest.h" @@ -78,100 +78,100 @@ protected: TEST_F(LAMMPS_extract_global, units) { - f_lammps_setup_extract_global(); - EXPECT_EQ(f_lammps_extract_global_units(), 1); + f_lammps_setup_extract_global(); + EXPECT_EQ(f_lammps_extract_global_units(), 1); }; TEST_F(LAMMPS_extract_global, ntimestep) { - f_lammps_setup_extract_global(); + f_lammps_setup_extract_global(); #ifdef LAMMPS_SMALLSMALL - EXPECT_EQ(f_lammps_extract_global_ntimestep(), 0); + EXPECT_EQ(f_lammps_extract_global_ntimestep(), 0); #else - EXPECT_EQ(f_lammps_extract_global_ntimestep_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_ntimestep_big(), 0l); #endif }; TEST_F(LAMMPS_extract_global, dt) { - f_lammps_setup_extract_global(); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_dt(), 0.005); + f_lammps_setup_extract_global(); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_dt(), 0.005); }; TEST_F(LAMMPS_extract_global, boxprops) { - f_lammps_setup_extract_global(); - double boxlo[3], boxhi[3]; - f_lammps_extract_global_boxlo(boxlo); - EXPECT_DOUBLE_EQ(boxlo[0], 0.0); - EXPECT_DOUBLE_EQ(boxlo[1], 0.0); - EXPECT_DOUBLE_EQ(boxlo[2], 0.0); - f_lammps_extract_global_boxhi(boxhi); - EXPECT_DOUBLE_EQ(boxhi[0], 2.0); - EXPECT_DOUBLE_EQ(boxhi[1], 3.0); - EXPECT_DOUBLE_EQ(boxhi[2], 4.0); + f_lammps_setup_extract_global(); + double boxlo[3], boxhi[3]; + f_lammps_extract_global_boxlo(boxlo); + EXPECT_DOUBLE_EQ(boxlo[0], 0.0); + EXPECT_DOUBLE_EQ(boxlo[1], 0.0); + EXPECT_DOUBLE_EQ(boxlo[2], 0.0); + f_lammps_extract_global_boxhi(boxhi); + EXPECT_DOUBLE_EQ(boxhi[0], 2.0); + EXPECT_DOUBLE_EQ(boxhi[1], 3.0); + EXPECT_DOUBLE_EQ(boxhi[2], 4.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxxlo(), 0.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxxhi(), 2.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxylo(), 0.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxyhi(), 3.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxzlo(), 0.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxzhi(), 4.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxxlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxxhi(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxylo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxyhi(), 3.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxzlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxzhi(), 4.0); - int periodicity[3]; - f_lammps_extract_global_periodicity(periodicity); - EXPECT_EQ(periodicity[0], 1); - EXPECT_EQ(periodicity[1], 1); - EXPECT_EQ(periodicity[2], 1); + int periodicity[3]; + f_lammps_extract_global_periodicity(periodicity); + EXPECT_EQ(periodicity[0], 1); + EXPECT_EQ(periodicity[1], 1); + EXPECT_EQ(periodicity[2], 1); - EXPECT_EQ(f_lammps_extract_global_triclinic(), 0); + EXPECT_EQ(f_lammps_extract_global_triclinic(), 0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_xy(), 0.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_yz(), 0.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_xz(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_xy(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_yz(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_xz(), 0.0); }; TEST_F(LAMMPS_extract_global, atomprops) { - f_lammps_setup_extract_global(); + f_lammps_setup_extract_global(); #ifdef LAMMPS_SMALLSMALL - EXPECT_EQ(f_lammps_extract_global_natoms(), 2); - EXPECT_EQ(f_lammps_extract_global_nbonds(), 0); - EXPECT_EQ(f_lammps_extract_global_nangles(), 0); - EXPECT_EQ(f_lammps_extract_global_ndihedrals(), 0); + EXPECT_EQ(f_lammps_extract_global_natoms(), 2); + EXPECT_EQ(f_lammps_extract_global_nbonds(), 0); + EXPECT_EQ(f_lammps_extract_global_nangles(), 0); + EXPECT_EQ(f_lammps_extract_global_ndihedrals(), 0); #else - EXPECT_EQ(f_lammps_extract_global_natoms_big(), 2l); - EXPECT_EQ(f_lammps_extract_global_nbonds_big(), 0l); - EXPECT_EQ(f_lammps_extract_global_nangles_big(), 0l); - EXPECT_EQ(f_lammps_extract_global_ndihedrals_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_natoms_big(), 2l); + EXPECT_EQ(f_lammps_extract_global_nbonds_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_nangles_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_ndihedrals_big(), 0l); #endif - EXPECT_EQ(f_lammps_extract_global_ntypes(), 1); - EXPECT_EQ(f_lammps_extract_global_nlocal(), 2); - EXPECT_EQ(f_lammps_extract_global_nghost(), 41); - EXPECT_EQ(f_lammps_extract_global_nmax(), 16384); + EXPECT_EQ(f_lammps_extract_global_ntypes(), 1); + EXPECT_EQ(f_lammps_extract_global_nlocal(), 2); + EXPECT_EQ(f_lammps_extract_global_nghost(), 41); + EXPECT_EQ(f_lammps_extract_global_nmax(), 16384); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_boltz(), 1.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_hplanck(), 1.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_angstrom(), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boltz(), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_hplanck(), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_angstrom(), 1.0); - EXPECT_DOUBLE_EQ(f_lammps_extract_global_femtosecond(), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_femtosecond(), 1.0); }; TEST_F(LAMMPS_extract_global, fullprops) { - if (! lammps_has_style(lmp, "atom", "full")) GTEST_SKIP(); - // This is not currently the world's most convincing test.... - f_lammps_setup_full_extract_global(); + if (!lammps_has_style(lmp, "atom", "full")) GTEST_SKIP(); + // This is not currently the world's most convincing test.... + f_lammps_setup_full_extract_global(); #ifdef LAMMPS_SMALLSMALL - EXPECT_EQ(f_lammps_extract_global_natoms(), 2); - EXPECT_EQ(f_lammps_extract_global_nbonds(), 0); - EXPECT_EQ(f_lammps_extract_global_nangles(), 0); - EXPECT_EQ(f_lammps_extract_global_ndihedrals(), 0); + EXPECT_EQ(f_lammps_extract_global_natoms(), 2); + EXPECT_EQ(f_lammps_extract_global_nbonds(), 0); + EXPECT_EQ(f_lammps_extract_global_nangles(), 0); + EXPECT_EQ(f_lammps_extract_global_ndihedrals(), 0); #else - EXPECT_EQ(f_lammps_extract_global_natoms_big(), 2l); - EXPECT_EQ(f_lammps_extract_global_nbonds_big(), 0l); - EXPECT_EQ(f_lammps_extract_global_nangles_big(), 0l); - EXPECT_EQ(f_lammps_extract_global_ndihedrals_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_natoms_big(), 2l); + EXPECT_EQ(f_lammps_extract_global_nbonds_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_nangles_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_ndihedrals_big(), 0l); #endif } diff --git a/unittest/fortran/wrap_extract_variable.cpp b/unittest/fortran/wrap_extract_variable.cpp new file mode 100644 index 0000000000..1082a381bb --- /dev/null +++ b/unittest/fortran/wrap_extract_variable.cpp @@ -0,0 +1,283 @@ +// unit tests for extracting compute data from a LAMMPS instance through the +// Fortran wrapper + +#include "lammps.h" +#include "library.h" +#include "platform.h" + +#include +#include +#include +#include +#include +#include +#include +#include + +#include "gtest/gtest.h" + +#define STRINGIFY(val) XSTR(val) +#define XSTR(val) #val + +// prototypes for Fortran reverse wrapper functions +extern "C" { +void *f_lammps_with_c_args(int, char **); +void f_lammps_close(); +void f_lammps_setup_extract_variable(); +int f_lammps_extract_variable_index_1(); +int f_lammps_extract_variable_index_2(); +int f_lammps_extract_variable_loop(); +char *f_lammps_extract_variable_loop_pad(); +char *f_lammps_extract_variable_world(); +char *f_lammps_extract_variable_universe(); +int f_lammps_extract_variable_uloop(); +char *f_lammps_extract_variable_string(); +char *f_lammps_extract_variable_format(); +char *f_lammps_extract_variable_format_pad(); +char *f_lammps_extract_variable_getenv(); +char *f_lammps_extract_variable_file(); +double f_lammps_extract_variable_atomfile(int); +double f_lammps_extract_variable_python(); +double f_lammps_extract_variable_timer(); +double f_lammps_extract_variable_internal(); +double f_lammps_extract_variable_equal(); +double f_lammps_extract_variable_atom(int); +double f_lammps_extract_variable_vector(int); +void f_lammps_set_variable_string(); +char *c_path_join(const char *, const char *); +} + +char *c_path_join(const char *a, const char *b) +{ + std::string A = a; + std::string B = b; + std::string C = LAMMPS_NS::platform::path_join(A, B); + size_t length = C.length() + 1; + char *retval = (char *)malloc(length * sizeof(char)); + C.copy(retval, length); + retval[length - 1] = '\0'; + return retval; +} + +constexpr char input_dir[] = STRINGIFY(TEST_INPUT_FOLDER); +class LAMMPS_extract_variable : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_extract_variable() = default; + ~LAMMPS_extract_variable() override = default; + + void SetUp() override + { + // clang-format off + const char *args[] = + { "LAMMPS_Fortran_test", "-l", "none", "-echo", "screen", "-nocite", + "-var", "input_dir", input_dir, "-var", "zpos", "1.5", "-var", "x", "2" }; + // clang-format on + char **argv = (char **)args; + int argc = sizeof(args) / sizeof(const char *); + ::testing::internal::CaptureStdout(); + lmp = (LAMMPS_NS::LAMMPS *)f_lammps_with_c_args(argc, argv); + + 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_extract_variable, index) +{ + f_lammps_setup_extract_variable(); + EXPECT_EQ(f_lammps_extract_variable_index_1(), 1); + EXPECT_EQ(f_lammps_extract_variable_index_2(), 0); + lammps_command(lmp, "next idx"); + EXPECT_EQ(f_lammps_extract_variable_index_1(), 0); + EXPECT_EQ(f_lammps_extract_variable_index_2(), 1); +}; + +TEST_F(LAMMPS_extract_variable, loop) +{ + f_lammps_setup_extract_variable(); + int i; + for (i = 1; i <= 10; i++) { + EXPECT_EQ(f_lammps_extract_variable_loop(), i); + lammps_command(lmp, "next lp"); + } +}; + +TEST_F(LAMMPS_extract_variable, loop_pad) +{ + f_lammps_setup_extract_variable(); + int i; + char str[10]; + char *fstr; + for (i = 1; i <= 10; i++) { + std::sprintf(str, "%02d", i); + fstr = f_lammps_extract_variable_loop_pad(); + EXPECT_STREQ(fstr, str); + std::free(fstr); + lammps_command(lmp, "next lp_pad"); + } +}; + +TEST_F(LAMMPS_extract_variable, world) +{ + f_lammps_setup_extract_variable(); + char *fstr = f_lammps_extract_variable_world(); + EXPECT_STREQ(fstr, "group1"); + std::free(fstr); +}; + +TEST_F(LAMMPS_extract_variable, universe) +{ + f_lammps_setup_extract_variable(); + char *fstr = f_lammps_extract_variable_universe(); + EXPECT_STREQ(fstr, "universe1"); + std::free(fstr); +}; + +TEST_F(LAMMPS_extract_variable, uloop) +{ + f_lammps_setup_extract_variable(); + EXPECT_EQ(f_lammps_extract_variable_uloop(), 1); +}; + +TEST_F(LAMMPS_extract_variable, string) +{ + f_lammps_setup_extract_variable(); + char *fstr = f_lammps_extract_variable_string(); + EXPECT_STREQ(fstr, "this is a string"); + std::free(fstr); + f_lammps_set_variable_string(); + fstr = f_lammps_extract_variable_string(); + EXPECT_STREQ(fstr, "this is the new string"); + std::free(fstr); +}; + +TEST_F(LAMMPS_extract_variable, format) +{ + f_lammps_setup_extract_variable(); + int i; + char str[16]; + char *fstr; + for (i = 1; i <= 10; i++) { + std::sprintf(str, "%.6G", std::exp(i)); + fstr = f_lammps_extract_variable_format(); + EXPECT_STREQ(fstr, str); + std::free(fstr); + lammps_command(lmp, "next lp"); + } +}; + +TEST_F(LAMMPS_extract_variable, format_pad) +{ + f_lammps_setup_extract_variable(); + int i; + char str[16]; + char *fstr; + for (i = 1; i <= 10; i++) { + std::sprintf(str, "%08.6G", std::exp(i)); + fstr = f_lammps_extract_variable_format_pad(); + EXPECT_STREQ(fstr, str); + std::free(fstr); + lammps_command(lmp, "next lp"); + } +}; + +TEST_F(LAMMPS_extract_variable, getenv) +{ + LAMMPS_NS::platform::putenv("FORTRAN_USER=myuser"); + f_lammps_setup_extract_variable(); + char *env = std::getenv("FORTRAN_USER"); + char *fenv = f_lammps_extract_variable_getenv(); + EXPECT_STREQ(fenv, env); + std::free(fenv); +}; + +TEST_F(LAMMPS_extract_variable, file) +{ + f_lammps_setup_extract_variable(); + int i; + const char *str[9] = {"hello", "god_dag", "hola", "bonjour", "guten_Tag", + "konnichiwa", "shalom", "salve", "goedendag"}; + char *fstr; + for (i = 0; i < 9; i++) { + fstr = f_lammps_extract_variable_file(); + EXPECT_STREQ(fstr, str[i]); + std::free(fstr); + lammps_command(lmp, "next greeting"); + } +}; + +TEST_F(LAMMPS_extract_variable, atomfile) +{ + f_lammps_setup_extract_variable(); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_atomfile(1), 5.2); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_atomfile(2), 1.6); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_atomfile(3), -1.4); + lammps_command(lmp, "next atfile"); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_atomfile(1), -1.1); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_atomfile(2), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_atomfile(3), 2.5); +}; + +TEST_F(LAMMPS_extract_variable, python) +{ + if (lammps_config_has_package("PYTHON")) { + f_lammps_setup_extract_variable(); + for (int i = 1; i <= 10; i++) { + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_python(), static_cast(i * i)); + lammps_command(lmp, "next lp"); + } + } +}; + +TEST_F(LAMMPS_extract_variable, timer) +{ + f_lammps_setup_extract_variable(); + double initial_t, final_t; + initial_t = f_lammps_extract_variable_timer(); + std::this_thread::sleep_for(std::chrono::milliseconds(100)); + lammps_command(lmp, "variable time timer"); // update the time + final_t = f_lammps_extract_variable_timer(); + EXPECT_GT(final_t, initial_t + 0.1); +}; + +TEST_F(LAMMPS_extract_variable, internal) +{ + f_lammps_setup_extract_variable(); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_internal(), 4.0); +}; + +TEST_F(LAMMPS_extract_variable, equal) +{ + f_lammps_setup_extract_variable(); + int i; + for (i = 1; i <= 10; i++) { + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_equal(), std::exp(static_cast(i))); + lammps_command(lmp, "next lp"); + } +}; + +TEST_F(LAMMPS_extract_variable, atom) +{ + f_lammps_setup_extract_variable(); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_atom(1), 1.5); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_atom(2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_atom(3), 0.5); +}; + +TEST_F(LAMMPS_extract_variable, vector) +{ + f_lammps_setup_extract_variable(); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_vector(1), (1 + 0.2 + 0.5) / 3.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_vector(2), (1 + 0.1 + 0.5) / 3.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_variable_vector(3), (1.5 + 0.1 + 0.5) / 3.0); +}; diff --git a/unittest/fortran/wrap_gather_scatter.cpp b/unittest/fortran/wrap_gather_scatter.cpp new file mode 100644 index 0000000000..3b70c4393e --- /dev/null +++ b/unittest/fortran/wrap_gather_scatter.cpp @@ -0,0 +1,202 @@ +// 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_atoms_mask(int); +double f_lammps_gather_atoms_position(int); +int f_lammps_gather_atoms_concat_mask(int); +double f_lammps_gather_atoms_concat_position(int, int); +int f_lammps_gather_atoms_subset_mask(int); +double f_lammps_gather_atoms_subset_position(int, int); +void f_lammps_scatter_atoms_masks(); +void f_lammps_scatter_atoms_positions(); +} + +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_atoms_masks) +{ + if (lammps_extract_setting(nullptr, "tagint") == 8) GTEST_SKIP(); + f_lammps_setup_gather_scatter(); + EXPECT_EQ(f_lammps_gather_atoms_mask(1), 1); + EXPECT_EQ(f_lammps_gather_atoms_mask(2), 1); + EXPECT_EQ(f_lammps_gather_atoms_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_atoms_mask(1), 3); + EXPECT_EQ(f_lammps_gather_atoms_mask(2), 5); + EXPECT_EQ(f_lammps_gather_atoms_mask(3), 9); + lammps_command(lmp, "group other id 1"); + EXPECT_EQ(f_lammps_gather_atoms_mask(1), 7); + EXPECT_EQ(f_lammps_gather_atoms_mask(2), 5); + EXPECT_EQ(f_lammps_gather_atoms_mask(3), 9); +}; + +TEST_F(LAMMPS_gather_scatter, gather_atoms_positions) +{ + if (lammps_extract_setting(nullptr, "tagint") == 8) GTEST_SKIP(); + f_lammps_setup_gather_scatter(); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_position(1), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_position(2), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_position(3), 1.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_position(4), 0.2); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_position(5), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_position(6), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_position(7), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_position(8), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_position(9), 0.5); +}; + +TEST_F(LAMMPS_gather_scatter, gather_atoms_concat_masks) +{ + if (lammps_extract_setting(nullptr, "tagint") == 8) GTEST_SKIP(); + f_lammps_setup_gather_scatter(); + EXPECT_EQ(f_lammps_gather_atoms_concat_mask(1), 1); + EXPECT_EQ(f_lammps_gather_atoms_concat_mask(2), 1); + EXPECT_EQ(f_lammps_gather_atoms_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_atoms_concat_mask(1), 3); + EXPECT_EQ(f_lammps_gather_atoms_concat_mask(2), 5); + EXPECT_EQ(f_lammps_gather_atoms_concat_mask(3), 9); + lammps_command(lmp, "group other id 1"); + EXPECT_EQ(f_lammps_gather_atoms_concat_mask(1), 7); + EXPECT_EQ(f_lammps_gather_atoms_concat_mask(2), 5); + EXPECT_EQ(f_lammps_gather_atoms_concat_mask(3), 9); +}; + +TEST_F(LAMMPS_gather_scatter, gather_atoms_concat_positions) +{ + if (lammps_extract_setting(nullptr, "tagint") == 8) GTEST_SKIP(); + f_lammps_setup_gather_scatter(); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(1, 1), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(2, 1), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(3, 1), 1.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(1, 2), 0.2); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(2, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(3, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(1, 3), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(2, 3), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(3, 3), 0.5); +}; + +TEST_F(LAMMPS_gather_scatter, gather_atoms_subset_masks) +{ + if (lammps_extract_setting(nullptr, "tagint") == 8) GTEST_SKIP(); + f_lammps_setup_gather_scatter(); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_mask(2), 1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_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_DOUBLE_EQ(f_lammps_gather_atoms_subset_mask(2), 5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_mask(3), 9); + lammps_command(lmp, "group other id 3"); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_mask(2), 5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_mask(3), 13); +}; + +TEST_F(LAMMPS_gather_scatter, gather_atoms_subset_positions) +{ + if (lammps_extract_setting(nullptr, "tagint") == 8) GTEST_SKIP(); + f_lammps_setup_gather_scatter(); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_position(1, 2), 0.2); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_position(2, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_position(3, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_position(1, 3), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_position(2, 3), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_subset_position(3, 3), 0.5); +}; + +TEST_F(LAMMPS_gather_scatter, scatter_atoms_masks) +{ + if (lammps_extract_setting(nullptr, "tagint") == 8) GTEST_SKIP(); + f_lammps_setup_gather_scatter(); + lammps_command(lmp, "group special id 1"); + lammps_command(lmp, "group other id 2"); + lammps_command(lmp, "group spiffy id 3"); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_mask(1), 3); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_mask(2), 5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_mask(3), 9); + f_lammps_scatter_atoms_masks(); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_mask(1), 9); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_mask(2), 5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_mask(3), 3); +}; + +TEST_F(LAMMPS_gather_scatter, scatter_atoms_positions) +{ + if (lammps_extract_setting(nullptr, "tagint") == 8) GTEST_SKIP(); + f_lammps_setup_gather_scatter(); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(1, 1), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(2, 1), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(3, 1), 1.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(1, 2), 0.2); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(2, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(3, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(1, 3), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(2, 3), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(3, 3), 0.5); + f_lammps_scatter_atoms_positions(); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(1, 3), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(2, 3), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(3, 3), 1.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(1, 2), 0.2); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(2, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(3, 2), 0.1); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(1, 1), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(2, 1), 0.5); + EXPECT_DOUBLE_EQ(f_lammps_gather_atoms_concat_position(3, 1), 0.5); +}; + +TEST_F(LAMMPS_gather_scatter, scatter_atoms_subset_mask) +{ + if (lammps_extract_setting(nullptr, "tagint") == 8) GTEST_SKIP(); + f_lammps_setup_gather_scatter(); + EXPECT_EQ(f_lammps_gather_atoms_mask(1), 1); + EXPECT_EQ(f_lammps_gather_atoms_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_atoms_mask(1), 3); + EXPECT_EQ(f_lammps_gather_atoms_mask(3), 9); + f_lammps_scatter_atoms_masks(); + EXPECT_EQ(f_lammps_gather_atoms_mask(1), 9); + EXPECT_EQ(f_lammps_gather_atoms_mask(3), 3); +}; diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp index c3c86964a5..5268548d48 100644 --- a/unittest/fortran/wrap_properties.cpp +++ b/unittest/fortran/wrap_properties.cpp @@ -2,9 +2,10 @@ #include "lammps.h" #include "library.h" -#include + #include +#include "gmock/gmock.h" #include "gtest/gtest.h" // prototypes for fortran reverse wrapper functions @@ -12,24 +13,30 @@ extern "C" { void *f_lammps_with_args(); void f_lammps_close(); int f_lammps_version(); -void f_lammps_memory_usage(double*); +void f_lammps_memory_usage(double *); int f_lammps_get_mpi_comm(); -int f_lammps_extract_setting(const char*); +int f_lammps_extract_setting(const char *); +int f_lammps_has_error(); +int f_lammps_get_last_error_message(char *, int); } +namespace LAMMPS_NS { + +using ::testing::ContainsRegex; + class LAMMPS_properties : public ::testing::Test { protected: - LAMMPS_NS::LAMMPS *lmp; - LAMMPS_properties() = default; - ~LAMMPS_properties() override = default; + LAMMPS *lmp; void SetUp() override { ::testing::internal::CaptureStdout(); - lmp = (LAMMPS_NS::LAMMPS *)f_lammps_with_args(); + lmp = (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(); @@ -47,10 +54,10 @@ TEST_F(LAMMPS_properties, version) TEST_F(LAMMPS_properties, memory_usage) { -// copied from c-library, with a two-character modification - double meminfo[3]; - f_lammps_memory_usage(meminfo); - EXPECT_GT(meminfo[0], 0.0); + // copied from c-library, with a two-character modification + double meminfo[3]; + f_lammps_memory_usage(meminfo); + EXPECT_GT(meminfo[0], 0.0); #if defined(__linux__) || defined(_WIN32) EXPECT_GE(meminfo[1], 0.0); #endif @@ -61,11 +68,11 @@ TEST_F(LAMMPS_properties, memory_usage) TEST_F(LAMMPS_properties, get_mpi_comm) { - int f_comm = f_lammps_get_mpi_comm(); - if ( lammps_config_has_mpi_support() ) - EXPECT_GE(f_comm, 0); - else - EXPECT_EQ(f_comm, -1); + int f_comm = f_lammps_get_mpi_comm(); + if (lammps_config_has_mpi_support()) + EXPECT_GE(f_comm, 0); + else + EXPECT_EQ(f_comm, -1); }; TEST_F(LAMMPS_properties, extract_setting) @@ -104,5 +111,34 @@ TEST_F(LAMMPS_properties, extract_setting) EXPECT_EQ(f_lammps_extract_setting("mu_flag"), 0); EXPECT_EQ(f_lammps_extract_setting("rmass_flag"), 0); EXPECT_EQ(f_lammps_extract_setting("UNKNOWN"), -1); - }; + +TEST_F(LAMMPS_properties, has_error) +{ + // need errors to throw exceptions to be able to intercept them. + if (!lammps_config_has_exceptions()) GTEST_SKIP(); + + EXPECT_EQ(f_lammps_has_error(), lammps_has_error(lmp)); + EXPECT_EQ(f_lammps_has_error(), 0); + + // trigger an error, but hide output + ::testing::internal::CaptureStdout(); + lammps_command(lmp, "this_is_not_a_known_command"); + ::testing::internal::GetCapturedStdout(); + + EXPECT_EQ(f_lammps_has_error(), lammps_has_error(lmp)); + EXPECT_EQ(f_lammps_has_error(), 1); + + // retrieve error message + char errmsg[1024]; + int err = f_lammps_get_last_error_message(errmsg, 1023); + EXPECT_EQ(err, 1); + EXPECT_THAT(errmsg, ContainsRegex(".*ERROR: Unknown command: this_is_not_a_known_command.*")); + + // retrieving the error message clear the error status + EXPECT_EQ(f_lammps_has_error(), 0); + err = f_lammps_get_last_error_message(errmsg, 1023); + EXPECT_EQ(err, 0); + EXPECT_THAT(errmsg, ContainsRegex(" ")); +}; +} // namespace LAMMPS_NS diff --git a/unittest/tools/test_lammps_shell.py b/unittest/tools/test_lammps_shell.py index 15cb259f84..2a55be0a4e 100644 --- a/unittest/tools/test_lammps_shell.py +++ b/unittest/tools/test_lammps_shell.py @@ -138,7 +138,7 @@ class LammpsShell(unittest.TestCase): for line in lines: if line.startswith('LAMMPS Shell>'): break idx += 1 - + self.assertEqual(lines[idx+4],"dimension 2") self.assertEqual(lines[idx+6],"units real") self.assertEqual(lines[idx+8],"dimension 2") diff --git a/unittest/utils/testshared.c b/unittest/utils/testshared.c index 869be91c2a..12922dea91 100644 --- a/unittest/utils/testshared.c +++ b/unittest/utils/testshared.c @@ -16,5 +16,5 @@ double some_double_function(double arg1, int arg2) return sum; } - - + +