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