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