*  This subroutine fragments a chemical into two parts.  
*  It is assumed that the bond breaking is already done in the calling
*  program, by setting the corresponding element of BOND to zero
***************************************************************************
      SUBROUTINE fragm(bond,group,chem1,chem2)
      IMPLICIT NONE
      INCLUDE 'general.h'
      INCLUDE 'common.h'

* input
      INTEGER         bond(mca,mca)
      CHARACTER(LEN=lgr) group(mca)

* output
      CHARACTER(LEN=lfo) chem1, chem2

* internal
      INTEGER         tbnd1(mca,mca)
      CHARACTER(LEN=lgr) tgrp1(mca)
      INTEGER         tbnd2(mca,mca)
      CHARACTER(LEN=lgr) tgrp2(mca)
      INTEGER         trace1(mca), trace2(mca)
      INTEGER         i,j,nring,nca

      IF(wtflag.GT.0) WRITE(6,*) '*fragm*'

      nca=0
      DO i=1,mca
        IF (group(i)(1:1).NE.' ') nca=nca+1
      ENDDO

* troubleshooting
      IF(wtflag.GT.0) THEN
        DO i=1,nca
          print*,group(i)
        print*,' '
        ENDDO
        DO i=1,nca
          print*,(bond(i,j),j=1,nca)
        ENDDO
        print*,' '
        
      ENDIF

* initialize tracer arrays
      chem1=' '
      chem2=' '
      DO i=1,mca
         trace1(i) = 0
         trace2(i) = 0
      ENDDO

      DO i=1,mca
         tgrp1(i) = ' '
         tgrp2(i) = ' '
      ENDDO

      DO i=1,mca
         DO j=1,mca
            tbnd1(i,j) = 0
            tbnd2(i,j) = 0
         ENDDO
      ENDDO


* connect TRACE1
* if not connected, skip
      trace1(1) = 1
      DO 10 i=1,mca-1
         IF (trace1(i).EQ.0) GO TO 10
         DO j=i+1,mca
            IF (bond(i,j).GE.1) trace1(j) = 1
         ENDDO
10    CONTINUE

* construct TRACE2 from non-blank remainder 
      DO i=1,mca
         IF( (trace1(i).EQ.0) .AND. (group(i).NE.' ') ) trace2(i) = 1
      ENDDO

* write new GROUP1, GROUP2, BOND1 and BOND2 elements:
      DO i=1,mca
         IF (trace1(i).EQ.1) THEN
            tgrp1(i) = group(i)
            DO j=1,mca
                tbnd1(i,j) = bond(i,j)
            ENDDO
         ENDIF

         IF (trace2(i).EQ.1) THEN
            tgrp2(i) = group(i)
            DO j=1,mca
               tbnd2(i,j) = bond(i,j)
            ENDDO
         ENDIF
      ENDDO

      CALL rebond(tbnd1,tgrp1,chem1,nring)
      CALL rebond(tbnd2,tgrp2,chem2,nring)
      IF(wtflag.GT.0) print*,'*fragm* : out 1 : ',TRIM(chem1)
      IF(wtflag.GT.0) print*,'*fragm* : out 2 : ',TRIM(chem2)
      
      RETURN
      END