implemented ndiv in nearest_lattice_point

aoterodelaroza · Feb 13, 2024 · 7232875 · 7232875
1 parent 1c59514
commit 7232875
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 13 deletions.
diff --git a/src/crystalmod.f90 b/src/crystalmod.f90
@@ -474,12 +474,13 @@ module subroutine list_near_lattice_points(c,xp,icrd,sorted,nat,dist,lvec,ndiv,&
        integer, intent(in), optional :: up2n
        logical, intent(in), optional :: nozero
      end subroutine list_near_lattice_points
-     module subroutine nearest_lattice_point(c,xp,icrd,dist,lvec,nozero)
+     module subroutine nearest_lattice_point(c,xp,icrd,dist,lvec,ndiv,nozero)
        class(crystal), intent(inout) :: c
        real*8, intent(in) :: xp(3)
        integer, intent(in) :: icrd
        real*8, intent(out) :: dist
        integer, intent(out), optional :: lvec(3)
+       integer, intent(in), optional :: ndiv(3)
        logical, intent(in), optional :: nozero
      end subroutine nearest_lattice_point
      module function identify_fragment(c,nat,x0) result(fr)

diff --git a/src/[email protected] b/src/[email protected]
@@ -1041,22 +1041,25 @@ end subroutine list_near_lattice_points
   !> Given the point xp (in icrd coordinates), calculate the nearest
   !> lattice point. The lattice point (in cryst. coords.) is returne
   !> in lvec and the distance in dist. If nozero, disregard
-  !> zero-distance lattice points. This routine is thread-safe.
-  module subroutine nearest_lattice_point(c,xp,icrd,dist,lvec,nozero)
+  !> zero-distance lattice points.  If ndiv is given, divide the
+  !> parent lattice vectors by ndiv; useful for grids. This routine
+  !> is thread-safe.
+  module subroutine nearest_lattice_point(c,xp,icrd,dist,lvec,ndiv,nozero)
     class(crystal), intent(inout) :: c
     real*8, intent(in) :: xp(3)
     integer, intent(in) :: icrd
     real*8, intent(out) :: dist
     integer, intent(out), optional :: lvec(3)
+    integer, intent(in), optional :: ndiv(3)
     logical, intent(in), optional :: nozero
 
     integer :: nat
     integer, allocatable :: eid(:), lvec_(:,:)
     real*8, allocatable :: dist_(:)
 
     ! get just one atom
-    call c%list_near_lattice_points(xp,icrd,.false.,nat,dist=dist_,lvec=lvec_,up2n=1,&
-       nozero=nozero)
+    call c%list_near_lattice_points(xp,icrd,.false.,nat,dist=dist_,&
+       lvec=lvec_,ndiv=ndiv,up2n=1,nozero=nozero)
 
     ! if no atoms in output, return
     if (present(lvec)) lvec = 0

diff --git a/src/[email protected] b/src/[email protected]
@@ -634,20 +634,40 @@ module subroutine critic_main()
        elseif (equal(word,'temp')) then
           ! xxxx
 
-          !! build lattice test
-          xp = (/10.3d0,0.1d0,-3.4d0/)
-          dmax = 30d0
+          ! !! build lattice test
+          ! xp = (/10.3d0,0.1d0,-3.4d0/)
+          ! dmax = 30d0
+
+          ! call e%build_lattice(sy%c%m_x2c,150d0)
+          ! call e%list_near_atoms(xp,icrd_crys,.true.,nat,ierr,eid=eid,dist=dist,lvec=lvec2,up2n=10,nozero=.true.)
+          ! do i = 1, nat
+          !    write (*,*) i, e%xr2x(e%at(eid(i))%x) + lvec2, dist(i)
+          ! end do
+          ! write (*,*)
 
-          call e%build_lattice(sy%c%m_x2c,150d0)
-          call e%list_near_atoms(xp,icrd_crys,.true.,nat,ierr,eid=eid,dist=dist,lvec=lvec2,up2n=10,nozero=.true.)
+          ! call sy%c%list_near_lattice_points(xp,icrd_crys,.true.,nat,dist,lvec,up2n=10,nozero=.true.)
+          ! do i = 1, nat
+          !    write (*,*) i, lvec(:,i), dist(i)
+          ! end do
+
+          !! ndiv, nearest lattice point
+          n = (/100,80,120/)
+          xp = (/0.3d0,0.1d0,0.411d0/) * n
+          dmax = 30d0
+          xred(:,1) = sy%c%m_x2c(:,1) / n(1)
+          xred(:,2) = sy%c%m_x2c(:,2) / n(2)
+          xred(:,3) = sy%c%m_x2c(:,3) / n(3)
+          call e%build_lattice(xred,5d0)
+          call e%list_near_atoms(xp,icrd_crys,.true.,nat,ierr,eid=eid,dist=dist,lvec=lvec2,up2n=1,nozero=.true.)
           do i = 1, nat
              write (*,*) i, e%xr2x(e%at(eid(i))%x) + lvec2, dist(i)
           end do
           write (*,*)
 
-          call sy%c%list_near_lattice_points(xp,icrd_crys,.true.,nat,dist,lvec,up2n=10,nozero=.true.)
-          do i = 1, nat
-             write (*,*) i, lvec(:,i), dist(i)
+          xp = (/0.3d0,0.1d0,0.411d0/)
+          call sy%c%nearest_lattice_point(xp,icrd_crys,dist=dist(1),lvec=lvec2,ndiv=n,nozero=.true.)
+          do i = 1, 1
+             write (*,*) i, lvec2, dist(i)
           end do
 
           ! !! ndiv