      subroutine rintab (ipr,irff,irf,iri,rindid,icomp,lv,geom,igeo,    RINT001
     &      elemt,ide,iat,ihand,lo,hi,loang,hiang,itetra,condis,conang, RINT002
     &      bad,ibadct,ibad,bump,ihydtp,iwat,an,de,watat,iwarr)                     RINT003
c ----------------------------------------------------------------------RINT004
c     This program module is part of the author's X-ray Library         RINT005
c     and may not be sold or reproduced for commercial purposes.        RINT006
c     Although it has been tested carefully, there is no warranty       RINT007
c     regarding accuracy or freedom from side-effects.                  RINT008
c                   (C) 1986-1994 Bernhard Rupp                         RINT009
c ----------------------------------------------------------------------RINT010
c     RINTAB prints a table of the (unique) ring structures found in    RINT011
c     subroutine RINGSS                                                 RINT012
c ----------------------------------------------------------------------RINT013
                                                                        RINT014
      character lv,an,de,elemt*2,ide*4,icomp*4,geom*25,geomtx*25        RINT015
      character hydshl*8                                                RINT016
      integer irff(iri),itetra(iat),ihydtp(iat,2),iwatyp(0:9),iarr(0:9)           RINT017
      real rindid(7*iri,6),lo,hi,loang,hiang,dd,bad(ibadct,3)           RINT018
      dimension elemt(iat),ide(iat),atlis(100,2),geom(igeo),hydshl(0:9) RINT019
      dimension watat(iat,4),rheap(2),rrheap(4),ihydsl(0:9),iwarr(iat,2)

      data (hydshl(k),k=0,9)/'isolated','first','second','third',       RINT021
     &'fourth','fifth','sixth','seventh','eighth','nineth'/             RINT022
                                                                        RINT023
      ifive=0                                                           RINT024
      isix=0                                                            RINT025
      iseven=0
      
      r1=4.47
      r2=6.69                                                           026
                                                                        RINT027
c --- sort out how many ring structures of each kind ---
      do 0001 i=1,irf                                                   RINT028
         if(irff(i).eq.5) then                                          RINT029
           ifive=ifive+1                                                RINT030
         elseif(irff(i).eq.6) then                                      RINT031
           isix=isix+1                                                  RINT032
         elseif(irff(i).eq.7) then                                      RINT033
           iseven=iseven+1                                              RINT034
         else                                                           RINT035
           write(ipr,*)' Tilt in irff(irf) '                            RINT036
         end if                                                         RINT037
 0001 continue

      itet=0
c --- check how many tetrahedra found --                                                           RINT038
      do 0002 i=1,iat
              if ((itetra(i).eq.7).or.(itetra(i).eq.39)) itet=itet+1
 0002 continue                                                                  RINT039

c --- print initial table --- 
      do 0003 i=ipr,ipr+2                                               RINT040
         write(i,*)                                                     RINT041
         call frames(i,1,icomp)                                         RINT042
         write(i,'(1x,a1,20x,a,20x,a1)') lv,                            RINT043
     &        ' Summary of water structure analysis ',lv                RINT044
         call frames(i,2,icomp)                                         RINT045
         write(i,'(1x,a1,a,i4,29x,a1)') lv,                             RINT046
     &     ' Number of water atoms treated in analysis :',iwat,lv       RINT047
         write(i,'(1x,a1,2(a,f5.3),1x,a1,27x,a1)')lv,                   RINT048
     &      ' Ring search H-bond distance from ',lo,' to ',hi,an,lv     RINT049
         write(i,'(1x,a1,2(a,f5.1),1x,a1,27x,a1)')lv,                   RINT050
     &      ' Ring search H-bond angles   from ',loang,                 RINT051
     &      ' to ',hiang,de,lv                                          RINT052
         write(i,'(1x,a1,a,f5.3,a,12x,a1)')lv,                          RINT125
     &      ' Tetrahedral distance range cutoff is first H-bond found +'      RINT126
     &      ,condis,' A',lv                                             RINT127
         write(i,'(1x,a1,a,f5.1,1x,a1,22x,a1)')lv,                          RINT128
     &      ' Permissible tetrahedral angle deviation is +/- ',conang,
     &      de,lv      
         write(i,'(1x,a1,a,9x,a1)') lv,                                 RINT046
     &   ' The above bond distance and angle conditions result in findin
     &g of :',lv                   
         write(i,'(1x,a1,4(i3,a),1x,a1)') lv, ifive,' Pentagons, ',     RINT053
     &    isix,' Hexagons, ',iseven-ihand,' Heptagons, ',ihand,         RINT054
     &    ' Pentagons with connection   ',lv                            RINT055
         write(i,'(1x,a1,i3,a,26x,a1)') lv,                                RINT046
     &   itet,' (distorted) tetrahedrons with water as a centre',lv                  RINT047
         call frames(i,2,icomp)                                         RINT124
         if (ibad.eq.0) then                                            RINT130
            write(i,'(1x,a1,1x,a,f3.1,a,31x,a1)') lv,                          RINT131
     &      ' No bad contacts below ',bump,' angstroem detected', lv         RINT132
         else                                                           RINT133
            write(i,'(1x,a1,1x,i3,a,f3.1,a,31x,a1)') lv, ibad,          RINT135
     &      ' bad contacts below ',bump,' angstroem detected', lv       RINT136
            call frames(i,2,icomp)                                      RINT137
            do 0004 ii=1,ibad                                           RINT138
             write(i,'(1x,a1,4x,a2,2x,a4,a3,a2,2x,a4,5x,f8.4,41x,a1)')   RINT139
     &       lv, elemt(bad(ii,1)),ide(bad(ii,1)),' - ',elemt(bad(ii,2)), RINT140
     &       ide(bad(ii,2)), bad(ii,3),lv                                RINT141
 0004       continue                                                    RINT142
         end if                                                         RINT143
         call frames(i,3,icomp)                                         RINT042
 0003 continue
 
