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

I think I finally fixed extract_global; we'll check it in the morning

Browse Source
This commit is contained in:
Karl Hammond
2022-08-12 00:04:25 -05:00
parent 4151a1af02
commit 88a3a38640
2 changed files with 198 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
doc/src/Fortran.rst
View File

@ -229,37 +229,6 @@ of the contents of the ``LIBLAMMPS`` Fortran interface to LAMMPS.
lmp = lammps(MPI_COMM_SELF%MPI_VAL)
END PROGRAM testmpi
Constants Defined by the API
============================
The following constants are declared by the Fortran API to resolve the
type/kind/rank signature for return values. These serve the same role as
``LAMMPS_INT``, ``LAMMPS_DOUBLE``, and similar constants in ``src/library.h``
and those in ``python/lammps/constants.py`` for the C and Python APIs,
respectively. Unlike their C and Python bretheren, however, it is the type
(e.g., ``INTEGER``), kind (e.g., ``C_int``), and rank (e.g., ``DIMENSION(:)``)
of these constants that is used by the calling routine, rather than their
numerical values.
:f:LMP_INT: 32-bit integer scalars
:f:LMP_INT_1D: 32-bit integer vectors
:f:LMP_INT_2D: 32-bit integer matrices
:f:LMP_DOUBLE: 64-bit real scalars
:f:LMP_DOUBLE_1D: 64-bit real vectors
:f:LMP_DOUBLE_2D: 64-bit real matrices
:f:LMP_INT64: 64-bit integer scalars
:f:LMP_INT64_1D: 64-bit integer vectors
:f:LMP_INT64_2D: 64-bit integer matrices
.. admonition:: Interaction with LAMMPS_BIGBIG and such
LAMMPS uses different-sized integers to store various entities, such as
the number of timesteps or the total number of atoms, depending on certain
compiler flags (see the :doc:`size limits <Build_settings_size>`
documentation). This API is currently agnostic to these settings, and it
is up to the user to know the size of LAMMPS_BIGINT and such and pass
LMP_INT or LMP_INT64, as appropriate, for such entities.
Procedures Bound to the lammps Derived Type
===========================================
@ -429,17 +398,19 @@ Procedures Bound to the lammps Derived Type
--------
.. f:function:: extract_global(name, dtype)
.. f:function:: extract_global(name)
Overloaded function to get internal global LAMMPS data. Note that all
currently implemented global types only return scalars or strings; all
array-returning entities currently supported use :f:func:`extract_box`.
Function to get internal global LAMMPS data.
Note that type/kind/rank of the *dtype* argument is used to determine
whether to return a type correspending to a C int, a C int64_t, or a
C double. The type/kind/rank signature of dtype is checked at runtime to
match that of the return value; this type of check cannot be performed at
compile time. For example,
Note that this function actually does not return a value, but rather
associates the the pointer on the left-hand side of the assignment to point
to internal LAMMPS data (with the exception of string data, which are
copied returned as ordinary Fortran strings). Pointers must be of the
correct data type to point to said data (typically INTEGER(c_int),
INTEGER(c_int64_t), or REAL(c_double)) and have appropriate rank.
The pointer being associated with LAMMPS data is type- and rank-checked at
run-time.
want via an overloaded assignment operator. For example,
.. code-block:: fortran
@ -447,16 +418,16 @@ Procedures Bound to the lammps Derived Type
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t
USE LIBLAMMPS
TYPE(lammps) :: lmp
INTEGER(C_int) :: nlocal
INTEGER(C_int64_t) :: ntimestep
INTEGER(C_int), POINTER :: nlocal
INTEGER(C_int64_t), POINTER :: ntimestep
CHARACTER(LEN=10) :: units
REAL(C_double) :: dt
REAL(C_double), POINTER :: dt
lmp = lammps()
! other commands
nlocal = lmp%extract_global('nlocal', LMP_INT)
ntimestep = lmp%extract_global('ntimestep', LMP_INT64)
dt = lmp%extract_global('dt', LMP_DOUBLE)
units = lmp%extract_global('units', LMP_STRING)
nlocal = lmp%extract_global('nlocal')
ntimestep = lmp%extract_global('ntimestep')
dt = lmp%extract_global('dt')
units = lmp%extract_global('units')
! more commands
lmp.close(.TRUE.)
END PROGRAM demo
@ -472,6 +443,14 @@ Procedures Bound to the lammps Derived Type
are padded with spaces at the end.
:p character(len=*) name: string with the name of the extracted property
:p polymorphic dtype: one of *LMP_INT*, *LMP_INT64*, *LMP_DOUBLE*, or
*LMP_STRING* designating the type/kind/rank of the return value
:r polymorphic: value of the extracted property
:r polymorphic: the left-hand side of the assignment should be either a
string (if expecting string data) or a C-interoperable pointer to the
extracted property. If expecting vector data, the pointer should have
dimension ":".
.. note::
Functions such as extract_global and extract_atom actually return a
derived type, and an overloaded operator tells the compiler how to pull the
data out of that derived type when the assignment is made. The user need
not worry about these implementation details.

