1c
2c $Id$
3c
4
5      SUBROUTINE frce_shrt(iii,ntype,rij,rijsq,jbeg,jend,evdw)
6
7      implicit none
8
9      include 'p_input.inc'
10      include 'p_array.inc'
11      include 'p_const.inc'
12      include 'cm_atom.inc'
13      include 'cm_vlst.inc'
14      include 'cm_pote.inc'
15      include 'cm_cuto.inc'
16
17      integer iii,i,j,k,l
18      integer ntype,potindex
19      integer jbeg,jend,imin,imax,idif
20
21      real*8  evdw,rij,drij,rijsq,force
22
23      dimension rij(mxnlist,3),rijsq(mxnlist)
24
25      write(24,*) "printing vdw"
26      evdw=0.0
27      k=0
28
29      do i=jbeg,jend
30
31       j=list(i)
32       k=k+1
33
34       if(rijsq(k).lt.rcutsq)then
35
36        drij=sqrt(rijsq(k))
37
38        imin=min(atmtype(iii),atmtype(j))
39        imax=max(atmtype(iii),atmtype(j))
40        idif=imax-imin
41
42        potindex=0
43        do l=1,imin-1
44         potindex=potindex+(ntype-l+1)
45        enddo
46        potindex=potindex+idif+1
47
48        if(potkey(potindex).eq.1)then
49
50         evdw=evdw+(potpar(potindex,1)/drij**12
51     $             -potpar(potindex,2)/drij**6)
52
53         force=(12*potpar(potindex,1)/drij**12
54     $          -6*potpar(potindex,2)/drij**6)/rijsq(k)
55         write(24,*) drij,rijsq(k)
56         fff(iii,1)=fff(iii,1)+convfct2*force*rij(k,1)
57         fff(iii,2)=fff(iii,2)+convfct2*force*rij(k,2)
58         fff(iii,3)=fff(iii,3)+convfct2*force*rij(k,3)
59
60         fff(j,1)=fff(j,1)-convfct2*force*rij(k,1)
61         fff(j,2)=fff(j,2)-convfct2*force*rij(k,2)
62         fff(j,3)=fff(j,3)-convfct2*force*rij(k,3)
63
64        elseif(potkey(potindex).eq.2)then
65
66         evdw=evdw+(potpar(potindex,1)
67     $              *exp(-drij/potpar(potindex,2))
68     $              -potpar(potindex,3)/drij**6)
69
70         force=(drij*potpar(potindex,1)
71     $         *exp(-drij/potpar(potindex,2))
72     $         /potpar(potindex,2)-6*potpar(potindex,3)/drij**6)
73     $         /rijsq(k)
74
75         fff(iii,1)=fff(iii,1)+convfct2*force*rij(k,1)
76         fff(iii,2)=fff(iii,2)+convfct2*force*rij(k,2)
77         fff(iii,3)=fff(iii,3)+convfct2*force*rij(k,3)
78
79         fff(j,1)=fff(j,1)-convfct2*force*rij(k,1)
80         fff(j,2)=fff(j,2)-convfct2*force*rij(k,2)
81         fff(j,3)=fff(j,3)-convfct2*force*rij(k,3)
82
83        endif
84
85       endif
86
87      enddo
88
89      return
90
91      END
92