1c
2c $Id$
3c
4
5      SUBROUTINE list_verlt()
6
7      implicit none
8
9      include 'p_input.inc'
10      include 'p_array.inc'
11      include 'cm_atom.inc'
12      include 'cm_cuto.inc'
13      include 'cm_latt.inc'
14      include 'cm_vlst.inc'
15      include 'cm_elst.inc'
16
17      integer i,j,k
18      integer eatm,nlist
19
20      real*8 rij,rijsq
21
22      dimension rij(mxatms,3)
23
24      nlist=0
25
26      do i=1,natms-1
27
28       k=0
29       point(i)=nlist+1
30       if(epoint(i).ne.epoint(i+1))eatm=epoint(i)
31
32       do j=i+1,natms
33
34        k=k+1
35        rij(k,1)=ccc(i,1)-ccc(j,1)
36        rij(k,2)=ccc(i,2)-ccc(j,2)
37        rij(k,3)=ccc(i,3)-ccc(j,3)
38
39       enddo
40
41       call tool_rebox(k,mxatms,latt,rlatt,rij)
42
43       k=0
44
45       do j=i+1,natms
46
47        k=k+1
48
49        if((epoint(i).ne.epoint(i+1)).and.(elist(eatm).eq.j))then
50
51         eatm=min(eatm+1,(epoint(i+1)-1))
52
53        else
54
55         rijsq=rij(k,1)*rij(k,1)+rij(k,2)*rij(k,2)+rij(k,3)*rij(k,3)
56
57         if(rijsq.lt.vcutsq)then
58
59          nlist=nlist+1
60
61          if(nlist.gt.(mxatms*mxvlist))then
62           write(output,"(/,1x,'mxatms*mxvlist exceeded')")
63           stop
64          endif
65          if((nlist-point(i)+1).gt.mxnlist)then
66           write(output,"(/,1x,'mxnlist exceeded')")
67           stop
68          endif
69
70          list(nlist)=j
71
72         endif
73
74        endif
75
76       enddo
77
78      enddo
79
80      point(natms)=nlist+1
81
82      return
83
84      END
85