Implemented, tested, and documented gather_atoms and variants; added RST docs for lammps_scatter_atoms and lammps_gather_atoms and variants (library.cpp); checked for missing atom map in lammps_gather_atoms_subset; fixed bug in keepstuff.f90; fixed docs for extract_variable

2022-10-02 15:28:10 -05:00
parent 2f5e0646d9
commit c5c21bb36c
9 changed files with 796 additions and 138 deletions
--- a/unittest/fortran/test_fortran_gather_scatter.f90
+++ b/unittest/fortran/test_fortran_gather_scatter.f90
@ -0,0 +1,143 @@
+FUNCTION f_lammps_with_args() BIND(C)
+  USE ISO_C_BINDING, ONLY: c_ptr
+  USE LIBLAMMPS
+  USE keepstuff, 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 keepstuff, ONLY: lmp
+  IMPLICIT NONE
+
+  CALL lmp%close()
+  lmp%handle = c_null_ptr
+END SUBROUTINE f_lammps_close
+
+SUBROUTINE f_lammps_setup_gather_scatter () BIND(C)
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp, big_input, cont_input, more_input
+  IMPLICIT NONE
+
+  CALL lmp%command('atom_modify map array')
+  CALL lmp%commands_list(big_input)
+  CALL lmp%commands_list(cont_input)
+  CALL lmp%commands_list(more_input)
+END SUBROUTINE f_lammps_setup_gather_scatter
+
+FUNCTION f_lammps_gather_mask (i) BIND(C)
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp
+  IMPLICIT NONE
+  INTEGER(c_int), INTENT(IN), VALUE :: i
+  INTEGER(c_int) :: f_lammps_gather_mask
+  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask
+
+  CALL lmp%gather_atoms('mask', 1_c_int, mask)
+  f_lammps_gather_mask = mask(i)
+END FUNCTION f_lammps_gather_mask
+
+FUNCTION f_lammps_gather_position (i) BIND(C)
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp
+  IMPLICIT NONE
+  INTEGER(c_int), INTENT(IN), VALUE :: i
+  REAL(c_double) :: f_lammps_gather_position
+  REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions
+
+  CALL lmp%gather_atoms('x', 3_c_int, positions)
+  f_lammps_gather_position = positions(i)
+END FUNCTION f_lammps_gather_position
+
+FUNCTION f_lammps_gather_concat_mask (i) BIND(C)
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp
+  IMPLICIT NONE
+  INTEGER(c_int), INTENT(IN), VALUE :: i
+  INTEGER(c_int) :: f_lammps_gather_concat_mask
+  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask, tag
+  INTEGER :: j
+
+  CALL lmp%gather_atoms_concat('mask', 1_c_int, mask)
+  CALL lmp%gather_atoms_concat('id', 1_c_int, tag)
+  DO j = 1, SIZE(tag)
+    IF ( tag(j) == i ) THEN
+      f_lammps_gather_concat_mask = mask(j)
+      RETURN
+    END IF
+  END DO
+  f_lammps_gather_concat_mask = -1
+END FUNCTION f_lammps_gather_concat_mask
+
+FUNCTION f_lammps_gather_concat_position (xyz, id) BIND(C)
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp
+  IMPLICIT NONE
+  INTEGER(c_int), INTENT(IN), VALUE :: id, xyz
+  REAL(c_double) :: f_lammps_gather_concat_position
+  REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions
+  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: tag
+  INTEGER :: j
+
+  CALL lmp%gather_atoms_concat('x', 3_c_int, positions)
+  CALL lmp%gather_atoms_concat('id', 1_c_int, tag)
+  DO j = 1, SIZE(tag)
+    IF ( tag(j) == id ) THEN
+       f_lammps_gather_concat_position = positions((j-1)*3 + xyz)
+    END IF
+  END DO
+END FUNCTION f_lammps_gather_concat_position
+
+FUNCTION f_lammps_gather_subset_mask (i) BIND(C)
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp
+  IMPLICIT NONE
+  INTEGER(c_int), INTENT(IN), VALUE :: i
+  INTEGER(c_int) :: f_lammps_gather_subset_mask
+  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask
+  INTEGER :: j
+  INTEGER(c_int), DIMENSION(*), PARAMETER :: tag = [3,2]
+
+  CALL lmp%gather_atoms_subset('mask', 1_c_int, tag, mask)
+  DO j = 1, SIZE(tag)
+    IF ( tag(j) == i ) THEN
+      f_lammps_gather_subset_mask = mask(j)
+      RETURN
+    END IF
+  END DO
+  f_lammps_gather_subset_mask = -1
+END FUNCTION f_lammps_gather_subset_mask
+
+FUNCTION f_lammps_gather_subset_position (xyz,id) BIND(C)
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp
+  IMPLICIT NONE
+  INTEGER(c_int), INTENT(IN), VALUE :: id, xyz
+  REAL(c_double) :: f_lammps_gather_subset_position
+  REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions
+  INTEGER(c_int), DIMENSION(*), PARAMETER :: tag = [3,2]
+  INTEGER :: j
+
+  CALL lmp%gather_atoms_subset('x', 3_c_int, tag, positions)
+  DO j = 1, SIZE(tag)
+    IF ( tag(j) == id ) THEN
+      f_lammps_gather_subset_position = positions((j-1)*3 + xyz)
+      RETURN
+    END IF
+  END DO
+  f_lammps_gather_subset_position = -1.0D0
+END FUNCTION f_lammps_gather_subset_position