From 7125682375d6f143a87f1328ba454e5ae5590cc0 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Tue, 9 Aug 2022 21:18:33 -0500 Subject: [PATCH 01/25] Added get_thermo and extract_box; added get_natoms to documentation; added a "TODO" for all other functions to implement --- doc/src/Fortran.rst | 48 +++++++++ fortran/lammps.f90 | 256 +++++++++++++++++++++++++++++++++++--------- 2 files changed, 256 insertions(+), 48 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index dd848a812e..6a550bf463 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -184,6 +184,11 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :f command: :f:func:`command` :f commands_list: :f:func:`commands_list` :f commands_string: :f:func:`commands_string` + :f get_natoms: :f:func:`get_natoms` + :f get_thermo: :f:func:`get_thermo` + :f extract_box: :f:func:`extract_box` + +-------- .. f:function:: lammps(args[,comm]) @@ -202,6 +207,8 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :o integer comm [optional]: MPI communicator :r lammps: an instance of the :f:type:`lammps` derived type +-------- + .. f:subroutine:: close([finalize]) This method will close down the LAMMPS instance through calling @@ -211,6 +218,8 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :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` @@ -226,6 +235,8 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :p character(len=*) filename: name of file with LAMMPS commands +-------- + .. f:subroutine:: command(cmd) This method will call :cpp:func:`lammps_command` to have LAMMPS @@ -233,6 +244,8 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :p character(len=*) cmd: single LAMMPS command +-------- + .. f:subroutine:: commands_list(cmds) This method will call :cpp:func:`lammps_commands_list` to have LAMMPS @@ -240,9 +253,44 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :p character(len=*) cmd(:): list of LAMMPS input lines +-------- + .. f:subroutine:: commands_string(str) This method will call :cpp:func:`lammps_commands_string` to have LAMMPS execute a block of commands from a string. :p character(len=*) str: LAMMPS input in string + +-------- + +.. f:function:: get_natoms() + + This function will call :cpp:func:`lammps_get_natoms` and return the number + of atoms in the system. + + :r real(C_double): number of atoms + +-------- + +.. f:function:: get_thermo(name) + + :p character(len=*) name: string with the name of the thermo keyword + :r real(C_double): value of the requested thermo property or 0.0_C_double + +-------- + +.. f:subroutine:: extract_box(boxlo, boxhi, xy, yz, xz, pflags, boxflag) + + :p real(c_double) boxlo [dimension(3),optional]: vector in which to store + lower-bounds of simulation box + :p real(c_double) boxhi [dimension(3),optional]: vector in which to store + upper-bounds of simulation box + :p real(c_double) xy [optional]: variable in which to store *xy* tilt factor + :p real(c_double) yz [optional]: variable in which to store *yz* tilt factor + :p real(c_double) xz [optional]: variable in which to store *xz* tilt factor + :p logical pflags [dimension(3),optional]: vector in which to store + periodicity flags (``.TRUE.`` means periodic in that dimension) + :p logical boxflag [optional]: variable in which to store boolean denoting + whether the box will change during a simulation + (``.TRUE.`` means box will change) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 144fd15652..7c21028191 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -46,6 +46,8 @@ MODULE LIBLAMMPS PROCEDURE :: commands_string => lmp_commands_string PROCEDURE :: version => lmp_version PROCEDURE :: get_natoms => lmp_get_natoms + PROCEDURE :: get_thermo => lmp_get_thermo + PROCEDURE :: extract_box => lmp_extract_box END TYPE lammps INTERFACE lammps @@ -56,80 +58,202 @@ MODULE LIBLAMMPS INTERFACE FUNCTION lammps_open(argc, argv, comm) BIND(C, name='lammps_open_fortran') IMPORT :: c_ptr, c_int - INTEGER(c_int), VALUE, INTENT(in) :: argc, comm - TYPE(c_ptr), DIMENSION(*), INTENT(in) :: argv + INTEGER(c_int), VALUE, INTENT(IN) :: argc, comm + TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv TYPE(c_ptr) :: lammps_open END FUNCTION lammps_open - FUNCTION lammps_open_no_mpi(argc, argv, handle) BIND(C, name='lammps_open_no_mpi') + FUNCTION lammps_open_no_mpi(argc, argv, handle) BIND(C) IMPORT :: c_ptr, c_int - INTEGER(c_int), VALUE, INTENT(in) :: argc - TYPE(c_ptr), DIMENSION(*), INTENT(in) :: argv + INTEGER(c_int), VALUE, INTENT(IN) :: argc + TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv TYPE(c_ptr), VALUE, INTENT(in) :: handle TYPE(c_ptr) :: lammps_open_no_mpi END FUNCTION lammps_open_no_mpi - SUBROUTINE lammps_close(handle) BIND(C, name='lammps_close') + SUBROUTINE lammps_close(handle) BIND(C) IMPORT :: c_ptr TYPE(c_ptr), VALUE :: handle END SUBROUTINE lammps_close - SUBROUTINE lammps_mpi_init() BIND(C, name='lammps_mpi_init') + SUBROUTINE lammps_mpi_init() BIND(C) END SUBROUTINE lammps_mpi_init - SUBROUTINE lammps_mpi_finalize() BIND(C, name='lammps_mpi_finalize') + SUBROUTINE lammps_mpi_finalize() BIND(C) END SUBROUTINE lammps_mpi_finalize - SUBROUTINE lammps_kokkos_finalize() BIND(C, name='lammps_kokkos_finalize') + SUBROUTINE lammps_kokkos_finalize() BIND(C) END SUBROUTINE lammps_kokkos_finalize - SUBROUTINE lammps_file(handle, filename) BIND(C, name='lammps_file') + SUBROUTINE lammps_file(handle, filename) BIND(C) IMPORT :: c_ptr TYPE(c_ptr), VALUE :: handle TYPE(c_ptr), VALUE :: filename END SUBROUTINE lammps_file - SUBROUTINE lammps_command(handle, cmd) BIND(C, name='lammps_command') + SUBROUTINE lammps_command(handle, cmd) BIND(C) IMPORT :: c_ptr TYPE(c_ptr), VALUE :: handle TYPE(c_ptr), VALUE :: cmd END SUBROUTINE lammps_command - SUBROUTINE lammps_commands_list(handle, ncmd, cmds) BIND(C, name='lammps_commands_list') + SUBROUTINE lammps_commands_list(handle, ncmd, cmds) BIND(C) IMPORT :: c_ptr, c_int TYPE(c_ptr), VALUE :: handle - INTEGER(c_int), VALUE, INTENT(in) :: ncmd - TYPE(c_ptr), DIMENSION(*), INTENT(in) :: cmds + INTEGER(c_int), VALUE, INTENT(IN) :: ncmd + TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: cmds END SUBROUTINE lammps_commands_list - SUBROUTINE lammps_commands_string(handle, str) BIND(C, name='lammps_commands_string') + SUBROUTINE lammps_commands_string(handle, str) BIND(C) IMPORT :: c_ptr TYPE(c_ptr), VALUE :: handle TYPE(c_ptr), VALUE :: str END SUBROUTINE lammps_commands_string - FUNCTION lammps_malloc(size) BIND(C, name='malloc') - IMPORT :: c_ptr, c_size_t - INTEGER(c_size_t), value :: size - TYPE(c_ptr) :: lammps_malloc - END FUNCTION lammps_malloc + FUNCTION lammps_get_natoms(handle) BIND(C) + IMPORT :: c_ptr, c_double + TYPE(c_ptr), VALUE :: handle + REAL(c_double) :: lammps_get_natoms + END FUNCTION lammps_get_natoms - SUBROUTINE lammps_free(ptr) BIND(C, name='lammps_free') - IMPORT :: c_ptr - TYPE(c_ptr), VALUE :: ptr - END SUBROUTINE lammps_free + FUNCTION lammps_get_thermo(handle,name) BIND(C) + IMPORT :: c_ptr, c_double, c_char + IMPLICIT NONE + REAL(c_double) :: lammps_get_thermo + TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), VALUE :: name + END FUNCTION lammps_get_thermo - FUNCTION lammps_version(handle) BIND(C, name='lammps_version') + 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 + END SUBROUTINE lammps_extract_box + + ! TODO + !SUBROUTINE lammps_reset_box + + !SUBROUTINE lammps_memory_usage + + !INTEGER (c_int) FUNCTION lammps_get_mpi_comm + !FIXME? type(MPI_Comm) FUNCTION lammps_get_mpi_comm + + !INTEGER (c_int) FUNCTION lammps_extract_setting + + !INTEGER (c_int) FUNCTION lammps_extract_global_datatype + + !(generic) lammps_extract_global + ! TODO: You can fake out the type-casting by declaring non-optional + ! parameters that help the compiler figure out which one to call + + !INTEGER (c_int) FUNCTION lammps_extract_atom_datatype + + !(generic) lammps_extract_atom + + !(generic) lammps_extract_compute + + !(generic) lammps_extract_fix + + !(generic) lammps_extract_variable + + !INTEGER (c_int) lammps_set_variable + + !SUBROUTINE lammps_gather_atoms + + !SUBROUTINE lammps_gather_atoms_concat + + !SUBROUTINE lammps_gather_atoms_subset + + !SUBROUTINE lammps_scatter_atoms + + !SUBROUTINE lammps_scatter_atoms_subset + + !SUBROUTINE lammps_gather_bonds + + !SUBROUTINE lammps_gather + + !SUBROUTINE lammps_gather_concat + + !SUBROUTINE lammps_gather_subset + + !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_find_pair_neighlist + + !INTEGER (C_int) FUNCTION lammps_find_fix_neighlist + + !INTEGER (C_int) FUNCTION lammps_find_compute_neighlist + + !INTEGER (C_int) FUNCTION lammps_neighlist_num_elements + + !SUBROUTINE lammps_neighlist_element_neighbors + + FUNCTION lammps_version(handle) BIND(C) IMPORT :: c_ptr, c_int TYPE(c_ptr), VALUE :: handle INTEGER(c_int) :: lammps_version END FUNCTION lammps_version - FUNCTION lammps_get_natoms(handle) BIND(C, name='lammps_get_natoms') - IMPORT :: c_ptr, c_double - TYPE(c_ptr), VALUE :: handle - REAL(c_double) :: lammps_get_natoms - END FUNCTION lammps_get_natoms + !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 + + !LOGICAL FUNCTION lammps_config_accelerator + !LOGICAL FUNCTION lammps_has_gpu_device + !SUBROUTINE lammps_get_gpu_device + + !LOGICAL FUNCTION lammps_has_id + !INTEGER (C_int) FUNCTION lammps_id_count + !SUBROUTINE lammps_id_name + + !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 + !SUBROUTINE lammps_decode_image_flags + + !SUBROUTINE lammps_set_fix_external_callback ! may have trouble.... + !FUNCTION lammps_fix_external_get_force() ! returns real(c_double) (:) + + !SUBROUTINE lammps_fix_external_set_energy_global + !SUBROUTINE lammps_fix_external_set_energy_peratom + !SUBROUTINE lammps_fix_external_set_virial_global + !SUBROUTINE lammps_fix_external_set_virial_peratom + !SUBROUTINE lammps_fix_external_set_vector_length + !SUBROUTINE lammps_fix_external_set_vector + + !SUBROUTINE lammps_flush_buffers + + FUNCTION lammps_malloc(size) BIND(C, name='malloc') + IMPORT :: c_ptr, c_size_t + INTEGER(c_size_t), VALUE :: size + TYPE(c_ptr) :: lammps_malloc + END FUNCTION lammps_malloc + + SUBROUTINE lammps_free(ptr) BIND(C) + IMPORT :: c_ptr + TYPE(c_ptr), VALUE :: ptr + END SUBROUTINE lammps_free + + + !LOGICAL FUNCTION lammps_is_running + !SUBROUTINE lammps_force_timeout + !LOGICAL FUNCTION lammps_has_error + !INTEGER (c_int) FUNCTION lammps_get_last_error_message END INTERFACE CONTAINS @@ -140,7 +264,7 @@ CONTAINS TYPE(lammps) FUNCTION lmp_open(args, comm) IMPLICIT NONE INTEGER, INTENT(in), OPTIONAL :: comm - CHARACTER(len=*), INTENT(in), OPTIONAL :: args(:) + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: args(:) TYPE(c_ptr), ALLOCATABLE :: argv(:) INTEGER(c_int) :: i, c_comm, argc @@ -175,7 +299,7 @@ CONTAINS SUBROUTINE lmp_close(self, finalize) IMPLICIT NONE CLASS(lammps) :: self - LOGICAL, INTENT(in), OPTIONAL :: finalize + LOGICAL, INTENT(IN), OPTIONAL :: finalize CALL lammps_close(self%handle) @@ -187,20 +311,6 @@ CONTAINS END IF END SUBROUTINE lmp_close - INTEGER FUNCTION lmp_version(self) - IMPLICIT NONE - CLASS(lammps) :: self - - lmp_version = lammps_version(self%handle) - END FUNCTION lmp_version - - DOUBLE PRECISION FUNCTION lmp_get_natoms(self) - IMPLICIT NONE - CLASS(lammps) :: self - - lmp_get_natoms = lammps_get_natoms(self%handle) - END FUNCTION lmp_get_natoms - SUBROUTINE lmp_file(self, filename) IMPLICIT NONE CLASS(lammps) :: self @@ -260,13 +370,63 @@ CONTAINS CALL lammps_free(tmp) END SUBROUTINE lmp_commands_string + ! equivalent function to lammps_get_natoms + DOUBLE PRECISION FUNCTION lmp_get_natoms(self) + IMPLICIT NONE + 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) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*) :: name + TYPE(C_ptr) :: Cname + + Cname = f2c_string(name) + lmp_get_thermo = lammps_get_thermo(self%handle, Cname) + CALL lammps_free(Cname) + END FUNCTION lmp_get_thermo + + ! equivalent subroutine to lammps_extract_box + SUBROUTINE lmp_extract_box (self, boxlo, boxhi, xy, yz, xz, pflags, boxflag) + CLASS(lammps), INTENT(IN) :: self + REAL(c_double), INTENT(OUT), TARGET, OPTIONAL :: boxlo(3), boxhi(3) + REAL(c_double), INTENT(OUT), TARGET, OPTIONAL :: xy, yz, xz + LOGICAL, INTENT(OUT), OPTIONAL :: pflags(3), boxflag + INTEGER(c_int), TARGET :: C_pflags(3), C_boxflag + TYPE (c_ptr) :: ptr(7) + + 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) + 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 ) + END SUBROUTINE lmp_extract_box + + ! equivalent function to lammps_version() + INTEGER FUNCTION lmp_version(self) + IMPLICIT NONE + CLASS(lammps) :: self + + lmp_version = lammps_version(self%handle) + END FUNCTION lmp_version + ! ---------------------------------------------------------------------- ! local helper functions ! copy fortran string to zero terminated c string ! ---------------------------------------------------------------------- FUNCTION f2c_string(f_string) RESULT(ptr) - CHARACTER (len=*), INTENT(in) :: f_string - CHARACTER (len=1, kind=c_char), POINTER :: c_string(:) + 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 From f442fc8540e55f5613cd4a0fa7b59dbdd9fe812c Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 10 Aug 2022 00:55:17 -0500 Subject: [PATCH 02/25] Added reset_box, memory_usage, get_mpi_comm, extract_setting and associated documentation --- doc/src/Fortran.rst | 54 +++++++++++++++ fortran/lammps.f90 | 159 +++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 203 insertions(+), 10 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 6a550bf463..19182321b5 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -187,6 +187,9 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :f get_natoms: :f:func:`get_natoms` :f get_thermo: :f:func:`get_thermo` :f extract_box: :f:func:`extract_box` + :f reset_box: :f:func:`reset_box` + :f memory_usage: :f:func:`memory_usage` + :f extract_setting: :f:func:`extract_setting` -------- @@ -294,3 +297,54 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :p logical boxflag [optional]: variable in which to store boolean denoting whether the box will change during a simulation (``.TRUE.`` means box will change) + +-------- + +.. f:subroutine:: reset_box(boxlo, boxhi, xy, yz, xz) + + :p real(c_double) boxlo [dimension(3)]: vector of three doubles containing + the lower box boundary + :p real(c_double) boxhi [dimension(3)]: vector of three doubles containing + the upper box boundary + :p real(c_double) xy: *x--y* tilt factor + :p real(c_double) yz: *y--z* tilt factor + :p real(c_double) xz: *x--z* tilt factor + +-------- + +.. f:subroutine:: memory_usage(meminfo) + + :p real(c_double) meminfo [dimension(3)]: vector of three doubles in which + to store memory usage data + +-------- + +.. f:function:: get_mpi_comm() + + :r integer: Fortran integer equivalent to the MPI communicator LAMMPS is + using + +.. note:: + + The MPI_F08 module, which is in compliance with the Fortran 2008 standard, + 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, + + .. code-block:: fortran + + USE MPI_F08 + USE LIBLAMMPS + 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. + +-------- + +.. f:function:: extract_setting(keyword) + + :p character(len=*) keyword: string containing the name of the thermo keyword + :r integer(c_int): value of the queried setting or :math:`-1` if unknown diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 7c21028191..0e91a378b1 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -30,12 +30,44 @@ MODULE LIBLAMMPS USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_loc, & - c_int, c_char, c_null_char, c_double, c_size_t, c_f_pointer + c_int, c_int64_t, c_char, c_null_char, c_double, c_size_t, c_f_pointer IMPLICIT NONE PRIVATE PUBLIC :: lammps + ! These are public-interface constants that have the same purpose as the + ! constants in library.h, except that their types match the type of the + ! constant in question. Their purpose is to determine the type of the + ! return value without something akin to a C/C++ type cast + INTEGER (c_int), PUBLIC, PARAMETER :: LMP_INT = 0_c_int + INTEGER (c_int), PUBLIC, DIMENSION(2), PARAMETER :: LMP_INT_1D = 1_c_int + INTEGER (c_int), PUBLIC, DIMENSION(2,2), PARAMETER :: LMP_INT_2D = 1_c_int + REAL (c_double), PUBLIC, PARAMETER :: LMP_DOUBLE = 2.0_c_double + REAL (c_double), PUBLIC, DIMENSION(2), PARAMETER :: & + LMP_DOUBLE_1D = 2.0_c_double + REAL (c_double), PUBLIC, DIMENSION(2,2), PARAMETER :: & + LMP_DOUBLE_2D = 3.0_c_double + INTEGER (c_int64_t), PUBLIC, PARAMETER :: LMP_INT64 = 4_c_int64_t + INTEGER (c_int64_t), PUBLIC, DIMENSION(2), PARAMETER :: & + LMP_INT64_1D = 4_c_int64_t + INTEGER (c_int64_t), PUBLIC, DIMENSION(2,2), PARAMETER :: & + LMP_INT64_2D = 5_c_int64_t + CHARACTER(LEN=*), PUBLIC, PARAMETER :: LMP_STRING = 'six' + + ! Data type constants for extracting data from global, atom, compute, and fix + ! + ! Must be kept in sync with the equivalent declarations in + ! src/library.h and python/lammps/constants.py + INTEGER (c_int), PARAMETER :: & + LAMMPS_INT = 0_c_int, & ! 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 + TYPE lammps TYPE(c_ptr) :: handle CONTAINS @@ -44,10 +76,15 @@ MODULE LIBLAMMPS PROCEDURE :: command => lmp_command PROCEDURE :: commands_list => lmp_commands_list PROCEDURE :: commands_string => lmp_commands_string - PROCEDURE :: version => lmp_version 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 :: version => lmp_version END TYPE lammps INTERFACE lammps @@ -117,7 +154,7 @@ MODULE LIBLAMMPS END FUNCTION lammps_get_natoms FUNCTION lammps_get_thermo(handle,name) BIND(C) - IMPORT :: c_ptr, c_double, c_char + IMPORT :: c_ptr, c_double IMPLICIT NONE REAL(c_double) :: lammps_get_thermo TYPE(c_ptr), VALUE :: handle @@ -132,18 +169,47 @@ MODULE LIBLAMMPS boxflag END SUBROUTINE lammps_extract_box - ! TODO - !SUBROUTINE lammps_reset_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 + END SUBROUTINE lammps_reset_box - !SUBROUTINE lammps_memory_usage + 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 + END SUBROUTINE lammps_memory_usage - !INTEGER (c_int) FUNCTION lammps_get_mpi_comm - !FIXME? type(MPI_Comm) FUNCTION lammps_get_mpi_comm + FUNCTION lammps_get_mpi_comm(handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE (c_ptr), VALUE :: handle + INTEGER (c_int) :: lammps_get_mpi_comm + END FUNCTION lammps_get_mpi_comm - !INTEGER (c_int) FUNCTION lammps_extract_setting + FUNCTION lammps_extract_setting(handle,keyword) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, keyword + INTEGER (c_int) :: lammps_extract_setting + END FUNCTION lammps_extract_setting - !INTEGER (c_int) FUNCTION lammps_extract_global_datatype + FUNCTION lammps_extract_global_datatype(handle,name) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, name + INTEGER (c_int) :: lammps_extract_global_datatype + END FUNCTION lammps_extract_global_datatype + FUNCTION lammps_extract_global(handle, name) BIND(C) + IMPORT :: c_ptr + TYPE(c_ptr), VALUE :: handle, name + TYPE(c_ptr) :: lammps_extract_global + END FUNCTION lammps_extract_global !(generic) lammps_extract_global ! TODO: You can fake out the type-casting by declaring non-optional ! parameters that help the compiler figure out which one to call @@ -412,6 +478,79 @@ CONTAINS 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 + + CALL lammps_reset_box (self%handle, boxlo, boxhi, xy, yz, xz) + END SUBROUTINE lmp_reset_box + + ! equivalent function to lammps_memory_usage + 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 + + CALL lammps_memory_usage(self%handle,meminfo) + END SUBROUTINE lmp_memory_usage + + ! equivalent function to lammps_get_mpi_comm + INTEGER FUNCTION lmp_get_mpi_comm (self) + CLASS(lammps), INTENT(IN) :: self + + lmp_get_mpi_comm = lammps_get_mpi_comm(self%handle) + END FUNCTION lmp_get_mpi_comm + + ! equivalent function to lammps_extract_setting + INTEGER (c_int) FUNCTION lmp_extract_setting (self, keyword) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: keyword + TYPE(c_ptr) :: Ckeyword + + Ckeyword = f2c_string(keyword) + lmp_extract_setting = lammps_extract_setting(self%handle, Ckeyword) + CALL lammps_free(Ckeyword) + END FUNCTION lmp_extract_setting + + ! equivalent function to lammps_extract_global_datatype + ! this function doesn't need to be accessed by the user, but is instead used + ! for type checking + INTEGER (c_int) FUNCTION lmp_extract_global_datatype (self, name) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(c_ptr) :: Cname + + Cname = f2c_string(name) + lmp_extract_global_datatype & + = lammps_extract_global_datatype(self%handle, Cname) + CALL lammps_free(Cname) + END FUNCTION lmp_extract_global_datatype + + ! equivalent functions to lammps_extract_global (overloaded) + FUNCTION lmp_extract_global_int (self, name, dtype) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(c_int) :: dtype + INTEGER(c_int) :: lmp_extract_global_int + TYPE(c_ptr) :: Cname, Cptr + INTEGER(c_int) :: datatype + INTEGER(c_int), POINTER :: ptr + + Cname = f2c_string(name) + datatype = lammps_extract_global_datatype(self%handle, Cname) + IF ( datatype /= LAMMPS_INT ) THEN + ! throw an exception or something; data type doesn't match! + END IF + Cptr = lammps_extract_global(self%handle, Cname) + CALL c_f_pointer(Cptr, ptr) + lmp_extract_global_int = ptr + CALL lammps_free(Cname) + END FUNCTION lmp_extract_global_int + ! TODO need more generics here to match TKR of LMP_INT_1D, LMP_BIGINT, + ! LMP_DOUBLE, LMP_DOUBLE_1D, LMS_STRING [this assumes no one adds anything + ! requiring LMP_DOUBLE_2D and the like!] + ! equivalent function to lammps_version() INTEGER FUNCTION lmp_version(self) IMPLICIT NONE From 6c49937ad7b61d0db06a60c4af0e49240d03aa75 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 10 Aug 2022 11:03:49 -0500 Subject: [PATCH 03/25] Re-ordered type-bound procedures to correspond with the order in library.h --- fortran/lammps.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 7c21028191..633abbc1f6 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -44,10 +44,10 @@ MODULE LIBLAMMPS PROCEDURE :: command => lmp_command PROCEDURE :: commands_list => lmp_commands_list PROCEDURE :: commands_string => lmp_commands_string - PROCEDURE :: version => lmp_version PROCEDURE :: get_natoms => lmp_get_natoms PROCEDURE :: get_thermo => lmp_get_thermo PROCEDURE :: extract_box => lmp_extract_box + PROCEDURE :: version => lmp_version END TYPE lammps INTERFACE lammps From 89b9967f2c46764e7181a3160e5659874c712bf5 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 10 Aug 2022 11:37:15 -0500 Subject: [PATCH 04/25] Added part of lmp_extract_global --- fortran/lammps.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 0e91a378b1..64d4c50e48 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -83,6 +83,8 @@ MODULE LIBLAMMPS PROCEDURE :: memory_usage => lmp_memory_usage PROCEDURE :: get_mpi_comm => lmp_get_mpi_comm PROCEDURE :: extract_setting => lmp_extract_setting + PROCEDURE, PRIVATE :: lmp_extract_global_int + GENERIC :: extract_global => lmp_extract_global_int ! TODO PROCEDURE :: version => lmp_version END TYPE lammps @@ -541,6 +543,7 @@ CONTAINS datatype = lammps_extract_global_datatype(self%handle, Cname) IF ( datatype /= LAMMPS_INT ) THEN ! throw an exception or something; data type doesn't match! + WRITE(0,*) 'WARNING: global data type is inconsistent' END IF Cptr = lammps_extract_global(self%handle, Cname) CALL c_f_pointer(Cptr, ptr) From 756074c073a00451929f8b8cd2dfb209151854fb Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 10 Aug 2022 11:39:23 -0500 Subject: [PATCH 05/25] Merge edits from two computers --- fortran/lammps.f90 | 60 ++++++++++++++++++++++++++++++---------------- 1 file changed, 40 insertions(+), 20 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 0e91a378b1..7da1a77a81 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -41,17 +41,17 @@ MODULE LIBLAMMPS ! constant in question. Their purpose is to determine the type of the ! return value without something akin to a C/C++ type cast INTEGER (c_int), PUBLIC, PARAMETER :: LMP_INT = 0_c_int - INTEGER (c_int), PUBLIC, DIMENSION(2), PARAMETER :: LMP_INT_1D = 1_c_int - INTEGER (c_int), PUBLIC, DIMENSION(2,2), PARAMETER :: LMP_INT_2D = 1_c_int + INTEGER (c_int), PUBLIC, DIMENSION(3), PARAMETER :: LMP_INT_1D = 1_c_int + INTEGER (c_int), PUBLIC, DIMENSION(3,3), PARAMETER :: LMP_INT_2D = 1_c_int REAL (c_double), PUBLIC, PARAMETER :: LMP_DOUBLE = 2.0_c_double - REAL (c_double), PUBLIC, DIMENSION(2), PARAMETER :: & + REAL (c_double), PUBLIC, DIMENSION(3), PARAMETER :: & LMP_DOUBLE_1D = 2.0_c_double - REAL (c_double), PUBLIC, DIMENSION(2,2), PARAMETER :: & + REAL (c_double), PUBLIC, DIMENSION(3,3), PARAMETER :: & LMP_DOUBLE_2D = 3.0_c_double INTEGER (c_int64_t), PUBLIC, PARAMETER :: LMP_INT64 = 4_c_int64_t - INTEGER (c_int64_t), PUBLIC, DIMENSION(2), PARAMETER :: & + INTEGER (c_int64_t), PUBLIC, DIMENSION(3), PARAMETER :: & LMP_INT64_1D = 4_c_int64_t - INTEGER (c_int64_t), PUBLIC, DIMENSION(2,2), PARAMETER :: & + INTEGER (c_int64_t), PUBLIC, DIMENSION(3,3), PARAMETER :: & LMP_INT64_2D = 5_c_int64_t CHARACTER(LEN=*), PUBLIC, PARAMETER :: LMP_STRING = 'six' @@ -513,19 +513,19 @@ CONTAINS CALL lammps_free(Ckeyword) END FUNCTION lmp_extract_setting - ! equivalent function to lammps_extract_global_datatype - ! this function doesn't need to be accessed by the user, but is instead used - ! for type checking - INTEGER (c_int) FUNCTION lmp_extract_global_datatype (self, name) - CLASS(lammps), INTENT(IN) :: self - CHARACTER(LEN=*), INTENT(IN) :: name - TYPE(c_ptr) :: Cname - - Cname = f2c_string(name) - lmp_extract_global_datatype & - = lammps_extract_global_datatype(self%handle, Cname) - CALL lammps_free(Cname) - END FUNCTION lmp_extract_global_datatype +! FIXME Now that I think about it...do we need this at all? +! ! equivalent function to lammps_extract_global_datatype +! ! this function doesn't need to be accessed by the user, but is instead used +! ! for type checking +! INTEGER (c_int) FUNCTION lmp_extract_global_datatype (name) +! CHARACTER(LEN=*), INTENT(IN) :: name +! TYPE(c_ptr) :: Cname +! +! Cname = f2c_string(name) +! lmp_extract_global_datatype +! = lammps_extract_global_datatype(c_null_ptr, Cname) +! CALL lammps_free(Cname) +! END FUNCTION lmp_extract_global_datatype ! equivalent functions to lammps_extract_global (overloaded) FUNCTION lmp_extract_global_int (self, name, dtype) @@ -538,7 +538,7 @@ CONTAINS INTEGER(c_int), POINTER :: ptr Cname = f2c_string(name) - datatype = lammps_extract_global_datatype(self%handle, Cname) + datatype = lammps_extract_global_datatype(Cname) IF ( datatype /= LAMMPS_INT ) THEN ! throw an exception or something; data type doesn't match! END IF @@ -547,6 +547,26 @@ CONTAINS lmp_extract_global_int = ptr CALL lammps_free(Cname) END FUNCTION lmp_extract_global_int + FUNCTION lmp_extract_global_int_1d (self, name, dtype) + ! This implementation assumes there are three elements to all arrays + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(c_int), DIMENSION(3) :: dtype + INTEGER(c_int) :: lmp_extract_global_int + TYPE(c_ptr) :: Cname, Cptr + INTEGER(c_int) :: datatype + INTEGER(c_int), DIMENSION(3), POINTER :: ptr + + Cname = f2c_string(name) + datatype = lammps_extract_global_datatype(Cname) + IF ( datatype /= LAMMPS_INT ) THEN + ! throw an exception or something; data type doesn't match! + END IF + Cptr = lammps_extract_global(self%handle, Cname) + CALL c_f_pointer(Cptr, ptr, shape(dtype)) + lmp_extract_global_int = ptr + CALL lammps_free(Cname) + END FUNCTION lmp_extract_global_int_1d ! TODO need more generics here to match TKR of LMP_INT_1D, LMP_BIGINT, ! LMP_DOUBLE, LMP_DOUBLE_1D, LMS_STRING [this assumes no one adds anything ! requiring LMP_DOUBLE_2D and the like!] From b191e295618cf1ebe073f8ce49f71fad47f31ef3 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 10 Aug 2022 17:56:28 -0500 Subject: [PATCH 06/25] Work in progress for extract_global; committing but will probably undo later --- doc/src/Fortran.rst | 157 +++++++++++++++++++++++++++++++++++++++----- fortran/lammps.f90 | 98 +++++++++++++++++++++------ 2 files changed, 220 insertions(+), 35 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 19182321b5..4e093dc49b 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -80,7 +80,7 @@ the optional logical argument set to ``.true.``. Here is a simple example: END PROGRAM testlib It is also possible to pass command line flags from Fortran to C/C++ and -thus make the resulting executable behave similar to the standalone +thus make the resulting executable behave similarly to the standalone executable (it will ignore the `-in/-i` flag, though). This allows to use the command line to configure accelerator and suffix settings, configure screen and logfile output, or to set index style variables @@ -190,6 +190,7 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :f reset_box: :f:func:`reset_box` :f memory_usage: :f:func:`memory_usage` :f extract_setting: :f:func:`extract_setting` + :f extract_global: :f:func:`extract_global` -------- @@ -210,7 +211,57 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. :o integer comm [optional]: MPI communicator :r lammps: an instance of the :f:type:`lammps` derived type --------- + .. note:: + + The ``MPI_F08`` module, which defines Fortran 2008 bindings for MPI, + is not directly supported by this interface due to the complexities of + supporting both the ``MPI_F08`` and ``MPI`` modules at the same time. + However, you should be able to use the ``MPI_VAL`` member of the + ``MPI_comm`` derived type to access the integer value of the + communicator, such as in + + .. code-block:: Fortran + + PROGRAM testmpi + USE LIBLAMMPS + USE MPI_F08 + TYPE(lammps) :: lmp + lmp = lammps(MPI_COMM_SELF%MPI_VAL) + END PROGRAM testmpi + +Constants Defined by the API +============================ + +The following constants are declared by the Fortran API to resolve the +type/kind/rank signature for return values. These serve the same role as +``LAMMPS_INT``, ``LAMMPS_DOUBLE``, and similar constants in ``src/library.h`` +and those in ``python/lammps/constants.py`` for the C and Python APIs, +respectively. Unlike their C and Python bretheren, however, it is the type +(e.g., ``INTEGER``), kind (e.g., ``C_int``), and rank (e.g., ``DIMENSION(:)``) +of these constants that is used by the calling routine, rather than their +numerical values. + +:f:LMP_INT: 32-bit integer scalars +:f:LMP_INT_1D: 32-bit integer vectors +:f:LMP_INT_2D: 32-bit integer matrices +:f:LMP_DOUBLE: 64-bit real scalars +:f:LMP_DOUBLE_1D: 64-bit real vectors +:f:LMP_DOUBLE_2D: 64-bit real matrices +:f:LMP_INT64: 64-bit integer scalars +:f:LMP_INT64_1D: 64-bit integer vectors +:f:LMP_INT64_2D: 64-bit integer matrices + +.. admonition:: Interaction with LAMMPS_BIGBIG and such + + LAMMPS uses different-sized integers to store various entities, such as + the number of timesteps or the total number of atoms, depending on certain + compiler flags (see the :doc:`size limits ` + documentation). This API is currently agnostic to these settings, and it + is up to the user to know the size of LAMMPS_BIGINT and such and pass + LMP_INT or LMP_INT64, as appropriate, for such entities. + +Procedures Bound to the lammps Derived Type +=========================================== .. f:subroutine:: close([finalize]) @@ -278,12 +329,20 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. .. f:function:: get_thermo(name) + This function will call :cpp:func:`lammps_get_thermo` and return the value + of the corresponding thermodynamic keyword. + :p character(len=*) name: string with the name of the thermo keyword :r real(C_double): value of the requested thermo property or 0.0_C_double -------- .. f:subroutine:: extract_box(boxlo, boxhi, xy, yz, xz, pflags, boxflag) + + This subroutine will call :cpp:func:`lammps_extract_box`. All parameters + are optional, though obviously at least one should be present. The + parameters *pflags* and *boxflag* are stored in LAMMPS as integers, but + should be declared as ``LOGICAL`` variables when calling from Fortran. :p real(c_double) boxlo [dimension(3),optional]: vector in which to store lower-bounds of simulation box @@ -302,6 +361,9 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. .. f:subroutine:: reset_box(boxlo, boxhi, xy, yz, xz) + This subroutine will call :cpp:func:`lammps_reset_box`. All parameters + are required. + :p real(c_double) boxlo [dimension(3)]: vector of three doubles containing the lower box boundary :p real(c_double) boxhi [dimension(3)]: vector of three doubles containing @@ -314,6 +376,9 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. .. f:subroutine:: memory_usage(meminfo) + This subroutine will call :cpp:func:`lammps_memory_usage` and store the + result in the three-element array *meminfo*. + :p real(c_double) meminfo [dimension(3)]: vector of three doubles in which to store memory usage data @@ -321,30 +386,92 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. .. f:function:: get_mpi_comm() + This function returns a Fortran representation of the LAMMPS "world" + communicator. + :r integer: Fortran integer equivalent to the MPI communicator LAMMPS is using -.. note:: + .. note:: - The MPI_F08 module, which is in compliance with the Fortran 2008 standard, - 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, + The C library interface currently returns type "int" instead of type + "MPI_Fint", which is the C type correspending to Fortran "INTEGER" + types of the default kind. On most compilers, these are the same anyway, + but this interface exchanges values this way to avoid warning messages. - .. code-block:: fortran + .. note:: - USE MPI_F08 - USE LIBLAMMPS - TYPE (LAMMPS) :: lmp - TYPE (MPI_Comm) :: comm - ! ... [commands to set up LAMMPS/etc.] - comm%MPI_VAL = lmp%get_mpi_comm() + 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, - should assign an MPI_F08 communicator properly. + .. code-block:: fortran + + USE MPI_F08 + USE LIBLAMMPS + 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. -------- .. f:function:: extract_setting(keyword) + Query LAMMPS about global settings. See the documentation for the + :c:func:`lammps_extract_setting` function from the C library. + :p character(len=*) keyword: string containing the name of the thermo keyword :r integer(c_int): value of the queried setting or :math:`-1` if unknown + +-------- + +.. f:function:: extract_global(name, dtype) + + Overloaded function to get internal global LAMMPS data. Note that all + currently implemented global types only return scalars or strings; all + array-returning entities currently supported use :f:func:`extract_box`. + + Note that type/kind/rank of the *dtype* argument is used to determine + whether to return a type correspending to a C int, a C int64_t, or a + C double. The type/kind/rank signature of dtype is checked at runtime to + match that of the return value; this type of check cannot be performed at + compile time. For example, + + .. code-block:: fortran + + PROGRAM demo + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + USE LIBLAMMPS + TYPE(lammps) :: lmp + INTEGER(C_int) :: nlocal + INTEGER(C_int64_t) :: ntimestep + CHARACTER(LEN=10) :: units + REAL(C_double) :: dt + lmp = lammps() + ! other commands + nlocal = lmp%extract_global('nlocal', LMP_INT) + ntimestep = lmp%extract_global('ntimestep', LMP_INT64) + dt = lmp%extract_global('dt', LMP_DOUBLE) + units = lmp%extract_global('units', LMP_STRING) + ! more commands + lmp.close(.TRUE.) + END PROGRAM demo + + would extract the number of atoms on this processor, the current time step, + 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. + + :p character(len=*) name: string with the name of the extracted property + :p polymorphic dtype: one of *LMP_INT*, *LMP_INT64*, *LMP_DOUBLE*, or + *LMP_STRING* designating the type/kind/rank of the return value + :r polymorphic: value of the extracted property diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 0b4f8d4f4a..f7a58bc572 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -38,10 +38,10 @@ MODULE LIBLAMMPS ! These are public-interface constants that have the same purpose as the ! constants in library.h, except that their types match the type of the - ! constant in question. Their purpose is to determine the type of the + ! constant in question. Their purpose is to specify the type of the ! return value without something akin to a C/C++ type cast INTEGER (c_int), PUBLIC, PARAMETER :: LMP_INT = 0_c_int - INTEGER (c_int), PUBLIC, DIMENSION(3), PARAMETER :: LMP_INT_1D = 1_c_int + INTEGER (c_int), PUBLIC, DIMENSION(3), PARAMETER :: LMP_INT_1D = 0_c_int INTEGER (c_int), PUBLIC, DIMENSION(3,3), PARAMETER :: LMP_INT_2D = 1_c_int REAL (c_double), PUBLIC, PARAMETER :: LMP_DOUBLE = 2.0_c_double REAL (c_double), PUBLIC, DIMENSION(3), PARAMETER :: & @@ -59,6 +59,8 @@ MODULE LIBLAMMPS ! ! Must be kept in sync with the equivalent declarations in ! src/library.h and python/lammps/constants.py + ! + ! NOT part of the API (the part the user sees) INTEGER (c_int), PARAMETER :: & LAMMPS_INT = 0_c_int, & ! 32-bit integer (array) LAMMPS_INT_2D = 1, & ! two-dimensional 32-bit integer array @@ -84,8 +86,12 @@ MODULE LIBLAMMPS PROCEDURE :: get_mpi_comm => lmp_get_mpi_comm PROCEDURE :: extract_setting => lmp_extract_setting PROCEDURE, PRIVATE :: lmp_extract_global_int - GENERIC :: extract_global => lmp_extract_global_int ! TODO - + PROCEDURE, PRIVATE :: lmp_extract_global_int64_t + PROCEDURE, PRIVATE :: lmp_extract_global_double + PROCEDURE, PRIVATE :: lmp_extract_global_str + GENERIC :: extract_global => lmp_extract_global_int, & + lmp_extract_global_int64_t, lmp_extract_global_double, & + lmp_extract_global_str PROCEDURE :: version => lmp_version END TYPE lammps @@ -207,6 +213,13 @@ MODULE LIBLAMMPS 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) :: str + INTEGER(c_size_t) :: c_strlen + END FUNCTION c_strlen + FUNCTION lammps_extract_global(handle, name) BIND(C) IMPORT :: c_ptr TYPE(c_ptr), VALUE :: handle, name @@ -530,49 +543,94 @@ CONTAINS ! END FUNCTION lmp_extract_global_datatype ! equivalent functions to lammps_extract_global (overloaded) + ! This implementation assumes there are no non-scalar data that can be + ! extracted through lammps_extract_global FUNCTION lmp_extract_global_int (self, name, dtype) CLASS(lammps), INTENT(IN) :: self CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER(c_int) :: dtype + INTEGER(c_int), INTENT(IN) :: dtype INTEGER(c_int) :: lmp_extract_global_int TYPE(c_ptr) :: Cname, Cptr INTEGER(c_int) :: datatype INTEGER(c_int), POINTER :: ptr Cname = f2c_string(name) - datatype = lammps_extract_global_datatype(Cname) + datatype = lammps_extract_global_datatype(c_null_ptr, Cname) IF ( datatype /= LAMMPS_INT ) THEN ! throw an exception or something; data type doesn't match! - WRITE(0,*) 'WARNING: global data type is inconsistent' + WRITE(0,*) 'WARNING: global data type is inconsistent (not an int)' END IF Cptr = lammps_extract_global(self%handle, Cname) CALL c_f_pointer(Cptr, ptr) lmp_extract_global_int = ptr CALL lammps_free(Cname) END FUNCTION lmp_extract_global_int - FUNCTION lmp_extract_global_int_1d (self, name, dtype) - ! This implementation assumes there are three elements to all arrays + FUNCTION lmp_extract_global_int64_t (self, name, dtype) CLASS(lammps), INTENT(IN) :: self CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER(c_int), DIMENSION(3) :: dtype - INTEGER(c_int) :: lmp_extract_global_int + INTEGER(c_int64_t), INTENT(IN) :: dtype + INTEGER(c_int64_t) :: lmp_extract_global_int64_t TYPE(c_ptr) :: Cname, Cptr INTEGER(c_int) :: datatype - INTEGER(c_int), DIMENSION(3), POINTER :: ptr + INTEGER(c_int64_t), POINTER :: ptr Cname = f2c_string(name) - datatype = lammps_extract_global_datatype(Cname) - IF ( datatype /= LAMMPS_INT ) THEN + datatype = lammps_extract_global_datatype(c_null_ptr, Cname) + IF ( datatype /= LAMMPS_INT64 ) THEN ! throw an exception or something; data type doesn't match! + WRITE(0,*) 'WARNING: global data type is inconsistent (not an int64_t)' END IF Cptr = lammps_extract_global(self%handle, Cname) - CALL c_f_pointer(Cptr, ptr, shape(dtype)) - lmp_extract_global_int = ptr + CALL c_f_pointer(Cptr, ptr) + lmp_extract_global_int64_t = ptr CALL lammps_free(Cname) - END FUNCTION lmp_extract_global_int_1d - ! TODO need more generics here to match TKR of LMP_INT_1D, LMP_BIGINT, - ! LMP_DOUBLE, LMP_DOUBLE_1D, LMS_STRING [this assumes no one adds anything - ! requiring LMP_DOUBLE_2D and the like!] + END FUNCTION lmp_extract_global_int64_t + FUNCTION lmp_extract_global_double (self, name, dtype) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + REAL(c_double), INTENT(IN) :: dtype + REAL(c_double) :: lmp_extract_global_double + TYPE(c_ptr) :: Cname, Cptr + INTEGER(c_int) :: datatype + REAL(c_double), POINTER :: ptr + + Cname = f2c_string(name) + datatype = lammps_extract_global_datatype(c_null_ptr, Cname) + IF ( datatype /= LAMMPS_DOUBLE ) THEN + ! throw an exception or something; data type doesn't match! + WRITE(0,*) 'WARNING: global data type is inconsistent (not a double)' + END IF + Cptr = lammps_extract_global(self%handle, Cname) + CALL c_f_pointer(Cptr, ptr) + lmp_extract_global_double = ptr + CALL lammps_free(Cname) + END FUNCTION lmp_extract_global_double + FUNCTION lmp_extract_global_str (self, name, dtype) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name, dtype + CHARACTER(LEN=:), ALLOCATABLE :: lmp_extract_global_str + TYPE(c_ptr) :: Cname, Cptr + INTEGER(c_int) :: datatype + CHARACTER(KIND=c_char,LEN=1), dimension(:), POINTER :: ptr + INTEGER(c_size_t) :: length + INTEGER :: i + + Cname = f2c_string(name) + datatype = lammps_extract_global_datatype(c_null_ptr, Cname) + IF ( datatype /= LAMMPS_STRING ) THEN + ! throw an exception or something; data type doesn't match! + WRITE(0,*) 'WARNING: global data type is inconsistent (not a string)' + END IF + Cptr = lammps_extract_global(self%handle, Cname) + length = c_strlen(Cptr) + CALL c_f_pointer(Cptr, ptr, [length]) + ALLOCATE ( CHARACTER(LEN=length) :: lmp_extract_global_str ) + FORALL ( I=1:length ) + lmp_extract_global_str(i:i) = ptr(i) + END FORALL + CALL lammps_free(Cname) + ! the allocatable scalar (return value) gets auto-deallocated on return + END FUNCTION lmp_extract_global_str ! equivalent function to lammps_version() INTEGER FUNCTION lmp_version(self) From 4151a1af02f8c45abe083d96f7d523f55e23c217 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Thu, 11 Aug 2022 17:46:21 -0500 Subject: [PATCH 07/25] Lots of tinkering with extract_global; back to square 1 --- fortran/lammps.f90 | 326 +++++++++++++++++++++++++++++---------------- 1 file changed, 210 insertions(+), 116 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index f7a58bc572..affab1ef53 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -36,24 +36,24 @@ MODULE LIBLAMMPS PRIVATE PUBLIC :: lammps - ! These are public-interface constants that have the same purpose as the - ! constants in library.h, except that their types match the type of the - ! constant in question. Their purpose is to specify the type of the - ! return value without something akin to a C/C++ type cast - INTEGER (c_int), PUBLIC, PARAMETER :: LMP_INT = 0_c_int - INTEGER (c_int), PUBLIC, DIMENSION(3), PARAMETER :: LMP_INT_1D = 0_c_int - INTEGER (c_int), PUBLIC, DIMENSION(3,3), PARAMETER :: LMP_INT_2D = 1_c_int - REAL (c_double), PUBLIC, PARAMETER :: LMP_DOUBLE = 2.0_c_double - REAL (c_double), PUBLIC, DIMENSION(3), PARAMETER :: & - LMP_DOUBLE_1D = 2.0_c_double - REAL (c_double), PUBLIC, DIMENSION(3,3), PARAMETER :: & - LMP_DOUBLE_2D = 3.0_c_double - INTEGER (c_int64_t), PUBLIC, PARAMETER :: LMP_INT64 = 4_c_int64_t - INTEGER (c_int64_t), PUBLIC, DIMENSION(3), PARAMETER :: & - LMP_INT64_1D = 4_c_int64_t - INTEGER (c_int64_t), PUBLIC, DIMENSION(3,3), PARAMETER :: & - LMP_INT64_2D = 5_c_int64_t - CHARACTER(LEN=*), PUBLIC, PARAMETER :: LMP_STRING = 'six' +! ! These are public-interface constants that have the same purpose as the +! ! constants in library.h, except that their types match the type of the +! ! constant in question. Their purpose is to specify the type of the +! ! return value without something akin to a C/C++ type cast +! INTEGER (c_int), PUBLIC, PARAMETER :: LMP_INT = 0_c_int +! INTEGER (c_int), PUBLIC, DIMENSION(3), PARAMETER :: LMP_INT_1D = 0_c_int +! INTEGER (c_int), PUBLIC, DIMENSION(3,3), PARAMETER :: LMP_INT_2D = 1_c_int +! REAL (c_double), PUBLIC, PARAMETER :: LMP_DOUBLE = 2.0_c_double +! REAL (c_double), PUBLIC, DIMENSION(3), PARAMETER :: & +! LMP_DOUBLE_1D = 2.0_c_double +! REAL (c_double), PUBLIC, DIMENSION(3,3), PARAMETER :: & +! LMP_DOUBLE_2D = 3.0_c_double +! INTEGER (c_int64_t), PUBLIC, PARAMETER :: LMP_INT64 = 4_c_int64_t +! INTEGER (c_int64_t), PUBLIC, DIMENSION(3), PARAMETER :: & +! LMP_INT64_1D = 4_c_int64_t +! INTEGER (c_int64_t), PUBLIC, DIMENSION(3,3), PARAMETER :: & +! LMP_INT64_2D = 5_c_int64_t +! CHARACTER(LEN=*), PUBLIC, PARAMETER :: LMP_STRING = 'six' ! Data type constants for extracting data from global, atom, compute, and fix ! @@ -85,13 +85,17 @@ MODULE LIBLAMMPS PROCEDURE :: memory_usage => lmp_memory_usage PROCEDURE :: get_mpi_comm => lmp_get_mpi_comm PROCEDURE :: extract_setting => lmp_extract_setting - PROCEDURE, PRIVATE :: lmp_extract_global_int - PROCEDURE, PRIVATE :: lmp_extract_global_int64_t - PROCEDURE, PRIVATE :: lmp_extract_global_double - PROCEDURE, PRIVATE :: lmp_extract_global_str - GENERIC :: extract_global => lmp_extract_global_int, & - lmp_extract_global_int64_t, lmp_extract_global_double, & - lmp_extract_global_str +! PROCEDURE :: extract_global => lmp_extract_global +! PROCEDURE, PRIVATE :: lmp_extract_global_int +! PROCEDURE, PRIVATE :: lmp_extract_global_int64_t +! PROCEDURE, PRIVATE :: lmp_extract_global_double +! PROCEDURE, PRIVATE :: lmp_extract_global_str +! GENERIC :: extract_global => lmp_extract_global_int, & +! lmp_extract_global_int64_t, lmp_extract_global_double, & +! lmp_extract_global_str +! PROCEDURE, PRIVATE :: lmp_extract_global_scalar +! !PROCEDURE, PRIVATE :: lmp_extract_global_string +! GENERIC :: extract_global => lmp_extract_global_scalar PROCEDURE :: version => lmp_version END TYPE lammps @@ -225,9 +229,6 @@ MODULE LIBLAMMPS TYPE(c_ptr), VALUE :: handle, name TYPE(c_ptr) :: lammps_extract_global END FUNCTION lammps_extract_global - !(generic) lammps_extract_global - ! TODO: You can fake out the type-casting by declaring non-optional - ! parameters that help the compiler figure out which one to call !INTEGER (c_int) FUNCTION lammps_extract_atom_datatype @@ -542,95 +543,186 @@ CONTAINS ! CALL lammps_free(Cname) ! END FUNCTION lmp_extract_global_datatype - ! equivalent functions to lammps_extract_global (overloaded) - ! This implementation assumes there are no non-scalar data that can be - ! extracted through lammps_extract_global - FUNCTION lmp_extract_global_int (self, name, dtype) - CLASS(lammps), INTENT(IN) :: self - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER(c_int), INTENT(IN) :: dtype - INTEGER(c_int) :: lmp_extract_global_int - TYPE(c_ptr) :: Cname, Cptr - INTEGER(c_int) :: datatype - INTEGER(c_int), POINTER :: ptr + ! equivalent function to lammps_extract_global + ! the return value should be automatically returned and assigned correctly + ! based on the information available from LAMMPS +! SUBROUTINE lmp_extract_global_scalar (self, global_data, name) +! CLASS(lammps), INTENT(IN) :: self +! CLASS(*), INTENT(OUT), POINTER :: global_data +! CHARACTER(LEN=*), INTENT(IN) :: name +! INTEGER(c_int) :: datatype +! TYPE(c_ptr) :: Cname, Cptr +! INTEGER(c_size_t) :: length, i +! CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Fptr +! +! Cname = f2c_string(name) +! datatype = lammps_extract_global_datatype(self%handle, Cname) +! ! above could be c_null_ptr in place of self%handle...doesn't matter +! Cptr = lammps_extract_global(self%handle, Cname) +! SELECT CASE (datatype) +! CASE (LAMMPS_INT) +! SELECT TYPE (global_data) +! TYPE IS (INTEGER(c_int)) +! CALL C_F_POINTER(Cptr, global_data) +! CLASS DEFAULT +! ! FIXME +! WRITE(0,'(A)') 'ERROR: Incompatible pointer type in extract_global' +! STOP +! END SELECT +! CASE (LAMMPS_INT64) +! SELECT TYPE (global_data) +! TYPE IS (INTEGER(c_int64_t)) +! CALL C_F_POINTER(Cptr, global_data) +! CLASS DEFAULT +! ! FIXME +! WRITE(0,'(A)') 'ERROR: Incompatible pointer type in extract_global' +! STOP +! END SELECT +! CASE (LAMMPS_DOUBLE) +! SELECT TYPE (global_data) +! TYPE IS (REAL(c_double)) +! CALL C_F_POINTER(Cptr, global_data) +! CLASS DEFAULT +! ! FIXME +! WRITE(0,'(A)') 'ERROR: Incompatible pointer type in extract_global' +! STOP +! END SELECT +! CASE (LAMMPS_STRING) +! SELECT TYPE (global_data) +! TYPE IS (CHARACTER(LEN=*)) +! length = c_strlen(Cptr) +! CALL C_F_POINTER(Cptr, Fptr, [length]) +! IF ( length < len(global_data) ) length = len(global_data) +! FORALL ( i = 1:length ) +! global_data(i:i) = Fptr(i) +! END FORALL +! END SELECT +! CASE DEFAULT +! ! FIXME +! WRITE (0,'(A,1X,I0,1X,A)') 'ERROR: Unknown type', datatype, & +! 'returned from extract_global_datatype' +! STOP +! END SELECT +! CALL lammps_free(Cname) +! END SUBROUTINE lmp_extract_global_scalar +! +! SUBROUTINE lmp_extract_global_string (self, global_data, name) +! CLASS(lammps), INTENT(IN) :: self +! CHARACTER(LEN=*), INTENT(OUT) :: global_data +! CHARACTER(LEN=*), INTENT(IN) :: name +! INTEGER(c_int) :: datatype +! TYPE(c_ptr) :: Cname, Cptr +! CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Fptr +! INTEGER(c_size_t) :: length +! INTEGER :: i +! +! global_data = '' +! Cname = f2c_string(name) +! datatype = lammps_extract_global_datatype(self%handle, Cname) +! IF ( datatype /= LAMMPS_STRING ) THEN +! ! FIXME +! WRITE (0,'(A)') 'ERROR: Cannot assign string to non-string variable.' +! STOP +! END IF +! Cptr = lammps_extract_global(self%handle, Cname) +! length = c_strlen(Cptr) +! CALL C_F_POINTER(Cptr, Fptr, [length]) +! IF ( length < len(global_data) ) length = len(global_data) +! FORALL ( i = 1:length ) +! global_data(i:i) = Fptr(i) +! END FORALL +! CALL lammps_free(Cname) +! END SUBROUTINE lmp_extract_global_string - Cname = f2c_string(name) - datatype = lammps_extract_global_datatype(c_null_ptr, Cname) - IF ( datatype /= LAMMPS_INT ) THEN - ! throw an exception or something; data type doesn't match! - WRITE(0,*) 'WARNING: global data type is inconsistent (not an int)' - END IF - Cptr = lammps_extract_global(self%handle, Cname) - CALL c_f_pointer(Cptr, ptr) - lmp_extract_global_int = ptr - CALL lammps_free(Cname) - END FUNCTION lmp_extract_global_int - FUNCTION lmp_extract_global_int64_t (self, name, dtype) - CLASS(lammps), INTENT(IN) :: self - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER(c_int64_t), INTENT(IN) :: dtype - INTEGER(c_int64_t) :: lmp_extract_global_int64_t - TYPE(c_ptr) :: Cname, Cptr - INTEGER(c_int) :: datatype - INTEGER(c_int64_t), POINTER :: ptr - - Cname = f2c_string(name) - datatype = lammps_extract_global_datatype(c_null_ptr, Cname) - IF ( datatype /= LAMMPS_INT64 ) THEN - ! throw an exception or something; data type doesn't match! - WRITE(0,*) 'WARNING: global data type is inconsistent (not an int64_t)' - END IF - Cptr = lammps_extract_global(self%handle, Cname) - CALL c_f_pointer(Cptr, ptr) - lmp_extract_global_int64_t = ptr - CALL lammps_free(Cname) - END FUNCTION lmp_extract_global_int64_t - FUNCTION lmp_extract_global_double (self, name, dtype) - CLASS(lammps), INTENT(IN) :: self - CHARACTER(LEN=*), INTENT(IN) :: name - REAL(c_double), INTENT(IN) :: dtype - REAL(c_double) :: lmp_extract_global_double - TYPE(c_ptr) :: Cname, Cptr - INTEGER(c_int) :: datatype - REAL(c_double), POINTER :: ptr - - Cname = f2c_string(name) - datatype = lammps_extract_global_datatype(c_null_ptr, Cname) - IF ( datatype /= LAMMPS_DOUBLE ) THEN - ! throw an exception or something; data type doesn't match! - WRITE(0,*) 'WARNING: global data type is inconsistent (not a double)' - END IF - Cptr = lammps_extract_global(self%handle, Cname) - CALL c_f_pointer(Cptr, ptr) - lmp_extract_global_double = ptr - CALL lammps_free(Cname) - END FUNCTION lmp_extract_global_double - FUNCTION lmp_extract_global_str (self, name, dtype) - CLASS(lammps), INTENT(IN) :: self - CHARACTER(LEN=*), INTENT(IN) :: name, dtype - CHARACTER(LEN=:), ALLOCATABLE :: lmp_extract_global_str - TYPE(c_ptr) :: Cname, Cptr - INTEGER(c_int) :: datatype - CHARACTER(KIND=c_char,LEN=1), dimension(:), POINTER :: ptr - INTEGER(c_size_t) :: length - INTEGER :: i - - Cname = f2c_string(name) - datatype = lammps_extract_global_datatype(c_null_ptr, Cname) - IF ( datatype /= LAMMPS_STRING ) THEN - ! throw an exception or something; data type doesn't match! - WRITE(0,*) 'WARNING: global data type is inconsistent (not a string)' - END IF - Cptr = lammps_extract_global(self%handle, Cname) - length = c_strlen(Cptr) - CALL c_f_pointer(Cptr, ptr, [length]) - ALLOCATE ( CHARACTER(LEN=length) :: lmp_extract_global_str ) - FORALL ( I=1:length ) - lmp_extract_global_str(i:i) = ptr(i) - END FORALL - CALL lammps_free(Cname) - ! the allocatable scalar (return value) gets auto-deallocated on return - END FUNCTION lmp_extract_global_str +! ! equivalent functions to lammps_extract_global (overloaded) +! ! This implementation assumes there are no non-scalar data that can be +! ! extracted through lammps_extract_global +! FUNCTION lmp_extract_global_int (self, name, dtype) +! CLASS(lammps), INTENT(IN) :: self +! CHARACTER(LEN=*), INTENT(IN) :: name +! INTEGER(c_int), INTENT(IN) :: dtype +! INTEGER(c_int) :: lmp_extract_global_int +! TYPE(c_ptr) :: Cname, Cptr +! INTEGER(c_int) :: datatype +! INTEGER(c_int), POINTER :: ptr +! +! Cname = f2c_string(name) +! datatype = lammps_extract_global_datatype(c_null_ptr, Cname) +! IF ( datatype /= LAMMPS_INT ) THEN +! ! throw an exception or something; data type doesn't match! +! WRITE(0,*) 'WARNING: global data type is inconsistent (not an int)' +! END IF +! Cptr = lammps_extract_global(self%handle, Cname) +! CALL C_F_POINTER(Cptr, ptr) +! lmp_extract_global_int = ptr +! CALL lammps_free(Cname) +! END FUNCTION lmp_extract_global_int +! FUNCTION lmp_extract_global_int64_t (self, name, dtype) +! CLASS(lammps), INTENT(IN) :: self +! CHARACTER(LEN=*), INTENT(IN) :: name +! INTEGER(c_int64_t), INTENT(IN) :: dtype +! INTEGER(c_int64_t) :: lmp_extract_global_int64_t +! TYPE(c_ptr) :: Cname, Cptr +! INTEGER(c_int) :: datatype +! INTEGER(c_int64_t), POINTER :: ptr +! +! Cname = f2c_string(name) +! datatype = lammps_extract_global_datatype(c_null_ptr, Cname) +! IF ( datatype /= LAMMPS_INT64 ) THEN +! ! throw an exception or something; data type doesn't match! +! WRITE(0,*) 'WARNING: global data type is inconsistent (not an int64_t)' +! END IF +! Cptr = lammps_extract_global(self%handle, Cname) +! CALL C_F_POINTER(Cptr, ptr) +! lmp_extract_global_int64_t = ptr +! CALL lammps_free(Cname) +! END FUNCTION lmp_extract_global_int64_t +! FUNCTION lmp_extract_global_double (self, name, dtype) +! CLASS(lammps), INTENT(IN) :: self +! CHARACTER(LEN=*), INTENT(IN) :: name +! REAL(c_double), INTENT(IN) :: dtype +! REAL(c_double) :: lmp_extract_global_double +! TYPE(c_ptr) :: Cname, Cptr +! INTEGER(c_int) :: datatype +! REAL(c_double), POINTER :: ptr +! +! Cname = f2c_string(name) +! datatype = lammps_extract_global_datatype(c_null_ptr, Cname) +! IF ( datatype /= LAMMPS_DOUBLE ) THEN +! ! throw an exception or something; data type doesn't match! +! WRITE(0,*) 'WARNING: global data type is inconsistent (not a double)' +! END IF +! Cptr = lammps_extract_global(self%handle, Cname) +! CALL C_F_POINTER(Cptr, ptr) +! lmp_extract_global_double = ptr +! CALL lammps_free(Cname) +! END FUNCTION lmp_extract_global_double +! FUNCTION lmp_extract_global_str (self, name, dtype) +! CLASS(lammps), INTENT(IN) :: self +! CHARACTER(LEN=*), INTENT(IN) :: name, dtype +! CHARACTER(LEN=:), ALLOCATABLE :: lmp_extract_global_str +! TYPE(c_ptr) :: Cname, Cptr +! INTEGER(c_int) :: datatype +! CHARACTER(KIND=c_char,LEN=1), dimension(:), POINTER :: ptr +! INTEGER(c_size_t) :: length +! INTEGER :: i +! +! Cname = f2c_string(name) +! datatype = lammps_extract_global_datatype(c_null_ptr, Cname) +! IF ( datatype /= LAMMPS_STRING ) THEN +! ! throw an exception or something; data type doesn't match! +! WRITE(0,*) 'WARNING: global data type is inconsistent (not a string)' +! END IF +! Cptr = lammps_extract_global(self%handle, Cname) +! length = c_strlen(Cptr) +! CALL C_F_POINTER(Cptr, ptr, [length]) +! ALLOCATE ( CHARACTER(LEN=length) :: lmp_extract_global_str ) +! FORALL ( I=1:length ) +! lmp_extract_global_str(i:i) = ptr(i) +! END FORALL +! CALL lammps_free(Cname) +! ! the allocatable scalar (return value) gets auto-deallocated on return +! END FUNCTION lmp_extract_global_str ! equivalent function to lammps_version() INTEGER FUNCTION lmp_version(self) @@ -659,3 +751,5 @@ CONTAINS c_string(n+1) = c_null_char END FUNCTION f2c_string END MODULE LIBLAMMPS + +! vim: ts=2 sts=2 sw=2 et From 88a3a3864076be17891995dc299d8e4004744da0 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 12 Aug 2022 00:04:25 -0500 Subject: [PATCH 08/25] I think I finally fixed extract_global; we'll check it in the morning --- doc/src/Fortran.rst | 79 +++++++---------- fortran/lammps.f90 | 203 ++++++++++++++++++++++++++++++++++++-------- 2 files changed, 198 insertions(+), 84 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 4e093dc49b..9fa91a9dd8 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -229,37 +229,6 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. lmp = lammps(MPI_COMM_SELF%MPI_VAL) END PROGRAM testmpi -Constants Defined by the API -============================ - -The following constants are declared by the Fortran API to resolve the -type/kind/rank signature for return values. These serve the same role as -``LAMMPS_INT``, ``LAMMPS_DOUBLE``, and similar constants in ``src/library.h`` -and those in ``python/lammps/constants.py`` for the C and Python APIs, -respectively. Unlike their C and Python bretheren, however, it is the type -(e.g., ``INTEGER``), kind (e.g., ``C_int``), and rank (e.g., ``DIMENSION(:)``) -of these constants that is used by the calling routine, rather than their -numerical values. - -:f:LMP_INT: 32-bit integer scalars -:f:LMP_INT_1D: 32-bit integer vectors -:f:LMP_INT_2D: 32-bit integer matrices -:f:LMP_DOUBLE: 64-bit real scalars -:f:LMP_DOUBLE_1D: 64-bit real vectors -:f:LMP_DOUBLE_2D: 64-bit real matrices -:f:LMP_INT64: 64-bit integer scalars -:f:LMP_INT64_1D: 64-bit integer vectors -:f:LMP_INT64_2D: 64-bit integer matrices - -.. admonition:: Interaction with LAMMPS_BIGBIG and such - - LAMMPS uses different-sized integers to store various entities, such as - the number of timesteps or the total number of atoms, depending on certain - compiler flags (see the :doc:`size limits ` - documentation). This API is currently agnostic to these settings, and it - is up to the user to know the size of LAMMPS_BIGINT and such and pass - LMP_INT or LMP_INT64, as appropriate, for such entities. - Procedures Bound to the lammps Derived Type =========================================== @@ -429,17 +398,19 @@ Procedures Bound to the lammps Derived Type -------- -.. f:function:: extract_global(name, dtype) +.. f:function:: extract_global(name) - Overloaded function to get internal global LAMMPS data. Note that all - currently implemented global types only return scalars or strings; all - array-returning entities currently supported use :f:func:`extract_box`. + Function to get internal global LAMMPS data. - Note that type/kind/rank of the *dtype* argument is used to determine - whether to return a type correspending to a C int, a C int64_t, or a - C double. The type/kind/rank signature of dtype is checked at runtime to - match that of the return value; this type of check cannot be performed at - compile time. For example, + Note that this function actually does not return a value, but rather + associates the the pointer on the left-hand side of the assignment to point + to internal LAMMPS data (with the exception of string data, which are + copied 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 appropriate rank. + The pointer being associated with LAMMPS data is type- and rank-checked at + run-time. + want via an overloaded assignment operator. For example, .. code-block:: fortran @@ -447,16 +418,16 @@ Procedures Bound to the lammps Derived Type USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t USE LIBLAMMPS TYPE(lammps) :: lmp - INTEGER(C_int) :: nlocal - INTEGER(C_int64_t) :: ntimestep + INTEGER(C_int), POINTER :: nlocal + INTEGER(C_int64_t), POINTER :: ntimestep CHARACTER(LEN=10) :: units - REAL(C_double) :: dt + REAL(C_double), POINTER :: dt lmp = lammps() ! other commands - nlocal = lmp%extract_global('nlocal', LMP_INT) - ntimestep = lmp%extract_global('ntimestep', LMP_INT64) - dt = lmp%extract_global('dt', LMP_DOUBLE) - units = lmp%extract_global('units', LMP_STRING) + 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 @@ -472,6 +443,14 @@ Procedures Bound to the lammps Derived Type are padded with spaces at the end. :p character(len=*) name: string with the name of the extracted property - :p polymorphic dtype: one of *LMP_INT*, *LMP_INT64*, *LMP_DOUBLE*, or - *LMP_STRING* designating the type/kind/rank of the return value - :r polymorphic: value of the extracted property + :r polymorphic: the left-hand side of the assignment should be either a + string (if expecting string data) or a C-interoperable pointer to the + extracted property. If expecting vector data, the pointer should have + dimension ":". + +.. note:: + + Functions such as extract_global and extract_atom actually return a + derived type, and an overloaded operator tells the compiler how to pull the + data out of that derived type when the assignment is made. The user need + not worry about these implementation details. diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index affab1ef53..312d6b7b1f 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -31,29 +31,11 @@ MODULE LIBLAMMPS USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_loc, & c_int, c_int64_t, c_char, c_null_char, c_double, c_size_t, c_f_pointer + USE, INTRINSIC :: ISO_Fortran_env, ONLY : ERROR_UNIT, OUTPUT_UNIT ! FIXME IMPLICIT NONE PRIVATE - PUBLIC :: lammps - -! ! These are public-interface constants that have the same purpose as the -! ! constants in library.h, except that their types match the type of the -! ! constant in question. Their purpose is to specify the type of the -! ! return value without something akin to a C/C++ type cast -! INTEGER (c_int), PUBLIC, PARAMETER :: LMP_INT = 0_c_int -! INTEGER (c_int), PUBLIC, DIMENSION(3), PARAMETER :: LMP_INT_1D = 0_c_int -! INTEGER (c_int), PUBLIC, DIMENSION(3,3), PARAMETER :: LMP_INT_2D = 1_c_int -! REAL (c_double), PUBLIC, PARAMETER :: LMP_DOUBLE = 2.0_c_double -! REAL (c_double), PUBLIC, DIMENSION(3), PARAMETER :: & -! LMP_DOUBLE_1D = 2.0_c_double -! REAL (c_double), PUBLIC, DIMENSION(3,3), PARAMETER :: & -! LMP_DOUBLE_2D = 3.0_c_double -! INTEGER (c_int64_t), PUBLIC, PARAMETER :: LMP_INT64 = 4_c_int64_t -! INTEGER (c_int64_t), PUBLIC, DIMENSION(3), PARAMETER :: & -! LMP_INT64_1D = 4_c_int64_t -! INTEGER (c_int64_t), PUBLIC, DIMENSION(3,3), PARAMETER :: & -! LMP_INT64_2D = 5_c_int64_t -! CHARACTER(LEN=*), PUBLIC, PARAMETER :: LMP_STRING = 'six' + PUBLIC :: lammps, ASSIGNMENT(=) ! Data type constants for extracting data from global, atom, compute, and fix ! @@ -62,7 +44,7 @@ MODULE LIBLAMMPS ! ! NOT part of the API (the part the user sees) INTEGER (c_int), PARAMETER :: & - LAMMPS_INT = 0_c_int, & ! 32-bit integer (array) + 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 @@ -85,17 +67,7 @@ MODULE LIBLAMMPS 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, PRIVATE :: lmp_extract_global_int -! PROCEDURE, PRIVATE :: lmp_extract_global_int64_t -! PROCEDURE, PRIVATE :: lmp_extract_global_double -! PROCEDURE, PRIVATE :: lmp_extract_global_str -! GENERIC :: extract_global => lmp_extract_global_int, & -! lmp_extract_global_int64_t, lmp_extract_global_double, & -! lmp_extract_global_str -! PROCEDURE, PRIVATE :: lmp_extract_global_scalar -! !PROCEDURE, PRIVATE :: lmp_extract_global_string -! GENERIC :: extract_global => lmp_extract_global_scalar + PROCEDURE :: extract_global => lmp_extract_global PROCEDURE :: version => lmp_version END TYPE lammps @@ -103,6 +75,33 @@ MODULE LIBLAMMPS MODULE PROCEDURE lmp_open END INTERFACE lammps + ! Constants to use in working with lammps_data + ENUM, BIND(C) + ENUMERATOR :: DATA_INT, DATA_INT_1D, DATA_INT_2D + ENUMERATOR :: DATA_INT64, DATA_INT64_1D, DATA_INT64_2D + ENUMERATOR :: DATA_DOUBLE, DATA_DOUBLE_1D, DATA_DOUBLE_2D + ENUMERATOR :: DATA_STRING + END ENUM + ! Derived type for receiving LAMMPS data (in lieu of the ability to type cast + ! pointers) + + TYPE lammps_data + INTEGER(c_int) :: datatype + INTEGER(c_int), POINTER :: i32 + INTEGER(c_int), DIMENSION(:), POINTER :: i32_vec + INTEGER(c_int64_t), POINTER :: i64 + INTEGER(c_int64_t), DIMENSION(:), POINTER :: i64_vec + REAL(c_double), POINTER :: r64 + REAL(c_double), DIMENSION(:), POINTER :: r64_vec + CHARACTER(LEN=:), ALLOCATABLE :: str + END TYPE lammps_data + + INTERFACE ASSIGNMENT(=) + MODULE PROCEDURE assign_int_to_lammps_data, assign_int64_to_lammps_data, & + assign_double_to_lammps_data, assign_doublevec_to_lammps_data, & + assign_string_to_lammps_data + END INTERFACE + ! interface definitions for calling functions in library.cpp INTERFACE FUNCTION lammps_open(argc, argv, comm) BIND(C, name='lammps_open_fortran') @@ -543,6 +542,78 @@ CONTAINS ! CALL lammps_free(Cname) ! END FUNCTION lmp_extract_global_datatype + ! equivalent function to lammps_extract_global + ! the assignment is actually overloaded so as to bind the pointers to + ! lammps data based on the information available from LAMMPS + FUNCTION lmp_extract_global (self, name) result(global_data) + CLASS(lammps), INTENT(IN) :: self + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(lammps_data) :: global_data + + INTEGER(c_int) :: datatype + TYPE(c_ptr) :: Cname, Cptr + INTEGER(c_size_t) :: length, i + CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Fptr + + ! Determine vector length + ! FIXME Is there a way to get the length of the vector from C rather + ! than defining it here AND in the Python API? + SELECT CASE (name) + CASE ('boxlo','boxhi','sublo','subhi','sublo_lambda','subhi_lambda', & + 'periodicity') + length = 3 + CASE DEFAULT + length = 1 + ! string cases are overridden later + END SELECT + + Cname = f2c_string(name) + datatype = lammps_extract_global_datatype(self%handle, Cname) + ! above could be c_null_ptr in place of self%handle...doesn't matter + Cptr = lammps_extract_global(self%handle, Cname) + CALL lammps_free(Cname) + + SELECT CASE (datatype) + CASE (LAMMPS_INT) + IF ( length == 1 ) THEN + global_data%datatype = DATA_INT + CALL C_F_POINTER(Cptr, global_data%i32) + ELSE + global_data%datatype = DATA_INT_1D + CALL C_F_POINTER(Cptr, global_data%i32_vec, [length]) + END IF + CASE (LAMMPS_INT64) + IF ( length == 1 ) THEN + global_data%datatype = DATA_INT64 + CALL C_F_POINTER(Cptr, global_data%i64) + ELSE + global_data%datatype = DATA_INT64_1D + CALL C_F_POINTER(Cptr, global_data%i64_vec, [length]) + END IF + CASE (LAMMPS_DOUBLE) + IF ( length == 1 ) THEN + global_data%datatype = DATA_DOUBLE + CALL C_F_POINTER(Cptr, global_data%r64) + ELSE + global_data%datatype = DATA_DOUBLE_1D + CALL C_F_POINTER(Cptr, global_data%r64_vec, [length]) + END IF + CASE (LAMMPS_STRING) + 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 ) + global_data%str(i:i) = Fptr(i) + END FORALL + CASE DEFAULT + WRITE(ERROR_UNIT,'(A)') 'ERROR: Unknown pointer type in& + & extract_global' + STOP + END SELECT + + END FUNCTION + ! equivalent function to lammps_extract_global ! the return value should be automatically returned and assigned correctly ! based on the information available from LAMMPS @@ -732,13 +803,77 @@ CONTAINS lmp_version = lammps_version(self%handle) END FUNCTION lmp_version + ! ---------------------------------------------------------------------- + ! functions to assign user-space pointers to LAMMPS data + ! ---------------------------------------------------------------------- + SUBROUTINE assign_int_to_lammps_data (lhs, rhs) + INTEGER(c_int), INTENT(OUT), POINTER :: lhs + CLASS(lammps_data), INTENT(IN) :: rhs + + IF ( rhs%datatype == DATA_INT ) THEN + lhs => rhs%i32 + ELSE + WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' + STOP + END IF + END SUBROUTINE assign_int_to_lammps_data + + SUBROUTINE assign_int64_to_lammps_data (lhs, rhs) + INTEGER(c_int64_t), INTENT(OUT), POINTER :: lhs + CLASS(lammps_data), INTENT(IN) :: rhs + + IF ( rhs%datatype == DATA_INT64 ) THEN + lhs => rhs%i64 + ELSE + WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' + STOP + END IF + END SUBROUTINE assign_int64_to_lammps_data + + SUBROUTINE assign_double_to_lammps_data (lhs, rhs) + REAL(c_double), INTENT(OUT), POINTER :: lhs + CLASS(lammps_data), INTENT(IN) :: rhs + + IF ( rhs%datatype == DATA_DOUBLE ) THEN + lhs => rhs%r64 + ELSE + WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' + STOP + END IF + END SUBROUTINE assign_double_to_lammps_data + + SUBROUTINE assign_doublevec_to_lammps_data (lhs, rhs) + REAL(c_double), DIMENSION(:), INTENT(OUT), POINTER :: lhs + CLASS(lammps_data), INTENT(IN) :: rhs + + IF ( rhs%datatype == DATA_DOUBLE_1D ) THEN + lhs => rhs%r64_vec + ELSE + WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' + STOP + END IF + END SUBROUTINE assign_doublevec_to_lammps_data + + SUBROUTINE assign_string_to_lammps_data (lhs, rhs) + CHARACTER(LEN=*), INTENT(OUT) :: lhs + CLASS(lammps_data), INTENT(IN) :: rhs + + IF ( rhs%datatype == DATA_STRING ) THEN + lhs = rhs%str + ELSE + WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' + STOP + END IF + END SUBROUTINE assign_string_to_lammps_data + + ! ---------------------------------------------------------------------- ! local helper functions ! copy fortran string to zero terminated c string ! ---------------------------------------------------------------------- FUNCTION f2c_string(f_string) RESULT(ptr) - CHARACTER (LEN=*), INTENT(IN) :: f_string - CHARACTER (LEN=1, KIND=c_char), POINTER :: c_string(:) + 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 From 9b0c2d82c39810bf8a9898092176868495429169 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 12 Aug 2022 08:23:20 -0500 Subject: [PATCH 09/25] Missing comma --- doc/src/Fortran.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 9fa91a9dd8..49bc3c803b 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -49,7 +49,7 @@ found together with equivalent examples in C and C++ in the Creating or deleting a LAMMPS object ************************************ -With the Fortran interface the creation of a :cpp:class:`LAMMPS +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 From 9d89bc8f8260ae335b37c75361f1d3d864977683 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 12 Aug 2022 09:40:29 -0500 Subject: [PATCH 10/25] Typo fixes/etc. in documentation --- doc/src/Fortran.rst | 81 ++++++++++++++++++++++++++------------------- 1 file changed, 47 insertions(+), 34 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 49bc3c803b..84d8e46576 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -120,9 +120,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 pass +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 similar to how it is implemented in the `C-library +is done similarly to how it is implemented in the `C-library ` interface. Before handing off the calls to the C-library interface, the corresponding Fortran versions of the calls (:f:func:`file`, :f:func:`command`, :f:func:`commands_list`, and @@ -178,23 +178,23 @@ 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 close: :f:func:`close` - :f version: :f:func:`version` - :f file: :f:func:`file` - :f command: :f:func:`command` - :f commands_list: :f:func:`commands_list` - :f commands_string: :f:func:`commands_string` - :f get_natoms: :f:func:`get_natoms` - :f get_thermo: :f:func:`get_thermo` - :f extract_box: :f:func:`extract_box` - :f reset_box: :f:func:`reset_box` - :f memory_usage: :f:func:`memory_usage` - :f extract_setting: :f:func:`extract_setting` - :f extract_global: :f:func:`extract_global` + :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` + :f subroutine commands_string: :f:func:`commands_string` + :f function get_natoms: :f:func:`get_natoms` + :f function get_thermo: :f:func:`get_thermo` + :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 extract_setting: :f:func:`extract_setting` + :f function extract_global: :f:func:`extract_global` -------- -.. f:function:: lammps(args[,comm]) +.. f:function:: lammps([args][,comm]) This is the constructor for the Fortran class and will forward the arguments to a call to either :cpp:func:`lammps_open_fortran` @@ -207,7 +207,7 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. If *comm* is not provided, ``MPI_COMM_WORLD`` is assumed. For more details please see the documentation of :cpp:func:`lammps_open`. - :p character(len=*) args(*) [optional]: arguments as list of strings + :o character(len=*) args(*) [optional]: arguments as list of strings :o integer comm [optional]: MPI communicator :r lammps: an instance of the :f:type:`lammps` derived type @@ -306,26 +306,40 @@ Procedures Bound to the lammps Derived Type -------- -.. f:subroutine:: extract_box(boxlo, boxhi, xy, yz, xz, pflags, boxflag) +.. f:subroutine:: extract_box([boxlo][, boxhi][, xy][, yz][, xz][, pflag]s[, boxflag]) This subroutine will call :cpp:func:`lammps_extract_box`. All parameters are optional, though obviously at least one should be present. The parameters *pflags* and *boxflag* are stored in LAMMPS as integers, but should be declared as ``LOGICAL`` variables when calling from Fortran. - :p real(c_double) boxlo [dimension(3),optional]: vector in which to store + :o real(c_double) boxlo [dimension(3),optional]: vector in which to store lower-bounds of simulation box - :p real(c_double) boxhi [dimension(3),optional]: vector in which to store + :o real(c_double) boxhi [dimension(3),optional]: vector in which to store upper-bounds of simulation box - :p real(c_double) xy [optional]: variable in which to store *xy* tilt factor - :p real(c_double) yz [optional]: variable in which to store *yz* tilt factor - :p real(c_double) xz [optional]: variable in which to store *xz* tilt factor - :p logical pflags [dimension(3),optional]: vector in which to store + :o real(c_double) xy [optional]: variable in which to store *xy* tilt factor + :o real(c_double) yz [optional]: variable in which to store *yz* tilt factor + :o real(c_double) xz [optional]: variable in which to store *xz* tilt factor + :o logical pflags [dimension(3),optional]: vector in which to store periodicity flags (``.TRUE.`` means periodic in that dimension) - :p logical boxflag [optional]: variable in which to store boolean denoting + :o logical boxflag [optional]: variable in which to store boolean denoting whether the box will change during a simulation (``.TRUE.`` means box will change) +.. note:: + + Note that a frequent use case of this function is to extract only one or + more of the options rather than all seven. For example, assuming "lmp" + represents a properly-initalized LAMMPS instance, the following code will + extract the periodic box settings into the variable "periodic": + + .. code-block:: Fortran + + ! code to start up + logical :: periodic(3) + ! code to initialize LAMMPS / run things / etc. + call lmp%extract_box(pflags = periodic) + -------- .. f:subroutine:: reset_box(boxlo, boxhi, xy, yz, xz) @@ -409,8 +423,7 @@ Procedures Bound to the lammps Derived Type correct data type to point to said data (typically INTEGER(c_int), INTEGER(c_int64_t), or REAL(c_double)) and have appropriate rank. The pointer being associated with LAMMPS data is type- and rank-checked at - run-time. - want via an overloaded assignment operator. For example, + run-time want via an overloaded assignment operator. For example, .. code-block:: fortran @@ -443,14 +456,14 @@ Procedures Bound to the lammps Derived Type are padded with spaces at the end. :p character(len=*) name: string with the name of the extracted property - :r polymorphic: the left-hand side of the assignment should be either a - string (if expecting string data) or a C-interoperable pointer to the - extracted property. If expecting vector data, the pointer should have - dimension ":". + :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 + property. If expecting vector data, the pointer should have dimension ":". .. note:: Functions such as extract_global and extract_atom actually return a - derived type, and an overloaded operator tells the compiler how to pull the - data out of that derived type when the assignment is made. The user need - not worry about these implementation details. + derived type, and an overloaded operator tells the compiler how to + associate the pointer with the relevant data when the assignment is made. + The user need not worry about these implementation details. From 05be7fe8cadf375d092f690ff6bb9bee1e57b793 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 12 Aug 2022 11:33:28 -0500 Subject: [PATCH 11/25] Possibly-read-for-inclusion version of extract_global and associated documentation --- doc/src/Fortran.rst | 32 ++++--- fortran/lammps.f90 | 206 ++++---------------------------------------- src/library.cpp | 4 +- 3 files changed, 39 insertions(+), 203 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 84d8e46576..d3b68a3570 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -414,16 +414,24 @@ Procedures Bound to the lammps Derived Type .. f:function:: extract_global(name) - Function to get internal global LAMMPS data. + This function calls :c:func:`lammps_extract_global` and returns either a + string or a pointer to internal global LAMMPS data, depending on the data + requested through *name*. Note that this function actually does not return a value, but rather - associates the the pointer on the left-hand side of the assignment to point + 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 returned as ordinary Fortran strings). Pointers must be of the + 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 appropriate rank. - The pointer being associated with LAMMPS data is type- and rank-checked at - run-time want via an overloaded assignment operator. For example, + 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 + it is not necessary to call the function again, unless a :doc:`clear` + command has been issued, which wipes out and recreates the contents of + the :cpp:class:`LAMMPS ` class. + + For example, .. code-block:: fortran @@ -461,9 +469,11 @@ 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 ":". -.. note:: + .. warning:: - Functions such as extract_global and extract_atom actually return a - derived type, and an overloaded operator tells the compiler how to - associate the pointer with the relevant data when the assignment is made. - The user need not worry about these implementation details. + Modifying the data in the location pointed to by the returned pointer + may lead to inconsistent internal data and thus may cause failures or + crashes or bogus simulations. In general it is thus usually better + to use a LAMMPS input command that sets or changes these parameters. + Those will take care of all side effects and necessary updates of + settings derived from such settings. diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 312d6b7b1f..459eedb830 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -72,7 +72,7 @@ MODULE LIBLAMMPS END TYPE lammps INTERFACE lammps - MODULE PROCEDURE lmp_open + MODULE PROCEDURE lmp_open END INTERFACE lammps ! Constants to use in working with lammps_data @@ -82,9 +82,9 @@ MODULE LIBLAMMPS ENUMERATOR :: DATA_DOUBLE, DATA_DOUBLE_1D, DATA_DOUBLE_2D ENUMERATOR :: DATA_STRING END ENUM + ! Derived type for receiving LAMMPS data (in lieu of the ability to type cast ! pointers) - TYPE lammps_data INTEGER(c_int) :: datatype INTEGER(c_int), POINTER :: i32 @@ -96,6 +96,12 @@ MODULE LIBLAMMPS CHARACTER(LEN=:), ALLOCATABLE :: str END TYPE lammps_data + ! This overloads the assignment operator (=) so that assignments of the + ! form + ! nlocal = extract_global('nlocal') + ! which are of the form "pointer to double = type(lammps_data)" result in + ! re-associating the pointer on the left with the appropriate piece of + ! LAMMPS data (after checking type-compatibility) INTERFACE ASSIGNMENT(=) MODULE PROCEDURE assign_int_to_lammps_data, assign_int64_to_lammps_data, & assign_double_to_lammps_data, assign_doublevec_to_lammps_data, & @@ -104,7 +110,7 @@ MODULE LIBLAMMPS ! interface definitions for calling functions in library.cpp INTERFACE - FUNCTION lammps_open(argc, argv, comm) BIND(C, name='lammps_open_fortran') + FUNCTION lammps_open(argc, argv, comm) BIND(C,name='lammps_open_fortran') IMPORT :: c_ptr, c_int INTEGER(c_int), VALUE, INTENT(IN) :: argc, comm TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv @@ -216,7 +222,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) :: str @@ -330,11 +336,14 @@ MODULE LIBLAMMPS TYPE(c_ptr), VALUE :: ptr END SUBROUTINE lammps_free - !LOGICAL FUNCTION lammps_is_running + !SUBROUTINE lammps_force_timeout + !LOGICAL FUNCTION lammps_has_error + !INTEGER (c_int) FUNCTION lammps_get_last_error_message + END INTERFACE CONTAINS @@ -392,6 +401,7 @@ CONTAINS END IF END SUBROUTINE lmp_close + ! equivalent function to lammps_file() SUBROUTINE lmp_file(self, filename) IMPLICIT NONE CLASS(lammps) :: self @@ -528,10 +538,8 @@ CONTAINS CALL lammps_free(Ckeyword) END FUNCTION lmp_extract_setting -! FIXME Now that I think about it...do we need this at all? +! FIXME Do we need this to be visible to the user? ! ! equivalent function to lammps_extract_global_datatype -! ! this function doesn't need to be accessed by the user, but is instead used -! ! for type checking ! INTEGER (c_int) FUNCTION lmp_extract_global_datatype (name) ! CHARACTER(LEN=*), INTENT(IN) :: name ! TYPE(c_ptr) :: Cname @@ -611,190 +619,8 @@ CONTAINS & extract_global' STOP END SELECT - END FUNCTION - ! equivalent function to lammps_extract_global - ! the return value should be automatically returned and assigned correctly - ! based on the information available from LAMMPS -! SUBROUTINE lmp_extract_global_scalar (self, global_data, name) -! CLASS(lammps), INTENT(IN) :: self -! CLASS(*), INTENT(OUT), POINTER :: global_data -! CHARACTER(LEN=*), INTENT(IN) :: name -! INTEGER(c_int) :: datatype -! TYPE(c_ptr) :: Cname, Cptr -! INTEGER(c_size_t) :: length, i -! CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Fptr -! -! Cname = f2c_string(name) -! datatype = lammps_extract_global_datatype(self%handle, Cname) -! ! above could be c_null_ptr in place of self%handle...doesn't matter -! Cptr = lammps_extract_global(self%handle, Cname) -! SELECT CASE (datatype) -! CASE (LAMMPS_INT) -! SELECT TYPE (global_data) -! TYPE IS (INTEGER(c_int)) -! CALL C_F_POINTER(Cptr, global_data) -! CLASS DEFAULT -! ! FIXME -! WRITE(0,'(A)') 'ERROR: Incompatible pointer type in extract_global' -! STOP -! END SELECT -! CASE (LAMMPS_INT64) -! SELECT TYPE (global_data) -! TYPE IS (INTEGER(c_int64_t)) -! CALL C_F_POINTER(Cptr, global_data) -! CLASS DEFAULT -! ! FIXME -! WRITE(0,'(A)') 'ERROR: Incompatible pointer type in extract_global' -! STOP -! END SELECT -! CASE (LAMMPS_DOUBLE) -! SELECT TYPE (global_data) -! TYPE IS (REAL(c_double)) -! CALL C_F_POINTER(Cptr, global_data) -! CLASS DEFAULT -! ! FIXME -! WRITE(0,'(A)') 'ERROR: Incompatible pointer type in extract_global' -! STOP -! END SELECT -! CASE (LAMMPS_STRING) -! SELECT TYPE (global_data) -! TYPE IS (CHARACTER(LEN=*)) -! length = c_strlen(Cptr) -! CALL C_F_POINTER(Cptr, Fptr, [length]) -! IF ( length < len(global_data) ) length = len(global_data) -! FORALL ( i = 1:length ) -! global_data(i:i) = Fptr(i) -! END FORALL -! END SELECT -! CASE DEFAULT -! ! FIXME -! WRITE (0,'(A,1X,I0,1X,A)') 'ERROR: Unknown type', datatype, & -! 'returned from extract_global_datatype' -! STOP -! END SELECT -! CALL lammps_free(Cname) -! END SUBROUTINE lmp_extract_global_scalar -! -! SUBROUTINE lmp_extract_global_string (self, global_data, name) -! CLASS(lammps), INTENT(IN) :: self -! CHARACTER(LEN=*), INTENT(OUT) :: global_data -! CHARACTER(LEN=*), INTENT(IN) :: name -! INTEGER(c_int) :: datatype -! TYPE(c_ptr) :: Cname, Cptr -! CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Fptr -! INTEGER(c_size_t) :: length -! INTEGER :: i -! -! global_data = '' -! Cname = f2c_string(name) -! datatype = lammps_extract_global_datatype(self%handle, Cname) -! IF ( datatype /= LAMMPS_STRING ) THEN -! ! FIXME -! WRITE (0,'(A)') 'ERROR: Cannot assign string to non-string variable.' -! STOP -! END IF -! Cptr = lammps_extract_global(self%handle, Cname) -! length = c_strlen(Cptr) -! CALL C_F_POINTER(Cptr, Fptr, [length]) -! IF ( length < len(global_data) ) length = len(global_data) -! FORALL ( i = 1:length ) -! global_data(i:i) = Fptr(i) -! END FORALL -! CALL lammps_free(Cname) -! END SUBROUTINE lmp_extract_global_string - -! ! equivalent functions to lammps_extract_global (overloaded) -! ! This implementation assumes there are no non-scalar data that can be -! ! extracted through lammps_extract_global -! FUNCTION lmp_extract_global_int (self, name, dtype) -! CLASS(lammps), INTENT(IN) :: self -! CHARACTER(LEN=*), INTENT(IN) :: name -! INTEGER(c_int), INTENT(IN) :: dtype -! INTEGER(c_int) :: lmp_extract_global_int -! TYPE(c_ptr) :: Cname, Cptr -! INTEGER(c_int) :: datatype -! INTEGER(c_int), POINTER :: ptr -! -! Cname = f2c_string(name) -! datatype = lammps_extract_global_datatype(c_null_ptr, Cname) -! IF ( datatype /= LAMMPS_INT ) THEN -! ! throw an exception or something; data type doesn't match! -! WRITE(0,*) 'WARNING: global data type is inconsistent (not an int)' -! END IF -! Cptr = lammps_extract_global(self%handle, Cname) -! CALL C_F_POINTER(Cptr, ptr) -! lmp_extract_global_int = ptr -! CALL lammps_free(Cname) -! END FUNCTION lmp_extract_global_int -! FUNCTION lmp_extract_global_int64_t (self, name, dtype) -! CLASS(lammps), INTENT(IN) :: self -! CHARACTER(LEN=*), INTENT(IN) :: name -! INTEGER(c_int64_t), INTENT(IN) :: dtype -! INTEGER(c_int64_t) :: lmp_extract_global_int64_t -! TYPE(c_ptr) :: Cname, Cptr -! INTEGER(c_int) :: datatype -! INTEGER(c_int64_t), POINTER :: ptr -! -! Cname = f2c_string(name) -! datatype = lammps_extract_global_datatype(c_null_ptr, Cname) -! IF ( datatype /= LAMMPS_INT64 ) THEN -! ! throw an exception or something; data type doesn't match! -! WRITE(0,*) 'WARNING: global data type is inconsistent (not an int64_t)' -! END IF -! Cptr = lammps_extract_global(self%handle, Cname) -! CALL C_F_POINTER(Cptr, ptr) -! lmp_extract_global_int64_t = ptr -! CALL lammps_free(Cname) -! END FUNCTION lmp_extract_global_int64_t -! FUNCTION lmp_extract_global_double (self, name, dtype) -! CLASS(lammps), INTENT(IN) :: self -! CHARACTER(LEN=*), INTENT(IN) :: name -! REAL(c_double), INTENT(IN) :: dtype -! REAL(c_double) :: lmp_extract_global_double -! TYPE(c_ptr) :: Cname, Cptr -! INTEGER(c_int) :: datatype -! REAL(c_double), POINTER :: ptr -! -! Cname = f2c_string(name) -! datatype = lammps_extract_global_datatype(c_null_ptr, Cname) -! IF ( datatype /= LAMMPS_DOUBLE ) THEN -! ! throw an exception or something; data type doesn't match! -! WRITE(0,*) 'WARNING: global data type is inconsistent (not a double)' -! END IF -! Cptr = lammps_extract_global(self%handle, Cname) -! CALL C_F_POINTER(Cptr, ptr) -! lmp_extract_global_double = ptr -! CALL lammps_free(Cname) -! END FUNCTION lmp_extract_global_double -! FUNCTION lmp_extract_global_str (self, name, dtype) -! CLASS(lammps), INTENT(IN) :: self -! CHARACTER(LEN=*), INTENT(IN) :: name, dtype -! CHARACTER(LEN=:), ALLOCATABLE :: lmp_extract_global_str -! TYPE(c_ptr) :: Cname, Cptr -! INTEGER(c_int) :: datatype -! CHARACTER(KIND=c_char,LEN=1), dimension(:), POINTER :: ptr -! INTEGER(c_size_t) :: length -! INTEGER :: i -! -! Cname = f2c_string(name) -! datatype = lammps_extract_global_datatype(c_null_ptr, Cname) -! IF ( datatype /= LAMMPS_STRING ) THEN -! ! throw an exception or something; data type doesn't match! -! WRITE(0,*) 'WARNING: global data type is inconsistent (not a string)' -! END IF -! Cptr = lammps_extract_global(self%handle, Cname) -! length = c_strlen(Cptr) -! CALL C_F_POINTER(Cptr, ptr, [length]) -! ALLOCATE ( CHARACTER(LEN=length) :: lmp_extract_global_str ) -! FORALL ( I=1:length ) -! lmp_extract_global_str(i:i) = ptr(i) -! END FORALL -! CALL lammps_free(Cname) -! ! the allocatable scalar (return value) gets auto-deallocated on return -! END FUNCTION lmp_extract_global_str - ! equivalent function to lammps_version() INTEGER FUNCTION lmp_version(self) IMPLICIT NONE diff --git a/src/library.cpp b/src/library.cpp index 584504599e..563f9376fc 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -1156,8 +1156,8 @@ Please also see :cpp:func:`lammps_extract_setting`, may lead to inconsistent internal data and thus may cause failures or crashes or bogus simulations. In general it is thus usually better to use a LAMMPS input command that sets or changes these parameters. - Those will takes care of all side effects and necessary updates of - settings derived from such settings. Where possible a reference to + Those will take care of all side effects and necessary updates of + settings derived from such settings. Where possible, a reference to such a command or a relevant section of the manual is given below. The following tables list the supported names, their data types, length From c2ded124a586c06d4142bdd6159f8290b3fd371c Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 12 Aug 2022 11:34:29 -0500 Subject: [PATCH 12/25] fixed spacing --- fortran/lammps.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 459eedb830..d66f0cc3c5 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -44,7 +44,7 @@ MODULE LIBLAMMPS ! ! NOT part of the API (the part the user sees) INTEGER (c_int), PARAMETER :: & - LAMMPS_INT = 0, & ! 32-bit integer (array) + 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 From c6972d483f63c4096c85da807a6c034ea20b8d55 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 12 Aug 2022 11:43:21 -0500 Subject: [PATCH 13/25] Made spacing consistent; added IMPLICIT NONE where it was not implied already and removed it where it was redundant --- fortran/lammps.f90 | 43 +++++++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index d66f0cc3c5..787476f21c 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -112,6 +112,7 @@ MODULE LIBLAMMPS INTERFACE FUNCTION lammps_open(argc, argv, comm) BIND(C,name='lammps_open_fortran') IMPORT :: c_ptr, c_int + IMPLICIT NONE INTEGER(c_int), VALUE, INTENT(IN) :: argc, comm TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv TYPE(c_ptr) :: lammps_open @@ -119,6 +120,7 @@ MODULE LIBLAMMPS FUNCTION lammps_open_no_mpi(argc, argv, handle) BIND(C) IMPORT :: c_ptr, c_int + IMPLICIT NONE INTEGER(c_int), VALUE, INTENT(IN) :: argc TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv TYPE(c_ptr), VALUE, INTENT(in) :: handle @@ -127,6 +129,7 @@ MODULE LIBLAMMPS SUBROUTINE lammps_close(handle) BIND(C) IMPORT :: c_ptr + IMPLICIT NONE TYPE(c_ptr), VALUE :: handle END SUBROUTINE lammps_close @@ -141,18 +144,21 @@ MODULE LIBLAMMPS SUBROUTINE lammps_file(handle, filename) BIND(C) IMPORT :: c_ptr + IMPLICIT NONE TYPE(c_ptr), VALUE :: handle TYPE(c_ptr), VALUE :: filename END SUBROUTINE lammps_file SUBROUTINE lammps_command(handle, cmd) BIND(C) IMPORT :: c_ptr + IMPLICIT NONE TYPE(c_ptr), VALUE :: handle TYPE(c_ptr), 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), DIMENSION(*), INTENT(IN) :: cmds @@ -160,12 +166,14 @@ MODULE LIBLAMMPS SUBROUTINE lammps_commands_string(handle, str) BIND(C) IMPORT :: c_ptr + IMPLICIT NONE TYPE(c_ptr), VALUE :: handle TYPE(c_ptr), 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 REAL(c_double) :: lammps_get_natoms END FUNCTION lammps_get_natoms @@ -179,19 +187,19 @@ MODULE LIBLAMMPS 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 + boxflag) BIND(C) + IMPORT :: c_ptr, c_double, c_int + IMPLICIT NONE + TYPE(c_ptr), 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), VALUE :: handle + REAL(c_double), DIMENSION(3) :: boxlo, boxhi + REAL(c_double), VALUE :: xy, yz, xz END SUBROUTINE lammps_reset_box SUBROUTINE lammps_memory_usage(handle,meminfo) BIND(C) @@ -204,22 +212,22 @@ MODULE LIBLAMMPS FUNCTION lammps_get_mpi_comm(handle) BIND(C) IMPORT :: c_ptr, c_int IMPLICIT NONE - TYPE (c_ptr), VALUE :: handle - INTEGER (c_int) :: lammps_get_mpi_comm + TYPE(c_ptr), 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 - INTEGER (c_int) :: lammps_extract_setting + 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 - INTEGER (c_int) :: lammps_extract_global_datatype + INTEGER(c_int) :: lammps_extract_global_datatype END FUNCTION lammps_extract_global_datatype FUNCTION c_strlen (str) BIND(C,name='strlen') @@ -231,6 +239,7 @@ MODULE LIBLAMMPS FUNCTION lammps_extract_global(handle, name) BIND(C) IMPORT :: c_ptr + IMPLICIT NONE TYPE(c_ptr), VALUE :: handle, name TYPE(c_ptr) :: lammps_extract_global END FUNCTION lammps_extract_global @@ -327,12 +336,14 @@ MODULE LIBLAMMPS 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 SUBROUTINE lammps_free(ptr) BIND(C) IMPORT :: c_ptr + IMPLICIT NONE TYPE(c_ptr), VALUE :: ptr END SUBROUTINE lammps_free @@ -352,7 +363,6 @@ CONTAINS ! Constructor for the LAMMPS class. ! Combined wrapper around lammps_open_fortran() and lammps_open_no_mpi() TYPE(lammps) FUNCTION lmp_open(args, comm) - IMPLICIT NONE INTEGER, INTENT(in), OPTIONAL :: comm CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: args(:) TYPE(c_ptr), ALLOCATABLE :: argv(:) @@ -387,7 +397,6 @@ CONTAINS ! Combined Fortran wrapper around lammps_close() and lammps_mpi_finalize() SUBROUTINE lmp_close(self, finalize) - IMPLICIT NONE CLASS(lammps) :: self LOGICAL, INTENT(IN), OPTIONAL :: finalize @@ -403,7 +412,6 @@ CONTAINS ! equivalent function to lammps_file() SUBROUTINE lmp_file(self, filename) - IMPLICIT NONE CLASS(lammps) :: self CHARACTER(len=*) :: filename TYPE(c_ptr) :: str @@ -415,7 +423,6 @@ CONTAINS ! equivalent function to lammps_command() SUBROUTINE lmp_command(self, cmd) - IMPLICIT NONE CLASS(lammps) :: self CHARACTER(len=*) :: cmd TYPE(c_ptr) :: str @@ -427,7 +434,6 @@ CONTAINS ! equivalent function to lammps_commands_list() SUBROUTINE lmp_commands_list(self, cmds) - IMPLICIT NONE CLASS(lammps) :: self CHARACTER(len=*), INTENT(in), OPTIONAL :: cmds(:) TYPE(c_ptr), ALLOCATABLE :: cmdv(:) @@ -451,7 +457,6 @@ CONTAINS ! equivalent function to lammps_commands_string() SUBROUTINE lmp_commands_string(self, str) - IMPLICIT NONE CLASS(lammps) :: self CHARACTER(len=*) :: str TYPE(c_ptr) :: tmp @@ -463,7 +468,6 @@ CONTAINS ! equivalent function to lammps_get_natoms DOUBLE PRECISION FUNCTION lmp_get_natoms(self) - IMPLICIT NONE CLASS(lammps) :: self lmp_get_natoms = lammps_get_natoms(self%handle) @@ -623,7 +627,6 @@ CONTAINS ! equivalent function to lammps_version() INTEGER FUNCTION lmp_version(self) - IMPLICIT NONE CLASS(lammps) :: self lmp_version = lammps_version(self%handle) From 257b551c921458467b21c14da23482ac8b0c1a7a Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 12 Aug 2022 11:44:55 -0500 Subject: [PATCH 14/25] Missed lammps_version implicit none --- fortran/lammps.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 787476f21c..c0ceadb839 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -291,6 +291,7 @@ MODULE LIBLAMMPS FUNCTION lammps_version(handle) BIND(C) IMPORT :: c_ptr, c_int + IMPLICIT NONE TYPE(c_ptr), VALUE :: handle INTEGER(c_int) :: lammps_version END FUNCTION lammps_version From 4c975c34c1c36631a48709f5e659a39bd97bf51d Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Fri, 12 Aug 2022 11:55:30 -0500 Subject: [PATCH 15/25] Deleted the parenthesis instead of the space... --- fortran/lammps.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index c0ceadb839..ecef8c3e67 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -213,7 +213,7 @@ MODULE LIBLAMMPS IMPORT :: c_ptr, c_int IMPLICIT NONE TYPE(c_ptr), VALUE :: handle - INTEGER c_int) :: lammps_get_mpi_comm + INTEGER(c_int) :: lammps_get_mpi_comm END FUNCTION lammps_get_mpi_comm FUNCTION lammps_extract_setting(handle,keyword) BIND(C) From 196d52fdb335182301f8b96c3c4e63341f606100 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Sat, 13 Aug 2022 19:09:40 -0500 Subject: [PATCH 16/25] Missing comma --- doc/src/Fortran.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index d3b68a3570..081108c719 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -52,7 +52,7 @@ 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 +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 From 8b181ed58a5c3fb53a654e38246ad0c8128c4564 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Mon, 15 Aug 2022 21:11:58 -0500 Subject: [PATCH 17/25] Minor tweaks to docs; fixed typo and capitalization to be consistent --- doc/src/Fortran.rst | 20 ++++++++++---------- fortran/README | 4 ++-- fortran/lammps.f90 | 6 +++--- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 081108c719..0db5f8f097 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -81,7 +81,7 @@ the optional logical argument set to ``.true.``. Here is a simple example: It is also possible to pass command line flags from Fortran to C/C++ and thus make the resulting executable behave similarly to the standalone -executable (it will ignore the `-in/-i` flag, though). This allows to +executable (it will ignore the `-in/-i` flag, though). This allows one to use the command line to configure accelerator and suffix settings, configure screen and logfile output, or to set index style variables from the command line and more. Here is a correspondingly adapted @@ -207,7 +207,7 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. If *comm* is not provided, ``MPI_COMM_WORLD`` is assumed. For more details please see the documentation of :cpp:func:`lammps_open`. - :o character(len=*) args(*) [optional]: arguments as list of strings + :o character(len=\*) args(\*) [optional]: arguments as list of strings :o integer comm [optional]: MPI communicator :r lammps: an instance of the :f:type:`lammps` derived type @@ -256,7 +256,7 @@ Procedures Bound to the lammps Derived Type This method will call :cpp:func:`lammps_file` to have LAMMPS read and process commands from a file. - :p character(len=*) filename: name of file with LAMMPS commands + :p character(len=\*) filename: name of file with LAMMPS commands -------- @@ -265,7 +265,7 @@ Procedures Bound to the lammps Derived Type This method will call :cpp:func:`lammps_command` to have LAMMPS execute a single command. - :p character(len=*) cmd: single LAMMPS command + :p character(len=\*) cmd: single LAMMPS command -------- @@ -274,7 +274,7 @@ Procedures Bound to the lammps Derived Type This method will call :cpp:func:`lammps_commands_list` to have LAMMPS execute a list of input lines. - :p character(len=*) cmd(:): list of LAMMPS input lines + :p character(len=\*) cmd(:): list of LAMMPS input lines -------- @@ -283,7 +283,7 @@ Procedures Bound to the lammps Derived Type This method will call :cpp:func:`lammps_commands_string` to have LAMMPS execute a block of commands from a string. - :p character(len=*) str: LAMMPS input in string + :p character(len=\*) str: LAMMPS input in string -------- @@ -301,12 +301,12 @@ Procedures Bound to the lammps Derived Type This function will call :cpp:func:`lammps_get_thermo` and return the value of the corresponding thermodynamic keyword. - :p character(len=*) name: string with the name of the thermo keyword + :p character(len=\*) name: string with the name of the thermo keyword :r real(C_double): value of the requested thermo property or 0.0_C_double -------- -.. f:subroutine:: extract_box([boxlo][, boxhi][, xy][, yz][, xz][, pflag]s[, boxflag]) +.. f:subroutine:: extract_box([boxlo][, boxhi][, xy][, yz][, xz][, pflags][, boxflag]) This subroutine will call :cpp:func:`lammps_extract_box`. All parameters are optional, though obviously at least one should be present. The @@ -407,7 +407,7 @@ Procedures Bound to the lammps Derived Type Query LAMMPS about global settings. See the documentation for the :c:func:`lammps_extract_setting` function from the C library. - :p character(len=*) keyword: string containing the name of the thermo keyword + :p character(len=\*) keyword: string containing the name of the thermo keyword :r integer(c_int): value of the queried setting or :math:`-1` if unknown -------- @@ -463,7 +463,7 @@ Procedures Bound to the lammps Derived Type 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 extracted property + :p character(len=\*) name: string with the name of the extracted property :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 diff --git a/fortran/README b/fortran/README index 653b6a966e..57d163e197 100644 --- a/fortran/README +++ b/fortran/README @@ -3,9 +3,9 @@ and allows the LAMMPS library interface to be invoked from Fortran codes. 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 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 -are in the manual in the doc/html/pg_fortran.html file. +are in the manual in the doc/html/Fortran.html file. diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index ecef8c3e67..5916823df1 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -123,7 +123,7 @@ MODULE LIBLAMMPS IMPLICIT NONE INTEGER(c_int), VALUE, INTENT(IN) :: argc TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv - TYPE(c_ptr), VALUE, INTENT(in) :: handle + TYPE(c_ptr), VALUE, INTENT(IN) :: handle TYPE(c_ptr) :: lammps_open_no_mpi END FUNCTION lammps_open_no_mpi @@ -364,7 +364,7 @@ CONTAINS ! Constructor for the LAMMPS class. ! Combined wrapper around lammps_open_fortran() and lammps_open_no_mpi() TYPE(lammps) FUNCTION lmp_open(args, comm) - INTEGER, INTENT(in), OPTIONAL :: comm + INTEGER, INTENT(IN), OPTIONAL :: comm CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: args(:) TYPE(c_ptr), ALLOCATABLE :: argv(:) INTEGER(c_int) :: i, c_comm, argc @@ -436,7 +436,7 @@ CONTAINS ! equivalent function to lammps_commands_list() SUBROUTINE lmp_commands_list(self, cmds) CLASS(lammps) :: self - CHARACTER(len=*), INTENT(in), OPTIONAL :: cmds(:) + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cmds(:) TYPE(c_ptr), ALLOCATABLE :: cmdv(:) INTEGER :: i, ncmd From 72573987fa106689597057b6f8bc370d0f731384 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 14 Sep 2022 21:07:32 -0500 Subject: [PATCH 18/25] I wrote unit tests for all the Fortran interface commands in this pull request --- fortran/lammps.f90 | 466 +++++++++-------- unittest/fortran/CMakeLists.txt | 25 +- unittest/fortran/test_fortran_box.f90 | 142 +++++ unittest/fortran/test_fortran_commands.f90 | 1 + .../fortran/test_fortran_extract_global.f90 | 491 ++++++++++++++++++ unittest/fortran/test_fortran_get_thermo.f90 | 174 +++++++ unittest/fortran/test_fortran_properties.f90 | 52 ++ unittest/fortran/wrap_box.cpp | 64 +++ unittest/fortran/wrap_extract_global.cpp | 177 +++++++ unittest/fortran/wrap_get_thermo.cpp | 67 +++ unittest/fortran/wrap_properties.cpp | 109 ++++ 11 files changed, 1556 insertions(+), 212 deletions(-) create mode 100644 unittest/fortran/test_fortran_box.f90 create mode 100644 unittest/fortran/test_fortran_extract_global.f90 create mode 100644 unittest/fortran/test_fortran_get_thermo.f90 create mode 100644 unittest/fortran/test_fortran_properties.f90 create mode 100644 unittest/fortran/wrap_box.cpp create mode 100644 unittest/fortran/wrap_extract_global.cpp create mode 100644 unittest/fortran/wrap_get_thermo.cpp create mode 100644 unittest/fortran/wrap_properties.cpp diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 5916823df1..7541bf7c0f 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -19,19 +19,19 @@ ! Karl D. Hammond ! University of Missouri, 2012-2020 ! -! The Fortran module tries to follow the API of the C-library interface -! closely, but like the Python wrapper it employs an object oriented -! approach. To accommodate the object oriented approach, all exported -! subroutine and functions have to be implemented in Fortran to then -! call the interfaced C style functions with adapted calling conventions -! as needed. The C-library interfaced functions retain their names -! starting with "lammps_" while the Fortran versions start with "lmp_". +! The Fortran module tries to follow the API of the C library interface +! closely, but like the Python wrapper it employs an object-oriented +! approach. To accommodate the object-oriented approach, all exported +! subroutines and functions have to be implemented in Fortran and +! call the interfaced C-style functions with adapted calling conventions +! as needed. The C library interface functions retain their names +! starting with "lammps_", while the Fortran versions start with "lmp_". ! MODULE LIBLAMMPS USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_loc, & c_int, c_int64_t, c_char, c_null_char, c_double, c_size_t, c_f_pointer - USE, INTRINSIC :: ISO_Fortran_env, ONLY : ERROR_UNIT, OUTPUT_UNIT ! FIXME + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : ERROR_UNIT IMPLICIT NONE PRIVATE @@ -69,6 +69,7 @@ MODULE LIBLAMMPS PROCEDURE :: extract_setting => lmp_extract_setting PROCEDURE :: extract_global => lmp_extract_global PROCEDURE :: version => lmp_version + PROCEDURE :: is_running => lmp_is_running END TYPE lammps INTERFACE lammps @@ -104,257 +105,262 @@ 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_double_to_lammps_data, assign_doublevec_to_lammps_data, & assign_string_to_lammps_data END INTERFACE ! interface definitions for calling functions in library.cpp INTERFACE - FUNCTION lammps_open(argc, argv, comm) BIND(C,name='lammps_open_fortran') - IMPORT :: c_ptr, c_int - IMPLICIT NONE - INTEGER(c_int), VALUE, INTENT(IN) :: argc, comm - TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv - TYPE(c_ptr) :: lammps_open - END FUNCTION lammps_open + FUNCTION lammps_open(argc, argv, comm) BIND(C,name='lammps_open_fortran') + IMPORT :: c_ptr, c_int + IMPLICIT NONE + INTEGER(c_int), VALUE, INTENT(IN) :: argc, comm + TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv + TYPE(c_ptr) :: lammps_open + END FUNCTION lammps_open - FUNCTION lammps_open_no_mpi(argc, argv, handle) BIND(C) - IMPORT :: c_ptr, c_int - IMPLICIT NONE - INTEGER(c_int), VALUE, INTENT(IN) :: argc - TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv - TYPE(c_ptr), VALUE, INTENT(IN) :: handle - TYPE(c_ptr) :: lammps_open_no_mpi - END FUNCTION lammps_open_no_mpi + FUNCTION lammps_open_no_mpi(argc, argv, handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + INTEGER(c_int), VALUE, INTENT(IN) :: argc + TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv + TYPE(c_ptr), VALUE, INTENT(IN) :: handle + TYPE(c_ptr) :: lammps_open_no_mpi + END FUNCTION lammps_open_no_mpi - SUBROUTINE lammps_close(handle) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - END SUBROUTINE lammps_close + SUBROUTINE lammps_close(handle) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + END SUBROUTINE lammps_close - SUBROUTINE lammps_mpi_init() BIND(C) - END SUBROUTINE lammps_mpi_init + SUBROUTINE lammps_mpi_init() BIND(C) + END SUBROUTINE lammps_mpi_init - SUBROUTINE lammps_mpi_finalize() BIND(C) - END SUBROUTINE lammps_mpi_finalize + SUBROUTINE lammps_mpi_finalize() BIND(C) + END SUBROUTINE lammps_mpi_finalize - SUBROUTINE lammps_kokkos_finalize() BIND(C) - END SUBROUTINE lammps_kokkos_finalize + SUBROUTINE lammps_kokkos_finalize() BIND(C) + END SUBROUTINE lammps_kokkos_finalize - SUBROUTINE lammps_file(handle, filename) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: filename - END SUBROUTINE lammps_file + SUBROUTINE lammps_file(handle, filename) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), VALUE :: filename + END SUBROUTINE lammps_file - SUBROUTINE lammps_command(handle, cmd) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: cmd - END SUBROUTINE lammps_command + SUBROUTINE lammps_command(handle, cmd) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), 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), DIMENSION(*), INTENT(IN) :: cmds - END SUBROUTINE lammps_commands_list + 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), 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 - END SUBROUTINE lammps_commands_string + SUBROUTINE lammps_commands_string(handle, str) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), 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 - REAL(c_double) :: lammps_get_natoms - END FUNCTION lammps_get_natoms + FUNCTION lammps_get_natoms(handle) BIND(C) + IMPORT :: c_ptr, c_double + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + REAL(c_double) :: lammps_get_natoms + END FUNCTION lammps_get_natoms - FUNCTION lammps_get_thermo(handle,name) BIND(C) - IMPORT :: c_ptr, c_double - IMPLICIT NONE - REAL(c_double) :: lammps_get_thermo - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: name - END FUNCTION lammps_get_thermo + FUNCTION lammps_get_thermo(handle,name) BIND(C) + IMPORT :: c_ptr, c_double + IMPLICIT NONE + REAL(c_double) :: lammps_get_thermo + TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), 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 - END SUBROUTINE lammps_extract_box + 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 + 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 - END SUBROUTINE lammps_reset_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 + 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 - END SUBROUTINE lammps_memory_usage + 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 + 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 - INTEGER(c_int) :: lammps_get_mpi_comm - END FUNCTION lammps_get_mpi_comm + FUNCTION lammps_get_mpi_comm(handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), 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 - INTEGER(c_int) :: lammps_extract_setting - END FUNCTION lammps_extract_setting + FUNCTION lammps_extract_setting(handle,keyword) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), 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 - INTEGER(c_int) :: lammps_extract_global_datatype - END FUNCTION lammps_extract_global_datatype + FUNCTION lammps_extract_global_datatype(handle,name) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), 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) :: str - INTEGER(c_size_t) :: c_strlen - END FUNCTION c_strlen + FUNCTION c_strlen (str) BIND(C,name='strlen') + IMPORT :: c_ptr, c_size_t + IMPLICIT NONE + TYPE(c_ptr), 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) :: lammps_extract_global - END FUNCTION lammps_extract_global + FUNCTION lammps_extract_global(handle, name) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, name + TYPE(c_ptr) :: lammps_extract_global + END FUNCTION lammps_extract_global - !INTEGER (c_int) FUNCTION lammps_extract_atom_datatype + !INTEGER (c_int) FUNCTION lammps_extract_atom_datatype - !(generic) lammps_extract_atom + !(generic) lammps_extract_atom - !(generic) lammps_extract_compute + !(generic) lammps_extract_compute - !(generic) lammps_extract_fix + !(generic) lammps_extract_fix - !(generic) lammps_extract_variable + !(generic) lammps_extract_variable - !INTEGER (c_int) lammps_set_variable + !INTEGER (c_int) lammps_set_variable - !SUBROUTINE lammps_gather_atoms + !SUBROUTINE lammps_gather_atoms - !SUBROUTINE lammps_gather_atoms_concat + !SUBROUTINE lammps_gather_atoms_concat - !SUBROUTINE lammps_gather_atoms_subset + !SUBROUTINE lammps_gather_atoms_subset - !SUBROUTINE lammps_scatter_atoms + !SUBROUTINE lammps_scatter_atoms - !SUBROUTINE lammps_scatter_atoms_subset + !SUBROUTINE lammps_scatter_atoms_subset - !SUBROUTINE lammps_gather_bonds + !SUBROUTINE lammps_gather_bonds - !SUBROUTINE lammps_gather + !SUBROUTINE lammps_gather - !SUBROUTINE lammps_gather_concat + !SUBROUTINE lammps_gather_concat - !SUBROUTINE lammps_gather_subset + !SUBROUTINE lammps_gather_subset - !SUBROUTINE lammps_scatter_subset + !SUBROUTINE lammps_scatter_subset - !(generic / id, type, and image are special) / requires LAMMPS_BIGBIG - !INTEGER (C_int) FUNCTION lammps_create_atoms + !(generic / id, type, and image are special) / requires LAMMPS_BIGBIG + !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 + !SUBROUTINE lammps_neighlist_element_neighbors - FUNCTION lammps_version(handle) BIND(C) - IMPORT :: c_ptr, c_int - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - INTEGER(c_int) :: lammps_version - END FUNCTION lammps_version + FUNCTION lammps_version(handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + INTEGER(c_int) :: lammps_version + END FUNCTION lammps_version - !SUBROUTINE lammps_get_os_info + !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 + !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 - !LOGICAL FUNCTION lammps_config_accelerator - !LOGICAL FUNCTION lammps_has_gpu_device - !SUBROUTINE lammps_get_gpu_device + !LOGICAL FUNCTION lammps_config_accelerator + !LOGICAL FUNCTION lammps_has_gpu_device + !SUBROUTINE lammps_get_gpu_device - !LOGICAL FUNCTION lammps_has_id - !INTEGER (C_int) FUNCTION lammps_id_count - !SUBROUTINE lammps_id_name + !LOGICAL FUNCTION lammps_has_id + !INTEGER (C_int) FUNCTION lammps_id_count + !SUBROUTINE lammps_id_name - !INTEGER (C_int) FUNCTION lammps_plugin_count - !SUBROUTINE lammps_plugin_name + !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 - !SUBROUTINE lammps_decode_image_flags + !Both of these use LAMMPS_BIGBIG + !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) (:) + !SUBROUTINE lammps_set_fix_external_callback ! may have trouble.... + !FUNCTION lammps_fix_external_get_force() ! returns real(c_double) (:) - !SUBROUTINE lammps_fix_external_set_energy_global - !SUBROUTINE lammps_fix_external_set_energy_peratom - !SUBROUTINE lammps_fix_external_set_virial_global - !SUBROUTINE lammps_fix_external_set_virial_peratom - !SUBROUTINE lammps_fix_external_set_vector_length - !SUBROUTINE lammps_fix_external_set_vector + !SUBROUTINE lammps_fix_external_set_energy_global + !SUBROUTINE lammps_fix_external_set_energy_peratom + !SUBROUTINE lammps_fix_external_set_virial_global + !SUBROUTINE lammps_fix_external_set_virial_peratom + !SUBROUTINE lammps_fix_external_set_vector_length + !SUBROUTINE lammps_fix_external_set_vector - !SUBROUTINE lammps_flush_buffers + !SUBROUTINE lammps_flush_buffers - 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 + 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 - SUBROUTINE lammps_free(ptr) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: ptr - END SUBROUTINE lammps_free + SUBROUTINE lammps_free(ptr) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: ptr + END SUBROUTINE lammps_free - !LOGICAL FUNCTION lammps_is_running + INTEGER(c_int) FUNCTION lammps_is_running(handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + END FUNCTION lammps_is_running - !SUBROUTINE lammps_force_timeout + !SUBROUTINE lammps_force_timeout - !LOGICAL FUNCTION lammps_has_error + !LOGICAL FUNCTION lammps_has_error - !INTEGER (c_int) FUNCTION lammps_get_last_error_message + !INTEGER (c_int) FUNCTION lammps_get_last_error_message END INTERFACE @@ -558,7 +564,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) :: self CHARACTER(LEN=*), INTENT(IN) :: name TYPE(lammps_data) :: global_data @@ -622,7 +628,7 @@ CONTAINS CASE DEFAULT WRITE(ERROR_UNIT,'(A)') 'ERROR: Unknown pointer type in& & extract_global' - STOP + STOP 2 END SELECT END FUNCTION @@ -633,6 +639,13 @@ 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) :: 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 ! ---------------------------------------------------------------------- @@ -643,8 +656,7 @@ CONTAINS IF ( rhs%datatype == DATA_INT ) THEN lhs => rhs%i32 ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'scalar int') END IF END SUBROUTINE assign_int_to_lammps_data @@ -655,11 +667,21 @@ CONTAINS IF ( rhs%datatype == DATA_INT64 ) THEN lhs => rhs%i64 ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'scalar long int') END IF END SUBROUTINE assign_int64_to_lammps_data + SUBROUTINE assign_intvec_to_lammps_data (lhs, rhs) + INTEGER(c_int), DIMENSION(:), INTENT(OUT), POINTER :: lhs + CLASS(lammps_data), INTENT(IN) :: rhs + + IF ( rhs%datatype == DATA_INT_1D ) THEN + lhs => rhs%i32_vec + ELSE + CALL assignment_error(rhs%datatype, 'vector of ints') + END IF + END SUBROUTINE assign_intvec_to_lammps_data + SUBROUTINE assign_double_to_lammps_data (lhs, rhs) REAL(c_double), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs @@ -667,8 +689,7 @@ CONTAINS IF ( rhs%datatype == DATA_DOUBLE ) THEN lhs => rhs%r64 ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'scalar double') END IF END SUBROUTINE assign_double_to_lammps_data @@ -679,8 +700,7 @@ CONTAINS IF ( rhs%datatype == DATA_DOUBLE_1D ) THEN lhs => rhs%r64_vec ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'vector of doubles') END IF END SUBROUTINE assign_doublevec_to_lammps_data @@ -691,11 +711,41 @@ CONTAINS IF ( rhs%datatype == DATA_STRING ) THEN lhs = rhs%str ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'string') END IF END SUBROUTINE assign_string_to_lammps_data + SUBROUTINE assignment_error (type1, type2) + INTEGER (c_int) :: type1 + CHARACTER (LEN=*) :: type2 + INTEGER, PARAMETER :: ERROR_CODE = 1 + CHARACTER (LEN=:), ALLOCATABLE :: str1 + + SELECT CASE (type1) + CASE (DATA_INT) + str1 = 'scalar int' + CASE (DATA_INT_1D) + str1 = 'vector of ints' + CASE (DATA_INT_2D) + str1 = 'matrix of ints' + CASE (DATA_INT64) + str1 = 'scalar long int' + CASE (DATA_INT64_1D) + str1 = 'vector of long ints' + CASE (DATA_INT64_2D) + str1 = 'matrix of long ints' + CASE (DATA_DOUBLE) + str1 = 'scalar double' + CASE (DATA_DOUBLE_1D) + str1 = 'vector of doubles' + CASE (DATA_DOUBLE_2D) + str1 = 'matrix of doubles' + CASE DEFAULT + str1 = 'that type' + END SELECT + WRITE (ERROR_UNIT,'(A)') 'Cannot associate ' // str1 // ' with ' // type2 + STOP ERROR_CODE + END SUBROUTINE assignment_error ! ---------------------------------------------------------------------- ! local helper functions diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index c7174d8e6e..c2bea82480 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -6,14 +6,14 @@ endif() include(CheckLanguage) check_language(Fortran) -if(NOT CMAKE_Fortran_COMPILER_ID) - message(STATUS "Skipping Tests for the LAMMPS Fortran Module: cannot identify Fortran compiler") - return() -endif() if(CMAKE_Fortran_COMPILER) enable_language(C) enable_language(Fortran) + if(NOT CMAKE_Fortran_COMPILER_ID) + message(STATUS "Skipping Tests for the LAMMPS Fortran Module: cannot identify Fortran compiler") + return() + endif() get_filename_component(LAMMPS_FORTRAN_MODULE ${LAMMPS_SOURCE_DIR}/../fortran/lammps.f90 ABSOLUTE) if(BUILD_MPI) find_package(MPI REQUIRED) @@ -40,6 +40,23 @@ if(CMAKE_Fortran_COMPILER) add_executable(test_fortran_commands wrap_commands.cpp test_fortran_commands.f90) target_link_libraries(test_fortran_commands PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) add_test(NAME FortranCommands COMMAND test_fortran_commands) + + add_executable(test_fortran_get_thermo wrap_get_thermo.cpp test_fortran_get_thermo.f90) + target_link_libraries(test_fortran_get_thermo PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranGetThermo COMMAND test_fortran_get_thermo) + + add_executable(test_fortran_box wrap_box.cpp test_fortran_box.f90) + target_link_libraries(test_fortran_box PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + 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) + add_test(NAME FortranProperties COMMAND test_fortran_properties) + + add_executable(test_fortran_extract_global wrap_extract_global.cpp test_fortran_extract_global.f90) + target_link_libraries(test_fortran_extract_global PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranExtractGlobal COMMAND test_fortran_extract_global) + else() message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler") endif() diff --git a/unittest/fortran/test_fortran_box.f90 b/unittest/fortran/test_fortran_box.f90 new file mode 100644 index 0000000000..c21918afd0 --- /dev/null +++ b/unittest/fortran/test_fortran_box.f90 @@ -0,0 +1,142 @@ +MODULE keepbox + USE liblammps + IMPLICIT NONE + TYPE(LAMMPS) :: lmp + 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(2), PARAMETER :: cont_input = & + [ CHARACTER(len=40) :: & + 'create_atoms 1 single &', & + ' 0.2 0.1 0.1' ] +END MODULE keepbox + +FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") + USE ISO_C_BINDING, ONLY: c_ptr + USE liblammps + USE keepbox, 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 keepbox, ONLY: lmp + IMPLICIT NONE + + CALL lmp%close() + lmp%handle = c_null_ptr +END SUBROUTINE f_lammps_close + +SUBROUTINE f_lammps_box_setup () BIND(C) + USE liblammps + USE keepbox, ONLY : lmp, demo_input + IMPLICIT NONE + + CALL lmp%commands_list(demo_input) +END SUBROUTINE f_lammps_box_setup + +SUBROUTINE f_lammps_delete_everything() BIND(C) + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + + CALL lmp%command("delete_atoms group all"); +END SUBROUTINE f_lammps_delete_everything + +FUNCTION f_lammps_extract_box_xlo () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: newlo(3), newhi(3), xy, yz, xz + + xy = 0.0_c_double + yz = 0.0_c_double + xz = 0.0_c_double + newlo = [-1.0_c_double, -1.0_c_double, -1.0_c_double] + newhi = [3.0_c_double, 3.0_c_double, 3.0_c_double] + CALL lmp%reset_box(newlo, newhi, xy, yz, xz) +END SUBROUTINE f_lammps_reset_box_2x diff --git a/unittest/fortran/test_fortran_commands.f90 b/unittest/fortran/test_fortran_commands.f90 index b5cffe698f..d85b0f183e 100644 --- a/unittest/fortran/test_fortran_commands.f90 +++ b/unittest/fortran/test_fortran_commands.f90 @@ -1,5 +1,6 @@ MODULE keepcmds USE liblammps + IMPLICIT NONE TYPE(LAMMPS) :: lmp CHARACTER(len=40), DIMENSION(3), PARAMETER :: demo_input = & [ CHARACTER(len=40) :: & diff --git a/unittest/fortran/test_fortran_extract_global.f90 b/unittest/fortran/test_fortran_extract_global.f90 new file mode 100644 index 0000000000..9a8552d677 --- /dev/null +++ b/unittest/fortran/test_fortran_extract_global.f90 @@ -0,0 +1,491 @@ +MODULE keepglobal + 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 1.0' ] +END MODULE keepglobal + +FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") + USE ISO_C_BINDING, ONLY: c_ptr + USE liblammps + USE keepglobal, 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 keepglobal, ONLY: lmp + IMPLICIT NONE + + CALL lmp%close() + lmp%handle = c_null_ptr +END SUBROUTINE f_lammps_close + +SUBROUTINE f_lammps_setup_extract_global () BIND(C) + USE LIBLAMMPS + USE keepglobal, 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_global + +SUBROUTINE f_lammps_setup_full_extract_global () BIND(C) + USE LIBLAMMPS + USE keepglobal, ONLY : lmp + IMPLICIT NONE + INTERFACE + SUBROUTINE f_lammps_setup_extract_global () BIND(C) + END SUBROUTINE f_lammps_setup_extract_global + END INTERFACE + + CALL lmp%command('atom_style full') + CALL f_lammps_setup_extract_global + CALL lmp%command('bond_style zero') + CALL lmp%command('angle_style zero') + CALL lmp%command('dihedral_style zero') + 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 + USE LIBLAMMPS + USE keepglobal, ONLY : lmp + IMPLICIT NONE + 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 + ELSE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + 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 + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: fs + REAL (C_double), POINTER :: femtosecond + + femtosecond = lmp%extract_global("femtosecond") + fs = femtosecond +END FUNCTION f_lammps_extract_global_femtosecond diff --git a/unittest/fortran/test_fortran_get_thermo.f90 b/unittest/fortran/test_fortran_get_thermo.f90 new file mode 100644 index 0000000000..e96c964e7c --- /dev/null +++ b/unittest/fortran/test_fortran_get_thermo.f90 @@ -0,0 +1,174 @@ +MODULE keepthermo + 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(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 1.0' ] +END MODULE keepthermo + +FUNCTION f_lammps_with_args() BIND(C) + USE ISO_C_BINDING, ONLY: c_ptr + USE liblammps + USE keepthermo, 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 keepthermo, ONLY: lmp + IMPLICIT NONE + + CALL lmp%close() + lmp%handle = c_null_ptr +END SUBROUTINE f_lammps_close + +SUBROUTINE f_lammps_get_thermo_setup () BIND(C) + USE liblammps + USE keepthermo, 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) +END SUBROUTINE f_lammps_get_thermo_setup + +FUNCTION f_lammps_get_thermo_natoms () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + 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 new file mode 100644 index 0000000000..00e083b301 --- /dev/null +++ b/unittest/fortran/test_fortran_properties.f90 @@ -0,0 +1,52 @@ +FUNCTION f_lammps_version () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE liblammps + USE keepcmds, ONLY : lmp + IMPLICIT NONE + 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 + USE liblammps + USE keepcmds, ONLY : lmp + IMPLICIT NONE + 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 + USE liblammps + USE keepcmds, ONLY : lmp + IMPLICIT NONE + 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 + USE keepcmds, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int) :: f_lammps_extract_setting + CHARACTER (KIND=C_char, LEN=1), DIMENSION(*), INTENT(IN) :: Cstr + INTEGER :: strlen, i + CHARACTER (LEN=:), ALLOCATABLE :: Fstr + + i = 1 + DO WHILE (Cstr(i) /= ACHAR(0)) + i = i + 1 + END DO + strlen = i + allocate ( CHARACTER(LEN=strlen) :: Fstr) + FORALL (i=1:strlen) + Fstr(i:i) = Cstr(i) + END FORALL + f_lammps_extract_setting = lmp%extract_setting(Fstr) + deallocate (Fstr) +END FUNCTION f_lammps_extract_setting diff --git a/unittest/fortran/wrap_box.cpp b/unittest/fortran/wrap_box.cpp new file mode 100644 index 0000000000..8678816658 --- /dev/null +++ b/unittest/fortran/wrap_box.cpp @@ -0,0 +1,64 @@ +// unit tests for extracting box dimensions fom a LAMMPS instance through the Fortran wrapper + +#include "lammps.h" +#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_box_setup(); +double f_lammps_extract_box_xlo(); +double f_lammps_extract_box_xhi(); +double f_lammps_extract_box_ylo(); +double f_lammps_extract_box_yhi(); +double f_lammps_extract_box_zlo(); +double f_lammps_extract_box_zhi(); +void f_lammps_delete_everything(); +void f_lammps_reset_box_2x(); +} + +class LAMMPS_commands : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_commands() = default; + ~LAMMPS_commands() 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_commands, get_thermo) +{ + f_lammps_box_setup(); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_xlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_xhi(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_ylo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_yhi(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_zlo(), 0.0); + 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_xhi(), 3.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_zhi(), 3.0); +}; diff --git a/unittest/fortran/wrap_extract_global.cpp b/unittest/fortran/wrap_extract_global.cpp new file mode 100644 index 0000000000..adf3986073 --- /dev/null +++ b/unittest/fortran/wrap_extract_global.cpp @@ -0,0 +1,177 @@ +// unit tests for extracting global 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_global(); +void f_lammps_setup_full_extract_global(); +int f_lammps_extract_global_units(); +int f_lammps_extract_global_ntimestep(); +int64_t f_lammps_extract_global_ntimestep_big(); +double f_lammps_extract_global_dt(); +void f_lammps_extract_global_boxlo(double[3]); +void f_lammps_extract_global_boxhi(double[3]); +double f_lammps_extract_global_boxxlo(); +double f_lammps_extract_global_boxylo(); +double f_lammps_extract_global_boxzlo(); +double f_lammps_extract_global_boxxhi(); +double f_lammps_extract_global_boxyhi(); +double f_lammps_extract_global_boxzhi(); +void f_lammps_extract_global_periodicity(int[3]); +int f_lammps_extract_global_triclinic(); +double f_lammps_extract_global_xy(); +double f_lammps_extract_global_yz(); +double f_lammps_extract_global_xz(); +int f_lammps_extract_global_natoms(); +int64_t f_lammps_extract_global_natoms_big(); +int f_lammps_extract_global_nbonds(); +int64_t f_lammps_extract_global_nbonds_big(); +int f_lammps_extract_global_nangles(); +int64_t f_lammps_extract_global_nangles_big(); +int f_lammps_extract_global_ndihedrals(); +int64_t f_lammps_extract_global_ndihedrals_big(); +int f_lammps_extract_global_nimpropers(); +int64_t f_lammps_extract_global_nimpropers_big(); +int f_lammps_extract_global_ntypes(); +int f_lammps_extract_global_nlocal(); +int f_lammps_extract_global_nghost(); +int f_lammps_extract_global_nmax(); +double f_lammps_extract_global_boltz(); +double f_lammps_extract_global_hplanck(); +double f_lammps_extract_global_angstrom(); +double f_lammps_extract_global_femtosecond(); +} + +class LAMMPS_extract_global : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_extract_global() = default; + ~LAMMPS_extract_global() 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_global, units) +{ + f_lammps_setup_extract_global(); + EXPECT_EQ(f_lammps_extract_global_units(), 1); +}; + +TEST_F(LAMMPS_extract_global, ntimestep) +{ + f_lammps_setup_extract_global(); +#ifdef LAMMPS_SMALLSMALL + EXPECT_EQ(f_lammps_extract_global_ntimestep(), 0); +#else + 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); +}; + +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); + + 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); + + 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); +}; + +TEST_F(LAMMPS_extract_global, atomprops) +{ + 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); +#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); +#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_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); +}; + +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(); +#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); +#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); +#endif +} diff --git a/unittest/fortran/wrap_get_thermo.cpp b/unittest/fortran/wrap_get_thermo.cpp new file mode 100644 index 0000000000..71b51609eb --- /dev/null +++ b/unittest/fortran/wrap_get_thermo.cpp @@ -0,0 +1,67 @@ +// unit tests for getting thermodynamic output from a LAMMPS instance through the Fortran wrapper + +#include "lammps.h" +#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_get_thermo_setup(); +double f_lammps_get_thermo_natoms(); +double f_lammps_get_thermo_dt(); +double f_lammps_get_thermo_vol(); +double f_lammps_get_thermo_lx(); +double f_lammps_get_thermo_ly(); +double f_lammps_get_thermo_lz(); +double f_lammps_get_thermo_xlo(); +double f_lammps_get_thermo_xhi(); +double f_lammps_get_thermo_ylo(); +double f_lammps_get_thermo_yhi(); +double f_lammps_get_thermo_zlo(); +double f_lammps_get_thermo_zhi(); +} + +class LAMMPS_thermo : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_thermo() = default; + ~LAMMPS_thermo() 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_thermo, get_thermo) +{ + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_natoms(), 0.0); + f_lammps_get_thermo_setup(); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_natoms(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_dt(), 0.005); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_vol(), 24.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_lx(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_ly(), 3.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_lz(), 4.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_xlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_xhi(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_ylo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_yhi(), 3.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_zlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_zhi(), 4.0); +}; diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp new file mode 100644 index 0000000000..8ecd9346dc --- /dev/null +++ b/unittest/fortran/wrap_properties.cpp @@ -0,0 +1,109 @@ +// unit tests for getting LAMMPS properties through the Fortran wrapper + +#include "lammps.h" +//#include // for stdin, stdout +#include "library.h" +#include +#include + +#include "gtest/gtest.h" + +// prototypes for fortran reverse wrapper functions +extern "C" { +void *f_lammps_with_args(); +void f_lammps_close(); +int f_lammps_version(); +void f_lammps_memory_usage(double*); +int f_lammps_get_mpi_comm(); +int f_lammps_extract_setting(const char*); +} + +class LAMMPS_properties : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_properties() = default; + ~LAMMPS_properties() 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_properties, version) +{ + EXPECT_LT(20200917, f_lammps_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); +#if defined(__linux__) || defined(_WIN32) + EXPECT_GE(meminfo[1], 0.0); +#endif +#if (defined(__linux__) || defined(__APPLE__) || defined(_WIN32)) && !defined(__INTEL_LLVM_COMPILER) + EXPECT_GT(meminfo[2], 0.0); +#endif +}; + +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); +}; + +TEST_F(LAMMPS_properties, extract_setting) +{ +#if defined(LAMMPS_SMALLSMALL) + EXPECT_EQ(f_lammps_extract_setting("bigint"), 4); +#else + EXPECT_EQ(f_lammps_extract_setting("bigint"), 8); +#endif +#if defined(LAMMPS_BIGBIG) + EXPECT_EQ(f_lammps_extract_setting("tagint"), 8); + EXPECT_EQ(f_lammps_extract_setting("imageint"), 8); +#else + EXPECT_EQ(f_lammps_extract_setting("tagint"), 4); + EXPECT_EQ(f_lammps_extract_setting("imageint"), 4); +#endif + + EXPECT_EQ(f_lammps_extract_setting("box_exist"), 0); + EXPECT_EQ(f_lammps_extract_setting("dimension"), 3); + EXPECT_EQ(f_lammps_extract_setting("world_size"), 1); + EXPECT_EQ(f_lammps_extract_setting("world_rank"), 0); + EXPECT_EQ(f_lammps_extract_setting("universe_size"), 1); + EXPECT_EQ(f_lammps_extract_setting("universe_rank"), 0); + EXPECT_GT(f_lammps_extract_setting("nthreads"), 0); + EXPECT_EQ(f_lammps_extract_setting("newton_pair"), 1); + EXPECT_EQ(f_lammps_extract_setting("newton_bond"), 1); + + EXPECT_EQ(f_lammps_extract_setting("ntypes"), 0); + EXPECT_EQ(f_lammps_extract_setting("nbondtypes"), 0); + EXPECT_EQ(f_lammps_extract_setting("nangletypes"), 0); + EXPECT_EQ(f_lammps_extract_setting("ndihedraltypes"), 0); + EXPECT_EQ(f_lammps_extract_setting("nimpropertypes"), 0); + + EXPECT_EQ(f_lammps_extract_setting("molecule_flag"), 0); + EXPECT_EQ(f_lammps_extract_setting("q_flag"), 0); + 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); + +}; From e4575aec3cbb8168cfd0c13eabe0863ad86c7a78 Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Wed, 14 Sep 2022 21:14:13 -0500 Subject: [PATCH 19/25] One fix after running fix-whitespace --- 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 0db5f8f097..28436c813f 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -221,7 +221,7 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS. communicator, such as in .. code-block:: Fortran - + PROGRAM testmpi USE LIBLAMMPS USE MPI_F08 @@ -312,7 +312,7 @@ Procedures Bound to the lammps Derived Type are optional, though obviously at least one should be present. The parameters *pflags* and *boxflag* are stored in LAMMPS as integers, but should be declared as ``LOGICAL`` variables when calling from Fortran. - + :o real(c_double) boxlo [dimension(3),optional]: vector in which to store lower-bounds of simulation box :o real(c_double) boxhi [dimension(3),optional]: vector in which to store From 6532640362cd7b2a38b9d9f023f3574cfe17cb4e Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 23 Sep 2022 10:23:32 -0400 Subject: [PATCH 20/25] spelling --- doc/src/Fortran.rst | 6 +++--- doc/utils/sphinx-config/false_positives.txt | 1 + 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 28436c813f..b9c1d24ad9 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -330,7 +330,7 @@ Procedures Bound to the lammps Derived Type Note that a frequent use case of this function is to extract only one or more of the options rather than all seven. For example, assuming "lmp" - represents a properly-initalized LAMMPS instance, the following code will + represents a properly-initialized LAMMPS instance, the following code will extract the periodic box settings into the variable "periodic": .. code-block:: Fortran @@ -378,7 +378,7 @@ Procedures Bound to the lammps Derived Type .. note:: The C library interface currently returns type "int" instead of type - "MPI_Fint", which is the C type correspending to Fortran "INTEGER" + "MPI_Fint", which is the C type corresponding to Fortran "INTEGER" types of the default kind. On most compilers, these are the same anyway, but this interface exchanges values this way to avoid warning messages. @@ -465,7 +465,7 @@ Procedures Bound to the lammps Derived Type :p character(len=\*) name: string with the name of the extracted property :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 + should be either a string (if expecting string data) or a C-compatible pointer (e.g., ``INTEGER (c_int), POINTER :: nlocal``) to the extracted property. If expecting vector data, the pointer should have dimension ":". diff --git a/doc/utils/sphinx-config/false_positives.txt b/doc/utils/sphinx-config/false_positives.txt index 15316b4f09..937836a9b9 100644 --- a/doc/utils/sphinx-config/false_positives.txt +++ b/doc/utils/sphinx-config/false_positives.txt @@ -1081,6 +1081,7 @@ filesystems Fily Fincham Finchham +Fint fingerprintconstants fingerprintsperelement Finnis From 2a14397318db438df4600241d54ec31ed0edcdd6 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 23 Sep 2022 10:41:21 -0400 Subject: [PATCH 21/25] fix broken link --- 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 b9c1d24ad9..aa599a3dbd 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -122,8 +122,8 @@ 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 `C-library -` interface. Before handing off the calls to the +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 (: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 From d9e2be4b75a112d65fc4af1b9f1eb82dc687d695 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 23 Sep 2022 12:41:31 -0400 Subject: [PATCH 22/25] updates to the fortran module docs to make it more consistent, fix links, add example similar to C library docs --- doc/src/Fortran.rst | 185 +++++++++++++------- doc/src/Library_properties.rst | 30 ++-- doc/utils/sphinx-config/false_positives.txt | 1 + 3 files changed, 142 insertions(+), 74 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index aa599a3dbd..2dd04439a1 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -3,7 +3,9 @@ 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. +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. While C libraries have a defined binary interface (ABI) and can thus be used from multiple compiler versions from different vendors for as long @@ -19,12 +21,20 @@ for a simple program using the Fortran interface would be: 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. Please also note the -order of the source files: the ``lammps.f90`` file needs to be compiled -first, since it provides the ``LIBLAMMPS`` module that is imported by -the Fortran code using the interface. A working example code can be -found together with equivalent examples in C and C++ in the -``examples/COUPLE/simple`` folder of the LAMMPS distribution. +calling the library from an MPI parallel code. 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 +configured and whether the LAMMPS library :doc:`was compiled as a static +or shared library `. + +If the LAMMPS library itself has been compiled with MPI support, the +resulting executable will still be able to run LAMMPS in parallel with +``mpirun`` or equivalent. Please also note that the order of the source +files matters: the ``lammps.f90`` file needs to be compiled first, since +it provides the ``LIBLAMMPS`` module that is imported by the Fortran +code using the interface. A working example code can be found together +with equivalent examples in C and C++ in the ``examples/COUPLE/simple`` +folder of the LAMMPS distribution. .. versionadded:: 9Oct2020 @@ -57,9 +67,10 @@ 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, -if it is needed. Similarly, a possible call to :cpp:func:`lammps_finalize` -is integrated into the :f:func:`close` function and triggered with -the optional logical argument set to ``.true.``. Here is a simple example: +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: .. code-block:: fortran @@ -81,10 +92,10 @@ the optional logical argument set to ``.true.``. Here is a simple example: It is also possible to pass command line flags from Fortran to C/C++ and thus make the resulting executable behave similarly to the standalone -executable (it will ignore the `-in/-i` flag, though). This allows one to -use the command line to configure accelerator and suffix settings, +executable (it will ignore the `-in/-i` flag, though). This allows +using the command line to configure accelerator and suffix settings, configure screen and logfile output, or to set index style variables -from the command line and more. Here is a correspondingly adapted +from the command line and more. Here is a correspondingly adapted version of the previous example: .. code-block:: fortran @@ -165,6 +176,57 @@ 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 +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. + +Below is an example demonstrating some of the possible uses. + +.. code-block:: fortran + + 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 + + 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. ', & + 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 + CALL lmp%command('run 2 post no') + + WRITE(6,'(A,I4)') '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 + +--------------- + The ``LIBLAMMPS`` module API **************************** @@ -292,7 +354,7 @@ Procedures Bound to the lammps Derived Type This function will call :cpp:func:`lammps_get_natoms` and return the number of atoms in the system. - :r real(C_double): number of atoms + :r real(c_double): number of atoms -------- @@ -302,16 +364,17 @@ Procedures Bound to the lammps Derived Type of the corresponding thermodynamic keyword. :p character(len=\*) name: string with the name of the thermo keyword - :r real(C_double): value of the requested thermo property or 0.0_C_double + :r real(c_double): value of the requested thermo property or `0.0_c_double` -------- .. f:subroutine:: extract_box([boxlo][, boxhi][, xy][, yz][, xz][, pflags][, boxflag]) - This subroutine will call :cpp:func:`lammps_extract_box`. All parameters - are optional, though obviously at least one should be present. The - parameters *pflags* and *boxflag* are stored in LAMMPS as integers, but - should be declared as ``LOGICAL`` variables when calling from Fortran. + This subroutine will call :cpp:func:`lammps_extract_box`. All + parameters are optional, though obviously at least one should be + present. The parameters *pflags* and *boxflag* are stored in LAMMPS + as integers, but should be declared as ``LOGICAL`` variables when + calling from Fortran. :o real(c_double) boxlo [dimension(3),optional]: vector in which to store lower-bounds of simulation box @@ -377,17 +440,18 @@ Procedures Bound to the lammps Derived Type .. note:: - The C library interface currently returns type "int" instead of type - "MPI_Fint", which is the C type corresponding to Fortran "INTEGER" - types of the default kind. On most compilers, these are the same anyway, - but this interface exchanges values this way to avoid warning messages. + The C library interface currently returns type ``int`` instead of + type ``MPI_Fint``, which is the C type corresponding to Fortran + ``INTEGER`` types of the default kind. On most compilers, these + are the same anyway, but this interface exchanges values this way + to avoid warning messages. .. note:: - 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, + 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, .. code-block:: fortran @@ -398,14 +462,14 @@ Procedures Bound to the lammps Derived Type ! ... [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. -------- .. f:function:: extract_setting(keyword) Query LAMMPS about global settings. See the documentation for the - :c:func:`lammps_extract_setting` function from the C library. + :cpp:func:`lammps_extract_setting` function from the C library. :p character(len=\*) keyword: string containing the name of the thermo keyword :r integer(c_int): value of the queried setting or :math:`-1` if unknown @@ -414,35 +478,36 @@ Procedures Bound to the lammps Derived Type .. f:function:: extract_global(name) - This function calls :c:func:`lammps_extract_global` and returns either a - string or a pointer to internal global LAMMPS data, depending on the data - requested through *name*. + This function calls :cpp:func:`lammps_extract_global` and returns + either a string or a pointer to internal global LAMMPS data, + depending on the data requested through *name*. 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 (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. - 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 - it is not necessary to call the function again, unless a :doc:`clear` - command has been issued, which wipes out and recreates the contents of - the :cpp:class:`LAMMPS ` class. + 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. 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 it is not necessary to + call the function again, unless a :doc:`clear` command has been + issued, which wipes out and recreates the contents of the + :cpp:class:`LAMMPS ` class. For example, .. code-block:: fortran PROGRAM demo - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + 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 + INTEGER(c_int64_t), POINTER :: ntimestep CHARACTER(LEN=10) :: units - REAL(C_double), POINTER :: dt + REAL(c_double), POINTER :: dt lmp = lammps() ! other commands nlocal = lmp%extract_global('nlocal') @@ -457,11 +522,13 @@ 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:: + + 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. :p character(len=\*) name: string with the name of the extracted property :r polymorphic: pointer to LAMMPS data. The left-hand side of the assignment @@ -469,11 +536,11 @@ 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 or - crashes or bogus simulations. In general it is thus usually better - to use a LAMMPS input command that sets or changes these parameters. - Those will take care of all side effects and necessary updates of - settings derived from such settings. + Modifying the data in the location pointed to by the returned pointer + may lead to inconsistent internal data and thus may cause failures or + crashes or bogus simulations. In general it is thus usually better + to use a LAMMPS input command that sets or changes these parameters. + Those will take care of all side effects and necessary updates of + settings derived from such settings. diff --git a/doc/src/Library_properties.rst b/doc/src/Library_properties.rst index e023c78185..a5c9c79c64 100644 --- a/doc/src/Library_properties.rst +++ b/doc/src/Library_properties.rst @@ -15,21 +15,21 @@ This section documents the following functions: -------------------- -The library interface allows extraction of different kinds of -information about the active simulation instance and also -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 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 indexed -accordingly. Per-atom data can change sizes and ordering at every -neighbor list rebuild or atom sort event as atoms migrate between +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 +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 +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 +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. .. code-block:: C diff --git a/doc/utils/sphinx-config/false_positives.txt b/doc/utils/sphinx-config/false_positives.txt index 937836a9b9..aba474d257 100644 --- a/doc/utils/sphinx-config/false_positives.txt +++ b/doc/utils/sphinx-config/false_positives.txt @@ -1094,6 +1094,7 @@ flagHI flaglog flagN flagVF +flang fld floralwhite Florez From 86d1aacf7ed750bda61b2917dd42fc7067ec4184 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 23 Sep 2022 16:28:15 -0400 Subject: [PATCH 23/25] add function to dispatch LAMMPS errors to library interfaces --- doc/src/Fortran.rst | 17 +++++++- doc/src/Library_create.rst | 6 +++ fortran/lammps.f90 | 52 ++++++++++++++---------- python/lammps/constants.py | 44 +++++++++++--------- python/lammps/core.py | 26 +++++++++++- src/library.cpp | 83 ++++++++++++++++++++++++++++++++++++++ src/library.h | 14 +++++++ 7 files changed, 197 insertions(+), 45 deletions(-) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 2dd04439a1..e15555bc4e 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -128,7 +128,7 @@ version of the previous example: -------------------- 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 @@ -177,7 +177,7 @@ 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 of information ` about the active simulation @@ -241,6 +241,7 @@ 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 subroutine error: :f:func:`error` :f function version: :f:func:`version` :f subroutine file: :f:func:`file` :f subroutine command: :f:func:`command` @@ -305,6 +306,18 @@ Procedures Bound to the lammps Derived Type -------- +.. f:subroutine:: error(error_type, error_text) + + This method is a wrapper around the :cpp:func:`lammps_error` function and will dispatch + an error through the LAMMPS Error class. + + .. versionadded:: TBD + + :p integer error_type: constant to select which Error class function to call + :p character(len=\*) error_text: error message + +-------- + .. f:function:: version() This method returns the numeric LAMMPS version like :cpp:func:`lammps_version` diff --git a/doc/src/Library_create.rst b/doc/src/Library_create.rst index 8043819891..8ccc2e80ce 100644 --- a/doc/src/Library_create.rst +++ b/doc/src/Library_create.rst @@ -11,6 +11,7 @@ This section documents the following functions: - :cpp:func:`lammps_mpi_finalize` - :cpp:func:`lammps_kokkos_finalize` - :cpp:func:`lammps_python_finalize` +- :cpp:func:`lammps_error` -------------------- @@ -115,3 +116,8 @@ calling program. .. doxygenfunction:: lammps_python_finalize :project: progguide + +----------------------- + +.. doxygenfunction:: lammps_error + :project: progguide diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 7541bf7c0f..98378c833a 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -56,6 +56,7 @@ MODULE LIBLAMMPS TYPE(c_ptr) :: handle CONTAINS PROCEDURE :: close => lmp_close + PROCEDURE :: error => lmp_error PROCEDURE :: file => lmp_file PROCEDURE :: command => lmp_command PROCEDURE :: commands_list => lmp_commands_list @@ -144,6 +145,14 @@ MODULE LIBLAMMPS SUBROUTINE lammps_kokkos_finalize() BIND(C) END SUBROUTINE lammps_kokkos_finalize + SUBROUTINE lammps_error(handle, error_type, error_text) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + INTEGER(c_int), VALUE :: error_type + TYPE(c_ptr), VALUE :: error_text + END SUBROUTINE lammps_error + SUBROUTINE lammps_file(handle, filename) BIND(C) IMPORT :: c_ptr IMPLICIT NONE @@ -417,6 +426,18 @@ CONTAINS END IF END SUBROUTINE lmp_close + ! equivalent function to lammps_error() + SUBROUTINE lmp_error(self, error_type, error_text) + CLASS(lammps) :: self + INTEGER :: error_type + CHARACTER(len=*) :: error_text + TYPE(c_ptr) :: str + + str = f2c_string(error_text) + CALL lammps_error(self%handle, error_type, str) + CALL lammps_free(str) + END SUBROUTINE lmp_error + ! equivalent function to lammps_file() SUBROUTINE lmp_file(self, filename) CLASS(lammps) :: self @@ -492,7 +513,7 @@ CONTAINS END FUNCTION lmp_get_thermo ! equivalent subroutine to lammps_extract_box - SUBROUTINE lmp_extract_box (self, boxlo, boxhi, xy, yz, xz, pflags, boxflag) + SUBROUTINE lmp_extract_box(self, boxlo, boxhi, xy, yz, xz, pflags, boxflag) CLASS(lammps), INTENT(IN) :: self REAL(c_double), INTENT(OUT), TARGET, OPTIONAL :: boxlo(3), boxhi(3) REAL(c_double), INTENT(OUT), TARGET, OPTIONAL :: xy, yz, xz @@ -515,11 +536,11 @@ CONTAINS END SUBROUTINE lmp_extract_box ! equivalent function to lammps_reset_box - SUBROUTINE lmp_reset_box (self, boxlo, boxhi, xy, yz, xz) + 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 - CALL lammps_reset_box (self%handle, boxlo, boxhi, xy, yz, xz) + CALL lammps_reset_box(self%handle, boxlo, boxhi, xy, yz, xz) END SUBROUTINE lmp_reset_box ! equivalent function to lammps_memory_usage @@ -532,14 +553,14 @@ CONTAINS END SUBROUTINE lmp_memory_usage ! equivalent function to lammps_get_mpi_comm - INTEGER FUNCTION lmp_get_mpi_comm (self) + INTEGER FUNCTION lmp_get_mpi_comm(self) CLASS(lammps), INTENT(IN) :: self lmp_get_mpi_comm = lammps_get_mpi_comm(self%handle) 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 @@ -549,22 +570,10 @@ CONTAINS CALL lammps_free(Ckeyword) END FUNCTION lmp_extract_setting -! FIXME Do we need this to be visible to the user? -! ! equivalent function to lammps_extract_global_datatype -! INTEGER (c_int) FUNCTION lmp_extract_global_datatype (name) -! CHARACTER(LEN=*), INTENT(IN) :: name -! TYPE(c_ptr) :: Cname -! -! Cname = f2c_string(name) -! lmp_extract_global_datatype -! = lammps_extract_global_datatype(c_null_ptr, Cname) -! CALL lammps_free(Cname) -! END FUNCTION lmp_extract_global_datatype - ! 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) :: self CHARACTER(LEN=*), INTENT(IN) :: name TYPE(lammps_data) :: global_data @@ -625,10 +634,9 @@ CONTAINS FORALL ( I=1:length ) global_data%str(i:i) = Fptr(i) END FORALL - CASE DEFAULT - WRITE(ERROR_UNIT,'(A)') 'ERROR: Unknown pointer type in& - & extract_global' - STOP 2 + CASE DEFAULT + ! FIXME convert to use symbolic constants later + CALL lmp_error(self, 6, 'Unknown pointer type in extract_global') END SELECT END FUNCTION diff --git a/python/lammps/constants.py b/python/lammps/constants.py index a50d58b28f..26bb92626a 100644 --- a/python/lammps/constants.py +++ b/python/lammps/constants.py @@ -13,29 +13,35 @@ # various symbolic constants to be used # in certain calls to select data formats -LAMMPS_AUTODETECT = None -LAMMPS_INT = 0 -LAMMPS_INT_2D = 1 -LAMMPS_DOUBLE = 2 -LAMMPS_DOUBLE_2D = 3 -LAMMPS_INT64 = 4 -LAMMPS_INT64_2D = 5 -LAMMPS_STRING = 6 +LAMMPS_AUTODETECT = None +LAMMPS_INT = 0 +LAMMPS_INT_2D = 1 +LAMMPS_DOUBLE = 2 +LAMMPS_DOUBLE_2D = 3 +LAMMPS_INT64 = 4 +LAMMPS_INT64_2D = 5 +LAMMPS_STRING = 6 # these must be kept in sync with the enums in library.h -LMP_STYLE_GLOBAL = 0 -LMP_STYLE_ATOM = 1 -LMP_STYLE_LOCAL = 2 +LMP_STYLE_GLOBAL = 0 +LMP_STYLE_ATOM = 1 +LMP_STYLE_LOCAL = 2 -LMP_TYPE_SCALAR = 0 -LMP_TYPE_VECTOR = 1 -LMP_TYPE_ARRAY = 2 -LMP_SIZE_VECTOR = 3 -LMP_SIZE_ROWS = 4 -LMP_SIZE_COLS = 5 +LMP_TYPE_SCALAR = 0 +LMP_TYPE_VECTOR = 1 +LMP_TYPE_ARRAY = 2 +LMP_SIZE_VECTOR = 3 +LMP_SIZE_ROWS = 4 +LMP_SIZE_COLS = 5 -LMP_VAR_EQUAL = 0 -LMP_VAR_ATOM = 1 +LMP_ERROR_WARNING = 0 +LMP_ERROR_ONE = 1 +LMP_ERROR_ALL = 2 +LMP_ERROR_WORLD = 4 +LMP_ERROR_UNIVERSE = 8 + +LMP_VAR_EQUAL = 0 +LMP_VAR_ATOM = 1 # ------------------------------------------------------------------------- diff --git a/python/lammps/core.py b/python/lammps/core.py index 930a40a4b0..aa4aae13db 100644 --- a/python/lammps/core.py +++ b/python/lammps/core.py @@ -167,6 +167,8 @@ class lammps(object): self.lib.lammps_flush_buffers.argtypes = [c_void_p] self.lib.lammps_free.argtypes = [c_void_p] + self.lib.lammps_error.argtypes = [c_void_p, c_int, c_char_p] + self.lib.lammps_file.argtypes = [c_void_p, c_char_p] self.lib.lammps_file.restype = None @@ -486,6 +488,26 @@ class lammps(object): # ------------------------------------------------------------------------- + def error(self, error_type, error_text): + """Forward error to the LAMMPS Error class. + + This is a wrapper around the :cpp:func:`lammps_error` function of the C-library interface. + + .. versionadded:: TBD + + :param error_type: + :type error_type: int + :param error_text: + :type error_text: string + """ + if error_text: error_text = error_text.encode() + else: error_text = "(unknown error)".encode() + + with ExceptionCheck(self): + self.lib.lammps_error(self.lmp, error_type, error_text) + + # ------------------------------------------------------------------------- + def version(self): """Return a numerical representation of the LAMMPS version in use. @@ -1622,8 +1644,8 @@ class lammps(object): """Return a string with detailed information about any devices that are usable by the GPU package. - This is a wrapper around the :cpp:func:`lammps_get_gpu_device_info` - function of the C-library interface. + This is a wrapper around the :cpp:func:`lammps_get_gpu_device_info` + function of the C-library interface. :return: GPU device info string :rtype: string diff --git a/src/library.cpp b/src/library.cpp index 8fa8b4c17b..cc547106f2 100644 --- a/src/library.cpp +++ b/src/library.cpp @@ -416,6 +416,89 @@ void lammps_python_finalize() Python::finalize(); } + +/* ---------------------------------------------------------------------- */ + +/** Call a LAMMPS Error class function + * +\verbatim embed:rst + +This function is a wrapper around functions in the ``Error`` to print an +error message and then stop LAMMPS. + +The *error_type* parameter selects which function to call. It is a sum +of constants from :cpp:enum:`_LMP_ERROR_CONST`. If the value does not +match any valid combination of constants a warning is printed and the +function returns. + +.. versionadded:: TBD + +\endverbatim + * + * \param handle pointer to a previously created LAMMPS instance + * \param error_type parameter to select function in the Error class + * \param error_text error message */ + +void lammps_error(void *handle, int error_type, const char *error_text) +{ + auto lmp = (LAMMPS *) handle; + + BEGIN_CAPTURE + { + switch (error_type) { + case LMP_ERROR_WARNING: + lmp->error->warning("(library)", 0, error_text); + break; + case LMP_ERROR_ONE: + lmp->error->one("(library)", 0, error_text); + break; + case LMP_ERROR_ALL: + lmp->error->all("(library)", 0, error_text); + break; + case LMP_ERROR_WARNING|LMP_ERROR_WORLD: + lmp->error->warning("(library)", 0, error_text); + break; + case LMP_ERROR_ONE|LMP_ERROR_WORLD: + lmp->error->one("(library)", 0, error_text); + break; + case LMP_ERROR_ALL|LMP_ERROR_WORLD: + lmp->error->all("(library)", 0, error_text); + break; + case LMP_ERROR_WARNING|LMP_ERROR_UNIVERSE: + lmp->error->universe_warn("(library)", 0, error_text); + break; + case LMP_ERROR_ONE|LMP_ERROR_UNIVERSE: + lmp->error->universe_one("(library)", 0, error_text); + break; + case LMP_ERROR_ALL|LMP_ERROR_UNIVERSE: + lmp->error->universe_all("(library)", 0, error_text); + break; + default: + auto mesg = fmt::format("Unknown error type {} for message: {}", error_type, error_text); + lmp->error->warning("(library)", 0, mesg); + } + } + END_CAPTURE + +#if defined(LAMMPS_EXCEPTIONS) + // with enabled exceptions the above code will simply throw an + // exception and record the error message. So we have to explicitly + // stop here like we do in main.cpp + if (lammps_has_error(handle)) { + if (error_type & 1) { + lammps_kokkos_finalize(); + lammps_python_finalize(); + MPI_Abort(lmp->universe->uworld, 1); + } else if (error_type & 2) { + lammps_kokkos_finalize(); + lammps_python_finalize(); + lammps_mpi_finalize(); + exit(1); + } + } +#endif +} + // ---------------------------------------------------------------------- // Library functions to process commands // ---------------------------------------------------------------------- diff --git a/src/library.h b/src/library.h index 311219e5ba..4e50cbee84 100644 --- a/src/library.h +++ b/src/library.h @@ -75,6 +75,18 @@ enum _LMP_TYPE_CONST { 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 lammps/constants.py */ + +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 */ +}; + /* Ifdefs to allow this file to be included in C and C++ programs */ #ifdef __cplusplus @@ -97,6 +109,8 @@ void lammps_mpi_finalize(); void lammps_kokkos_finalize(); void lammps_python_finalize(); +void lammps_error(void *handle, int error_type, const char *error_text); + /* ---------------------------------------------------------------------- * Library functions to process commands * ---------------------------------------------------------------------- */ From a94cfe175b887ec0bfa92110ceb646699db1ca27 Mon Sep 17 00:00:00 2001 From: Axel Kohlmeyer Date: Fri, 23 Sep 2022 18:59:29 -0400 Subject: [PATCH 24/25] add c/python unit tests for lammps_error() --- unittest/c-library/test_library_open.cpp | 29 ++++++++++++++++++++++++ unittest/python/python-open.py | 14 ++++++++++-- 2 files changed, 41 insertions(+), 2 deletions(-) diff --git a/unittest/c-library/test_library_open.cpp b/unittest/c-library/test_library_open.cpp index c75fd3738b..1cd65d843d 100644 --- a/unittest/c-library/test_library_open.cpp +++ b/unittest/c-library/test_library_open.cpp @@ -198,3 +198,32 @@ TEST(lammps_open_fortran, no_args) if (verbose) std::cout << output; MPI_Comm_free(&mycomm); } + +TEST(lammps_open_no_mpi, lammps_error) +{ + const char *args[] = {"liblammps", "-log", "none", "-nocite"}; + char **argv = (char **)args; + int argc = sizeof(args) / sizeof(char *); + + ::testing::internal::CaptureStdout(); + void *alt_ptr; + void *handle = lammps_open_no_mpi(argc, argv, &alt_ptr); + std::string output = ::testing::internal::GetCapturedStdout(); + EXPECT_EQ(handle, alt_ptr); + LAMMPS_NS::LAMMPS *lmp = (LAMMPS_NS::LAMMPS *)handle; + + EXPECT_EQ(lmp->world, MPI_COMM_WORLD); + EXPECT_EQ(lmp->infile, stdin); + EXPECT_NE(lmp->screen, nullptr); + EXPECT_EQ(lmp->logfile, nullptr); + EXPECT_EQ(lmp->citeme, nullptr); + EXPECT_EQ(lmp->suffix_enable, 0); + + EXPECT_STREQ(lmp->exename, "liblammps"); + EXPECT_EQ(lmp->num_package, 0); + ::testing::internal::CaptureStdout(); + lammps_error(handle, 0, "test_warning"); + output = ::testing::internal::GetCapturedStdout(); + EXPECT_THAT(output, HasSubstr("WARNING: test_warning")); +} + diff --git a/unittest/python/python-open.py b/unittest/python/python-open.py index 328745ded0..3c9165b8c8 100644 --- a/unittest/python/python-open.py +++ b/unittest/python/python-open.py @@ -45,11 +45,21 @@ class PythonOpen(unittest.TestCase): def testWithArgs(self): """Create LAMMPS instance with a few arguments""" - lmp=lammps(name=self.machine, - cmdargs=['-nocite','-sf','opt','-log','none']) + lmp=lammps(name=self.machine,cmdargs=['-nocite','-sf','opt','-log','none']) self.assertIsNot(lmp.lmp,None) self.assertEqual(lmp.opened,1) + def testError(self): + """Print warning message through LAMMPS Error class""" + lmp=lammps(name=self.machine,cmdargs=['-nocite','-log','none','-screen','tmp.error.output']) + lmp.error(0,'test_warning') + lmp.close() + with open('tmp.error.output','r') as f: + output = f.read() + self.assertTrue('LAMMPS' in output) + self.assertTrue('Total wall time' in output) + self.assertTrue('WARNING: test_warning' in output) + def testContextManager(self): """Automatically clean up LAMMPS instance""" with lammps(name=self.machine) as lmp: From 058e49696a83c30c0e3e202ef6c489ab032e17df Mon Sep 17 00:00:00 2001 From: Karl Hammond Date: Sat, 24 Sep 2022 12:12:24 -0500 Subject: [PATCH 25/25] Added "New in version TBD" to new functions --- doc/src/Fortran.rst | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index e15555bc4e..77ab447c7c 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -376,6 +376,8 @@ Procedures Bound to the lammps Derived Type This function will call :cpp:func:`lammps_get_thermo` and return the value of the corresponding thermodynamic keyword. + .. versionadded:: TBD + :p character(len=\*) name: string with the name of the thermo keyword :r real(c_double): value of the requested thermo property or `0.0_c_double` @@ -389,6 +391,8 @@ Procedures Bound to the lammps Derived Type as integers, but should be declared as ``LOGICAL`` variables when calling from Fortran. + .. versionadded:: TBD + :o real(c_double) boxlo [dimension(3),optional]: vector in which to store lower-bounds of simulation box :o real(c_double) boxhi [dimension(3),optional]: vector in which to store @@ -423,6 +427,8 @@ Procedures Bound to the lammps Derived Type This subroutine will call :cpp:func:`lammps_reset_box`. All parameters are required. + .. versionadded:: TBD + :p real(c_double) boxlo [dimension(3)]: vector of three doubles containing the lower box boundary :p real(c_double) boxhi [dimension(3)]: vector of three doubles containing @@ -438,6 +444,8 @@ Procedures Bound to the lammps Derived Type This subroutine will call :cpp:func:`lammps_memory_usage` and store the result in the three-element array *meminfo*. + .. versionadded:: TBD + :p real(c_double) meminfo [dimension(3)]: vector of three doubles in which to store memory usage data @@ -448,6 +456,8 @@ Procedures Bound to the lammps Derived Type This function returns a Fortran representation of the LAMMPS "world" communicator. + .. versionadded:: TBD + :r integer: Fortran integer equivalent to the MPI communicator LAMMPS is using @@ -484,6 +494,8 @@ Procedures Bound to the lammps Derived Type Query LAMMPS about global settings. See the documentation for the :cpp:func:`lammps_extract_setting` function from the C library. + .. versionadded:: TBD + :p character(len=\*) keyword: string containing the name of the thermo keyword :r integer(c_int): value of the queried setting or :math:`-1` if unknown @@ -495,6 +507,8 @@ Procedures Bound to the lammps Derived Type either a string or a pointer to internal global LAMMPS data, depending on the data requested through *name*. + .. 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 (with the exception of string data, which are