1c
2c $Id$
3c
4
5      SUBROUTINE list_excld(ntype)
6
7      implicit none
8
9      include 'p_input.inc'
10      include 'p_array.inc'
11      include 'cm_atom.inc'
12      include 'cm_elst.inc'
13
14      integer i,j,iexcl,nelist,exclpair,nexcl
15      integer ntype,eatm
16
17      dimension iexcl(mxtype),exclpair(mxtype,mxtype)
18
19      do i=1,ntype
20       iexcl(i)=0
21      enddo
22
23      do i=1,ntype-1
24
25       iexcl(i)=0
26
27       do j=i+1,ntype
28
29        if(typmol(i).eq.typmol(j))then
30
31         iexcl(i)=iexcl(i)+1
32         if(iexcl(i).gt.mxtype)then
33          write(output,"(/,1x,'mxtype exceeded')")
34          stop
35         endif
36         exclpair(i,iexcl(i))=j-i
37
38        endif
39
40       enddo
41
42      enddo
43
44      nelist=0
45
46      do i=1,natms
47
48       epoint(i)=nelist+1
49       eatm=atmtype(i)
50       nexcl=iexcl(eatm)
51
52       if(nexcl.gt.0)then
53
54        do j=1,nexcl
55
56         nelist=nelist+1
57         if(nelist.gt.(mxatms*mxelist))then
58          write(output,"(/,1x,'mxatms*mxelist exceeded')")
59          stop
60         endif
61         if((nelist-epoint(i)+1).gt.mxnlist)then
62          write(output,"(/,1x,'mxnlist exceeded')")
63          stop
64         endif
65
66         elist(nelist)=i+exclpair(eatm,j)
67
68        enddo
69
70       endif
71
72      enddo
73
74      epoint(natms)=nelist+1
75
76      return
77
78      END
79