PROGRAM XCHARGE
c     find molecular charge for a peptide in FILE.X
      implicit none
      integer*4 nat,ia,q,ix,o1,o2,no,nh,n1,n2,n3,icoo,inp,iarg,ib,nn,
     1ihis,nnh,nnc,ic,c41,c42,nc4,n5,nn5,nh2
      real*8,allocatable::r(:)
      integer*4,allocatable::ity(:),bt(:,:),nt(:)

      OPEN(20,FILE='FILE.X',STATUS='OLD')
      read(20,*)
      read(20,*)nat
      allocate(r(3*nat),ity(nat),bt(nat,7),nt(nat))
      do 1 ia=1,nat
      read(20,*)ity(ia),(r(3*(ia-1)+ix),ix=1,3),(bt(ia,ix),ix=1,7)
      nt(ia)=7
      do 2 ix=1,7
      if(bt(ia,ix).eq.0)then
       nt(ia)=ix-1
       goto 1
      endif
2     continue
1     continue
      close(20)

      q=0
      icoo=0
      iarg=0
      inp=0
      ihis=0
      do 3 ia=1,nat
      if(ity(ia).eq.6.and.nt(ia).eq.3)then
       o1=0
       o2=0
       no=0
       nn=0
       n1=0
       n2=0
       n3=0
       nh=0
       do 4 ix=1,nt(ia)
       ib=bt(ia,ix)
       if(ity(ib).eq.1)then
        nh=nh+1
       endif
       if(ity(ib).eq.8)then
        no=no+1
        if(o1.eq.0)then
         o1=ib
        else
         if(o2.eq.0)o2=ib
        endif
       endif
       if(ity(ib).eq.7)then
        nn=nn+1
        if(n1.eq.0)then
         n1=ib
        else
         if(n2.eq.0)then
          n2=ib
         else
          if(n3.eq.0)n3=ib
         endif
        endif
       endif
4      continue
C      Histidine+:
       if(nn.eq.2.and.nh.eq.1.and.nt(n1).eq.3.and.nt(n2).eq.3)then
        nnh=0
        nnc=0
        ic=0
        do 8 ix=1,nt(n1)
        ib=bt(n1,ix)
        if(ity(ib).eq.1)nnh=nnh+1
        if(ity(ib).eq.6.and.ib.ne.ia)then
         nnc=nnc+1
         ic=ib
        endif
8       continue
        nh2=0
        do 11 ix=1,nt(n2)
11      if(ity(bt(n2,ix)).eq.1)nh2=nh2+1
        if(nnh.eq.1.and.nh2.eq.1.and.nnc.eq.1.and.nt(ic).eq.3)then
         nc4=0
         c41=0
         c42=0
         do 9 ix=1,nt(ic)
         ib=bt(ic,ix)
         if(ity(ib).eq.6)then
          nc4=nc4+1
          if(c41.eq.0)then
           c41=ib
          else
           c42=ib
          endif
         endif
9        continue
         if(nc4.eq.1.or.nc4.eq.2)then
          if(nt(c41).eq.3)then
           n5=0
           nn5=0
           do 10 ix=1,nt(c41)
           ib=bt(c41,ix)
           if(ity(ib).eq.7)then
            nn5=nn5+1
            n5=ib
           endif
10         continue
           if(nn5.eq.1.and.n5.eq.n2)then
            q=q+1
            ihis=ihis+1
           endif
          endif
          if(c42.ne.0.and.nt(c42).eq.3)then
           n5=0
           nn5=0
           do 12 ix=1,nt(c42)
           ib=bt(c42,ix)
           if(ity(ib).eq.7)then
            nn5=nn5+1
            n5=ib
           endif
12         continue
           if(nn5.eq.1.and.n5.eq.n2)then
            q=q+1
            ihis=ihis+1
           endif
          endif
         endif
        endif
       endif
c      COO-:
       if(no.eq.2.and.nt(o1).eq.1.and.nt(o2).eq.1)then
        q=q-1
        icoo=icoo+1
       endif
c      ARG+:
       if(nn.eq.3.and.nt(ia).eq.3.and.nt(n1).eq.3.and.nt(n2).eq.3)then
        nh=0
        do 5 ix=1,nt(n1)
        ib=bt(n1,ix)
5       if(ity(ib).eq.1)nh=nh+1
        do 6 ix=1,nt(n2)
        ib=bt(n2,ix)
6       if(ity(ib).eq.1)nh=nh+1
        do 7 ix=1,nt(n3)
        ib=bt(n3,ix)
7       if(ity(ib).eq.1)nh=nh+1
        if(nh.eq.5)then
         q=q+1
         iarg=iarg+1
        endif
       endif
      endif

c     N+:
      if(ity(ia).eq.7.and.nt(ia).eq.4)then
       q=q+1
       inp=inp+1
      endif

3     continue

      open(2,file='charge.txt')
      write(2,*)q
      close(2)

      write(6,600)q,icoo,inp,iarg,ihis
600   format(5i5,' (Q NCOO- NN+ NARG+ NHIS+)')
      end