1 subroutine argos_cafe_lsb(lself,iga,idt,istemp, 2 + isfr,isto,jsfr,jsto, 3 + idb,nsb,nbonds,mbonds,nconst,lbonds,itemp) 4c 5 implicit none 6c 7#include "argos_cafe_common.fh" 8c 9 integer iga(msa),idt(msa) 10 integer nsb,mbonds 11 integer idb(nsb,4) 12 integer lbonds(*) 13 integer itemp(nsatot),istemp(msa) 14 integer isa,jsa,isfr,isto,jsfr,jsto,isafr,isato,jsafr,jsato 15 integer isb,nbi,nbj,nbonds,nconst,ibloc,jbloc,isbloc,iq,jq 16 logical lself 17c 18#include "bitops.fh" 19c 20 if(numb(2).eq.0) return 21c 22c This subroutine evaluates the solute bonds list 23c 24 isafr=isfr 25 isato=isto 26 jsafr=jsfr 27 jsato=jsto 28c 29 nbonds=0 30 nconst=0 31c 32 do 1 isa=1,nsatot 33 itemp(isa)=0 34 1 continue 35 do 2 jsa=jsafr,jsato 36 itemp(iga(jsa))=3 37c if(iand(idt(jsa),mdynam).ne.ldynam) itemp(iga(jsa))=-3 38 2 continue 39 do 3 isa=isafr,isato 40 itemp(iga(isa))=1 41c if(iand(idt(isa),mdynam).ne.ldynam) itemp(iga(isa))=-1 42 3 continue 43c 44 do 4 isb=1,numb(2) 45 if(idb(isb,3).ge.0) then 46 nbi=itemp(idb(isb,1)) 47c lbi=nbi.ge.0 48c nbi=iabs(nbi) 49 if(nbi.gt.0) then 50 nbj=itemp(idb(isb,2)) 51c lbj=nbj.ge.0 52 nbi=nbi+iabs(nbj) 53 if(nbi.gt.1) then 54 if((lself.and.nbi.eq.2).or.(.not.lself.and.nbi.eq.4)) then 55c if(lbi.or.lbj) then 56 nbonds=nbonds+1 57 if(idb(isb,3).eq.1) nconst=nconst+1 58 if(nbonds.gt.mbonds) 59 + call md_abort('Insufficient memory for bond list',0) 60 lbonds(nbonds)=isb 61c endif 62 endif 63 endif 64 endif 65 endif 66 4 continue 67c 68 return 69 end 70c $Id$ 71