From b51c50294e3d209eba33d7010591738ecff9d38c Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 19 Oct 2022 18:40:12 -0500 Subject: [PATCH] implemented create_atoms and encode_image_flags and unit tests for them; added IMGMASK and friends to extract_setting and unit tests for them; wrote documentation for them --- doc/src/Fortran.rst | 104 +++++++++- fortran/lammps.f90 | 194 ++++++++++++++---- src/library.cpp | 28 +++ .../fortran/test_fortran_create_atoms.f90 | 99 ++++++++- unittest/fortran/test_fortran_properties.f90 | 31 ++- unittest/fortran/wrap_create_atoms.cpp | 144 ++++++++++++- unittest/fortran/wrap_properties.cpp | 31 +++ 7 files changed, 578 insertions(+), 53 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 28254e056c..f755670d77 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -145,10 +145,10 @@ Below is a small demonstration of the uses of the different functions: PROGRAM testcmd USE LIBLAMMPS - TYPE(lammps) :: lmp - CHARACTER(len=512) :: cmds - CHARACTER(len=40), ALLOCATABLE :: cmdlist(:) - CHARACTER(len=10) :: trimmed + TYPE(lammps) :: lmp + CHARACTER(LEN=512) :: cmds + CHARACTER(LEN=40), ALLOCATABLE :: cmdlist(:) + CHARACTER(LEN=10) :: trimmed INTEGER :: i lmp = lammps() @@ -265,6 +265,7 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :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 subroutine create_atoms: :f:func:`create_atoms` :f function version: :f:func:`version` :f subroutine flush_buffers: :f:func:`flush_buffers` :f function is_running: :f:func:`is_running` @@ -1267,6 +1268,56 @@ Procedures Bound to the lammps Derived Type -------- +.. f:subroutine:: create_atoms([id,] type, x, [v,] [image,] [bexpand]) + + This method calls :c:func:`lammps_create_atoms` to create additional atoms + from a given list of coordinates and a list of atom types. Additionally, + the atom IDs, velocities, and image flags may be provided. + + .. versionadded:: TBD + + :p integer(c_int) type [dimension(N)]: vector of :math:`N` atom types + (required/see note below) + :p real(c_double) x [dimension(3N)]: vector of :math:`3N` x/y/z positions + of the new atoms, arranged as :math:`[x_1,y_1,z_1,x_2,y_2,\dotsc]` + (required/see note below) + :o integer(\*) id [dimension(N)]: vector of :math:`N` atom IDs; if + absent, LAMMPS will generate them for you. \*The kind parameter should be + ``c_int`` unless LAMMPS was compiled with ``-DLAMMPS_BIGBIG``, in which + case it should be ``c_int64_t``. + :o real(c_double) v [dimension(3N)]: vector of :math:`3N` x/y/z velocities + of the new atoms, arranged as :math:`[v_{1,x},v_{1,y},v_{1,z},v_{2,x}, + \dotsc]`; if absent, they will be set to zero + :o integer(\*) image [dimension(N)]: vector of :math:`N` image flags; if + absent, they are set to zero. \*The kind parameter should be + ``c_int`` unless LAMMPS was compiled with ``-DLAMMPS_BIGBIG``, in which + case it should be ``c_int64_t``. See note below. + :o logical bexpand: if ``.TRUE.``, atoms outside of shrink-wrap boundaries + will be created, not dropped, and the box dimensions will be extended. + Default is ``.FALSE.`` + + .. note:: + + The *type* and *x* arguments are required, but they are declared + ``OPTIONAL`` in the module because making them mandatory would require + *id* to be present as well. To have LAMMPS generate the ids for you, + use a call something like + + .. code-block:: Fortran + + lmp%create_atoms(type=new_types, x=new_xs) + + .. note:: + + When LAMMPS has been compiled with ``-DLAMMPS_BIGBIG``, it is not + possible to include the *image* parameter but omit the *id* parameter. + Either *id* must be present, or both *id* and *image* must be absent. + This is required because having all arguments be optional in both + generic functions creates an ambiguous interface. This limitation does + not exist if LAMMPS was not compiled with ``-DLAMMPS_BIGBIG``. + +-------- + .. f:function:: version() This method returns the numeric LAMMPS version like @@ -1456,6 +1507,51 @@ Procedures Bound to the lammps Derived Type -------- +.. f:function:: encode_image_flags(ix, iy, iz) + + Encodes three integer image flags into a single imageint. + + .. versionadded:: TBD + + This function performs the bit-shift, addition, and bit-wise OR operations + necessary to combine the values of three integers representing the image + flags in the :math:`x`-, :math:`y`-, and :math:`z`-directions. Unless LAMMPS + is compiled with ``-DLAMMPS_BIGBIG``, those integers are limited to 10-bit + signed integers :math:`[-512,512]`. If ``-DLAMMPS_BIGBIG`` was used when + compiling, then the return value is of kind ``c_int64_t`` instead of + kind ``c_int``, and the valid range for the individual image flags becomes + :math:`[-1048576,1048575]` (i.e., the range of a 21-bit signed integer). + There is no check on whether the arguments conform to these requirements. + + :p integer(c_int) ix: image flag in :math:`x`-direction + :p integer(c_int) iy: image flag in :math:`y`-direction + :p integer(c_int) iz: image flag in :math:`z`-direction + :r integer(\*): encoded image flag. \*Kind parameter is ``c_int`` unless + LAMMPS was built with ``-DLAMMPS_BIGBIG``, in which case it is + ``c_int64_t``. + + .. note:: + + The fact that the programmer does not know the kind parameter of the + return value until compile time means that it is impossible to define an + interface that works for both sizes of ``imageint``. One side effect of + this is that you must assign the return value of this function to a + variable; it cannot be used as the argument to another function or as part + of an array constructor. For example, + + .. code-block:: Fortran + + my_images = [lmp%encode_image_flags(0,0,0), lmp%encode_image_flags(1,0,0)] + + will *not* work; instead, do something like + + .. code-block:: Fortran + + my_images(1) = lmp%encode_image_flags(0,0,0) + my_images(2) = lmp%encode_image_flags(1,0,0) + +-------- + .. f:subroutine:: flush_buffers() This function calls :cpp:func:`lammps_flush_buffers`, which flushes buffered diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 2cbeeb4490..467acf057d 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -130,18 +130,19 @@ MODULE LIBLAMMPS lmp_create_atoms_bigbig ! 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, 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 :: encode_image_flags => lmp_encode_image_flags ! PROCEDURE :: flush_buffers => lmp_flush_buffers PROCEDURE :: is_running => lmp_is_running @@ -202,6 +203,11 @@ MODULE LIBLAMMPS CHARACTER(LEN=:), ALLOCATABLE :: str END TYPE lammps_variable_data + TYPE, EXTENDS(lammps_data_baseclass) :: lammps_image_data + INTEGER(c_int) :: i32 + INTEGER(c_int64_t) :: i64 + END TYPE lammps_image_data + ! This overloads the assignment operator (=) so that assignments of the ! form ! nlocal = extract_global('nlocal') @@ -222,6 +228,9 @@ MODULE LIBLAMMPS MODULE PROCEDURE assign_double_to_lammps_variable_data, & assign_doublevec_to_lammps_variable_data, & assign_string_to_lammps_variable_data + ! Image data, too + MODULE PROCEDURE assign_int_to_lammps_image_data, & + assign_int64_to_lammps_image_data END INTERFACE ! interface definitions for calling functions in library.cpp @@ -567,6 +576,10 @@ MODULE LIBLAMMPS !INTEGER(c_int) FUNCTION lammps_plugin_count !SUBROUTINE lammps_plugin_name + ! We don't call lammps_encode_image_flags because its interface is + ! ambiguous: we don't know sizeof(imageint) prior to compile time + ! It is re-written in Fortran below. It was easier to do the same for + ! lammps_decode_image_flags's equivalent. !Both of these use LAMMPS_BIGBIG !INTEGER(LAMMPS_imageint) FUNCTION lammps_encode_image_flags !SUBROUTINE lammps_decode_image_flags @@ -1544,34 +1557,69 @@ CONTAINS CALL lammps_free(Cname) END SUBROUTINE lmp_scatter_atoms_subset_double - ! equivalent function to lammps_create_atoms + ! equivalent function to lammps_create_atoms (int ids or id absent) SUBROUTINE lmp_create_atoms_int(self, id, type, x, v, image, bexpand) CLASS(lammps), INTENT(IN) :: self - INTEGER(c_int), DIMENSION(:), TARGET :: id, image - INTEGER(c_int), DIMENSION(:), TARGET :: type - REAL(c_double), DIMENSION(:), TARGET :: x, v - LOGICAL :: bexpand + INTEGER(c_int), DIMENSION(:), TARGET, OPTIONAL :: id, image + INTEGER(c_int), DIMENSION(:), TARGET, OPTIONAL :: type + REAL(c_double), DIMENSION(:), TARGET, OPTIONAL :: x, v + LOGICAL, OPTIONAL :: bexpand INTEGER(c_int) :: n, Cbexpand TYPE(c_ptr) :: Cid, Ctype, Cx, Cv, Cimage INTEGER(c_int) :: tagint_size, atoms_created + ! type is actually NOT optional, but we can't make id optional without it, + ! so we check at run-time + IF (.NOT. PRESENT(type)) THEN + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'the "type" argument to create_atoms is required& + & [Fortran/create_atoms]') + END IF + tagint_size = lmp_extract_setting(self, 'tagint') - IF ( tagint_size /= 4_c_int ) THEN + IF (tagint_size /= 4_c_int .AND. (PRESENT(id) .OR. PRESENT(image))) THEN CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & 'Unable to create_atoms; your id/image array types are incompatible& & with LAMMPS_SMALLBIG and LAMMPS_SMALLSMALL [Fortran/create_atoms]') + RETURN ! in case exception is caught END IF - n = SIZE(id, KIND=c_int) - IF ( bexpand) THEN - Cbexpand = 1_c_int + n = SIZE(type, KIND=c_int) + IF (PRESENT(bexpand)) THEN + IF (bexpand) THEN + Cbexpand = 1_c_int + ELSE + Cbexpand = 0_c_int + END IF ELSE - Cbexpand = 0 + Cbexpand = 0_c_int + END IF + IF (PRESENT(id)) THEN + Cid = C_LOC(id(1)) + ELSE + Cid = c_null_ptr + END IF + IF (PRESENT(type)) THEN + Ctype = C_LOC(type(1)) + ELSE + RETURN ! We shouldn't get here unless exceptions are being caught + END IF + IF (PRESENT(image)) THEN + Cimage = C_LOC(image(1)) + ELSE + Cimage = c_null_ptr + END IF + IF (PRESENT(x)) THEN + Cx = C_LOC(x(1)) + ELSE + CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, & + 'the argument "x" to create_atoms is required') + RETURN + END IF + IF (PRESENT(v)) THEN + Cv = C_LOC(v(1)) + ELSE + Cv = c_null_ptr END IF - Cid = C_LOC(id(1)) - Ctype = C_LOC(type(1)) - Cimage = C_LOC(image(1)) - Cx = C_LOC(x(1)) - Cv = C_LOC(v(1)) atoms_created = lammps_create_atoms(self%handle, n, Cid, Ctype, Cx, Cv, & Cimage, Cbexpand) IF ( atoms_created < 0_c_int ) THEN @@ -1583,12 +1631,15 @@ CONTAINS END IF END SUBROUTINE lmp_create_atoms_int + ! equivalent function to lammps_create_atoms (long int ids and images) SUBROUTINE lmp_create_atoms_bigbig(self, id, type, x, v, image, bexpand) CLASS(lammps), INTENT(IN) :: self - INTEGER(c_int64_t), DIMENSION(:), TARGET :: id, image + INTEGER(c_int64_t), DIMENSION(:), TARGET :: id INTEGER(c_int), DIMENSION(:), TARGET :: type - REAL(c_double), DIMENSION(:), TARGET :: x, v - LOGICAL :: bexpand + REAL(c_double), DIMENSION(:), TARGET :: x + REAL(c_double), DIMENSION(:), OPTIONAL, TARGET :: v + INTEGER(c_int64_t), DIMENSION(:), OPTIONAL, TARGET :: image + LOGICAL, OPTIONAL :: bexpand INTEGER(c_int) :: n, Cbexpand TYPE(c_ptr) :: Cid, Ctype, Cx, Cv, Cimage INTEGER(c_int) :: tagint_size, atoms_created @@ -1599,17 +1650,29 @@ CONTAINS 'Unable to create_atoms; your id/image array types are incompatible& & with LAMMPS_BIGBIG') END IF - n = SIZE(id, KIND=c_int) - IF ( bexpand) THEN - Cbexpand = 1_c_int + n = SIZE(type, KIND=c_int) + IF (PRESENT(bexpand)) THEN + IF (bexpand) THEN + Cbexpand = 1_c_int + ELSE + Cbexpand = 0_c_int + END IF ELSE - Cbexpand = 0 + Cbexpand = 0_c_int END IF Cid = C_LOC(id(1)) Ctype = C_LOC(type(1)) - Cimage = C_LOC(image(1)) + IF (PRESENT(image)) THEN + Cimage = C_LOC(image(1)) + ELSE + Cimage = c_null_ptr + END IF Cx = C_LOC(x(1)) - Cv = C_LOC(v(1)) + IF (PRESENT(v)) THEN + Cv = C_LOC(v(1)) + ELSE + Cv = c_null_ptr + END IF atoms_created = lammps_create_atoms(self%handle, n, Cid, Ctype, Cx, Cv, & Cimage, Cbexpand) IF ( atoms_created < 0_c_int ) THEN @@ -1748,6 +1811,43 @@ CONTAINS END DO END SUBROUTINE lmp_installed_packages + ! equivalent function to lammps_encode_image_flags + FUNCTION lmp_encode_image_flags(self, ix, iy, iz) RESULT (image) + CLASS(lammps), INTENT(IN), TARGET :: self + INTEGER(c_int), INTENT(IN) :: ix, iy, iz + TYPE(lammps_image_data) :: image + INTEGER(c_int) :: imageint_size + INTEGER(c_int) :: IMGMAX, IMGMASK, IMGBITS, IMG2BITS + INTEGER(c_int64_t) :: ibx, iby, ibz, BIMGMAX, BIMGMASK, BIMGBITS, BIMG2BITS + + image%lammps_instance => self + IMGMASK = lmp_extract_setting(self, 'IMGMASK') + IMGMAX = lmp_extract_setting(self, 'IMGMAX') + IMGBITS = lmp_extract_setting(self, 'IMGBITS') + IMG2BITS = lmp_extract_setting(self, 'IMG2BITS') + imageint_size = lmp_extract_setting(self, 'imageint') + IF (imageint_size == 4_c_int) THEN + image%datatype = DATA_INT + image%i32 = IOR( IOR(IAND(ix + IMGMAX, IMGMASK), & + ISHFT(IAND(iy + IMGMAX, IMGMASK), IMGBITS)), & + ISHFT(IAND(iz + IMGMAX, IMGMASK), IMG2BITS) ) + ELSE + image%datatype = DATA_INT64 + ibx = ix + iby = iy + ibz = iz + BIMGMAX = IMGMAX + BIMGMASK = IMGMASK + BIMGBITS = IMGBITS + BIMG2BITS = IMG2BITS + image%i64 = IOR( IOR(IAND(ibx + BIMGMAX, BIMGMASK), & + ISHFT(IAND(iby + BIMGMAX, BIMGMASK), BIMGBITS)), & + ISHFT(IAND(ibz + BIMGMAX, BIMGMASK), BIMG2BITS) ) + END IF + END FUNCTION lmp_encode_image_flags + + ! equivalent function to lammps_decode_image_flags + ! equivalent function to lammps_flush_buffers SUBROUTINE lmp_flush_buffers(self) CLASS(lammps), INTENT(IN) :: self @@ -1984,6 +2084,28 @@ CONTAINS END IF END SUBROUTINE assign_string_to_lammps_variable_data + SUBROUTINE assign_int_to_lammps_image_data(lhs, rhs) + INTEGER(c_int), INTENT(OUT) :: lhs + CLASS(lammps_image_data), INTENT(IN) :: rhs + + IF (rhs%datatype == DATA_INT) THEN + lhs = rhs%i32 + ELSE + CALL assignment_error(rhs, 'scalar int') + END IF + END SUBROUTINE assign_int_to_lammps_image_data + + SUBROUTINE assign_int64_to_lammps_image_data(lhs, rhs) + INTEGER(c_int64_t), INTENT(OUT) :: lhs + CLASS(lammps_image_data), INTENT(IN) :: rhs + + IF (rhs%datatype == DATA_INT64) THEN + lhs = rhs%i64 + ELSE + CALL assignment_error(rhs, 'scalar long int') + END IF + END SUBROUTINE assign_int64_to_lammps_image_data + ! ---------------------------------------------------------------------- ! Generic function to catch all errors in assignments of LAMMPS data to ! user-space variables/pointers diff --git a/src/library.cpp b/src/library.cpp index 03f6c0e211..28da887496 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -953,6 +953,7 @@ 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:`Image masks ` * :ref:`System status ` * :ref:`System sizes ` * :ref:`Atom style flags ` @@ -977,6 +978,28 @@ be called without a valid LAMMPS object handle (it is ignored). - size of the ``imageint`` integer type, 4 or 8 bytes. Set at :ref:`compile time `. +.. _extract_image_masks: + +**Image masks** + +These settings are related to how LAMMPS stores and interprets periodic images. The values are used +internally by the Fortran interface and are not likely to be useful to users. + +.. list-table:: + :header-rows: 1 + :widths: auto + + * - Keyword + - Description / Return value + * - IMGMASK + - Bit-mask used to convert image flags to a single integer + * - IMGMAX + - Maximum allowed image number for a particular atom + * - IMGBITS + - Bits used in image counts + * - IMG2BITS + - Second bitmask used in image counts + .. _extract_system_status: **System status** @@ -1096,6 +1119,11 @@ int lammps_extract_setting(void *handle, const char *keyword) if (strcmp(keyword,"tagint") == 0) return sizeof(tagint); if (strcmp(keyword,"imageint") == 0) return sizeof(imageint); + if (strcmp(keyword,"IMGMASK") == 0) return IMGMASK; + if (strcmp(keyword,"IMGBITS") == 0) return IMGBITS; + if (strcmp(keyword,"IMG2BITS") == 0) return IMG2BITS; + if (strcmp(keyword,"IMGMAX") == 0) return IMGMAX; + if (strcmp(keyword,"dimension") == 0) return lmp->domain->dimension; if (strcmp(keyword,"box_exist") == 0) return lmp->domain->box_exist; if (strcmp(keyword,"newton_bond") == 0) return lmp->force->newton_bond; diff --git a/unittest/fortran/test_fortran_create_atoms.f90 b/unittest/fortran/test_fortran_create_atoms.f90 index 3ad5eb5625..7ba20a00db 100644 --- a/unittest/fortran/test_fortran_create_atoms.f90 +++ b/unittest/fortran/test_fortran_create_atoms.f90 @@ -24,7 +24,7 @@ END SUBROUTINE f_lammps_close SUBROUTINE f_lammps_setup_create_atoms() BIND(C) USE LIBLAMMPS - USE keepstuff, ONLY : lmp, big_input, cont_input, more_input + USE keepstuff, ONLY : lmp, big_input, cont_input, more_input, pair_input IMPLICIT NONE !CALL lmp%command('atom_modify map array') @@ -35,7 +35,7 @@ END SUBROUTINE f_lammps_setup_create_atoms SUBROUTINE f_lammps_create_three_atoms() BIND(C) USE ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t - USE keepstuff, ONLY : lmp, big_input, cont_input, more_input + USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE INTEGER(c_int), DIMENSION(3) :: new_ids, new_images, new_types @@ -46,8 +46,16 @@ SUBROUTINE f_lammps_create_three_atoms() BIND(C) new_ids = [4, 6, 5] new_big_ids = [4, 6, 5] - new_images = [0, 0, 1] - new_big_images = [0, 0, 1] + tagint_size = lmp%extract_setting('tagint') + IF ( tagint_size == 4_c_int ) THEN + new_images(1) = lmp%encode_image_flags(1, -1, 3) + new_images(2) = lmp%encode_image_flags(-2, 0, 0) + new_images(3) = lmp%encode_image_flags(-2, -2, 1) + ELSE + new_big_images(1) = lmp%encode_image_flags(1, -1, 3) + new_big_images(2) = lmp%encode_image_flags(-2, 0, 0) + new_big_images(3) = lmp%encode_image_flags(-2, -2, 1) + END IF new_types = [1, 1, 1] new_x = [ 1.0_c_double, 1.8_c_double, 2.718281828_c_double, & 0.6_c_double, 0.8_c_double, 2.2_c_double, & @@ -56,7 +64,6 @@ SUBROUTINE f_lammps_create_three_atoms() BIND(C) 0.1_c_double, 0.2_c_double, -0.2_c_double, & 1.0_c_double, -1.0_c_double, 3.0_c_double ] wrap = .FALSE. - tagint_size = lmp%extract_setting('tagint') IF ( tagint_size == 4_c_int ) THEN CALL lmp%create_atoms(new_ids, new_types, new_x, new_v, new_images, wrap) ELSE @@ -65,4 +72,86 @@ SUBROUTINE f_lammps_create_three_atoms() BIND(C) END IF END SUBROUTINE f_lammps_create_three_atoms +SUBROUTINE f_lammps_create_two_more() BIND(C) + USE ISO_C_BINDING, ONLY: c_double, c_int + USE keepstuff, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int), DIMENSION(2) :: new_types + REAL(c_double), DIMENSION(6) :: new_x + + new_types = [1_c_int, 1_c_int] + new_x = [0.1_c_double, 1.9_c_double, 3.8_c_double, & + 1.2_c_double, 2.1_c_double, 1.25_c_double] + CALL lmp%create_atoms(type=new_types, x=new_x) +END SUBROUTINE f_lammps_create_two_more + +SUBROUTINE f_lammps_create_two_more_small() BIND(C) + USE ISO_C_BINDING, ONLY: c_double, c_int + USE keepstuff, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int), DIMENSION(2) :: new_types + REAL(c_double), DIMENSION(6) :: new_x + INTEGER(c_int), DIMENSION(2) :: new_id, new_image + + new_types = [1_c_int, 1_c_int] + new_x = [0.1_c_double, 1.9_c_double, 3.8_c_double, & + 1.2_c_double, 2.1_c_double, 1.25_c_double] + new_id = [8_c_int, 7_c_int] + new_image(1) = lmp%encode_image_flags(1,0,0) + new_image(2) = lmp%encode_image_flags(-1,0,0) + CALL lmp%create_atoms(id=new_id, image=new_image, type=new_types, x=new_x) +END SUBROUTINE f_lammps_create_two_more_small + +SUBROUTINE f_lammps_create_two_more_big() BIND(C) + USE ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t + USE keepstuff, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int), DIMENSION(2) :: new_types + REAL(c_double), DIMENSION(6) :: new_x + INTEGER(c_int64_t), DIMENSION(2) :: new_id, new_image + + new_types = [1_c_int, 1_c_int] + new_x = [0.1_c_double, 1.9_c_double, 3.8_c_double, & + 1.2_c_double, 2.1_c_double, 1.25_c_double] + new_id = [8_c_int64_t, 7_c_int64_t] + new_image(1) = lmp%encode_image_flags(1,0,0) + new_image(2) = lmp%encode_image_flags(-1,0,0) + CALL lmp%create_atoms(id=new_id, image=new_image, type=new_types, x=new_x) +END SUBROUTINE f_lammps_create_two_more_big + +SUBROUTINE f_lammps_create_two_more_small2() BIND(C) + USE ISO_C_BINDING, ONLY: c_double, c_int + USE keepstuff, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int), DIMENSION(2) :: new_types + REAL(c_double), DIMENSION(6) :: new_x + INTEGER(c_int), DIMENSION(2) :: new_id + + new_types = [1_c_int, 1_c_int] + new_x = [0.1_c_double, 1.9_c_double, 3.8_c_double, & + 1.2_c_double, 2.1_c_double, 1.25_c_double] + new_id = [8_c_int, 7_c_int] + CALL lmp%create_atoms(id=new_id, type=new_types, x=new_x) +END SUBROUTINE f_lammps_create_two_more_small2 + +SUBROUTINE f_lammps_create_two_more_big2() BIND(C) + USE ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t + USE keepstuff, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int), DIMENSION(2) :: new_types + REAL(c_double), DIMENSION(6) :: new_x + INTEGER(c_int64_t), DIMENSION(2) :: new_id + + new_types = [1_c_int, 1_c_int] + new_x = [0.1_c_double, 1.9_c_double, 3.8_c_double, & + 1.2_c_double, 2.1_c_double, 1.25_c_double] + new_id = [8_c_int64_t, 7_c_int64_t] + CALL lmp%create_atoms(id=new_id, type=new_types, x=new_x) +END SUBROUTINE f_lammps_create_two_more_big2 + ! vim: ts=2 sts=2 sw=2 et diff --git a/unittest/fortran/test_fortran_properties.f90 b/unittest/fortran/test_fortran_properties.f90 index 39606937a4..6fb6b6ce5c 100644 --- a/unittest/fortran/test_fortran_properties.f90 +++ b/unittest/fortran/test_fortran_properties.f90 @@ -29,7 +29,7 @@ FUNCTION f_lammps_get_mpi_comm() BIND(C) 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 + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_char, c_null_char USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE @@ -39,7 +39,7 @@ FUNCTION f_lammps_extract_setting(Cstr) BIND(C) CHARACTER(LEN=:), ALLOCATABLE :: Fstr i = 1 - DO WHILE (Cstr(i) /= ACHAR(0)) + DO WHILE (Cstr(i) /= c_null_char) i = i + 1 END DO strlen = i @@ -66,7 +66,8 @@ FUNCTION f_lammps_has_error() BIND(C) 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, & + c_null_char USE keepstuff, ONLY : lmp USE LIBLAMMPS IMPLICIT NONE @@ -83,7 +84,29 @@ FUNCTION f_lammps_get_last_error_message(errmesg, errlen) BIND(C) ! and copy to C style string DO i=1, errlen errmesg(i) = buffer(i:i) - IF (buffer(i:i) == ACHAR(0)) EXIT + IF (buffer(i:i) == c_null_char) EXIT END DO DEALLOCATE(buffer) END FUNCTION f_lammps_get_last_error_message + +FUNCTION f_lammps_get_image_flags_int(ix, iy, iz) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int + USE keepstuff, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: ix, iy, iz + INTEGER(c_int) :: f_lammps_get_image_flags_int + + f_lammps_get_image_flags_int = lmp%encode_image_flags(ix, iy, iz) +END FUNCTION f_lammps_get_image_flags_int + +FUNCTION f_lammps_get_image_flags_bigint(ix, iy, iz) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t + USE keepstuff, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER(c_int), INTENT(IN), VALUE :: ix, iy, iz + INTEGER(c_int64_t) :: f_lammps_get_image_flags_bigint + + f_lammps_get_image_flags_bigint = lmp%encode_image_flags(ix, iy, iz) +END FUNCTION f_lammps_get_image_flags_bigint diff --git a/unittest/fortran/wrap_create_atoms.cpp b/unittest/fortran/wrap_create_atoms.cpp index 0e9bdf2a7c..585a32fbf8 100644 --- a/unittest/fortran/wrap_create_atoms.cpp +++ b/unittest/fortran/wrap_create_atoms.cpp @@ -16,6 +16,11 @@ void *f_lammps_with_args(); void f_lammps_close(); void f_lammps_setup_create_atoms(); void f_lammps_create_three_atoms(); +void f_lammps_create_two_more(); +void f_lammps_create_two_more_small(); +void f_lammps_create_two_more_big(); +void f_lammps_create_two_more_small2(); +void f_lammps_create_two_more_big2(); } class LAMMPS_create_atoms : public ::testing::Test { @@ -41,7 +46,7 @@ protected: } }; -TEST_F(LAMMPS_create_atoms, create_two) +TEST_F(LAMMPS_create_atoms, create_three) { f_lammps_setup_create_atoms(); #ifdef LAMMPS_BIGBIG @@ -61,7 +66,7 @@ TEST_F(LAMMPS_create_atoms, create_two) EXPECT_EQ(lmp->atom->nlocal, 6); for (int i = 0; i < lmp->atom->nlocal; i++) { if (tag[i] == 4) { - EXPECT_EQ(image[i],0); + EXPECT_EQ(image[i],lammps_encode_image_flags(1,-1,3)); EXPECT_DOUBLE_EQ(x[i][0],1.0); EXPECT_DOUBLE_EQ(x[i][1],1.8); EXPECT_DOUBLE_EQ(x[i][2],2.718281828); @@ -70,7 +75,7 @@ TEST_F(LAMMPS_create_atoms, create_two) EXPECT_DOUBLE_EQ(v[i][2],-1.0); } if (tag[i] == 5) { - EXPECT_EQ(image[i],1); + EXPECT_EQ(image[i],lammps_encode_image_flags(-2,-2,1)); EXPECT_DOUBLE_EQ(x[i][0],1.8); EXPECT_DOUBLE_EQ(x[i][1],0.1); EXPECT_DOUBLE_EQ(x[i][2],1.8); @@ -79,7 +84,7 @@ TEST_F(LAMMPS_create_atoms, create_two) EXPECT_DOUBLE_EQ(v[i][2],3.0); } if (tag[i] == 6) { - EXPECT_EQ(image[i],0); + EXPECT_EQ(image[i],lammps_encode_image_flags(-2,0,0)); EXPECT_DOUBLE_EQ(x[i][0],0.6); EXPECT_DOUBLE_EQ(x[i][1],0.8); EXPECT_DOUBLE_EQ(x[i][2],2.2); @@ -89,3 +94,134 @@ TEST_F(LAMMPS_create_atoms, create_two) } } }; + +TEST_F(LAMMPS_create_atoms, create_two_more) +{ + f_lammps_setup_create_atoms(); +#ifdef LAMMPS_BIGBIG + int64_t *tag, *image; +#else + int *tag, *image; +#endif + int *type; + double **x, **v; + f_lammps_create_three_atoms(); + EXPECT_EQ(lmp->atom->nlocal, 6); + f_lammps_create_two_more(); + EXPECT_EQ(lmp->atom->nlocal, 8); + tag = lmp->atom->tag; + image = lmp->atom->image; + x = lmp->atom->x; + v = lmp->atom->v; + type = lmp->atom->type; + for (int i = 0; i < lmp->atom->nlocal; i++) { + if (tag[i] == 7) { + EXPECT_EQ(image[i],lammps_encode_image_flags(0,0,0)); + EXPECT_DOUBLE_EQ(x[i][0],0.1); + EXPECT_DOUBLE_EQ(x[i][1],1.9); + EXPECT_DOUBLE_EQ(x[i][2],3.8); + EXPECT_DOUBLE_EQ(v[i][0],0.0); + EXPECT_DOUBLE_EQ(v[i][1],0.0); + EXPECT_DOUBLE_EQ(v[i][2],0.0); + } + if (tag[i] == 8) { + EXPECT_EQ(image[i],lammps_encode_image_flags(0,0,0)); + EXPECT_DOUBLE_EQ(x[i][0],1.2); + EXPECT_DOUBLE_EQ(x[i][1],2.1); + EXPECT_DOUBLE_EQ(x[i][2],1.25); + EXPECT_DOUBLE_EQ(v[i][0],0.0); + EXPECT_DOUBLE_EQ(v[i][1],0.0); + EXPECT_DOUBLE_EQ(v[i][2],0.0); + } + } +}; + +TEST_F(LAMMPS_create_atoms, create_two_more_bigsmall) +{ + f_lammps_setup_create_atoms(); +#ifdef LAMMPS_BIGBIG + int64_t *tag, *image; +#else + int *tag, *image; +#endif + int *type; + double **x, **v; + f_lammps_create_three_atoms(); + EXPECT_EQ(lmp->atom->nlocal, 6); +#ifdef LAMMPS_BIGBIG + f_lammps_create_two_more_big(); +#else + f_lammps_create_two_more_small(); +#endif + EXPECT_EQ(lmp->atom->nlocal, 8); + tag = lmp->atom->tag; + image = lmp->atom->image; + x = lmp->atom->x; + v = lmp->atom->v; + type = lmp->atom->type; + for (int i = 0; i < lmp->atom->nlocal; i++) { + if (tag[i] == 7) { + EXPECT_EQ(image[i],lammps_encode_image_flags(-1,0,0)); + EXPECT_DOUBLE_EQ(x[i][0],1.2); + EXPECT_DOUBLE_EQ(x[i][1],2.1); + EXPECT_DOUBLE_EQ(x[i][2],1.25); + EXPECT_DOUBLE_EQ(v[i][0],0.0); + EXPECT_DOUBLE_EQ(v[i][1],0.0); + EXPECT_DOUBLE_EQ(v[i][2],0.0); + } + if (tag[i] == 8) { + EXPECT_EQ(image[i],lammps_encode_image_flags(1,0,0)); + EXPECT_DOUBLE_EQ(x[i][0],0.1); + EXPECT_DOUBLE_EQ(x[i][1],1.9); + EXPECT_DOUBLE_EQ(x[i][2],3.8); + EXPECT_DOUBLE_EQ(v[i][0],0.0); + EXPECT_DOUBLE_EQ(v[i][1],0.0); + EXPECT_DOUBLE_EQ(v[i][2],0.0); + } + } +}; + +TEST_F(LAMMPS_create_atoms, create_two_more_bigsmall2) +{ + f_lammps_setup_create_atoms(); +#ifdef LAMMPS_BIGBIG + int64_t *tag, *image; +#else + int *tag, *image; +#endif + int *type; + double **x, **v; + f_lammps_create_three_atoms(); + EXPECT_EQ(lmp->atom->nlocal, 6); +#ifdef LAMMPS_BIGBIG + f_lammps_create_two_more_big2(); +#else + f_lammps_create_two_more_small2(); +#endif + EXPECT_EQ(lmp->atom->nlocal, 8); + tag = lmp->atom->tag; + image = lmp->atom->image; + x = lmp->atom->x; + v = lmp->atom->v; + type = lmp->atom->type; + for (int i = 0; i < lmp->atom->nlocal; i++) { + if (tag[i] == 7) { + EXPECT_EQ(image[i],lammps_encode_image_flags(0,0,0)); + EXPECT_DOUBLE_EQ(x[i][0],1.2); + EXPECT_DOUBLE_EQ(x[i][1],2.1); + EXPECT_DOUBLE_EQ(x[i][2],1.25); + EXPECT_DOUBLE_EQ(v[i][0],0.0); + EXPECT_DOUBLE_EQ(v[i][1],0.0); + EXPECT_DOUBLE_EQ(v[i][2],0.0); + } + if (tag[i] == 8) { + EXPECT_EQ(image[i],lammps_encode_image_flags(0,0,0)); + EXPECT_DOUBLE_EQ(x[i][0],0.1); + EXPECT_DOUBLE_EQ(x[i][1],1.9); + EXPECT_DOUBLE_EQ(x[i][2],3.8); + EXPECT_DOUBLE_EQ(v[i][0],0.0); + EXPECT_DOUBLE_EQ(v[i][1],0.0); + EXPECT_DOUBLE_EQ(v[i][2],0.0); + } + } +}; diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp index 5268548d48..18ec465e45 100644 --- a/unittest/fortran/wrap_properties.cpp +++ b/unittest/fortran/wrap_properties.cpp @@ -3,6 +3,7 @@ #include "lammps.h" #include "library.h" +#include #include #include "gmock/gmock.h" @@ -18,6 +19,8 @@ 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); +int f_lammps_get_image_flags_int(int, int, int); +int64_t f_lammps_get_image_flags_bigint(int, int, int); } namespace LAMMPS_NS { @@ -85,9 +88,17 @@ TEST_F(LAMMPS_properties, extract_setting) #if defined(LAMMPS_BIGBIG) EXPECT_EQ(f_lammps_extract_setting("tagint"), 8); EXPECT_EQ(f_lammps_extract_setting("imageint"), 8); + EXPECT_EQ(f_lammps_extract_setting("IMGMASK"), 2097151); + EXPECT_EQ(f_lammps_extract_setting("IMGMAX"), 1048576); + EXPECT_EQ(f_lammps_extract_setting("IMGBITS"), 21); + EXPECT_EQ(f_lammps_extract_setting("IMG2BITS"), 42); #else EXPECT_EQ(f_lammps_extract_setting("tagint"), 4); EXPECT_EQ(f_lammps_extract_setting("imageint"), 4); + EXPECT_EQ(f_lammps_extract_setting("IMGMASK"), 1023); + EXPECT_EQ(f_lammps_extract_setting("IMGMAX"), 512); + EXPECT_EQ(f_lammps_extract_setting("IMGBITS"), 10); + EXPECT_EQ(f_lammps_extract_setting("IMG2BITS"), 20); #endif EXPECT_EQ(f_lammps_extract_setting("box_exist"), 0); @@ -141,4 +152,24 @@ TEST_F(LAMMPS_properties, has_error) EXPECT_EQ(err, 0); EXPECT_THAT(errmsg, ContainsRegex(" ")); }; + +TEST_F(LAMMPS_properties, get_image_flags) +{ +#ifdef LAMMPS_BIGBIG + int64_t image = f_lammps_get_image_flags_bigint(0,0,0); + int64_t Cimage = lammps_encode_image_flags(0,0,0); + EXPECT_EQ(image, Cimage); + image = f_lammps_get_image_flags_bigint(1,-1,1); + Cimage = lammps_encode_image_flags(1,-1,1); + EXPECT_EQ(image, Cimage); +#else + int image = f_lammps_get_image_flags_int(0,0,0); + int Cimage = lammps_encode_image_flags(0,0,0); + EXPECT_EQ(image, Cimage); + image = f_lammps_get_image_flags_int(1,-1,1); + Cimage = lammps_encode_image_flags(1,-1,1); + EXPECT_EQ(image, Cimage); +#endif +} + } // namespace LAMMPS_NS