1      subroutine pairs(lself,lpbcs,xw,xwm,iwdt,iwz,
2     + iwfr,iwto,jwfr,jwto,xs,xsm,
3     + isga,isat,isdt,isgr,isgm,ismf,isml,isss,isq1,isq2,isq3,ishop,isz,
4     + isfr,isto,jsfr,jsto,lpbc,lstptr,lseq)
5c
6c     in     log : lself           : true for box self interactions
7c     in     r*8 : xw(mwm,3,mwa)   : solvent coordinates
8c     in     r*8 : xwm(mwm,3)      : solvent molecule center of mass coordinates
9c     in     int : iwdt(mwm)       : solvent dynamics type
10c     out    int : iwz(mwm)        : solvent boundary type
11c     in     int : iwfr,iwto       : first and last solvent molecule i
12c     in     int : jwfr,jwto       : first and last solvent molecule j
13c     in     r*8 : xs(msa,3)       : solute atom coordinates
14c     in     r*8 : xsm(msm,3)      : solute molecule center of mass coordinates
15c     in     int : isga(msa)       : solute global atom number
16c     in     int : isat(msa)       : solute atom type
17c     in     int : isdt(msa)       : solute dynamics type
18c     in     int : isgr(msa)       : solute charge group
19c     in     int : ismf(msa)       : solute molecule fraction
20c     in     int : isml(msa)       : solute molecule
21c     in     int : isss(msa)       : solute separation shifted scaling type
22c     in     int : isq1(msa)       : solute charge type 1
23c     in     int : isq2(msa)       : solute charge type 2
24c     in     int : isq3(msa)       : solute charge type 3
25c     out    int : isz(msa)        : solute boundary type
26c     in     int : isfr,isto       : first and last solute atom i
27c     in     int : jsfr,jsto       : first and last solute atom j
28c     in     log : lpbc            : flag to consider periodic boundary conditions
29c     in/out int : lstptr          : list pointer
30c
31c     dimensions nwm,nwa and nsa need to have been given by a call to cf_initx
32c
33c $Id$
34      implicit none
35c
36#include "cf_common.fh"
37#include "mafdecls.fh"
38c
39      real*8 xw(mwm,3,mwa),xwm(mwm,3)
40      real*8 xs(msa,3),xsm(msm,3)
41      integer iwdt(mwm),iwz(mwm),isz(msa)
42      integer isga(msa),isat(msa),isdt(msa),isgr(msa),ismf(msa)
43      integer isml(msa),isss(msa),isq1(msa),isq2(msa),isq3(msa)
44      integer ishop(msa),isgm(msa)
45      integer iwfr,iwto,jwfr,jwto,isfr,isto,jsfr,jsto
46      integer lstptr
47      logical lself,lpbc,lpbcs
48      integer lseq(mseq)
49c
50      integer nwloc,nsloc,nwnon,nsnon,npairs,mpairs
51      integer lptr,lptrn
52      integer nconst
53c
54      if(lself) then
55      jwfr=iwfr
56      jwto=iwto
57      jsfr=isfr
58      jsto=isto
59      endif
60c
61      lstptr=ndxp
62      lptrn=i_list+ndxp
63      lptr=i_list+ndxp+24
64c
65      nwloc=iwto-iwfr+1
66      if(iwfr.eq.0.or.iwto.lt.iwfr) nwloc=0
67      nwnon=jwto-jwfr+1
68      if(jwfr.eq.0.or.jwto.lt.jwfr) nwnon=0
69      nsloc=isto-isfr+1
70      if(isfr.eq.0.or.isto.lt.isfr) nsloc=0
71      nsnon=jsto-jsfr+1
72      if(jsfr.eq.0.or.jsto.lt.jsfr) nsnon=0
73c
74c     pairlists
75c     ---------
76c
77c     solvent-solvent pairlist
78c
79      npairs=0
80      mpairs=maxl-(lptr-i_list)-4*nwloc-1
81      if(nwloc.gt.0.and.nwnon.gt.0) then
82      call cf_lww(lself,lpbc,xwm,iwdt,iwfr,iwto,jwfr,jwto,nwloc,
83     + mpairs,npairs,int_mb(lptr+1),int_mb(lptr+1+2*nwloc),
84     + int_mb(lptr+1+4*nwloc),
85     + int_mb(i_s2i1),dbl_mb(i_s3r1),dbl_mb(i_s1r1))
86      endif
87      int_mb(lptr)=npairs
88      int_mb(lptrn)=lptr
89      if(npairs.gt.0) then
90      lptr=lptr+4*nwloc+1+npairs
91      else
92      lptr=lptr+1
93      endif
94c
95c     solute-solvent pairlist
96c
97      npairs=0
98      mpairs=maxl-(lptr-i_list)-4*nsloc-1
99      if(nsloc.gt.0.and.nwnon.gt.0) then
100      call cf_lsw(lpbc,lpbcs,
101     + xs,isdt,isgr,isfr,isto,xwm,iwdt,iwz,jwfr,jwto,
102     + nsloc,mpairs,npairs,int_mb(lptr+1),int_mb(lptr+1+2*nsloc),
103     + int_mb(lptr+1+4*nsloc),
104     + int_mb(i_s2i1),dbl_mb(i_s3r1),dbl_mb(i_s1r1))
105      endif
106      int_mb(lptr)=npairs
107      int_mb(lptrn+1)=lptr
108      if(npairs.gt.0) then
109      lptr=lptr+4*nsloc+1+npairs
110      else
111      lptr=lptr+1
112      endif
113c
114c     solvent-solute pairlist
115c
116      npairs=0
117      mpairs=maxl-(lptr-i_list)-4*nsnon-1
118      if(nsnon.gt.0.and.nwloc.gt.0.and..not.lself) then
119      call cf_lsw(lpbc,lpbcs,
120     + xs,isdt,isgr,jsfr,jsto,xwm,iwdt,iwz,iwfr,iwto,
121     + nsnon,mpairs,npairs,int_mb(lptr+1),int_mb(lptr+1+2*nsnon),
122     + int_mb(lptr+1+4*nsnon),
123     + int_mb(i_s2i1),dbl_mb(i_s3r1),dbl_mb(i_s1r1))
124      endif
125      int_mb(lptr)=npairs
126      int_mb(lptrn+2)=lptr
127      if(npairs.gt.0) then
128      lptr=lptr+4*nsnon+1+npairs
129      else
130      lptr=lptr+1
131      endif
132c
133c     solute-solute pairlist
134c
135      npairs=0
136      mpairs=maxl-(lptr-i_list)-4*nsloc-1
137      if(nsloc.gt.0.and.nsnon.gt.0) then
138      call cf_lss(lself,lpbc,lpbcs,
139     + xs,isga,isdt,isgr,isgm,isss,ishop,isz,isfr,isto,
140     + jsfr,jsto,
141     + nsloc,mpairs,npairs,int_mb(lptr+1),int_mb(lptr+1+2*nsloc),
142     + int_mb(lptr+1+4*nsloc),
143     + int_mb(i_s2i1),dbl_mb(i_s3r1),dbl_mb(i_s1r1),
144     + int_mb(i_itrd(2)),mtt(2),int_mb(i_ixcl(2)),mxt(2),
145     + int_mb(i_lda),dbl_mb(i_rda),lseq,int_mb(i_lsthop),
146     + int_mb(i_mprot))
147      endif
148      int_mb(lptr)=npairs
149      int_mb(lptrn+3)=lptr
150      if(npairs.gt.0) then
151      lptr=lptr+4*nsloc+1+npairs
152      else
153      lptr=lptr+1
154      endif
155c
156c     solute bond list
157c
158      npairs=0
159      mpairs=maxl-(lptr-i_list)
160      if(nsloc.gt.0.and.(lself.or.nsnon.gt.0)) then
161      call cf_lsb(lself,isga,isdt,isz,isfr,isto,jsfr,jsto,
162     + int_mb(i_ibnd(2)),mbt(2),npairs,mpairs,nconst,
163     + int_mb(lptr+1),int_mb(i_s2i1))
164      endif
165      int_mb(lptr)=npairs
166      int_mb(lptrn+4)=lptr
167      if(npairs.gt.0) then
168      lptr=lptr+1+npairs
169      else
170      lptr=lptr+1
171      endif
172c
173c     solute angle list
174c
175      npairs=0
176      mpairs=maxl-(lptr-i_list)
177      if(nsloc.gt.0.and.(lself.or.nsnon.gt.0)) then
178      call cf_lsh(lself,isga,isdt,isz,isfr,isto,jsfr,jsto,
179     + int_mb(i_iang(2)),mht(2),npairs,mpairs,nconst,
180     + int_mb(lptr+1),int_mb(i_s2i1))
181      endif
182      int_mb(lptr)=npairs
183      int_mb(lptrn+5)=lptr
184      if(npairs.gt.0) then
185      lptr=lptr+1+npairs
186      else
187      lptr=lptr+1
188      endif
189c
190c     solute torsion list
191c
192      npairs=0
193      mpairs=maxl-(lptr-i_list)
194      if(nsloc.gt.0.and.(lself.or.nsnon.gt.0)) then
195      call cf_lsd(lself,isga,isdt,isz,isfr,isto,jsfr,jsto,
196     + int_mb(i_idih(2)),mdt(2),npairs,mpairs,nconst,
197     + int_mb(lptr+1),int_mb(i_s2i1))
198      endif
199      int_mb(lptr)=npairs
200      int_mb(lptrn+6)=lptr
201      if(npairs.gt.0) then
202      lptr=lptr+1+npairs
203      else
204      lptr=lptr+1
205      endif
206c
207c     solute improper torsion list
208c
209      npairs=0
210      mpairs=maxl-(lptr-i_list)
211      if(nsloc.gt.0.and.(lself.or.nsnon.gt.0)) then
212      call cf_lso(lself,isga,isdt,isz,isfr,isto,jsfr,jsto,
213     + int_mb(i_iimp(2)),mit(2),npairs,mpairs,nconst,
214     + int_mb(lptr+1),int_mb(i_s2i1))
215      endif
216      int_mb(lptr)=npairs
217      int_mb(lptrn+7)=lptr
218      if(npairs.gt.0) then
219      lptr=lptr+1+npairs
220      else
221      lptr=lptr+1
222      endif
223c
224c     solute third neighbor list
225c
226      npairs=0
227      mpairs=maxl-(lptr-i_list)
228      if(nsloc.gt.0.and.(lself.or.nsnon.gt.0)) then
229      call cf_lst(lself,isga,isdt,isz,isfr,isto,jsfr,jsto,
230     + int_mb(i_itrd(2)),mtt(2),npairs,mpairs,
231     + int_mb(lptr+1),int_mb(i_s2i1))
232      endif
233      int_mb(lptr)=npairs
234      int_mb(lptrn+8)=lptr
235      if(npairs.gt.0) then
236      lptr=lptr+1+npairs
237      else
238      lptr=lptr+1
239      endif
240c
241      llist=.true.
242      ndxp=lptr-i_list
243c
244      return
245      end
246
247
248
249