program delete_water
      real,allocatable::r(:)
      integer,allocatable::bt(:,:),ty(:)
      character*3,allocatable::sy(:)
      character*80 fn,fnn
      write(6,*)' Delete water atoms in Tinker files'
      write(6,*)' Old filename:'
      read(5,'(a)')fn
      write(6,*)' New filename:'
      read(5,'(a)')fnn

      open(8,file=fn)
      read(8,*)nat
      write(6,*)nat, ' atoms'
      allocate(r(3*nat),bt(nat,4),ty(nat),sy(nat))
      do 1 i=1,nat
1     read(8,801)sy(i),(r(3*(i-1)+ix),ix=1,3),ty(i),(bt(i,ix),ix=1,4)
801   format(8x,a3,3f12.6,5i6)
      close(8)

      iw1=2001
      iw2=2002
      write(6,*)' water types:',iw1,iw2

      ia=0
56    ia=ia+1
      if(ia.lt.nat)then
55     if(ty(ia).eq.iw1.or.ty(ia).eq.iw2)then

c       first atom after ia that is not water
        do 9 ino=ia+3,nat
9       if(ty(ino).ne.iw1.and.ty(ino).ne.iw2) goto 99
        nat=ia-1
        goto 88
99      ioff=ino-ia
        do 2 i=ia,nat-ioff
        do 3 ix=1,3
3       r(3*(i-1)+ix)=r(3*(i+ioff-1)+ix)
        sy(i)=sy(i+ioff)
        ty(i)=ty(i+ioff)
        do 2 ix=1,4
2       bt(i,ix)=bt(i+ioff,ix)

        nat=nat-ioff
        do 5 i=1,nat
        do 5 ix=1,4
5       if(bt(i,ix).ge.ia)bt(i,ix)=bt(i,ix)-ioff
        if(nat.gt.0.and.ia.le.nat)goto 55
       endif
       if(ia.lt.nat)goto 56
      endif

88    write(6,*)nat, ' atoms left'
      
      open(9,file=fnn)
      write(9,901)nat
901   format(i6)
      do 7 ia=1,nat
      nt=4
      do 8 ix=4,1,-1
8     if(bt(ia,ix).eq.0)nt=ix-1
7     write(9,902)ia,sy(ia),(r(3*(ia-1)+ix),ix=1,3),ty(ia),
     1(bt(ia,ix),ix=1,nt)
902   format(i6,2x,a3,3f12.6,5i6)
      close(9)

      end