diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 9191586bcc..d09754cac4 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -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 ` 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 `. + + 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 `. 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. diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index a4551aad6d..8554d13476 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -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 diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index 4b3eccb2e9..75c14626e9 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -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() diff --git a/unittest/fortran/keepstuff.f90 b/unittest/fortran/keepstuff.f90 index 6838d78955..e48eed4734 100644 --- a/unittest/fortran/keepstuff.f90 +++ b/unittest/fortran/keepstuff.f90 @@ -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 diff --git a/unittest/fortran/test_fortran_configuration.f90 b/unittest/fortran/test_fortran_configuration.f90 new file mode 100644 index 0000000000..55ec712249 --- /dev/null +++ b/unittest/fortran/test_fortran_configuration.f90 @@ -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 diff --git a/unittest/fortran/test_fortran_extract_variable.f90 b/unittest/fortran/test_fortran_extract_variable.f90 index c10e3eaa04..b4b5ab8727 100644 --- a/unittest/fortran/test_fortran_extract_variable.f90 +++ b/unittest/fortran/test_fortran_extract_variable.f90 @@ -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 diff --git a/unittest/fortran/test_fortran_properties.f90 b/unittest/fortran/test_fortran_properties.f90 index bbb47f7eb3..b68794ce14 100644 --- a/unittest/fortran/test_fortran_properties.f90 +++ b/unittest/fortran/test_fortran_properties.f90 @@ -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 diff --git a/unittest/fortran/wrap_configuration.cpp b/unittest/fortran/wrap_configuration.cpp new file mode 100644 index 0000000000..e07620ed34 --- /dev/null +++ b/unittest/fortran/wrap_configuration.cpp @@ -0,0 +1,204 @@ +// unit tests for getting LAMMPS configuration through the Fortran wrapper + +#include "lammps.h" +#include "library.h" +#include "info.h" + +#include + +#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 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 diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp index 7112a50081..50704d326a 100644 --- a/unittest/fortran/wrap_properties.cpp +++ b/unittest/fortran/wrap_properties.cpp @@ -2,6 +2,7 @@ #include "lammps.h" #include "library.h" +#include "info.h" #include #include @@ -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