lijiext
/
lammps
mirror of https://github.com/lammps/lammps.git
1
0
Fork 1
Code Issues Packages Projects Releases Wiki Activity

I wrote unit tests for all the Fortran interface commands in this pull request

This commit is contained in:
Karl Hammond 2022-09-14 21:07:32 -05:00
parent 9a44d708e9
commit 72573987fa
11 changed files with 1556 additions and 212 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

466
fortran/lammps.f90
View File

@ -19,19 +19,19 @@
! Karl D. Hammond <hammondkd@missouri.edu>
! 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

25
unittest/fortran/CMakeLists.txt
View File

@ -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()

142
unittest/fortran/test_fortran_box.f90 Normal file
View File

@ -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

1
unittest/fortran/test_fortran_commands.f90
View File

@ -1,5 +1,6 @@
MODULE keepcmds
USE liblammps
IMPLICIT NONE
TYPE(LAMMPS) :: lmp
CHARACTER(len=40), DIMENSION(3), PARAMETER :: demo_input = &
[ CHARACTER(len=40) :: &

491
unittest/fortran/test_fortran_extract_global.f90 Normal file
View File

@ -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

174
unittest/fortran/test_fortran_get_thermo.f90 Normal file
View File

@ -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

52
unittest/fortran/test_fortran_properties.f90 Normal file
View File

@ -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

64
unittest/fortran/wrap_box.cpp Normal file
View File

@ -0,0 +1,64 @@
// unit tests for extracting box dimensions fom a LAMMPS instance through the Fortran wrapper
#include "lammps.h"
#include <mpi.h>
#include <string>
#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);
};

177
unittest/fortran/wrap_extract_global.cpp Normal file
View File

@ -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 <mpi.h>
#include <string>
#include <cstdlib>
#include <cstdint>
#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
}

67
unittest/fortran/wrap_get_thermo.cpp Normal file
View File

@ -0,0 +1,67 @@
// unit tests for getting thermodynamic output from a LAMMPS instance through the Fortran wrapper
#include "lammps.h"
#include <mpi.h>
#include <string>
#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);
};

109
unittest/fortran/wrap_properties.cpp Normal file
View File

@ -0,0 +1,109 @@
// unit tests for getting LAMMPS properties through the Fortran wrapper
#include "lammps.h"
//#include <cstdio> // for stdin, stdout
#include "library.h"
#include <mpi.h>
#include <string>
#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);
};