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