implicit none
INTEGER :: i,j,k,l,ida,dd,ct
INTEGER :: n,bd(2,2),ncd(2),xx(2)
INTEGER :: fro,frd
REAL :: x(3)
INTEGER :: cdo(0:3,500),pp(1:2,2500)
integer, allocatable, dimension(:,:) :: cds
real, parameter :: a0=2.855312
real, parameter :: a=a0*sqrt(2.)/2
real, parameter :: hbv=a0*sqrt(3.)/2./2.
real, parameter :: b=a0*sqrt(6.)*2/3/4
real :: dis(500), dx(2500)


open(NEWUNIT=fro,FILE='x1.xyz',status='old')
do i=1,3
    read(fro,*)
end do
read(fro,*)n
do i=5,9
    read(fro,*)
end do
do i=1,n
    read(fro,*) ida,x(1:3)
    x=x*(/6,2,4/)
    cdo(0,i)=ida
    cdo(1:3,i)=nint(x(1:3))
end do
bd(1,1)=minval(cdo(2,:))
bd(2,1)=maxval(cdo(2,:))
bd(1,2)=minval(cdo(3,:))
bd(2,2)=maxval(cdo(3,:))
allocate(cds(bd(1,1):bd(2,1),bd(1,2):bd(2,2)))
cds=0
do i=1,n
    do j=bd(1,1),bd(2,1)
        do k=bd(1,2),bd(2,2)
            if (cdo(2,i)==j.and.cdo(3,i)==k) then
                cds(j,k)=i
            end if
        end do
    end do
end do
ct=0
do i=1,n
    do j=-1,1,2
        do k=-1,1,2
            ncd=cdo(2:3,i)+(/j,k/)
            if (ncd(1)>=bd(1,1).and.ncd(1)<=bd(2,1).and.ncd(2)>=bd(1,2).and.ncd(2)<=bd(2,2)) then
                dd=cds(ncd(1),ncd(2))
                if (dd==0) cycle
                if (i<dd)then
                    do l=1,ct
                        xx=pp(1:2,l)-(/i,dd/)
                        if (maxval(abs(xx))==0) exit
                    end do
                    if (l==ct+1) then
                        ct=ct+1
                        pp(1:2,ct)=(/i,dd/)
                    end if
                end if
            end if
        end do
    end do
    j=0
    do k=-2,2,4
        ncd=cdo(2:3,i)+(/j,k/)
        if (ncd(1)>=bd(1,1).and.ncd(1)<=bd(2,1).and.ncd(2)>=bd(1,2).and.ncd(2)<=bd(2,2)) then
            dd=cds(ncd(1),ncd(2))
            if (dd==0) cycle
            if (i<dd)then
                do l=1,ct
                    xx=pp(1:2,l)-(/i,dd/)
                    if (maxval(abs(xx))==0) exit
                end do
                if (l==ct+1) then
                    ct=ct+1
                    pp(1:2,ct)=(/i,dd/)
                end if
            end if
        end if
    end do
end do

open(NEWUNIT=frd,FILE='y1.xyz',status='old')
do i=1,3
    read(frd,*)
end do
read(frd,*)
do i=5,9
    read(frd,*)
end do
do i=1,n
    read(frd,*) ida,x(1:3)
    do j=1,n
        if (ida==cdo(0,j)) exit
    end do
    dis(j)=x(1)
end do

do i=1,ct
    dx(i)=dis(pp(1,i))-dis(pp(2,i))
    if (dx(i)>hbv) dx(i)=dx(i)-hbv*2
    if (dx(i)<-hbv) dx(i)=dx(i)+hbv*2
end do
write(*,*) n,ct
do i=1,n
    write(*,*) cdo(2,i)*a,cdo(3,i)*b
end do
do i=1,ct
    write(*,*) cdo(2,pp(1,i))*a,cdo(3,pp(1,i))*b,cdo(2,pp(2,i))*a,cdo(3,pp(2,i))*b, dx(i)
end do
end