ICODE-ADC/lammps
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Refactor Fortran properties test into configuration; implemented several configuration functions and wrote unit tests for them; implemented missing unit tests

Browse Source
This commit is contained in:
Karl Hammond
2022-10-20 20:24:59 -05:00
parent 34121e5545
commit 60318a5a26
9 changed files with 719 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files

93
doc/src/Fortran.rst
View File

@ -278,6 +278,9 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS.
:f function config_package_count: :f:func:`config_package_count`
:f function config_package_name: :f:func:`config_package_name`
:f subroutine installed_packages: :f:func:`installed_packages`
:f function config_accelerator: :f:func:`config_accelerator`
:f function has_gpu_device: :f:func:`has_gpu_device`
:f subroutine get_gpu_device_info: :f:func:`get_gpu_device_info`
:f function encode_image_flags: :f:func:`encode_image_flags`
:f subroutine decode_image_flags: :f:func:`decode_image_flags`
:f subroutine flush_buffers: :f:func:`flush_buffers`
@ -643,7 +646,7 @@ Procedures Bound to the lammps Derived Type
.. f:function:: extract_atom(name)
This function calls :c:func:`lammps_extract_atom` and returns a pointer to
This function calls :cpp:func:`lammps_extract_atom` and returns a pointer to
LAMMPS data tied to the :cpp:class:`Atom` class, depending on the data
requested through *name*.
@ -748,7 +751,7 @@ Procedures Bound to the lammps Derived Type
.. f:function:: extract_compute(id, style, type)
This function calls :c:func:`lammps_extract_compute` and returns a pointer
This function calls :cpp:func:`lammps_extract_compute` and returns a pointer
to LAMMPS data tied to the :cpp:class:`Compute` class, specifically data
provided by the compute identified by *id*. Computes may provide global,
per-atom, or local data, and those data may be a scalar, a vector, or an
@ -858,7 +861,7 @@ Procedures Bound to the lammps Derived Type
.. f:function:: extract_fix(id, style, type[, nrow][, ncol])
This function calls :c:func:`lammps_extract_fix` and returns a pointer to
This function calls :cpp:func:`lammps_extract_fix` and returns a pointer to
LAMMPS data tied to the :cpp:class:`Fix` class, specifically data provided
by the fix identified by *id*. Fixes may provide global, per-atom, or
local data, and those data may be a scalar, a vector, or an array. Since
@ -1049,7 +1052,7 @@ Procedures Bound to the lammps Derived Type
.. f:function:: extract_variable(name[,group])
This function calls :c:func:`lammps_extract_variable` and returns a scalar,
This function calls :cpp:func:`lammps_extract_variable` and returns a scalar,
vector, or string containing the value of the variable identified by
*name*. When the variable is an *equal*-style variable (or one compatible
with that style such as *internal*), the variable is evaluated and the
@ -1111,7 +1114,7 @@ Procedures Bound to the lammps Derived Type
.. f:subroutine:: gather_atoms(name, count, data)
This function calls :c:func:`lammps_gather_atoms` to gather the named
This function calls :cpp:func:`lammps_gather_atoms` to gather the named
atom-based entity for all atoms on all processors and return it in the
vector *data*. The vector *data* will be ordered by atom
ID, which requires consecutive atom IDs (1 to *natoms*).
@ -1162,8 +1165,8 @@ Procedures Bound to the lammps Derived Type
.. f:subroutine:: gather_atoms_concat(name, count, data)
This function calls :c:func:`lammps_gather_atoms_concat` to gather the named
atom-based entity for all atoms on all processors and return it in the
This function calls :cpp:func:`lammps_gather_atoms_concat` to gather the
named atom-based entity for all atoms on all processors and return it in the
vector *data*.
.. versionadded:: TBD
@ -1190,9 +1193,9 @@ Procedures Bound to the lammps Derived Type
.. f:subroutine:: gather_atoms_subset(name, count, ids, data)
This function calls :c:func:`lammps_gather_atoms_subset` to gather the named
atom-based entity for the atoms in the array *ids* from all processors and
return it in the vector *data*.
This function calls :cpp:func:`lammps_gather_atoms_subset` to gather the
named atom-based entity for the atoms in the array *ids* from all processors
and return it in the vector *data*.
.. versionadded: TBD
@ -1225,7 +1228,7 @@ Procedures Bound to the lammps Derived Type
.. f:subroutine:: scatter_atoms(name, data)
This function calls :c:func:`lammps_scatter_atoms` to scatter the named
This function calls :cpp:func:`lammps_scatter_atoms` to scatter the named
atom-based entities in *data* to all processors.
.. versionadded:: TBD
@ -1253,7 +1256,7 @@ Procedures Bound to the lammps Derived Type
.. f:subroutine:: scatter_atoms_subset(name, ids, data)
This function calls :c:func:`lammps_scatter_atoms_subset` to scatter the
This function calls :cpp:func:`lammps_scatter_atoms_subset` to scatter the
named atom-based entities in *data* to all processors.
.. versionadded:: TBD
@ -1284,7 +1287,7 @@ Procedures Bound to the lammps Derived Type
.. f:subroutine:: create_atoms([id,] type, x, [v,] [image,] [bexpand])
This method calls :c:func:`lammps_create_atoms` to create additional atoms
This method calls :cpp:func:`lammps_create_atoms` to create additional atoms
from a given list of coordinates and a list of atom types. Additionally,
the atom IDs, velocities, and image flags may be provided.
@ -1509,6 +1512,8 @@ Procedures Bound to the lammps Derived Type
Obtain a list of the names of enabled packages in the LAMMPS shared library
and store it in *package*.
.. versionadded:: TBD
This function is analogous to the :py:func`installed_packages` function in
the Python API. The optional argument *length* sets the length of each
string in the vector *package* (default: 31).
@ -1521,6 +1526,68 @@ Procedures Bound to the lammps Derived Type
--------
.. f:function:: config_accelerator(package, category, setting)
This function calls :cpp:func:`lammps_config_accelerator` to check the
availability of compile time settings of included
:doc:`accelerator packages <Speed_packages>` in LAMMPS.
.. versionadded:: TBD
Supported packages names are "GPU", "KOKKOS", "INTEL", and "OPENMP".
Supported categories are "api" with possible settings "cuda", "hip", "phi",
"pthreads", "opencl", "openmp", and "serial"; and "precision" with
possible settings "double", "mixed", and "single".
:p character(len=\*) package: string with the name of the accelerator
package
:p character(len=\*) category: string with the name of the setting
:p character(len=\*) setting: string with the name of the specific
setting
:r logical: ``.TRUE.`` if the combination of package, category, and setting
is available, otherwise ``.FALSE.``.
--------
.. f:function:: has_gpu_device()
Checks for the presence of a viable GPU package device.
.. versionadded:: TBD
This function calls :cpp:func:`lammps_has_gpu_device`, which checks at
runtime whether an accelerator device is present that can be used with the
:doc:`GPU package <Speed_gpu>`.
More detailed information about the available device or devices can
be obtained by calling the
:cpp:func:`lammps_get_gpu_device_info` function.
:r logical: ``.TRUE.`` if a viable device is available, ``.FALSE.`` if not.
--------
.. f:subroutine:: get_gpu_device_info(buffer)
Get GPU package device information.
.. versionadded:: TBD
Calls :cpp:func:`lammps_get_gpu_device_info` to retrieve detailed
information about any accelerator devices that are viable for use with the
:doc:`GPU package <Speed_gpu>`. It will fill *buffer* with a string that is
equivalent to the output of the ``nvc_get_device`` or ``ocl_get_device`` or
``hip_get_device`` tools that are compiled alongside LAMMPS if the GPU
package is enabled.
A suitable-length Fortran string has to be provided. The assembled text will
be truncated so as not to overflow this buffer. This string can be several
kilobytes long if multiple devices are present.
:p character(len=\*) buffer: string into which to copy the information.
--------
.. f:function:: encode_image_flags(ix, iy, iz)
Encodes three integer image flags into a single imageint.

