mirror of https://github.com/lammps/lammps.git
make f2c_string utility function portable across fortran compilers
This commit is contained in:
parent
51d55aa036
commit
a0d0f96e52
|
@ -24,7 +24,7 @@ of the source files: the lammps.f90 file needs to be compiled first,
|
||||||
since it provides the ``LIBLAMMPS`` module that is imported by the
|
since it provides the ``LIBLAMMPS`` module that is imported by the
|
||||||
Fortran code using the interface.
|
Fortran code using the interface.
|
||||||
|
|
||||||
.. versionadded:: 30Sep2020
|
.. versionadded:: 6Oct2020
|
||||||
|
|
||||||
.. admonition:: Work in Progress
|
.. admonition:: Work in Progress
|
||||||
|
|
||||||
|
|
|
@ -16,8 +16,8 @@
|
||||||
! and library.h using the ISO_C_BINDING module of the Fortran compiler.
|
! and library.h using the ISO_C_BINDING module of the Fortran compiler.
|
||||||
!
|
!
|
||||||
! Based on the LAMMPS Fortran 2003 module contributed by:
|
! Based on the LAMMPS Fortran 2003 module contributed by:
|
||||||
! Karl D. Hammond <karlh@ugcs.caltech.edu>
|
! Karl D. Hammond <hammondkd@missouri.edu>
|
||||||
! University of Tennessee, Knoxville (USA), 2012
|
! University of Missouri, 2012-2020
|
||||||
!
|
!
|
||||||
! The Fortran module tries to follow the API of the C-library interface
|
! The Fortran module tries to follow the API of the C-library interface
|
||||||
! closely, but like the Python wrapper it employs an object oriented
|
! closely, but like the Python wrapper it employs an object oriented
|
||||||
|
@ -30,7 +30,7 @@
|
||||||
MODULE LIBLAMMPS
|
MODULE LIBLAMMPS
|
||||||
|
|
||||||
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_loc, &
|
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_loc, &
|
||||||
c_int, c_char, c_null_char, c_double
|
c_int, c_char, c_null_char, c_double, c_size_t, c_f_pointer
|
||||||
|
|
||||||
IMPLICIT NONE
|
IMPLICIT NONE
|
||||||
PRIVATE
|
PRIVATE
|
||||||
|
@ -114,6 +114,12 @@ MODULE LIBLAMMPS
|
||||||
TYPE(c_ptr), VALUE :: str
|
TYPE(c_ptr), VALUE :: str
|
||||||
END SUBROUTINE lammps_commands_string
|
END SUBROUTINE lammps_commands_string
|
||||||
|
|
||||||
|
FUNCTION lammps_malloc(size) BIND(C, name='malloc')
|
||||||
|
IMPORT :: c_ptr, c_size_t
|
||||||
|
INTEGER(c_size_t), value :: size
|
||||||
|
TYPE(c_ptr) :: lammps_malloc
|
||||||
|
END FUNCTION lammps_malloc
|
||||||
|
|
||||||
SUBROUTINE lammps_free(ptr) BIND(C, name='lammps_free')
|
SUBROUTINE lammps_free(ptr) BIND(C, name='lammps_free')
|
||||||
IMPORT :: c_ptr
|
IMPORT :: c_ptr
|
||||||
TYPE(c_ptr), VALUE :: ptr
|
TYPE(c_ptr), VALUE :: ptr
|
||||||
|
@ -267,14 +273,14 @@ CONTAINS
|
||||||
CHARACTER (len=*), INTENT(in) :: f_string
|
CHARACTER (len=*), INTENT(in) :: f_string
|
||||||
CHARACTER (len=1, kind=c_char), POINTER :: c_string(:)
|
CHARACTER (len=1, kind=c_char), POINTER :: c_string(:)
|
||||||
TYPE(c_ptr) :: ptr
|
TYPE(c_ptr) :: ptr
|
||||||
INTEGER :: i, n
|
INTEGER(c_size_t) :: i, n
|
||||||
|
|
||||||
n = LEN_TRIM(f_string)
|
n = LEN_TRIM(f_string)
|
||||||
ALLOCATE(c_string(n+1))
|
ptr = lammps_malloc(n+1)
|
||||||
|
CALL C_F_POINTER(ptr,c_string,[1])
|
||||||
DO i=1,n
|
DO i=1,n
|
||||||
c_string(i) = f_string(i:i)
|
c_string(i) = f_string(i:i)
|
||||||
END DO
|
END DO
|
||||||
c_string(n+1) = c_null_char
|
c_string(n+1) = c_null_char
|
||||||
ptr = c_loc(c_string(1))
|
|
||||||
END FUNCTION f2c_string
|
END FUNCTION f2c_string
|
||||||
END MODULE LIBLAMMPS
|
END MODULE LIBLAMMPS
|
||||||
|
|
Loading…
Reference in New Issue