************************************************************************ * MASTER MECHANISM - ROUTINE NAME : mkcopy * * * * * * PURPOSE: make a copy of a molecule according to the longest tree. * * On each call of mkcopy, the group ig is written in "copy". * * At the same time and according to the bond-matrix, all * * groups having a bond to ig (except the bond of * * longest tree), are attached to it (using parentheses). * * * * Ramifications are written according some priority rules. A max of 2 * * ramifications is expected and the formula must have the form : * * longest_tree-Cig(branch1)(branch2)-longest_tree * * Since the branches may also contain ramification and functionalities,* * each branch must be written in a unique way. This is done by * * subroutine getbrch. If the carbon ig 'carry' 2 branches, then * * branch1 and branch2 must be evaluated to know which branch has the * * highest priority and must be written first. * * * * The structure of the subroutine is : * * 1 - write the group ig and check if branching exist at * * the ig position * * 2 - if no branching => return * * 3 - if only 1 branching => get and write the branch * * 4 - if 2 branching => get each branches, evaluate the priority of * * each branch and write them. * * It is expected that in most cases, the branch will only be 1C long. * * This case is tested first, since there is only 1 way to write the * * the branch. * * * * * * INPUT: * * - lobond(i,j) : logical carbon-carbon bond matrix * * - group(i) : group at position (carbon) i * * - rank(i) : rank (priority) of group i (low = more important) * * - ig : is next group to be written to the copy * * - pg and ng : previous and next group of ig in the longest tree * * - nca : total number of group in the molecule * * * * INPUT/OUTPUT: * * - ptr1 : pointer in "copy", where to put next group * * - copy : chemical formula under that is curently written * * * ************************************************************************ SUBROUTINE mkcopy(lobond,group,nca,rank,nring,ig,pg,ng,ptr1,copy) IMPLICIT NONE INCLUDE 'general.h' * input LOGICAL lobond(mca,mca) CHARACTER(LEN=lgr) group(mca) INTEGER rank(mca) INTEGER nca,nring,ig,pg,ng * input/output: CHARACTER(LEN=lfo) copy INTEGER ptr1 * internal: INTEGER ptr2,i INTEGER ialpha,ia1,ia2,ib1,ib2 INTEGER ml1,ml2,nsor,maxpri CHARACTER(LEN=lfo) tempbr(mca) CHARACTER(LEN=lfo) brch1,brch2 * ----------------------------------------------------------- * WRITE GROUP IG TO COPY * ----------------------------------------------------------- ptr2 = ptr1 + INDEX(group(ig),' ') - 2 copy(ptr1:ptr2) = group(ig) ptr1 = ptr2 + 1 * ----------------------------------------------------------- * LOOK FOR ALL ATTACHED GROUPS TO GROUP IG, BUT NOT PG OR NG * ----------------------------------------------------------- * search number attached group to IG in "alpha" position ialpha=0 ia1=0 ia2=0 DO i=1,nca IF (lobond(ig,i)) THEN IF ( (i.NE.pg) .AND. (i.NE.ng) ) THEN ialpha=ialpha+1 IF (ialpha.eq.1) ia1=i IF (ialpha.eq.2) ia2=i ENDIF ENDIF ENDDO * ----------------------------------------------------------- * IF NO ALPHA GROUP, THEN RETURN * ----------------------------------------------------------- IF (ialpha.eq.0) THEN !print*,'no alpha ',copy RETURN ENDIF * ----------------------------------------------------------- * ONE ALPHA GROUP * ----------------------------------------------------------- IF (ialpha.eq.1) THEN * check if at least a beta position is occupied ib1=0 DO i=1,nca IF (lobond(ia1,i)) THEN IF (i.ne.ig) THEN ib1=i GOTO 15 ENDIF ENDIF ENDDO 15 CONTINUE * no beta position found : write group alpha and return IF (ib1.eq.0) THEN ptr2=INDEX(group(ia1),' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = group(ia1) ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 !print*,'no beta ',copy RETURN * at least a beta position found ELSE * search the longest tree starting from ia1 with the highest priority * write out CALL getbrch(lobond,group,nca,rank,nring,ig,ia1,ib1,brch1,ml1) ptr2=INDEX(brch1,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch1 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 !print*,'yes beta ',copy RETURN ENDIF ENDIF * ----------------------------------------------------------- * TWO ALPHA GROUP * ----------------------------------------------------------- * 4 various cases need to be considered : * case 1 : the 2 branches are C1 branches * case 2 : branch 1 is a "long" branch, branch 2 is a C1 branch * case 3 : branch 1 is a C1 branch, branch 2 is a "long" branch * case 4 : the 2 branches are "long" branches IF (ialpha.eq.2) THEN * check if at least a beta position is occupied ib1=0 DO i=1,nca IF (lobond(ia1,i)) THEN IF (i.ne.ig) THEN ib1=i GOTO 115 ENDIF ENDIF ENDDO 115 CONTINUE ib2=0 DO i=1,nca IF (lobond(ia2,i)) THEN IF (i.ne.ig) THEN ib2=i GOTO 125 ENDIF ENDIF ENDDO 125 CONTINUE * get the branches starting at ia1 and ia2 IF (ib1.ne.0) THEN CALL getbrch(lobond,group,nca,rank,nring,ig,ia1,ib1,brch1,ml1) ENDIF IF (ib2.ne.0) THEN CALL getbrch(lobond,group,nca,rank,nring,ig,ia2,ib2,brch2,ml2) ENDIF * Case 1 : * -------- * 2 methyl substitued => find the group with the highest priority * and write the group having the lowest priority first, then return IF ((ib1.eq.0).AND.(ib2.eq.0)) THEN IF(rank(ia2).GE.rank(ia1))THEN nsor=ia1 ELSE nsor=ia2 ENDIF IF (nsor.EQ.2) THEN ptr2 = INDEX(group(ia1),' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = group(ia1) ptr1 = ptr2 + 1 copy(ptr1:ptr1) = ')' ptr1 = ptr1 + 1 ptr2 = INDEX(group(ia2),' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = group(ia2) ptr1 = ptr2 + 1 copy(ptr1:ptr1) = ')' ptr1 = ptr1 + 1 ELSE ptr2 = INDEX(group(ia2),' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = group(ia2) ptr1 = ptr2 + 1 copy(ptr1:ptr1) = ')' ptr1 = ptr1 + 1 ptr2 = INDEX(group(ia1),' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = group(ia1) ptr1 = ptr2 + 1 copy(ptr1:ptr1) = ')' ptr1 = ptr1 + 1 ENDIF !print*,'1 ',copy RETURN ENDIF * Case 2 : * -------- * ib2=0 : write first branch2 (methyl group) then branch 1 (long chain) IF ( (ib1.ne.0).and.(ib2.eq.0) ) THEN ptr2 = INDEX(group(ia2),' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = group(ia2) ptr1 = ptr2 + 1 copy(ptr1:ptr1) = ')' ptr1 = ptr1 + 1 ptr2=INDEX(brch1,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch1 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 !print*,'2 ',copy RETURN ENDIF * Case 3 : * -------- * ib1=0 : write first branch1 (methyl group) then branch 2 (long chain) IF ( (ib1.eq.0).and.(ib2.ne.0) ) THEN ptr2 = INDEX(group(ia1),' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = group(ia1) ptr1 = ptr2 + 1 copy(ptr1:ptr1) = ')' ptr1 = ptr1 + 1 ptr2=INDEX(brch2,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch2 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 !print*,'3 ',copy RETURN ENDIF * Case 4 : * -------- * ib1 and ib2 are both not equal to 0. Check the length of the chain (mli) * and write the shortest chain first. If the chains are of the same * length then call brpri to find priority. IF ( (ib1.ne.0).and.(ib2.ne.0) ) THEN IF (ml1.lt.ml2) THEN ptr2=INDEX(brch1,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch1 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 ptr2=INDEX(brch2,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch2 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 !print*,'4a ',copy RETURN ELSE IF (ml2.lt.ml1) THEN ptr2=INDEX(brch2,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch2 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 ptr2=INDEX(brch1,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch1 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 !print*,'4b ',copy RETURN ELSE IF (brch1.eq.brch2) THEN maxpri=1 ELSE tempbr(1)=brch1 tempbr(2)=brch2 DO i=3,mca tempbr(i)=' ' ENDDO CALL brpri(group,rank,tempbr,2,nring,maxpri) ENDIF IF (maxpri.eq.1) THEN ptr2=INDEX(brch1,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch1 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 ptr2=INDEX(brch2,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch2 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 !print*,'4c ',copy RETURN ELSE ptr2=INDEX(brch2,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch2 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 ptr2=INDEX(brch1,' ') - 1 ptr2 = ptr1 + ptr2 copy(ptr1:ptr1) = '(' copy(ptr1+1:ptr2) = brch1 ptr1 = ptr2 + 1 copy(ptr1:ptr1)=')' ptr1=ptr1+1 !print*,'4d ',copy RETURN ENDIF ENDIF ENDIF ENDIF * end of mkcopy END