************************************************************************ * PROGRAM compteur * * * * PURPOSE : read the dictionary and sort the peroxy radicals into * * the various classes of RO2 (primary, substitued, ...). * * The program provide as output a file for each class of * * RO2 in which the RO2 that belong to the class are listed. * * * * INPUT (files): * * - fort.7 : dictionary provided by the generator's output * * * * OUTPUT (file): * * - XP1O2 (type1) : linear primary RO2 * - XP2O2 (type2) : branched primary RO2 * - XP3O2 (type3) : alpha or beta O substitued primary RO2 * - XS1O2 (type4) : CH3CH(OO.)CH3 * - XS2O2 (type5) : secondary RO2 (C>3) * - XS3O2 (type6) : alpha or beta O substitued secondary RO2 * - XT1O2 (type7) : Tertiary RO2 * - XT2O2 (type8) : alpha or beta O substitued tertiary RO2 * - XACO3 (type9) : peroxy acyl * * Sorting is done using the class definition set in the generator. It * is done by the subroutine "multispecial" (included in this file), * which is a "piece" of the generator subroutine "multi.f". * * * * * WARNING : * * * ************************************************************************ PROGRAM compteur IMPLICIT NONE INCLUDE 'general.h' INTEGER nspec,i CHARACTER*(lco) name(mni), tname CHARACTER*(lfo) chem(mni), tchem CHARACTER*(150) line2 INTEGER typper,alcox INTEGER npero(10) CHARACTER*(lgr) fgrp INTEGER max, ntot OPEN(20,FILE='fort.7',STATUS='OLD') * initialize * ---------- DO i=1,mni name(i)=' ' chem(i)=' ' ENDDO DO i=1,10 npero(i)=0 ENDDO nspec=0 alcox = 0 ntot=0 max=0 * read dictionary * ---------------- 10 READ (20,'(A150)',END=50) line2 ntot=ntot+1 IF (index(line2,'***').ne.0) GOTO 50 READ(line2,'(a6,3x,a120,a12)') tname,tchem,fgrp IF (index(fgrp, '1.') .ne. 0) alcox=alcox+1 IF (index(fgrp, '2.').eq.0 .and. index(fgrp, '3.').eq.0) GOTO 10 nspec= nspec + 1 name(nspec) = tname chem(nspec) = tchem GOTO 10 50 CONTINUE CLOSE(20) WRITE(6,*) 'total # of species:', ntot WRITE(6,*) '# of peroxys:', nspec WRITE(6,*) '# of alcoxys:',alcox * open output files * ----------------- OPEN(1,file='XP1O2') OPEN(12,file='XP2O2') OPEN(3,file='XP3O2') OPEN(4,file='XS1O2') OPEN(5,file='XS2O2') OPEN(10,file='XS3O2') OPEN(7,file='XT1O2') OPEN(8,file='XT2O2') OPEN(9,file='XACO3') * sort each peroxy * ----------------- DO i =1,nspec typper=0 ! print*,'chem=',i,' ',chem(i)(1:50) ! (new lines) ! IF (chem(i)(1:3) .EQ. '#mm' ) THEN tchem=' ' tchem(1:)=chem(i)(4:) * ignore species with names beginning with C ELSE IF (chem(i)(1:5).EQ.'#CISO' ) THEN CYCLE ELSE IF (chem(i)(1:5).EQ.'#CMYR' ) THEN CYCLE ELSE IF (chem(i)(1:1).EQ.'#' ) THEN tchem=' ' tchem(1:)=chem(i)(2:) * convert X or Y at start of name to C ELSE IF (chem(i)(1:1).EQ.'X' ) THEN tchem=' ' tchem(1:1)='C' ELSE IF (chem(i)(1:1).EQ.'Y' ) THEN tchem=' ' tchem(1:1)='C' ELSE tchem=' ' tchem=chem(i) ENDIF * ignore species with names NOT beginning with C IF (tchem(1:1).NE.'C'.AND.tchem(1:1).NE.'c' & .AND.tchem(1:2).NE.'-O' ) CYCLE !(end new lines)! ! (change argument chem to tchem)! IF (tchem == "XH3(OO.)") THEN typper = 0 ELSE CALL multispecial(tchem,typper) ENDIF * XP102 IF (typper.EQ.1) THEN WRITE (1,'(a1,a6)')'G',name(i) npero(1)=npero(1)+1 * XP202 ELSE IF (typper.EQ.2) THEN WRITE (12,'(a1,a6)')'G',name(i) npero(2)=npero(2)+1 * XP3O2 ELSE IF (typper.EQ.3) THEN WRITE (3,'(a1,a6)')'G',name(i) npero(3)=npero(3)+1 * XS102 ELSE IF (typper.EQ.4) THEN WRITE (4,'(a1,a6)')'G',name(i) npero(4)=npero(4)+1 * XS2O2 ELSE IF (typper.EQ.5) THEN WRITE (5,'(a1,a6)')'G',name(i) npero(5)=npero(5)+1 * XS3O2 ELSE IF (typper.EQ.6) THEN WRITE (10,'(a1,a6)')'G',name(i) npero(6)=npero(6)+1 * XT1O2 ELSE IF (typper.EQ.7) THEN WRITE (7,'(a1,a6)')'G',name(i) npero(7)=npero(7)+1 * XT2O2 ELSE IF (typper.EQ.8) THEN WRITE (8,'(a1,a6)')'G',name(i) npero(8)=npero(8)+1 * XACO3 ELSE IF (typper.EQ.9) THEN WRITE (9,'(a1,a6)')'G',name(i) npero(9)=npero(9)+1 ENDIF WRITE(33,'(a6,1x,i2,1x,a120)') name(i),typper,chem(i) ENDDO * add special species, if necessary (i.e. peroxy for which the * short name does not start with the character 2) c write(10,'(a)')'GRO2R' c write(10,'(a)')'GRO2N' c write(10,'(a)')'GR2O2' c write(9,'(a)') 'GBZCOO2' * close all files * --------------- WRITE (1,'(a5)') '*****' WRITE (12,'(a5)') '*****' WRITE (3,'(a5)') '*****' WRITE (4,'(a5)') '*****' WRITE (5,'(a5)') '*****' WRITE (10,'(a5)') '*****' WRITE (7,'(a5)') '*****' WRITE (8,'(a5)') '*****' WRITE (9,'(a5)') '*****' CLOSE (1) CLOSE (12) CLOSE (3) CLOSE (4) CLOSE (5) CLOSE (10) CLOSE (7) CLOSE (8) CLOSE (9) * give the maximum number of RO2 in a class (required to optimize * the size of the solver) max=0 DO i=1,10 WRITE(6,'(a17,i2,a3,i6)') 'nb pero in class ',i,' = ',npero(i) IF (max.lt.npero(i)) max=npero(i) ENDDO WRITE(6,*) 'maximum =', max END *************************************************************************** * SUBROUTINE MULTISPECIAL * * (this subroutine must be consistent with the generator. The code * * in this subroutine is a fraction of the generator's subroutine * * multi.f). For a given pero provided as input (tchem), the * * subroutine return an integer (typper) corresponding to the class * * of the peroxy. Lumping of RO2 classes may be allowed (see end of * * the subroutine) * *************************************************************************** SUBROUTINE multispecial(tchem,typper) IMPLICIT NONE INCLUDE 'general.h' * input CHARACTER*(lfo) tchem * output INTEGER typper * internal variables: INTEGER cnum,onum,nc,nca,np,j1,j2 INTEGER icl,ibr,ipo,itype INTEGER i,j CHARACTER*(lgr) tgroup(mca) INTEGER tbond(mca,mca) INTEGER dbflg,nring !! DEBUG !! ! WRITE(6,*)'*multispecial* : input : ',tchem !! END DEBUG !! * initialize: np = 0 j1=0 j2=0 * re-entry point and condition nc = INDEX(tchem,' ') - 1 nca = cnum(tchem,nc)+onum(tchem,nc) IF (nca.EQ.1) GOTO 900 CALL grbond(tchem,nc,tgroup,tbond,dbflg,nring) * find group which contain '.' DO i=1,mca IF (INDEX(tgroup(i),'.').NE.0) j1 = i ENDDO IF(j1.EQ.0) GO TO 900 * ---------------------------------------- * identify type of RO2: * ---------------------------------------- * itype 1 : linear primary RO2 * itype 2 : branched primary RO2 * itype 3 : alpha or beta O substitued primary RO2 * itype 4 : CH3CH(OO.)CH3 * itype 5 : secondary RO2 (C>3) * itype 6 : alpha or beta O substitued secondary RO2 * itype 7 : Tertiary RO2 * itype 8 : alpha or beta O substitued tertiary RO2 * itype 9 : peroxy acyl * count for RO2 class (primary, secondary, ...), branched * structure in beta, polar subtitution in alpha or beta icl=0 ibr=0 ipo=0 DO i=1, mca IF (tbond(j1,i).ne.0) THEN icl=icl+1 DO j=1, mca IF ( (tbond(i,j).ne.0).AND.(j.ne.j1) ) ibr=ibr+1 ENDDO IF (INDEX(tgroup(i),'O').NE.0) ipo=1 IF (INDEX(tgroup(i),'N').NE.0) ipo=1 ENDIF ENDDO * assign the type. Note that substitution at the carbon bearing * the peroxy group is not tested above. This is done below if * the number of H is not the number expected. itype=0 IF (icl.EQ.1) THEN itype=1 IF (INDEX(tgroup(j1),'CH2').EQ.0) itype=3 IF (ibr.gt.1) itype=2 IF (ipo.ne.0) itype=3 ELSE IF (icl.EQ.2) THEN itype = 4 IF (INDEX(tgroup(j1),'CH').EQ.0) itype=6 IF (nca.gt.3) itype=5 IF (ipo.ne.0) itype=6 ELSE IF (icl.EQ.3) THEN itype = 7 IF (ipo.ne.0) itype=8 ENDIF * overwrite if acyl_peroxy radical IF (INDEX(tgroup(j1),'CO(OO.)').NE.0) THEN itype=9 ENDIF * check that a type was applied to the RO2 !! DEBUG !! ! WRITE(6,*)'output from multispecial: itype:',itype !! END DEBUG !! IF (itype.eq.0) THEN WRITE(6,'(a)') '--warning, (stop) in multispecial' WRITE(6,'(a)') 'the following species has no type' WRITE(6,'(a)') '(e.g. primary, secondary, ...)' WRITE(6,'(a)') tchem STOP ENDIF * ------------------------------ * REDUCE number of PEROXY TYPES * ------------------------------ * To use less than 9 types of peroxy, replace some type by other * reactivity type * We keep 4 types of peroxy : * - primary with the reactivity of branched primary * - secondary and substituted tertiary with reactivity of * linear secondary * - linear tertiary * - acyl peroxys * IF (itype.EQ.1) itype = 2 * IF (itype.EQ.3) itype = 2 * IF (itype.EQ.4) itype = 7 * IF (itype.EQ.6) itype = 5 * IF (itype.EQ.8) itype = 7 * CHANGER LES GRO2R(6),GRO2N(6),GBCOO2(9) de type ds compteur.f typper = itype 900 CONTINUE RETURN END