************************************************************************ * MASTER MECHANISM - ROUTINE NAME : treebr * * * * PURPOSE : THIS ROUTINE IS VERY SIMILAR TO LNTREE. Main difference * * is that lntree is called to find the longest tree in the * * molecule while treebr is called to find the longest tree * * in a given branch of the molecule. * * Treebr sets up the tree of the C-C bond starting at the * * group given in the input (top) and evaluate the longest * * path (brpath), its length (maxlng) and the total number * * of path having the maximum length (npath) * * * * INPUT: * * - bond(i,j) : carbon-carbon bond matrix * * - top : 1st group (C) => starting point * * - sec : 2nd group (C) => carbon just after top in the * * skeleton * * - nca : number of group * * * * OUTPUT: * * - brpath(j,k) : trees (path) of the jth path found starting at the * * ith group (C) position (here "i" is "top") * * -maxlng : maximum length of the pathes found * * -npath : number of pathes having the maximum length * * * * * * -SEE LNTREE FOR ADDITIONAL COMMENT - * * * ************************************************************************ SUBROUTINE treebr(lobond,ig,top,sec,nca,brpath,maxlng,npath) IMPLICIT NONE INCLUDE 'general.h' * input/output: INTEGER brpath(mca,mca) INTEGER top,sec,ig INTEGER nca LOGICAL lobond(mca,mca) INTEGER maxlng,npath * internal: INTEGER left(mca),right(mca),center(mca),parent(mca) INTEGER tlngth(mca) INTEGER tpath(mca,mca) INTEGER flag(mca) INTEGER ptr,knt,nknt,nct1,nct2 INTEGER kt,iend,i,j,k LOGICAL tbond(mca,mca) !print*,'*treebr*' * ----------- * initialize * ----------- ptr = 0 DO i=1,mca flag(i) = 0 left(i) = 0 right(i) = 0 center(i) = 0 parent(i) = 0 tlngth(i) = 0 DO j=1,mca brpath(i,j) = 0 tpath(i,j) = 0 ENDDO ENDDO * make a copy of logical bond matrix DO i=1,mca DO j=1,mca tbond(i,j) = lobond(i,j) ENDDO ENDDO left(top) = sec parent(sec) = top parent(top) = ig ! JMLT : this line added to avoid zero array-index, line 161 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.and.i.NE.ig) 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,*) (lobond(j,iend),iend=1,mca) ENDDO WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE: treebr' WRITE(6,'(a)') 'no path possible, error in bonding' STOP ENDIF ENDIF ENDIF ENDDO * do loop until bond-matrix for the branch 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 tpath(i,1) = top DO j=2,nct2 IF(flag(ptr).EQ.0) THEN IF(left(ptr).NE.0) THEN ptr = left(ptr) tpath(i,j) = ptr ELSE flag(ptr) = 1 ENDIF ELSE IF(flag(ptr).EQ.1) THEN IF(right(ptr).NE.0) THEN ptr = right(ptr) tpath(i,j) = ptr ELSE flag(ptr) = 2 ENDIF ELSE IF(flag(ptr).EQ.2) THEN IF(center(ptr).NE.0) THEN ptr = center(ptr) tpath(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 * --------------------- * get the length of each path and found the maximum length maxlng = 0 DO i=1,nca DO j=1,nca IF (tpath(i,j).NE.0) tlngth(i)=tlngth(i) + 1 ENDDO IF (tlngth(i).GT.maxlng) THEN maxlng = tlngth(i) ENDIF ENDDO * find all paths having the maximum length npath = 0 DO i=1,nca IF (tlngth(i).eq.maxlng) THEN npath=npath+1 DO j=1,nca brpath(npath,j)=tpath(i,j) ENDDO ENDIF ENDDO * check if everything is ok IF (npath.EQ.0) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE: treebr' WRITE(6,'(a)') 'no path found' STOP ENDIF IF (maxlng.LT.2) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE: treebr' WRITE(6,'(a)') 'length of the path shorter than expected' STOP ENDIF * delta position in the branch can only be reached for C14 * no delta position (maxlng=4) is expected IF (maxlng.GT.3) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE: treebr' WRITE(6,'(a)') 'length of the path greater than expected' STOP ENDIF * end of lntree RETURN END