203
fortran/lammps.f90
View File

@ -31,29 +31,11 @@ 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
IMPLICIT NONE
PRIVATE
PUBLIC :: lammps
! ! These are public-interface constants that have the same purpose as the
! ! constants in library.h, except that their types match the type of the
! ! constant in question. Their purpose is to specify the type of the
! ! return value without something akin to a C/C++ type cast
! INTEGER (c_int), PUBLIC, PARAMETER :: LMP_INT = 0_c_int
! INTEGER (c_int), PUBLIC, DIMENSION(3), PARAMETER :: LMP_INT_1D = 0_c_int
! INTEGER (c_int), PUBLIC, DIMENSION(3,3), PARAMETER :: LMP_INT_2D = 1_c_int
! REAL (c_double), PUBLIC, PARAMETER :: LMP_DOUBLE = 2.0_c_double
! REAL (c_double), PUBLIC, DIMENSION(3), PARAMETER :: &
! LMP_DOUBLE_1D = 2.0_c_double
! REAL (c_double), PUBLIC, DIMENSION(3,3), PARAMETER :: &
! LMP_DOUBLE_2D = 3.0_c_double
! INTEGER (c_int64_t), PUBLIC, PARAMETER :: LMP_INT64 = 4_c_int64_t
! INTEGER (c_int64_t), PUBLIC, DIMENSION(3), PARAMETER :: &
! LMP_INT64_1D = 4_c_int64_t
! INTEGER (c_int64_t), PUBLIC, DIMENSION(3,3), PARAMETER :: &
! LMP_INT64_2D = 5_c_int64_t
! CHARACTER(LEN=*), PUBLIC, PARAMETER :: LMP_STRING = 'six'
PUBLIC :: lammps, ASSIGNMENT(=)
! Data type constants for extracting data from global, atom, compute, and fix
!
@ -62,7 +44,7 @@ MODULE LIBLAMMPS
!
! NOT part of the API (the part the user sees)
INTEGER (c_int), PARAMETER :: &
LAMMPS_INT = 0_c_int, & ! 32-bit integer (array)
LAMMPS_INT = 0, & ! 32-bit integer (array)
LAMMPS_INT_2D = 1, & ! two-dimensional 32-bit integer array
LAMMPS_DOUBLE = 2, & ! 64-bit double (array)
LAMMPS_DOUBLE_2D = 3, & ! two-dimensional 64-bit double array
@ -85,17 +67,7 @@ MODULE LIBLAMMPS
PROCEDURE :: memory_usage => lmp_memory_usage
PROCEDURE :: get_mpi_comm => lmp_get_mpi_comm
PROCEDURE :: extract_setting => lmp_extract_setting
! PROCEDURE :: extract_global => lmp_extract_global
! PROCEDURE, PRIVATE :: lmp_extract_global_int
! PROCEDURE, PRIVATE :: lmp_extract_global_int64_t
! PROCEDURE, PRIVATE :: lmp_extract_global_double
! PROCEDURE, PRIVATE :: lmp_extract_global_str
! GENERIC :: extract_global => lmp_extract_global_int, &
! lmp_extract_global_int64_t, lmp_extract_global_double, &
! lmp_extract_global_str
! PROCEDURE, PRIVATE :: lmp_extract_global_scalar
! !PROCEDURE, PRIVATE :: lmp_extract_global_string
! GENERIC :: extract_global => lmp_extract_global_scalar
PROCEDURE :: extract_global => lmp_extract_global
PROCEDURE :: version => lmp_version
END TYPE lammps
@ -103,6 +75,33 @@ MODULE LIBLAMMPS
MODULE PROCEDURE lmp_open
END INTERFACE lammps
! Constants to use in working with lammps_data
ENUM, BIND(C)
ENUMERATOR :: DATA_INT, DATA_INT_1D, DATA_INT_2D
ENUMERATOR :: DATA_INT64, DATA_INT64_1D, DATA_INT64_2D
ENUMERATOR :: DATA_DOUBLE, DATA_DOUBLE_1D, DATA_DOUBLE_2D
ENUMERATOR :: DATA_STRING
END ENUM
! Derived type for receiving LAMMPS data (in lieu of the ability to type cast
! pointers)
TYPE lammps_data
INTEGER(c_int) :: datatype
INTEGER(c_int), POINTER :: i32
INTEGER(c_int), DIMENSION(:), POINTER :: i32_vec
INTEGER(c_int64_t), POINTER :: i64
INTEGER(c_int64_t), DIMENSION(:), POINTER :: i64_vec
REAL(c_double), POINTER :: r64
REAL(c_double), DIMENSION(:), POINTER :: r64_vec
CHARACTER(LEN=:), ALLOCATABLE :: str
END TYPE lammps_data
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE assign_int_to_lammps_data, assign_int64_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')
@ -543,6 +542,78 @@ CONTAINS
! CALL lammps_free(Cname)
! END FUNCTION lmp_extract_global_datatype
! 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)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name
TYPE(lammps_data) :: global_data
INTEGER(c_int) :: datatype
TYPE(c_ptr) :: Cname, Cptr
INTEGER(c_size_t) :: length, i
CHARACTER(KIND=c_char, LEN=1), DIMENSION(:), POINTER :: Fptr
! Determine vector length
! FIXME Is there a way to get the length of the vector from C rather
! than defining it here AND in the Python API?
SELECT CASE (name)
CASE ('boxlo','boxhi','sublo','subhi','sublo_lambda','subhi_lambda', &
'periodicity')
length = 3
CASE DEFAULT
length = 1
! string cases are overridden later
END SELECT
Cname = f2c_string(name)
datatype = lammps_extract_global_datatype(self%handle, Cname)
! above could be c_null_ptr in place of self%handle...doesn't matter
Cptr = lammps_extract_global(self%handle, Cname)
CALL lammps_free(Cname)
SELECT CASE (datatype)
CASE (LAMMPS_INT)
IF ( length == 1 ) THEN
global_data%datatype = DATA_INT
CALL C_F_POINTER(Cptr, global_data%i32)
ELSE
global_data%datatype = DATA_INT_1D
CALL C_F_POINTER(Cptr, global_data%i32_vec, [length])
END IF
CASE (LAMMPS_INT64)
IF ( length == 1 ) THEN
global_data%datatype = DATA_INT64
CALL C_F_POINTER(Cptr, global_data%i64)
ELSE
global_data%datatype = DATA_INT64_1D
CALL C_F_POINTER(Cptr, global_data%i64_vec, [length])
END IF
CASE (LAMMPS_DOUBLE)
IF ( length == 1 ) THEN
global_data%datatype = DATA_DOUBLE
CALL C_F_POINTER(Cptr, global_data%r64)
ELSE
global_data%datatype = DATA_DOUBLE_1D
CALL C_F_POINTER(Cptr, global_data%r64_vec, [length])
END IF
CASE (LAMMPS_STRING)
global_data%datatype = DATA_STRING
length = c_strlen(Cptr)
CALL C_F_POINTER(Cptr, Fptr, [length])
ALLOCATE ( CHARACTER(LEN=length) :: global_data%str )
FORALL ( I=1:length )
global_data%str(i:i) = Fptr(i)
END FORALL
CASE DEFAULT
WRITE(ERROR_UNIT,'(A)') 'ERROR: Unknown pointer type in&
& extract_global'
STOP
END SELECT
END FUNCTION
! equivalent function to lammps_extract_global
! the return value should be automatically returned and assigned correctly
! based on the information available from LAMMPS
@ -732,13 +803,77 @@ CONTAINS
lmp_version = lammps_version(self%handle)
END FUNCTION lmp_version
! ----------------------------------------------------------------------
! functions to assign user-space pointers to LAMMPS data
! ----------------------------------------------------------------------
SUBROUTINE assign_int_to_lammps_data (lhs, rhs)
INTEGER(c_int), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_INT ) THEN
lhs => rhs%i32
ELSE
WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment'
STOP
END IF
END SUBROUTINE assign_int_to_lammps_data
SUBROUTINE assign_int64_to_lammps_data (lhs, rhs)
INTEGER(c_int64_t), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_INT64 ) THEN
lhs => rhs%i64
ELSE
WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment'
STOP
END IF
END SUBROUTINE assign_int64_to_lammps_data
SUBROUTINE assign_double_to_lammps_data (lhs, rhs)
REAL(c_double), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE ) THEN
lhs => rhs%r64
ELSE
WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment'
STOP
END IF
END SUBROUTINE assign_double_to_lammps_data
SUBROUTINE assign_doublevec_to_lammps_data (lhs, rhs)
REAL(c_double), DIMENSION(:), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE_1D ) THEN
lhs => rhs%r64_vec
ELSE
WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment'
STOP
END IF
END SUBROUTINE assign_doublevec_to_lammps_data
SUBROUTINE assign_string_to_lammps_data (lhs, rhs)
CHARACTER(LEN=*), INTENT(OUT) :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_STRING ) THEN
lhs = rhs%str
ELSE
WRITE(ERROR_UNIT,'(A)') 'ERROR: Data types incompatible in assignment'
STOP
END IF
END SUBROUTINE assign_string_to_lammps_data
! ----------------------------------------------------------------------
! local helper functions
! copy fortran string to zero terminated c string
! ----------------------------------------------------------------------
FUNCTION f2c_string(f_string) RESULT(ptr)
CHARACTER (LEN=*), INTENT(IN) :: f_string
CHARACTER (LEN=1, KIND=c_char), POINTER :: c_string(:)
CHARACTER(LEN=*), INTENT(IN) :: f_string
CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:)
TYPE(c_ptr) :: ptr
INTEGER(c_size_t) :: i, n