************************************************************************ * MASTER MECHANISM - ROUTINE NAME : lntree * * * * * * PURPOSE : Set-up the tree of the C-C and C-O-C bond starting at * * the group in the input (top) and evaluate the longest * * path and its length. * * * * INPUT: * * - bond(i,j) : carbon-carbon bond matrix * * - dbflg : flag for double-bond indication * * - top : 1st group (C) => starting point * * - sec : 2nd group (C) => carbon just after top in the * * skeleton * * - nca : number of group * * * * INPUT/OUTPUT: * * - clngth(i,j) : length of jth path found starting at the ith * * group (C) position (here "i" is "top") * * - path(i,j,k) : trees (path) of the jth path found starting at the * * ith group (C) position (here "i" is "top") * * * * The purpose of this routine is to evaluate the longest chain of * * the molecule. With the information in the bond-matrix, it is * * possible to evaluate the top-down trees of the molecule: * * e.g. CO(CH3)CH(CH(OH)(CH3))CHO * * 1 2 3 4 5 6 * * ___ * * | 1 | parent of 2,3 * * --- * * / \ * * ___ ___ * * child of 1| 2 | | 3 | child of 1, parent of 4,6 * * --- --- * * / \ * * ___ ___ * * child of 3 & | 4 | | 6 | child of 3 * * parent of 5 --- --- * * / * * ___ * * | 5 | child of 4 * * --- * * * * A child on the left hand is called "LEFT", on the right hand * * "RIGHT" and in the middle "CENTER". * * In CLNGTH the length of each longest tree is stored. * * Nevertheless the longest chain is the chain with most of the * * double bonds in it. * * First all relationships (parent - children) are evaluated. Then * * the top-down paths are defined so that first a LEFT, if not * * available, a RIGHT and then a CENTER is taken. As often as at * * least one child exists the specified path is followed further on. * * In the last section the longest paths and the paths with the * * most double-bonds in it still remain and are given to the cal- * * ling routine. * * * ************************************************************************ SUBROUTINE lntree(bond,dbflg,top,sec,nca,clngth,path) IMPLICIT NONE INCLUDE 'general.h' * input/output: INTEGER clngth(mca,mca) INTEGER path(mca,mca,mca) INTEGER top,sec INTEGER nca INTEGER bond(mca,mca) INTEGER dbflg * internal: INTEGER left(mca),right(mca),center(mca),parent(mca) INTEGER flag(mca),sumcd INTEGER ptr,knt,nknt,nct1,nct2 INTEGER maxlng,maxcd,kt,iend,i,j,k LOGICAL tbond(mca,mca) * ----------- * initialize * ----------- ptr = 0 DO i=1,mca flag(i) = 0 left(i) = 0 right(i) = 0 center(i) = 0 parent(i) = 0 ENDDO * make a logical bond matrix (tbond only used to find parent and child) DO i=1,mca DO j=1,mca IF (bond(i,j).eq.0) THEN tbond(i,j) = .false. ELSE tbond(i,j) = .true. ENDIF ENDDO ENDDO left(top) = sec parent(sec) = top tbond(top,sec) = .false. tbond(sec,top) = .false. * --------------------------------------- * get the relationships (parent/children) * --------------------------------------- DO k=1,nca nknt = 0 DO i=1,nca knt = 0 DO j=1,nca IF (tbond(i,j)) THEN knt = knt + 1 ptr = j ENDIF ENDDO nknt = nknt + knt * look for ith carbon with only one node, where parents do not * exist: (ith carbon = child,jth carbon = parent) IF (knt.EQ.1) THEN IF ( (parent(i).EQ.0).and.(i.NE.top) ) THEN parent(i) = ptr tbond(i,ptr) = .false. tbond(ptr,i) = .false. IF(left(ptr).EQ.0) THEN left(ptr) = i ELSE IF(right(ptr).EQ.0) THEN right(ptr) = i ELSE IF(center(ptr).EQ.0) THEN center(ptr) = i ELSE * if all children taken, error in bond-matrix: DO j=1,mca WRITE(6,*) (bond(j,iend),iend=1,mca) ENDDO WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE: lntree' WRITE(6,'(a)') 'no path possible, error in bonding' STOP ENDIF ENDIF ENDIF ENDDO * do loop until bond-matrix is (0). IF (nknt.EQ.0) GOTO 35 ENDDO 35 CONTINUE * --------------------------------------------- * define all top-down pathes starting at "top" * --------------------------------------------- nct1 = nca - 1 nct2 = nca + 4 DO 40 i=1,nct1 ptr = top path(top,i,1) = top DO j=2,nct2 IF(flag(ptr).EQ.0) THEN IF(left(ptr).NE.0) THEN ptr = left(ptr) path(top,i,j) = ptr ELSE flag(ptr) = 1 ENDIF ELSE IF(flag(ptr).EQ.1) THEN IF(right(ptr).NE.0) THEN ptr = right(ptr) path(top,i,j) = ptr ELSE flag(ptr) = 2 ENDIF ELSE IF(flag(ptr).EQ.2) THEN IF(center(ptr).NE.0) THEN ptr = center(ptr) path(top,i,j) = ptr ELSE flag(ptr) = 3 flag(parent(ptr)) = flag(parent(ptr)) + 1 GOTO 40 ENDIF ELSE IF (flag(ptr).EQ.3) THEN flag(parent(ptr)) = flag(parent(ptr)) + 1 GOTO 40 ENDIF ENDDO 40 CONTINUE * --------------------- * get the longest path * --------------------- * If double-bonds exists then take path with most of them in it as * the first criterion, then the longest path (in fact, the test * does not check if the C=C bond is in the path but only if the * C in the path hold a double bond) c IF (dbflg.NE.0) THEN c maxlng = 0 c maxcd = 0 c DO i=1,nca c sumcd=0 c DO j=1,nca c IF (path(top,i,j).NE.0) THEN c DO k=1,nca c IF (bond(path(top,i,j),k).EQ.2) sumcd=sumcd+1 c ENDDO c clngth(top,i) = clngth(top,i) + 1 c ENDIF c ENDDO c c IF (sumcd.gt.maxcd) THEN c maxlng = clngth(top,i) c maxcd = sumcd c iend=i-1 c DO j=1,iend c clngth(top,j) = 0 c ENDDO c c ELSE IF (sumcd.eq.maxcd) THEN c IF (clngth(top,i).gt.maxlng) THEN c maxlng = clngth(top,i) c iend=i-1 c DO j=1,iend c clngth(top,j) = 0 c ENDDO c ELSE IF (clngth(top,i).lt.maxlng) THEN c clngth(top,i) = 0 c ENDIF c c ELSE c clngth(top,i) = 0 c ENDIF c ENDDO * if no double bond, take simply the longest c ELSE maxlng = 0 DO i=1,nca DO j=1,nca IF (path(top,i,j).NE.0) clngth(top,i)=clngth(top,i) + 1 ENDDO IF (clngth(top,i).GT.maxlng) THEN maxlng = clngth(top,i) iend=i-1 DO j=1,iend clngth(top,j) = 0 ENDDO ELSE IF (clngth(top,i).LT.maxlng) THEN clngth(top,i) = 0 ENDIF ENDDO c ENDIF * end of lntree RETURN END