181
fortran/lammps.f90
View File

@ -142,6 +142,13 @@ MODULE LIBLAMMPS
PROCEDURE, NOPASS :: config_package_count => lammps_config_package_count
PROCEDURE, NOPASS :: config_package_name => lmp_config_package_name
PROCEDURE, NOPASS :: installed_packages => lmp_installed_packages
PROCEDURE, NOPASS :: config_accelerator => lmp_config_accelerator
PROCEDURE, NOPASS :: has_gpu_device => lmp_has_gpu_device
PROCEDURE, NOPASS :: get_gpu_device_info => lmp_get_gpu_device_info
PROCEDURE :: has_style => lmp_has_style
PROCEDURE :: style_count => lmp_style_count
PROCEDURE :: style_name => lmp_style_name
!
PROCEDURE :: encode_image_flags => lmp_encode_image_flags
PROCEDURE, PRIVATE :: lmp_decode_image_flags
PROCEDURE, PRIVATE :: lmp_decode_image_flags_bigbig
@ -367,13 +374,6 @@ 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), INTENT(IN), VALUE :: str
INTEGER(c_size_t) :: c_strlen
END FUNCTION c_strlen
FUNCTION lammps_extract_global(handle, name) BIND(C)
IMPORT :: c_ptr
IMPLICIT NONE
@ -569,9 +569,47 @@ MODULE LIBLAMMPS
TYPE(c_ptr), VALUE :: buffer
END FUNCTION lammps_config_package_name
!LOGICAL FUNCTION lammps_config_accelerator
!LOGICAL FUNCTION lammps_has_gpu_device
!SUBROUTINE lammps_get_gpu_device
FUNCTION lammps_config_accelerator(package, category, setting) BIND(C)
IMPORT :: c_int, c_ptr
IMPLICIT NONE
TYPE(c_ptr), VALUE :: package, category, setting
INTEGER(c_int) :: lammps_config_accelerator
END FUNCTION lammps_config_accelerator
FUNCTION lammps_has_gpu_device() BIND(C)
IMPORT :: c_int
IMPLICIT NONE
INTEGER(c_int) :: lammps_has_gpu_device
END FUNCTION lammps_has_gpu_device
SUBROUTINE lammps_get_gpu_device_info(buffer, buf_size) BIND(C)
IMPORT :: c_int, c_ptr
IMPLICIT NONE
TYPE(c_ptr), VALUE :: buffer
INTEGER(c_int), VALUE :: buf_size
END SUBROUTINE lammps_get_gpu_device_info
FUNCTION lammps_has_style(handle, category, name) BIND(C)
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(c_ptr), VALUE :: handle, category, name
INTEGER(c_int) :: lammps_has_style
END FUNCTION lammps_has_style
FUNCTION lammps_style_count(handle, category) BIND(C)
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(c_ptr), VALUE :: handle, category
INTEGER(c_int) :: lammps_style_count
END FUNCTION lammps_style_count
FUNCTION lammps_style_name(handle, category, idx, buffer, buf_size) BIND(C)
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(c_ptr), VALUE :: handle, category, buffer
INTEGER(c_int), VALUE :: idx, buf_size
INTEGER(c_int) :: lammps_style_name
END FUNCTION lammps_style_name
!LOGICAL FUNCTION lammps_has_id
!INTEGER(c_int) FUNCTION lammps_id_count
@ -601,13 +639,6 @@ MODULE LIBLAMMPS
TYPE(c_ptr), VALUE :: handle
END 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
SUBROUTINE lammps_free(ptr) BIND(C)
IMPORT :: c_ptr
IMPLICIT NONE
@ -640,6 +671,23 @@ MODULE LIBLAMMPS
INTEGER(c_int), VALUE :: buf_size
END FUNCTION lammps_get_last_error_message
!---------------------------------------------------------------------
! Utility functions imported for convenience (not in library.h)
!---------------------------------------------------------------------
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 c_strlen(str) BIND(C, name='strlen')
IMPORT :: c_ptr, c_size_t
IMPLICIT NONE
TYPE(c_ptr), INTENT(IN), VALUE :: str
INTEGER(c_size_t) :: c_strlen
END FUNCTION c_strlen
END INTERFACE
CONTAINS
@ -1812,6 +1860,104 @@ CONTAINS
END DO
END SUBROUTINE lmp_installed_packages
! equivalent function to lammps_config_accelerator
LOGICAL FUNCTION lmp_config_accelerator(package, category, setting)
CHARACTER(LEN=*), INTENT(IN) :: package, category, setting
TYPE(c_ptr) :: Cpackage, Ccategory, Csetting
INTEGER(c_int) :: is_configured
Cpackage = f2c_string(package)
Ccategory = f2c_string(category)
Csetting = f2c_string(setting)
is_configured = lammps_config_accelerator(Cpackage, Ccategory, Csetting)
CALL lammps_free(Cpackage)
CALL lammps_free(Ccategory)
CALL lammps_free(Csetting)
lmp_config_accelerator = (is_configured /= 0_c_int)
END FUNCTION lmp_config_accelerator
! equivalent function to lammps_has_gpu_device
LOGICAL FUNCTION lmp_has_gpu_device()
lmp_has_gpu_device = (lammps_has_gpu_device() /= 0_c_int)
END FUNCTION lmp_has_gpu_device
! equivalent subroutine to lammps_get_gpu_device_info
SUBROUTINE lmp_get_gpu_device_info(buffer)
CHARACTER(LEN=*), INTENT(OUT) :: buffer
INTEGER(c_int) :: buf_size, i
INTEGER(c_size_t) :: strlen
TYPE(c_ptr) :: Cptr
CHARACTER(LEN=1,KIND=c_char), DIMENSION(:), POINTER :: Cbuffer => NULL()
buffer = ''
buf_size = LEN(buffer) + 1
Cptr = lammps_malloc(INT(buf_size,c_size_t))
CALL lammps_get_gpu_device_info(Cptr, buf_size)
CALL C_F_POINTER(Cptr, Cbuffer, [buf_size])
strlen = c_strlen(Cptr)
DO i = 1, strlen
buffer(i:i) = Cbuffer(i)
END DO
CALL lammps_free(Cptr)
END SUBROUTINE lmp_get_gpu_device_info
! equivalent function to lammps_has_style
LOGICAL FUNCTION lmp_has_style(self, category, name)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: category, name
TYPE(c_ptr) :: Ccategory, Cname
INTEGER(c_int) :: has_style
Ccategory = f2c_string(category)
Cname = f2c_string(name)
has_style = lammps_has_style(self%handle, Ccategory, Cname)
CALL lammps_free(Ccategory)
CALL lammps_free(Cname)
lmp_has_style = (has_style /= 0_c_int)
END FUNCTION
! equivalent function to lammps_style_count
INTEGER(c_int) FUNCTION lmp_style_count(self, category)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: category
TYPE(c_ptr) :: Ccategory
Ccategory = f2c_string(category)
lmp_style_count = lammps_style_count(self%handle, Ccategory)
CALL lammps_free(Ccategory)
END FUNCTION lmp_style_count
! equivalent function to lammps_style_name
SUBROUTINE lmp_style_name(self, category, idx, buffer)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: category
INTEGER(c_int), INTENT(IN) :: idx
CHARACTER(LEN=*), INTENT(OUT) :: buffer
INTEGER(c_int) :: buf_size, success
TYPE(c_ptr) :: Ccategory, Cbuffer
INTEGER(c_size_t) :: length
CHARACTER(LEN=1,KIND=c_char), DIMENSION(:), POINTER :: Fbuffer => NULL()
INTEGER :: i
buf_size = LEN(buffer)
Ccategory = f2c_string(category)
Cbuffer = lammps_malloc(buf_size + 1_c_size_t)
success = lammps_style_name(self%handle, Ccategory, idx, Cbuffer, buf_size)
IF (success == 1_c_int) THEN
length = c_strlen(Cbuffer)
CALL C_F_POINTER(Cbuffer, Fbuffer, [length])
DO i = 1, length
buffer(i:i) = Fbuffer(i)
END DO
ELSE
buffer = ''
CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, &
'idx value not in range [Fortran/style_name]')
END IF
CALL lammps_free(Ccategory)
CALL lammps_free(Cbuffer)
END SUBROUTINE lmp_style_name
! equivalent function to lammps_encode_image_flags
FUNCTION lmp_encode_image_flags(self, ix, iy, iz) RESULT (image)
CLASS(lammps), INTENT(IN), TARGET :: self
@ -2211,6 +2357,7 @@ CONTAINS
END DO
c_string(n+1) = c_null_char
END FUNCTION f2c_string
END MODULE LIBLAMMPS
! vim: ts=2 sts=2 sw=2 et

