* this subroutine reads the C-C bond matrix BOND, the corresponding groups
* GROUP, and generates the (non-standardised) chemical formula CHEM
*******************************************************************
      SUBROUTINE rebond(bond,group,chem,nring) 
      IMPLICIT NONE
      INCLUDE 'general.h'
      INCLUDE 'common.h'

* input
      INTEGER,INTENT(in)          :: bond(mca,mca)
      CHARACTER(LEN=lgr),INTENT(in)  :: group(mca)
* output
      CHARACTER(LEN=lfo),INTENT(out) :: chem
      INTEGER,INTENT(out)         :: nring
* local
      INTEGER     ::    i,j,k,n,l,nc,idbflg,jj,beg
      INTEGER     ::    nca,ncx,nr,last,icheck
! rjg(nring,2) = indices of ring-joining groups
      INTEGER     ::    rjg(mri,2),nrs
      INTEGER     ::    rank(mca)
      INTEGER     ::    path(mca,mca,mca) 
      INTEGER     ::    clngth(mca,mca)
      INTEGER     ::    leaf, last2, ptr
      INTEGER     ::    ig, pg, ng
      LOGICAL     ::    lobond(mca,mca)

      INTEGER     ::    tbond(mca,mca)
      CHARACTER(LEN=lgr) :: tgroup(mca)

!---------------------------------------------------
      IF (wtflag.NE.0) WRITE(*,*) '*rebond*'
* initialize
      chem = ' '
      clngth(:,:) = 0
      lobond(:,:) = .false.
      path(:,:,:) = 0

* make a copy of group and bond so that these tables are
* not modified in the calling routines (due to uniqring)
      tgroup(:)=group(:)
      tbond(:,:)=bond(:,:)
      
      nca=0
      idbflg=0
      DO 20 n=1,mca
         IF (tgroup(n)(1:1) .NE. ' ') THEN
           nca=nca+1
           last=n
         ENDIF
         IF (INDEX(tgroup(n),'Cd').NE.0) idbflg=1
20    CONTINUE

      IF(nca.LT.1)RETURN

* If there is only one group in tgroup, chem=group and return
      IF (nca.EQ.1) THEN
        DO i=1,mca
          IF (tgroup(i).NE.' ') THEN
            chem=tgroup(i)
            RETURN
          ENDIF
        ENDDO
      ENDIF

! Find if we have ring(s)
      ncx = 0
      DO i=1,last
        DO j=i+1,last
          IF(tbond(i,j).GT.0) ncx = ncx + 1
        ENDDO
      ENDDO
      nring=ncx-nca+1
      
***** erase blank lines in bond and group
* icheck is just to know if we are in an infinite loop
       icheck=0
       i=1
15     CONTINUE
       IF (i.GT.nca) GOTO 30
       IF (tgroup(i).EQ.' ') THEN
         DO j=i,last
           tgroup(j)=tgroup(j+1)
         ENDDO
         tgroup(last)=' '
         DO j=1,last
           DO k=i,last-1
             tbond(k,j)=tbond(k+1,j)
           ENDDO
         ENDDO
         DO j=1,last
           DO k=i,last-1
             tbond(j,k)=tbond(j,k+1)
           ENDDO
         ENDDO
       ENDIF
       
       IF (tgroup(i).NE.' ') i=i+1

       icheck=icheck+1
       IF (icheck.GT.mca) THEN
         WRITE(*,*) '--error-- in rebond.f'
         WRITE(*,*) 'infinite loop when erasing blanks lines'
         STOP
       ENDIF
       GOTO 15

30     CONTINUE       

* troubleshooting
      !print*,'from rebond start, nring = ',nring
      !print*,'ncx = ',ncx,'; nca = ',nca,'; last = ',last
      !DO i=1,last
      !  write(6,'(a10,10(i2))'),tgroup(i),(tbond(j,i),j=1,last)
      !ENDDO

* find 'ends' of rings, add ring-join characters
* Richard : change closring because closring lead to an error 
* when used with bicyclic compounds (e.g. terpene like species).
* Since uniqring modify bopnd and group, a copy of the table 
* are used
      CALL ratings(nca,tgroup,tbond,nring,rank)
      IF(nring.GT.0) THEN
c        CALL ratings(nca,tgroup,tbond,nring,rank)
        CALL uniqring(nring,nca,tgroup,tbond,rank,rjg)
        DO k=1,nring
          i=rjg(k,1)
          j=rjg(k,2)
          tbond(i,j) = 0
          tbond(j,i) = 0
        ENDDO
c        CALL closring(nring,last,tgroup,tbond,rjg)
c        CALL rjgadd(nring,tgroup,rjg)
      ENDIF

* make a logical copy of the bond matrix
      DO i=1,nca
        DO j=1,nca
          IF (tbond(i,j).NE.0) lobond(i,j)= .true.
        ENDDO
      ENDDO

* bond between node 1 and 2 might be broken.
      beg=0
      DO i=1,mca
        IF (tgroup(i).NE.' ') THEN
          beg=i
          DO j=i+1,mca
            IF (lobond(i,j)) THEN
              CALL lntree(tbond,idbflg,i,j,nca,clngth,path)
              GOTO 42
            ENDIF
          ENDDO  
        ENDIF
      ENDDO
42    CONTINUE

c      IF (lobond(1,2)) THEN
c        CALL lntree(tbond,idbflg,1,2,nca,clngth,path)
c      ELSE
c        DO j=3,nca
c          IF (lobond(1,j)) THEN
c            CALL lntree(tbond,idbflg,1,j,nca,clngth,path)
c            GOTO 42
c          ENDIF
c        ENDDO  
c42    ENDIF

c      IF (nring.GT.0) GOTO 123
* look down-top for the very longest tree ...
      DO 50 i=1,nca
        IF (clngth(beg,i).NE.0) THEN
           leaf = path(beg,i,clngth(beg,i))
           last2 = path(beg,i,clngth(beg,i)-1)
           CALL lntree(tbond,idbflg,leaf,last2,nca,clngth,path)
           DO j=1,nca
             IF (clngth(leaf,j).NE.0) THEN
               ptr = 1
               DO k=1,nca
                 ig = path(leaf,j,k)
                 IF (ig.NE.0) THEN
                   IF (k.GT.1)   pg = path(leaf,j,k-1)
                   IF (k.LT.nca) ng = path(leaf,j,k+1)
                   !print*,'stdchm ',ig,pg,ng
                   CALL mkcopy
     &             (lobond,tgroup,nca,rank,nring,ig,pg,ng,ptr,chem)
                 ENDIF
               ENDDO
               GOTO 123 ! the first copy has been written in chem
             ENDIF
           ENDDO
        ENDIF
50    CONTINUE
      
123   CONTINUE

* add '=' id double bond
      IF (idbflg.NE.0) CALL dwrite(chem)

!      IF (wtflag.NE.0) WRITE(*,*) '*end rebond*'

      RETURN
  
      END