************************************************************************ * MASTER MECHANISM - ROUTINE NAME codefg * * * * PURPOSE : * * For a species in input , this subroutine gives the code 'frgp' * * corresponding to the the functionnal groups borne by the molecule * * * * INPUT: * * - chem : formula of the species for which the code * * must be given * * * * OUTPUT: * * - fgrp : code string corresponding to the various functional * * group in chem * ************************************************************************ SUBROUTINE codefg(chem,fgrp,lfg) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'organic.h' * input: CHARACTER(LEN=lfo) chem * output CHARACTER(LEN=lfl) fgrp * internal: INTEGER nc, lfg, il INTEGER ic, ih, in, io, ir, is, ibr, ifl, icl INTEGER i, j, k, l INTEGER np, na, ng, nf, m INTEGER rjs(mri,2), nring LOGICAL lohc CHARACTER*9 hcstring CHARACTER(LEN=lfo) tchem DATA hcstring /'CH1234().'/ * ----------- * initialize * ----------- tchem = chem ! chem could be modified due to removal of rings lfg = 1 fgrp = ' ' nc = INDEX(tchem,' ') - 1 * count number of atoms and radical dots CALL number(tchem,nc,ic,ih,in,io,ir,is,ifl,ibr,icl) * ---------------------------------------- * GET THE RADICAL FUNCTIONAL GROUP IN CHEM * ---------------------------------------- * check for radical dot, if not then jump IF (INDEX(tchem,'.') .EQ. 0) GO TO 100 * radical check: Assume one radical group per chemical - no more, * so check for illegal (non-Criegee) di-radicals: IF ((ir.GT.1) .AND. (INDEX(tchem,criegee).EQ.0)) THEN WRITE(6,'(a)') '--error-- in "codefg". Illegal di-radical in :' WRITE(6,'(a)') chem WRITE(99,*) 'codefg',chem STOP ENDIF * assume alkyl, then overwrite if needed. Note order of * IF - ELSEIF-ENDIF statements,to avoid confusing e.g., * peroxy (OO.) with criegee .(OO.) or acylperoxy CO(OO.): fgrp(1:1) = '0' IF (INDEX(tchem,criegee).NE.0) THEN fgrp(1:1) = '4' ELSE IF (INDEX(tchem,acyl_peroxy).NE.0) THEN fgrp(1:1) = '3' ELSE IF(INDEX(tchem,alkyl_peroxy).NE.0) THEN fgrp(1:1) = '2' ELSE IF (INDEX(tchem,alkoxy).NE.0) THEN fgrp(1:1) = '1' ENDIF * add point to fgrp and update the poiter lfg fgrp(2:2) = '.' lfg = 3 100 CONTINUE * ---------------------------------------------- * GET THE (NO RADICAL) FUNCTIONAL GROUP IN CHEM * ---------------------------------------------- * add flag for rings nring=0 IF ((index(tchem,'12').ne.0).OR. & (index(tchem,'C2').ne.0).OR. & (index(tchem,'-O2').ne.0)) THEN fgrp(lfg:lfg+1) = 'TT' lfg = lfg + 2 nring=2 ELSE IF ((index(tchem,'C1').ne.0).OR. & (index(tchem,'-O1').ne.0)) THEN fgrp(lfg:lfg) = 'T' lfg = lfg + 1 nring=1 ENDIF IF (index(tchem,'c2').ne.0) THEN fgrp(lfg:lfg+1) = 'RR' lfg = lfg + 2 nring=2 ELSE IF (index(tchem,'c1').ne.0) THEN fgrp(lfg:lfg) = 'R' lfg = lfg + 1 nring=1 ENDIF * remove ring joining character to search functional groups IF (nring.GT.0) THEN CALL rjsrm(nring,tchem,rjs) ENDIF * add flag for aromatics ! IF (index(tchem,aromatic).ne.0) THEN ! fgrp(lfg:lfg) = 'R' ! lfg = lfg + 1 ! ENDIF * here it is possible to have more than one occurrence of the group: * for these functional groups,e.g.fluorine, multiple occurrences * are counted once: * fluorine: IF (ifl.GT.0) THEN fgrp(lfg:lfg) = 'F' lfg = lfg + 1 ENDIF * bromine: IF (ibr.GT.0) THEN fgrp(lfg:lfg) = 'B' lfg = lfg + 1 ENDIF * chlorine: IF (icl.GT.0) THEN fgrp(lfg:lfg) = 'L' lfg = lfg + 1 ENDIF * sulfur: c IF (is.GT.0) THEN c fgrp(lfg:lfg) = 'S' c lfg = lfg + 1 c ENDIF * amine: c i = INDEX(tchem,amine) c IF(i.GT.0) THEN c fgrp(lfg:lfg) = 'M' c lfg = lfg + 1 c ENDIF * ketenes: i = INDEX(tchem,ketene) IF(i.GT.0) THEN fgrp(lfg:lfg) = 'X' lfg = lfg + 1 ENDIF * for following functional groups, e.g. (OH) and CHO, multiple * occurrences are counted separately, so loop is needed to * find all: * peroxy-acyl-nitrates [CO(OONO2)] np=0 DO i=1,nc-8 IF(tchem(i:i+8).EQ.pan) THEN fgrp(lfg:lfg) = 'P' lfg = lfg + 1 np=np+1 ENDIF ENDDO * carboxylic acids [CO(OH)] na=0 DO i=1,nc-5 IF(tchem(i:i+5).EQ.carboxylic_acid) THEN fgrp(lfg:lfg) = 'A' lfg = lfg + 1 na=na+1 ENDIF ENDDO * peroxy-acids [CO(OOH)] ng=0 DO i=1,nc-6 IF(tchem(I:I+6) .EQ. peroxy_acid) THEN fgrp(lfg:lfg) = 'G' lfg = lfg + 1 ng=ng+1 ENDIF ENDDO * hydroperoxides [(OOH)] DO i=1,nc-4 IF( (tchem(i:i+4).EQ.hydro_peroxide) .AND. & (tchem(i-2:i-1).NE.'CO') ) THEN fgrp(lfg:lfg) = 'H' lfg = lfg + 1 ENDIF ENDDO ! JMLT toggle to following statement to use/skip standard sectoin !GO TO 40 * nitrates [(ONO2)] AND peroxy nitrates [(OONO2)] DO i=1,nc-5 IF ((tchem(i:i+5).EQ.nitrate) .OR. ((tchem(i:i+6).EQ.'(OONO2)') & .AND. (tchem(i-2:i-1).NE.'CO') ) ) THEN fgrp(lfg:lfg) = 'N' lfg = lfg + 1 ENDIF ENDDO ! JMLT GO TO 50 ! skip test section 40 CONTINUE ! IF GO TO 40 statment is active: use test section * TEST nitrates [(ONO2)] BUT NOT peroxy nitrates [(OONO2)] DO i=1,nc-5 IF ((tchem(i:i+5).EQ.nitrate) !.OR. ((tchem(i:i+6).EQ.'(OONO2)') & .AND. (tchem(i-2:i-1).NE.'CO') ) THEN fgrp(lfg:lfg) = 'N' lfg = lfg + 1 ENDIF ENDDO * TEST peroxy nitrates [(OONO2)] DO i=1,nc-5 IF ( (tchem(i:i+6).EQ.'(OONO2)') & .AND. (tchem(i-2:i-1).NE.'CO') ) THEN fgrp(lfg:lfg) = 'Y' lfg = lfg + 1 ENDIF ENDDO 50 CONTINUE * unsaturated DO i=1,nc IF(tchem(i:i).EQ.'=') THEN fgrp(lfg:lfg) = 'U' lfg = lfg + 1 ENDIF ENDDO * aldehydes [CHO] DO i=1,nc-2 IF(tchem(i:i+2).EQ.aldehyde) THEN fgrp(lfg:lfg) = 'D' lfg = lfg + 1 ENDIF ENDDO * nitro compounds [(NO2)] DO I=1,nc-4 IF(tchem(i:i+4).EQ.nitro) THEN fgrp(lfg:lfg) = 'V' lfg = lfg + 1 ENDIF ENDDO * nitroso c DO i=1,nc-2 c IF( (tchem(i:i+2).EQ.nitroso(1)) .OR. c & (tchem(i:i+2).EQ.nitroso(2)) ) THEN c fgrp(lfg:lfg) = 'W' c lfg = lfg + 1 c ENDIF c ENDDO * ketones (including: RCO(ONO2), RCOBr,...). Remove contribution * from pan, acid and peracid compounds nf=0 DO i=1,nc-2 IF(tchem(i:i+1) .EQ. carbonyl) THEN nf=nf+1 ENDIF ENDDO nf = nf - np - na - ng IF (nf.gt.0) THEN DO i=1,nf fgrp(lfg:lfg) = 'K' lfg = lfg + 1 ENDDO ENDIF * hydroxy groups [(OH)] (rm carboxylic acids) DO i=1,nc-3 ! IF( (tchem(i+3:i+6).EQ.hydroxy) .AND. ! & (tchem(i+1:i+6).NE.carboxylic_acid) ) THEN IF( (tchem(i+1:i+4).EQ.hydroxy) .AND. & (tchem(i:i+4).NE.'O(OH)') ) THEN fgrp(lfg:lfg) = 'O' lfg = lfg + 1 ENDIF ENDDO * ether groups [-O-] DO i=1,nc-3 IF(tchem(i:i+2).EQ.ether) THEN fgrp(lfg:lfg) = 'E' lfg = lfg + 1 ENDIF ENDDO * --------------------------------------------------- * IF NO FUNCTIONAL GROUP THEN CHECK FOR HYDROCARBONS * --------------------------------------------------- * only possible characters are CH1234 - if any other * then test failed: lohc = .true. DO i=1,nc IF (INDEX(hcstring,tchem(i:i)).EQ.0) lohc = .false. ENDDO * if 'C' was not the only FRGP entry, then there is an error: IF (lohc) THEN IF (lfg .NE. 1) THEN WRITE(6,'(a)') '--error--(2)' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : naming' WRITE(6,'(a)') 'illegal di-radical or hydrocarbon:' WRITE(6,'(a)') chem,' ',fgrp(1:6) WRITE(99,*) 'codefg',chem !STOP ENDIF fgrp(1:1) = 'C' ENDIF RETURN END