c --- hydration shell analysis follows -
      do 0005 j=0,9                                                     RINT150
         iwatyp(j)=0                                                    RINT151
         ihydsl(j)=0
 0005 continue                                                          RINT152
                                                                         RINT153
      do 0006 j=1,iwat                                                   RINT154
         ik=ihydtp(j,2)                                                   RINT155
         iwatyp(ik)=iwatyp(ik)+1
 0006 continue                                                           RINT157

      itwat=0
      do 0007 j=1,iat
         if (watat(j,1).gt.0.001) then
            itwat=itwat+1
            if (watat(j,2).lt.0.001) then
               ihydsl(0)=ihydsl(0)+1
               ihydtp(itwat,2)=0
            elseif (watat(j,3).gt.r1) then
               ihydsl(2)=ihydsl(2)+1
               ihydtp(itwat,2)=2
            else if (watat(j,3).gt.r2) then
               ihydsl(3)=ihydsl(3)+1
               ihydtp(itwat,2)=2
            else
               ihydsl(1)=ihydsl(1)+1
               ihydtp(itwat,2)=1
            end if
         end if
 0007 continue   

c --- print the hydration shell analysis --
      do 0008 i=ipr,ipr+2
         write(i,*)                                                     RINT159
         call frames(i,1,icomp)                                         RINT160
         write(i,'(1x,a1,1x,a,i4,a,18x,a1)') lv,                       
     &        'Hydration shell statistics of ',iwat,
     &        ' water atoms based on : ',lv
         write(i,'(1x,a1,1x,a,f4.2,1x,a1,39x,a1)') lv,
     &    'a) shell grouping thickness of ', condis,an,lv                                              RINT161
         call frames(i,2,icomp)                                         RINT163
         write(i,'(1x,a1,a,a1)') lv,                                    RINT164
     &    ' Isolated    1.     2.     3.     4.     5.     6.     7.    RINT165
     & 8.     9. Shell',lv                                              RINT166
         call frames(i,2,icomp)                                         RINT167
         write(i,'(1x,a1,1x,a4,i3,9(4x,i3),6x,a1)') lv,'num.',          RINT168
     &            (iwatyp(k),k=0,9),lv                                  RINT169
         do 0009 k=0,9                                                  RINT170
            iarr(k)=int((100.0*iwatyp(k))/iwat)                         RINT171
 0009    continue                                                       RINT172
         write(i,'(1x,a1,1x,a4,i3,9(4x,i3),6x,a1)') lv,'in %',          RINT173
     &            (iarr(k),k=0,9),lv                                    RINT174
         call frames(i,2,icomp)
         srad=(lo+hi)/2.0                                               RINT175
         write(i,'(1x,a1,1x,a,f4.2,1x,a1,27x,a1)') lv,
     &    'b) tetrahedral packing of water spheres of ', srad,an,lv                                              RINT161
         call frames(i,2,icomp)                                         RINT163

         write(i,'(1x,a1,1x,a4,i3,9(4x,i3),6x,a1)') lv,'num.',          RINT168
     &            (ihydsl(k),k=0,9),lv                                  RINT169
         do 0010 k=0,9                                                  RINT170
            iarr(k)=int((100.0*ihydsl(k))/iwat)                         RINT171
 0010    continue                                                       RINT172
         write(i,'(1x,a1,1x,a4,i3,9(4x,i3),6x,a1)') lv,'in %',          RINT173
     &            (iarr(k),k=0,9),lv                                    RINT174

         call frames(i,3,icomp)                                         RINT175
         write(i,*)
 0008 continue

