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 evdw=0.0 26 k=0 27 28 do i=jbeg,jend 29 30 j=list(i) 31 k=k+1 32 33 if(rijsq(k).lt.rcutsq)then 34 35 drij=sqrt(rijsq(k)) 36 37 imin=min(atmtype(iii),atmtype(j)) 38 imax=max(atmtype(iii),atmtype(j)) 39 idif=imax-imin 40 41 potindex=0 42 do l=1,imin-1 43 potindex=potindex+(ntype-l+1) 44 enddo 45 potindex=potindex+idif+1 46 47 if(potkey(potindex).eq.1)then 48 49 evdw=evdw+(potpar(potindex,1)/drij**12 50 $ -potpar(potindex,2)/drij**6) 51 52 force=(12*potpar(potindex,1)/drij**12 53 $ -6*potpar(potindex,2)/drij**6)/rijsq(k) 54 55 fff(iii,1)=fff(iii,1)+convfct2*force*rij(k,1) 56 fff(iii,2)=fff(iii,2)+convfct2*force*rij(k,2) 57 fff(iii,3)=fff(iii,3)+convfct2*force*rij(k,3) 58 59 fff(j,1)=fff(j,1)-convfct2*force*rij(k,1) 60 fff(j,2)=fff(j,2)-convfct2*force*rij(k,2) 61 fff(j,3)=fff(j,3)-convfct2*force*rij(k,3) 62 63 elseif(potkey(potindex).eq.2)then 64 65 evdw=evdw+(potpar(potindex,1) 66 $ *exp(-drij/potpar(potindex,2)) 67 $ -potpar(potindex,3)/drij**6) 68 69 force=(drij*potpar(potindex,1) 70 $ *exp(-drij/potpar(potindex,2)) 71 $ /potpar(potindex,2)-6*potpar(potindex,3)/drij**6) 72 $ /rijsq(k) 73 74 fff(iii,1)=fff(iii,1)+convfct2*force*rij(k,1) 75 fff(iii,2)=fff(iii,2)+convfct2*force*rij(k,2) 76 fff(iii,3)=fff(iii,3)+convfct2*force*rij(k,3) 77 78 fff(j,1)=fff(j,1)-convfct2*force*rij(k,1) 79 fff(j,2)=fff(j,2)-convfct2*force*rij(k,2) 80 fff(j,3)=fff(j,3)-convfct2*force*rij(k,3) 81 82 endif 83 84 endif 85 86 enddo 87 88 return 89 90 END 91