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

incorporate bugfixes and some suggestions from PR #3314

Browse Source
This commit is contained in:
Axel Kohlmeyer
2022-08-06 17:43:40 -04:00
parent d58b81afe2
commit 322dc9a4de
3 changed files with 83 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

67
fortran/lammps.f90
View File

@ -54,20 +54,18 @@ MODULE LIBLAMMPS
! interface definitions for calling functions in library.cpp
INTERFACE
FUNCTION lammps_open(argc,argv,comm) &
BIND(C, name='lammps_open_fortran')
FUNCTION lammps_open(argc, argv, comm) BIND(C, name='lammps_open_fortran')
IMPORT :: c_ptr, c_int
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, name='lammps_open_no_mpi')
FUNCTION lammps_open_no_mpi(argc, argv, handle) BIND(C, name='lammps_open_no_mpi')
IMPORT :: c_ptr, c_int
INTEGER(c_int), VALUE, INTENT(in) :: argc
TYPE(c_ptr), DIMENSION(*), INTENT(in) :: argv
TYPE(c_ptr), INTENT(out) :: handle
TYPE(c_ptr), VALUE :: handle
TYPE(c_ptr) :: lammps_open_no_mpi
END FUNCTION lammps_open_no_mpi
@ -85,28 +83,26 @@ MODULE LIBLAMMPS
SUBROUTINE lammps_kokkos_finalize() BIND(C, name='lammps_kokkos_finalize')
END SUBROUTINE lammps_kokkos_finalize
SUBROUTINE lammps_file(handle,filename) BIND(C, name='lammps_file')
SUBROUTINE lammps_file(handle, filename) BIND(C, name='lammps_file')
IMPORT :: c_ptr
TYPE(c_ptr), VALUE :: handle
TYPE(c_ptr), VALUE :: filename
END SUBROUTINE lammps_file
SUBROUTINE lammps_command(handle,cmd) BIND(C, name='lammps_command')
SUBROUTINE lammps_command(handle, cmd) BIND(C, name='lammps_command')
IMPORT :: c_ptr
TYPE(c_ptr), VALUE :: handle
TYPE(c_ptr), VALUE :: cmd
END SUBROUTINE lammps_command
SUBROUTINE lammps_commands_list(handle,ncmd,cmds) &
BIND(C, name='lammps_commands_list')
SUBROUTINE lammps_commands_list(handle, ncmd, cmds) BIND(C, name='lammps_commands_list')
IMPORT :: c_ptr, c_int
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, name='lammps_commands_string')
SUBROUTINE lammps_commands_string(handle, str) BIND(C, name='lammps_commands_string')
IMPORT :: c_ptr
TYPE(c_ptr), VALUE :: handle
TYPE(c_ptr), VALUE :: str
@ -137,24 +133,23 @@ MODULE LIBLAMMPS
END INTERFACE
CONTAINS
! Fortran wrappers and helper functions.
! Constructor for the LAMMPS class.
! Combined wrapper around lammps_open_fortran() and lammps_open_no_mpi()
TYPE(lammps) FUNCTION lmp_open(args,comm)
TYPE(lammps) FUNCTION lmp_open(args, comm)
IMPLICIT NONE
INTEGER,INTENT(in), OPTIONAL :: comm
INTEGER, INTENT(in), OPTIONAL :: comm
CHARACTER(len=*), INTENT(in), OPTIONAL :: args(:)
TYPE(c_ptr), ALLOCATABLE :: argv(:)
TYPE(c_ptr) :: dummy=c_null_ptr
INTEGER :: i,argc
INTEGER(c_int) :: i, c_comm, argc
IF (PRESENT(args)) THEN
! convert argument list to c style
! convert fortran argument list to c style
argc = SIZE(args)
ALLOCATE(argv(argc))
DO i=1,argc
DO i=1, argc
argv(i) = f2c_string(args(i))
END DO
ELSE
@ -164,23 +159,24 @@ CONTAINS
ENDIF
IF (PRESENT(comm)) THEN
lmp_open%handle = lammps_open(argc,argv,comm)
c_comm = comm
lmp_open%handle = lammps_open(argc, argv, c_comm)
ELSE
lmp_open%handle = lammps_open_no_mpi(argc,argv,dummy)
lmp_open%handle = lammps_open_no_mpi(argc, argv, dummy)
END IF
! Clean up allocated memory
DO i=1,argc
DO i=1, argc
CALL lammps_free(argv(i))
END DO
DEALLOCATE(argv)
END FUNCTION lmp_open
! Combined Fortran wrapper around lammps_close() and lammps_mpi_finalize()
SUBROUTINE lmp_close(self,finalize)
SUBROUTINE lmp_close(self, finalize)
IMPLICIT NONE
CLASS(lammps) :: self
LOGICAL,INTENT(in),OPTIONAL :: finalize
LOGICAL, INTENT(in), OPTIONAL :: finalize
CALL lammps_close(self%handle)
@ -206,68 +202,69 @@ CONTAINS
lmp_get_natoms = lammps_get_natoms(self%handle)
END FUNCTION lmp_get_natoms
SUBROUTINE lmp_file(self,filename)
SUBROUTINE lmp_file(self, filename)
IMPLICIT NONE
CLASS(lammps) :: self
CHARACTER(len=*) :: filename
TYPE(c_ptr) :: str
str = f2c_string(filename)
CALL lammps_file(self%handle,str)
CALL lammps_file(self%handle, str)
CALL lammps_free(str)
END SUBROUTINE lmp_file
! equivalent function to lammps_command()
SUBROUTINE lmp_command(self,cmd)
SUBROUTINE lmp_command(self, cmd)
IMPLICIT NONE
CLASS(lammps) :: self
CHARACTER(len=*) :: cmd
TYPE(c_ptr) :: str
str = f2c_string(cmd)
CALL lammps_command(self%handle,str)
CALL lammps_command(self%handle, str)
CALL lammps_free(str)
END SUBROUTINE lmp_command
! equivalent function to lammps_commands_list()
SUBROUTINE lmp_commands_list(self,cmds)
SUBROUTINE lmp_commands_list(self, cmds)
IMPLICIT NONE
CLASS(lammps) :: self
CHARACTER(len=*), INTENT(in), OPTIONAL :: cmds(:)
TYPE(c_ptr), ALLOCATABLE :: cmdv(:)
INTEGER :: i,ncmd
INTEGER :: i, ncmd
! convert command list to c style
ncmd = SIZE(cmds)
ALLOCATE(cmdv(ncmd))
DO i=1,ncmd
DO i=1, ncmd
cmdv(i) = f2c_string(cmds(i))
END DO
CALL lammps_commands_list(self%handle,ncmd,cmdv)
CALL lammps_commands_list(self%handle, ncmd, cmdv)
! Clean up allocated memory
DO i=1,ncmd
DO i=1, ncmd
CALL lammps_free(cmdv(i))
END DO
DEALLOCATE(cmdv)
END SUBROUTINE lmp_commands_list
! equivalent function to lammps_commands_string()
SUBROUTINE lmp_commands_string(self,str)
SUBROUTINE lmp_commands_string(self, str)
IMPLICIT NONE
CLASS(lammps) :: self
CHARACTER(len=*) :: str
TYPE(c_ptr) :: tmp
tmp = f2c_string(str)
CALL lammps_commands_string(self%handle,tmp)
CALL lammps_commands_string(self%handle, tmp)
CALL lammps_free(tmp)
END SUBROUTINE lmp_commands_string
! ----------------------------------------------------------------------
! 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(:)
@ -276,8 +273,8 @@ CONTAINS
n = LEN_TRIM(f_string)
ptr = lammps_malloc(n+1)
CALL C_F_POINTER(ptr,c_string,[1])
DO i=1,n
CALL C_F_POINTER(ptr, c_string, [1])
DO i=1, n
c_string(i) = f_string(i:i)
END DO
c_string(n+1) = c_null_char