c --- water statistics according to cavity dimensions and neighbours --
      do 0011 ii=1,iat                                                  RINT098
         watat(ii,4)= -watat(ii,4)                                      RINT099
 0011 continue                                                          RINT100
      call heapst (iat,watat,4,iat,4,rrheap)                                RINT101
      do 0012 ii=1,iat                                                  RINT098
         watat(ii,4)= -watat(ii,4)                                      RINT099
         iwarr(ii,1)=int(watat(ii,1))     
         iwarr(ii,2)=int(watat(ii,4))
 0012 continue
                                                             
      do 0013 ii=1,iat                                                   RINT098
         watat(ii,3)= -watat(ii,3)                                      RINT099
 0013 continue                                                          RINT100
      call heapst (iat,watat,3,iat,4,rrheap)                                RINT101
      do 0014 ii=1,iat                                                  RINT098
         watat(ii,3)= -watat(ii,3)                                      RINT099
 0014 continue                                                          RINT100

      do 0015 i=ipr ,ipr+2
         call frames(i,1,icomp)                                         RINT175
         write(i,'(1x,a1,1x,a,14x,a1)') lv,                       
     &  'Water atoms beyond first hydration shell sorted according to :'
     &   ,lv
         write(i,'(1x,a1,1x,a,4x,a1)') lv,                       
     &  'Atom ident   sph.cavity radius    atom  ident    no. of water nw
     &eighbours', lv
         call frames (i,2,icomp)
         do 0016 ik=1,iat
            if ((watat(ik,1).gt.0.001).and.(watat(ik,3).ge.4.47))then
               j=int(watat(ik,1))
               k=iwarr(ik,1)
      write(i,'(1x,a1,1x,a2,2x,a4,10x,f7.4,10x,a2,2x,a4,10x,i4,19x,a1)')
     &   lv,elemt(j),ide(j),watat(ik,3),elemt(k),ide(k),iwarr(ik,2),lv
     
            end if
 0016    continue   
         call frames (i,3,icomp)
 0015 continue                                                          RINT177

c --- sort ring atoms into occurance bins for listing of nodes ---
      ilist=1                                                           RINT057
      ibeg=1                                                            RINT058
      do 0018 j=1,ifive+isix+iseven                                     RINT059
         ik=1                                                           RINT061
         do 0019 k=ibeg, ibeg+irff(j)-1                                 RINT062
            iold=0                                                       RINT067
            do 0020 ii=1,ilist-1                                         RINT068
               if (rindid(k,1).eq.atlis(ii,1)) iold=ii                  RINT069
 0020       continue                                                    RINT070
            if (iold.eq.0) then                                          RINT071
               atlis(ilist,1)=rindid(k,1)                                RINT072
               atlis(ilist,2)=1                                         RINT073
               ilist=ilist+1                                             RINT074
            else                                                          RINT075
               atlis(iold,2)=atlis(iold,2)+1                             RINT076
            end if                                                       RINT077
            ik=ik+1                                                       RINT081
 0019    continue                                                         RINT082
         ibeg=ibeg+irff(j)                                               RINT083
 0018 continue                                                            RINT084
      ilist=ilist-1                       

c --- sort the array atlist according to occurence of atoms in ring --                                                 RINT097
      do 0022 ii=1,ilist                                                RINT098
         atlis(ii,2)= -atlis(ii,2)                                      RINT099
 0022 continue                                                          RINT100
      call heapst (ilist,atlis,2,100,2,rheap)                              RINT101
      do 0023 ii=1,ilist                                                RINT102
         atlis(ii,2)= -atlis(ii,2)    
 0023 continue                                                           RINT104

c --- print the possible node table based on atlist --

      do 0024 i=ipr,ipr+2
         write(i,*)                                                     RINT087
         call frames(i,1,icomp)                                         RINT088
         write(i,'(1x,a1,24x,a,23x,a1)') lv,                            RINT089
     &        'Possible water structure nodes',lv                       RINT090
         call frames(i,2,icomp)                                         RINT091
         write(i,'(1x,a1,1x,a,a, 3x,a1)') lv,                           RINT092
     &    'Atom Ident Occurence   1.shell ligand     Hydration    w',   RINT093
     &    'ater    cavity   ',lv                                        RINT094
         write(i,'(1x,a1,1x,a,a, 3x,a1)') lv,                           RINT092
     &    '            in rings    configuration       shell    nei',   RINT093
     &    'gbours  radius   ',lv                                        RINT094
         call frames(i,2,icomp)                                         RINT095
         do 0025 ii=1,ilist                                             RINT106
            if (int(atlis(ii,2)).ge.3) then                             RINT107
            if (itetra(atlis(ii,1)).lt.1) then                          RINT108
               geomtx='Not evaluated'                                   RINT109
            else                                                        RINT110
               geomtx=geom(itetra(atlis(ii,1)))                         RINT111
            end if                                                      RINT112