4
unittest/fortran/CMakeLists.txt
View File

@ -82,6 +82,10 @@ if(CMAKE_Fortran_COMPILER)
target_link_libraries(test_fortran_create_atoms PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
add_test(NAME FortranCreateAtoms COMMAND test_fortran_create_atoms)
add_executable(test_fortran_configuration wrap_configuration.cpp test_fortran_configuration.f90 test_fortran_commands.f90)
target_link_libraries(test_fortran_configuration PRIVATE flammps lammps MPI::MPI_Fortran GTest::GMockMain)
add_test(NAME FortranConfiguration COMMAND test_fortran_configuration)
else()
message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler")
endif()

40
unittest/fortran/keepstuff.f90
View File

@ -1,5 +1,5 @@
MODULE keepstuff
USE liblammps
USE LIBLAMMPS
IMPLICIT NONE
TYPE(LAMMPS) :: lmp
INTEGER :: mycomm
@ -24,5 +24,43 @@ MODULE keepstuff
'pair_style lj/cut 2.5', &
'pair_coeff 1 1 1.0 1.0', &
'mass 1 2.0' ]
INTERFACE
FUNCTION c_strlen(str) BIND(C,name='strlen')
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, c_size_t
IMPLICIT NONE
TYPE(c_ptr), INTENT(IN), VALUE :: str
INTEGER(c_size_t) :: c_strlen
END FUNCTION c_strlen
END INTERFACE
CONTAINS
FUNCTION f2c_string(f_string) RESULT(ptr)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_char, c_ptr, c_size_t, &
c_null_char, C_F_POINTER
CHARACTER(LEN=*), INTENT(IN) :: f_string
CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:)
TYPE(c_ptr) :: ptr
INTEGER(c_size_t) :: i, n
INTERFACE
FUNCTION lammps_malloc(size) BIND(C, name='malloc')
IMPORT :: c_ptr, c_size_t
IMPLICIT NONE
INTEGER(c_size_t), VALUE :: size
TYPE(c_ptr) :: lammps_malloc
END FUNCTION lammps_malloc
END INTERFACE
n = LEN_TRIM(f_string)
ptr = lammps_malloc(n+1)
CALL C_F_POINTER(ptr, c_string, [1])
DO i=1, n
c_string(i) = f_string(i:i)
END DO
c_string(n+1) = c_null_char
END FUNCTION f2c_string
END MODULE keepstuff

