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