Implemented scatter_atoms and scatter_atoms_subset + unit tests + documentation + typos/edits

2022-10-02 20:32:42 -05:00
parent c5c21bb36c
commit db9b59c269
6 changed files with 520 additions and 170 deletions
--- a/unittest/fortran/test_fortran_gather_scatter.f90
+++ b/unittest/fortran/test_fortran_gather_scatter.f90
@ -33,39 +33,39 @@ SUBROUTINE f_lammps_setup_gather_scatter () BIND(C)
  CALL lmp%commands_list(more_input)
 END SUBROUTINE f_lammps_setup_gather_scatter

-FUNCTION f_lammps_gather_mask (i) BIND(C)
+FUNCTION f_lammps_gather_atoms_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) :: f_lammps_gather_atoms_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
+  f_lammps_gather_atoms_mask = mask(i)
+END FUNCTION f_lammps_gather_atoms_mask

-FUNCTION f_lammps_gather_position (i) BIND(C)
+FUNCTION f_lammps_gather_atoms_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) :: f_lammps_gather_atoms_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
+  f_lammps_gather_atoms_position = positions(i)
+END FUNCTION f_lammps_gather_atoms_position

-FUNCTION f_lammps_gather_concat_mask (i) BIND(C)
+FUNCTION f_lammps_gather_atoms_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) :: f_lammps_gather_atoms_concat_mask
  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask, tag
  INTEGER :: j

@ -73,20 +73,20 @@ FUNCTION f_lammps_gather_concat_mask (i) BIND(C)
  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)
+      f_lammps_gather_atoms_concat_mask = mask(j)
      RETURN
    END IF
  END DO
-  f_lammps_gather_concat_mask = -1
-END FUNCTION f_lammps_gather_concat_mask
+  f_lammps_gather_atoms_concat_mask = -1
+END FUNCTION f_lammps_gather_atoms_concat_mask

-FUNCTION f_lammps_gather_concat_position (xyz, id) BIND(C)
+FUNCTION f_lammps_gather_atoms_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) :: f_lammps_gather_atoms_concat_position
  REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions
  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: tag
  INTEGER :: j
@ -95,18 +95,18 @@ FUNCTION f_lammps_gather_concat_position (xyz, id) BIND(C)
  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)
+       f_lammps_gather_atoms_concat_position = positions((j-1)*3 + xyz)
    END IF
  END DO
-END FUNCTION f_lammps_gather_concat_position
+END FUNCTION f_lammps_gather_atoms_concat_position

-FUNCTION f_lammps_gather_subset_mask (i) BIND(C)
+FUNCTION f_lammps_gather_atoms_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) :: f_lammps_gather_atoms_subset_mask
  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: mask
  INTEGER :: j
  INTEGER(c_int), DIMENSION(*), PARAMETER :: tag = [3,2]
@ -114,20 +114,20 @@ FUNCTION f_lammps_gather_subset_mask (i) BIND(C)
  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)
+      f_lammps_gather_atoms_subset_mask = mask(j)
      RETURN
    END IF
  END DO
-  f_lammps_gather_subset_mask = -1
-END FUNCTION f_lammps_gather_subset_mask
+  f_lammps_gather_atoms_subset_mask = -1
+END FUNCTION f_lammps_gather_atoms_subset_mask

-FUNCTION f_lammps_gather_subset_position (xyz,id) BIND(C)
+FUNCTION f_lammps_gather_atoms_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) :: f_lammps_gather_atoms_subset_position
  REAL(c_double), DIMENSION(:), ALLOCATABLE :: positions
  INTEGER(c_int), DIMENSION(*), PARAMETER :: tag = [3,2]
  INTEGER :: j
@ -135,9 +135,68 @@ FUNCTION f_lammps_gather_subset_position (xyz,id) BIND(C)
  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)
+      f_lammps_gather_atoms_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
+  f_lammps_gather_atoms_subset_position = -1.0D0
+END FUNCTION f_lammps_gather_atoms_subset_position
+
+SUBROUTINE f_lammps_scatter_atoms_masks() BIND(C)
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp
+  IMPLICIT NONE
+  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: masks
+  INTEGER(c_int) :: swap
+
+  CALL lmp%gather_atoms('mask', 1_c_int, masks)
+
+  ! swap masks of atoms 1 and 3
+  swap=masks(1)
+  masks(1) = masks(3)
+  masks(3) = swap
+
+  CALL lmp%scatter_atoms('mask', masks) ! push the swap back to LAMMPS
+END SUBROUTINE f_lammps_scatter_atoms_masks
+
+SUBROUTINE f_lammps_scatter_atoms_positions() BIND(C)
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp
+  IMPLICIT NONE
+  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: tags
+  REAL(c_double), DIMENSION(:), ALLOCATABLE, TARGET :: xvec
+  REAL(c_double), DIMENSION(:,:), POINTER :: x
+  REAL(c_double) :: swap(3)
+
+  CALL lmp%gather_atoms('id',1_c_int,tags)
+  CALL lmp%gather_atoms('x',3_c_int,xvec)
+  x(1:3,1:SIZE(xvec)/3) => xvec
+
+  ! swap positions of atoms 1 and 3
+  swap=x(:,1)
+  x(:,1) = x(:,3)
+  x(:,3) = swap
+
+  CALL lmp%scatter_atoms('x', xvec) ! push the swap back to LAMMPS
+END SUBROUTINE f_lammps_scatter_atoms_positions
+
+SUBROUTINE f_lammps_scatter_atoms_subset_mask() BIND(C)
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
+  USE LIBLAMMPS
+  USE keepstuff, ONLY : lmp
+  IMPLICIT NONE
+  INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: all_masks
+  INTEGER(c_int), DIMENSION(*), PARAMETER :: tags = [3,1]
+  INTEGER(c_int), DIMENSION(2) :: masks
+  INTEGER(c_int) :: swap
+
+  CALL lmp%gather_atoms('mask', 1_c_int, all_masks)
+
+  ! swap masks of atoms 1 and 3 in the new array (because 'tags' is reversed)
+  masks(1) = all_masks(1)
+  masks(2) = all_masks(3)
+
+  CALL lmp%scatter_atoms_subset('mask', tags, masks) ! push the swap to LAMMPS
+END SUBROUTINE f_lammps_scatter_atoms_subset_mask