216
unittest/fortran/test_fortran_configuration.f90 Normal file
View File

@ -0,0 +1,216 @@
FUNCTION f_lammps_version() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_version
f_lammps_version = lmp%version()
END FUNCTION f_lammps_version
FUNCTION f_lammps_mpi_support() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_mpi_support
IF (lmp%config_has_mpi_support()) THEN
f_lammps_mpi_support = 1_c_int
ELSE
f_lammps_mpi_support = 0_c_int
END IF
END FUNCTION f_lammps_mpi_support
FUNCTION f_lammps_gzip_support() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_gzip_support
IF (lmp%config_has_gzip_support()) THEN
f_lammps_gzip_support = 1_c_int
ELSE
f_lammps_gzip_support = 0_c_int
END IF
END FUNCTION f_lammps_gzip_support
FUNCTION f_lammps_png_support() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_png_support
IF (lmp%config_has_png_support()) THEN
f_lammps_png_support = 1_c_int
ELSE
f_lammps_png_support = 0_c_int
END IF
END FUNCTION f_lammps_png_support
FUNCTION f_lammps_jpeg_support() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_jpeg_support
IF (lmp%config_has_jpeg_support()) THEN
f_lammps_jpeg_support = 1_c_int
ELSE
f_lammps_jpeg_support = 0_c_int
END IF
END FUNCTION f_lammps_jpeg_support
FUNCTION f_lammps_ffmpeg_support() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_ffmpeg_support
IF (lmp%config_has_ffmpeg_support()) THEN
f_lammps_ffmpeg_support = 1_c_int
ELSE
f_lammps_ffmpeg_support = 0_c_int
END IF
END FUNCTION f_lammps_ffmpeg_support
FUNCTION f_lammps_has_exceptions() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_has_exceptions
IF (lmp%config_has_exceptions()) THEN
f_lammps_has_exceptions = 1_c_int
ELSE
f_lammps_has_exceptions = 0_c_int
END IF
END FUNCTION f_lammps_has_exceptions
FUNCTION f_lammps_has_package(Cname) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_size_t, c_ptr, c_char, &
C_F_POINTER
USE LIBLAMMPS
USE keepstuff, ONLY : lmp, c_strlen
IMPLICIT NONE
TYPE(c_ptr), VALUE :: Cname
INTEGER(c_int) :: f_lammps_has_package
CHARACTER(LEN=1,KIND=c_char), DIMENSION(:), POINTER :: Fname
CHARACTER(LEN=:), ALLOCATABLE :: name
INTEGER(c_size_t) :: length
INTEGER :: i
length = c_strlen(Cname)
CALL C_F_POINTER(Cname, Fname, [length])
ALLOCATE(CHARACTER(LEN=length) :: name)
DO i = 1, length
name(i:i) = Fname(i)
END DO
IF (lmp%config_has_package(name)) THEN
f_lammps_has_package = 1_c_int
ELSE
f_lammps_has_package = 0_c_int
END IF
END FUNCTION f_lammps_has_package
FUNCTION f_lammps_package_count() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_package_count
f_lammps_package_count = lmp%config_package_count()
END FUNCTION f_lammps_package_count
FUNCTION f_lammps_package_name(idx) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, c_null_ptr, c_int
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
INTEGER(c_int), VALUE :: idx
TYPE(c_ptr) :: f_lammps_package_name
CHARACTER(LEN=80) :: buffer
CALL lmp%config_package_name(idx, buffer)
IF (LEN_TRIM(buffer) > 0) THEN
f_lammps_package_name = f2c_string(buffer)
ELSE
f_lammps_package_name = c_null_ptr
END IF
END FUNCTION f_lammps_package_name
FUNCTION f_lammps_config_accelerator(package, category, setting) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_ptr, c_size_t, c_char, &
C_F_POINTER
USE keepstuff, ONLY : lmp, c_strlen
USE LIBLAMMPS
IMPLICIT NONE
TYPE(c_ptr), VALUE :: package, category, setting
INTEGER(c_int) :: f_lammps_config_accelerator
INTEGER(c_size_t) :: len_package, len_category, len_setting
CHARACTER(LEN=1,KIND=c_char), POINTER :: Cpackage(:),Ccategory(:),Csetting(:)
CHARACTER(LEN=:), ALLOCATABLE :: Fpackage, Fcategory, Fsetting
INTEGER :: i
LOGICAL :: configured
len_package = c_strlen(package)
len_category = c_strlen(category)
len_setting = c_strlen(setting)
ALLOCATE(CHARACTER(LEN=len_package) :: Fpackage)
ALLOCATE(CHARACTER(LEN=len_category) :: Fcategory)
ALLOCATE(CHARACTER(LEN=len_setting) :: Fsetting)
CALL C_F_POINTER(package, Cpackage, [len_package])
CALL C_F_POINTER(category, Ccategory, [len_category])
CALL C_F_POINTER(setting, Csetting, [len_setting])
DO i = 1, len_package
Fpackage(i:i) = Cpackage(i)
END DO
DO i = 1, len_category
Fcategory(i:i) = Ccategory(i)
END DO
DO i = 1, len_setting
Fsetting(i:i) = Csetting(i)
END DO
configured = lmp%config_accelerator(Fpackage, Fcategory, Fsetting)
IF (configured) THEN
f_lammps_config_accelerator = 1_c_int
ELSE
f_lammps_config_accelerator = 0_c_int
END IF
END FUNCTION f_lammps_config_accelerator
FUNCTION f_lammps_has_gpu() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_has_gpu
IF (lmp%has_gpu_device()) THEN
f_lammps_has_gpu = 1_c_int
ELSE
f_lammps_has_gpu = 0_c_int
END IF
END FUNCTION f_lammps_has_gpu
FUNCTION f_lammps_get_gpu_info(buf_size) RESULT(info) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_size_t, c_ptr
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
INTEGER(c_size_t), VALUE :: buf_size
TYPE(c_ptr) :: info
CHARACTER(LEN=buf_size) :: string
CALL lmp%get_gpu_device_info(string)
info = f2c_string(string)
END FUNCTION f_lammps_get_gpu_info