c ---       iiat is number of atom in atlis --                          RINT113
            iiat=atlis(ii,1)                                            RINT114
            do 0026 ik=1,iat                                            RINT115
               if (iiat.eq.ihydtp(ik,1)) iity=ihydtp(ik,2)
               if (iiat.eq.watat(ik,1)) then
                  iwaa=int(watat(ik,4))
                  ratata=watat(ik,3)
               end if                                                       RINT116
 0026       continue                                                    RINT117
c ---       iwaa and ratata und leck du mich am arsch haha --
            write
     &     (i,'(1x,a1,1x,a2,2x,a4,4x,i4,2x,a,1x,a,3x,i5,4x,f6.3,6x,a1)')               RINT119
     &      lv, elemt(atlis(ii,1)),ide(atlis(ii,1)),int(atlis(ii,2)),       RINT120
     &      geomtx,hydshl(iity),iwaa,ratata,lv                            RINT121
            end if                                                      RINT122
 0025    continue                                                       RINT123
         call frames(i,3,icomp)                                         RINT144
 0024 continue

c --- ring list follows ---
      do 0030 i=ipr,ipr+2
c         ilist=1                                                        RINT057
         ibeg=1
         write(i,*)
         call frames(i,1,icomp)                                          RINT060
         write(i,'(1x,a1,a,8x,a1)') lv,
     &   'Abreviated list of ring structures follows - full listing in RING                                                                RINT058
     &ING.DAT', lv
         call frames(i,2,icomp)                                          RINT060
         do 0031 j=1,ifive+isix+iseven                                  RINT059
            ik=1                                                        RINT061
            write(i,'(1x,a1,i2,a1$)') lv,irff(j),':'                           RINT062
            do 0032 k=ibeg, ibeg+irff(j)-1
               write(i,'(1x,a2,a4,a1,1x$)')
     &               elemt(rindid(k,1)),ide(rindid(k,1)),','                
               ik=ik+1                                                  RINT081
 0032       continue
            if (irff(j).eq.5) then
               write(i,'(34x,a1)')lv
            else if (irff(j).eq.6) then
               write(i,'(26x,a1)')lv
            else
               write(i,'(18x,a1)')lv
            end if      
            ibeg=ibeg+irff(j)                                           RINT083
 0031    continue                                                       RINT084
         call frames(i,3,icomp)                                         RINT086
 0030 continue

      i=21
      open(i,file='ring.dat',status='unknown')
c --- ring list follows ---
         ilist=1                                                        RINT057
         ibeg=1                                                         RINT058
         do 0143 j=1,ifive+isix+iseven                                  RINT059
            call frames(i,1,icomp)                                      RINT060
            ik=1                                                        RINT061
            do 0144 k=ibeg, ibeg+irff(j)-1                              RINT062
               x2=(rindid(k,2)-rindid(ibeg+irff(j)-1,2))**2             RINT063
               y2=(rindid(k,3)-rindid(ibeg+irff(j)-1,3))**2             RINT064
               z2=(rindid(k,4)-rindid(ibeg+irff(j)-1,4))**2             RINT065
               dd=sqrt(x2+y2+z2)                                        RINT066
               iold=0                                                   RINT067
               do 0145 ii=1,ilist-1                                     RINT068
                  if (rindid(k,1).eq.atlis(ii,1)) iold=ii               RINT069
 0145          continue                                                 RINT070
               if (iold.eq.0) then                                      RINT071
                  atlis(ilist,1)=rindid(k,1)                            RINT072
                  atlis(ilist,2)=1                                      RINT073
                  ilist=ilist+1                                         RINT074
               else                                                     RINT075
                  atlis(iold,2)=atlis(iold,2)+1                         RINT076
               end if                                                   RINT077
               write(i,'(1x,a1,i2,a1,1x,a2,1x,a4,6(f9.4),12x,a1)')lv,ik,RINT078
     &               '.',elemt(rindid(k,1)),ide(rindid(k,1)),           RINT079
     &                (rindid(k,ii),ii=2,6),dd,lv                       RINT080
               ik=ik+1                                                  RINT081
 0144       continue                                                    RINT082
            ibeg=ibeg+irff(j)                                           RINT083
 0143    continue                                                       RINT084
         ilist=ilist-1                                                  RINT085
         call frames(i,3,icomp)                                         RINT086
      close (21)

c --- end ringlist ---

      return                                                            RINT178
      end                                                               RINT179
