! THIS FILE CONTAINS 2 SUBROUTINE get_hsig (hammet) and get_tsig (taft) ! --------------------------------------------------------------------- ! ! get_tsig : ! Return the taft sigma value at for the positions given by the ! of the funcctional group given in "tabcde". ! note : the position for which sigma is computed is given ! by tabcde(1,1,1). ! ! ndeep : deepest position for which sigma must be considered ! (ndeep=5 is delta position) ! ! - nabcde(k) : number of distinct pathways that end up at a ! position k relative to top (e.g. nabcde(3) gives ! the number of distinct pathways finishing in a ! beta position relative to top ! - tabcde(k,i,j) : give the pathways (nodes j), for the track number i ! to reach the position k (k=2 is beta position ...). ! For example, tabcde(4,1,j) give the first track to ! reach a gamma position (node given by ! tabcde(4,1,4), using the track given by ! tabcde(4,1,*) ! - mapfun(a,b,c) : provide the number of function of type 'c' ! at position (node) 'a'. index 'b' if for node ! type with 1=aliphatic, 2=cd and 3=aromatic ! for example, the molecule CH2(OH)CdH=CdHCHO ! should have non zero values at the positions : ! mapfun(1,1,1)=1 ! mapfun(4,2,9)=1 ! - funflg(a) : get the number of functional group at ! node a. For the example above, non-zero ! values are found at position 1 and 4, where ! it is set to 1. ! - nodetype : table of character for type node ! 'y' is for carbonyl ! 'r' is for aromatic ! 'o' is for -O- node ! 'd' is for Cd ! 'n' is for the others (i.e. normal) ! ! - sigma : is the taft sigma due to the neighboors relative to the ! position being considered (and given by tabcde(1,1,1). ! ! table of functions - Index of functionalities (in mapfun) ! ----------------------------------------------------------------- ! 1= -OH ; 2= -NO2 ; 3= -ONO2 ; 4= -OOH ; 5= -F ! 6= -Cl ; 7= -Br ; 8= -I ; 9= -CHO ; 10= -CO- ! 11= -COOH ; 12= -CO(OOH) ; 13= -PAN ; 14= -O- ; 15= R-COO-R ! 16 = HCO-O-R; 17= -CO(F) ; 18= -CO(Cl) ; 19= -CO(Br) ; 20= -CO(I) ! 21 = -CO(O-) ! This list is used in alisig which provide sigma for a given group ! ---------------------------------------------------------------------- SUBROUTINE get_tsig(bond,group,ndeep,nabcde,tabcde,mapfun, & funflg,nodetype,sigma) IMPLICIT NONE INCLUDE 'general.h' ! input INTEGER bond(mca,mca) CHARACTER(LEN=lgr) group(mca) INTEGER ndeep INTEGER nabcde(9), tabcde(9,mco,mca) REAL mapfun(mca,3,21) INTEGER funflg(mca) CHARACTER*1 nodetype(mca) ! ouput REAL sigma ! local REAL alisig(21), sigester INTEGER in, k, ncd, locn, l, i1, i2, ifun REAL dist, tsig INTEGER aroflg ! Tafta sigm values for aliphatic compounds ! sigma for ester depend whether ester is connected from the -CO- side ! or the -O- side. Sigma=2.56 for -O- side and 2.00 for CO side !CMV! 16/06/14 ! add sigma taft for CO(O-), n°21 DATA alisig/ 0.62 , 1.47 , 1.38 , 0.62 , 1.10 , & 0.94 , 1.00 , 1.00 , 2.15 , 1.81 , & 2.08 , 2.08 , 2.00 , 1.81 , 2.56 , & 2.90 , 2.44 , 2.37 , 2.37 , 2.37 , & -1.06/ DATA sigester / 2.00/ ! sigma for ester, CO side ! initialize sigma=0. ! scroll the neighboors up to ndeep position DO in=2,ndeep DO k=1,nabcde(in) ncd=0 locn=tabcde(in,k,in) IF (funflg(locn).ne.0) THEN DO l=1,in-1 ! start the loop to see if Cd are in between i1=tabcde(in,k,l) i2=tabcde(in,k,l+1) IF (bond(i1,i2).eq.2) ncd=ncd+1 IF ( (nodetype(i1).eq.'d').AND. & (nodetype(i2).eq.'d') ) THEN ncd=ncd+1 ENDIF ENDDO dist=REAL(in)-REAL(ncd)-2. IF (group(locn)(1:3).EQ.'-O-') THEN ! decrease the distance dist=dist-1. ENDIF aroflg=0 ! check for armotic nodes between groups DO l=2,in IF (nodetype(tabcde(in,k,l)).eq.'r') aroflg=1 ENDDO DO ifun=1,21 ! find the function on node locn (local node) IF (mapfun(locn,1,ifun).ne.0) THEN tsig=mapfun(locn,1,ifun)*alisig(ifun) IF (ifun.eq.15) THEN ! check ester IF (group(locn)(1:2).eq.'CO') tsig=sigester ! CO instead of -O- ENDIF WRITE(98,*) 'tsig=',tsig,'dist=',dist sigma=sigma+(tsig*0.4**(dist)) WRITE(98,*) 'sigma=',sigma ENDIF IF (mapfun(locn,2,ifun).ne.0) THEN ! =CdC(X)CHO must counted tsig=mapfun(locn,2,ifun)*alisig(ifun) IF (ifun.eq.15) THEN ! check ester IF (group(locn)(1:2).eq.'CO') tsig=sigester ! CO instead of -O- ENDIF WRITE(98,*) 'tsig=',tsig,'dist=',dist sigma=sigma+(tsig*0.4**(dist)) WRITE(98,*) 'sigma=',sigma ENDIF IF (mapfun(locn,3,ifun).ne.0) THEN ! Phi-COCHO must counted IF (aroflg.eq.0) THEN tsig=mapfun(locn,3,ifun)*alisig(ifun) IF (ifun.eq.15) THEN ! check ester IF (group(locn)(1:2).eq.'CO') tsig=sigester ! CO instead of -O- ENDIF WRITE(98,*) 'tsig=',tsig,'dist=',dist sigma=sigma+(tsig*0.4**(dist)) WRITE(98,*) 'sigma=',sigma ENDIF ENDIF ENDDO ENDIF ENDDO ENDDO END ! ---------------------------------------------------------------------- ! return the hammet sigmas. see comment above ! Group number are given in the header above. ! arorto, arometa, aropara give the hammet sigma for each group in o,m,p. ! ---------------------------------------------------------------------- SUBROUTINE get_hsig(bond,group,nabcde,tabcde,mapfun, & funflg,nodetype,hsigma) IMPLICIT NONE INCLUDE 'general.h' ! input INTEGER bond(mca,mca) CHARACTER(LEN=lgr) group(mca) INTEGER nabcde(9), tabcde(9,mco,mca) REAL mapfun(mca,3,21) INTEGER funflg(mca) CHARACTER*1 nodetype(mca) ! ouput REAL hsigma ! local REAL arometa(21),aropara(21),arorto(21) INTEGER in, k, ncd, locn,l, ifun, funindex REAL dist, tsig !CMV! 16/06/14 ! add hammet values for -CO(O-) !hammet orto meta para DATA arometa/ 0.13 , 0.74 , 0.55 , 0.00 , 0.34 , & 0.37 , 0.39 , 0.35 , 0.36 , 0.36 , & 0.35 , 0.00 , 0.00 , 0.11 , 0.32 , & 0.00 , 0.55 , 0.53 , 0.53 , 0.53 , & 0.09 / DATA aropara/ -0.38 , 0.78 , 0.70 , 0.00 , 0.06 , & 0.24 , 0.22 , 0.21 , 0.44 , 0.47 , & 0.44 , 0.00 , 0.00 , -0.28 , 0.39 , & 0.00 , 0.70 , 0.69 , 0.69 , 0.69 , & -0.05 / ! benzoic as a reference for substituents in ortho DATA arorto/ 1.22 , 1.99 , 0.00 , 0.00 , 0.93 , & 1.28 , 1.35 , 1.34 , 0.72 , 0.07 , & 0.95 , 0.00 , 0.00 , 0.12 , 0.63 , & 0.00 , 0.00 , 0.00 , 0.00 , 0.00 , & -0.91 / ! initialize hsigma=0. funindex = 0 ! scroll the neighboors up to 7 position (i.e. a carbonyl on para) DO in=2,7 DO 308 k=1,nabcde(in) ! exit if already taken into account by another pathway (it happens at ! every para position) IF (k.ge.2) THEN DO l=1,k-1 IF (tabcde(in,k,in).eq. & tabcde(in,l,in) ) GOTO 308 ENDDO ENDIF locn=tabcde(in,k,in) IF (funflg(locn).ne.0) THEN ! find the function on node locn (local node) DO ifun=1,21 IF ((mapfun(locn,3,ifun)).ne.0 .or. !CMV! 20/06/16 !CMV! look for function on aromatic AND aliphatic carbons & (mapfun(locn,1,ifun).ne.0)) THEN funindex=ifun ENDIF ENDDO !CMV! 20/06/16 !CMV! funindex should not be 0 at this stage IF (funindex == 0) THEN print*,"error, funindex = 0 in get_hsig (getsigmas.f)" STOP ENDIF ! find the distance (ortho, meta, para) on node locn (local node) dist=0 DO l=1,in IF (nodetype(tabcde(in,k,l)).eq.'r') dist=dist+1 ENDDO IF (dist.eq.2) THEN hsigma = hsigma+arorto(funindex) ELSE IF (dist.eq.3) THEN hsigma = hsigma+arometa(funindex) ELSE IF (dist.eq.4) THEN hsigma = hsigma+aropara(funindex) ENDIF IF (tabcde(in,k,2).eq.0) hsigma=0. ! kill second node on ester ENDIF 308 CONTINUE ENDDO ! END