73
unittest/fortran/test_fortran_extract_variable.f90
View File

@ -10,13 +10,6 @@ MODULE keepvar
TYPE(c_ptr) :: c_path_join
END FUNCTION c_path_join
FUNCTION c_strlen(str) BIND(C,name='strlen')
IMPORT :: c_ptr, c_size_t
IMPLICIT NONE
TYPE(c_ptr), INTENT(IN), VALUE :: str
INTEGER(c_size_t) :: c_strlen
END FUNCTION c_strlen
SUBROUTINE c_free(ptr) BIND(C,name='free')
IMPORT :: c_ptr
TYPE(c_ptr), VALUE :: ptr
@ -27,7 +20,7 @@ CONTAINS
FUNCTION absolute_path(filename)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, c_size_t, c_char, C_F_POINTER
USE keepstuff, ONLY : lmp
USE keepstuff, ONLY : lmp, f2c_string, c_strlen
CHARACTER(LEN=:), ALLOCATABLE :: absolute_path
CHARACTER(LEN=*), INTENT(IN) :: filename
CHARACTER(LEN=256) :: test_input_directory
@ -50,38 +43,12 @@ CONTAINS
CALL c_free(c_absolute_path)
END FUNCTION absolute_path
FUNCTION f2c_string(f_string) RESULT(ptr)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_char, c_ptr, c_size_t, &
c_null_char, C_F_POINTER
CHARACTER(LEN=*), INTENT(IN) :: f_string
CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:)
TYPE(c_ptr) :: ptr
INTEGER(c_size_t) :: i, n
INTERFACE
FUNCTION lammps_malloc(size) BIND(C, name='malloc')
IMPORT :: c_ptr, c_size_t
IMPLICIT NONE
INTEGER(c_size_t), VALUE :: size
TYPE(c_ptr) :: lammps_malloc
END FUNCTION lammps_malloc
END INTERFACE
n = LEN_TRIM(f_string)
ptr = lammps_malloc(n+1)
CALL C_F_POINTER(ptr, c_string, [1])
DO i=1, n
c_string(i) = f_string(i:i)
END DO
c_string(n+1) = c_null_char
END FUNCTION f2c_string
END MODULE keepvar
FUNCTION f_lammps_with_C_args(argc, argv) BIND(C)
USE ISO_C_BINDING, ONLY: c_ptr, c_char, c_int, c_size_t, C_F_POINTER
USE liblammps
USE keepstuff, ONLY: lmp
USE keepstuff, ONLY: lmp, c_strlen
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: argc
TYPE(c_ptr), VALUE :: argv
@ -92,15 +59,6 @@ FUNCTION f_lammps_with_C_args(argc, argv) BIND(C)
CHARACTER(LEN=1,KIND=c_char), DIMENSION(:), POINTER :: Cstr
INTEGER(c_size_t):: i, length, j
INTERFACE
FUNCTION c_strlen(str) BIND(C,name='strlen')
IMPORT :: c_ptr, c_size_t
IMPLICIT NONE
TYPE(c_ptr), INTENT(IN), VALUE :: str
INTEGER(c_size_t) :: c_strlen
END FUNCTION c_strlen
END INTERFACE
CALL C_F_POINTER(argv, Fargv, [argc])
DO i = 1, argc
args(i) = ''
@ -219,8 +177,7 @@ END FUNCTION f_lammps_extract_variable_loop
FUNCTION f_lammps_extract_variable_loop_pad() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_loop_pad
CHARACTER(LEN=20) :: loop
@ -232,8 +189,7 @@ END FUNCTION f_lammps_extract_variable_loop_pad
FUNCTION f_lammps_extract_variable_world() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_world
CHARACTER(LEN=20) :: world
@ -245,8 +201,7 @@ END FUNCTION f_lammps_extract_variable_world
FUNCTION f_lammps_extract_variable_universe() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_universe
CHARACTER(LEN=20) :: universe
@ -270,8 +225,7 @@ END FUNCTION f_lammps_extract_variable_uloop
FUNCTION f_lammps_extract_variable_string() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_string
CHARACTER(LEN=256) :: string
@ -283,8 +237,7 @@ END FUNCTION f_lammps_extract_variable_string
FUNCTION f_lammps_extract_variable_format() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_format
CHARACTER(LEN=20) :: form
@ -296,8 +249,7 @@ END FUNCTION f_lammps_extract_variable_format
FUNCTION f_lammps_extract_variable_format_pad() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_format_pad
CHARACTER(LEN=20) :: form
@ -309,8 +261,7 @@ END FUNCTION f_lammps_extract_variable_format_pad
FUNCTION f_lammps_extract_variable_getenv() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_getenv
CHARACTER(LEN=40) :: string
@ -322,8 +273,7 @@ END FUNCTION f_lammps_extract_variable_getenv
FUNCTION f_lammps_extract_variable_file() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_file
CHARACTER(LEN=40) :: string
@ -414,8 +364,7 @@ END FUNCTION f_lammps_extract_variable_vector
SUBROUTINE f_lammps_set_variable_string() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
USE keepstuff, ONLY : lmp, f2c_string
IMPLICIT NONE
CHARACTER(LEN=40) :: string

