diff --git a/fortran/lammps.f90 b/fortran/lammps.f90 index 5916823df1..7541bf7c0f 100644 --- a/fortran/lammps.f90 +++ b/fortran/lammps.f90 @@ -19,19 +19,19 @@ ! Karl D. Hammond ! University of Missouri, 2012-2020 ! -! The Fortran module tries to follow the API of the C-library interface -! closely, but like the Python wrapper it employs an object oriented -! approach. To accommodate the object oriented approach, all exported -! subroutine and functions have to be implemented in Fortran to then -! call the interfaced C style functions with adapted calling conventions -! as needed. The C-library interfaced functions retain their names -! starting with "lammps_" while the Fortran versions start with "lmp_". +! The Fortran module tries to follow the API of the C library interface +! closely, but like the Python wrapper it employs an object-oriented +! approach. To accommodate the object-oriented approach, all exported +! subroutines and functions have to be implemented in Fortran and +! call the interfaced C-style functions with adapted calling conventions +! as needed. The C library interface functions retain their names +! starting with "lammps_", while the Fortran versions start with "lmp_". ! MODULE LIBLAMMPS USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_loc, & c_int, c_int64_t, c_char, c_null_char, c_double, c_size_t, c_f_pointer - USE, INTRINSIC :: ISO_Fortran_env, ONLY : ERROR_UNIT, OUTPUT_UNIT ! FIXME + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : ERROR_UNIT IMPLICIT NONE PRIVATE @@ -69,6 +69,7 @@ MODULE LIBLAMMPS PROCEDURE :: extract_setting => lmp_extract_setting PROCEDURE :: extract_global => lmp_extract_global PROCEDURE :: version => lmp_version + PROCEDURE :: is_running => lmp_is_running END TYPE lammps INTERFACE lammps @@ -104,257 +105,262 @@ MODULE LIBLAMMPS ! LAMMPS data (after checking type-compatibility) INTERFACE ASSIGNMENT(=) MODULE PROCEDURE assign_int_to_lammps_data, assign_int64_to_lammps_data, & + assign_intvec_to_lammps_data, & assign_double_to_lammps_data, assign_doublevec_to_lammps_data, & assign_string_to_lammps_data END INTERFACE ! interface definitions for calling functions in library.cpp INTERFACE - FUNCTION lammps_open(argc, argv, comm) BIND(C,name='lammps_open_fortran') - IMPORT :: c_ptr, c_int - IMPLICIT NONE - INTEGER(c_int), VALUE, INTENT(IN) :: argc, comm - TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv - TYPE(c_ptr) :: lammps_open - END FUNCTION lammps_open + FUNCTION lammps_open(argc, argv, comm) BIND(C,name='lammps_open_fortran') + IMPORT :: c_ptr, c_int + IMPLICIT NONE + INTEGER(c_int), VALUE, INTENT(IN) :: argc, comm + TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv + TYPE(c_ptr) :: lammps_open + END FUNCTION lammps_open - FUNCTION lammps_open_no_mpi(argc, argv, handle) BIND(C) - IMPORT :: c_ptr, c_int - IMPLICIT NONE - INTEGER(c_int), VALUE, INTENT(IN) :: argc - TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv - TYPE(c_ptr), VALUE, INTENT(IN) :: handle - TYPE(c_ptr) :: lammps_open_no_mpi - END FUNCTION lammps_open_no_mpi + FUNCTION lammps_open_no_mpi(argc, argv, handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + INTEGER(c_int), VALUE, INTENT(IN) :: argc + TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: argv + TYPE(c_ptr), VALUE, INTENT(IN) :: handle + TYPE(c_ptr) :: lammps_open_no_mpi + END FUNCTION lammps_open_no_mpi - SUBROUTINE lammps_close(handle) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - END SUBROUTINE lammps_close + SUBROUTINE lammps_close(handle) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + END SUBROUTINE lammps_close - SUBROUTINE lammps_mpi_init() BIND(C) - END SUBROUTINE lammps_mpi_init + SUBROUTINE lammps_mpi_init() BIND(C) + END SUBROUTINE lammps_mpi_init - SUBROUTINE lammps_mpi_finalize() BIND(C) - END SUBROUTINE lammps_mpi_finalize + SUBROUTINE lammps_mpi_finalize() BIND(C) + END SUBROUTINE lammps_mpi_finalize - SUBROUTINE lammps_kokkos_finalize() BIND(C) - END SUBROUTINE lammps_kokkos_finalize + SUBROUTINE lammps_kokkos_finalize() BIND(C) + END SUBROUTINE lammps_kokkos_finalize - SUBROUTINE lammps_file(handle, filename) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: filename - END SUBROUTINE lammps_file + SUBROUTINE lammps_file(handle, filename) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), VALUE :: filename + END SUBROUTINE lammps_file - SUBROUTINE lammps_command(handle, cmd) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: cmd - END SUBROUTINE lammps_command + SUBROUTINE lammps_command(handle, cmd) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), VALUE :: cmd + END SUBROUTINE lammps_command - SUBROUTINE lammps_commands_list(handle, ncmd, cmds) BIND(C) - IMPORT :: c_ptr, c_int - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - INTEGER(c_int), VALUE, INTENT(IN) :: ncmd - TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: cmds - END SUBROUTINE lammps_commands_list + SUBROUTINE lammps_commands_list(handle, ncmd, cmds) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + INTEGER(c_int), VALUE, INTENT(IN) :: ncmd + TYPE(c_ptr), DIMENSION(*), INTENT(IN) :: cmds + END SUBROUTINE lammps_commands_list - SUBROUTINE lammps_commands_string(handle, str) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: str - END SUBROUTINE lammps_commands_string + SUBROUTINE lammps_commands_string(handle, str) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), VALUE :: str + END SUBROUTINE lammps_commands_string - FUNCTION lammps_get_natoms(handle) BIND(C) - IMPORT :: c_ptr, c_double - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - REAL(c_double) :: lammps_get_natoms - END FUNCTION lammps_get_natoms + FUNCTION lammps_get_natoms(handle) BIND(C) + IMPORT :: c_ptr, c_double + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + REAL(c_double) :: lammps_get_natoms + END FUNCTION lammps_get_natoms - FUNCTION lammps_get_thermo(handle,name) BIND(C) - IMPORT :: c_ptr, c_double - IMPLICIT NONE - REAL(c_double) :: lammps_get_thermo - TYPE(c_ptr), VALUE :: handle - TYPE(c_ptr), VALUE :: name - END FUNCTION lammps_get_thermo + FUNCTION lammps_get_thermo(handle,name) BIND(C) + IMPORT :: c_ptr, c_double + IMPLICIT NONE + REAL(c_double) :: lammps_get_thermo + TYPE(c_ptr), VALUE :: handle + TYPE(c_ptr), VALUE :: name + END FUNCTION lammps_get_thermo - SUBROUTINE lammps_extract_box(handle,boxlo,boxhi,xy,yz,xz,pflags, & - boxflag) BIND(C) - IMPORT :: c_ptr, c_double, c_int - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle, boxlo, boxhi, xy, yz, xz, pflags, & - boxflag - END SUBROUTINE lammps_extract_box + SUBROUTINE lammps_extract_box(handle,boxlo,boxhi,xy,yz,xz,pflags, & + boxflag) BIND(C) + IMPORT :: c_ptr, c_double, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, boxlo, boxhi, xy, yz, xz, pflags, & + boxflag + END SUBROUTINE lammps_extract_box - SUBROUTINE lammps_reset_box(handle,boxlo,boxhi,xy,yz,xz) BIND(C) - IMPORT :: c_ptr, c_double - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - REAL(c_double), DIMENSION(3) :: boxlo, boxhi - REAL(c_double), VALUE :: xy, yz, xz - END SUBROUTINE lammps_reset_box + SUBROUTINE lammps_reset_box(handle,boxlo,boxhi,xy,yz,xz) BIND(C) + IMPORT :: c_ptr, c_double + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + REAL(c_double), DIMENSION(3) :: boxlo, boxhi + REAL(c_double), VALUE :: xy, yz, xz + END SUBROUTINE lammps_reset_box - SUBROUTINE lammps_memory_usage(handle,meminfo) BIND(C) - IMPORT :: c_ptr, c_double - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - REAL(c_double), DIMENSION(*) :: meminfo - END SUBROUTINE lammps_memory_usage + SUBROUTINE lammps_memory_usage(handle,meminfo) BIND(C) + IMPORT :: c_ptr, c_double + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + REAL(c_double), DIMENSION(*) :: meminfo + END SUBROUTINE lammps_memory_usage - FUNCTION lammps_get_mpi_comm(handle) BIND(C) - IMPORT :: c_ptr, c_int - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - INTEGER(c_int) :: lammps_get_mpi_comm - END FUNCTION lammps_get_mpi_comm + FUNCTION lammps_get_mpi_comm(handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + INTEGER(c_int) :: lammps_get_mpi_comm + END FUNCTION lammps_get_mpi_comm - FUNCTION lammps_extract_setting(handle,keyword) BIND(C) - IMPORT :: c_ptr, c_int - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle, keyword - INTEGER(c_int) :: lammps_extract_setting - END FUNCTION lammps_extract_setting + FUNCTION lammps_extract_setting(handle,keyword) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, keyword + INTEGER(c_int) :: lammps_extract_setting + END FUNCTION lammps_extract_setting - FUNCTION lammps_extract_global_datatype(handle,name) BIND(C) - IMPORT :: c_ptr, c_int - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle, name - INTEGER(c_int) :: lammps_extract_global_datatype - END FUNCTION lammps_extract_global_datatype + FUNCTION lammps_extract_global_datatype(handle,name) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, name + INTEGER(c_int) :: lammps_extract_global_datatype + END FUNCTION lammps_extract_global_datatype - FUNCTION c_strlen (str) BIND(C,name='strlen') - IMPORT :: c_ptr, c_size_t - IMPLICIT NONE - TYPE(c_ptr) :: str - INTEGER(c_size_t) :: c_strlen - END FUNCTION c_strlen + FUNCTION c_strlen (str) BIND(C,name='strlen') + IMPORT :: c_ptr, c_size_t + IMPLICIT NONE + TYPE(c_ptr), VALUE :: str + INTEGER(c_size_t) :: c_strlen + END FUNCTION c_strlen - FUNCTION lammps_extract_global(handle, name) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle, name - TYPE(c_ptr) :: lammps_extract_global - END FUNCTION lammps_extract_global + FUNCTION lammps_extract_global(handle, name) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle, name + TYPE(c_ptr) :: lammps_extract_global + END FUNCTION lammps_extract_global - !INTEGER (c_int) FUNCTION lammps_extract_atom_datatype + !INTEGER (c_int) FUNCTION lammps_extract_atom_datatype - !(generic) lammps_extract_atom + !(generic) lammps_extract_atom - !(generic) lammps_extract_compute + !(generic) lammps_extract_compute - !(generic) lammps_extract_fix + !(generic) lammps_extract_fix - !(generic) lammps_extract_variable + !(generic) lammps_extract_variable - !INTEGER (c_int) lammps_set_variable + !INTEGER (c_int) lammps_set_variable - !SUBROUTINE lammps_gather_atoms + !SUBROUTINE lammps_gather_atoms - !SUBROUTINE lammps_gather_atoms_concat + !SUBROUTINE lammps_gather_atoms_concat - !SUBROUTINE lammps_gather_atoms_subset + !SUBROUTINE lammps_gather_atoms_subset - !SUBROUTINE lammps_scatter_atoms + !SUBROUTINE lammps_scatter_atoms - !SUBROUTINE lammps_scatter_atoms_subset + !SUBROUTINE lammps_scatter_atoms_subset - !SUBROUTINE lammps_gather_bonds + !SUBROUTINE lammps_gather_bonds - !SUBROUTINE lammps_gather + !SUBROUTINE lammps_gather - !SUBROUTINE lammps_gather_concat + !SUBROUTINE lammps_gather_concat - !SUBROUTINE lammps_gather_subset + !SUBROUTINE lammps_gather_subset - !SUBROUTINE lammps_scatter_subset + !SUBROUTINE lammps_scatter_subset - !(generic / id, type, and image are special) / requires LAMMPS_BIGBIG - !INTEGER (C_int) FUNCTION lammps_create_atoms + !(generic / id, type, and image are special) / requires LAMMPS_BIGBIG + !INTEGER (C_int) FUNCTION lammps_create_atoms - !INTEGER (C_int) FUNCTION lammps_find_pair_neighlist + !INTEGER (C_int) FUNCTION lammps_find_pair_neighlist - !INTEGER (C_int) FUNCTION lammps_find_fix_neighlist + !INTEGER (C_int) FUNCTION lammps_find_fix_neighlist - !INTEGER (C_int) FUNCTION lammps_find_compute_neighlist + !INTEGER (C_int) FUNCTION lammps_find_compute_neighlist - !INTEGER (C_int) FUNCTION lammps_neighlist_num_elements + !INTEGER (C_int) FUNCTION lammps_neighlist_num_elements - !SUBROUTINE lammps_neighlist_element_neighbors + !SUBROUTINE lammps_neighlist_element_neighbors - FUNCTION lammps_version(handle) BIND(C) - IMPORT :: c_ptr, c_int - IMPLICIT NONE - TYPE(c_ptr), VALUE :: handle - INTEGER(c_int) :: lammps_version - END FUNCTION lammps_version + FUNCTION lammps_version(handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + INTEGER(c_int) :: lammps_version + END FUNCTION lammps_version - !SUBROUTINE lammps_get_os_info + !SUBROUTINE lammps_get_os_info - !LOGICAL FUNCTION lammps_config_has_mpi_support - !LOGICAL FUNCTION lammps_config_has_gzip_support - !LOGICAL FUNCTION lammps_config_has_png_support - !LOGICAL FUNCTION lammps_config_has_jpeg_support - !LOGICAL FUNCTION lammps_config_has_ffmpeg_support - !LOGICAL FUNCTION lammps_config_has_exceptions - !LOGICAL FUNCTION lammps_config_has_package - !INTEGER (C_int) FUNCTION lammps_config_package_count - !SUBROUTINE lammps_config_package_name + !LOGICAL FUNCTION lammps_config_has_mpi_support + !LOGICAL FUNCTION lammps_config_has_gzip_support + !LOGICAL FUNCTION lammps_config_has_png_support + !LOGICAL FUNCTION lammps_config_has_jpeg_support + !LOGICAL FUNCTION lammps_config_has_ffmpeg_support + !LOGICAL FUNCTION lammps_config_has_exceptions + !LOGICAL FUNCTION lammps_config_has_package + !INTEGER (C_int) FUNCTION lammps_config_package_count + !SUBROUTINE lammps_config_package_name - !LOGICAL FUNCTION lammps_config_accelerator - !LOGICAL FUNCTION lammps_has_gpu_device - !SUBROUTINE lammps_get_gpu_device + !LOGICAL FUNCTION lammps_config_accelerator + !LOGICAL FUNCTION lammps_has_gpu_device + !SUBROUTINE lammps_get_gpu_device - !LOGICAL FUNCTION lammps_has_id - !INTEGER (C_int) FUNCTION lammps_id_count - !SUBROUTINE lammps_id_name + !LOGICAL FUNCTION lammps_has_id + !INTEGER (C_int) FUNCTION lammps_id_count + !SUBROUTINE lammps_id_name - !INTEGER (C_int) FUNCTION lammps_plugin_count - !SUBROUTINE lammps_plugin_name + !INTEGER (C_int) FUNCTION lammps_plugin_count + !SUBROUTINE lammps_plugin_name - !Both of these use LAMMPS_BIGBIG - !INTEGER (LAMMPS_imageint) FUNCTION lammps_encode_image_flags - !SUBROUTINE lammps_decode_image_flags + !Both of these use LAMMPS_BIGBIG + !INTEGER (LAMMPS_imageint) FUNCTION lammps_encode_image_flags + !SUBROUTINE lammps_decode_image_flags - !SUBROUTINE lammps_set_fix_external_callback ! may have trouble.... - !FUNCTION lammps_fix_external_get_force() ! returns real(c_double) (:) + !SUBROUTINE lammps_set_fix_external_callback ! may have trouble.... + !FUNCTION lammps_fix_external_get_force() ! returns real(c_double) (:) - !SUBROUTINE lammps_fix_external_set_energy_global - !SUBROUTINE lammps_fix_external_set_energy_peratom - !SUBROUTINE lammps_fix_external_set_virial_global - !SUBROUTINE lammps_fix_external_set_virial_peratom - !SUBROUTINE lammps_fix_external_set_vector_length - !SUBROUTINE lammps_fix_external_set_vector + !SUBROUTINE lammps_fix_external_set_energy_global + !SUBROUTINE lammps_fix_external_set_energy_peratom + !SUBROUTINE lammps_fix_external_set_virial_global + !SUBROUTINE lammps_fix_external_set_virial_peratom + !SUBROUTINE lammps_fix_external_set_vector_length + !SUBROUTINE lammps_fix_external_set_vector - !SUBROUTINE lammps_flush_buffers + !SUBROUTINE lammps_flush_buffers - FUNCTION lammps_malloc(size) BIND(C, name='malloc') - IMPORT :: c_ptr, c_size_t - IMPLICIT NONE - INTEGER(c_size_t), VALUE :: size - TYPE(c_ptr) :: lammps_malloc - END FUNCTION lammps_malloc + FUNCTION lammps_malloc(size) BIND(C, name='malloc') + IMPORT :: c_ptr, c_size_t + IMPLICIT NONE + INTEGER(c_size_t), VALUE :: size + TYPE(c_ptr) :: lammps_malloc + END FUNCTION lammps_malloc - SUBROUTINE lammps_free(ptr) BIND(C) - IMPORT :: c_ptr - IMPLICIT NONE - TYPE(c_ptr), VALUE :: ptr - END SUBROUTINE lammps_free + SUBROUTINE lammps_free(ptr) BIND(C) + IMPORT :: c_ptr + IMPLICIT NONE + TYPE(c_ptr), VALUE :: ptr + END SUBROUTINE lammps_free - !LOGICAL FUNCTION lammps_is_running + INTEGER(c_int) FUNCTION lammps_is_running(handle) BIND(C) + IMPORT :: c_ptr, c_int + IMPLICIT NONE + TYPE(c_ptr), VALUE :: handle + END FUNCTION lammps_is_running - !SUBROUTINE lammps_force_timeout + !SUBROUTINE lammps_force_timeout - !LOGICAL FUNCTION lammps_has_error + !LOGICAL FUNCTION lammps_has_error - !INTEGER (c_int) FUNCTION lammps_get_last_error_message + !INTEGER (c_int) FUNCTION lammps_get_last_error_message END INTERFACE @@ -558,7 +564,7 @@ CONTAINS ! equivalent function to lammps_extract_global ! the assignment is actually overloaded so as to bind the pointers to ! lammps data based on the information available from LAMMPS - FUNCTION lmp_extract_global (self, name) result(global_data) + FUNCTION lmp_extract_global (self, name) RESULT (global_data) CLASS(lammps), INTENT(IN) :: self CHARACTER(LEN=*), INTENT(IN) :: name TYPE(lammps_data) :: global_data @@ -622,7 +628,7 @@ CONTAINS CASE DEFAULT WRITE(ERROR_UNIT,'(A)') 'ERROR: Unknown pointer type in& & extract_global' - STOP + STOP 2 END SELECT END FUNCTION @@ -633,6 +639,13 @@ CONTAINS lmp_version = lammps_version(self%handle) END FUNCTION lmp_version + ! equivalent function to lammps_is_running + LOGICAL FUNCTION lmp_is_running(self) + CLASS(lammps) :: self + + lmp_is_running = ( lammps_is_running(self%handle) /= 0_C_int ) + END FUNCTION lmp_is_running + ! ---------------------------------------------------------------------- ! functions to assign user-space pointers to LAMMPS data ! ---------------------------------------------------------------------- @@ -643,8 +656,7 @@ CONTAINS IF ( rhs%datatype == DATA_INT ) THEN lhs => rhs%i32 ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'scalar int') END IF END SUBROUTINE assign_int_to_lammps_data @@ -655,11 +667,21 @@ CONTAINS IF ( rhs%datatype == DATA_INT64 ) THEN lhs => rhs%i64 ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'scalar long int') END IF END SUBROUTINE assign_int64_to_lammps_data + SUBROUTINE assign_intvec_to_lammps_data (lhs, rhs) + INTEGER(c_int), DIMENSION(:), INTENT(OUT), POINTER :: lhs + CLASS(lammps_data), INTENT(IN) :: rhs + + IF ( rhs%datatype == DATA_INT_1D ) THEN + lhs => rhs%i32_vec + ELSE + CALL assignment_error(rhs%datatype, 'vector of ints') + END IF + END SUBROUTINE assign_intvec_to_lammps_data + SUBROUTINE assign_double_to_lammps_data (lhs, rhs) REAL(c_double), INTENT(OUT), POINTER :: lhs CLASS(lammps_data), INTENT(IN) :: rhs @@ -667,8 +689,7 @@ CONTAINS IF ( rhs%datatype == DATA_DOUBLE ) THEN lhs => rhs%r64 ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'scalar double') END IF END SUBROUTINE assign_double_to_lammps_data @@ -679,8 +700,7 @@ CONTAINS IF ( rhs%datatype == DATA_DOUBLE_1D ) THEN lhs => rhs%r64_vec ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'vector of doubles') END IF END SUBROUTINE assign_doublevec_to_lammps_data @@ -691,11 +711,41 @@ CONTAINS IF ( rhs%datatype == DATA_STRING ) THEN lhs = rhs%str ELSE - WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment' - STOP + CALL assignment_error(rhs%datatype, 'string') END IF END SUBROUTINE assign_string_to_lammps_data + SUBROUTINE assignment_error (type1, type2) + INTEGER (c_int) :: type1 + CHARACTER (LEN=*) :: type2 + INTEGER, PARAMETER :: ERROR_CODE = 1 + CHARACTER (LEN=:), ALLOCATABLE :: str1 + + SELECT CASE (type1) + CASE (DATA_INT) + str1 = 'scalar int' + CASE (DATA_INT_1D) + str1 = 'vector of ints' + CASE (DATA_INT_2D) + str1 = 'matrix of ints' + CASE (DATA_INT64) + str1 = 'scalar long int' + CASE (DATA_INT64_1D) + str1 = 'vector of long ints' + CASE (DATA_INT64_2D) + str1 = 'matrix of long ints' + CASE (DATA_DOUBLE) + str1 = 'scalar double' + CASE (DATA_DOUBLE_1D) + str1 = 'vector of doubles' + CASE (DATA_DOUBLE_2D) + str1 = 'matrix of doubles' + CASE DEFAULT + str1 = 'that type' + END SELECT + WRITE (ERROR_UNIT,'(A)') 'Cannot associate ' // str1 // ' with ' // type2 + STOP ERROR_CODE + END SUBROUTINE assignment_error ! ---------------------------------------------------------------------- ! local helper functions diff --git a/unittest/fortran/CMakeLists.txt b/unittest/fortran/CMakeLists.txt index c7174d8e6e..c2bea82480 100644 --- a/unittest/fortran/CMakeLists.txt +++ b/unittest/fortran/CMakeLists.txt @@ -6,14 +6,14 @@ endif() include(CheckLanguage) check_language(Fortran) -if(NOT CMAKE_Fortran_COMPILER_ID) - message(STATUS "Skipping Tests for the LAMMPS Fortran Module: cannot identify Fortran compiler") - return() -endif() if(CMAKE_Fortran_COMPILER) enable_language(C) enable_language(Fortran) + if(NOT CMAKE_Fortran_COMPILER_ID) + message(STATUS "Skipping Tests for the LAMMPS Fortran Module: cannot identify Fortran compiler") + return() + endif() get_filename_component(LAMMPS_FORTRAN_MODULE ${LAMMPS_SOURCE_DIR}/../fortran/lammps.f90 ABSOLUTE) if(BUILD_MPI) find_package(MPI REQUIRED) @@ -40,6 +40,23 @@ if(CMAKE_Fortran_COMPILER) add_executable(test_fortran_commands wrap_commands.cpp test_fortran_commands.f90) target_link_libraries(test_fortran_commands PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) add_test(NAME FortranCommands COMMAND test_fortran_commands) + + add_executable(test_fortran_get_thermo wrap_get_thermo.cpp test_fortran_get_thermo.f90) + target_link_libraries(test_fortran_get_thermo PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranGetThermo COMMAND test_fortran_get_thermo) + + add_executable(test_fortran_box wrap_box.cpp test_fortran_box.f90) + target_link_libraries(test_fortran_box PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranBox COMMAND test_fortran_box) + + add_executable(test_fortran_properties wrap_properties.cpp test_fortran_properties.f90 test_fortran_commands.f90) + target_link_libraries(test_fortran_properties PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranProperties COMMAND test_fortran_properties) + + add_executable(test_fortran_extract_global wrap_extract_global.cpp test_fortran_extract_global.f90) + target_link_libraries(test_fortran_extract_global PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain) + add_test(NAME FortranExtractGlobal COMMAND test_fortran_extract_global) + else() message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler") endif() diff --git a/unittest/fortran/test_fortran_box.f90 b/unittest/fortran/test_fortran_box.f90 new file mode 100644 index 0000000000..c21918afd0 --- /dev/null +++ b/unittest/fortran/test_fortran_box.f90 @@ -0,0 +1,142 @@ +MODULE keepbox + USE liblammps + IMPLICIT NONE + TYPE(LAMMPS) :: lmp + CHARACTER(len=40), DIMENSION(3), PARAMETER :: demo_input = & + [ CHARACTER(len=40) :: & + 'region box block 0 $x 0 2 0 2', & + 'create_box 1 box', & + 'create_atoms 1 single 1.0 1.0 ${zpos}' ] + CHARACTER(len=40), DIMENSION(2), PARAMETER :: cont_input = & + [ CHARACTER(len=40) :: & + 'create_atoms 1 single &', & + ' 0.2 0.1 0.1' ] +END MODULE keepbox + +FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") + USE ISO_C_BINDING, ONLY: c_ptr + USE liblammps + USE keepbox, ONLY: lmp + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_with_args + + CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = & + [ CHARACTER(len=12) :: 'liblammps', '-log', 'none', & + '-echo','screen','-nocite','-var','zpos','1.5','-var','x','2'] + + lmp = lammps(args) + f_lammps_with_args = lmp%handle +END FUNCTION f_lammps_with_args + +SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close") + USE ISO_C_BINDING, ONLY: c_null_ptr + USE liblammps + USE keepbox, ONLY: lmp + IMPLICIT NONE + + CALL lmp%close() + lmp%handle = c_null_ptr +END SUBROUTINE f_lammps_close + +SUBROUTINE f_lammps_box_setup () BIND(C) + USE liblammps + USE keepbox, ONLY : lmp, demo_input + IMPLICIT NONE + + CALL lmp%commands_list(demo_input) +END SUBROUTINE f_lammps_box_setup + +SUBROUTINE f_lammps_delete_everything() BIND(C) + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + + CALL lmp%command("delete_atoms group all"); +END SUBROUTINE f_lammps_delete_everything + +FUNCTION f_lammps_extract_box_xlo () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_extract_box_xlo + REAL (c_double) :: boxdim(3) + + CALL lmp%extract_box(boxlo=boxdim) + f_lammps_extract_box_xlo = boxdim(1) +END FUNCTION f_lammps_extract_box_xlo + +FUNCTION f_lammps_extract_box_xhi () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_extract_box_xhi + REAL (c_double) :: boxdim(3) + + CALL lmp%extract_box(boxhi=boxdim) + f_lammps_extract_box_xhi = boxdim(1) +END FUNCTION f_lammps_extract_box_xhi + +FUNCTION f_lammps_extract_box_ylo () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_extract_box_ylo + REAL (c_double) :: boxdim(3) + + CALL lmp%extract_box(boxlo=boxdim) + f_lammps_extract_box_ylo = boxdim(2) +END FUNCTION f_lammps_extract_box_ylo + +FUNCTION f_lammps_extract_box_yhi () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_extract_box_yhi + REAL (c_double) :: boxdim(3) + + CALL lmp%extract_box(boxhi=boxdim) + f_lammps_extract_box_yhi = boxdim(2) +END FUNCTION f_lammps_extract_box_yhi + +FUNCTION f_lammps_extract_box_zlo () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_extract_box_zlo + REAL (c_double) :: boxdim(3) + + CALL lmp%extract_box(boxlo=boxdim) + f_lammps_extract_box_zlo = boxdim(2) +END FUNCTION f_lammps_extract_box_zlo + +FUNCTION f_lammps_extract_box_zhi () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_extract_box_zhi + REAL (c_double) :: boxdim(3) + + CALL lmp%extract_box(boxhi=boxdim) + f_lammps_extract_box_zhi = boxdim(2) +END FUNCTION f_lammps_extract_box_zhi + +SUBROUTINE f_lammps_reset_box_2x () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double + USE liblammps + USE keepbox, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: newlo(3), newhi(3), xy, yz, xz + + xy = 0.0_c_double + yz = 0.0_c_double + xz = 0.0_c_double + newlo = [-1.0_c_double, -1.0_c_double, -1.0_c_double] + newhi = [3.0_c_double, 3.0_c_double, 3.0_c_double] + CALL lmp%reset_box(newlo, newhi, xy, yz, xz) +END SUBROUTINE f_lammps_reset_box_2x diff --git a/unittest/fortran/test_fortran_commands.f90 b/unittest/fortran/test_fortran_commands.f90 index b5cffe698f..d85b0f183e 100644 --- a/unittest/fortran/test_fortran_commands.f90 +++ b/unittest/fortran/test_fortran_commands.f90 @@ -1,5 +1,6 @@ MODULE keepcmds USE liblammps + IMPLICIT NONE TYPE(LAMMPS) :: lmp CHARACTER(len=40), DIMENSION(3), PARAMETER :: demo_input = & [ CHARACTER(len=40) :: & diff --git a/unittest/fortran/test_fortran_extract_global.f90 b/unittest/fortran/test_fortran_extract_global.f90 new file mode 100644 index 0000000000..9a8552d677 --- /dev/null +++ b/unittest/fortran/test_fortran_extract_global.f90 @@ -0,0 +1,491 @@ +MODULE keepglobal + USE liblammps + TYPE(LAMMPS) :: lmp + CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & + [ CHARACTER(len=40) :: & + 'region box block 0 $x 0 3 0 4', & + 'create_box 1 box', & + 'create_atoms 1 single 1.0 1.0 ${zpos}' ] + CHARACTER(LEN=40), DIMENSION(2), PARAMETER :: cont_input = & + [ CHARACTER(len=40) :: & + 'create_atoms 1 single &', & + ' 0.2 0.1 0.1' ] + CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: pair_input = & + [ CHARACTER(LEN=40) :: & + 'pair_style lj/cut 2.5', & + 'pair_coeff 1 1 1.0 1.0', & + 'mass 1 1.0' ] +END MODULE keepglobal + +FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args") + USE ISO_C_BINDING, ONLY: c_ptr + USE liblammps + USE keepglobal, ONLY: lmp + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_with_args + CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = & + [ CHARACTER(len=12) :: 'liblammps', '-log', 'none', & + '-echo','screen','-nocite','-var','zpos','1.5','-var','x','2'] + + lmp = lammps(args) + f_lammps_with_args = lmp%handle +END FUNCTION f_lammps_with_args + +SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close") + USE ISO_C_BINDING, ONLY: c_null_ptr + USE liblammps + USE keepglobal, ONLY: lmp + IMPLICIT NONE + + CALL lmp%close() + lmp%handle = c_null_ptr +END SUBROUTINE f_lammps_close + +SUBROUTINE f_lammps_setup_extract_global () BIND(C) + USE LIBLAMMPS + USE keepglobal, ONLY : lmp, demo_input, cont_input, pair_input + IMPLICIT NONE + + CALL lmp%commands_list(demo_input) + CALL lmp%commands_list(cont_input) + CALL lmp%commands_list(pair_input) + CALL lmp%command('run 0') +END SUBROUTINE f_lammps_setup_extract_global + +SUBROUTINE f_lammps_setup_full_extract_global () BIND(C) + USE LIBLAMMPS + USE keepglobal, ONLY : lmp + IMPLICIT NONE + INTERFACE + SUBROUTINE f_lammps_setup_extract_global () BIND(C) + END SUBROUTINE f_lammps_setup_extract_global + END INTERFACE + + CALL lmp%command('atom_style full') + CALL f_lammps_setup_extract_global + CALL lmp%command('bond_style zero') + CALL lmp%command('angle_style zero') + CALL lmp%command('dihedral_style zero') + CALL lmp%command('run 0') +END SUBROUTINE f_lammps_setup_full_extract_global + +FUNCTION f_lammps_extract_global_units () BIND(C) RESULT(success) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE LIBLAMMPS + USE keepglobal, ONLY : lmp + IMPLICIT NONE + INTEGER (C_int) :: success + CHARACTER (LEN=16) :: units + + ! passing strings from Fortran to C is icky, so we do the test here and + ! report the result instead + units = lmp%extract_global('units') + IF ( TRIM(units) == 'lj' ) THEN + success = 1_C_int + ELSE + success = 0_C_int + END IF +END FUNCTION f_lammps_extract_global_units + +FUNCTION f_lammps_extract_global_ntimestep () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: ntimestep + INTEGER (C_int) :: f_lammps_extract_global_ntimestep + + ntimestep = lmp%extract_global("ntimestep") + f_lammps_extract_global_ntimestep = ntimestep +END FUNCTION f_lammps_extract_global_ntimestep +FUNCTION f_lammps_extract_global_ntimestep_big () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int64_t), POINTER :: ntimestep + INTEGER (C_int64_t) :: f_lammps_extract_global_ntimestep_big + + ntimestep = lmp%extract_global("ntimestep") + f_lammps_extract_global_ntimestep_big = ntimestep +END FUNCTION f_lammps_extract_global_ntimestep_big + +FUNCTION f_lammps_extract_global_dt () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double), POINTER :: dt + REAL (C_double) :: f_lammps_extract_global_dt + + dt = lmp%extract_global("dt") + f_lammps_extract_global_dt = dt +END FUNCTION f_lammps_extract_global_dt + +SUBROUTINE f_lammps_extract_global_boxlo (C_boxlo) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double), DIMENSION(3) :: C_boxlo + REAL (C_double), DIMENSION(:), POINTER :: boxlo + + boxlo = lmp%extract_global("boxlo") + C_boxlo = boxlo +END SUBROUTINE f_lammps_extract_global_boxlo + +SUBROUTINE f_lammps_extract_global_boxhi (C_boxhi) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double), DIMENSION(3) :: C_boxhi + REAL (C_double), DIMENSION(:), POINTER :: boxhi + + boxhi = lmp%extract_global("boxhi") + C_boxhi = boxhi +END SUBROUTINE f_lammps_extract_global_boxhi + +FUNCTION f_lammps_extract_global_boxxlo () BIND(C) RESULT(C_boxxlo) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_boxxlo + REAL (C_double), POINTER :: boxxlo + + boxxlo = lmp%extract_global("boxxlo") + C_boxxlo = boxxlo +END FUNCTION f_lammps_extract_global_boxxlo + +FUNCTION f_lammps_extract_global_boxxhi () BIND(C) RESULT(C_boxxhi) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_boxxhi + REAL (C_double), POINTER :: boxxhi + + boxxhi = lmp%extract_global("boxxhi") + C_boxxhi = boxxhi +END FUNCTION f_lammps_extract_global_boxxhi + +FUNCTION f_lammps_extract_global_boxylo () BIND(C) RESULT(C_boxylo) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_boxylo + REAL (C_double), POINTER :: boxylo + + boxylo = lmp%extract_global("boxylo") + C_boxylo = boxylo +END FUNCTION f_lammps_extract_global_boxylo + +FUNCTION f_lammps_extract_global_boxyhi () BIND(C) RESULT(C_boxyhi) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_boxyhi + REAL (C_double), POINTER :: boxyhi + + boxyhi = lmp%extract_global("boxyhi") + C_boxyhi = boxyhi +END FUNCTION f_lammps_extract_global_boxyhi + +FUNCTION f_lammps_extract_global_boxzlo () BIND(C) RESULT(C_boxzlo) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_boxzlo + REAL (C_double), POINTER :: boxzlo + + boxzlo = lmp%extract_global("boxzlo") + C_boxzlo = boxzlo +END FUNCTION f_lammps_extract_global_boxzlo + +FUNCTION f_lammps_extract_global_boxzhi () BIND(C) RESULT(C_boxzhi) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_boxzhi + REAL (C_double), POINTER :: boxzhi + + boxzhi = lmp%extract_global("boxzhi") + C_boxzhi = boxzhi +END FUNCTION f_lammps_extract_global_boxzhi + +SUBROUTINE f_lammps_extract_global_periodicity (C_periodicity) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), DIMENSION(3) :: C_periodicity + INTEGER (C_int), DIMENSION(:), POINTER :: periodicity + + periodicity = lmp%extract_global("periodicity") + C_periodicity = periodicity +END SUBROUTINE f_lammps_extract_global_periodicity + +FUNCTION f_lammps_extract_global_triclinic () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: triclinic + INTEGER (C_int) :: f_lammps_extract_global_triclinic + + triclinic = lmp%extract_global("triclinic") + f_lammps_extract_global_triclinic = triclinic +END FUNCTION f_lammps_extract_global_triclinic + +FUNCTION f_lammps_extract_global_xy () BIND(C) RESULT(C_xy) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_xy + REAL (C_double), POINTER :: xy + + xy = lmp%extract_global("xy") + C_xy = xy +END FUNCTION f_lammps_extract_global_xy + +FUNCTION f_lammps_extract_global_xz () BIND(C) RESULT(C_xz) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_xz + REAL (C_double), POINTER :: xz + + xz = lmp%extract_global("xz") + C_xz = xz +END FUNCTION f_lammps_extract_global_xz + +FUNCTION f_lammps_extract_global_yz () BIND(C) RESULT(C_yz) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_yz + REAL (C_double), POINTER :: yz + + yz = lmp%extract_global("yz") + C_yz = yz +END FUNCTION f_lammps_extract_global_yz + +FUNCTION f_lammps_extract_global_natoms () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: natoms + INTEGER (C_int) :: f_lammps_extract_global_natoms + + natoms = lmp%extract_global("natoms") + f_lammps_extract_global_natoms = natoms +END FUNCTION f_lammps_extract_global_natoms +FUNCTION f_lammps_extract_global_natoms_big () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int64_t), POINTER :: natoms + INTEGER (C_int64_t) :: f_lammps_extract_global_natoms_big + + natoms = lmp%extract_global("natoms") + f_lammps_extract_global_natoms_big = natoms +END FUNCTION f_lammps_extract_global_natoms_big + +FUNCTION f_lammps_extract_global_nbonds () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: nbonds + INTEGER (C_int) :: f_lammps_extract_global_nbonds + + nbonds = lmp%extract_global("nbonds") + f_lammps_extract_global_nbonds = nbonds +END FUNCTION f_lammps_extract_global_nbonds +FUNCTION f_lammps_extract_global_nbonds_big () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int64_t), POINTER :: nbonds + INTEGER (C_int64_t) :: f_lammps_extract_global_nbonds_big + + nbonds = lmp%extract_global("nbonds") + f_lammps_extract_global_nbonds_big = nbonds +END FUNCTION f_lammps_extract_global_nbonds_big + +FUNCTION f_lammps_extract_global_nangles () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: nangles + INTEGER (C_int) :: f_lammps_extract_global_nangles + + nangles = lmp%extract_global("nangles") + f_lammps_extract_global_nangles = nangles +END FUNCTION f_lammps_extract_global_nangles +FUNCTION f_lammps_extract_global_nangles_big () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int64_t), POINTER :: nangles + INTEGER (C_int64_t) :: f_lammps_extract_global_nangles_big + + nangles = lmp%extract_global("nangles") + f_lammps_extract_global_nangles_big = nangles +END FUNCTION f_lammps_extract_global_nangles_big + +FUNCTION f_lammps_extract_global_ndihedrals () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: ndihedrals + INTEGER (C_int) :: f_lammps_extract_global_ndihedrals + + ndihedrals = lmp%extract_global("ndihedrals") + f_lammps_extract_global_ndihedrals = ndihedrals +END FUNCTION f_lammps_extract_global_ndihedrals +FUNCTION f_lammps_extract_global_ndihedrals_big () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int64_t), POINTER :: ndihedrals + INTEGER (C_int64_t) :: f_lammps_extract_global_ndihedrals_big + + ndihedrals = lmp%extract_global("ndihedrals") + f_lammps_extract_global_ndihedrals_big = ndihedrals +END FUNCTION f_lammps_extract_global_ndihedrals_big + +FUNCTION f_lammps_extract_global_nimpropers () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: nimpropers + INTEGER (C_int) :: f_lammps_extract_global_nimpropers + + nimpropers = lmp%extract_global("nimpropers") + f_lammps_extract_global_nimpropers = nimpropers +END FUNCTION f_lammps_extract_global_nimpropers +FUNCTION f_lammps_extract_global_nimpropers_big () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int64_t), POINTER :: nimpropers + INTEGER (C_int64_t) :: f_lammps_extract_global_nimpropers_big + + nimpropers = lmp%extract_global("nimpropers") + f_lammps_extract_global_nimpropers_big = nimpropers +END FUNCTION f_lammps_extract_global_nimpropers_big + + +FUNCTION f_lammps_extract_global_ntypes () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: ntypes + INTEGER (C_int) :: f_lammps_extract_global_ntypes + + ntypes = lmp%extract_global("ntypes") + f_lammps_extract_global_ntypes = ntypes +END FUNCTION f_lammps_extract_global_ntypes + +FUNCTION f_lammps_extract_global_nlocal () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: nlocal + INTEGER (C_int) :: f_lammps_extract_global_nlocal + + nlocal = lmp%extract_global("nlocal") + f_lammps_extract_global_nlocal = nlocal +END FUNCTION f_lammps_extract_global_nlocal + +FUNCTION f_lammps_extract_global_nghost () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: nghost + INTEGER (C_int) :: f_lammps_extract_global_nghost + + nghost = lmp%extract_global("nghost") + f_lammps_extract_global_nghost = nghost +END FUNCTION f_lammps_extract_global_nghost + +FUNCTION f_lammps_extract_global_nmax () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int), POINTER :: nmax + INTEGER (C_int) :: f_lammps_extract_global_nmax + + nmax = lmp%extract_global("nmax") + f_lammps_extract_global_nmax = nmax +END FUNCTION f_lammps_extract_global_nmax + +FUNCTION f_lammps_extract_global_boltz () BIND(C) RESULT(C_k_B) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_k_B + REAL (C_double), POINTER :: k_B + + k_B = lmp%extract_global("boltz") + C_k_B = k_B +END FUNCTION f_lammps_extract_global_boltz + +FUNCTION f_lammps_extract_global_hplanck () BIND(C) RESULT(C_h) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: C_h + REAL (C_double), POINTER :: h + + h = lmp%extract_global("boltz") + C_h = h +END FUNCTION f_lammps_extract_global_hplanck + +FUNCTION f_lammps_extract_global_angstrom () BIND(C) RESULT(Angstrom) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: Angstrom + REAL (C_double), POINTER :: A + + A = lmp%extract_global("angstrom") + Angstrom = A +END FUNCTION f_lammps_extract_global_angstrom + +FUNCTION f_lammps_extract_global_femtosecond () BIND(C) RESULT(fs) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE keepglobal, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + REAL (C_double) :: fs + REAL (C_double), POINTER :: femtosecond + + femtosecond = lmp%extract_global("femtosecond") + fs = femtosecond +END FUNCTION f_lammps_extract_global_femtosecond diff --git a/unittest/fortran/test_fortran_get_thermo.f90 b/unittest/fortran/test_fortran_get_thermo.f90 new file mode 100644 index 0000000000..e96c964e7c --- /dev/null +++ b/unittest/fortran/test_fortran_get_thermo.f90 @@ -0,0 +1,174 @@ +MODULE keepthermo + USE liblammps + IMPLICIT NONE + TYPE(LAMMPS) :: lmp + CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: demo_input = & + [ CHARACTER(len=40) :: & + 'region box block 0 $x 0 3 0 4', & + 'create_box 1 box', & + 'create_atoms 1 single 1.0 1.0 ${zpos}' ] + CHARACTER(LEN=40), DIMENSION(2), PARAMETER :: cont_input = & + [ CHARACTER(len=40) :: & + 'create_atoms 1 single &', & + ' 0.2 0.1 0.1' ] + CHARACTER(LEN=40), DIMENSION(3), PARAMETER :: pair_input = & + [ CHARACTER(LEN=40) :: & + 'pair_style lj/cut 2.5', & + 'pair_coeff 1 1 1.0 1.0', & + 'mass 1 1.0' ] +END MODULE keepthermo + +FUNCTION f_lammps_with_args() BIND(C) + USE ISO_C_BINDING, ONLY: c_ptr + USE liblammps + USE keepthermo, ONLY: lmp + IMPLICIT NONE + TYPE(c_ptr) :: f_lammps_with_args + + CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = & + [ CHARACTER(len=12) :: 'liblammps', '-log', 'none', & + '-echo','screen','-nocite','-var','zpos','1.5','-var','x','2'] + + lmp = lammps(args) + f_lammps_with_args = lmp%handle +END FUNCTION f_lammps_with_args + +SUBROUTINE f_lammps_close() BIND(C) + USE ISO_C_BINDING, ONLY: c_null_ptr + USE liblammps + USE keepthermo, ONLY: lmp + IMPLICIT NONE + + CALL lmp%close() + lmp%handle = c_null_ptr +END SUBROUTINE f_lammps_close + +SUBROUTINE f_lammps_get_thermo_setup () BIND(C) + USE liblammps + USE keepthermo, ONLY : lmp, demo_input, cont_input, pair_input + IMPLICIT NONE + + CALL lmp%commands_list(demo_input) + CALL lmp%commands_list(cont_input) + CALL lmp%commands_list(pair_input) +END SUBROUTINE f_lammps_get_thermo_setup + +FUNCTION f_lammps_get_thermo_natoms () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_natoms + + f_lammps_get_thermo_natoms = lmp%get_thermo('atoms') +END FUNCTION f_lammps_get_thermo_natoms + +FUNCTION f_lammps_get_thermo_dt () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_dt + + f_lammps_get_thermo_dt = lmp%get_thermo('dt') +END FUNCTION f_lammps_get_thermo_dt + +FUNCTION f_lammps_get_thermo_vol () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_vol + + f_lammps_get_thermo_vol = lmp%get_thermo('vol') +END FUNCTION f_lammps_get_thermo_vol + +FUNCTION f_lammps_get_thermo_lx () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_lx + + f_lammps_get_thermo_lx = lmp%get_thermo('lx') +END FUNCTION f_lammps_get_thermo_lx + +FUNCTION f_lammps_get_thermo_ly () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_ly + + f_lammps_get_thermo_ly = lmp%get_thermo('ly') +END FUNCTION f_lammps_get_thermo_ly + +FUNCTION f_lammps_get_thermo_lz () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_lz + + f_lammps_get_thermo_lz = lmp%get_thermo('lz') +END FUNCTION f_lammps_get_thermo_lz + +FUNCTION f_lammps_get_thermo_xlo () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_xlo + + f_lammps_get_thermo_xlo = lmp%get_thermo('xlo') +END FUNCTION f_lammps_get_thermo_xlo + +FUNCTION f_lammps_get_thermo_xhi () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_xhi + + f_lammps_get_thermo_xhi = lmp%get_thermo('xhi') +END FUNCTION f_lammps_get_thermo_xhi + +FUNCTION f_lammps_get_thermo_ylo () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_ylo + + f_lammps_get_thermo_ylo = lmp%get_thermo('ylo') +END FUNCTION f_lammps_get_thermo_ylo + +FUNCTION f_lammps_get_thermo_yhi () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_yhi + + f_lammps_get_thermo_yhi = lmp%get_thermo('yhi') +END FUNCTION f_lammps_get_thermo_yhi + +FUNCTION f_lammps_get_thermo_zlo () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_zlo + + f_lammps_get_thermo_zlo = lmp%get_thermo('zlo') +END FUNCTION f_lammps_get_thermo_zlo + +FUNCTION f_lammps_get_thermo_zhi () BIND (C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double + USE liblammps + USE keepthermo, ONLY : lmp + IMPLICIT NONE + REAL (c_double) :: f_lammps_get_thermo_zhi + + f_lammps_get_thermo_zhi = lmp%get_thermo('zhi') +END FUNCTION f_lammps_get_thermo_zhi diff --git a/unittest/fortran/test_fortran_properties.f90 b/unittest/fortran/test_fortran_properties.f90 new file mode 100644 index 0000000000..00e083b301 --- /dev/null +++ b/unittest/fortran/test_fortran_properties.f90 @@ -0,0 +1,52 @@ +FUNCTION f_lammps_version () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE liblammps + USE keepcmds, ONLY : lmp + IMPLICIT NONE + INTEGER (C_int) :: f_lammps_version + + f_lammps_version = lmp%version() +END FUNCTION f_lammps_version + +SUBROUTINE f_lammps_memory_usage (meminfo) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double + USE liblammps + USE keepcmds, ONLY : lmp + IMPLICIT NONE + REAL (C_double), DIMENSION(3), INTENT(OUT) :: meminfo + + CALL lmp%memory_usage(meminfo) +END SUBROUTINE f_lammps_memory_usage + +FUNCTION f_lammps_get_mpi_comm () BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int + USE liblammps + USE keepcmds, ONLY : lmp + IMPLICIT NONE + INTEGER (C_int) :: f_lammps_get_mpi_comm + + f_lammps_get_mpi_comm = lmp%get_mpi_comm() +END FUNCTION f_lammps_get_mpi_comm + +FUNCTION f_lammps_extract_setting (Cstr) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_char + USE keepcmds, ONLY : lmp + USE LIBLAMMPS + IMPLICIT NONE + INTEGER (C_int) :: f_lammps_extract_setting + CHARACTER (KIND=C_char, LEN=1), DIMENSION(*), INTENT(IN) :: Cstr + INTEGER :: strlen, i + CHARACTER (LEN=:), ALLOCATABLE :: Fstr + + i = 1 + DO WHILE (Cstr(i) /= ACHAR(0)) + i = i + 1 + END DO + strlen = i + allocate ( CHARACTER(LEN=strlen) :: Fstr) + FORALL (i=1:strlen) + Fstr(i:i) = Cstr(i) + END FORALL + f_lammps_extract_setting = lmp%extract_setting(Fstr) + deallocate (Fstr) +END FUNCTION f_lammps_extract_setting diff --git a/unittest/fortran/wrap_box.cpp b/unittest/fortran/wrap_box.cpp new file mode 100644 index 0000000000..8678816658 --- /dev/null +++ b/unittest/fortran/wrap_box.cpp @@ -0,0 +1,64 @@ +// unit tests for extracting box dimensions fom a LAMMPS instance through the Fortran wrapper + +#include "lammps.h" +#include +#include + +#include "gtest/gtest.h" + +// prototypes for fortran reverse wrapper functions +extern "C" { +void *f_lammps_with_args(); +void f_lammps_close(); +void f_lammps_box_setup(); +double f_lammps_extract_box_xlo(); +double f_lammps_extract_box_xhi(); +double f_lammps_extract_box_ylo(); +double f_lammps_extract_box_yhi(); +double f_lammps_extract_box_zlo(); +double f_lammps_extract_box_zhi(); +void f_lammps_delete_everything(); +void f_lammps_reset_box_2x(); +} + +class LAMMPS_commands : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_commands() = default; + ~LAMMPS_commands() override = default; + + void SetUp() override + { + ::testing::internal::CaptureStdout(); + lmp = (LAMMPS_NS::LAMMPS *)f_lammps_with_args(); + std::string output = ::testing::internal::GetCapturedStdout(); + EXPECT_STREQ(output.substr(0, 8).c_str(), "LAMMPS ("); + } + void TearDown() override + { + ::testing::internal::CaptureStdout(); + f_lammps_close(); + std::string output = ::testing::internal::GetCapturedStdout(); + EXPECT_STREQ(output.substr(0, 16).c_str(), "Total wall time:"); + lmp = nullptr; + } +}; + +TEST_F(LAMMPS_commands, get_thermo) +{ + f_lammps_box_setup(); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_xlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_xhi(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_ylo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_yhi(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_zlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_zhi(), 2.0); + f_lammps_delete_everything(); + f_lammps_reset_box_2x(); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_xlo(),-1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_xhi(), 3.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_ylo(),-1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_yhi(), 3.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_zlo(),-1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_box_zhi(), 3.0); +}; diff --git a/unittest/fortran/wrap_extract_global.cpp b/unittest/fortran/wrap_extract_global.cpp new file mode 100644 index 0000000000..adf3986073 --- /dev/null +++ b/unittest/fortran/wrap_extract_global.cpp @@ -0,0 +1,177 @@ +// unit tests for extracting global data from a LAMMPS instance through the +// Fortran wrapper + +#include "lammps.h" +#include "library.h" +#include +#include +#include +#include + +#include "gtest/gtest.h" + +// prototypes for Fortran reverse wrapper functions +extern "C" { +void *f_lammps_with_args(); +void f_lammps_close(); +void f_lammps_setup_extract_global(); +void f_lammps_setup_full_extract_global(); +int f_lammps_extract_global_units(); +int f_lammps_extract_global_ntimestep(); +int64_t f_lammps_extract_global_ntimestep_big(); +double f_lammps_extract_global_dt(); +void f_lammps_extract_global_boxlo(double[3]); +void f_lammps_extract_global_boxhi(double[3]); +double f_lammps_extract_global_boxxlo(); +double f_lammps_extract_global_boxylo(); +double f_lammps_extract_global_boxzlo(); +double f_lammps_extract_global_boxxhi(); +double f_lammps_extract_global_boxyhi(); +double f_lammps_extract_global_boxzhi(); +void f_lammps_extract_global_periodicity(int[3]); +int f_lammps_extract_global_triclinic(); +double f_lammps_extract_global_xy(); +double f_lammps_extract_global_yz(); +double f_lammps_extract_global_xz(); +int f_lammps_extract_global_natoms(); +int64_t f_lammps_extract_global_natoms_big(); +int f_lammps_extract_global_nbonds(); +int64_t f_lammps_extract_global_nbonds_big(); +int f_lammps_extract_global_nangles(); +int64_t f_lammps_extract_global_nangles_big(); +int f_lammps_extract_global_ndihedrals(); +int64_t f_lammps_extract_global_ndihedrals_big(); +int f_lammps_extract_global_nimpropers(); +int64_t f_lammps_extract_global_nimpropers_big(); +int f_lammps_extract_global_ntypes(); +int f_lammps_extract_global_nlocal(); +int f_lammps_extract_global_nghost(); +int f_lammps_extract_global_nmax(); +double f_lammps_extract_global_boltz(); +double f_lammps_extract_global_hplanck(); +double f_lammps_extract_global_angstrom(); +double f_lammps_extract_global_femtosecond(); +} + +class LAMMPS_extract_global : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_extract_global() = default; + ~LAMMPS_extract_global() override = default; + + void SetUp() override + { + ::testing::internal::CaptureStdout(); + lmp = (LAMMPS_NS::LAMMPS *)f_lammps_with_args(); + std::string output = ::testing::internal::GetCapturedStdout(); + EXPECT_STREQ(output.substr(0, 8).c_str(), "LAMMPS ("); + } + void TearDown() override + { + ::testing::internal::CaptureStdout(); + f_lammps_close(); + std::string output = ::testing::internal::GetCapturedStdout(); + EXPECT_STREQ(output.substr(0, 16).c_str(), "Total wall time:"); + lmp = nullptr; + } +}; + +TEST_F(LAMMPS_extract_global, units) +{ + f_lammps_setup_extract_global(); + EXPECT_EQ(f_lammps_extract_global_units(), 1); +}; + +TEST_F(LAMMPS_extract_global, ntimestep) +{ + f_lammps_setup_extract_global(); +#ifdef LAMMPS_SMALLSMALL + EXPECT_EQ(f_lammps_extract_global_ntimestep(), 0); +#else + EXPECT_EQ(f_lammps_extract_global_ntimestep_big(), 0l); +#endif +}; + +TEST_F(LAMMPS_extract_global, dt) +{ + f_lammps_setup_extract_global(); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_dt(), 0.005); +}; + +TEST_F(LAMMPS_extract_global, boxprops) +{ + f_lammps_setup_extract_global(); + double boxlo[3], boxhi[3]; + f_lammps_extract_global_boxlo(boxlo); + EXPECT_DOUBLE_EQ(boxlo[0], 0.0); + EXPECT_DOUBLE_EQ(boxlo[1], 0.0); + EXPECT_DOUBLE_EQ(boxlo[2], 0.0); + f_lammps_extract_global_boxhi(boxhi); + EXPECT_DOUBLE_EQ(boxhi[0], 2.0); + EXPECT_DOUBLE_EQ(boxhi[1], 3.0); + EXPECT_DOUBLE_EQ(boxhi[2], 4.0); + + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxxlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxxhi(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxylo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxyhi(), 3.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxzlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boxzhi(), 4.0); + + int periodicity[3]; + f_lammps_extract_global_periodicity(periodicity); + EXPECT_EQ(periodicity[0], 1); + EXPECT_EQ(periodicity[1], 1); + EXPECT_EQ(periodicity[2], 1); + + EXPECT_EQ(f_lammps_extract_global_triclinic(), 0); + + EXPECT_DOUBLE_EQ(f_lammps_extract_global_xy(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_yz(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_xz(), 0.0); +}; + +TEST_F(LAMMPS_extract_global, atomprops) +{ + f_lammps_setup_extract_global(); +#ifdef LAMMPS_SMALLSMALL + EXPECT_EQ(f_lammps_extract_global_natoms(), 2); + EXPECT_EQ(f_lammps_extract_global_nbonds(), 0); + EXPECT_EQ(f_lammps_extract_global_nangles(), 0); + EXPECT_EQ(f_lammps_extract_global_ndihedrals(), 0); +#else + EXPECT_EQ(f_lammps_extract_global_natoms_big(), 2l); + EXPECT_EQ(f_lammps_extract_global_nbonds_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_nangles_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_ndihedrals_big(), 0l); +#endif + + EXPECT_EQ(f_lammps_extract_global_ntypes(), 1); + EXPECT_EQ(f_lammps_extract_global_nlocal(), 2); + EXPECT_EQ(f_lammps_extract_global_nghost(), 41); + EXPECT_EQ(f_lammps_extract_global_nmax(), 16384); + + EXPECT_DOUBLE_EQ(f_lammps_extract_global_boltz(), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_hplanck(), 1.0); + EXPECT_DOUBLE_EQ(f_lammps_extract_global_angstrom(), 1.0); + + EXPECT_DOUBLE_EQ(f_lammps_extract_global_femtosecond(), 1.0); +}; + +TEST_F(LAMMPS_extract_global, fullprops) +{ + if (! lammps_has_style(lmp, "atom", "full")) GTEST_SKIP(); + // This is not currently the world's most convincing test.... + f_lammps_setup_full_extract_global(); +#ifdef LAMMPS_SMALLSMALL + EXPECT_EQ(f_lammps_extract_global_natoms(), 2); + EXPECT_EQ(f_lammps_extract_global_nbonds(), 0); + EXPECT_EQ(f_lammps_extract_global_nangles(), 0); + EXPECT_EQ(f_lammps_extract_global_ndihedrals(), 0); +#else + EXPECT_EQ(f_lammps_extract_global_natoms_big(), 2l); + EXPECT_EQ(f_lammps_extract_global_nbonds_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_nangles_big(), 0l); + EXPECT_EQ(f_lammps_extract_global_ndihedrals_big(), 0l); +#endif +} diff --git a/unittest/fortran/wrap_get_thermo.cpp b/unittest/fortran/wrap_get_thermo.cpp new file mode 100644 index 0000000000..71b51609eb --- /dev/null +++ b/unittest/fortran/wrap_get_thermo.cpp @@ -0,0 +1,67 @@ +// unit tests for getting thermodynamic output from a LAMMPS instance through the Fortran wrapper + +#include "lammps.h" +#include +#include + +#include "gtest/gtest.h" + +// prototypes for fortran reverse wrapper functions +extern "C" { +void *f_lammps_with_args(); +void f_lammps_close(); +void f_lammps_get_thermo_setup(); +double f_lammps_get_thermo_natoms(); +double f_lammps_get_thermo_dt(); +double f_lammps_get_thermo_vol(); +double f_lammps_get_thermo_lx(); +double f_lammps_get_thermo_ly(); +double f_lammps_get_thermo_lz(); +double f_lammps_get_thermo_xlo(); +double f_lammps_get_thermo_xhi(); +double f_lammps_get_thermo_ylo(); +double f_lammps_get_thermo_yhi(); +double f_lammps_get_thermo_zlo(); +double f_lammps_get_thermo_zhi(); +} + +class LAMMPS_thermo : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_thermo() = default; + ~LAMMPS_thermo() override = default; + + void SetUp() override + { + ::testing::internal::CaptureStdout(); + lmp = (LAMMPS_NS::LAMMPS *)f_lammps_with_args(); + std::string output = ::testing::internal::GetCapturedStdout(); + EXPECT_STREQ(output.substr(0, 8).c_str(), "LAMMPS ("); + } + void TearDown() override + { + ::testing::internal::CaptureStdout(); + f_lammps_close(); + std::string output = ::testing::internal::GetCapturedStdout(); + EXPECT_STREQ(output.substr(0, 16).c_str(), "Total wall time:"); + lmp = nullptr; + } +}; + +TEST_F(LAMMPS_thermo, get_thermo) +{ + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_natoms(), 0.0); + f_lammps_get_thermo_setup(); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_natoms(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_dt(), 0.005); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_vol(), 24.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_lx(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_ly(), 3.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_lz(), 4.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_xlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_xhi(), 2.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_ylo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_yhi(), 3.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_zlo(), 0.0); + EXPECT_DOUBLE_EQ(f_lammps_get_thermo_zhi(), 4.0); +}; diff --git a/unittest/fortran/wrap_properties.cpp b/unittest/fortran/wrap_properties.cpp new file mode 100644 index 0000000000..8ecd9346dc --- /dev/null +++ b/unittest/fortran/wrap_properties.cpp @@ -0,0 +1,109 @@ +// unit tests for getting LAMMPS properties through the Fortran wrapper + +#include "lammps.h" +//#include // for stdin, stdout +#include "library.h" +#include +#include + +#include "gtest/gtest.h" + +// prototypes for fortran reverse wrapper functions +extern "C" { +void *f_lammps_with_args(); +void f_lammps_close(); +int f_lammps_version(); +void f_lammps_memory_usage(double*); +int f_lammps_get_mpi_comm(); +int f_lammps_extract_setting(const char*); +} + +class LAMMPS_properties : public ::testing::Test { +protected: + LAMMPS_NS::LAMMPS *lmp; + LAMMPS_properties() = default; + ~LAMMPS_properties() override = default; + + void SetUp() override + { + ::testing::internal::CaptureStdout(); + lmp = (LAMMPS_NS::LAMMPS *)f_lammps_with_args(); + std::string output = ::testing::internal::GetCapturedStdout(); + EXPECT_STREQ(output.substr(0, 8).c_str(), "LAMMPS ("); + } + void TearDown() override + { + ::testing::internal::CaptureStdout(); + f_lammps_close(); + std::string output = ::testing::internal::GetCapturedStdout(); + EXPECT_STREQ(output.substr(0, 16).c_str(), "Total wall time:"); + lmp = nullptr; + } +}; + +TEST_F(LAMMPS_properties, version) +{ + EXPECT_LT(20200917, f_lammps_version()); +}; + +TEST_F(LAMMPS_properties, memory_usage) +{ +// copied from c-library, with a two-character modification + double meminfo[3]; + f_lammps_memory_usage(meminfo); + EXPECT_GT(meminfo[0], 0.0); +#if defined(__linux__) || defined(_WIN32) + EXPECT_GE(meminfo[1], 0.0); +#endif +#if (defined(__linux__) || defined(__APPLE__) || defined(_WIN32)) && !defined(__INTEL_LLVM_COMPILER) + EXPECT_GT(meminfo[2], 0.0); +#endif +}; + +TEST_F(LAMMPS_properties, get_mpi_comm) +{ + int f_comm = f_lammps_get_mpi_comm(); + if ( lammps_config_has_mpi_support() ) + EXPECT_GE(f_comm, 0); + else + EXPECT_EQ(f_comm, -1); +}; + +TEST_F(LAMMPS_properties, extract_setting) +{ +#if defined(LAMMPS_SMALLSMALL) + EXPECT_EQ(f_lammps_extract_setting("bigint"), 4); +#else + EXPECT_EQ(f_lammps_extract_setting("bigint"), 8); +#endif +#if defined(LAMMPS_BIGBIG) + EXPECT_EQ(f_lammps_extract_setting("tagint"), 8); + EXPECT_EQ(f_lammps_extract_setting("imageint"), 8); +#else + EXPECT_EQ(f_lammps_extract_setting("tagint"), 4); + EXPECT_EQ(f_lammps_extract_setting("imageint"), 4); +#endif + + EXPECT_EQ(f_lammps_extract_setting("box_exist"), 0); + EXPECT_EQ(f_lammps_extract_setting("dimension"), 3); + EXPECT_EQ(f_lammps_extract_setting("world_size"), 1); + EXPECT_EQ(f_lammps_extract_setting("world_rank"), 0); + EXPECT_EQ(f_lammps_extract_setting("universe_size"), 1); + EXPECT_EQ(f_lammps_extract_setting("universe_rank"), 0); + EXPECT_GT(f_lammps_extract_setting("nthreads"), 0); + EXPECT_EQ(f_lammps_extract_setting("newton_pair"), 1); + EXPECT_EQ(f_lammps_extract_setting("newton_bond"), 1); + + EXPECT_EQ(f_lammps_extract_setting("ntypes"), 0); + EXPECT_EQ(f_lammps_extract_setting("nbondtypes"), 0); + EXPECT_EQ(f_lammps_extract_setting("nangletypes"), 0); + EXPECT_EQ(f_lammps_extract_setting("ndihedraltypes"), 0); + EXPECT_EQ(f_lammps_extract_setting("nimpropertypes"), 0); + + EXPECT_EQ(f_lammps_extract_setting("molecule_flag"), 0); + EXPECT_EQ(f_lammps_extract_setting("q_flag"), 0); + EXPECT_EQ(f_lammps_extract_setting("mu_flag"), 0); + EXPECT_EQ(f_lammps_extract_setting("rmass_flag"), 0); + EXPECT_EQ(f_lammps_extract_setting("UNKNOWN"), -1); + +};