From aff5200ded78c5b29c6fea1faf5a994f3393937a Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Thu, 22 Sep 2022 19:16:15 -0500 Subject: [PATCH 01/49] Implemented extract_atom, updated docs, added some unit tests --- doc/src/Fortran.rst | 124 +++++++++++++++++++++++++------- fortran/lammps.f90 | 110 ++++++++++++++++++++++++++-- unittest/fortran/CMakeLists.txt | 4 ++ 3 files changed, 210 insertions(+), 28 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 28436c813f..74863d484b 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -179,7 +179,6 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :f c_ptr handle: reference to the LAMMPS class :f subroutine close: :f:func:`close` - :f function version: :f:func:`version` :f subroutine file: :f:func:`file` :f subroutine command: :f:func:`command` :f subroutine commands_list: :f:func:`commands_list` @@ -191,6 +190,8 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :f subroutine memory_usage: :f:func:`memory_usage` :f function extract_setting: :f:func:`extract_setting` :f function extract_global: :f:func:`extract_global` + :f function version: :f:func:`version` + :f function is_running: :f:func:`is_running` -------- @@ -223,10 +224,10 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. .. code-block:: Fortran PROGRAM testmpi - USE LIBLAMMPS - USE 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 Procedures Bound to the lammps Derived Type @@ -236,18 +237,11 @@ Procedures Bound to the lammps Derived Type This method will close down the LAMMPS instance through calling :cpp:func:`lammps_close`. If the *finalize* argument is present and - has a value of ``.true.``, then this subroutine also calls + has a value of ``.TRUE.``, then this subroutine also calls :cpp:func:`lammps_mpi_finalize`. - :o logical finalize [optional]: shut down the MPI environment of the LAMMPS library if true. - --------- - -.. f:function:: version() - - This method returns the numeric LAMMPS version like :cpp:func:`lammps_version` - - :r integer: LAMMPS version + :o logical finalize [optional]: shut down the MPI environment of the LAMMPS + library if true. -------- @@ -422,8 +416,8 @@ Procedures Bound to the lammps Derived Type associates the pointer on the left side of the assignment to point to internal LAMMPS data (with the exception of string data, which are copied and returned as ordinary Fortran strings). Pointers must be of the - correct data type to point to said data (typically INTEGER(c_int), - INTEGER(c_int64_t), or REAL(c_double)) and have compatible kind and rank. + correct data type to point to said data (typically integer(C_int), + integer(C_int64_t), or real(C_double)) and have compatible kind and rank. The pointer being associated with LAMMPS data is type-, kind-, and rank-checked at run-time via an overloaded assignment operator. The pointers returned by this function are generally persistent; therefore @@ -436,7 +430,7 @@ Procedures Bound to the lammps Derived Type .. code-block:: fortran PROGRAM demo - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_int64_t, C_double USE LIBLAMMPS TYPE(lammps) :: lmp INTEGER(C_int), POINTER :: nlocal @@ -457,13 +451,15 @@ Procedures Bound to the lammps Derived Type the size of the current time step, and the units being used into the variables *nlocal*, *ntimestep*, *dt*, and *units*, respectively. - *Note*: if this function returns a string, the string must have - 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. + .. note:: - :p character(len=\*) name: string with the name of the extracted property + If :f:func:`extract_global` returns a string, the string must have length + greater than or equal to the length of the string (not including the + terminal ``NULL`` character) that LAMMPS returns. If the variable's + length is too short, the string will be truncated. As usual in Fortran, + strings are padded with spaces at the end. + + :p character(len=\*) name: string with the name of the property to extract :r polymorphic: pointer to LAMMPS data. The left-hand side of the assignment should be either a string (if expecting string data) or a C-interoperable pointer (e.g., ``INTEGER (c_int), POINTER :: nlocal``) to the extracted @@ -477,3 +473,83 @@ Procedures Bound to the lammps Derived Type to use a LAMMPS input command that sets or changes these parameters. Those will take care of all side effects and necessary updates of settings derived from such settings. + +-------- + +.. f:function:: extract_atom(name) + + This function calls :c:func:`lammps_extract_atom` and returns a pointer to + LAMMPS data tied to the :cpp:class:`Atom` class, depending on the data + requested through *name*. + + Note that this function actually does not return a pointer, but rather + associates the pointer on the left side of the assignment to point + to internal LAMMPS data. Pointers must be of the correct type, kind, and + rank (e.g., integer(C_int), dimension(:) for "type" or "mask"; + integer(C_int64_t), dimension(:) for "tag", assuming LAMMPS was not compiled + with the -DLAMMPS_SMALL_SMALL flag; real(C_double), dimension(:,:) for "x" + or "f"; and so forth). The pointer being associated with LAMMPS data is + type-, kind-, and rank-checked at run-time. Pointers returned by this + function are generally persistent; therefore, it is not necessary to call + the function again unless the underlying LAMMPS data are destroyed, such as + through the :doc:`clear` command. + + :p character(len=\*) name: string with the name of the property to extract + :r polymorphic: pointer to LAMMPS data. The left-hand side of the assignment + should be a C-interoperable pointer + (e.g., ``INTEGER (c_int), POINTER :: mask``) to the extracted + property. If expecting vector data, the pointer should have dimension ":"; + if expecting matrix data, the pointer should have dimension ":,:". + + .. note:: + + Two-dimensional arrays returned from :f:func:`extract_atom` will be + **transposed** from equivalent arrays in C, and they will be indexed + from 1 instead of 0. For example, in C, + + .. code-block:: C + + void *lmp; + double **x; + /* more code to setup, etc. */ + x = lammps_extract_atom(lmp, "x"); + printf("%f\n", x[5][1]); + + will print the *y*-coordinate of the sixth atom on this processor. + Conversely, + + .. code-block:: Fortran + + TYPE(lammps) :: lmp + REAL(C_double), DIMENSION(:,:), POINTER :: x + ! more code to setup, etc. + x = lmp%extract_atom("x") + print '(f0.6)', x(2,6) + + will print the *y*-coordinate of the third atom on this processor + (note the transposition of the two indices). This is not a choice, but + rather a consequence of the different conventions adopted by the Fortran + and C standards decades ago. + + If you would like the indices to start at 0 instead of 1 (which follows + typical notation in C and C++, but not Fortran), you can create another + pointer and associate it thus: + + .. code-block:: Fortran + + REAL(C_double), DIMENSION(:,:), POINTER :: x, x0 + x = lmp%extract_atom("x") + x0(0:,0:) => x + + The above would cause the dimensions of *x* to be (1:3, 1:nlocal) + and those of *x0* to be (0:2, 0:nlocal-1). + +-------- + +.. f:function:: version() + + This method returns the numeric LAMMPS version like + :cpp:func:`lammps_version` does. + + :r integer: LAMMPS version + diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 7541bf7c0f..322d54687c 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -68,6 +68,7 @@ MODULE LIBLAMMPS PROCEDURE :: get_mpi_comm => lmp_get_mpi_comm PROCEDURE :: extract_setting => lmp_extract_setting PROCEDURE :: extract_global => lmp_extract_global + PROCEDURE :: extract_atom => lmp_extract_atom PROCEDURE :: version => lmp_version PROCEDURE :: is_running => lmp_is_running END TYPE lammps @@ -94,6 +95,7 @@ MODULE LIBLAMMPS INTEGER(c_int64_t), DIMENSION(:), POINTER :: i64_vec REAL(c_double), POINTER :: r64 REAL(c_double), DIMENSION(:), POINTER :: r64_vec + REAL(c_double), DIMENSION(:,:), POINTER :: r64_mat CHARACTER(LEN=:), ALLOCATABLE :: str END TYPE lammps_data @@ -105,8 +107,9 @@ MODULE LIBLAMMPS ! LAMMPS data (after checking type-compatibility) INTERFACE ASSIGNMENT(=) MODULE PROCEDURE assign_int_to_lammps_data, assign_int64_to_lammps_data, & - assign_intvec_to_lammps_data, & + assign_intvec_to_lammps_data, assign_int64vec_to_lammps_data, & assign_double_to_lammps_data, assign_doublevec_to_lammps_data, & + assign_doublemat_to_lammps_data, & assign_string_to_lammps_data END INTERFACE @@ -246,9 +249,19 @@ MODULE LIBLAMMPS TYPE(c_ptr) :: lammps_extract_global END FUNCTION lammps_extract_global - !INTEGER (c_int) FUNCTION lammps_extract_atom_datatype + FUNCTION lammps_extract_atom_datatype(handle, name) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, name + INTEGER(c_int) :: lammps_extract_atom_datatype + END FUNCTION lammps_extract_atom_datatype - !(generic) lammps_extract_atom + FUNCTION lammps_extract_atom(handle, name) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, name + TYPE(c_ptr) :: lammps_extract_atom + END FUNCTION lammps_extract_atom !(generic) lammps_extract_compute @@ -632,6 +645,72 @@ CONTAINS END SELECT END FUNCTION + ! equivalent function to lammps_extract_atom + ! the assignment is actually overloaded so as to bind the pointers to + ! lammps data based on the information available from LAMMPS + FUNCTION lmp_extract_atom (self, name) RESULT (peratom_data) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(lammps_data) :: peratom_data + + INTEGER(c_int) :: datatype + TYPE(c_ptr) :: Cname, Cptr + INTEGER(c_int) :: ntypes, nmax + INTEGER :: nrows, ncols + REAL(c_double), DIMENSION(:), POINTER :: dummy + TYPE(c_ptr), DIMENSION(:), POINTER :: Catomptr + + nmax = lmp_extract_setting(self, 'nmax') + ntypes = lmp_extract_setting(self, 'ntypes') + Cname = f2c_string(name) + datatype = lammps_extract_atom_datatype(self%handle, Cname) + Cptr = lammps_extract_atom(self%handle, Cname) + CALL lammps_free(Cname) + + SELECT CASE (name) + CASE ('mass') + ncols = ntypes + 1 + nrows = 1 + CASE ('x','v','f','mu','omega','torque','angmom') + ncols = nmax + nrows = 3 + CASE DEFAULT + ncols = nmax + nrows = 1 + END SELECT + + SELECT CASE (datatype) + CASE (LAMMPS_INT) + peratom_data%datatype = DATA_INT_1D + CALL C_F_POINTER(Cptr, peratom_data%i32_vec, [ncols]) + CASE (LAMMPS_INT64) + peratom_data%datatype = DATA_INT64_1D + CALL C_F_POINTER(Cptr, peratom_data%i64_vec, [ncols]) + CASE (LAMMPS_DOUBLE) + peratom_data%datatype = DATA_DOUBLE_1D + IF ( name == 'mass' ) THEN + CALL C_F_POINTER(Cptr, dummy, [ncols]) + peratom_data%r64_vec(0:) => dummy + ELSE + CALL C_F_POINTER(Cptr, peratom_data%r64_vec, [ncols]) + END IF + CASE (LAMMPS_DOUBLE_2D) + peratom_data%datatype = DATA_DOUBLE_2D + ! First, we dereference the void** pointer to point to the void* + CALL C_F_POINTER(Cptr, Catomptr, [ncols]) + ! Catomptr(1) now points to the first element of the array + CALL C_F_POINTER(Catomptr(1), peratom_data%r64_mat, [nrows,ncols]) + CASE (-1) + WRITE(ERROR_UNIT,'(A)') 'ERROR: per-atom property "' // name // & + '" not found.' + STOP 2 + CASE DEFAULT + WRITE(ERROR_UNIT,'(A,I0,A)') 'ERROR: return value ', datatype, & + ' from lammps_extract_atom_datatype not known' + STOP 1 + END SELECT + END FUNCTION lmp_extract_atom + ! equivalent function to lammps_version() INTEGER FUNCTION lmp_version(self) CLASS(lammps) :: self @@ -682,6 +761,17 @@ CONTAINS END IF END SUBROUTINE assign_intvec_to_lammps_data + SUBROUTINE assign_int64vec_to_lammps_data (lhs, rhs) + INTEGER(c_int64_t), DIMENSION(:), INTENT(OUT), POINTER :: lhs + CLASS(lammps_data), INTENT(IN) :: rhs + + IF ( rhs%datatype == DATA_INT64_1D ) THEN + lhs => rhs%i64_vec + ELSE + CALL assignment_error(rhs%datatype, 'vector of long ints') + END IF + END SUBROUTINE assign_int64vec_to_lammps_data + SUBROUTINE assign_double_to_lammps_data (lhs, rhs) REAL(c_double), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs @@ -704,6 +794,17 @@ CONTAINS END IF END SUBROUTINE assign_doublevec_to_lammps_data + SUBROUTINE assign_doublemat_to_lammps_data (lhs, rhs) + REAL(c_double), DIMENSION(:,:), INTENT(OUT), POINTER :: lhs + CLASS(lammps_data), INTENT(IN) :: rhs + + IF ( rhs%datatype == DATA_DOUBLE_2D ) THEN + lhs => rhs%r64_mat + ELSE + CALL assignment_error(rhs%datatype, 'matrix of doubles') + END IF + END SUBROUTINE assign_doublemat_to_lammps_data + SUBROUTINE assign_string_to_lammps_data (lhs, rhs) CHARACTER(LEN=*), INTENT(OUT) :: lhs CLASS(lammps_data), INTENT(IN) :: rhs @@ -743,7 +844,8 @@ CONTAINS CASE DEFAULT str1 = 'that type' END SELECT - WRITE (ERROR_UNIT,'(A)') 'Cannot associate ' // str1 // ' with ' // type2 + WRITE (ERROR_UNIT,'(A)') 'ERROR (Fortran API): cannot associate ' & + // str1 // ' with ' // type2 STOP ERROR_CODE END SUBROUTINE assignment_error diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index c2bea82480..fea9d6aae9 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -57,6 +57,10 @@ if(CMAKE_Fortran_COMPILER) target_link_libraries(test_fortran_extract_global PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) add_test(NAME FortranExtractGlobal COMMAND test_fortran_extract_global) + add_executable(test_fortran_extract_atom wrap_extract_atom.cpp test_fortran_extract_atom.f90) + target_link_libraries(test_fortran_extract_atom PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranExtractAtom COMMAND test_fortran_extract_atom) + else() message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler") endif() From ae4404201f779adbdf55292a29c71a4b6306b84f Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Thu, 22 Sep 2022 19:55:10 -0500 Subject: [PATCH 02/49] Forgot to add the unit test files to the commit.... --- .../fortran/test_fortran_extract_atom.f90 | 130 ++++++++++++++++++ unittest/fortran/wrap_extract_atom.cpp | 99 +++++++++++++ 2 files changed, 229 insertions(+) create mode 100644 unittest/fortran/test_fortran_extract_atom.f90 create mode 100644 unittest/fortran/wrap_extract_atom.cpp diff --git a/unittest/fortran/test_fortran_extract_atom.f90 b/unittest/fortran/test_fortran_extract_atom.f90 new file mode 100644 index 0000000000..d3a49c56ec --- /dev/null +++ b/unittest/fortran/test_fortran_extract_atom.f90 @@ -0,0 +1,130 @@ +MODULE keepatom + USE liblammps + TYPE(LAMMPS) :: lmp + CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & + [ 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) :: & + 'create_atoms 1 single &', & + ' 0.2 0.1 0.1' ] + 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 2.0' ] +END MODULE keepatom + +FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") + USE ISO_C_BINDING, ONLY: c_ptr + USE liblammps + USE keepatom, 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 keepatom, 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 keepatom, ONLY : lmp, demo_input, cont_input, pair_input + IMPLICIT NONE + + CALL lmp%commands_list(demo_input) + CALL lmp%commands_list(cont_input) + CALL lmp%commands_list(pair_input) +! CALL lmp%command('run 0') +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 keepatom, ONLY : lmp + IMPLICIT NONE + REAL(C_double) :: f_lammps_extract_atom_mass + REAL(C_double), DIMENSION(:), POINTER :: mass + + 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 keepatom, 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 + + 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 keepatom, 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 + + 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 keepatom, 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 + + 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 keepatom, 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 + + 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 keepatom, ONLY : lmp + IMPLICIT NONE + INTEGER(C_int), INTENT(IN), VALUE :: i + REAL(C_double), DIMENSION(3) :: x + REAL(C_double), DIMENSION(:,:), POINTER :: xptr + + xptr = lmp%extract_atom('x') + x = xptr(:,i) +END SUBROUTINE f_lammps_extract_atom_x diff --git a/unittest/fortran/wrap_extract_atom.cpp b/unittest/fortran/wrap_extract_atom.cpp new file mode 100644 index 0000000000..7cc5ff396f --- /dev/null +++ b/unittest/fortran/wrap_extract_atom.cpp @@ -0,0 +1,99 @@ +// unit tests for extracting Atom class data from a LAMMPS instance through the +// Fortran wrapper + +#include "lammps.h" +#include "library.h" +#include "lmptype.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*); +} + +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(); +#ifdef 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); +} From 5f5397f61b332d8cba97866b0196e0723a73f7be Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Thu, 22 Sep 2022 22:23:31 -0500 Subject: [PATCH 03/49] Added unit tests for x and v --- .../fortran/test_fortran_extract_atom.f90 | 25 ++++++++++++++----- unittest/fortran/wrap_extract_atom.cpp | 23 ++++++++++++++++- 2 files changed, 41 insertions(+), 7 deletions(-) diff --git a/unittest/fortran/test_fortran_extract_atom.f90 b/unittest/fortran/test_fortran_extract_atom.f90 index d3a49c56ec..5f899f80e0 100644 --- a/unittest/fortran/test_fortran_extract_atom.f90 +++ b/unittest/fortran/test_fortran_extract_atom.f90 @@ -58,7 +58,7 @@ FUNCTION f_lammps_extract_atom_mass () BIND(C) USE keepatom, ONLY : lmp IMPLICIT NONE REAL(C_double) :: f_lammps_extract_atom_mass - REAL(C_double), DIMENSION(:), POINTER :: mass + REAL(C_double), DIMENSION(:), POINTER :: mass => NULL() mass = lmp%extract_atom('mass') f_lammps_extract_atom_mass = mass(1) @@ -71,7 +71,7 @@ FUNCTION f_lammps_extract_atom_tag_int (i) BIND(C) IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i INTEGER(C_int) :: f_lammps_extract_atom_tag_int - INTEGER(C_int), DIMENSION(:), POINTER :: tag + INTEGER(C_int), DIMENSION(:), POINTER :: tag => NULL() tag = lmp%extract_atom('id') f_lammps_extract_atom_tag_int = tag(i) @@ -84,7 +84,7 @@ FUNCTION f_lammps_extract_atom_tag_int64 (i) BIND(C) 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 + INTEGER(C_int64_t), DIMENSION(:), POINTER :: tag => NULL() tag = lmp%extract_atom('id') f_lammps_extract_atom_tag_int64 = tag(i) @@ -97,7 +97,7 @@ FUNCTION f_lammps_extract_atom_type(i) BIND(C) IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i INTEGER(C_int) :: f_lammps_extract_atom_type - INTEGER(C_int), DIMENSION(:), POINTER :: atype + INTEGER(C_int), DIMENSION(:), POINTER :: atype => NULL() atype = lmp%extract_atom('type') f_lammps_extract_atom_type = atype(i) @@ -110,7 +110,7 @@ FUNCTION f_lammps_extract_atom_mask(i) BIND(C) IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i INTEGER(C_int) :: f_lammps_extract_atom_mask - INTEGER(C_int), DIMENSION(:), POINTER :: mask + INTEGER(C_int), DIMENSION(:), POINTER :: mask => NULL() mask = lmp%extract_atom('mask') f_lammps_extract_atom_mask = mask(i) @@ -123,8 +123,21 @@ SUBROUTINE f_lammps_extract_atom_x (i, x) BIND(C) IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i REAL(C_double), DIMENSION(3) :: x - REAL(C_double), DIMENSION(:,:), POINTER :: xptr + 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 keepatom, 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/wrap_extract_atom.cpp b/unittest/fortran/wrap_extract_atom.cpp index 7cc5ff396f..17116b11b9 100644 --- a/unittest/fortran/wrap_extract_atom.cpp +++ b/unittest/fortran/wrap_extract_atom.cpp @@ -3,7 +3,6 @@ #include "lammps.h" #include "library.h" -#include "lmptype.h" #include #include #include @@ -22,6 +21,7 @@ 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 { @@ -97,3 +97,24 @@ TEST_F(LAMMPS_extract_atom, x) 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); +} From ac0080f2df60a4572c807c26be37d3912b167e23 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 23 Sep 2022 07:20:49 -0500 Subject: [PATCH 04/49] Reintroduced some stashed doc edits --- doc/src/Fortran.rst | 56 +++++++++++++++++++++------------------------ 1 file changed, 26 insertions(+), 30 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 74863d484b..7039762bf8 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -76,7 +76,6 @@ the optional logical argument set to ``.true.``. Here is a simple example: PRINT*, 'LAMMPS Version: ', lmp%version() ! delete LAMMPS instance (and shuts down MPI) CALL lmp%close(.true.) - END PROGRAM testlib It is also possible to pass command line flags from Fortran to C/C++ and @@ -111,7 +110,6 @@ version of the previous example: ! delete LAMMPS instance (and shuts down MPI) CALL lmp%close(.TRUE.) DEALLOCATE(command_args) - END PROGRAM testlib2 -------------------- @@ -160,7 +158,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 --------------- @@ -430,21 +427,21 @@ Procedures Bound to the lammps Derived Type .. code-block:: fortran PROGRAM demo - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_int64_t, C_double - 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 + 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.) END PROGRAM demo would extract the number of atoms on this processor, the current time step, @@ -468,11 +465,11 @@ Procedures Bound to the lammps Derived Type .. 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 + 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. - Those will take care of all side effects and necessary updates of - settings derived from such settings. + Using an input command will take care of all side effects and necessary + updates of settings derived from such settings. -------- @@ -485,9 +482,9 @@ Procedures Bound to the lammps Derived Type Note that this function actually does not return a pointer, but rather associates the pointer on the left side of the assignment to point to internal LAMMPS data. Pointers must be of the correct type, kind, and - rank (e.g., integer(C_int), dimension(:) for "type" or "mask"; - integer(C_int64_t), dimension(:) for "tag", assuming LAMMPS was not compiled - with the -DLAMMPS_SMALL_SMALL flag; real(C_double), dimension(:,:) for "x" + 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 @@ -496,8 +493,8 @@ Procedures Bound to the lammps Derived Type :p character(len=\*) name: string with the name of the property to extract :r polymorphic: pointer to LAMMPS data. The left-hand side of the assignment - should be a C-interoperable pointer - (e.g., ``INTEGER (c_int), POINTER :: mask``) to the extracted + 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 ":,:". @@ -541,8 +538,8 @@ Procedures Bound to the lammps Derived Type x = lmp%extract_atom("x") x0(0:,0:) => x - The above would cause the dimensions of *x* to be (1:3, 1:nlocal) - and those of *x0* to be (0:2, 0:nlocal-1). + 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). -------- @@ -552,4 +549,3 @@ Procedures Bound to the lammps Derived Type :cpp:func:`lammps_version` does. :r integer: LAMMPS version - From cc0fc01d1c2aae9a3c6a448de49ebedd76ba655f Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 23 Sep 2022 16:23:51 -0500 Subject: [PATCH 05/49] Implemented extract_compute and started writing unit test for it --- fortran/lammps.f90 | 160 ++++++++++++++---- .../fortran/test_fortran_extract_compute.f90 | 149 ++++++++++++++++ 2 files changed, 275 insertions(+), 34 deletions(-) create mode 100644 unittest/fortran/test_fortran_extract_compute.f90 diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 322d54687c..dc9393699f 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -42,7 +42,7 @@ 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) + ! 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 @@ -50,10 +50,30 @@ MODULE LIBLAMMPS 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_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) + + ! "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 + TYPE(lammps_style) :: style + TYPE(lammps_type) :: type CONTAINS PROCEDURE :: close => lmp_close PROCEDURE :: file => lmp_file @@ -69,6 +89,8 @@ MODULE LIBLAMMPS 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 :: version => lmp_version PROCEDURE :: is_running => lmp_is_running END TYPE lammps @@ -104,7 +126,7 @@ MODULE LIBLAMMPS ! 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_int64vec_to_lammps_data, & @@ -157,29 +179,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 @@ -187,83 +209,89 @@ 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') 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 FUNCTION lammps_extract_atom_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_atom_datatype END FUNCTION lammps_extract_atom_datatype FUNCTION lammps_extract_atom(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_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 @@ -413,11 +441,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) @@ -432,7 +468,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 @@ -443,7 +479,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 @@ -454,7 +490,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 @@ -477,7 +513,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 @@ -711,16 +747,72 @@ CONTAINS 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) :: self + CHARACTER(LEN=*), INTENT(IN) :: id + INTEGER(c_int), INTENT(IN) :: style, type + TYPE(lammps_data) :: compute_data + + INTEGER(c_int) :: datatype + TYPE(c_ptr) :: Cid, Cptr, Ctemp + INTEGER :: nrows, ncols, length + INTEGER(c_int), POINTER :: temp + + Cid = f2c_string(id) + Cptr = lammps_extract_compute(self%handle, Cid, style, type) + + ! Remember that rows and columns in C are transposed in Fortran! + SELECT CASE (type) + CASE (LMP_TYPE_SCALAR) + length = 1 + nrows = 1 + ncols = 1 + CALL C_F_POINTER(Cptr, compute_data%r64) + CASE (LMP_TYPE_VECTOR) + 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) + IF (style == LMP_STYLE_ATOM) THEN + nrows = self%extract_setting('nmax') + Ctemp = lammps_extract_compute(self%handle,Cid,style,LMP_SIZE_ROWS) + CALL C_F_POINTER(Ctemp, temp) + ncols = 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 + CALL C_F_POINTER(Cptr, compute_data%r64_mat, [nrows, ncols]) + CASE DEFAULT + WRITE(ERROR_UNIT,'(A,I0,A)') 'ERROR: unknown type value ', type, & + 'passed to extract_compute' + STOP 1 + END SELECT + CALL lammps_free(Cid) + END FUNCTION lmp_extract_compute + ! 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_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 ) END FUNCTION lmp_is_running diff --git a/unittest/fortran/test_fortran_extract_compute.f90 b/unittest/fortran/test_fortran_extract_compute.f90 new file mode 100644 index 0000000000..091572ace3 --- /dev/null +++ b/unittest/fortran/test_fortran_extract_compute.f90 @@ -0,0 +1,149 @@ +MODULE keepcompute + USE liblammps + TYPE(LAMMPS) :: lmp + CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & + [ 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) :: & + 'create_atoms 1 single &', & + ' 0.2 0.1 0.1' ] + 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 2.0' ] +END MODULE keepcompute + +FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") + USE ISO_C_BINDING, ONLY: c_ptr + USE liblammps + USE keepatom, 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 keepatom, 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 keepatom, ONLY : lmp, demo_input, cont_input, pair_input + IMPLICIT NONE + + CALL lmp%commands_list(demo_input) + CALL lmp%commands_list(cont_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 COM all com") ! global vector + CALL lmp%command("compute totalpe all reduce sum c_peratompe") ! global scalar + CALL lmp%command("compute 1 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 +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 keepatom, 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 keepatom, 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 keepatom, 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 keepatom, 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 keepatom, 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 keepatom, 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 keepatom, 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 From 26e269aacd06f136ff82828b3b254df105309039 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Sat, 24 Sep 2022 12:04:27 -0500 Subject: [PATCH 06/49] continued ork on extract_compute unit tests --- doc/src/Fortran.rst | 6 +- doc/src/Library_properties.rst | 10 +- unittest/fortran/CMakeLists.txt | 4 + .../fortran/test_fortran_extract_compute.f90 | 103 +++--------------- 4 files changed, 25 insertions(+), 98 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 312ef3a671..7726a43f6e 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -508,10 +508,10 @@ Procedures Bound to the lammps Derived Type 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 + INTEGER(C_int), POINTER :: nlocal => NULL() + INTEGER(C_int64_t), POINTER :: ntimestep => NULL() + REAL(C_double), POINTER :: dt => NULL() CHARACTER(LEN=10) :: units - REAL(C_double), POINTER :: dt lmp = lammps() ! other commands nlocal = lmp%extract_global('nlocal') 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/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index 44f4f86d89..672333c529 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -61,6 +61,10 @@ if(CMAKE_Fortran_COMPILER) 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) + else() message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler") endif() diff --git a/unittest/fortran/test_fortran_extract_compute.f90 b/unittest/fortran/test_fortran_extract_compute.f90 index 091572ace3..f358ec9d2c 100644 --- a/unittest/fortran/test_fortran_extract_compute.f90 +++ b/unittest/fortran/test_fortran_extract_compute.f90 @@ -17,10 +17,10 @@ MODULE keepcompute 'mass 1 2.0' ] END MODULE keepcompute -FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") +FUNCTION f_lammps_with_args() BIND(C) USE ISO_C_BINDING, ONLY: c_ptr USE liblammps - USE keepatom, ONLY: lmp + USE keepcompute, ONLY: lmp IMPLICIT NONE TYPE(c_ptr) :: f_lammps_with_args CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = & @@ -31,10 +31,10 @@ FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") f_lammps_with_args = lmp%handle END FUNCTION f_lammps_with_args -SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close") +SUBROUTINE f_lammps_close() BIND(C) USE ISO_C_BINDING, ONLY: c_null_ptr USE liblammps - USE keepatom, ONLY: lmp + USE keepcompute, ONLY: lmp IMPLICIT NONE CALL lmp%close() @@ -43,7 +43,7 @@ END SUBROUTINE f_lammps_close SUBROUTINE f_lammps_setup_extract_compute () BIND(C) USE LIBLAMMPS - USE keepatom, ONLY : lmp, demo_input, cont_input, pair_input + USE keepcompute, ONLY : lmp, demo_input, cont_input, pair_input IMPLICIT NONE CALL lmp%commands_list(demo_input) @@ -56,94 +56,17 @@ SUBROUTINE f_lammps_setup_extract_compute () BIND(C) CALL lmp%command("compute 1 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 -END SUBROUTINE f_lammps_setup_extract_atom +END SUBROUTINE f_lammps_setup_extract_compute -FUNCTION f_lammps_extract_atom_mass () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double - USE LIBLAMMPS - USE keepatom, 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) +FUNCTION f_lammps_extract_compute_peratom_vector (i) BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int USE LIBLAMMPS - USE keepatom, ONLY : lmp + USE keepcompute, 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() + REAL(C_double) :: f_lammps_extract_compute_peratom_vector + REAL(C_double), DIMENSION(:), POINTER :: vector => 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 keepatom, 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 keepatom, 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 keepatom, 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 keepatom, 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 keepatom, 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 + 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 From bada1fb348b5a1bbd1d608b98d68f3db8c7053d6 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Sun, 25 Sep 2022 23:54:18 -0500 Subject: [PATCH 07/49] Finished extract_compute and its unit tests and documentation --- doc/src/Fortran.rst | 143 +++++++++++++++--- fortran/lammps.f90 | 110 +++++++++----- .../fortran/test_fortran_extract_compute.f90 | 88 ++++++++++- 3 files changed, 276 insertions(+), 65 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 7726a43f6e..b24eb30d83 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -452,7 +452,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, @@ -461,12 +461,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. -------- @@ -505,12 +505,12 @@ Procedures Bound to the lammps Derived Type .. code-block:: fortran PROGRAM demo - USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_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() + 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 @@ -540,7 +540,7 @@ Procedures Bound to the lammps Derived Type 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, @@ -560,14 +560,14 @@ Procedures Bound to the lammps Derived Type 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. + 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 @@ -576,7 +576,7 @@ Procedures Bound to the lammps Derived Type property. If expecting vector data, the pointer should have dimension ":"; if expecting matrix data, the pointer should have dimension ":,:". - .. note:: + .. 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 @@ -596,12 +596,12 @@ Procedures Bound to the lammps Derived Type .. code-block:: Fortran TYPE(lammps) :: lmp - REAL(C_double), DIMENSION(:,:), POINTER :: x + 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 third atom on this processor + 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. @@ -612,7 +612,7 @@ Procedures Bound to the lammps Derived Type .. code-block:: Fortran - REAL(C_double), DIMENSION(:,:), POINTER :: x, x0 + REAL(c_double), DIMENSION(:,:), POINTER :: x, x0 x = lmp%extract_atom("x") x0(0:,0:) => x @@ -621,6 +621,109 @@ Procedures Bound to the lammps Derived Type -------- +.. 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. + + 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 similar note under + :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 + - Pointer 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) + + .. 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:: version() This method returns the numeric LAMMPS version like diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index d06de746d5..4486bd87c1 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -29,8 +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_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 USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : ERROR_UNIT IMPLICIT NONE @@ -44,22 +45,27 @@ MODULE LIBLAMMPS ! ! These are NOT part of the API (the part the user sees) INTEGER (c_int), PARAMETER :: & - LAMMPS_INT = 0, & ! 32-bit integer (array) - LAMMPS_INT_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) + 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 ! "Constants" to use with extract_compute and friends TYPE lammps_style @@ -112,13 +118,13 @@ MODULE LIBLAMMPS ! 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 - REAL(c_double), DIMENSION(:,:), POINTER :: r64_mat + 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 @@ -683,9 +689,9 @@ CONTAINS FORALL ( 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') + CASE DEFAULT + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'Unknown pointer type in extract_global') END SELECT END FUNCTION @@ -703,6 +709,7 @@ CONTAINS 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') @@ -745,13 +752,18 @@ CONTAINS ! Catomptr(1) now points to the first element of the array CALL C_F_POINTER(Catomptr(1), peratom_data%r64_mat, [nrows,ncols]) CASE (-1) - WRITE(ERROR_UNIT,'(A)') 'ERROR: per-atom property "' // name // & - '" not found.' - STOP 2 + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'per-atom property ' // name // 'not found in extract_setting') +! WRITE(ERROR_UNIT,'(A)') 'ERROR: per-atom property "' // name // & +! '" not found.' +! STOP 2 CASE DEFAULT - WRITE(ERROR_UNIT,'(A,I0,A)') 'ERROR: return value ', datatype, & - ' from lammps_extract_atom_datatype not known' - STOP 1 + 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) +! WRITE(ERROR_UNIT,'(A,I0,A)') 'ERROR: return value ', datatype, & +! ' from lammps_extract_atom_datatype not known' +! STOP 1 END SELECT END FUNCTION lmp_extract_atom @@ -768,18 +780,26 @@ CONTAINS 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! 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 @@ -789,11 +809,12 @@ CONTAINS 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 - nrows = self%extract_setting('nmax') - Ctemp = lammps_extract_compute(self%handle,Cid,style,LMP_SIZE_ROWS) + ncols = self%extract_setting('nmax') + Ctemp = lammps_extract_compute(self%handle,Cid,style,LMP_SIZE_COLS) CALL C_F_POINTER(Ctemp, temp) - ncols = temp + nrows = temp ELSE Ctemp = lammps_extract_compute(self%handle,Cid,style,LMP_SIZE_ROWS) CALL C_F_POINTER(Ctemp, temp) @@ -802,11 +823,16 @@ CONTAINS CALL C_F_POINTER(Ctemp, temp) nrows = temp END IF - CALL C_F_POINTER(Cptr, compute_data%r64_mat, [nrows, ncols]) + ! 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 - WRITE(ERROR_UNIT,'(A,I0,A)') 'ERROR: unknown type value ', type, & - 'passed to extract_compute' - STOP 1 + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'unknown type value passed to extract_compute') + !WRITE(ERROR_UNIT,'(A,I0,A)') 'ERROR: unknown type value ', type, & + ! 'passed to extract_compute' + !STOP 1 END SELECT CALL lammps_free(Cid) END FUNCTION lmp_extract_compute @@ -944,6 +970,8 @@ CONTAINS CASE DEFAULT str1 = 'that type' END SELECT + !CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, 'cannot associate ' & + ! // str1 // ' with ' // type2 // ' [Fortran API]') WRITE (ERROR_UNIT,'(A)') 'ERROR (Fortran API): cannot associate ' & // str1 // ' with ' // type2 STOP ERROR_CODE diff --git a/unittest/fortran/test_fortran_extract_compute.f90 b/unittest/fortran/test_fortran_extract_compute.f90 index f358ec9d2c..64b5068171 100644 --- a/unittest/fortran/test_fortran_extract_compute.f90 +++ b/unittest/fortran/test_fortran_extract_compute.f90 @@ -6,10 +6,11 @@ MODULE keepcompute '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), DIMENSION(3), PARAMETER :: cont_input = & [ CHARACTER(len=40) :: & 'create_atoms 1 single &', & - ' 0.2 0.1 0.1' ] + ' 0.2 0.1 0.1', & + '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', & @@ -51,11 +52,13 @@ SUBROUTINE f_lammps_setup_extract_compute () BIND(C) 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 COM all com") ! global vector CALL lmp%command("compute totalpe all reduce sum c_peratompe") ! global scalar - CALL lmp%command("compute 1 all rdf 100") ! global array + 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) @@ -70,3 +73,80 @@ FUNCTION f_lammps_extract_compute_peratom_vector (i) BIND(C) 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 keepcompute, 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 keepcompute, 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 keepcompute, 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 keepcompute, 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 keepcompute, 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 keepcompute, 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 From 7cd5d7b357946fb77a1fa3ddcec935dbc932325d Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Mon, 26 Sep 2022 08:57:03 -0500 Subject: [PATCH 08/49] Added lammps_has_error --- fortran/lammps.f90 | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 4486bd87c1..371e4073bc 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -414,7 +414,11 @@ MODULE LIBLAMMPS !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 @@ -844,6 +848,15 @@ CONTAINS lmp_version = lammps_version(self%handle) END FUNCTION lmp_version + ! 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_is_running LOGICAL FUNCTION lmp_is_running(self) CLASS(lammps), INTENT(IN) :: self From 28d84b4fcbe1317e57c926be631b3a29bb802fc3 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Mon, 26 Sep 2022 08:57:32 -0500 Subject: [PATCH 09/49] Missed wrap_extract_compute.cpp in prior commit --- unittest/fortran/wrap_extract_compute.cpp | 174 ++++++++++++++++++++++ 1 file changed, 174 insertions(+) create mode 100644 unittest/fortran/wrap_extract_compute.cpp diff --git a/unittest/fortran/wrap_extract_compute.cpp b/unittest/fortran/wrap_extract_compute.cpp new file mode 100644 index 0000000000..2325b1540f --- /dev/null +++ b/unittest/fortran/wrap_extract_compute.cpp @@ -0,0 +1,174 @@ +// 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]); +}; From 1072a5bda2b334114a874b2b27da9a465e3b75c9 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Mon, 26 Sep 2022 09:21:41 -0500 Subject: [PATCH 10/49] Added unit test for has_error --- fortran/lammps.f90 | 1 + unittest/fortran/test_fortran_properties.f90 | 14 ++++++++++++++ unittest/fortran/wrap_properties.cpp | 6 ++++++ 3 files changed, 21 insertions(+) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 371e4073bc..506a560613 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -100,6 +100,7 @@ MODULE LIBLAMMPS ! PROCEDURE :: version => lmp_version PROCEDURE :: is_running => lmp_is_running + PROCEDURE :: has_error => lmp_has_error END TYPE lammps INTERFACE lammps diff --git a/unittest/fortran/test_fortran_properties.f90 b/unittest/fortran/test_fortran_properties.f90 index 00e083b301..9719e5c136 100644 --- a/unittest/fortran/test_fortran_properties.f90 +++ b/unittest/fortran/test_fortran_properties.f90 @@ -50,3 +50,17 @@ FUNCTION f_lammps_extract_setting (Cstr) BIND(C) f_lammps_extract_setting = lmp%extract_setting(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 keepcmds, 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 diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp index 8ecd9346dc..b4dffeed3a 100644 --- a/unittest/fortran/wrap_properties.cpp +++ b/unittest/fortran/wrap_properties.cpp @@ -16,6 +16,7 @@ int f_lammps_version(); void f_lammps_memory_usage(double*); int f_lammps_get_mpi_comm(); int f_lammps_extract_setting(const char*); +int f_lammps_has_error(); } class LAMMPS_properties : public ::testing::Test { @@ -107,3 +108,8 @@ TEST_F(LAMMPS_properties, extract_setting) EXPECT_EQ(f_lammps_extract_setting("UNKNOWN"), -1); }; + +TEST_F(LAMMPS_properties, has_error) +{ + EXPECT_EQ(f_lammps_has_error(), 0); +}; From 2072e08624c8510da25e0e6096401293165edf28 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Mon, 26 Sep 2022 21:56:03 -0500 Subject: [PATCH 11/49] added get_last_error_message; still working on its unit test --- fortran/lammps.f90 | 85 ++++++++++++++++++++-------- unittest/fortran/wrap_properties.cpp | 3 +- 2 files changed, 62 insertions(+), 26 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 506a560613..45540ffb84 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -81,26 +81,27 @@ MODULE LIBLAMMPS 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 :: version => lmp_version - PROCEDURE :: is_running => lmp_is_running - PROCEDURE :: has_error => lmp_has_error + 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 :: version => lmp_version + PROCEDURE :: is_running => lmp_is_running + PROCEDURE :: has_error => lmp_has_error + PROCEDURE :: get_last_error_message => lmp_get_last_error_message END TYPE lammps INTERFACE lammps @@ -416,12 +417,18 @@ MODULE LIBLAMMPS !SUBROUTINE lammps_force_timeout INTEGER (C_int) FUNCTION lammps_has_error (handle) BIND(C) - IMPORT :: C_ptr, C_int + IMPORT :: c_ptr, c_int IMPLICIT NONE - TYPE(C_ptr), VALUE :: handle + 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 @@ -852,12 +859,40 @@ CONTAINS ! equivalent function to lammps_has_error LOGICAL FUNCTION lmp_has_error(self) CLASS(lammps), INTENT(IN) :: self - INTEGER(C_int) :: has_error + INTEGER(c_int) :: has_error has_error = lammps_has_error(self%handle) - lmp_has_error = (has_error /= 0_C_int) + 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) :: length, Cstatus, i + TYPE(c_ptr) :: Cbuffer + + buffer = '' + IF ( lmp_has_error(self) ) THEN + length = LEN(buffer) + Cbuffer = f2cstring(buffer) + Cstatus = lammps_get_last_error_message(self%handle, Cbuffer, length) + length = MIN(LEN(buffer), c_strlen(Cbuffer)) + FORALL ( i=1:length ) + buffer(i:i) = Cbuffer(i) + END FORALL + IF ( PRESENT(status) ) THEN + status = Cstatus + END IF + ELSE + buffer = '' + IF ( PRESENT(status) ) THEN + status = 0 + END IF + END IF + END SUBROUTINE lmp_get_last_error_message + ! equivalent function to lammps_is_running LOGICAL FUNCTION lmp_is_running(self) CLASS(lammps), INTENT(IN) :: self diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp index b4dffeed3a..392a6633d6 100644 --- a/unittest/fortran/wrap_properties.cpp +++ b/unittest/fortran/wrap_properties.cpp @@ -111,5 +111,6 @@ TEST_F(LAMMPS_properties, extract_setting) TEST_F(LAMMPS_properties, has_error) { - EXPECT_EQ(f_lammps_has_error(), 0); + EXPECT_EQ(f_lammps_has_error(), lammps_has_error(lmp)); + // TODO: How to test the error message itself? }; From e22699197d60be749f9945f44b925e9b8dcaaf04 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 28 Sep 2022 07:40:06 -0500 Subject: [PATCH 12/49] Added flush_buffers --- fortran/lammps.f90 | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 45540ffb84..7ab6255f90 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -100,6 +100,8 @@ MODULE LIBLAMMPS ! PROCEDURE :: version => lmp_version PROCEDURE :: is_running => lmp_is_running +! + PROCEDURE :: flush_buffers => lmp_flush_buffers PROCEDURE :: has_error => lmp_has_error PROCEDURE :: get_last_error_message => lmp_get_last_error_message END TYPE lammps @@ -393,7 +395,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 @@ -856,6 +862,20 @@ CONTAINS lmp_version = lammps_version(self%handle) END FUNCTION lmp_version + ! equivalent function to lammps_is_running + LOGICAL FUNCTION lmp_is_running(self) + CLASS(lammps), INTENT(IN) :: self + + lmp_is_running = ( lammps_is_running(self%handle) /= 0_C_int ) + END FUNCTION lmp_is_running + + ! 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_has_error LOGICAL FUNCTION lmp_has_error(self) CLASS(lammps), INTENT(IN) :: self @@ -893,13 +913,6 @@ CONTAINS END IF END SUBROUTINE lmp_get_last_error_message - ! equivalent function to lammps_is_running - LOGICAL FUNCTION lmp_is_running(self) - CLASS(lammps), INTENT(IN) :: self - - lmp_is_running = ( lammps_is_running(self%handle) /= 0_C_int ) - END FUNCTION lmp_is_running - ! ---------------------------------------------------------------------- ! functions to assign user-space pointers to LAMMPS data ! ---------------------------------------------------------------------- From 1d4297e2dd8c1c19d8cae6de50ea8b192738a796 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 28 Sep 2022 22:09:26 -0500 Subject: [PATCH 13/49] Implemented extract_fix, extract_variable, flush_buffers; unit test for extract_fix --- fortran/lammps.f90 | 352 +++++++++++++++--- python/lammps/constants.py | 1 + src/library.cpp | 41 ++ src/library.h | 24 +- unittest/fortran/CMakeLists.txt | 4 + unittest/fortran/test_fortran_extract_fix.f90 | 118 ++++++ unittest/fortran/wrap_extract_fix.cpp | 107 ++++++ 7 files changed, 597 insertions(+), 50 deletions(-) create mode 100644 unittest/fortran/test_fortran_extract_fix.f90 create mode 100644 unittest/fortran/wrap_extract_fix.cpp diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 7ab6255f90..9f49a1fcb5 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -65,7 +65,10 @@ MODULE LIBLAMMPS 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_ERROR_UNIVERSE = 8, & ! error on comm->universe + LMP_VAR_EQUAL = 0, & ! equal-style variables (and compatible) + LMP_VAR_ATOM = 1, & ! atom-style variables (and compatible) + LMP_VAR_STRING = 2 ! string variables (and compatible) ! "Constants" to use with extract_compute and friends TYPE lammps_style @@ -97,11 +100,14 @@ MODULE LIBLAMMPS 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 :: version => lmp_version - PROCEDURE :: is_running => lmp_is_running ! PROCEDURE :: flush_buffers => lmp_flush_buffers + PROCEDURE :: is_running => lmp_is_running +! force_timeout PROCEDURE :: has_error => lmp_has_error PROCEDURE :: get_last_error_message => lmp_get_last_error_message END TYPE lammps @@ -118,10 +124,16 @@ 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 + ! 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() @@ -132,6 +144,26 @@ MODULE LIBLAMMPS 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') @@ -144,6 +176,10 @@ MODULE LIBLAMMPS 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 END INTERFACE ! interface definitions for calling functions in library.cpp @@ -312,9 +348,27 @@ MODULE LIBLAMMPS 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 + + 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 !INTEGER (c_int) lammps_set_variable @@ -647,7 +701,7 @@ CONTAINS ! 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 + CLASS(lammps), INTENT(IN), TARGET :: self CHARACTER(LEN=*), INTENT(IN) :: name TYPE(lammps_data) :: global_data @@ -674,6 +728,7 @@ 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 @@ -704,7 +759,7 @@ CONTAINS length = c_strlen(Cptr) CALL C_F_POINTER(Cptr, Fptr, [length]) ALLOCATE ( CHARACTER(LEN=length) :: global_data%str ) - FORALL ( I=1:length ) + FORALL ( i=1:length ) global_data%str(i:i) = Fptr(i) END FORALL CASE DEFAULT @@ -717,7 +772,7 @@ CONTAINS ! the assignment is actually overloaded so as to bind the pointers to ! lammps data based on the information available from LAMMPS FUNCTION lmp_extract_atom (self, name) RESULT (peratom_data) - CLASS(lammps), INTENT(IN) :: self + CLASS(lammps), INTENT(IN), TARGET :: self CHARACTER(LEN=*), INTENT(IN) :: name TYPE(lammps_data) :: peratom_data @@ -748,6 +803,7 @@ CONTAINS nrows = 1 END SELECT + peratom_data%lammps_instance => self SELECT CASE (datatype) CASE (LAMMPS_INT) peratom_data%datatype = DATA_INT_1D @@ -772,16 +828,10 @@ CONTAINS CASE (-1) CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & 'per-atom property ' // name // 'not found in extract_setting') -! WRITE(ERROR_UNIT,'(A)') 'ERROR: per-atom property "' // name // & -! '" not found.' -! STOP 2 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) -! WRITE(ERROR_UNIT,'(A,I0,A)') 'ERROR: return value ', datatype, & -! ' from lammps_extract_atom_datatype not known' -! STOP 1 END SELECT END FUNCTION lmp_extract_atom @@ -789,12 +839,11 @@ CONTAINS ! 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) :: self + CLASS(lammps), INTENT(IN), TARGET :: self CHARACTER(LEN=*), INTENT(IN) :: id INTEGER(c_int), INTENT(IN) :: style, type TYPE(lammps_data) :: compute_data - INTEGER(c_int) :: datatype TYPE(c_ptr) :: Cid, Cptr, Ctemp INTEGER :: nrows, ncols, length INTEGER(c_int), POINTER :: temp @@ -809,6 +858,7 @@ CONTAINS 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 @@ -847,14 +897,161 @@ CONTAINS 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') - !WRITE(ERROR_UNIT,'(A,I0,A)') 'ERROR: unknown type value ', type, & - ! 'passed to extract_compute' - !STOP 1 + '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 + INTEGER :: length, i + CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Cstring + INTEGER(c_int) :: datatype + REAL(c_double), POINTER :: double + REAL(c_double), DIMENSION(:), POINTER :: double_vec + + 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) + + 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]) + variable_data%r64_vec = double_vec + CALL lammps_free(Cptr) + 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 ) + FORALL ( i=1:length ) + variable_data%str(i:i) = Cstring(i) + END FORALL + 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_version() INTEGER FUNCTION lmp_version(self) CLASS(lammps), INTENT(IN) :: self @@ -873,7 +1070,7 @@ CONTAINS SUBROUTINE lmp_flush_buffers(self) CLASS(lammps), INTENT(IN) :: self - call lammps_flush_buffers(self%handle) + CALL lammps_flush_buffers(self%handle) END SUBROUTINE lmp_flush_buffers ! equivalent function to lammps_has_error @@ -891,14 +1088,16 @@ CONTAINS CHARACTER(LEN=*), INTENT(OUT) :: buffer INTEGER, INTENT(OUT), OPTIONAL :: status INTEGER(c_int) :: length, Cstatus, i - TYPE(c_ptr) :: Cbuffer + TYPE(c_ptr) :: Cptr + CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Cbuffer buffer = '' IF ( lmp_has_error(self) ) THEN length = LEN(buffer) - Cbuffer = f2cstring(buffer) - Cstatus = lammps_get_last_error_message(self%handle, Cbuffer, length) - length = MIN(LEN(buffer), c_strlen(Cbuffer)) + Cptr = f2c_string(buffer) + Cstatus = lammps_get_last_error_message(self%handle, Cptr, length) + length = MIN(LEN(buffer), c_strlen(Cptr)) + CALL C_F_POINTER(Cptr, Cbuffer, [length]) FORALL ( i=1:length ) buffer(i:i) = Cbuffer(i) END FORALL @@ -923,7 +1122,7 @@ CONTAINS 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 @@ -934,7 +1133,7 @@ CONTAINS 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 @@ -945,7 +1144,7 @@ CONTAINS 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 @@ -956,7 +1155,7 @@ CONTAINS IF ( rhs%datatype == DATA_INT64_1D ) THEN lhs => rhs%i64_vec ELSE - CALL assignment_error(rhs%datatype, 'vector of long ints') + CALL assignment_error(rhs, 'vector of long ints') END IF END SUBROUTINE assign_int64vec_to_lammps_data @@ -967,7 +1166,7 @@ CONTAINS 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 @@ -978,7 +1177,7 @@ CONTAINS 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 @@ -989,7 +1188,7 @@ CONTAINS IF ( rhs%datatype == DATA_DOUBLE_2D ) THEN lhs => rhs%r64_mat ELSE - CALL assignment_error(rhs%datatype, 'matrix of doubles') + CALL assignment_error(rhs, 'matrix of doubles') END IF END SUBROUTINE assign_doublemat_to_lammps_data @@ -1000,17 +1199,81 @@ CONTAINS IF ( rhs%datatype == DATA_STRING ) THEN lhs = rhs%str 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 + ! ---------------------------------------------------------------------- + ! 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 + + 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(:), INTENT(OUT), POINTER :: lhs + CLASS(lammps_variable_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_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) + SELECT CASE (type1%datatype) CASE (DATA_INT) str1 = 'scalar int' CASE (DATA_INT_1D) @@ -1032,11 +1295,8 @@ CONTAINS CASE DEFAULT str1 = 'that type' END SELECT - !CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, 'cannot associate ' & - ! // str1 // ' with ' // type2 // ' [Fortran API]') - WRITE (ERROR_UNIT,'(A)') 'ERROR (Fortran API): 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/lammps/constants.py b/python/lammps/constants.py index 26bb92626a..6a7fda85a8 100644 --- a/python/lammps/constants.py +++ b/python/lammps/constants.py @@ -42,6 +42,7 @@ LMP_ERROR_UNIVERSE = 8 LMP_VAR_EQUAL = 0 LMP_VAR_ATOM = 1 +LMP_VAR_STRING = 2 # ------------------------------------------------------------------------- diff --git a/src/library.cpp b/src/library.cpp index 16381a089d..d5e309ce33 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -2130,6 +2130,47 @@ 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 + 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 diff --git a/src/library.h b/src/library.h index 1eec57898e..d0616cd6c4 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 lammps/constants.py + * and fortran/lammps.f90 */ 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 lammps/constants.py + * and fortran/lammps.f90 */ 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 lammps/constants.py + * and fortran/lammps.f90 */ 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 lammps/constants.py + * and fortran/lammps.f90 */ enum _LMP_ERROR_CONST { LMP_ERROR_WARNING = 0, /*!< call Error::warning() */ @@ -87,6 +91,17 @@ 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 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_STRING = 2 /*!< 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 +168,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/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index 672333c529..fc0d0dc956 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -65,6 +65,10 @@ if(CMAKE_Fortran_COMPILER) 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) + else() message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler") endif() diff --git a/unittest/fortran/test_fortran_extract_fix.f90 b/unittest/fortran/test_fortran_extract_fix.f90 new file mode 100644 index 0000000000..85b4cb5f4f --- /dev/null +++ b/unittest/fortran/test_fortran_extract_fix.f90 @@ -0,0 +1,118 @@ +MODULE keepfix + USE liblammps + TYPE(LAMMPS) :: lmp + CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & + [ 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(3), PARAMETER :: cont_input = & + [ CHARACTER(LEN=40) :: & + 'create_atoms 1 single &', & + ' 0.2 0.1 0.1', & + '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 2.0' ] +END MODULE keepfix + +FUNCTION f_lammps_with_args() BIND(C) + USE ISO_C_BINDING, ONLY: C_ptr + USE liblammps + USE keepfix, 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 keepfix, 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 keepfix, ONLY : lmp, demo_input, cont_input, pair_input + IMPLICIT NONE + + CALL lmp%commands_list(demo_input) + CALL lmp%commands_list(cont_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 keepfix, 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 keepfix, 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 keepfix, 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 keepfix, 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 keepfix, 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/wrap_extract_fix.cpp b/unittest/fortran/wrap_extract_fix.cpp new file mode 100644 index 0000000000..d8f19c8b95 --- /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); +}; From 6c0da8cbaf1081f7cd472573cc371fc52c80c3b4 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Thu, 29 Sep 2022 01:07:46 -0500 Subject: [PATCH 14/49] Wrote documentation for extract_fix, extract_variable --- doc/src/Fortran.rst | 337 +++++++++++++++++++++++++++++++----- doc/src/Library_objects.rst | 7 + src/library.cpp | 78 ++++----- src/library.h | 2 +- 4 files changed, 340 insertions(+), 84 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 730148b7f1..9bcf34a2d1 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -10,7 +10,7 @@ written in C, C++, or Fortran. While C libraries have a defined binary interface (ABI) and can thus be used from multiple compiler versions from different vendors for 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,21 +18,21 @@ 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 +``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 using the interface. A working example code can be found together +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. @@ -62,31 +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 @@ -102,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()` @@ -131,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 @@ -157,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 @@ -176,13 +176,13 @@ 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. In +some cases, the C library interface makes pointers to internal 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. @@ -191,35 +191,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) :: 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_setting('natoms') + WRITE(OUTPUT_UNIT,'(A,I8,A)') 'Running a simulation with', natoms, ' atoms' + WRITE(OUTPUT_UNIT,'(I8,A,I8,A,I3,A)') lmp%extract_setting('nlocal'), & + ' local and', lmp%extract_setting('nghost'), ' ghost atom. ', & 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,I4,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 --------------- @@ -237,6 +238,8 @@ 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 subroutine file: :f:func:`file` @@ -248,10 +251,18 @@ 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 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` -------- @@ -290,6 +301,24 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. 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 =========================================== @@ -301,7 +330,7 @@ Procedures Bound to the lammps Derived Type :cpp:func:`lammps_mpi_finalize`. :o logical finalize [optional]: shut down the MPI environment of the LAMMPS - library if true. + library if ``.TRUE.``. -------- @@ -571,6 +600,8 @@ Procedures Bound to the lammps Derived Type 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 @@ -645,6 +676,8 @@ Procedures Bound to the lammps Derived Type 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 @@ -719,6 +752,11 @@ Procedures Bound to the lammps Derived Type (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:: @@ -738,9 +776,220 @@ Procedures Bound to the lammps Derived Type -------- +.. 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. + + 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 reinvoke 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 + global or per-atom data, it should have the ``POINTER`` attribute. + + .. 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 either have + the ``ALLOCATABLE`` attribute or be long enough to contain the data without + reallocation. + + .. 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(nlocal)`` for *atom*-style variables, or + ``CHARACTER(LEN=:), ALLOCATABLE`` for *string*-style and compatible + variables. Non-allocatable strings whose length is too short to hold the + result will be truncated. + +.. 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 safe to evaluate the variable + and thus an error and crash are avoided. + +-------- + .. f:function:: version() This method returns the numeric LAMMPS version like :cpp:func:`lammps_version` does. :r integer: LAMMPS version + +-------- + +.. f:subroutine:: flush_buffers + +.. + TODO + +-------- + +.. f:function:: is_running + +.. + TODO + +-------- + +.. f:function:: has_error + +.. + TODO + +-------- + +.. f:subroutine:: get_last_error_message + +.. + TODO diff --git a/doc/src/Library_objects.rst b/doc/src/Library_objects.rst index eed14b3a05..6604236f5e 100644 --- a/doc/src/Library_objects.rst +++ b/doc/src/Library_objects.rst @@ -21,6 +21,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 +41,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/src/library.cpp b/src/library.cpp index d5e309ce33..bb9d42aa99 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -2068,9 +2068,9 @@ use to avoid a memory leak. Example: For *atom*\ -style variables the data returned 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 other variable styles the returned pointer needs to be cast to @@ -2084,10 +2084,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 or 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 * @@ -2130,7 +2130,7 @@ void *lammps_extract_variable(void *handle, const char *name, const char *group) /* ---------------------------------------------------------------------- */ -/** Get data type of a LAMMPS variable +/** Get data type of a LAMMPS variable. * \verbatim embed:rst @@ -2207,12 +2207,12 @@ int lammps_set_variable(void *handle, char *name, char *str) 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 + 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" 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: @@ -2344,12 +2344,12 @@ void lammps_gather_atoms(void *handle, char *name, int type, int count, void *da 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 + 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" 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],... + (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: @@ -2488,14 +2488,14 @@ void lammps_gather_atoms_concat(void *handle, char *name, int type, int count, v 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 + 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" 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],... + (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: @@ -2632,12 +2632,12 @@ void lammps_gather_atoms_subset(void *handle, char *name, int type, int count, 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 + 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 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*Natoms, as queried by get_natoms() method: loop over Natoms, if I own atom ID, set its values from data @@ -2748,14 +2748,14 @@ void lammps_scatter_atoms(void *handle, char *name, int type, int count, void *d 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 @@ -2992,10 +2992,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: @@ -3227,10 +3227,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: @@ -3479,10 +3479,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: @@ -3727,10 +3727,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: @@ -3945,12 +3945,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 @@ -4193,8 +4193,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). @@ -4552,7 +4552,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 @@ -5224,8 +5224,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 @@ -5511,7 +5511,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 diff --git a/src/library.h b/src/library.h index d0616cd6c4..2eadb9c5f3 100644 --- a/src/library.h +++ b/src/library.h @@ -91,7 +91,7 @@ enum _LMP_ERROR_CONST { LMP_ERROR_UNIVERSE = 8 /*!< error on Comm::universe */ }; -/** Variable style constants for extracting data from variables +/** Variable style constants for extracting data from variables. * * Must be kept in sync with the equivalent constants in lammps/constants.py * and fortran/lammps.f90 */ From 3ab8f6ea163bbcd2cd17c3aadc09af890e5b0442 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Thu, 29 Sep 2022 09:14:49 -0500 Subject: [PATCH 15/49] Finished docs for everything currently implemented --- doc/src/Fortran.rst | 105 +++++++++++++++++++++++++++++++----- doc/src/Library_objects.rst | 1 + src/library.cpp | 16 +++--- 3 files changed, 102 insertions(+), 20 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 9bcf34a2d1..d041946470 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -649,7 +649,40 @@ Procedures Bound to the lammps Derived Type 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. + 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 @@ -776,7 +809,7 @@ Procedures Bound to the lammps Derived Type -------- -.. f:function:: extract_fix(id, style, type, [nrow,] [ncol]) +.. 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 @@ -884,7 +917,9 @@ Procedures Bound to the lammps Derived Type 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 - global or per-atom data, it should have the ``POINTER`` attribute. + 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 @@ -970,26 +1005,72 @@ Procedures Bound to the lammps Derived Type .. f:subroutine:: flush_buffers -.. - TODO + 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 -.. - TODO + 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:function:: has_error -.. - TODO + 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 +.. f:subroutine:: get_last_error_message(buffer[,status]) -.. - TODO + 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 whethher 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 6604236f5e..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` diff --git a/src/library.cpp b/src/library.cpp index bb9d42aa99..cd4742a2e4 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -2139,7 +2139,7 @@ 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 +.. versionadded:: TBD \endverbatim * @@ -5635,9 +5635,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 * @@ -5667,15 +5667,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 *``. From a7071fea78a9ae0f5b919e4e2d1501439a1da171 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Thu, 29 Sep 2022 19:28:15 -0500 Subject: [PATCH 16/49] Wrote docs for extract_fix,extract_variable; fixed python so it knows about string variables; doc typo fixes; part of extract_variable unit test --- doc/src/Fortran.rst | 323 ++++++++++++++++-- fortran/lammps.f90 | 305 ++++++++++++++--- python/lammps/core.py | 27 +- src/library.cpp | 22 +- unittest/fortran/CMakeLists.txt | 5 + unittest/fortran/atomdata.txt | 8 + unittest/fortran/greetings.txt | 9 + .../fortran/test_fortran_extract_variable.f90 | 161 +++++++++ unittest/fortran/wrap_extract_variable.cpp | 87 +++++ 9 files changed, 861 insertions(+), 86 deletions(-) create mode 100644 unittest/fortran/atomdata.txt create mode 100644 unittest/fortran/greetings.txt create mode 100644 unittest/fortran/test_fortran_extract_variable.f90 create mode 100644 unittest/fortran/wrap_extract_variable.cpp diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index d041946470..3112440bb0 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -389,6 +389,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) @@ -575,7 +581,26 @@ Procedures Bound to the lammps Derived Type 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. + 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., + + .. 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 @@ -737,8 +762,8 @@ Procedures Bound to the lammps Derived Type 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 similar note under - :f:func:`extract_atom` for further details. + 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): @@ -749,7 +774,7 @@ Procedures Bound to the lammps Derived Type * - Style - Type - - Pointer type to assign to + - Type to assign to - Returned data * - ``lmp%style%global`` - ``lmp%type%scalar`` @@ -786,7 +811,7 @@ Procedures Bound to the lammps Derived Type :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``) + 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 ":,:". @@ -828,10 +853,76 @@ Procedures Bound to the lammps Derived Type 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. + 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 + ``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 @@ -914,7 +1005,7 @@ Procedures Bound to the lammps Derived Type :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., + 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 @@ -950,7 +1041,7 @@ Procedures Bound to the lammps Derived Type 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 either have + ``REAL(c_double)``, be of rank 1 (i.e., ``DIMENSION(:)``), and either have the ``ALLOCATABLE`` attribute or be long enough to contain the data without reallocation. @@ -977,19 +1068,20 @@ Procedures Bound to the lammps Derived Type :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 + :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(nlocal)`` for *atom*-style variables, or - ``CHARACTER(LEN=:), ALLOCATABLE`` for *string*-style and compatible - variables. Non-allocatable strings whose length is too short to hold the - result will be truncated. + ``REAL(c_double), DIMENSION(nlocal)`` for *atom*-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. .. 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 safe to evaluate the variable + that the data are extracted only when it is safe to evaluate the variable and thus an error and crash are avoided. -------- @@ -1003,7 +1095,187 @@ Procedures Bound to the lammps Derived Type -------- -.. f:subroutine:: flush_buffers +.. 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 + to not 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 @@ -1013,7 +1285,7 @@ Procedures Bound to the lammps Derived Type -------- -.. f:function:: is_running +.. f:function:: is_running() Check if LAMMPS is currently inside a run or minimization. @@ -1026,7 +1298,18 @@ Procedures Bound to the lammps Derived Type -------- -.. f:function:: has_error +.. 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. @@ -1069,8 +1352,8 @@ Procedures Bound to the lammps Derived Type 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 whethher this is the case. + :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, + :o integer(c_int) status [optional]: 1 when all ranks had the error, 2 on a single-rank error. diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 9f49a1fcb5..eb83ce3058 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -32,7 +32,6 @@ MODULE LIBLAMMPS 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 - USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : ERROR_UNIT IMPLICIT NONE PRIVATE @@ -80,36 +79,48 @@ MODULE LIBLAMMPS END TYPE lammps_type TYPE lammps - TYPE(c_ptr) :: handle - 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 + 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 :: version => lmp_version + 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 -! force_timeout - PROCEDURE :: has_error => lmp_has_error - PROCEDURE :: get_last_error_message => lmp_get_last_error_message + 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 @@ -180,6 +191,9 @@ MODULE LIBLAMMPS 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_string_to_lammps_variable_data END INTERFACE ! interface definitions for calling functions in library.cpp @@ -412,17 +426,69 @@ 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 @@ -474,7 +540,11 @@ 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 INTEGER (C_int) FUNCTION lammps_has_error (handle) BIND(C) IMPORT :: c_ptr, c_int @@ -622,14 +692,14 @@ 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 @@ -1025,6 +1095,7 @@ CONTAINS 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 @@ -1059,12 +1130,125 @@ CONTAINS lmp_version = lammps_version(self%handle) END FUNCTION lmp_version - ! equivalent function to lammps_is_running - LOGICAL FUNCTION lmp_is_running(self) - CLASS(lammps), INTENT(IN) :: self + ! 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 - lmp_is_running = ( lammps_is_running(self%handle) /= 0_C_int ) - END FUNCTION lmp_is_running + 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 :: 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) + FORALL ( i = 1:strlen ) + buffer(i:i) = Cbuffer(i) + END FORALL + 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) @@ -1073,6 +1257,20 @@ CONTAINS 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), INTENT(IN) :: self + + 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 @@ -1264,6 +1462,17 @@ CONTAINS 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 + 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 @@ -1292,6 +1501,8 @@ CONTAINS str1 = 'vector of doubles' CASE (DATA_DOUBLE_2D) str1 = 'matrix of doubles' + CASE (DATA_STRING) + str1 = 'string' CASE DEFAULT str1 = 'that type' END SELECT diff --git a/python/lammps/core.py b/python/lammps/core.py index aa4aae13db..45f49332a7 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,22 @@ 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``, 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 +1114,9 @@ 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) + #vartype = LMP_VAR_EQUAL if vartype == LMP_VAR_EQUAL: self.lib.lammps_extract_variable.restype = POINTER(c_double) with ExceptionCheck(self): @@ -1130,6 +1136,11 @@ class lammps(object): self.lib.lammps_free(ptr) else: return None return result + 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 cd4742a2e4..194c0d9674 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -4572,8 +4572,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. @@ -4591,8 +4591,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 @@ -4609,7 +4609,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. @@ -4623,14 +4623,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 @@ -4649,10 +4649,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 * @@ -5609,7 +5609,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. diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index fc0d0dc956..796416b7fb 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -69,6 +69,11 @@ if(CMAKE_Fortran_COMPILER) 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_link_libraries(test_fortran_extract_variable PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranExtractVariable COMMAND test_fortran_extract_variable) + + 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..cb547f0adf --- /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/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 new file mode 100644 index 0000000000..fda68b0cad --- /dev/null +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -0,0 +1,161 @@ +MODULE keepvar + USE liblammps + IMPLICIT NONE + TYPE(LAMMPS) :: lmp + CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & + [ 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(3), PARAMETER :: cont_input = & + [ CHARACTER(LEN=40) :: & + 'create_atoms 1 single &', & + ' 0.2 0.1 0.1', & + '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 2.0' ] + CHARACTER(LEN=60), DIMENSION(4), PARAMETER :: py_input = & + [ CHARACTER(LEN=60) :: & + 'python square_it input 1 v_lp return v_square here """', & + 'def square_it(N) :', & + ' return N*N', & + '"""' ] + +CONTAINS + + FUNCTION absolute_path(filename) + CHARACTER(LEN=:), ALLOCATABLE :: absolute_path + CHARACTER(LEN=*), INTENT(IN) :: filename + CHARACTER(LEN=:), ALLOCATABLE :: test_input_directory + +print *, 'GOT HERE! filename is ', filename + test_input_directory = lmp%extract_variable('input_dir') +print *, ' test_input_directory is ', test_input_directory + absolute_path = test_input_directory // '/' // TRIM(filename) + END FUNCTION absolute_path + +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 keepvar, 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 = 80 + 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 :: 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]) + FORALL (j = 1:length) + args(i)(j:j) = Cstr(j) + END FORALL + 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 keepvar, 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 keepvar, ONLY : lmp, demo_input, cont_input, pair_input, absolute_path + IMPLICIT NONE + + CALL lmp%commands_list(demo_input) + CALL lmp%commands_list(cont_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" "group2" "group3"') + 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 index "this is a string"') + CALL lmp%command('variable fmt format lp %.6G') + CALL lmp%command('variable fmt_pad format lp %0.6g') + CALL lmp%command('variable shell getenv SHELL') +! CALL lmp%command('variable greet 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('variable py python square_it') + END IF + CALL lmp%command('variable time timer') + CALL lmp%command('variable int internal 4') + CALL lmp%command("variable nat equal count(all)") + CALL lmp%command("variable ts equal step") +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 keepvar, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_extract_variable_index_1 + CHARACTER(LEN=80) :: 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 keepvar, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_extract_variable_index_2 + CHARACTER(LEN=80) :: 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 keepvar, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_extract_variable_loop + CHARACTER(LEN=80) :: loop + + loop = lmp%extract_variable('lp') + READ(loop,*) f_lammps_extract_variable_loop +END FUNCTION f_lammps_extract_variable_loop diff --git a/unittest/fortran/wrap_extract_variable.cpp b/unittest/fortran/wrap_extract_variable.cpp new file mode 100644 index 0000000000..0e3ffecfac --- /dev/null +++ b/unittest/fortran/wrap_extract_variable.cpp @@ -0,0 +1,87 @@ +// 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" + +#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(); +double f_lammps_extract_variable_loop_pad(); +void f_lammps_setup_extract_variable_world(); +void f_lammps_setup_extract_variable_universe(); +int f_lammps_setup_extract_variable_uloop(); +void f_lammps_setup_extract_variable_string(); +void f_lammps_setup_extract_variable_format(); +void f_lammps_setup_extract_variable_getenv(); +void f_lammps_setup_extract_variable_file(); +void f_lammps_setup_extract_variable_atomfile(); +double f_lammps_setup_extract_variable_python(); +double f_lammps_setup_extract_variable_timer(); +double f_lammps_setup_extract_variable_internal(); +double f_lammps_extract_variable_equal_natoms(); +double f_lammps_extract_variable_equal_dt(); +double f_lammps_extract_variable_vector(int); +double f_lammps_extract_variable_atom(int); +} + +class LAMMPS_extract_variable : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_extract_variable() = default; + ~LAMMPS_extract_variable() override = default; + + void SetUp() override + { + const char *args[] = {"LAMMPS_Fortran_test", "-l", "none", + "-echo", "screen", "-nocite", "-var", + "input_dir", STRINGIFY(TEST_INPUT_FOLDER), + "-var", "zpos", "1.5", "-var", "x", "2"}; + char** argv = (char**) args; + int argc = sizeof(args) / sizeof(const char*); + ::testing::internal::CaptureStdout(); +std::fprintf(stderr,"THIS IS A TEST\n"); + 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(); + EXPECT_EQ(f_lammps_extract_variable_loop(), 1); +}; From 8ee17edcab2b4c7b681e805a098f84f6ddea4190 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Thu, 29 Sep 2022 23:39:39 -0500 Subject: [PATCH 17/49] Implemented more unit tests; stuck on atomfile --- fortran/lammps.f90 | 1 + unittest/fortran/CMakeLists.txt | 2 +- unittest/fortran/greetings.txt | 4 +- .../fortran/test_fortran_extract_variable.f90 | 214 +++++++++++++++--- unittest/fortran/wrap_extract_variable.cpp | 146 ++++++++++-- 5 files changed, 318 insertions(+), 49 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index eb83ce3058..7fe5e7fd8a 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -193,6 +193,7 @@ MODULE LIBLAMMPS 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 diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index 796416b7fb..8aaff70041 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -70,10 +70,10 @@ if(CMAKE_Fortran_COMPILER) 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) - else() message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler") endif() diff --git a/unittest/fortran/greetings.txt b/unittest/fortran/greetings.txt index cb547f0adf..9cccccc35d 100644 --- a/unittest/fortran/greetings.txt +++ b/unittest/fortran/greetings.txt @@ -1,8 +1,8 @@ hello -god dag +god_dag hola bonjour -guten Tag +guten_Tag konnichiwa shalom salve diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index fda68b0cad..46a4609e08 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -29,18 +29,42 @@ CONTAINS FUNCTION absolute_path(filename) CHARACTER(LEN=:), ALLOCATABLE :: absolute_path CHARACTER(LEN=*), INTENT(IN) :: filename - CHARACTER(LEN=:), ALLOCATABLE :: test_input_directory + CHARACTER(LEN=256) :: test_input_directory -print *, 'GOT HERE! filename is ', filename test_input_directory = lmp%extract_variable('input_dir') -print *, ' test_input_directory is ', test_input_directory - absolute_path = test_input_directory // '/' // TRIM(filename) + absolute_path = TRIM(test_input_directory) // '/' // TRIM(filename) 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 ISO_C_BINDING, ONLY: c_ptr, c_char, c_int, c_size_t, C_F_POINTER USE liblammps USE keepvar, ONLY: lmp IMPLICIT NONE @@ -87,33 +111,36 @@ SUBROUTINE f_lammps_close() BIND(C) END SUBROUTINE f_lammps_close SUBROUTINE f_lammps_setup_extract_variable () BIND(C) - USE LIBLAMMPS - USE keepvar, ONLY : lmp, demo_input, cont_input, pair_input, absolute_path - IMPLICIT NONE + USE LIBLAMMPS + USE keepvar, ONLY : lmp, demo_input, cont_input, pair_input, absolute_path + IMPLICIT NONE - CALL lmp%commands_list(demo_input) - CALL lmp%commands_list(cont_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" "group2" "group3"') - 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 index "this is a string"') - CALL lmp%command('variable fmt format lp %.6G') - CALL lmp%command('variable fmt_pad format lp %0.6g') - CALL lmp%command('variable shell getenv SHELL') -! CALL lmp%command('variable greet 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('variable py python square_it') - END IF - CALL lmp%command('variable time timer') - CALL lmp%command('variable int internal 4') - CALL lmp%command("variable nat equal count(all)") - CALL lmp%command("variable ts equal step") + CALL lmp%command('atom_modify map array') + CALL lmp%commands_list(demo_input) + CALL lmp%commands_list(cont_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') + ! USERNAME should exist on all platforms (incl. Windows) + CALL lmp%command('variable username getenv USERNAME') + 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('variable py python square_it') + END IF + CALL lmp%command('variable time timer') + CALL lmp%command('variable int internal 4') + CALL lmp%command("variable nat equal count(all)") + CALL lmp%command("variable ts equal step") END SUBROUTINE f_lammps_setup_extract_variable FUNCTION f_lammps_extract_variable_index_1 () BIND(C) @@ -159,3 +186,128 @@ FUNCTION f_lammps_extract_variable_loop () BIND(C) 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 keepvar, ONLY : lmp, 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 keepvar, ONLY : lmp, 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 keepvar, ONLY : lmp, 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 keepvar, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int) :: f_lammps_extract_variable_uloop + CHARACTER(LEN=80) :: 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 keepvar, ONLY : lmp, f2c_string + + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_string + CHARACTER(LEN=20) :: 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 keepvar, ONLY : lmp, 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 keepvar, ONLY : lmp, 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 keepvar, ONLY : lmp, f2c_string + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_extract_variable_getenv + CHARACTER(LEN=20) :: 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 keepvar, ONLY : lmp, 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 keepvar, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + REAL(c_double) :: f_lammps_extract_variable_atomfile + REAL(c_double), DIMENSION(:), POINTER :: atom_data + + atom_data = lmp%extract_variable('atfile') +print*, 'TESTING: atom_data is', atom_data + f_lammps_extract_variable_atomfile = atom_data(i) +END FUNCTION f_lammps_extract_variable_atomfile diff --git a/unittest/fortran/wrap_extract_variable.cpp b/unittest/fortran/wrap_extract_variable.cpp index 0e3ffecfac..3d139c222a 100644 --- a/unittest/fortran/wrap_extract_variable.cpp +++ b/unittest/fortran/wrap_extract_variable.cpp @@ -1,13 +1,14 @@ // 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 +#include #include "gtest/gtest.h" @@ -22,18 +23,19 @@ 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(); -double f_lammps_extract_variable_loop_pad(); -void f_lammps_setup_extract_variable_world(); -void f_lammps_setup_extract_variable_universe(); -int f_lammps_setup_extract_variable_uloop(); -void f_lammps_setup_extract_variable_string(); -void f_lammps_setup_extract_variable_format(); -void f_lammps_setup_extract_variable_getenv(); -void f_lammps_setup_extract_variable_file(); -void f_lammps_setup_extract_variable_atomfile(); -double f_lammps_setup_extract_variable_python(); -double f_lammps_setup_extract_variable_timer(); -double f_lammps_setup_extract_variable_internal(); +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_natoms(); double f_lammps_extract_variable_equal_dt(); double f_lammps_extract_variable_vector(int); @@ -55,7 +57,6 @@ protected: char** argv = (char**) args; int argc = sizeof(args) / sizeof(const char*); ::testing::internal::CaptureStdout(); -std::fprintf(stderr,"THIS IS A TEST\n"); 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 ("); @@ -83,5 +84,120 @@ TEST_F(LAMMPS_extract_variable, index) TEST_F(LAMMPS_extract_variable, loop) { f_lammps_setup_extract_variable(); - EXPECT_EQ(f_lammps_extract_variable_loop(), 1); + 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); +}; + +TEST_F(LAMMPS_extract_variable, format) +{ + f_lammps_setup_extract_variable(); + int i; + char str[10]; + 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[10]; + 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) +{ + f_lammps_setup_extract_variable(); + char *env = std::getenv("USERNAME"); + 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); */ }; From 756d24ff9e3426c4f9f65c769f3d80b60611c95d Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 30 Sep 2022 16:02:26 -0500 Subject: [PATCH 18/49] Implemented vector-style variables in C, Python, and Fortran APIs; unit test and more for Fortran/extract_variable --- fortran/lammps.f90 | 40 ++++++-- python/lammps/constants.py | 3 +- python/lammps/core.py | 20 ++++ src/library.cpp | 44 ++++++--- src/library.h | 7 +- .../fortran/test_fortran_extract_variable.f90 | 96 ++++++++++++++++--- unittest/fortran/wrap_extract_variable.cpp | 68 ++++++++++++- 7 files changed, 241 insertions(+), 37 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 7fe5e7fd8a..563c96024d 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -66,8 +66,9 @@ MODULE LIBLAMMPS 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 (and compatible) - LMP_VAR_STRING = 2 ! string 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 @@ -1078,12 +1079,13 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: group TYPE(lammps_variable_data) :: variable_data - TYPE(c_ptr) :: Cptr, Cname, Cgroup + TYPE(c_ptr) :: Cptr, Cname, Cgroup, Cveclength INTEGER :: length, i CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Cstring INTEGER(c_int) :: datatype - REAL(c_double), POINTER :: double - REAL(c_double), DIMENSION(:), POINTER :: double_vec + 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 @@ -1107,8 +1109,27 @@ CONTAINS 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) @@ -1117,6 +1138,11 @@ CONTAINS FORALL ( i=1:length ) variable_data%str(i:i) = Cstring(i) END FORALL + ! 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 & @@ -1453,10 +1479,12 @@ CONTAINS END SUBROUTINE assign_double_to_lammps_variable_data SUBROUTINE assign_doublevec_to_lammps_variable_data (lhs, rhs) - REAL(c_double), DIMENSION(:), INTENT(OUT), POINTER :: lhs + 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') diff --git a/python/lammps/constants.py b/python/lammps/constants.py index 6a7fda85a8..a76be819fe 100644 --- a/python/lammps/constants.py +++ b/python/lammps/constants.py @@ -42,7 +42,8 @@ LMP_ERROR_UNIVERSE = 8 LMP_VAR_EQUAL = 0 LMP_VAR_ATOM = 1 -LMP_VAR_STRING = 2 +LMP_VAR_VECTOR = 2 +LMP_VAR_STRING = 3 # ------------------------------------------------------------------------- diff --git a/python/lammps/core.py b/python/lammps/core.py index 45f49332a7..b7f3ada6a6 100644 --- a/python/lammps/core.py +++ b/python/lammps/core.py @@ -1136,6 +1136,26 @@ 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) : diff --git a/src/library.cpp b/src/library.cpp index 194c0d9674..1e0c438984 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -2043,16 +2043,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 +2069,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 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,7 +2095,7 @@ 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 + 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. @@ -2118,6 +2129,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); } @@ -2162,6 +2182,8 @@ int lammps_extract_variable_datatype(void *handle, const char *name) 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; } diff --git a/src/library.h b/src/library.h index 2eadb9c5f3..9adb274518 100644 --- a/src/library.h +++ b/src/library.h @@ -97,9 +97,10 @@ enum _LMP_ERROR_CONST { * 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_STRING = 2 /*!< return value will be a string (catch-all) */ + 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 */ diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index 46a4609e08..de0e588b86 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -17,12 +17,6 @@ MODULE keepvar 'pair_style lj/cut 2.5', & 'pair_coeff 1 1 1.0 1.0', & 'mass 1 2.0' ] - CHARACTER(LEN=60), DIMENSION(4), PARAMETER :: py_input = & - [ CHARACTER(LEN=60) :: & - 'python square_it input 1 v_lp return v_square here """', & - 'def square_it(N) :', & - ' return N*N', & - '"""' ] CONTAINS @@ -115,6 +109,14 @@ SUBROUTINE f_lammps_setup_extract_variable () BIND(C) USE keepvar, ONLY : lmp, demo_input, cont_input, pair_input, 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(demo_input) CALL lmp%commands_list(cont_input) @@ -135,12 +137,17 @@ SUBROUTINE f_lammps_setup_extract_variable () BIND(C) CALL lmp%command('variable atfile atomfile ' & // absolute_path('atomdata.txt')) IF ( lmp%config_has_package('PYTHON') ) THEN - CALL lmp%command('variable py python square_it') + 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 nat equal count(all)") - CALL lmp%command("variable ts equal step") + 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) @@ -305,9 +312,76 @@ FUNCTION f_lammps_extract_variable_atomfile(i) BIND(C) IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: i REAL(c_double) :: f_lammps_extract_variable_atomfile - REAL(c_double), DIMENSION(:), POINTER :: atom_data + REAL(c_double), DIMENSION(:), ALLOCATABLE :: atom_data atom_data = lmp%extract_variable('atfile') -print*, 'TESTING: atom_data is', atom_data f_lammps_extract_variable_atomfile = atom_data(i) END FUNCTION f_lammps_extract_variable_atomfile + +FUNCTION f_lammps_extract_variable_python(i) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_double + USE LIBLAMMPS + USE keepvar, ONLY : lmp + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: i + 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 keepvar, 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 keepvar, 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 keepvar, 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 keepvar, 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 keepvar, 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 +! vim: sts=2 ts=2 sw=2 et diff --git a/unittest/fortran/wrap_extract_variable.cpp b/unittest/fortran/wrap_extract_variable.cpp index 3d139c222a..d209b4c59b 100644 --- a/unittest/fortran/wrap_extract_variable.cpp +++ b/unittest/fortran/wrap_extract_variable.cpp @@ -9,6 +9,9 @@ #include #include #include +#include +#include +#include #include "gtest/gtest.h" @@ -36,10 +39,9 @@ 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_natoms(); -double f_lammps_extract_variable_equal_dt(); -double f_lammps_extract_variable_vector(int); +double f_lammps_extract_variable_equal(); double f_lammps_extract_variable_atom(int); +double f_lammps_extract_variable_vector(int); } class LAMMPS_extract_variable : public ::testing::Test { @@ -196,8 +198,64 @@ TEST_F(LAMMPS_extract_variable, atomfile) 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"); + 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); */ + 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); }; From d301ff9961e115f1e8cf6597f85cd005749f16c3 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 30 Sep 2022 18:31:18 -0500 Subject: [PATCH 19/49] Added set_variable and a test for it --- fortran/lammps.f90 | 31 +++++++++++++++++-- .../fortran/test_fortran_extract_variable.f90 | 17 ++++++++-- unittest/fortran/wrap_extract_variable.cpp | 5 +++ 3 files changed, 47 insertions(+), 6 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 563c96024d..ddd82719d8 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -102,6 +102,7 @@ MODULE LIBLAMMPS 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 :: version => lmp_version PROCEDURE,NOPASS :: get_os_info => lmp_get_os_info @@ -386,7 +387,12 @@ MODULE LIBLAMMPS TYPE(c_ptr) :: lammps_extract_variable END FUNCTION lammps_extract_variable - !INTEGER (c_int) lammps_set_variable + 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 @@ -1150,7 +1156,26 @@ CONTAINS END SELECT END FUNCTION lmp_extract_variable - ! equivalent function to lammps_version() + ! 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_version INTEGER FUNCTION lmp_version(self) CLASS(lammps), INTENT(IN) :: self @@ -1321,7 +1346,7 @@ CONTAINS length = LEN(buffer) Cptr = f2c_string(buffer) Cstatus = lammps_get_last_error_message(self%handle, Cptr, length) - length = MIN(LEN(buffer), c_strlen(Cptr)) + length = MIN(LEN(buffer, c_size_t), c_strlen(Cptr)) CALL C_F_POINTER(Cptr, Cbuffer, [length]) FORALL ( i=1:length ) buffer(i:i) = Cbuffer(i) diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index de0e588b86..267b5e1139 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -248,10 +248,9 @@ FUNCTION f_lammps_extract_variable_string () BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr USE LIBLAMMPS USE keepvar, ONLY : lmp, f2c_string - IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_string - CHARACTER(LEN=20) :: string + CHARACTER(LEN=40) :: string string = lmp%extract_variable('str') f_lammps_extract_variable_string = f2c_string(string) @@ -287,7 +286,7 @@ FUNCTION f_lammps_extract_variable_getenv () BIND(C) USE keepvar, ONLY : lmp, f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_getenv - CHARACTER(LEN=20) :: string + CHARACTER(LEN=40) :: string string = lmp%extract_variable('username') f_lammps_extract_variable_getenv = f2c_string(string) @@ -384,4 +383,16 @@ FUNCTION f_lammps_extract_variable_vector(i) BIND(C) 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 keepvar, ONLY : lmp, 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/wrap_extract_variable.cpp b/unittest/fortran/wrap_extract_variable.cpp index d209b4c59b..ba439fbda4 100644 --- a/unittest/fortran/wrap_extract_variable.cpp +++ b/unittest/fortran/wrap_extract_variable.cpp @@ -42,6 +42,7 @@ 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(); } class LAMMPS_extract_variable : public ::testing::Test { @@ -136,6 +137,10 @@ TEST_F(LAMMPS_extract_variable, string) 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) From 953c3d0cadc2d5edd6c6643dad3febd7043ce30d Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 30 Sep 2022 18:50:16 -0500 Subject: [PATCH 20/49] spell check; updated false positives; whitespace --- doc/src/Fortran.rst | 34 ++--- doc/utils/sphinx-config/false_positives.txt | 3 + fortran/lammps.f90 | 152 ++++++++++---------- 3 files changed, 96 insertions(+), 93 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 3112440bb0..7b3e20b978 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -180,7 +180,7 @@ 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; when accessing them through the library interfaces, +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. @@ -651,7 +651,7 @@ Procedures Bound to the lammps Derived Type 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; @@ -712,13 +712,13 @@ Procedures Bound to the lammps Derived Type 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). @@ -886,9 +886,9 @@ Procedures Bound to the lammps Derived Type - Element of global array * - ``lmp%style%atom`` - ``lmp%type%scalar`` - - - - - - + - + - + - - (not allowed) * - ``lmp%style%atom`` - ``lmp%type%vector`` @@ -904,9 +904,9 @@ Procedures Bound to the lammps Derived Type - Per-atom array * - ``lmp%style%local`` - ``lmp%type%scalar`` - - - - - - + - + - + - - (not allowed) * - ``lmp%style%local`` - ``lmp%type%vector`` @@ -986,7 +986,7 @@ Procedures Bound to the lammps Derived Type 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 reinvoke this function before the data are accessed or to + 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. @@ -1133,7 +1133,7 @@ Procedures Bound to the lammps Derived Type 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: -------- @@ -1244,7 +1244,7 @@ Procedures Bound to the lammps Derived Type 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 @@ -1272,7 +1272,7 @@ Procedures Bound to the lammps Derived Type (``DIMENSION(:)``) with allocatable length. :o integer length [optional]: length of each string in the list. Default: 31. - + -------- .. f:subroutine:: flush_buffers() @@ -1293,7 +1293,7 @@ Procedures Bound to the lammps Derived Type 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 -------- @@ -1303,7 +1303,7 @@ Procedures Bound to the lammps Derived Type 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. @@ -1325,7 +1325,7 @@ Procedures Bound to the lammps Derived Type 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. -------- diff --git a/doc/utils/sphinx-config/false_positives.txt b/doc/utils/sphinx-config/false_positives.txt index c719620fc6..b39ec746f1 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 diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index ddd82719d8..0ec58c7914 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -43,7 +43,7 @@ MODULE LIBLAMMPS ! src/library.h and python/lammps/constants.py ! ! These are NOT part of the API (the part the user sees) - INTEGER (c_int), PARAMETER :: & + 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) @@ -329,7 +329,7 @@ MODULE LIBLAMMPS 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), INTENT(IN), VALUE :: str @@ -387,11 +387,11 @@ MODULE LIBLAMMPS TYPE(c_ptr) :: lammps_extract_variable END FUNCTION lammps_extract_variable - FUNCTION lammps_set_variable (handle, name, str) BIND(C) + 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 + TYPE(c_ptr), VALUE :: handle, name, str + INTEGER(c_int) :: lammps_set_variable END FUNCTION lammps_set_variable !SUBROUTINE lammps_gather_atoms @@ -415,15 +415,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 @@ -434,11 +434,11 @@ MODULE LIBLAMMPS INTEGER(c_int) :: lammps_version END FUNCTION lammps_version - SUBROUTINE lammps_get_os_info (buffer, buf_size) BIND(C) + 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 + TYPE(C_ptr), VALUE :: buffer + INTEGER(C_int), VALUE :: buf_size END SUBROUTINE lammps_get_os_info FUNCTION lammps_config_has_mpi_support() BIND(C) @@ -474,28 +474,28 @@ MODULE LIBLAMMPS FUNCTION lammps_config_has_exceptions() BIND(C) IMPORT :: c_int IMPLICIT NONE - INTEGER (c_int) :: lammps_config_has_exceptions + 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 + 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 + INTEGER(C_int) :: lammps_config_package_count END FUNCTION lammps_config_package_count - FUNCTION lammps_config_package_name (idx, buffer, buf_size) BIND(C) + 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 + 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 @@ -503,18 +503,18 @@ MODULE LIBLAMMPS !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 @@ -523,7 +523,7 @@ MODULE LIBLAMMPS !SUBROUTINE lammps_fix_external_set_vector_length !SUBROUTINE lammps_fix_external_set_vector - SUBROUTINE lammps_flush_buffers (handle) BIND(C) + SUBROUTINE lammps_flush_buffers(handle) BIND(C) IMPORT :: C_ptr IMPLICIT NONE TYPE(C_ptr), VALUE :: handle @@ -548,19 +548,19 @@ MODULE LIBLAMMPS TYPE(c_ptr), VALUE :: handle END FUNCTION lammps_is_running - SUBROUTINE lammps_force_timeout (handle) BIND(C) + SUBROUTINE lammps_force_timeout(handle) BIND(C) IMPORT :: c_ptr IMPLICIT NONE TYPE(c_ptr), VALUE :: handle END SUBROUTINE lammps_force_timeout - INTEGER (C_int) FUNCTION lammps_has_error (handle) BIND(C) + 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 @@ -700,14 +700,14 @@ CONTAINS END SUBROUTINE lmp_commands_string ! equivalent function to lammps_get_natoms - REAL (c_double) 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 @@ -724,7 +724,7 @@ CONTAINS 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) + TYPE(c_ptr) :: ptr(7) ptr = c_null_ptr IF ( PRESENT(boxlo) ) ptr(1) = C_LOC(boxlo(1)) @@ -752,7 +752,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 @@ -765,7 +765,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 @@ -778,7 +778,7 @@ 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) + 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 @@ -849,7 +849,7 @@ CONTAINS ! 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) + 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 @@ -916,7 +916,7 @@ CONTAINS ! 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) + 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 @@ -980,7 +980,7 @@ CONTAINS CALL lammps_free(Cid) END FUNCTION lmp_extract_compute - FUNCTION lmp_extract_fix(self, id, style, type, nrow, ncol) RESULT (fix_data) + 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 @@ -1079,7 +1079,7 @@ CONTAINS END FUNCTION lmp_extract_fix ! equivalent function to lammps_extract_variable - FUNCTION lmp_extract_variable(self, name, group) RESULT (variable_data) + 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 @@ -1157,9 +1157,9 @@ CONTAINS END FUNCTION lmp_extract_variable ! equivalent function to lammps_set_variable - SUBROUTINE lmp_set_variable (self, name, str) + SUBROUTINE lmp_set_variable(self, name, str) CLASS(lammps), INTENT(IN) :: self - CHARACTER (LEN=*), INTENT(IN) :: name, str + CHARACTER(LEN=*), INTENT(IN) :: name, str INTEGER :: err TYPE(C_ptr) :: Cstr, Cname @@ -1183,7 +1183,7 @@ CONTAINS END FUNCTION lmp_version ! equivalent function to lammps_get_os_info - SUBROUTINE lmp_get_os_info (buffer) + 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 @@ -1193,7 +1193,7 @@ CONTAINS buffer = '' ptr = C_LOC(Cbuffer(1)) buf_size = LEN(buffer) - CALL lammps_get_os_info (ptr, buf_size) + 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) @@ -1251,8 +1251,8 @@ CONTAINS ! 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 + INTEGER(c_int) :: has_package + TYPE(c_ptr) :: Cname Cname = f2c_string(name) has_package = lammps_config_has_package(Cname) @@ -1261,7 +1261,7 @@ CONTAINS END FUNCTION lmp_config_has_package ! equivalent subroutine to lammps_config_package_name - SUBROUTINE lmp_config_package_name (idx, buffer) + SUBROUTINE lmp_config_package_name(idx, buffer) INTEGER, INTENT(IN) :: idx CHARACTER(LEN=*), INTENT(OUT) :: buffer INTEGER(c_int) :: Cidx, Csuccess @@ -1282,7 +1282,7 @@ CONTAINS END SUBROUTINE lmp_config_package_name ! equivalent function to Python routine .installed_packages() - SUBROUTINE lmp_installed_packages (package, length) + SUBROUTINE lmp_installed_packages(package, length) CHARACTER(LEN=:), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: package INTEGER, INTENT(IN), OPTIONAL :: length INTEGER, PARAMETER :: MAX_BUFFER_LENGTH = 31 @@ -1317,7 +1317,7 @@ CONTAINS END FUNCTION lmp_is_running ! equivalent function to lammps_force_timeout - SUBROUTINE lmp_force_timeout (self) + SUBROUTINE lmp_force_timeout(self) CLASS(lammps), INTENT(IN) :: self CALL lammps_force_timeout(self%handle) @@ -1365,7 +1365,7 @@ CONTAINS ! ---------------------------------------------------------------------- ! 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 @@ -1376,7 +1376,7 @@ CONTAINS 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 @@ -1387,7 +1387,7 @@ CONTAINS 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 @@ -1398,7 +1398,7 @@ CONTAINS END IF END SUBROUTINE assign_intvec_to_lammps_data - SUBROUTINE assign_int64vec_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 @@ -1409,7 +1409,7 @@ CONTAINS END IF END SUBROUTINE assign_int64vec_to_lammps_data - SUBROUTINE assign_double_to_lammps_data (lhs, rhs) + SUBROUTINE assign_double_to_lammps_data(lhs, rhs) REAL(c_double), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs @@ -1420,7 +1420,7 @@ CONTAINS 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 @@ -1431,7 +1431,7 @@ CONTAINS END IF END SUBROUTINE assign_doublevec_to_lammps_data - SUBROUTINE assign_doublemat_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 @@ -1442,7 +1442,7 @@ CONTAINS END IF END SUBROUTINE assign_doublemat_to_lammps_data - SUBROUTINE assign_string_to_lammps_data (lhs, rhs) + SUBROUTINE assign_string_to_lammps_data(lhs, rhs) CHARACTER(LEN=*), INTENT(OUT) :: lhs CLASS(lammps_data), INTENT(IN) :: rhs @@ -1456,7 +1456,7 @@ CONTAINS ! ---------------------------------------------------------------------- ! functions to assign user-space pointers to LAMMPS *fix* data ! ---------------------------------------------------------------------- - SUBROUTINE assign_double_to_lammps_fix_data (lhs, rhs) + SUBROUTINE assign_double_to_lammps_fix_data(lhs, rhs) REAL(c_double), INTENT(OUT) :: lhs CLASS(lammps_fix_data), INTENT(IN) :: rhs @@ -1467,7 +1467,7 @@ CONTAINS END IF END SUBROUTINE assign_double_to_lammps_fix_data - SUBROUTINE assign_doublevec_to_lammps_fix_data (lhs, rhs) + SUBROUTINE assign_doublevec_to_lammps_fix_data(lhs, rhs) REAL(c_double), DIMENSION(:), INTENT(OUT), POINTER :: lhs CLASS(lammps_fix_data), INTENT(IN) :: rhs @@ -1478,7 +1478,7 @@ CONTAINS END IF END SUBROUTINE assign_doublevec_to_lammps_fix_data - SUBROUTINE assign_doublemat_to_lammps_fix_data (lhs, rhs) + SUBROUTINE assign_doublemat_to_lammps_fix_data(lhs, rhs) REAL(c_double), DIMENSION(:,:), INTENT(OUT), POINTER :: lhs CLASS(lammps_fix_data), INTENT(IN) :: rhs @@ -1492,7 +1492,7 @@ CONTAINS ! ---------------------------------------------------------------------- ! functions to assign user-space pointers to LAMMPS *variable* data ! ---------------------------------------------------------------------- - SUBROUTINE assign_double_to_lammps_variable_data (lhs, rhs) + SUBROUTINE assign_double_to_lammps_variable_data(lhs, rhs) REAL(c_double), INTENT(OUT) :: lhs CLASS(lammps_variable_data), INTENT(IN) :: rhs @@ -1503,7 +1503,7 @@ CONTAINS END IF END SUBROUTINE assign_double_to_lammps_variable_data - SUBROUTINE assign_doublevec_to_lammps_variable_data (lhs, rhs) + SUBROUTINE assign_doublevec_to_lammps_variable_data(lhs, rhs) REAL(c_double), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: lhs CLASS(lammps_variable_data), INTENT(IN) :: rhs @@ -1516,7 +1516,7 @@ CONTAINS END IF END SUBROUTINE assign_doublevec_to_lammps_variable_data - SUBROUTINE assign_string_to_lammps_variable_data (lhs, rhs) + SUBROUTINE assign_string_to_lammps_variable_data(lhs, rhs) CHARACTER(LEN=*), INTENT(OUT) :: lhs CLASS(lammps_variable_data), INTENT(IN) :: rhs @@ -1531,31 +1531,31 @@ CONTAINS ! Generic function to catch all errors in assignments of LAMMPS data to ! user-space variables/pointers ! ---------------------------------------------------------------------- - SUBROUTINE assignment_error (type1, str2) + SUBROUTINE assignment_error(type1, str2) CLASS(lammps_data_baseclass), INTENT(IN) :: type1 - CHARACTER (LEN=*), INTENT(IN) :: str2 - CHARACTER (LEN=:), ALLOCATABLE :: str1 + CHARACTER(LEN=*), INTENT(IN) :: str2 + CHARACTER(LEN=:), ALLOCATABLE :: str1 - SELECT CASE (type1%datatype) - CASE (DATA_INT) + 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) + CASE(DATA_STRING) str1 = 'string' CASE DEFAULT str1 = 'that type' From 6dea4d50d61c829f13af7e2ca652d119c15a76d4 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 30 Sep 2022 19:51:56 -0500 Subject: [PATCH 21/49] Fixed oversight in edits to example in Fortran doc page --- doc/src/Fortran.rst | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 7b3e20b978..73e3499565 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -193,17 +193,17 @@ Below is an example demonstrating some of the possible uses. USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int64_t USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : OUTPUT_UNIT TYPE(lammps) :: lmp - INTEGER(KIND=c_int64_t) :: natoms + 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 = lmp%extract_setting('natoms') - WRITE(OUTPUT_UNIT,'(A,I8,A)') 'Running a simulation with', natoms, ' atoms' - WRITE(OUTPUT_UNIT,'(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') From eac855343fee8b64f2ab1c4eb8ccddd13386ccb2 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 30 Sep 2022 19:54:58 -0500 Subject: [PATCH 22/49] Spacing --- doc/src/Fortran.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 73e3499565..2d03f135a9 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -201,9 +201,9 @@ Below is an example demonstrating some of the possible uses. lmp = lammps() CALL lmp%file('in.sysinit') natoms = lmp%extract_global('natoms') - WRITE(OUTPUT_UNIT,'(A,I0,A)') 'Running a simulation with', natoms, ' atoms' + 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. ', & + ' local and ', lmp%extract_setting('nghost'), ' ghost atoms. ', & lmp%extract_setting('ntypes'), ' atom types' CALL lmp%command('run 2 post no') From 9c314966aebe7b626a8fc3d0aa6c2bbc56a08f2c Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 30 Sep 2022 19:58:56 -0500 Subject: [PATCH 23/49] More spacing --- doc/src/Fortran.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 2d03f135a9..c17c39db72 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -209,12 +209,12 @@ Below is an example demonstrating some of the possible uses. CALL lmp%command('run 2 post no') dt = lmp%extract_global('dt') ntimestep = lmp%extract_global('ntimestep') - WRITE(OUTPUT_UNIT,'(A,I4,A,F4.1,A)') 'At step:', ntimestep, & + 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(OUTPUT_UNIT,'(A,I0)') 'At step:', ntimestep + WRITE(OUTPUT_UNIT,'(A,I0)') 'At step: ', ntimestep pe = lmp%get_thermo('pe') ke = lmp%get_thermo('ke') PRINT*, 'PE = ', pe From 9183c0e1c80014f5463ea84d9b23a3f1f2396b89 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 30 Sep 2022 20:02:23 -0500 Subject: [PATCH 24/49] Removed commented-out line now that I know it works --- python/lammps/core.py | 1 - 1 file changed, 1 deletion(-) diff --git a/python/lammps/core.py b/python/lammps/core.py index b7f3ada6a6..fb2be48feb 100644 --- a/python/lammps/core.py +++ b/python/lammps/core.py @@ -1116,7 +1116,6 @@ class lammps(object): if group: group = group.encode() if vartype is None : vartype = self.lib.lammps_extract_variable_datatype(self.lmp, name) - #vartype = LMP_VAR_EQUAL if vartype == LMP_VAR_EQUAL: self.lib.lammps_extract_variable.restype = POINTER(c_double) with ExceptionCheck(self): From da2f7f6fad196b588dba7b7e12d8348e3000219d Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 30 Sep 2022 20:14:40 -0500 Subject: [PATCH 25/49] Forgot to put LMP_VAR_VECTOR in the documentation --- python/lammps/core.py | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/python/lammps/core.py b/python/lammps/core.py index fb2be48feb..074e579d13 100644 --- a/python/lammps/core.py +++ b/python/lammps/core.py @@ -1096,11 +1096,12 @@ class lammps(object): The variable must be either an equal-style (or equivalent) 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``, 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". + 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 From 2f5e0646d9bd61dc040c126b77576ecc3599ea3c Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 30 Sep 2022 21:55:50 -0500 Subject: [PATCH 26/49] Fixed typo in test_fortran_properties --- unittest/fortran/test_fortran_properties.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unittest/fortran/test_fortran_properties.f90 b/unittest/fortran/test_fortran_properties.f90 index 36b1c30638..153cab8c77 100644 --- a/unittest/fortran/test_fortran_properties.f90 +++ b/unittest/fortran/test_fortran_properties.f90 @@ -53,7 +53,7 @@ END FUNCTION f_lammps_extract_setting FUNCTION f_lammps_has_error () BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int - USE keepcmds, ONLY : lmp + USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE INTEGER(C_int) :: f_lammps_has_error From c5c21bb36c552c9cb07fa5a0ee1a3cfc30d46769 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Sun, 2 Oct 2022 15:28:10 -0500 Subject: [PATCH 27/49] Implemented, tested, and documented gather_atoms and variants; added RST docs for lammps_scatter_atoms and lammps_gather_atoms and variants (library.cpp); checked for missing atom map in lammps_gather_atoms_subset; fixed bug in keepstuff.f90; fixed docs for extract_variable --- doc/src/Fortran.rst | 90 ++++++- fortran/lammps.f90 | 237 +++++++++++++++++- src/library.cpp | 221 +++++++++++----- unittest/fortran/CMakeLists.txt | 4 + unittest/fortran/keepstuff.f90 | 14 +- .../fortran/test_fortran_extract_atom.f90 | 42 +--- .../fortran/test_fortran_extract_compute.f90 | 43 +--- .../fortran/test_fortran_gather_scatter.f90 | 143 +++++++++++ unittest/fortran/wrap_gather_scatter.cpp | 140 +++++++++++ 9 files changed, 796 insertions(+), 138 deletions(-) create mode 100644 unittest/fortran/test_fortran_gather_scatter.f90 create mode 100644 unittest/fortran/wrap_gather_scatter.cpp diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index c17c39db72..12056df995 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -1070,11 +1070,13 @@ Procedures Bound to the lammps Derived Type 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(nlocal)`` for *atom*-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. + ``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:: @@ -1086,6 +1088,84 @@ Procedures Bound to the lammps Derived Type -------- +.. f:function:: 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)``. + +-------- + +.. f:function:: 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:function:: version() This method returns the numeric LAMMPS version like diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 0ec58c7914..ad90d45aa4 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_associated, & - c_loc, c_int, c_int64_t, c_char, c_null_char, c_double, c_size_t, & - c_f_pointer + 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 @@ -103,6 +103,17 @@ MODULE LIBLAMMPS PROCEDURE :: extract_fix => lmp_extract_fix PROCEDURE :: extract_variable => lmp_extract_variable PROCEDURE :: set_variable => lmp_set_variable + PROCEDURE, PRIVATE :: lmp_gather_atoms_int, 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 :: version => lmp_version PROCEDURE,NOPASS :: get_os_info => lmp_get_os_info @@ -394,11 +405,28 @@ MODULE LIBLAMMPS INTEGER(c_int) :: lammps_set_variable END FUNCTION lammps_set_variable - !SUBROUTINE lammps_gather_atoms + 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_concat + 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_gather_atoms_subset + 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 @@ -1175,6 +1203,203 @@ CONTAINS 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=80) :: 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=80) :: 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=80) :: 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=80) :: 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 + CHARACTER(LEN=80) :: 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 + + 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 + CHARACTER(LEN=80) :: 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 + + 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_version INTEGER FUNCTION lmp_version(self) CLASS(lammps), INTENT(IN) :: self diff --git a/src/library.cpp b/src/library.cpp index 1e0c438984..0851980207 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -2222,21 +2222,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 @@ -2357,23 +2374,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 ------------------------------------------------------------------------- */ @@ -2503,23 +2540,38 @@ 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 +(e.g., if *name* is *x* and *count* = 3, then *data* might look like +x[100][0], x[100][1], x[100][2], x[101][0], x[101][1], x[101][2], x[102][0], +:math:`\dots`); *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 @@ -2540,12 +2592,13 @@ 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"); @@ -2649,18 +2702,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 ------------------------------------------------------------------------- */ @@ -2765,6 +2835,38 @@ 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 @@ -3528,11 +3630,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"); diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index 0c813573f5..d3c18c9941 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -74,6 +74,10 @@ if(CMAKE_Fortran_COMPILER) 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/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_extract_atom.f90 b/unittest/fortran/test_fortran_extract_atom.f90 index 5f899f80e0..eb55754561 100644 --- a/unittest/fortran/test_fortran_extract_atom.f90 +++ b/unittest/fortran/test_fortran_extract_atom.f90 @@ -1,26 +1,7 @@ -MODULE keepatom - USE liblammps - TYPE(LAMMPS) :: lmp - CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & - [ 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) :: & - 'create_atoms 1 single &', & - ' 0.2 0.1 0.1' ] - 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 2.0' ] -END MODULE keepatom - FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") USE ISO_C_BINDING, ONLY: c_ptr USE liblammps - USE keepatom, ONLY: lmp + USE keepstuff, ONLY: lmp IMPLICIT NONE TYPE(c_ptr) :: f_lammps_with_args CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = & @@ -34,7 +15,7 @@ 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 keepatom, ONLY: lmp + USE keepstuff, ONLY: lmp IMPLICIT NONE CALL lmp%close() @@ -43,19 +24,18 @@ END SUBROUTINE f_lammps_close SUBROUTINE f_lammps_setup_extract_atom () BIND(C) USE LIBLAMMPS - USE keepatom, ONLY : lmp, demo_input, cont_input, pair_input + USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input IMPLICIT NONE - CALL lmp%commands_list(demo_input) + CALL lmp%commands_list(big_input) CALL lmp%commands_list(cont_input) CALL lmp%commands_list(pair_input) -! CALL lmp%command('run 0') 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 keepatom, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE REAL(C_double) :: f_lammps_extract_atom_mass REAL(C_double), DIMENSION(:), POINTER :: mass => NULL() @@ -67,7 +47,7 @@ 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 keepatom, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i INTEGER(C_int) :: f_lammps_extract_atom_tag_int @@ -80,7 +60,7 @@ 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 keepatom, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int64_t), INTENT(IN), VALUE :: i INTEGER(C_int64_t) :: f_lammps_extract_atom_tag_int64 @@ -93,7 +73,7 @@ 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 keepatom, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i INTEGER(C_int) :: f_lammps_extract_atom_type @@ -106,7 +86,7 @@ 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 keepatom, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i INTEGER(C_int) :: f_lammps_extract_atom_mask @@ -119,7 +99,7 @@ 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 keepatom, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i REAL(C_double), DIMENSION(3) :: x @@ -132,7 +112,7 @@ 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 keepatom, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i REAL(C_double), DIMENSION(3) :: v diff --git a/unittest/fortran/test_fortran_extract_compute.f90 b/unittest/fortran/test_fortran_extract_compute.f90 index 64b5068171..8f5bbdfd51 100644 --- a/unittest/fortran/test_fortran_extract_compute.f90 +++ b/unittest/fortran/test_fortran_extract_compute.f90 @@ -1,27 +1,7 @@ -MODULE keepcompute - USE liblammps - TYPE(LAMMPS) :: lmp - CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & - [ 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(3), PARAMETER :: cont_input = & - [ CHARACTER(len=40) :: & - 'create_atoms 1 single &', & - ' 0.2 0.1 0.1', & - '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 2.0' ] -END MODULE keepcompute - FUNCTION f_lammps_with_args() BIND(C) USE ISO_C_BINDING, ONLY: c_ptr USE liblammps - USE keepcompute, ONLY: lmp + USE keepstuff, ONLY: lmp IMPLICIT NONE TYPE(c_ptr) :: f_lammps_with_args CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = & @@ -35,7 +15,7 @@ END FUNCTION f_lammps_with_args SUBROUTINE f_lammps_close() BIND(C) USE ISO_C_BINDING, ONLY: c_null_ptr USE liblammps - USE keepcompute, ONLY: lmp + USE keepstuff, ONLY: lmp IMPLICIT NONE CALL lmp%close() @@ -44,11 +24,12 @@ END SUBROUTINE f_lammps_close SUBROUTINE f_lammps_setup_extract_compute () BIND(C) USE LIBLAMMPS - USE keepcompute, ONLY : lmp, demo_input, cont_input, pair_input + USE keepstuff, ONLY : lmp, big_input, cont_input, more_input, pair_input IMPLICIT NONE - CALL lmp%commands_list(demo_input) + 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 @@ -64,7 +45,7 @@ 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 keepcompute, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i REAL(C_double) :: f_lammps_extract_compute_peratom_vector @@ -77,7 +58,7 @@ 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 keepcompute, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i, j REAL(C_double) :: f_lammps_extract_compute_peratom_array @@ -90,7 +71,7 @@ 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 keepcompute, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE REAL(C_double) :: f_lammps_extract_compute_global_scalar REAL(C_double), POINTER :: scalar @@ -102,7 +83,7 @@ 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 keepcompute, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: i REAL(C_double) :: f_lammps_extract_compute_global_vector @@ -115,7 +96,7 @@ 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 keepcompute, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: i, j REAL(C_double) :: f_lammps_extract_compute_global_array @@ -128,7 +109,7 @@ 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 keepcompute, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: i REAL(C_double) :: f_lammps_extract_compute_local_vector @@ -141,7 +122,7 @@ 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 keepcompute, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: i, j REAL(C_double) :: f_lammps_extract_compute_local_array diff --git a/unittest/fortran/test_fortran_gather_scatter.f90 b/unittest/fortran/test_fortran_gather_scatter.f90 new file mode 100644 index 0000000000..86870721ba --- /dev/null +++ b/unittest/fortran/test_fortran_gather_scatter.f90 @@ -0,0 +1,143 @@ +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_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_mask + INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask + + CALL lmp%gather_atoms('mask', 1_c_int, mask) + f_lammps_gather_mask = mask(i) +END FUNCTION f_lammps_gather_mask + +FUNCTION f_lammps_gather_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_position + REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions + + CALL lmp%gather_atoms('x', 3_c_int, positions) + f_lammps_gather_position = positions(i) +END FUNCTION f_lammps_gather_position + +FUNCTION f_lammps_gather_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_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_concat_mask = mask(j) + RETURN + END IF + END DO + f_lammps_gather_concat_mask = -1 +END FUNCTION f_lammps_gather_concat_mask + +FUNCTION f_lammps_gather_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_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_concat_position = positions((j-1)*3 + xyz) + END IF + END DO +END FUNCTION f_lammps_gather_concat_position + +FUNCTION f_lammps_gather_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_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_subset_mask = mask(j) + RETURN + END IF + END DO + f_lammps_gather_subset_mask = -1 +END FUNCTION f_lammps_gather_subset_mask + +FUNCTION f_lammps_gather_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_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_subset_position = positions((j-1)*3 + xyz) + RETURN + END IF + END DO + f_lammps_gather_subset_position = -1.0D0 +END FUNCTION f_lammps_gather_subset_position diff --git a/unittest/fortran/wrap_gather_scatter.cpp b/unittest/fortran/wrap_gather_scatter.cpp new file mode 100644 index 0000000000..4fd733a167 --- /dev/null +++ b/unittest/fortran/wrap_gather_scatter.cpp @@ -0,0 +1,140 @@ +// 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_mask(int); +double f_lammps_gather_position(int); +int f_lammps_gather_concat_mask(int); +double f_lammps_gather_concat_position(int,int); +int f_lammps_gather_subset_mask(int); +double f_lammps_gather_subset_position(int,int); +} + +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_masks) +{ + f_lammps_setup_gather_scatter(); + EXPECT_EQ(f_lammps_gather_mask(1), 1); + EXPECT_EQ(f_lammps_gather_mask(2), 1); + EXPECT_EQ(f_lammps_gather_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_mask(1), 3); + EXPECT_EQ(f_lammps_gather_mask(2), 5); + EXPECT_EQ(f_lammps_gather_mask(3), 9); + lammps_command(lmp, "group other id 1"); + EXPECT_EQ(f_lammps_gather_mask(1), 7); + EXPECT_EQ(f_lammps_gather_mask(2), 5); + EXPECT_EQ(f_lammps_gather_mask(3), 9); +}; + +TEST_F(LAMMPS_gather_scatter, gather_positions) +{ + f_lammps_setup_gather_scatter(); + EXPECT_EQ(f_lammps_gather_position(1), 1.0); + EXPECT_EQ(f_lammps_gather_position(2), 1.0); + EXPECT_EQ(f_lammps_gather_position(3), 1.5); + EXPECT_EQ(f_lammps_gather_position(4), 0.2); + EXPECT_EQ(f_lammps_gather_position(5), 0.1); + EXPECT_EQ(f_lammps_gather_position(6), 0.1); + EXPECT_EQ(f_lammps_gather_position(7), 0.5); + EXPECT_EQ(f_lammps_gather_position(8), 0.5); + EXPECT_EQ(f_lammps_gather_position(9), 0.5); +}; + +TEST_F(LAMMPS_gather_scatter, gather_masks_concat) +{ + f_lammps_setup_gather_scatter(); + EXPECT_EQ(f_lammps_gather_concat_mask(1), 1); + EXPECT_EQ(f_lammps_gather_concat_mask(2), 1); + EXPECT_EQ(f_lammps_gather_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_concat_mask(1), 3); + EXPECT_EQ(f_lammps_gather_concat_mask(2), 5); + EXPECT_EQ(f_lammps_gather_concat_mask(3), 9); + lammps_command(lmp, "group other id 1"); + EXPECT_EQ(f_lammps_gather_concat_mask(1), 7); + EXPECT_EQ(f_lammps_gather_concat_mask(2), 5); + EXPECT_EQ(f_lammps_gather_concat_mask(3), 9); +}; + +TEST_F(LAMMPS_gather_scatter, gather_positions_concat) +{ + f_lammps_setup_gather_scatter(); + EXPECT_EQ(f_lammps_gather_concat_position(1,1), 1.0); + EXPECT_EQ(f_lammps_gather_concat_position(2,1), 1.0); + EXPECT_EQ(f_lammps_gather_concat_position(3,1), 1.5); + EXPECT_EQ(f_lammps_gather_concat_position(1,2), 0.2); + EXPECT_EQ(f_lammps_gather_concat_position(2,2), 0.1); + EXPECT_EQ(f_lammps_gather_concat_position(3,2), 0.1); + EXPECT_EQ(f_lammps_gather_concat_position(1,3), 0.5); + EXPECT_EQ(f_lammps_gather_concat_position(2,3), 0.5); + EXPECT_EQ(f_lammps_gather_concat_position(3,3), 0.5); +}; + +TEST_F(LAMMPS_gather_scatter, gather_masks_subset) +{ + f_lammps_setup_gather_scatter(); + EXPECT_EQ(f_lammps_gather_subset_mask(2), 1); + EXPECT_EQ(f_lammps_gather_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_EQ(f_lammps_gather_subset_mask(2), 5); + EXPECT_EQ(f_lammps_gather_subset_mask(3), 9); + lammps_command(lmp, "group other id 3"); + EXPECT_EQ(f_lammps_gather_subset_mask(2), 5); + EXPECT_EQ(f_lammps_gather_subset_mask(3), 13); +}; + +TEST_F(LAMMPS_gather_scatter, gather_positions_subset) +{ + f_lammps_setup_gather_scatter(); +// EXPECT_EQ(f_lammps_gather_subset_position(1,1), 1.0); +// EXPECT_EQ(f_lammps_gather_subset_position(2,1), 1.0); +// EXPECT_EQ(f_lammps_gather_subset_position(3,1), 1.5); + EXPECT_EQ(f_lammps_gather_subset_position(1,2), 0.2); + EXPECT_EQ(f_lammps_gather_subset_position(2,2), 0.1); + EXPECT_EQ(f_lammps_gather_subset_position(3,2), 0.1); + EXPECT_EQ(f_lammps_gather_subset_position(1,3), 0.5); + EXPECT_EQ(f_lammps_gather_subset_position(2,3), 0.5); + EXPECT_EQ(f_lammps_gather_subset_position(3,3), 0.5); +}; From db9b59c269983581f8983e7cc602b887657654c7 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Sun, 2 Oct 2022 20:32:42 -0500 Subject: [PATCH 28/49] Implemented scatter_atoms and scatter_atoms_subset + unit tests + documentation + typos/edits --- doc/src/Fortran.rst | 141 ++++++++-- fortran/README | 8 +- fortran/lammps.f90 | 161 ++++++++++- src/library.cpp | 16 +- .../fortran/test_fortran_gather_scatter.f90 | 113 ++++++-- unittest/fortran/wrap_gather_scatter.cpp | 251 +++++++++++------- 6 files changed, 520 insertions(+), 170 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 12056df995..a62378819f 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -1,14 +1,14 @@ 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 programs. Thus, the LAMMPS Fortran module needs to be compiled alongside the code using it from the source code in @@ -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,8 +62,8 @@ 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 @@ -178,11 +178,13 @@ Accessing system properties 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; 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. +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. @@ -258,6 +260,11 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :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` @@ -1041,9 +1048,8 @@ Procedures Bound to the lammps Derived Type 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 either have - the ``ALLOCATABLE`` attribute or be long enough to contain the data without - reallocation. + ``REAL(c_double)``, be of rank 1 (i.e., ``DIMENSION(:)``), and have the + ``ALLOCATABLE`` attribute. .. note:: @@ -1088,7 +1094,7 @@ Procedures Bound to the lammps Derived Type -------- -.. f:function:: gather_atoms(name, count, data) +.. 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 @@ -1135,10 +1141,11 @@ Procedures Bound to the lammps Derived Type 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:function:: gather_atoms_concat(name, count, data) +.. 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 @@ -1166,6 +1173,100 @@ Procedures Bound to the lammps Derived Type -------- +.. 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 @@ -1183,8 +1284,8 @@ Procedures Bound to the lammps Derived Type .. versionadded:: TBD A suitable buffer has to be provided. The assembled text will be truncated - to not overflow this buffer. The string is typically a few hundred bytes - long. + so as not to overflow this buffer. The string is typically a few hundred + bytes long. -------- 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 ad90d45aa4..8fad0d43e5 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -114,7 +114,14 @@ MODULE LIBLAMMPS 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, 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 @@ -428,9 +435,20 @@ MODULE LIBLAMMPS INTEGER(c_int), VALUE :: type, count, ndata END SUBROUTINE lammps_gather_atoms_subset - !SUBROUTINE lammps_scatter_atoms + 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 + 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 @@ -1212,8 +1230,8 @@ CONTAINS TYPE(c_ptr) :: Cdata, Cname INTEGER(c_int) :: natoms INTEGER(c_int), PARAMETER :: Ctype = 0_c_int - REAL(C_double) :: dnatoms - CHARACTER(LEN=80) :: error_msg + 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& @@ -1247,7 +1265,7 @@ CONTAINS INTEGER(c_int) :: natoms INTEGER(c_int), PARAMETER :: Ctype = 1_c_int REAL(C_double) :: dnatoms - CHARACTER(LEN=80) :: error_msg + CHARACTER(LEN=100) :: error_msg IF ( count /= 1 .AND. count /= 3 ) THEN CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, 'gather_atoms& @@ -1281,7 +1299,7 @@ CONTAINS INTEGER(c_int) :: natoms INTEGER(c_int), PARAMETER :: Ctype = 0_c_int REAL(C_double) :: dnatoms - CHARACTER(LEN=80) :: error_msg + CHARACTER(LEN=100) :: error_msg IF ( count /= 1 .AND. count /= 3 ) THEN CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & @@ -1316,7 +1334,7 @@ CONTAINS INTEGER(c_int) :: natoms INTEGER(c_int), PARAMETER :: Ctype = 1_c_int REAL(C_double) :: dnatoms - CHARACTER(LEN=80) :: error_msg + CHARACTER(LEN=100) :: error_msg IF ( count /= 1 .AND. count /= 3 ) THEN CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & @@ -1351,11 +1369,12 @@ CONTAINS INTEGER(c_int) :: ndata TYPE(c_ptr) :: Cdata, Cname, Cids INTEGER(c_int), PARAMETER :: Ctype = 0_c_int - CHARACTER(LEN=80) :: error_msg + 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]') + 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) @@ -1381,11 +1400,12 @@ CONTAINS INTEGER(c_int) :: ndata TYPE(c_ptr) :: Cdata, Cname, Cids INTEGER(c_int), PARAMETER :: Ctype = 1_c_int - CHARACTER(LEN=80) :: error_msg + 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]') + 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) @@ -1400,6 +1420,121 @@ CONTAINS 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 + CHARACTER(LEN=100) :: error_msg + + 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) + 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 + CHARACTER(LEN=100) :: error_msg + + 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) + 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), INTENT(IN) :: self diff --git a/src/library.cpp b/src/library.cpp index 0851980207..fe16d1e518 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -2551,10 +2551,12 @@ 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 -(e.g., if *name* is *x* and *count* = 3, then *data* might look like -x[100][0], x[100][1], x[100][2], x[101][0], x[101][1], x[101][2], x[102][0], -:math:`\dots`); *data* must be pre-allocated by the caller to length (*count* -:math:`\times` *ndata*). +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 * @@ -2601,7 +2603,7 @@ void lammps_gather_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_gather_atoms_subset"); + lmp->error->warning(FLERR,"Library error in lammps_gather_atoms_subset: atoms must have mappable ids"); return; } @@ -2757,7 +2759,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; } @@ -2908,7 +2910,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; } diff --git a/unittest/fortran/test_fortran_gather_scatter.f90 b/unittest/fortran/test_fortran_gather_scatter.f90 index 86870721ba..dd9182afaa 100644 --- a/unittest/fortran/test_fortran_gather_scatter.f90 +++ b/unittest/fortran/test_fortran_gather_scatter.f90 @@ -33,39 +33,39 @@ SUBROUTINE f_lammps_setup_gather_scatter () BIND(C) CALL lmp%commands_list(more_input) END SUBROUTINE f_lammps_setup_gather_scatter -FUNCTION f_lammps_gather_mask (i) BIND(C) +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_mask + 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_mask = mask(i) -END FUNCTION f_lammps_gather_mask + f_lammps_gather_atoms_mask = mask(i) +END FUNCTION f_lammps_gather_atoms_mask -FUNCTION f_lammps_gather_position (i) BIND(C) +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_position + 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_position = positions(i) -END FUNCTION f_lammps_gather_position + f_lammps_gather_atoms_position = positions(i) +END FUNCTION f_lammps_gather_atoms_position -FUNCTION f_lammps_gather_concat_mask (i) BIND(C) +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_concat_mask + INTEGER(c_int) :: f_lammps_gather_atoms_concat_mask INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask, tag INTEGER :: j @@ -73,20 +73,20 @@ FUNCTION f_lammps_gather_concat_mask (i) BIND(C) CALL lmp%gather_atoms_concat('id', 1_c_int, tag) DO j = 1, SIZE(tag) IF ( tag(j) == i ) THEN - f_lammps_gather_concat_mask = mask(j) + f_lammps_gather_atoms_concat_mask = mask(j) RETURN END IF END DO - f_lammps_gather_concat_mask = -1 -END FUNCTION f_lammps_gather_concat_mask + f_lammps_gather_atoms_concat_mask = -1 +END FUNCTION f_lammps_gather_atoms_concat_mask -FUNCTION f_lammps_gather_concat_position (xyz, id) BIND(C) +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_concat_position + REAL(c_double) :: f_lammps_gather_atoms_concat_position REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: tag INTEGER :: j @@ -95,18 +95,18 @@ FUNCTION f_lammps_gather_concat_position (xyz, id) BIND(C) CALL lmp%gather_atoms_concat('id', 1_c_int, tag) DO j = 1, SIZE(tag) IF ( tag(j) == id ) THEN - f_lammps_gather_concat_position = positions((j-1)*3 + xyz) + f_lammps_gather_atoms_concat_position = positions((j-1)*3 + xyz) END IF END DO -END FUNCTION f_lammps_gather_concat_position +END FUNCTION f_lammps_gather_atoms_concat_position -FUNCTION f_lammps_gather_subset_mask (i) BIND(C) +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_subset_mask + 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] @@ -114,20 +114,20 @@ FUNCTION f_lammps_gather_subset_mask (i) BIND(C) CALL lmp%gather_atoms_subset('mask', 1_c_int, tag, mask) DO j = 1, SIZE(tag) IF ( tag(j) == i ) THEN - f_lammps_gather_subset_mask = mask(j) + f_lammps_gather_atoms_subset_mask = mask(j) RETURN END IF END DO - f_lammps_gather_subset_mask = -1 -END FUNCTION f_lammps_gather_subset_mask + f_lammps_gather_atoms_subset_mask = -1 +END FUNCTION f_lammps_gather_atoms_subset_mask -FUNCTION f_lammps_gather_subset_position (xyz,id) BIND(C) +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_subset_position + 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 @@ -135,9 +135,68 @@ FUNCTION f_lammps_gather_subset_position (xyz,id) BIND(C) CALL lmp%gather_atoms_subset('x', 3_c_int, tag, positions) DO j = 1, SIZE(tag) IF ( tag(j) == id ) THEN - f_lammps_gather_subset_position = positions((j-1)*3 + xyz) + f_lammps_gather_atoms_subset_position = positions((j-1)*3 + xyz) RETURN END IF END DO - f_lammps_gather_subset_position = -1.0D0 -END FUNCTION f_lammps_gather_subset_position + 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 + INTEGER(c_int) :: swap + + 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/wrap_gather_scatter.cpp b/unittest/fortran/wrap_gather_scatter.cpp index 4fd733a167..96397b7681 100644 --- a/unittest/fortran/wrap_gather_scatter.cpp +++ b/unittest/fortran/wrap_gather_scatter.cpp @@ -15,126 +15,179 @@ extern "C" { void *f_lammps_with_args(); void f_lammps_close(); void f_lammps_setup_gather_scatter(); -int f_lammps_gather_mask(int); -double f_lammps_gather_position(int); -int f_lammps_gather_concat_mask(int); -double f_lammps_gather_concat_position(int,int); -int f_lammps_gather_subset_mask(int); -double f_lammps_gather_subset_position(int,int); +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; + 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; - } + 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_masks) +TEST_F(LAMMPS_gather_scatter, gather_atoms_masks) { - f_lammps_setup_gather_scatter(); - EXPECT_EQ(f_lammps_gather_mask(1), 1); - EXPECT_EQ(f_lammps_gather_mask(2), 1); - EXPECT_EQ(f_lammps_gather_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_mask(1), 3); - EXPECT_EQ(f_lammps_gather_mask(2), 5); - EXPECT_EQ(f_lammps_gather_mask(3), 9); - lammps_command(lmp, "group other id 1"); - EXPECT_EQ(f_lammps_gather_mask(1), 7); - EXPECT_EQ(f_lammps_gather_mask(2), 5); - EXPECT_EQ(f_lammps_gather_mask(3), 9); + 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_positions) +TEST_F(LAMMPS_gather_scatter, gather_atoms_positions) { - f_lammps_setup_gather_scatter(); - EXPECT_EQ(f_lammps_gather_position(1), 1.0); - EXPECT_EQ(f_lammps_gather_position(2), 1.0); - EXPECT_EQ(f_lammps_gather_position(3), 1.5); - EXPECT_EQ(f_lammps_gather_position(4), 0.2); - EXPECT_EQ(f_lammps_gather_position(5), 0.1); - EXPECT_EQ(f_lammps_gather_position(6), 0.1); - EXPECT_EQ(f_lammps_gather_position(7), 0.5); - EXPECT_EQ(f_lammps_gather_position(8), 0.5); - EXPECT_EQ(f_lammps_gather_position(9), 0.5); + 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_masks_concat) +TEST_F(LAMMPS_gather_scatter, gather_atoms_concat_masks) { - f_lammps_setup_gather_scatter(); - EXPECT_EQ(f_lammps_gather_concat_mask(1), 1); - EXPECT_EQ(f_lammps_gather_concat_mask(2), 1); - EXPECT_EQ(f_lammps_gather_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_concat_mask(1), 3); - EXPECT_EQ(f_lammps_gather_concat_mask(2), 5); - EXPECT_EQ(f_lammps_gather_concat_mask(3), 9); - lammps_command(lmp, "group other id 1"); - EXPECT_EQ(f_lammps_gather_concat_mask(1), 7); - EXPECT_EQ(f_lammps_gather_concat_mask(2), 5); - EXPECT_EQ(f_lammps_gather_concat_mask(3), 9); + 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_positions_concat) +TEST_F(LAMMPS_gather_scatter, gather_atoms_concat_positions) { - f_lammps_setup_gather_scatter(); - EXPECT_EQ(f_lammps_gather_concat_position(1,1), 1.0); - EXPECT_EQ(f_lammps_gather_concat_position(2,1), 1.0); - EXPECT_EQ(f_lammps_gather_concat_position(3,1), 1.5); - EXPECT_EQ(f_lammps_gather_concat_position(1,2), 0.2); - EXPECT_EQ(f_lammps_gather_concat_position(2,2), 0.1); - EXPECT_EQ(f_lammps_gather_concat_position(3,2), 0.1); - EXPECT_EQ(f_lammps_gather_concat_position(1,3), 0.5); - EXPECT_EQ(f_lammps_gather_concat_position(2,3), 0.5); - EXPECT_EQ(f_lammps_gather_concat_position(3,3), 0.5); + 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_masks_subset) +TEST_F(LAMMPS_gather_scatter, gather_atoms_subset_masks) { - f_lammps_setup_gather_scatter(); - EXPECT_EQ(f_lammps_gather_subset_mask(2), 1); - EXPECT_EQ(f_lammps_gather_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_EQ(f_lammps_gather_subset_mask(2), 5); - EXPECT_EQ(f_lammps_gather_subset_mask(3), 9); - lammps_command(lmp, "group other id 3"); - EXPECT_EQ(f_lammps_gather_subset_mask(2), 5); - EXPECT_EQ(f_lammps_gather_subset_mask(3), 13); + 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_positions_subset) +TEST_F(LAMMPS_gather_scatter, gather_atoms_subset_positions) { - f_lammps_setup_gather_scatter(); -// EXPECT_EQ(f_lammps_gather_subset_position(1,1), 1.0); -// EXPECT_EQ(f_lammps_gather_subset_position(2,1), 1.0); -// EXPECT_EQ(f_lammps_gather_subset_position(3,1), 1.5); - EXPECT_EQ(f_lammps_gather_subset_position(1,2), 0.2); - EXPECT_EQ(f_lammps_gather_subset_position(2,2), 0.1); - EXPECT_EQ(f_lammps_gather_subset_position(3,2), 0.1); - EXPECT_EQ(f_lammps_gather_subset_position(1,3), 0.5); - EXPECT_EQ(f_lammps_gather_subset_position(2,3), 0.5); - EXPECT_EQ(f_lammps_gather_subset_position(3,3), 0.5); + 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) +{ + 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) +{ + 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) +{ + 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); }; From dc5324c1db0572ee38376f613d6383a34679b8a4 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Sun, 2 Oct 2022 21:26:42 -0500 Subject: [PATCH 29/49] Updated unit tests to use keepstuff; whitespace fixes --- doc/src/Fortran.rst | 2 +- src/library.cpp | 4 +- unittest/fortran/test_fortran_extract_fix.f90 | 39 +++------- .../fortran/test_fortran_extract_variable.f90 | 78 +++++++++---------- 4 files changed, 49 insertions(+), 74 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index a62378819f..e7b44c4686 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -1108,7 +1108,7 @@ Procedures Bound to the lammps Derived Type 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], + 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 diff --git a/src/library.cpp b/src/library.cpp index fe16d1e518..bfa0fc803a 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -2235,7 +2235,7 @@ a similar array but have non-consecutive atom IDs, see 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], +(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`, @@ -2383,7 +2383,7 @@ 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 +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 diff --git a/unittest/fortran/test_fortran_extract_fix.f90 b/unittest/fortran/test_fortran_extract_fix.f90 index 85b4cb5f4f..7d5e18016b 100644 --- a/unittest/fortran/test_fortran_extract_fix.f90 +++ b/unittest/fortran/test_fortran_extract_fix.f90 @@ -1,27 +1,7 @@ -MODULE keepfix - USE liblammps - TYPE(LAMMPS) :: lmp - CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & - [ 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(3), PARAMETER :: cont_input = & - [ CHARACTER(LEN=40) :: & - 'create_atoms 1 single &', & - ' 0.2 0.1 0.1', & - '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 2.0' ] -END MODULE keepfix - FUNCTION f_lammps_with_args() BIND(C) USE ISO_C_BINDING, ONLY: C_ptr USE liblammps - USE keepfix, ONLY: lmp + USE keepstuff, ONLY: lmp IMPLICIT NONE TYPE(C_ptr) :: f_lammps_with_args CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = & @@ -35,7 +15,7 @@ END FUNCTION f_lammps_with_args SUBROUTINE f_lammps_close() BIND(C) USE ISO_C_BINDING, ONLY: c_null_ptr USE liblammps - USE keepfix, ONLY: lmp + USE keepstuff, ONLY: lmp IMPLICIT NONE CALL lmp%close() @@ -44,11 +24,12 @@ END SUBROUTINE f_lammps_close SUBROUTINE f_lammps_setup_extract_fix () BIND(C) USE LIBLAMMPS - USE keepfix, ONLY : lmp, demo_input, cont_input, pair_input + USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input, more_input IMPLICIT NONE - CALL lmp%commands_list(demo_input) + 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 @@ -62,7 +43,7 @@ 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 keepfix, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE REAL(C_double) :: scalar @@ -72,7 +53,7 @@ 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 keepfix, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i REAL(C_double) :: element @@ -83,7 +64,7 @@ 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 keepfix, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i, j REAL(C_double) :: element @@ -94,7 +75,7 @@ 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 keepfix, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i REAL(C_double) :: f_lammps_extract_fix_peratom_vector @@ -107,7 +88,7 @@ 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 keepfix, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(C_int), INTENT(IN), VALUE :: i, j REAL(C_double) :: f_lammps_extract_fix_peratom_array diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index 267b5e1139..0b16e61894 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -1,26 +1,11 @@ MODULE keepvar USE liblammps IMPLICIT NONE - TYPE(LAMMPS) :: lmp - CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & - [ 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(3), PARAMETER :: cont_input = & - [ CHARACTER(LEN=40) :: & - 'create_atoms 1 single &', & - ' 0.2 0.1 0.1', & - '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 2.0' ] CONTAINS FUNCTION absolute_path(filename) + USE keepstuff, ONLY : lmp CHARACTER(LEN=:), ALLOCATABLE :: absolute_path CHARACTER(LEN=*), INTENT(IN) :: filename CHARACTER(LEN=256) :: test_input_directory @@ -60,7 +45,7 @@ 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 keepvar, ONLY: lmp + USE keepstuff, ONLY: lmp IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: argc TYPE(c_ptr), VALUE :: argv @@ -97,7 +82,7 @@ END FUNCTION f_lammps_with_C_args SUBROUTINE f_lammps_close() BIND(C) USE ISO_C_BINDING, ONLY: c_null_ptr USE liblammps - USE keepvar, ONLY: lmp + USE keepstuff, ONLY: lmp IMPLICIT NONE CALL lmp%close() @@ -106,7 +91,8 @@ END SUBROUTINE f_lammps_close SUBROUTINE f_lammps_setup_extract_variable () BIND(C) USE LIBLAMMPS - USE keepvar, ONLY : lmp, demo_input, cont_input, pair_input, absolute_path + 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 @@ -118,8 +104,9 @@ SUBROUTINE f_lammps_setup_extract_variable () BIND(C) // NEW_LINE(' ') // '"""' CALL lmp%command('atom_modify map array') - CALL lmp%commands_list(demo_input) + 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') @@ -153,7 +140,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int) :: f_lammps_extract_variable_index_1 CHARACTER(LEN=80) :: str @@ -169,7 +156,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int) :: f_lammps_extract_variable_index_2 CHARACTER(LEN=80) :: str @@ -185,7 +172,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int) :: f_lammps_extract_variable_loop CHARACTER(LEN=80) :: loop @@ -197,7 +184,8 @@ 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 keepvar, ONLY : lmp, f2c_string + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_loop_pad CHARACTER(LEN=20) :: loop @@ -209,8 +197,8 @@ 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 keepvar, ONLY : lmp, f2c_string - + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_world CHARACTER(LEN=20) :: world @@ -222,8 +210,8 @@ 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 keepvar, ONLY : lmp, f2c_string - + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_universe CHARACTER(LEN=20) :: universe @@ -235,7 +223,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int) :: f_lammps_extract_variable_uloop CHARACTER(LEN=80) :: uloop @@ -247,7 +235,8 @@ 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 keepvar, ONLY : lmp, f2c_string + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_string CHARACTER(LEN=40) :: string @@ -259,7 +248,8 @@ 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 keepvar, ONLY : lmp, f2c_string + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_format CHARACTER(LEN=20) :: form @@ -271,7 +261,8 @@ 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 keepvar, ONLY : lmp, f2c_string + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_format_pad CHARACTER(LEN=20) :: form @@ -283,7 +274,8 @@ 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 keepvar, ONLY : lmp, f2c_string + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_getenv CHARACTER(LEN=40) :: string @@ -295,7 +287,8 @@ 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 keepvar, ONLY : lmp, f2c_string + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_file CHARACTER(LEN=40) :: string @@ -307,7 +300,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: i REAL(c_double) :: f_lammps_extract_variable_atomfile @@ -320,7 +313,7 @@ END FUNCTION f_lammps_extract_variable_atomfile FUNCTION f_lammps_extract_variable_python(i) BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_double USE LIBLAMMPS - USE keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: i REAL(c_double) :: f_lammps_extract_variable_python @@ -331,7 +324,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE REAL(c_double) :: f_lammps_extract_variable_timer @@ -341,7 +334,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE REAL(c_double) :: f_lammps_extract_variable_internal @@ -351,7 +344,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE REAL(c_double) :: f_lammps_extract_variable_equal @@ -361,7 +354,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: i REAL(c_double) :: f_lammps_extract_variable_atom @@ -374,7 +367,7 @@ 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 keepvar, ONLY : lmp + USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int), INTENT(IN), VALUE :: i REAL(c_double) :: f_lammps_extract_variable_vector @@ -387,7 +380,8 @@ 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 keepvar, ONLY : lmp, f2c_string + USE keepstuff, ONLY : lmp + USE keepvar, ONLY : f2c_string IMPLICIT NONE CHARACTER(LEN=40) :: string From f474b67c7c5a94b66cb49086e56b5889842a474e Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 09:22:02 -0400 Subject: [PATCH 30/49] update swig interface file for recent changes to the library interface --- tools/swig/lammps.i | 183 ++++++++++++++++++++++++++++++++------------ 1 file changed, 135 insertions(+), 48 deletions(-) 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 */ From ea512ce2bbaaed4f9d68fc28aa836af34dee2e40 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 09:22:28 -0400 Subject: [PATCH 31/49] update comments about which files to keep synchronized for consistency --- python/lammps/constants.py | 3 ++- src/library.h | 20 ++++++++++---------- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/python/lammps/constants.py b/python/lammps/constants.py index a76be819fe..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 diff --git a/src/library.h b/src/library.h index 9adb274518..814c24210d 100644 --- a/src/library.h +++ b/src/library.h @@ -40,8 +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 - * and fortran/lammps.f90 */ + * 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) */ @@ -55,8 +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 - * and fortran/lammps.f90 */ + * 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 */ @@ -66,8 +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 - * and fortran/lammps.f90 */ + * 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 */ @@ -80,8 +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 - * and fortran/lammps.f90 */ + * 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() */ @@ -93,8 +93,8 @@ enum _LMP_ERROR_CONST { /** Variable style constants for extracting data from variables. * - * Must be kept in sync with the equivalent constants in lammps/constants.py - * and fortran/lammps.f90 */ + * 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 */ From 658df50e97ac4bc6e65b228d32942375402e15b8 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 09:37:05 -0400 Subject: [PATCH 32/49] make getenv style variable test fully portable --- unittest/fortran/test_fortran_extract_variable.f90 | 3 +-- unittest/fortran/wrap_extract_variable.cpp | 5 ++++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index 0b16e61894..da7b2d5835 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -118,8 +118,7 @@ SUBROUTINE f_lammps_setup_extract_variable () BIND(C) 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') - ! USERNAME should exist on all platforms (incl. Windows) - CALL lmp%command('variable username getenv USERNAME') + 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')) diff --git a/unittest/fortran/wrap_extract_variable.cpp b/unittest/fortran/wrap_extract_variable.cpp index ba439fbda4..47ca0c205d 100644 --- a/unittest/fortran/wrap_extract_variable.cpp +++ b/unittest/fortran/wrap_extract_variable.cpp @@ -3,6 +3,8 @@ #include "lammps.h" #include "library.h" +#include "platform.h" + #include #include #include @@ -175,8 +177,9 @@ TEST_F(LAMMPS_extract_variable, format_pad) TEST_F(LAMMPS_extract_variable, getenv) { + LAMMPS_NS::platform::putenv("FORTRAN_USER=myuser"); f_lammps_setup_extract_variable(); - char *env = std::getenv("USERNAME"); + char *env = std::getenv("FORTRAN_USER"); char *fenv = f_lammps_extract_variable_getenv(); EXPECT_STREQ(fenv, env); std::free(fenv); From 6a2023e7df80da3624bec2c835f4a184ca08ca25 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 09:55:20 -0400 Subject: [PATCH 33/49] spelling --- doc/src/Build_manual.rst | 2 +- doc/utils/sphinx-config/false_positives.txt | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) 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/utils/sphinx-config/false_positives.txt b/doc/utils/sphinx-config/false_positives.txt index 9708c02403..85df97b332 100644 --- a/doc/utils/sphinx-config/false_positives.txt +++ b/doc/utils/sphinx-config/false_positives.txt @@ -1489,6 +1489,7 @@ interfacial interial interlayer intermolecular +interoperable Interparticle interstitials intertube @@ -3622,6 +3623,7 @@ Universite unix unmaintained unoptimized +unordered unpadded unphysical unphysically From aff58465f208baa7f85291d2ac83b897608259ef Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Mon, 3 Oct 2022 15:15:15 -0500 Subject: [PATCH 34/49] Reimplemented absolute_path using platform::path_join for portability --- .../fortran/test_fortran_extract_variable.f90 | 39 ++++++++++++++++++- unittest/fortran/wrap_extract_variable.cpp | 13 +++++++ 2 files changed, 51 insertions(+), 1 deletion(-) diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index da7b2d5835..af6ed0c019 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -1,17 +1,54 @@ 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 :: i + INTEGER(c_size_t) :: length test_input_directory = lmp%extract_variable('input_dir') - absolute_path = TRIM(test_input_directory) // '/' // TRIM(filename) + 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) diff --git a/unittest/fortran/wrap_extract_variable.cpp b/unittest/fortran/wrap_extract_variable.cpp index 47ca0c205d..095b0b3be7 100644 --- a/unittest/fortran/wrap_extract_variable.cpp +++ b/unittest/fortran/wrap_extract_variable.cpp @@ -45,6 +45,19 @@ 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; } class LAMMPS_extract_variable : public ::testing::Test { From 02158516f21b31fe0321d6a71b3d8a542cfdd4cb Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 17:58:14 -0400 Subject: [PATCH 35/49] use large string buffers to avoid truncation --- unittest/fortran/test_fortran_extract_variable.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index af6ed0c019..1e05dd5a27 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -87,7 +87,7 @@ FUNCTION f_lammps_with_C_args(argc, argv) BIND(C) INTEGER(c_int), INTENT(IN), VALUE :: argc TYPE(c_ptr), VALUE :: argv TYPE(c_ptr), DIMENSION(:), POINTER :: Fargv - INTEGER, PARAMETER :: ARG_LENGTH = 80 + 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 @@ -179,7 +179,7 @@ FUNCTION f_lammps_extract_variable_index_1 () BIND(C) USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int) :: f_lammps_extract_variable_index_1 - CHARACTER(LEN=80) :: str + CHARACTER(LEN=256) :: str str = lmp%extract_variable("idx") IF ( trim(str) == 'hello' ) THEN @@ -195,7 +195,7 @@ FUNCTION f_lammps_extract_variable_index_2 () BIND(C) USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int) :: f_lammps_extract_variable_index_2 - CHARACTER(LEN=80) :: str + CHARACTER(LEN=256) :: str str = lmp%extract_variable("idx") IF ( trim(str) == 'goodbye' ) THEN @@ -211,7 +211,7 @@ FUNCTION f_lammps_extract_variable_loop () BIND(C) USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int) :: f_lammps_extract_variable_loop - CHARACTER(LEN=80) :: loop + CHARACTER(LEN=256) :: loop loop = lmp%extract_variable('lp') READ(loop,*) f_lammps_extract_variable_loop @@ -262,7 +262,7 @@ FUNCTION f_lammps_extract_variable_uloop () BIND(C) USE keepstuff, ONLY : lmp IMPLICIT NONE INTEGER(c_int) :: f_lammps_extract_variable_uloop - CHARACTER(LEN=80) :: uloop + CHARACTER(LEN=256) :: uloop uloop = lmp%extract_variable('ulp') READ(uloop,*) f_lammps_extract_variable_uloop @@ -275,7 +275,7 @@ FUNCTION f_lammps_extract_variable_string () BIND(C) USE keepvar, ONLY : f2c_string IMPLICIT NONE TYPE(c_ptr) :: f_lammps_extract_variable_string - CHARACTER(LEN=40) :: string + CHARACTER(LEN=256) :: string string = lmp%extract_variable('str') f_lammps_extract_variable_string = f2c_string(string) From a9ba96252a10197e56842afcefb8832f791f6340 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Mon, 3 Oct 2022 17:44:09 -0500 Subject: [PATCH 36/49] Added warning message if we ever assign to a too-short string; fixed array-reference typo that -f2003 helped catch --- fortran/lammps.f90 | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 8fad0d43e5..2e552f22f0 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -103,7 +103,8 @@ MODULE LIBLAMMPS PROCEDURE :: extract_fix => lmp_extract_fix PROCEDURE :: extract_variable => lmp_extract_variable PROCEDURE :: set_variable => lmp_set_variable - PROCEDURE, PRIVATE :: lmp_gather_atoms_int, lmp_gather_atoms_double + 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 @@ -114,7 +115,8 @@ MODULE LIBLAMMPS 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, lmp_scatter_atoms_double + PROCEDURE, PRIVATE :: lmp_scatter_atoms_int + PROCEDURE, PRIVATE :: lmp_scatter_atoms_double GENERIC :: scatter_atoms => lmp_scatter_atoms_int, & lmp_scatter_atoms_double ! @@ -1504,7 +1506,7 @@ CONTAINS Cname = f2c_string(name) Cdata = C_LOC(data(1)) - Cids = C_LOC(ids) + Cids = C_LOC(ids(1)) CALL lammps_scatter_atoms_subset(self%handle, Cname, Ctype, Ccount, & Cndata, Cids, Cdata) CALL lammps_free(Cname) @@ -1529,7 +1531,7 @@ CONTAINS Cname = f2c_string(name) Cdata = C_LOC(data(1)) - Cids = C_LOC(ids) + Cids = C_LOC(ids(1)) CALL lammps_scatter_atoms_subset(self%handle, Cname, Ctype, Ccount, & Cndata, Cids, Cdata) CALL lammps_free(Cname) @@ -1808,6 +1810,10 @@ CONTAINS 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 @@ -1882,6 +1888,10 @@ CONTAINS 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 From fcf415d0b1b8b6188f876dba3cc6856b55dd2039 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Mon, 3 Oct 2022 18:01:33 -0500 Subject: [PATCH 37/49] Skipped scatter/gather tests when sizeof(tagint) is 8 --- unittest/fortran/wrap_gather_scatter.cpp | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/unittest/fortran/wrap_gather_scatter.cpp b/unittest/fortran/wrap_gather_scatter.cpp index 96397b7681..efb33467d9 100644 --- a/unittest/fortran/wrap_gather_scatter.cpp +++ b/unittest/fortran/wrap_gather_scatter.cpp @@ -50,6 +50,7 @@ protected: 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); @@ -68,6 +69,7 @@ TEST_F(LAMMPS_gather_scatter, gather_atoms_masks) 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); @@ -82,6 +84,7 @@ TEST_F(LAMMPS_gather_scatter, gather_atoms_positions) 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); @@ -100,6 +103,7 @@ TEST_F(LAMMPS_gather_scatter, gather_atoms_concat_masks) 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); @@ -114,6 +118,7 @@ TEST_F(LAMMPS_gather_scatter, gather_atoms_concat_positions) 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); @@ -129,6 +134,7 @@ TEST_F(LAMMPS_gather_scatter, gather_atoms_subset_masks) 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); @@ -140,6 +146,7 @@ TEST_F(LAMMPS_gather_scatter, gather_atoms_subset_positions) 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"); @@ -155,6 +162,7 @@ TEST_F(LAMMPS_gather_scatter, scatter_atoms_masks) 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); @@ -179,6 +187,7 @@ TEST_F(LAMMPS_gather_scatter, scatter_atoms_positions) 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); From af3d618f474349d68920c5f20daf1621bd604bda Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 23:18:44 -0400 Subject: [PATCH 38/49] complete implementation of looking up last error message and include test --- fortran/lammps.f90 | 29 ++++++++++-------- unittest/fortran/CMakeLists.txt | 2 +- unittest/fortran/test_fortran_properties.f90 | 23 +++++++++++++++ unittest/fortran/wrap_properties.cpp | 31 +++++++++++++++++--- 4 files changed, 67 insertions(+), 18 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 2e552f22f0..2a4a16bdd0 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -1552,7 +1552,7 @@ CONTAINS TYPE(c_ptr) :: ptr INTEGER :: i - buffer = '' + buffer = ' ' ptr = C_LOC(Cbuffer(1)) buf_size = LEN(buffer) CALL lammps_get_os_info(ptr, buf_size) @@ -1699,25 +1699,28 @@ CONTAINS CLASS(lammps), INTENT(IN) :: self CHARACTER(LEN=*), INTENT(OUT) :: buffer INTEGER, INTENT(OUT), OPTIONAL :: status - INTEGER(c_int) :: length, Cstatus, i + INTEGER(c_int) :: buflen, Cstatus, i + INTEGER(c_size_t) :: length TYPE(c_ptr) :: Cptr - CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Cbuffer + CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:) - buffer = '' + buffer = ' ' IF ( lmp_has_error(self) ) THEN - length = LEN(buffer) - Cptr = f2c_string(buffer) - Cstatus = lammps_get_last_error_message(self%handle, Cptr, length) - length = MIN(LEN(buffer, c_size_t), c_strlen(Cptr)) - CALL C_F_POINTER(Cptr, Cbuffer, [length]) - FORALL ( i=1:length ) - buffer(i:i) = Cbuffer(i) - END FORALL + 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 = '' + buffer = ' ' IF ( PRESENT(status) ) THEN status = 0 END IF diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index d3c18c9941..70ab462053 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -50,7 +50,7 @@ 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) diff --git a/unittest/fortran/test_fortran_properties.f90 b/unittest/fortran/test_fortran_properties.f90 index 153cab8c77..e8ea330bd6 100644 --- a/unittest/fortran/test_fortran_properties.f90 +++ b/unittest/fortran/test_fortran_properties.f90 @@ -64,3 +64,26 @@ FUNCTION f_lammps_has_error () BIND(C) 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_properties.cpp b/unittest/fortran/wrap_properties.cpp index d53aabb8fa..21c953a514 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 @@ -16,8 +17,13 @@ void f_lammps_memory_usage(double*); int f_lammps_get_mpi_comm(); 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; @@ -105,11 +111,28 @@ 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) { - EXPECT_EQ(f_lammps_has_error(), lammps_has_error(lmp)); - // TODO: How to test the error message itself? + // 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(".*ERRORx: Unknown command: this_is_not_a_known_command.*")); }; +} // namespace LAMMPS_NS From 337443528180e452211f942feb6b050025a23f02 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 23:19:05 -0400 Subject: [PATCH 39/49] add note that integer sizes can be queried without a LAMMPS handle --- src/library.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/library.cpp b/src/library.cpp index bfa0fc803a..a2a632c244 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 ` From 647c5e3572fdc951f1b5f34f248360523cda9771 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 23:19:59 -0400 Subject: [PATCH 40/49] apply clang-format --- unittest/fortran/wrap_box.cpp | 6 +- unittest/fortran/wrap_extract_atom.cpp | 100 +++---- unittest/fortran/wrap_extract_compute.cpp | 202 +++++++------- unittest/fortran/wrap_extract_fix.cpp | 86 +++--- unittest/fortran/wrap_extract_global.cpp | 124 ++++----- unittest/fortran/wrap_extract_variable.cpp | 305 +++++++++++---------- unittest/fortran/wrap_gather_scatter.cpp | 278 +++++++++---------- unittest/fortran/wrap_properties.cpp | 30 +- 8 files changed, 563 insertions(+), 568 deletions(-) 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 index 17116b11b9..2552d6a10f 100644 --- a/unittest/fortran/wrap_extract_atom.cpp +++ b/unittest/fortran/wrap_extract_atom.cpp @@ -3,10 +3,10 @@ #include "lammps.h" #include "library.h" +#include +#include #include #include -#include -#include #include "gtest/gtest.h" @@ -20,8 +20,8 @@ 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*); +void f_lammps_extract_atom_x(int, double *); +void f_lammps_extract_atom_v(int, double *); } class LAMMPS_extract_atom : public ::testing::Test { @@ -49,72 +49,72 @@ protected: TEST_F(LAMMPS_extract_atom, mass) { - f_lammps_setup_extract_atom(); - EXPECT_DOUBLE_EQ(f_lammps_extract_atom_mass(), 2.0); + 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(); -#ifdef LAMMPS_BIGBIG - EXPECT_EQ(f_lammps_extract_atom_tag_int64(1l), 1l); - EXPECT_EQ(f_lammps_extract_atom_tag_int64(2l), 2l); + 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); + 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); + 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); + 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); + 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); + 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 index 2325b1540f..5d6e8b1978 100644 --- a/unittest/fortran/wrap_extract_compute.cpp +++ b/unittest/fortran/wrap_extract_compute.cpp @@ -3,10 +3,10 @@ #include "lammps.h" #include "library.h" +#include +#include #include #include -#include -#include #include "gtest/gtest.h" @@ -16,12 +16,12 @@ 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_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_global_array(int, int); double f_lammps_extract_compute_local_vector(int); -double f_lammps_extract_compute_local_array(int,int); +double f_lammps_extract_compute_local_array(int, int); } class LAMMPS_extract_compute : public ::testing::Test { @@ -49,126 +49,120 @@ protected: 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); - + 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); + 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); + 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]); + 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]); + 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]); + 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]); + 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 index d8f19c8b95..bbb535c1e7 100644 --- a/unittest/fortran/wrap_extract_fix.cpp +++ b/unittest/fortran/wrap_extract_fix.cpp @@ -4,10 +4,10 @@ #include "lammps.h" #include "library.h" +#include +#include #include #include -#include -#include #include "gtest/gtest.h" @@ -18,11 +18,11 @@ 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_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_peratom_array(int, int); double f_lammps_extract_fix_local_vector(int); -double f_lammps_extract_fix_local_array(int,int); +double f_lammps_extract_fix_local_array(int, int); } class LAMMPS_extract_fix : public ::testing::Test { @@ -50,58 +50,58 @@ protected: 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); + 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); + 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); + 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); + 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); + 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 index 095b0b3be7..0c1ffcc37e 100644 --- a/unittest/fortran/wrap_extract_variable.cpp +++ b/unittest/fortran/wrap_extract_variable.cpp @@ -5,15 +5,14 @@ #include "library.h" #include "platform.h" -#include -#include +#include +#include +#include #include #include -#include -#include -#include +#include +#include #include -#include #include "gtest/gtest.h" @@ -22,21 +21,21 @@ // prototypes for Fortran reverse wrapper functions extern "C" { -void *f_lammps_with_c_args(int,char**); +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(); +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(); +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(); @@ -45,21 +44,22 @@ 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 *, const char *); } -char* c_path_join(const char* a, const char* b) +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; + 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; @@ -68,17 +68,20 @@ protected: void SetUp() override { - const char *args[] = {"LAMMPS_Fortran_test", "-l", "none", - "-echo", "screen", "-nocite", "-var", - "input_dir", STRINGIFY(TEST_INPUT_FOLDER), - "-var", "zpos", "1.5", "-var", "x", "2"}; - char** argv = (char**) args; - int argc = sizeof(args) / sizeof(const char*); + // 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); + 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(); @@ -91,192 +94,190 @@ protected: 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); + 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"); - } + 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"); - } + 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); + 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); + 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); + 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); + 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[10]; - 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"); - } + f_lammps_setup_extract_variable(); + int i; + char str[10]; + 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[10]; - 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"); - } + f_lammps_setup_extract_variable(); + int i; + char str[10]; + 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); + 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"); - } + 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); + 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"); - } - } + 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); + 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); + 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"); - } + 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); + 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); + 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 index efb33467d9..3b70c4393e 100644 --- a/unittest/fortran/wrap_gather_scatter.cpp +++ b/unittest/fortran/wrap_gather_scatter.cpp @@ -3,10 +3,10 @@ #include "lammps.h" #include "library.h" +#include +#include #include #include -#include -#include #include "gtest/gtest.h" @@ -18,185 +18,185 @@ 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); +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); +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; + 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; - } + 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); + 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); + 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); + 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); + 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); + 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); + 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); + 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); + 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); + 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 21c953a514..d2daa22cf4 100644 --- a/unittest/fortran/wrap_properties.cpp +++ b/unittest/fortran/wrap_properties.cpp @@ -13,9 +13,9 @@ 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); } @@ -26,17 +26,17 @@ 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(); @@ -54,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 @@ -68,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) From 4e9b97d5cba2a16b9770cb5172d6fa09afdb91c0 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 23:49:17 -0400 Subject: [PATCH 41/49] make capitalization and whitespace fortran coding style more consistent --- fortran/lammps.f90 | 211 ++++++------- unittest/fortran/test_fortran_box.f90 | 42 +-- .../fortran/test_fortran_extract_atom.f90 | 66 ++-- .../fortran/test_fortran_extract_compute.f90 | 62 ++-- unittest/fortran/test_fortran_extract_fix.f90 | 44 +-- .../fortran/test_fortran_extract_global.f90 | 298 +++++++++--------- .../fortran/test_fortran_extract_variable.f90 | 48 +-- .../fortran/test_fortran_gather_scatter.f90 | 22 +- unittest/fortran/test_fortran_get_thermo.f90 | 50 +-- unittest/fortran/test_fortran_properties.f90 | 50 +-- 10 files changed, 449 insertions(+), 444 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 2a4a16bdd0..d37b12c7db 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -483,10 +483,10 @@ MODULE LIBLAMMPS END FUNCTION lammps_version SUBROUTINE lammps_get_os_info(buffer, buf_size) BIND(C) - IMPORT :: C_ptr, C_int + IMPORT :: c_ptr, c_int IMPLICIT NONE - TYPE(C_ptr), VALUE :: buffer - INTEGER(C_int), VALUE :: buf_size + TYPE(c_ptr), VALUE :: buffer + INTEGER(c_int), VALUE :: buf_size END SUBROUTINE lammps_get_os_info FUNCTION lammps_config_has_mpi_support() BIND(C) @@ -526,24 +526,24 @@ MODULE LIBLAMMPS END FUNCTION lammps_config_has_exceptions FUNCTION lammps_config_has_package(name) BIND(C) - IMPORT :: C_int, C_ptr + IMPORT :: c_int, c_ptr IMPLICIT NONE - TYPE(C_ptr), VALUE :: name + 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 + IMPORT :: c_int IMPLICIT NONE - INTEGER(C_int) :: lammps_config_package_count + 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 + 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 + 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 @@ -551,10 +551,10 @@ MODULE LIBLAMMPS !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 @@ -572,9 +572,9 @@ MODULE LIBLAMMPS !SUBROUTINE lammps_fix_external_set_vector SUBROUTINE lammps_flush_buffers(handle) BIND(C) - IMPORT :: C_ptr + IMPORT :: c_ptr IMPLICIT NONE - TYPE(C_ptr), VALUE :: handle + TYPE(c_ptr), VALUE :: handle END SUBROUTINE lammps_flush_buffers FUNCTION lammps_malloc(size) BIND(C, name='malloc') @@ -602,7 +602,7 @@ MODULE LIBLAMMPS TYPE(c_ptr), VALUE :: handle END SUBROUTINE lammps_force_timeout - INTEGER(C_int) FUNCTION lammps_has_error(handle) BIND(C) + INTEGER(c_int) FUNCTION lammps_has_error(handle) BIND(C) IMPORT :: c_ptr, c_int IMPLICIT NONE TYPE(c_ptr), VALUE :: handle @@ -758,7 +758,7 @@ CONTAINS 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) @@ -771,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 + 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 @@ -857,7 +857,7 @@ CONTAINS 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 @@ -865,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 @@ -873,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 @@ -884,8 +884,8 @@ 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) + FORALL (i=1:length) global_data%str(i:i) = Fptr(i) END FORALL CASE DEFAULT @@ -939,7 +939,7 @@ CONTAINS CALL C_F_POINTER(Cptr, peratom_data%i64_vec, [ncols]) CASE (LAMMPS_DOUBLE) peratom_data%datatype = DATA_DOUBLE_1D - IF ( name == 'mass' ) THEN + IF (name == 'mass') THEN CALL C_F_POINTER(Cptr, dummy, [ncols]) peratom_data%r64_vec(0:) => dummy ELSE @@ -978,7 +978,7 @@ CONTAINS Cid = f2c_string(id) Cptr = lammps_extract_compute(self%handle, Cid, style, type) - IF ( .NOT. C_ASSOCIATED(Cptr) ) THEN + 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 @@ -1046,8 +1046,8 @@ CONTAINS ! 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 + 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 @@ -1057,11 +1057,11 @@ CONTAINS END IF END IF - IF ( PRESENT(ncol) ) Cnrow = ncol - 1_c_int + 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 + 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]') @@ -1082,7 +1082,7 @@ CONTAINS & [Fortran/extract_fix]') CASE (LMP_TYPE_VECTOR) fix_data%datatype = DATA_DOUBLE_1D - IF ( STYLE == LMP_STYLE_ATOM ) THEN + IF (STYLE == LMP_STYLE_ATOM) THEN nrows = self%extract_setting('nmax') ELSE Ctemp = lammps_extract_fix(self%handle, Cid, style, & @@ -1093,7 +1093,7 @@ CONTAINS 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 + 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, & @@ -1142,7 +1142,7 @@ CONTAINS INTEGER(c_int), POINTER :: Clength => NULL() Cname = f2c_string(name) - IF ( PRESENT(group) ) THEN + IF (PRESENT(group)) THEN Cgroup = f2c_string(group) ELSE Cgroup = c_null_ptr @@ -1163,9 +1163,8 @@ CONTAINS 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) ) + 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) @@ -1179,17 +1178,17 @@ CONTAINS CALL lammps_free(Cname) CALL lammps_free(Cveclength) CALL C_F_POINTER(Cptr, double_vec, [length]) - IF ( ALLOCATED(variable_data%r64_vec) ) & + IF (ALLOCATED(variable_data%r64_vec)) & DEALLOCATE(variable_data%r64_vec) - ALLOCATE( variable_data%r64_vec(length) ) + 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 ) - FORALL ( i=1:length ) + ALLOCATE(CHARACTER(LEN=length) :: variable_data%str) + FORALL (i=1:length) variable_data%str(i:i) = Cstring(i) END FORALL ! DO NOT deallocate the C pointer @@ -1209,14 +1208,14 @@ CONTAINS CLASS(lammps), INTENT(IN) :: self CHARACTER(LEN=*), INTENT(IN) :: name, str INTEGER :: err - TYPE(C_ptr) :: Cstr, Cname + 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 + IF (err /= 0) THEN CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, & 'WARNING: unable to set string variable "' // name & // '" [Fortran/set_variable]') @@ -1235,13 +1234,13 @@ CONTAINS REAL(c_double) :: dnatoms CHARACTER(LEN=100) :: error_msg - IF ( count /= 1 .AND. count /= 3 ) THEN + 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 + 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]' @@ -1250,7 +1249,7 @@ CONTAINS natoms = NINT(dnatoms, c_int) Cname = f2c_string(name) - IF ( ALLOCATED(data) ) DEALLOCATE(data) + IF (ALLOCATED(data)) DEALLOCATE(data) ALLOCATE(data(natoms*count)) Cdata = C_LOC(data(1)) CALL lammps_gather_atoms(self%handle, Cname, Ctype, count, Cdata) @@ -1266,16 +1265,16 @@ CONTAINS TYPE(c_ptr) :: Cdata, Cname INTEGER(c_int) :: natoms INTEGER(c_int), PARAMETER :: Ctype = 1_c_int - REAL(C_double) :: dnatoms + REAL(c_double) :: dnatoms CHARACTER(LEN=100) :: error_msg - IF ( count /= 1 .AND. count /= 3 ) THEN + 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 + 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]' @@ -1284,7 +1283,7 @@ CONTAINS natoms = NINT(dnatoms, c_int) Cname = f2c_string(name) - IF ( ALLOCATED(data) ) DEALLOCATE(data) + IF (ALLOCATED(data)) DEALLOCATE(data) ALLOCATE(data(natoms*count)) Cdata = C_LOC(data(1)) CALL lammps_gather_atoms(self%handle, Cname, Ctype, count, Cdata) @@ -1300,17 +1299,17 @@ CONTAINS TYPE(c_ptr) :: Cdata, Cname INTEGER(c_int) :: natoms INTEGER(c_int), PARAMETER :: Ctype = 0_c_int - REAL(C_double) :: dnatoms + REAL(c_double) :: dnatoms CHARACTER(LEN=100) :: error_msg - IF ( count /= 1 .AND. count /= 3 ) THEN + 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 + 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]' @@ -1319,7 +1318,7 @@ CONTAINS natoms = NINT(dnatoms, c_int) Cname = f2c_string(name) - IF ( ALLOCATED(data) ) DEALLOCATE(data) + 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) @@ -1335,17 +1334,17 @@ CONTAINS TYPE(c_ptr) :: Cdata, Cname INTEGER(c_int) :: natoms INTEGER(c_int), PARAMETER :: Ctype = 1_c_int - REAL(C_double) :: dnatoms + REAL(c_double) :: dnatoms CHARACTER(LEN=100) :: error_msg - IF ( count /= 1 .AND. count /= 3 ) THEN + 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 + 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]' @@ -1354,7 +1353,7 @@ CONTAINS natoms = NINT(dnatoms, c_int) Cname = f2c_string(name) - IF ( ALLOCATED(data) ) DEALLOCATE(data) + 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) @@ -1373,7 +1372,7 @@ CONTAINS INTEGER(c_int), PARAMETER :: Ctype = 0_c_int CHARACTER(LEN=100) :: error_msg - IF ( count /= 1 .AND. count /= 3 ) THEN + 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]') @@ -1382,7 +1381,7 @@ CONTAINS ndata = SIZE(ids, KIND=c_int) Cname = f2c_string(name) - IF ( ALLOCATED(data) ) DEALLOCATE(data) + IF (ALLOCATED(data)) DEALLOCATE(data) ALLOCATE(data(ndata*count)) data = -1_c_int Cdata = C_LOC(data(1)) @@ -1404,7 +1403,7 @@ CONTAINS INTEGER(c_int), PARAMETER :: Ctype = 1_c_int CHARACTER(LEN=100) :: error_msg - IF ( count /= 1 .AND. count /= 3 ) THEN + 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]') @@ -1413,7 +1412,7 @@ CONTAINS ndata = SIZE(ids, KIND=c_int) Cname = f2c_string(name) - IF ( ALLOCATED(data) ) DEALLOCATE(data) + IF (ALLOCATED(data)) DEALLOCATE(data) ALLOCATE(data(ndata*count)) Cdata = C_LOC(data(1)) Cids = C_LOC(ids(1)) @@ -1434,7 +1433,7 @@ CONTAINS CHARACTER(LEN=100) :: error_msg dnatoms = lmp_get_natoms(self) - IF ( dnatoms > HUGE(1_c_int) ) THEN + 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]' @@ -1446,7 +1445,7 @@ CONTAINS Cdata = C_LOC(data(1)) Ccount = SIZE(data) / natoms - IF ( Ccount /= 1 .AND. Ccount /= 3 ) THEN + 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 @@ -1466,7 +1465,7 @@ CONTAINS CHARACTER(LEN=100) :: error_msg dnatoms = lmp_get_natoms(self) - IF ( dnatoms > HUGE(1_c_int) ) THEN + 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]' @@ -1478,7 +1477,7 @@ CONTAINS Cdata = C_LOC(data(1)) Ccount = SIZE(data) / natoms - IF ( Ccount /= 1 .AND. Ccount /= 3 ) THEN + 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]') @@ -1499,7 +1498,7 @@ CONTAINS Cndata = SIZE(ids, KIND=c_int) Ccount = SIZE(data, KIND=c_int) / Cndata - IF ( Ccount /= 1 .AND. Ccount /= 3 ) THEN + 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 @@ -1524,7 +1523,7 @@ CONTAINS Cndata = SIZE(ids, KIND=c_int) Ccount = SIZE(data, KIND=c_int) / Cndata - IF ( Ccount /= 1 .AND. Ccount /= 3 ) THEN + 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 @@ -1557,7 +1556,7 @@ CONTAINS buf_size = LEN(buffer) CALL lammps_get_os_info(ptr, buf_size) DO i=1,buf_size - IF ( Cbuffer(i) == C_NULL_CHAR ) EXIT + IF (Cbuffer(i) == c_null_char) EXIT buffer(i:i) = Cbuffer(i) END DO END SUBROUTINE lmp_get_os_info @@ -1580,7 +1579,7 @@ CONTAINS ! equivalent function to lammps_config_has_png_support LOGICAL FUNCTION lmp_config_has_png_support() - INTEGER(C_int) :: 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) @@ -1634,10 +1633,10 @@ CONTAINS 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 + buffer = ' ' + IF (Csuccess /= 0_c_int) THEN strlen = c_strlen(Cptr) - FORALL ( i = 1:strlen ) + FORALL (i = 1:strlen) buffer(i:i) = Cbuffer(i) END FORALL END IF @@ -1650,15 +1649,15 @@ CONTAINS INTEGER, PARAMETER :: MAX_BUFFER_LENGTH = 31 INTEGER :: i, npackage, buf_length - IF ( PRESENT(length) ) THEN + IF (PRESENT(length)) THEN buf_length = length ELSE buf_length = MAX_BUFFER_LENGTH END IF - IF ( ALLOCATED(package) ) DEALLOCATE(package) + IF (ALLOCATED(package)) DEALLOCATE(package) npackage = lammps_config_package_count() - ALLOCATE( CHARACTER(LEN=MAX_BUFFER_LENGTH) :: package(npackage) ) + ALLOCATE(CHARACTER(LEN=MAX_BUFFER_LENGTH) :: package(npackage)) DO i=1, npackage CALL lmp_config_package_name(i, package(i)) END DO @@ -1675,7 +1674,7 @@ CONTAINS LOGICAL FUNCTION lmp_is_running(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 @@ -1705,7 +1704,7 @@ CONTAINS CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:) buffer = ' ' - IF ( lmp_has_error(self) ) THEN + IF (lmp_has_error(self)) THEN buflen = LEN(buffer) length = buflen Cptr = lammps_malloc(length) @@ -1715,13 +1714,13 @@ CONTAINS buffer(i:i) = c_string(i) IF (c_string(i) == c_null_char) EXIT END DO - IF ( PRESENT(status) ) THEN + IF (PRESENT(status)) THEN status = Cstatus END IF CALL lammps_free(Cptr) ELSE buffer = ' ' - IF ( PRESENT(status) ) THEN + IF (PRESENT(status)) THEN status = 0 END IF END IF @@ -1734,7 +1733,7 @@ CONTAINS 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, 'scalar int') @@ -1745,7 +1744,7 @@ CONTAINS 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, 'scalar long int') @@ -1756,7 +1755,7 @@ CONTAINS 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, 'vector of ints') @@ -1767,7 +1766,7 @@ CONTAINS INTEGER(c_int64_t), DIMENSION(:), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs - IF ( rhs%datatype == DATA_INT64_1D ) THEN + IF (rhs%datatype == DATA_INT64_1D) THEN lhs => rhs%i64_vec ELSE CALL assignment_error(rhs, 'vector of long ints') @@ -1778,7 +1777,7 @@ CONTAINS 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, 'scalar double') @@ -1789,7 +1788,7 @@ CONTAINS 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, 'vector of doubles') @@ -1800,7 +1799,7 @@ CONTAINS REAL(c_double), DIMENSION(:,:), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs - IF ( rhs%datatype == DATA_DOUBLE_2D ) THEN + IF (rhs%datatype == DATA_DOUBLE_2D) THEN lhs => rhs%r64_mat ELSE CALL assignment_error(rhs, 'matrix of doubles') @@ -1811,9 +1810,9 @@ CONTAINS 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 + 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 @@ -1829,7 +1828,7 @@ CONTAINS REAL(c_double), INTENT(OUT) :: lhs CLASS(lammps_fix_data), INTENT(IN) :: rhs - IF ( rhs%datatype == DATA_DOUBLE ) THEN + IF (rhs%datatype == DATA_DOUBLE) THEN lhs = rhs%r64 ELSE CALL assignment_error(rhs, 'scalar double') @@ -1840,7 +1839,7 @@ CONTAINS REAL(c_double), DIMENSION(:), INTENT(OUT), POINTER :: lhs CLASS(lammps_fix_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, 'vector of doubles') @@ -1851,7 +1850,7 @@ CONTAINS REAL(c_double), DIMENSION(:,:), INTENT(OUT), POINTER :: lhs CLASS(lammps_fix_data), INTENT(IN) :: rhs - IF ( rhs%datatype == DATA_DOUBLE_2D ) THEN + IF (rhs%datatype == DATA_DOUBLE_2D) THEN lhs => rhs%r64_mat ELSE CALL assignment_error(rhs, 'matrix of doubles') @@ -1865,7 +1864,7 @@ CONTAINS REAL(c_double), INTENT(OUT) :: lhs CLASS(lammps_variable_data), INTENT(IN) :: rhs - IF ( rhs%datatype == DATA_DOUBLE ) THEN + IF (rhs%datatype == DATA_DOUBLE) THEN lhs = rhs%r64 ELSE CALL assignment_error(rhs, 'scalar double') @@ -1876,9 +1875,9 @@ CONTAINS 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)) ) + 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') @@ -1889,9 +1888,9 @@ CONTAINS CHARACTER(LEN=*), INTENT(OUT) :: lhs CLASS(lammps_variable_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 + 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 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 index eb55754561..262e5de47d 100644 --- a/unittest/fortran/test_fortran_extract_atom.f90 +++ b/unittest/fortran/test_fortran_extract_atom.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_atom () BIND(C) +SUBROUTINE f_lammps_setup_extract_atom() BIND(C) USE LIBLAMMPS USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input IMPLICIT NONE @@ -32,91 +32,91 @@ SUBROUTINE f_lammps_setup_extract_atom () BIND(C) 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 +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() + 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 +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() + 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 +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() + 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, 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() + 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, 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() + 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 +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() + 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 +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() + 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) diff --git a/unittest/fortran/test_fortran_extract_compute.f90 b/unittest/fortran/test_fortran_extract_compute.f90 index 8f5bbdfd51..e3515f2a7a 100644 --- a/unittest/fortran/test_fortran_extract_compute.f90 +++ b/unittest/fortran/test_fortran_extract_compute.f90 @@ -22,7 +22,7 @@ SUBROUTINE f_lammps_close() BIND(C) lmp%handle = c_null_ptr END SUBROUTINE f_lammps_close -SUBROUTINE f_lammps_setup_extract_compute () BIND(C) +SUBROUTINE f_lammps_setup_extract_compute() BIND(C) USE LIBLAMMPS USE keepstuff, ONLY : lmp, big_input, cont_input, more_input, pair_input IMPLICIT NONE @@ -42,91 +42,91 @@ SUBROUTINE f_lammps_setup_extract_compute () BIND(C) 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 +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() + 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 +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() + 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 +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 + 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 +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 + 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 +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 + 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 +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 + 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 +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 + 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) diff --git a/unittest/fortran/test_fortran_extract_fix.f90 b/unittest/fortran/test_fortran_extract_fix.f90 index 7d5e18016b..24f90553a5 100644 --- a/unittest/fortran/test_fortran_extract_fix.f90 +++ b/unittest/fortran/test_fortran_extract_fix.f90 @@ -22,7 +22,7 @@ SUBROUTINE f_lammps_close() BIND(C) lmp%handle = C_NULL_PTR END SUBROUTINE f_lammps_close -SUBROUTINE f_lammps_setup_extract_fix () BIND(C) +SUBROUTINE f_lammps_setup_extract_fix() BIND(C) USE LIBLAMMPS USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input, more_input IMPLICIT NONE @@ -40,59 +40,59 @@ SUBROUTINE f_lammps_setup_extract_fix () BIND(C) 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 +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 + 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 +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 + 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 +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 + 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 +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 + 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 +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 + 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) 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 index 1e05dd5a27..34ccb766de 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -42,7 +42,7 @@ CONTAINS 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 ) + ALLOCATE(CHARACTER(LEN=length) :: absolute_path) DO i = 1, length absolute_path(i:i) = F_absolute_path(i) END DO @@ -159,7 +159,7 @@ SUBROUTINE f_lammps_setup_extract_variable () BIND(C) 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 + IF (lmp%config_has_package('PYTHON')) THEN CALL lmp%command(py_input) CALL lmp%command('variable py python square_it') END IF @@ -174,7 +174,7 @@ SUBROUTINE f_lammps_setup_extract_variable () BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -182,7 +182,7 @@ FUNCTION f_lammps_extract_variable_index_1 () BIND(C) CHARACTER(LEN=256) :: str str = lmp%extract_variable("idx") - IF ( trim(str) == 'hello' ) THEN + IF (trim(str) == 'hello') THEN f_lammps_extract_variable_index_1 = 1_c_int ELSE f_lammps_extract_variable_index_1 = 0_c_int @@ -190,7 +190,7 @@ FUNCTION f_lammps_extract_variable_index_1 () BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -198,7 +198,7 @@ FUNCTION f_lammps_extract_variable_index_2 () BIND(C) CHARACTER(LEN=256) :: str str = lmp%extract_variable("idx") - IF ( trim(str) == 'goodbye' ) THEN + IF (trim(str) == 'goodbye') THEN f_lammps_extract_variable_index_2 = 1_c_int ELSE f_lammps_extract_variable_index_2 = 0_c_int @@ -206,7 +206,7 @@ FUNCTION f_lammps_extract_variable_index_2 () BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -218,7 +218,7 @@ FUNCTION f_lammps_extract_variable_loop () BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp USE keepvar, ONLY : f2c_string @@ -231,7 +231,7 @@ FUNCTION f_lammps_extract_variable_loop_pad () BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp USE keepvar, ONLY : f2c_string @@ -244,7 +244,7 @@ FUNCTION f_lammps_extract_variable_world () BIND(C) END FUNCTION f_lammps_extract_variable_world FUNCTION f_lammps_extract_variable_universe () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp USE keepvar, ONLY : f2c_string @@ -257,7 +257,7 @@ FUNCTION f_lammps_extract_variable_universe () BIND(C) END FUNCTION f_lammps_extract_variable_universe FUNCTION f_lammps_extract_variable_uloop () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -269,7 +269,7 @@ FUNCTION f_lammps_extract_variable_uloop () BIND(C) END FUNCTION f_lammps_extract_variable_uloop FUNCTION f_lammps_extract_variable_string () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp USE keepvar, ONLY : f2c_string @@ -282,7 +282,7 @@ FUNCTION f_lammps_extract_variable_string () BIND(C) END FUNCTION f_lammps_extract_variable_string FUNCTION f_lammps_extract_variable_format () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp USE keepvar, ONLY : f2c_string @@ -295,7 +295,7 @@ FUNCTION f_lammps_extract_variable_format () BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp USE keepvar, ONLY : f2c_string @@ -308,7 +308,7 @@ FUNCTION f_lammps_extract_variable_format_pad () BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp USE keepvar, ONLY : f2c_string @@ -321,7 +321,7 @@ FUNCTION f_lammps_extract_variable_getenv () BIND(C) END FUNCTION f_lammps_extract_variable_getenv FUNCTION f_lammps_extract_variable_file () BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp USE keepvar, ONLY : f2c_string @@ -334,7 +334,7 @@ FUNCTION f_lammps_extract_variable_file () BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -347,7 +347,7 @@ FUNCTION f_lammps_extract_variable_atomfile(i) BIND(C) END FUNCTION f_lammps_extract_variable_atomfile FUNCTION f_lammps_extract_variable_python(i) BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_double + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -358,7 +358,7 @@ FUNCTION f_lammps_extract_variable_python(i) BIND(C) END FUNCTION f_lammps_extract_variable_python FUNCTION f_lammps_extract_variable_timer() BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -368,7 +368,7 @@ FUNCTION f_lammps_extract_variable_timer() BIND(C) END FUNCTION f_lammps_extract_variable_timer FUNCTION f_lammps_extract_variable_internal() BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -378,7 +378,7 @@ FUNCTION f_lammps_extract_variable_internal() BIND(C) END FUNCTION f_lammps_extract_variable_internal FUNCTION f_lammps_extract_variable_equal() BIND(C) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -388,7 +388,7 @@ FUNCTION f_lammps_extract_variable_equal() BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -401,7 +401,7 @@ FUNCTION f_lammps_extract_variable_atom(i) BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp IMPLICIT NONE @@ -414,7 +414,7 @@ FUNCTION f_lammps_extract_variable_vector(i) BIND(C) 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, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp USE keepvar, ONLY : f2c_string diff --git a/unittest/fortran/test_fortran_gather_scatter.f90 b/unittest/fortran/test_fortran_gather_scatter.f90 index dd9182afaa..69bb0e030f 100644 --- a/unittest/fortran/test_fortran_gather_scatter.f90 +++ b/unittest/fortran/test_fortran_gather_scatter.f90 @@ -22,7 +22,7 @@ SUBROUTINE f_lammps_close() BIND(C) lmp%handle = c_null_ptr END SUBROUTINE f_lammps_close -SUBROUTINE f_lammps_setup_gather_scatter () BIND(C) +SUBROUTINE f_lammps_setup_gather_scatter() BIND(C) USE LIBLAMMPS USE keepstuff, ONLY : lmp, big_input, cont_input, more_input IMPLICIT NONE @@ -33,7 +33,7 @@ SUBROUTINE f_lammps_setup_gather_scatter () BIND(C) CALL lmp%commands_list(more_input) END SUBROUTINE f_lammps_setup_gather_scatter -FUNCTION f_lammps_gather_atoms_mask (i) BIND(C) +FUNCTION f_lammps_gather_atoms_mask(i) BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -46,7 +46,7 @@ FUNCTION f_lammps_gather_atoms_mask (i) BIND(C) f_lammps_gather_atoms_mask = mask(i) END FUNCTION f_lammps_gather_atoms_mask -FUNCTION f_lammps_gather_atoms_position (i) BIND(C) +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 @@ -59,7 +59,7 @@ FUNCTION f_lammps_gather_atoms_position (i) BIND(C) f_lammps_gather_atoms_position = positions(i) END FUNCTION f_lammps_gather_atoms_position -FUNCTION f_lammps_gather_atoms_concat_mask (i) BIND(C) +FUNCTION f_lammps_gather_atoms_concat_mask(i) BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -72,7 +72,7 @@ FUNCTION f_lammps_gather_atoms_concat_mask (i) BIND(C) 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 + IF (tag(j) == i) THEN f_lammps_gather_atoms_concat_mask = mask(j) RETURN END IF @@ -80,7 +80,7 @@ FUNCTION f_lammps_gather_atoms_concat_mask (i) BIND(C) 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) +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 @@ -94,13 +94,13 @@ FUNCTION f_lammps_gather_atoms_concat_position (xyz, id) BIND(C) 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 + 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) +FUNCTION f_lammps_gather_atoms_subset_mask(i) BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -113,7 +113,7 @@ FUNCTION f_lammps_gather_atoms_subset_mask (i) BIND(C) CALL lmp%gather_atoms_subset('mask', 1_c_int, tag, mask) DO j = 1, SIZE(tag) - IF ( tag(j) == i ) THEN + IF (tag(j) == i) THEN f_lammps_gather_atoms_subset_mask = mask(j) RETURN END IF @@ -121,7 +121,7 @@ FUNCTION f_lammps_gather_atoms_subset_mask (i) BIND(C) 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) +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 @@ -134,7 +134,7 @@ FUNCTION f_lammps_gather_atoms_subset_position (xyz,id) BIND(C) CALL lmp%gather_atoms_subset('x', 3_c_int, tag, positions) DO j = 1, SIZE(tag) - IF ( tag(j) == id ) THEN + IF (tag(j) == id) THEN f_lammps_gather_atoms_subset_position = positions((j-1)*3 + xyz) RETURN END IF 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 e8ea330bd6..32f02789af 100644 --- a/unittest/fortran/test_fortran_properties.f90 +++ b/unittest/fortran/test_fortran_properties.f90 @@ -1,78 +1,78 @@ -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) + allocate (CHARACTER(LEN=strlen) :: Fstr) FORALL (i=1:strlen) Fstr(i:i) = Cstr(i) END FORALL 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 +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 + INTEGER(c_int) :: f_lammps_has_error - IF ( lmp%has_error() ) THEN - f_lammps_has_error = 1_C_int + IF (lmp%has_error()) THEN + f_lammps_has_error = 1_c_int ELSE - f_lammps_has_error = 0_C_int + 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, 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 + INTEGER(c_int) :: f_lammps_get_last_error_message CHARACTER(KIND=c_char), DIMENSION(*) :: errmesg - INTEGER(C_int), VALUE, INTENT(IN) :: errlen + INTEGER(c_int), VALUE, INTENT(IN) :: errlen CHARACTER(LEN=:), ALLOCATABLE :: buffer INTEGER :: status, i From d7d2802061d47d77fb1af976c8337fc67d76a2f5 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Mon, 3 Oct 2022 23:51:21 -0400 Subject: [PATCH 42/49] remove intentional false positive --- unittest/fortran/wrap_properties.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp index d2daa22cf4..59e98891c3 100644 --- a/unittest/fortran/wrap_properties.cpp +++ b/unittest/fortran/wrap_properties.cpp @@ -133,6 +133,6 @@ TEST_F(LAMMPS_properties, has_error) char errmsg[1024]; int err = f_lammps_get_last_error_message(errmsg, 1023); EXPECT_EQ(err, 1); - EXPECT_THAT(errmsg, ContainsRegex(".*ERRORx: Unknown command: this_is_not_a_known_command.*")); + EXPECT_THAT(errmsg, ContainsRegex(".*ERROR: Unknown command: this_is_not_a_known_command.*")); }; } // namespace LAMMPS_NS From bc6e42a6104999f5d35ca9a9997a275e7ca9854d Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 4 Oct 2022 04:11:39 -0400 Subject: [PATCH 43/49] add more extensive whitespace checking for fortran and unittests --- python/examples/mc.py | 4 +- python/examples/pizza/gl.py | 144 +++++++++--------- python/examples/pizza/vizinfo.py | 28 ++-- python/examples/pizza/vmd.py | 40 ++--- python/examples/pylammps/elastic/README | 2 +- python/examples/split.py | 6 +- python/examples/viz_gl.py | 2 +- python/examples/viz_pymol.py | 4 +- tools/coding_standard/whitespace.py | 4 +- .../fortran/test_fortran_extract_variable.f90 | 4 +- unittest/tools/test_lammps_shell.py | 2 +- unittest/utils/testshared.c | 4 +- 12 files changed, 123 insertions(+), 121 deletions(-) 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/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/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index 34ccb766de..ded3743409 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -100,7 +100,7 @@ FUNCTION f_lammps_with_C_args(argc, argv) BIND(C) TYPE(c_ptr), INTENT(IN), VALUE :: str INTEGER(c_size_t) :: c_strlen END FUNCTION c_strlen - END INTERFACE + END INTERFACE CALL C_F_POINTER(argv, Fargv, [argc]) DO i = 1, argc @@ -111,7 +111,7 @@ FUNCTION f_lammps_with_C_args(argc, argv) BIND(C) args(i)(j:j) = Cstr(j) END FORALL END DO - + lmp = lammps(args) f_lammps_with_C_args = lmp%handle END FUNCTION f_lammps_with_C_args 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; } - - + + From 90e820e8ec5b3bad110f4356c8c123e4874611a7 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 4 Oct 2022 08:55:53 -0400 Subject: [PATCH 44/49] format mpirun/mpiexec consistently --- doc/src/Fortran.rst | 12 ++++++------ doc/src/Run_basics.rst | 9 +++++---- doc/src/Run_options.rst | 20 ++++++++++---------- doc/src/Speed_gpu.rst | 13 +++++++------ doc/src/Speed_kokkos.rst | 17 +++++++++-------- doc/src/Speed_omp.rst | 8 ++++---- 6 files changed, 41 insertions(+), 38 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index e7b44c4686..28254e056c 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -29,12 +29,12 @@ 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 -``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. +``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 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. From b0e3c2a440c0ce2978bd1f0cc502c41f67e67957 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 4 Oct 2022 09:16:15 -0400 Subject: [PATCH 45/49] retrieving the error message clears the error status --- unittest/fortran/wrap_properties.cpp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp index 59e98891c3..5268548d48 100644 --- a/unittest/fortran/wrap_properties.cpp +++ b/unittest/fortran/wrap_properties.cpp @@ -134,5 +134,11 @@ TEST_F(LAMMPS_properties, has_error) 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 From 74705c811107ebc036bf519e973c8ebb0e3bb28d Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Tue, 4 Oct 2022 09:27:52 -0400 Subject: [PATCH 46/49] port error check test from fortran wrapper to c-library interface test --- .../c-library/test_library_properties.cpp | 27 +++++++++++++++++++ 1 file changed, 27 insertions(+) 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; From 8fd19fe7fe32bc0dcbde24eaea7bf5c55cfff7e2 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Tue, 4 Oct 2022 14:35:24 -0500 Subject: [PATCH 47/49] Fixed a typo in library.cpp (documentation) and adjusted spacing to be consistent --- src/library.cpp | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/library.cpp b/src/library.cpp index bfa0fc803a..e430614b13 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -1145,7 +1145,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 +1622,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 @@ -2080,7 +2080,7 @@ 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 +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. @@ -2157,7 +2157,7 @@ void *lammps_extract_variable(void *handle, const char *name, const char *group) 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. +decide how to cast the ``void *`` pointer and access the data. .. versionadded:: TBD @@ -3071,7 +3071,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; @@ -4526,7 +4526,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; @@ -5773,8 +5773,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; From 80da4c307c5a18026bfd47549255825cbb684781 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Wed, 5 Oct 2022 10:52:17 -0400 Subject: [PATCH 48/49] silence compiler warnings, avoid integer or buffer overflows --- fortran/lammps.f90 | 12 +++---- .../fortran/test_fortran_extract_variable.f90 | 36 +++++++++---------- .../fortran/test_fortran_gather_scatter.f90 | 1 - unittest/fortran/wrap_extract_variable.cpp | 4 +-- 4 files changed, 23 insertions(+), 30 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index d37b12c7db..880eef9b67 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -1134,7 +1134,7 @@ CONTAINS TYPE(lammps_variable_data) :: variable_data TYPE(c_ptr) :: Cptr, Cname, Cgroup, Cveclength - INTEGER :: length, i + 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() @@ -1370,7 +1370,6 @@ CONTAINS INTEGER(c_int) :: ndata TYPE(c_ptr) :: Cdata, Cname, Cids INTEGER(c_int), PARAMETER :: Ctype = 0_c_int - CHARACTER(LEN=100) :: error_msg IF (count /= 1 .AND. count /= 3) THEN CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & @@ -1401,7 +1400,6 @@ CONTAINS INTEGER(c_int) :: ndata TYPE(c_ptr) :: Cdata, Cname, Cids INTEGER(c_int), PARAMETER :: Ctype = 1_c_int - CHARACTER(LEN=100) :: error_msg IF (count /= 1 .AND. count /= 3) THEN CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & @@ -1494,7 +1492,6 @@ CONTAINS INTEGER(c_int), PARAMETER :: Ctype = 0_c_int INTEGER(c_int) :: Cndata, Ccount TYPE(c_ptr) :: Cdata, Cname, Cids - CHARACTER(LEN=100) :: error_msg Cndata = SIZE(ids, KIND=c_int) Ccount = SIZE(data, KIND=c_int) / Cndata @@ -1519,7 +1516,6 @@ CONTAINS INTEGER(c_int), PARAMETER :: Ctype = 1_c_int INTEGER(c_int) :: Cndata, Ccount TYPE(c_ptr) :: Cdata, Cname, Cids - CHARACTER(LEN=100) :: error_msg Cndata = SIZE(ids, KIND=c_int) Ccount = SIZE(data, KIND=c_int) / Cndata @@ -1628,7 +1624,7 @@ CONTAINS INTEGER(c_int) :: Cidx, Csuccess TYPE(c_ptr) :: Cptr CHARACTER(LEN=1,KIND=c_char), TARGET :: Cbuffer(LEN(buffer)+1) - INTEGER :: i, strlen + INTEGER(c_size_t) :: i, strlen Cidx = idx - 1 Cptr = C_LOC(Cbuffer(1)) @@ -1698,8 +1694,8 @@ CONTAINS CLASS(lammps), INTENT(IN) :: self CHARACTER(LEN=*), INTENT(OUT) :: buffer INTEGER, INTENT(OUT), OPTIONAL :: status - INTEGER(c_int) :: buflen, Cstatus, i - INTEGER(c_size_t) :: length + INTEGER(c_int) :: buflen, Cstatus + INTEGER(c_size_t) :: i, length TYPE(c_ptr) :: Cptr CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:) diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index ded3743409..e373228a0f 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -33,8 +33,7 @@ CONTAINS 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 :: i - INTEGER(c_size_t) :: length + INTEGER(c_size_t) :: i, length test_input_directory = lmp%extract_variable('input_dir') c_test_input_directory = f2c_string(test_input_directory) @@ -91,10 +90,10 @@ FUNCTION f_lammps_with_C_args(argc, argv) BIND(C) 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 :: i, length, j + INTEGER(c_size_t):: i, length, j INTERFACE - 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), INTENT(IN), VALUE :: str @@ -126,7 +125,7 @@ SUBROUTINE f_lammps_close() BIND(C) lmp%handle = c_null_ptr END SUBROUTINE f_lammps_close -SUBROUTINE f_lammps_setup_extract_variable () BIND(C) +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 @@ -173,7 +172,7 @@ SUBROUTINE f_lammps_setup_extract_variable () BIND(C) 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) +FUNCTION f_lammps_extract_variable_index_1() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -189,7 +188,7 @@ FUNCTION f_lammps_extract_variable_index_1 () BIND(C) END IF END FUNCTION f_lammps_extract_variable_index_1 -FUNCTION f_lammps_extract_variable_index_2 () BIND(C) +FUNCTION f_lammps_extract_variable_index_2() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -205,7 +204,7 @@ FUNCTION f_lammps_extract_variable_index_2 () BIND(C) END IF END FUNCTION f_lammps_extract_variable_index_2 -FUNCTION f_lammps_extract_variable_loop () BIND(C) +FUNCTION f_lammps_extract_variable_loop() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -217,7 +216,7 @@ FUNCTION f_lammps_extract_variable_loop () BIND(C) READ(loop,*) f_lammps_extract_variable_loop END FUNCTION f_lammps_extract_variable_loop -FUNCTION f_lammps_extract_variable_loop_pad () BIND(C) +FUNCTION f_lammps_extract_variable_loop_pad() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -230,7 +229,7 @@ FUNCTION f_lammps_extract_variable_loop_pad () BIND(C) 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) +FUNCTION f_lammps_extract_variable_world() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -243,7 +242,7 @@ FUNCTION f_lammps_extract_variable_world () BIND(C) f_lammps_extract_variable_world = f2c_string(world) END FUNCTION f_lammps_extract_variable_world -FUNCTION f_lammps_extract_variable_universe () BIND(C) +FUNCTION f_lammps_extract_variable_universe() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -256,7 +255,7 @@ FUNCTION f_lammps_extract_variable_universe () BIND(C) f_lammps_extract_variable_universe = f2c_string(universe) END FUNCTION f_lammps_extract_variable_universe -FUNCTION f_lammps_extract_variable_uloop () BIND(C) +FUNCTION f_lammps_extract_variable_uloop() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -268,7 +267,7 @@ FUNCTION f_lammps_extract_variable_uloop () BIND(C) READ(uloop,*) f_lammps_extract_variable_uloop END FUNCTION f_lammps_extract_variable_uloop -FUNCTION f_lammps_extract_variable_string () BIND(C) +FUNCTION f_lammps_extract_variable_string() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -281,7 +280,7 @@ FUNCTION f_lammps_extract_variable_string () BIND(C) f_lammps_extract_variable_string = f2c_string(string) END FUNCTION f_lammps_extract_variable_string -FUNCTION f_lammps_extract_variable_format () BIND(C) +FUNCTION f_lammps_extract_variable_format() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -294,7 +293,7 @@ FUNCTION f_lammps_extract_variable_format () BIND(C) f_lammps_extract_variable_format = f2c_string(form) END FUNCTION f_lammps_extract_variable_format -FUNCTION f_lammps_extract_variable_format_pad () BIND(C) +FUNCTION f_lammps_extract_variable_format_pad() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -307,7 +306,7 @@ FUNCTION f_lammps_extract_variable_format_pad () BIND(C) 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) +FUNCTION f_lammps_extract_variable_getenv() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -320,7 +319,7 @@ FUNCTION f_lammps_extract_variable_getenv () BIND(C) f_lammps_extract_variable_getenv = f2c_string(string) END FUNCTION f_lammps_extract_variable_getenv -FUNCTION f_lammps_extract_variable_file () BIND(C) +FUNCTION f_lammps_extract_variable_file() BIND(C) USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE LIBLAMMPS USE keepstuff, ONLY : lmp @@ -346,12 +345,11 @@ FUNCTION f_lammps_extract_variable_atomfile(i) BIND(C) f_lammps_extract_variable_atomfile = atom_data(i) END FUNCTION f_lammps_extract_variable_atomfile -FUNCTION f_lammps_extract_variable_python(i) BIND(C) +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 - INTEGER(c_int), INTENT(IN), VALUE :: i REAL(c_double) :: f_lammps_extract_variable_python f_lammps_extract_variable_python = lmp%extract_variable('py') diff --git a/unittest/fortran/test_fortran_gather_scatter.f90 b/unittest/fortran/test_fortran_gather_scatter.f90 index 69bb0e030f..ec1880c908 100644 --- a/unittest/fortran/test_fortran_gather_scatter.f90 +++ b/unittest/fortran/test_fortran_gather_scatter.f90 @@ -190,7 +190,6 @@ SUBROUTINE f_lammps_scatter_atoms_subset_mask() BIND(C) INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: all_masks INTEGER(c_int), DIMENSION(*), PARAMETER :: tags = [3,1] INTEGER(c_int), DIMENSION(2) :: masks - INTEGER(c_int) :: swap CALL lmp%gather_atoms('mask', 1_c_int, all_masks) diff --git a/unittest/fortran/wrap_extract_variable.cpp b/unittest/fortran/wrap_extract_variable.cpp index 0c1ffcc37e..1082a381bb 100644 --- a/unittest/fortran/wrap_extract_variable.cpp +++ b/unittest/fortran/wrap_extract_variable.cpp @@ -165,7 +165,7 @@ TEST_F(LAMMPS_extract_variable, format) { f_lammps_setup_extract_variable(); int i; - char str[10]; + char str[16]; char *fstr; for (i = 1; i <= 10; i++) { std::sprintf(str, "%.6G", std::exp(i)); @@ -180,7 +180,7 @@ TEST_F(LAMMPS_extract_variable, format_pad) { f_lammps_setup_extract_variable(); int i; - char str[10]; + char str[16]; char *fstr; for (i = 1; i <= 10; i++) { std::sprintf(str, "%08.6G", std::exp(i)); From e3b5514b623d2d9dcfcec4622339f609b292cfe9 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 5 Oct 2022 14:30:02 -0500 Subject: [PATCH 49/49] I just learned that FORALL is obsolescent in Fortran 2018; removed --- fortran/lammps.f90 | 12 ++++++------ unittest/fortran/test_fortran_extract_variable.f90 | 4 ++-- unittest/fortran/test_fortran_properties.f90 | 6 +++--- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index d37b12c7db..d73949cb1a 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -885,9 +885,9 @@ CONTAINS length = c_strlen(Cptr) CALL C_F_POINTER(Cptr, Fptr, [length]) ALLOCATE(CHARACTER(LEN=length) :: global_data%str) - FORALL (i=1:length) + DO i = 1, length global_data%str(i:i) = Fptr(i) - END FORALL + END DO CASE DEFAULT CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & 'Unknown pointer type in extract_global') @@ -1188,9 +1188,9 @@ CONTAINS length = c_strlen(Cptr) CALL C_F_POINTER(Cptr, Cstring, [length]) ALLOCATE(CHARACTER(LEN=length) :: variable_data%str) - FORALL (i=1:length) + DO i = 1, length variable_data%str(i:i) = Cstring(i) - END FORALL + END DO ! DO NOT deallocate the C pointer CASE (-1) CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & @@ -1636,9 +1636,9 @@ CONTAINS buffer = ' ' IF (Csuccess /= 0_c_int) THEN strlen = c_strlen(Cptr) - FORALL (i = 1:strlen) + DO i = 1, strlen buffer(i:i) = Cbuffer(i) - END FORALL + END DO END IF END SUBROUTINE lmp_config_package_name diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index ded3743409..269047da5a 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -107,9 +107,9 @@ FUNCTION f_lammps_with_C_args(argc, argv) BIND(C) args(i) = '' length = c_strlen(Fargv(i)) CALL C_F_POINTER(Fargv(i), Cstr, [length]) - FORALL (j = 1:length) + DO j = 1, length args(i)(j:j) = Cstr(j) - END FORALL + END DO END DO lmp = lammps(args) diff --git a/unittest/fortran/test_fortran_properties.f90 b/unittest/fortran/test_fortran_properties.f90 index 32f02789af..39606937a4 100644 --- a/unittest/fortran/test_fortran_properties.f90 +++ b/unittest/fortran/test_fortran_properties.f90 @@ -43,10 +43,10 @@ FUNCTION f_lammps_extract_setting(Cstr) BIND(C) 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) END FUNCTION f_lammps_extract_setting