10
unittest/fortran/test_fortran_properties.f90
View File

@ -1,13 +1,3 @@
FUNCTION f_lammps_version() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int) :: f_lammps_version
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

204
unittest/fortran/wrap_configuration.cpp Normal file
View File

@ -0,0 +1,204 @@
// unit tests for getting LAMMPS configuration through the Fortran wrapper
#include "lammps.h"
#include "library.h"
#include "info.h"
#include <string>
#include "gmock/gmock.h"
#include "gtest/gtest.h"
extern "C" {
void *f_lammps_with_args();
void f_lammps_close();
int f_lammps_version();
int f_lammps_mpi_support();
int f_lammps_gzip_support();
int f_lammps_png_support();
int f_lammps_jpeg_support();
int f_lammps_ffmpeg_support();
int f_lammps_has_exceptions();
int f_lammps_has_package(const char*);
int f_lammps_package_count();
char* f_lammps_package_name(int);
int f_lammps_config_accelerator(const char*, const char*, const char*);
int f_lammps_has_gpu();
char* f_lammps_get_gpu_info(size_t);
int f_lammps_has_style();
int f_lammps_style_count();
int f_lammps_style_name();
}
namespace LAMMPS_NS {
using ::testing::ContainsRegex;
class LAMMPS_configuration : public ::testing::Test {
protected:
LAMMPS *lmp;
void SetUp() override
{
::testing::internal::CaptureStdout();
lmp = (LAMMPS *)f_lammps_with_args();
std::string output = ::testing::internal::GetCapturedStdout();
EXPECT_STREQ(output.substr(0, 8).c_str(), "LAMMPS (");
}
void TearDown() override
{
::testing::internal::CaptureStdout();
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_configuration, version)
{
EXPECT_LT(20200917, f_lammps_version());
EXPECT_EQ(lmp->num_ver, f_lammps_version());
};
TEST_F(LAMMPS_configuration, MPI_support)
{
#ifdef MPI_STUBS
EXPECT_EQ(f_lammps_mpi_support(), 0);
#else
EXPECT_EQ(f_lammps_mpi_support(), 1);
#endif
};
TEST_F(LAMMPS_configuration, gzip_support)
{
EXPECT_EQ(f_lammps_gzip_support(), Info::has_gzip_support());
}
TEST_F(LAMMPS_configuration, png_support)
{
EXPECT_EQ(f_lammps_png_support(), Info::has_png_support());
}
TEST_F(LAMMPS_configuration, jpeg_support)
{
EXPECT_EQ(f_lammps_jpeg_support(), Info::has_jpeg_support());
}
TEST_F(LAMMPS_configuration, ffmpeg_support)
{
EXPECT_EQ(f_lammps_ffmpeg_support(), Info::has_ffmpeg_support());
}
TEST_F(LAMMPS_configuration, has_exceptions)
{
EXPECT_EQ(f_lammps_has_exceptions(), Info::has_exceptions());
}
TEST_F(LAMMPS_configuration, has_package)
{
std::vector<std::string> pkg_name = {"ADIOS","ASPHERE","ATC","AWPMD","BOCS",
"BODY", "BPM", "BROWNIAN", "CG-DNA", "CLASS2", "COLLOID", "COLVARS",
"COMPRESS", "CORESHELL", "DEPEND", "DIELECTRIC", "DIFFRACTION", "DIPOLE",
"DPD-BASIC", "DPD-MESO", "DPD-REACT", "DPD-SMOOTH", "DRUDE", "EFF",
"ELECTRODE", "EXTRA-COMPUTE", "EXTRA-DUMP", "EXTRA-FIX",
"EXTRA-MOLECULE", "EXTRA-PAIR", "FEP", "GPU", "GRANULAR", "H5MD",
"INTEL", "INTEL/TEST", "INTERLAYER", "KIM", "KOKKOS", "KSPACE",
"LATBOLTZ", "LATTE", "MACHDYN", "MAKE", "MAKE/MACHINES", "MAKE/MINE",
"MAKE/OPTIONS", "MANIFOLD", "MANYBODY", "MC", "MDI", "MEAM", "MESONT",
"MGPT", "MISC", "ML-HDNNP", "ML-IAP", "ML-PACE", "ML-QUIP", "ML-RANN",
"ML-SNAP", "MOFFF", "MOLECULE", "MOLFILE", "MPIIO", "MSCG", "NETCDF",
"OPENMP", "OPT", "ORIENT", "PERI", "PHONON", "PLUGIN", "PLUMED", "POEMS",
"PTM", "PYTHON", "QEQ", "QMMM", "QTB", "REACTION", "REAXFF", "REPLICA",
"RIGID", "SCAFACOS", "SHOCK", "SMTBQ", "SPH", "SPIN", "SRD", "STUBS",
"TALLY", "UEF", "VORONOI", "VTK", "YAFF", "CG-SPICA", "AMOEBA"};
for (int i = 0; i < pkg_name.size(); i++)
EXPECT_EQ(f_lammps_has_package(pkg_name[i].c_str()),
Info::has_package(pkg_name[i]));
}
TEST_F(LAMMPS_configuration, package_count)
{
int package_count = 0;
while (LAMMPS::installed_packages[package_count] != nullptr)
package_count++;
EXPECT_EQ(f_lammps_package_count(), package_count);
};
TEST_F(LAMMPS_configuration, package_name)
{
int i = 0;
while (LAMMPS::installed_packages[i] != nullptr)
{
char* name = f_lammps_package_name(i+1); // 1 in Fortran is 0 in C
if (name)
EXPECT_STREQ(LAMMPS::installed_packages[i], name);
else
EXPECT_STREQ(LAMMPS::installed_packages[i], "NOT FOUND");
std::free(name);
i++;
}
};
TEST_F(LAMMPS_configuration, config_accelerator)
{
const int npackage = 4;
const int ncategory = 2;
const int nsetting_api = 7;
const int nsetting_precision = 3;
const std::string package[] = {"GPU","KOKKOS","INTEL","OPENMP"};
const std::string category[] = {"api","precision"};
const std::string setting_api[] = {"cuda","hip","phi","pthreads","opencl",
"openmp","serial"};
const std::string setting_precision[] = {"double","mixed","single"};
for (int p=0; p < npackage; p++)
{
for (int c=0; c < ncategory; c++)
{
if (category[c] == "api")
{
for (int s=0; s < nsetting_api; s++)
EXPECT_EQ(f_lammps_config_accelerator(package[p].c_str(), category[c].c_str(),
setting_api[s].c_str()),
Info::has_accelerator_feature(package[p], category[c], setting_api[s]));
}
else if (category[c] == "precision")
{
for (int s=0; s < nsetting_precision; s++)
EXPECT_EQ(f_lammps_config_accelerator(package[p].c_str(), category[c].c_str(),
setting_precision[s].c_str()),
Info::has_accelerator_feature(package[p],category[c],setting_precision[s]));
}
}
}
};
TEST_F(LAMMPS_configuration, has_gpu)
{
EXPECT_EQ(Info::has_gpu_device(), f_lammps_has_gpu());
};
TEST_F(LAMMPS_configuration, get_gpu_info)
{
if (!Info::has_gpu_device()) GTEST_SKIP();
size_t n;
std::string cpp_info = Info::get_gpu_device_info();
n = cpp_info.size();
char* f_string;
f_string = f_lammps_get_gpu_info(n);
EXPECT_STREQ(f_string, cpp_info.c_str());
std::free(f_string);
if (n > 80)
{
f_string = f_lammps_get_gpu_info(80);
cpp_info.resize(80);
EXPECT_STREQ(f_string, cpp_info.c_str());
std::free(f_string);
}
};
} // namespace LAMMPS_NS

7
unittest/fortran/wrap_properties.cpp
View File

@ -2,6 +2,7 @@
#include "lammps.h"
#include "library.h"
#include "info.h"
#include <cstdint>
#include <string>
@ -13,7 +14,6 @@
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 *);
@ -52,11 +52,6 @@ protected:
}
};
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