************************************************************************ * MASTER MECHANISM - ROUTINE NAME : lntreeCd * * * * * * 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 containing double bonds 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 lntreeCd(bond,dbflg,top,sec,nca,clngth,path) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'common.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 * ----------- ! print*,'*lntreeCd*' ptr = 0 flag = 0 left = 0 right = 0 center = 0 parent = 0 path = 0 clngth = 0 * 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 paths 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) IF (dbflg.NE.0) THEN maxlng = 0 maxcd = 0 DO i=1,nca sumcd=0 DO j=1,nca IF (path(top,i,j).NE.0) THEN DO k=1,nca IF (bond(path(top,i,j),k).EQ.2) sumcd=sumcd+1 ENDDO clngth(top,i) = clngth(top,i) + 1 ENDIF ENDDO IF (sumcd.gt.maxcd) THEN maxlng = clngth(top,i) maxcd = sumcd iend=i-1 DO j=1,iend clngth(top,j) = 0 ENDDO ELSE IF (sumcd.eq.maxcd) THEN 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 ELSE clngth(top,i) = 0 ENDIF ENDDO * if no double bond, take simply the longest 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 ENDIF * end of lntree RETURN END