!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MASTER MECHANISM - ROUTINE NAME isomer * ! * ! PURPOSE : * ! Replace a species by an already existing species in the dictionnary. * ! The isomer must have the same number of carbon and fonctional groups.* ! Other criteria, like number of COCO groups, are used to select the * ! which species (if any) best fit the structure of the species * ! provided as input. * ! * ! INPUT/output : * ! - chem : chemical formula for which an isomer is seek * ! - dbrch : yield linked to a formual. When isomer subsitution * ! occurs, then the yields are added * ! * ! INPUT * ! - dict(j) : dictionary line (name + formula + functional * ! group info) of species number j * ! - stabl : the generation of the species provided as input * ! - brtio : yield of the species * ! - nrec : number of species in the dictionnary * ! * ! OUTPUT: * ! - fgrp : code string corresponding to the various functional * ! group in chem * !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE isomer(chem,dict,nrec,stabl,brtio,dbrch,chg,tabinfo) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'organic.h' INCLUDE 'isomer.h' ! input: CHARACTER(LEN=ldi) dict(mni) INTEGER stabl REAL brtio INTEGER nrec ! input/output: CHARACTER(LEN=lfo) chem REAL dbrch(mni) ! output INTEGER chg ! internal: CHARACTER(LEN=lfl) fgrp INTEGER n, nca, ncd INTEGER nc, lfg INTEGER i,j,ij INTEGER cnum INTEGER nlen, niso, tiso, imax, kc CHARACTER(LEN=lfo) skelet CHARACTER(LEN=lfo) tpchem c CHARACTER(LEN=lfo) dictiso(miso) INTEGER tabinfo(mcri) c INTEGER dictinfo(miso,mcri) INTEGER dictinfo(miso) INTEGER dicflg(miso) INTEGER score(miso) INTEGER side1,side2 REAL ymax ! initialize: chg = 0 lfg = 1 fgrp = ' ' nc = INDEX(chem,' ') - 1 DO i=1,miso dicflg(i)=0 c dictiso(i)=' ' score(i)=0 c DO j=1,mcri dictinfo(i)=0 c ENDDO ENDDO DO j=1,mcri tabinfo(j)=0 ENDDO ! get info about the species provided as input CALL interacgrp(chem,tabinfo,mcri) ! return if generation is lesser than a given number c IF (stabl.LE.1) RETURN ! check for non-radicals (done before calling) c IF(INDEX(chem,'.').NE.0) RETURN ! species having less than 3 carbons are not considered (done before calling) c nca=cnum(chem,nc) c IF (nca.LE.2) RETURN ! get the code string for chem CALL codefg(chem,fgrp,lfg) nlen = INDEX(fgrp,' ') c write(48,*) fgrp ! ignore species bearing a >C=C< bond IF (INDEX(fgrp,'U').ne.0) RETURN ! ignore species having a yield greater than 1% c IF (brtio.ge.0.05) RETURN c IF (brtio.ge.0.01) RETURN c IF (brtio.ge.1E-2) RETURN IF (brtio.ge.5E-3) RETURN c IF (brtio.ge.1) RETURN ! ------------------------------------------------------------------- ! LOOP OVER SPECIES IN THE DICTIONNARY - KEEP A FIRST SET OF SPECIES ! ------------------------------------------------------------------- niso=0 DO 99 i=1, nrec ! ignore species not having the same number of groups IF (tabinfo(1).NE.diccri(i,1)) GOTO 99 ! ignore the species not bearing the same list of groups DO j=1,nlen IF (fgrp(j:j).NE.dict(i)(111+j:111+j)) GOTO 99 ENDDO ! store the molecule that may be used as isomers (if that point is reached) niso=niso+1 IF (niso.gt.miso) THEN write(6,*) '--error--, in subroutine isomer' write(6,*) 'number of isomers exceed the maximum allowed.' write(6,*) 'Change parameter miso in isomer.f.' write(6,*) 'niso=', niso STOP ENDIF dictinfo(niso)=i 99 CONTINUE ! exit if no isomer available IF (niso.eq.0) RETURN ! store the number of entry in the tables for isomers tiso=niso c write(48,'(a)') ' ' c write(48,'(a)') '-----------------------------------' c WRITE(48,'(a6,a40)') 'pchem=',chem c write(48,'(a)') ' ' DO i=1,niso j=dictinfo(i) c WRITE(48,'(a9,a40)') ' ',dict(j)(10:) ENDDO !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Rules number 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! c GOTO 345 ! skip to the lqst rule ! the isomer must match all critia 2-17. c IF (brtio.lt.5E-2) THEN c IF (brtio.lt.1E-2) THEN c IF (brtio.lt.1E-3) THEN IF ((brtio.ge.1E-3).AND.(brtio.lt.5E-3)) THEN c IF (brtio.lt.5E-4) THEN c IF (brtio.lt.1) THEN DO 200 i=1,tiso ij=dictinfo(i) DO j=2,17 ! note : the last criteria are not used here IF (tabinfo(j).ne.diccri(ij,j)) THEN dicflg(i)=1 niso=niso-1 GOTO 200 ENDIF ENDDO c IF (tabinfo(22).ne.diccri(ij,22)) THEN c dicflg(i)=1 c niso=niso-1 c GOTO 200 c ENDIF c IF (tabinfo(23).ne.diccri(ij,23)) THEN c dicflg(i)=1 c niso=niso-1 c GOTO 200 c ENDIF c IF (tabinfo(24).ne.diccri(ij,24)) THEN c dicflg(i)=1 c niso=niso-1 c GOTO 200 c ENDIF 200 CONTINUE IF (niso.eq.0) THEN RETURN ELSE IF (niso.eq.1) THEN GOTO 666 *-8 number of -CO-CHO, -CO-CO(OONO2), -CO-CO(OH), -CO-CO(OOH) (criteria 18-21) *-9 number of CH2, CH, C (criteria 3-5) ELSE IF (niso.gt.1) THEN DO kc=18,21,1 CALL seliso(kc,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list ENDDO DO kc=3,5 CALL seliso(kc,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list ENDDO ENDIF GOTO 666 ! jump to subsitution process ENDIF ! tabinfo(1) : number of group in chem * ! tabinfo(2) : number of CH3 * ! tabinfo(3) : number of CH2 * ! tabinfo(4) : number of CH * ! tabinfo(5) : number of C * ! tabinfo(6) : number of primary node (ending position) * ! tabinfo(7) : number of secondary node * ! tabinfo(8) : number of tertiary node (branching position) * ! tabinfo(9) : number of quaternary node (2 branching ) * ! tabinfo(10): number of -CO-CO- conjugaisons * ! tabinfo(11): number of 1-2 interactions * ! tabinfo(12): number of 1-3 interactions * ! tabinfo(13): number of 1-4 interactions * ! tabinfo(14): number of -CO-CO- at a terminal end the chain * ! tabinfo(15): number of -CH2CH3 * ! tabinfo(16): number of -CH2CH2CH3 * ! tabinfo(17): number of -CH2CH2CH2CH3 * ! tabinfo(18): number of -CO-CHO * ! tabinfo(19): number of -CO-CO(OONO2) * ! tabinfo(20): number of -CO-CO(OH) * ! tabinfo(21): number of -CO-CO(OOH) * !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Rules number 2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! GOTO 345 ! skip to the lqst rule ! the isomer must match critia 1-9. Criteria 10-14-16 are used to discriminate IF ((brtio.ge.5E-4).AND.(brtio.lt.5E-3)) THEN DO 210 i=1,tiso ij=dictinfo(i) DO j=2,9 IF (tabinfo(j).ne.diccri(ij,j)) THEN dicflg(i)=1 niso=niso-1 GOTO 210 ENDIF ENDDO 210 CONTINUE IF (niso.eq.0) THEN ! no molecule match criterion 2-9 RETURN ELSE IF (niso.eq.1) THEN ! one molecule match criterion 2-9 DO i=1,tiso IF (dicflg(i).eq.0) THEN j=dictinfo(i) chem=dict(j)(10:110) dbrch(j)=dbrch(j)+brtio c write(48,'(5x,a7,a50)') 'select=',chem chg = 1 RETURN ENDIF ENDDO ELSE IF (niso.ge.2) THEN ! more than one molecule match 2-9 DO i=1,tiso ij=dictinfo(i) IF (dicflg(i).eq.0) THEN score(i)=1 DO j=14,17 IF (tabinfo(j).ne.0) THEN IF (tabinfo(j).eq.diccri(ij,j)) score(i)=score(i)+3 ENDIF ENDDO IF (tabinfo(10).ne.0) THEN IF (tabinfo(10).eq.diccri(ij,10)) score(i)=score(i)+3 ENDIF c side1=0 c side2=0 c DO j=10,13 c side1=side1+tabinfo(j) c side2=side2+diccri(ij,j) c ENDDO c IF ((side1.ne.0).and.(side1.eq.side2)) score(i)=score(i)+2 DO j=11,13 IF (tabinfo(j).ne.0) THEN IF (tabinfo(j).eq.diccri(ij,j)) score(i)=score(i)+1 ENDIF ENDDO ENDIF ENDDO imax=0 DO i=1,tiso IF (score(i).gt.imax) imax=score(i) ENDDO DO i=1,tiso IF (score(i).eq.imax) THEN j=dictinfo(i) chem=dict(j)(10:110) dbrch(j)=dbrch(j)+brtio c write(48,'(5x,a7,a50)') 'select=',chem chg = 1 RETURN ENDIF ENDDO ENDIF RETURN ENDIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Rules numbers 3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! GOTO 345 ! the isomer must match critia 2-7. Criteria 8-16 are used to discriminate IF ((brtio.ge.5E-5).AND.(brtio.lt.5E-4)) THEN DO 220 i=1,tiso ij=dictinfo(i) DO j=2,7 IF (tabinfo(j).ne.diccri(ij,j)) THEN dicflg(i)=1 niso=niso-1 GOTO 220 ENDIF ENDDO 220 CONTINUE IF (niso.eq.0) THEN ! no molecule match criterion 2-7 RETURN ELSE IF (niso.eq.1) THEN ! one molecule match criterion 2-7 DO i=1,tiso IF (dicflg(i).eq.0) THEN j=dictinfo(i) chem=dict(j)(10:110) dbrch(j)=dbrch(j)+brtio c write(48,'(5x,a7,a50)') 'select=',chem chg = 1 RETURN ENDIF ENDDO ELSE IF (niso.ge.2) THEN ! more than one molecule match 2-7 DO i=1,tiso ij=dictinfo(i) IF (dicflg(i).eq.0) THEN score(i)=1 DO j=8,13 IF (tabinfo(j).ne.0) THEN IF (tabinfo(j).eq.diccri(ij,j)) score(i)=score(i)+3 ENDIF ENDDO side1=0 side2=0 DO j=10,13 side1=side1+tabinfo(j) side2=side2+diccri(ij,j) ENDDO IF ((side1.ne.0).and.(side1.eq.side2)) score(i)=score(i)+2 DO j=14,16 IF (tabinfo(j).ne.0) THEN IF (tabinfo(j).eq.diccri(ij,j)) score(i)=score(i)+1 ENDIF ENDDO ENDIF ENDDO imax=0 DO i=1,tiso IF (score(i).gt.imax) imax=score(i) ENDDO DO i=1,tiso IF (score(i).eq.imax) THEN j=dictinfo(i) chem=dict(j)(10:110) dbrch(j)=dbrch(j)+brtio c write(48,'(5x,a7,a50)') 'select=',chem chg = 1 RETURN ENDIF ENDDO ENDIF RETURN ENDIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Rules number 4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 345 CONTINUE ! the isomer must match critia 1 only. Criteria 2-16 are used to discriminate IF (brtio.lt.1E-3) THEN ! open rules number 4 ! ---------------------------------------------------------------- ! Roll out the check list of criteria to select the 'best' isomere ! ---------------------------------------------------------------- IF (niso.ge.2) THEN ! more than one molecule match criterion 1 *-1 check that the carbon skeletons are similar (criteria 6-9) DO kc=6,9 CALL seliso(kc,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list ENDDO c write(48,'(a11,i3)') '1 , niso=',niso *-2 check the number of -CO-CO- conjugaisons (criteria 10) CALL seliso(10,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list c write(48,'(a11,i3)') '2 , niso=',niso *-3 check the number of 1-2 interactions (criteria 11) CALL seliso(11,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list c write(48,'(a11,i3)') '3 , niso=',niso *-4 substitution at terminal end (i.e. check CH3, criteria 2) CALL seliso(2,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list c write(48,'(a11,i3)') '4 , niso=',niso *-5 alkyl chain (criteria 17-15) DO kc=17,15,-1 CALL seliso(kc,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list ENDDO c write(48,'(a11,i3)') '5 , niso=',niso *-6 number of -CO-CO- at a terminal end the chain (criteria 14) CALL seliso(14,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list c write(48,'(a11,i3)') '6 , niso=',niso *-7 number of 1-4 interactions (first) and 1-3 (then) (criteria 13-12) DO kc=13,12,-1 CALL seliso(kc,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list ENDDO c write(48,'(a11,i3)') '7 , niso=',niso *-8 number of -CO-CHO, -CO-CO(OONO2), -CO-CO(OH), -CO-CO(OOH) (criteria 18-21) DO kc=18,21,1 CALL seliso(kc,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list ENDDO c write(48,'(a11,i3)') '8 , niso=',niso *-9 number of CH2, CH, C (criteria 3-5) DO kc=3,5 CALL seliso(kc,tiso,dictinfo,tabinfo,dicflg,niso) IF (niso.eq.1) GOTO 666 ! exit the check list ENDDO c write(48,'(a11,i3)') '9 , niso=',niso ENDIF ENDIF ! close rules number 4 ! ----------------------------- ! Pick the isomers that remain ! ----------------------------- 666 CONTINUE ! Only one molecule remain IF (niso.eq.1) THEN DO i=1,tiso IF (dicflg(i).eq.0) THEN j=dictinfo(i) chem=dict(j)(10:110) dbrch(j)=dbrch(j)+brtio c write(48,'(5x,a7,a50)') 'select=',chem chg = 1 RETURN ENDIF ENDDO ! more the one molecule remain - pick the one with highest yield ELSE IF (niso.gt.1) THEN imax=0 ymax=0. DO i=1,tiso IF (dicflg(i).eq.0) THEN j=dictinfo(i) IF (dbrch(j).gt.ymax) THEN ymax=dbrch(j) imax=j ENDIF ENDIF ENDDO chem=dict(imax)(10:110) dbrch(imax)=dbrch(imax)+brtio c write(48,'(5x,a7,a50)') 'select=',chem chg = 1 RETURN ENDIF ! end of the subr END