Added set_variable and a test for it

This commit is contained in:
Karl Hammond
2022-09-30 18:31:18 -05:00
parent 756d24ff9e
commit d301ff9961
3 changed files with 47 additions and 6 deletions

View File

@ -102,6 +102,7 @@ MODULE LIBLAMMPS
PROCEDURE :: extract_compute => lmp_extract_compute
PROCEDURE :: extract_fix => lmp_extract_fix
PROCEDURE :: extract_variable => lmp_extract_variable
PROCEDURE :: set_variable => lmp_set_variable
!
PROCEDURE :: version => lmp_version
PROCEDURE,NOPASS :: get_os_info => lmp_get_os_info
@ -386,7 +387,12 @@ MODULE LIBLAMMPS
TYPE(c_ptr) :: lammps_extract_variable
END FUNCTION lammps_extract_variable
!INTEGER (c_int) lammps_set_variable
FUNCTION lammps_set_variable (handle, name, str) BIND(C)
IMPORT :: c_int, c_ptr
IMPLICIT NONE
TYPE (c_ptr), VALUE :: handle, name, str
INTEGER (c_int) :: lammps_set_variable
END FUNCTION lammps_set_variable
!SUBROUTINE lammps_gather_atoms
@ -1150,7 +1156,26 @@ CONTAINS
END SELECT
END FUNCTION lmp_extract_variable
! equivalent function to lammps_version()
! equivalent function to lammps_set_variable
SUBROUTINE lmp_set_variable (self, name, str)
CLASS(lammps), INTENT(IN) :: self
CHARACTER (LEN=*), INTENT(IN) :: name, str
INTEGER :: err
TYPE(C_ptr) :: Cstr, Cname
Cstr = f2c_string(str)
Cname = f2c_string(name)
err = lammps_set_variable(self%handle, Cname, Cstr)
CALL lammps_free(Cname)
CALL lammps_free(Cstr)
IF ( err /= 0 ) THEN
CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, &
'WARNING: unable to set string variable "' // name &
// '" [Fortran/set_variable]')
END IF
END SUBROUTINE lmp_set_variable
! equivalent function to lammps_version
INTEGER FUNCTION lmp_version(self)
CLASS(lammps), INTENT(IN) :: self
@ -1321,7 +1346,7 @@ CONTAINS
length = LEN(buffer)
Cptr = f2c_string(buffer)
Cstatus = lammps_get_last_error_message(self%handle, Cptr, length)
length = MIN(LEN(buffer), c_strlen(Cptr))
length = MIN(LEN(buffer, c_size_t), c_strlen(Cptr))
CALL C_F_POINTER(Cptr, Cbuffer, [length])
FORALL ( i=1:length )
buffer(i:i) = Cbuffer(i)

View File

@ -248,10 +248,9 @@ FUNCTION f_lammps_extract_variable_string () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr
USE LIBLAMMPS
USE keepvar, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_string
CHARACTER(LEN=20) :: string
CHARACTER(LEN=40) :: string
string = lmp%extract_variable('str')
f_lammps_extract_variable_string = f2c_string(string)
@ -287,7 +286,7 @@ FUNCTION f_lammps_extract_variable_getenv () BIND(C)
USE keepvar, ONLY : lmp, f2c_string
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_extract_variable_getenv
CHARACTER(LEN=20) :: string
CHARACTER(LEN=40) :: string
string = lmp%extract_variable('username')
f_lammps_extract_variable_getenv = f2c_string(string)
@ -384,4 +383,16 @@ FUNCTION f_lammps_extract_variable_vector(i) BIND(C)
vector = lmp%extract_variable('center') ! z-coordinates
f_lammps_extract_variable_vector = vector(i)
END FUNCTION f_lammps_extract_variable_vector
SUBROUTINE f_lammps_set_variable_string() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepvar, ONLY : lmp, f2c_string
IMPLICIT NONE
CHARACTER(LEN=40) :: string
string = "this is the new string"
CALL lmp%set_variable('str', string)
END SUBROUTINE f_lammps_set_variable_string
! vim: sts=2 ts=2 sw=2 et

View File

@ -42,6 +42,7 @@ double f_lammps_extract_variable_internal();
double f_lammps_extract_variable_equal();
double f_lammps_extract_variable_atom(int);
double f_lammps_extract_variable_vector(int);
void f_lammps_set_variable_string();
}
class LAMMPS_extract_variable : public ::testing::Test {
@ -136,6 +137,10 @@ TEST_F(LAMMPS_extract_variable, string)
char* fstr = f_lammps_extract_variable_string();
EXPECT_STREQ(fstr, "this is a string");
std::free(fstr);
f_lammps_set_variable_string();
fstr = f_lammps_extract_variable_string();
EXPECT_STREQ(fstr, "this is the new string");
std::free(fstr);
};
TEST_F(LAMMPS_extract_variable, format)