program kuk
      implicit none
      integer*4 ia,nf,nat,ix,ja,na1,na2,nh,nht,nas,nhs,nhts,nus,ka,nhu
      real*8 xi,yi,zi,xj,yj,zj,d
      character*80 fn
      logical ac,ls
      real*8,allocatable::r(:)
      character*1 si,sj
      integer*4,allocatable::q(:),sl(:)
      write(6,600)
600   format(' Kuk looks at geometries listed in X.LST',/,
     1       ' and counts hydrogen bonds',/)

      nus=0
      inquire(file='SOLU.LST',exist=ls)
      if(ls)then
       open(9,file='SOLU.LST')
       read(9,*)nus
       allocate(sl(nus))
       read(9,*)(sl(ia),ia=1,nus)
       close(9)
       write(6,*)nus,' atoms in SOLU.LST'
      endif

      nf=0
      nht=0
      nhts=0
      nhu=0
      open(9,file='X.LST',status='old')
1     read(9,90,end=99,err=99)fn
  90  format(a80)
      nf=nf+1
      open(8,file=fn,status='old')
      read(8,*)
      read(8,*)nat
      allocate(r(3*nat),q(nat))
      do 2 ia=1,nat
   2  read(8,*)q(ia),(r(3*(ia-1)+ix),ix=1,3)
      close(8)
      nh=0
      nhs=0
      do 3 ia=1,nat
      if(q(ia).eq.1)then
       call as(ia,xi,yi,zi,r)
c      na1..number of acidic atoms bonded to this hydrogen
c      na2..number of acidic atoms H-bonded to this hydrogen
c      nas..number of acidic atoms short H-bonded to this hydrogen
       na1=0
       na2=0
       nas=0
       do 31 ja=1,nat
       if(ac(q(ja)))then
        call as(ja,xj,yj,zj,r)
        d=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
c       d(XH)<1.5:
        if(d.lt.2.25d0)na1=na1+1
c       1.5<d(XH)<2.5:
        if(d.lt.6.25d0.and.d.gt.2.25d0)na2=na2+1
c       1.5<d(XH)<1.8:
        if(d.lt.3.24d0.and.d.gt.2.25d0)then
         nas=nas+1
         si=' '
         sj=' '
         do 21 ka=1,nus
         if(sl(ka).eq.ia)si='s'
21       if(sl(ka).eq.ja)sj='s'
         write(6,604)ia,si,ja,sj,dsqrt(d)
604      format(' Short H-bond ',i4,1x,a1,i4,1x,a1,f10.4)
         if(si.eq.'s'.or.sj.eq.'s')nhu=nhu+1
        endif
       endif
31     continue
       if(na1.gt.1)write(6,603)na1,ia
603    format(i6,' too many bonds to H',i5)
       nh=nh+na2
       nhs=nhs+nas
      endif
3     continue
      deallocate(r,q)
      write(6,602)nf,nh,nhs,fn(1:40)
602   format(' structure',i6,',',i6,' H-bonds',i6,' short ',a40)
      nht=nht+nh
      nhts=nhts+nhs

      goto 1
 99   write(6,601)nf,nht,nhts,nhu
  601 format(i6,' geoms,',i6,' H-bonds,',i6,' short',i6,' short sol')
      end

      function ac(j)
      implicit none
      logical ac
      integer*4 j
c     acidic atoms N O F P S Cl Br I 
      ac=j.eq. 7.or.j.eq. 8.or.j.eq.9.or.j.eq.15.or.j.eq.16.or.j.eq.17.
     1or.j.eq.35.or.j.eq.53
      return
      end

      subroutine as(i,x,y,z,r)
      implicit none
      integer*4 i
      real*8 x,y,z,r(*)
      x=r(3*(i-1)+1)
      y=r(3*(i-1)+2)
      z=r(3*(i-1)+3)
      return
      end