*********************************************************************** * PURPOSE: - Find the number of each possible group in the * * species CHEM,e.g. CH3, CH2, C, OH.... * * group increments for the Joback method for Tb estimation * * * * ------------------- * * * * Joback group contribution for boiling point (Tb) are given in * * Reid et al., 1986, except for -ONO2 and -COOONO2 * * (see Camredon & Aumont, 2005). Joback groups are picked with the * * following index in JdeltaTb (table of DeltaTb) and Jobgroup (number * * of Joback group in chem): * * * * 1: CH3 2: CH2-chain 3: CH-chain * * 4: C-chain 5: CdH2 6: CdH-chain * * 7: Cd-chain (=Cd<) 8: F 9: Cl * * 10: Br 11: (OH) 12: -O- chain * * 13: -CO- chain 14: CHO 15: CO(OH) * * 16: CO-O- 17: S 18: ONO2 * * 19: COOONO2 20: CH2- ring 21: CH-ring * * 22: C- ring 23: CdH- ring 24: Cd-ring * * 25: -O- ring 26: CO- ring 27: phenolic OH * * 28: NO2 29: OOH (-O-+OH) * ********************************************************************** SUBROUTINE jobakgr(group,bond,nring,JobGroup) IMPLICIT NONE INCLUDE 'general.h' * input: CHARACTER(LEN=lgr) group(mca) INTEGER bond(mca,mca),nring * output: INTEGER Jobgroup(29) * internal: INTEGER i, j, k INTEGER begrg,endrg INTEGER ring(mca) ! rg index for nodes, current ring (0=no, 1=yes) INTEGER indexrg(mca) ! rg index for nodes, any ring (0=no, 1=yes) INTEGER rngflg ! 0 = 'no ring', 1 = 'yes ring' INTEGER rjg(mri,2) ! ring-join group pairs INTEGER nca ! number of nodes INTEGER nc, ibeg, eflg INTEGER tbond(mca,mca) *---------------------------------------- * sum of contributions for each group *---------------------------------------- * initialize DO i=1,29 Jobgroup(i)=0 ENDDO DO i=1,mca indexrg(i)=0 DO j=1, mca tbond(i,j)=bond(i,j) ENDDO ENDDO * STOP if the number of rings is greater than 2! (need additional checks) IF (nring.gt.2) THEN WRITE(6,*) '--error--, in jobakgr.f; nring > 2' WRITE(6,*) ' (More than 2 rings present)' STOP ENDIF * count the number of nodes nca=0 DO i=1,mca IF (group(i)(1:1).NE.' ') nca=nca+1 ENDDO * IF RINGS EXIST, THEN FIND THE NODES THAT BELONG TO THE RINGS * -------------------------------------------------------------- IF (nring.gt.0) THEN * remove ring-join characters from groups and find the nodes that close rings CALL rjgrm(nring,group,rjg) * find the nodes that belong to a ring DO i=1,nring begrg=rjg(i,1) endrg=rjg(i,2) CALL findring(begrg,endrg,nca,bond,rngflg,ring) DO j=1,mca IF (ring(j).eq.1) indexrg(j)=1 ENDDO ENDDO ENDIF * LOOP OVER THE GROUPS AND FIND JOBACK'S GROUPS * ---------------------------------------------- * Corresponding index for the joback group * 1: CH3 2: CH2-chain 3: CH-chain * * 4: C-chain 5: CdH2 6: CdH-chain * 7: Cd-chain (=Cd<) 8: F 9: Cl *10: Br 11: (OH) 12: -O- chain *13: -CO- chain 14: CHO 15: CO(OH) *16: CO-O- 17: S 18: ONO2 *19: COOONO2 20: CH2- ring 21: CH-ring *22: C- ring 23: CdH- ring 24: Cd-ring *25: -O- ring 26: CO- ring 27: phenolic OH *28: NO2 29: OOH (=OH+-O-) DO 20 i=1,nca * oxygen increments -CH=O,-COOH,CO(OONO2),-O-,>C=O IF (group(i)(1:4).EQ.'CHO ') THEN Jobgroup(14)=Jobgroup(14)+1 GOTO 20 ! jump to next node ELSE IF (group(i)(1:7).EQ.'CO(OH) ') THEN Jobgroup(15)=Jobgroup(15)+1 GOTO 20 ! jump to next node ELSE IF (group(i)(1:10).EQ.'CO(OONO2) ') THEN Jobgroup(19)=Jobgroup(19)+1 GOTO 20 ! jump to next node ELSE IF (group(i)(1:4).EQ.'-O- ') THEN IF (indexrg(i).EQ.0) THEN eflg=0 DO j=1,nca IF (tbond(i,j).eq.3) THEN IF (group(j)(1:3).eq.'CO ') THEN eflg=eflg+1 DO k=1,mca ! loop to avoid double count for -O-CO-O- IF (tbond(j,k).eq.3) THEN tbond(j,k)=0 tbond(k,j)=0 ENDIF ENDDO ENDIF ENDIF ENDDO IF (eflg.ge.1) THEN Jobgroup(16)=Jobgroup(16)+1 Jobgroup(13)=Jobgroup(13)-1 ELSE Jobgroup(12)=Jobgroup(12)+1 ENDIF ELSE Jobgroup(25)=Jobgroup(25)+1 ENDIF GOTO 20 ! jump to next node ELSE IF (group(i)(1:2).EQ.'CO') THEN IF (indexrg(i).EQ.0) THEN Jobgroup(13)=Jobgroup(13)+1 ELSE Jobgroup(26)=Jobgroup(26)+1 ENDIF IF (group(i)(1:3).EQ.'CO ') GOTO 20 ! end of molecule * alkane-alkene-aromatic -CH3,-CH2-,=CH2-,-CH<,=CH-,>C<,=C< ELSE IF (group(i)(1:4).EQ.'CH3 ') THEN Jobgroup(1)=Jobgroup(1)+1 GOTO 20 ! jump to next node ELSE IF (group(i)(1:3).EQ.'CH2') THEN IF (indexrg(i).EQ.0) THEN Jobgroup(2)=Jobgroup(2)+1 ELSE Jobgroup(20)=Jobgroup(20)+1 ENDIF IF (group(i)(1:4).EQ.'CH2 ') GOTO 20 ! end of molecule ELSE IF (group(i)(1:5).EQ.'CdH2 ') THEN Jobgroup(5)=Jobgroup(5)+1 GOTO 20 ! jump to next node ELSE IF (group(i)(1:2).EQ.'CH') THEN IF (indexrg(i).EQ.0) THEN Jobgroup(3)=Jobgroup(3)+1 ELSE Jobgroup(21)=Jobgroup(21)+1 ENDIF IF (group(i)(1:3).EQ.'CH ') GOTO 20 ! end of molecule ELSE IF (group(i)(1:3).EQ.'CdH') THEN IF (indexrg(i).EQ.0) THEN Jobgroup(6)=Jobgroup(6)+1 ELSE Jobgroup(23)=Jobgroup(23)+1 ENDIF IF (group(i)(1:4).EQ.'CdH ') GOTO 20 ! end of molecule ELSE IF (group(i)(1:3).EQ.'Cd ') THEN IF (indexrg(i).EQ.0) THEN Jobgroup(7)=Jobgroup(7)+1 ELSE Jobgroup(24)=Jobgroup(24)+1 ENDIF ELSE IF (group(i)(1:1).EQ.'C') THEN IF (indexrg(i).EQ.0) THEN Jobgroup(4)=Jobgroup(4)+1 ELSE Jobgroup(22)=Jobgroup(22)+1 ENDIF IF (group(i)(1:2).EQ.'C ') GOTO 20 ! end of molecule * aromatics ELSE IF (group(i)(1:2).EQ.'cH') THEN Jobgroup(23)=Jobgroup(23)+1 IF (group(i)(1:3).EQ.'cH ') GOTO 20 ! end of moelcule ELSE IF (group(i)(1:1).EQ.'c') THEN Jobgroup(24)=Jobgroup(24)+1 IF (group(i)(1:5).EQ.'c(OH)') THEN Jobgroup(27)=Jobgroup(27)+1 GOTO 20 ENDIF ENDIF * SEARCH FOR FUNCTIONALTIES IN () nc=INDEX(group(i),' ') * alcohol increments (OH) but not carboxylic acid. Distinguish * between primary and secondary alcohol for Stein and Brown correction ibeg=INDEX(group(i),'(OH)') IF (ibeg.ne.0) THEN DO j=ibeg,nc-3 IF ((group(i)(j:j+3).EQ.'(OH)').AND. & (group(i)(1:6).NE.'CO(OH)') ) THEN Jobgroup(11)=Jobgroup(11)+1 c IF (group(i)(1:3).EQ.'CH2') THEN c vOH_1=vOH_1+1 c ELSE IF ((group(i)(1:2).EQ.'CH').OR. c & (group(i)(1:3).EQ.'CdH')) THEN c vOH_2=vOH_2+1 c ELSE IF ((group(i)(1:1).EQ.'C').OR. c & (group(i)(1:2).EQ.'Cd')) THEN c vOH_3=vOH_3+1 c ENDIF c IF (vOH.NE.vOH_1+vOH_2+vOH_3) THEN c write(6,*) 'erreur OH' c STOP c ENDIF ENDIF ENDDO ENDIF * hydroperoxides (OOH) increments ibeg=INDEX(group(i),'(OOH)') IF (ibeg.ne.0) THEN DO j=ibeg,nc-4 IF (group(i)(j:j+4).EQ.'(OOH)') THEN Jobgroup(29)=Jobgroup(29)+1 ENDIF ENDDO ENDIF * (OONO2) : should only be PAN, already treated above c ibeg=INDEX(group(i),'(OONO2)') c IF (ibeg.ne.0) THEN c DO j=ibeg,nc-6 c IF (group(i)(j:j+6).EQ.'(OONO2)') THEN c vOONO2=vOONO2+1 c ENDIF c ENDDO c ENDIF * (ONO2) increments ibeg=INDEX(group(i),'(ONO2)') IF (ibeg.ne.0) THEN DO j=ibeg,nc-5 IF (group(i)(j:j+5).EQ.'(ONO2)') THEN Jobgroup(18)=Jobgroup(18)+1 ENDIF ENDDO ENDIF ibeg=INDEX(group(i),'(NO2)') IF (ibeg.ne.0) THEN DO j=ibeg,nc-4 IF (group(i)(j:j+5).EQ.'(NO2)') THEN Jobgroup(28)=Jobgroup(28)+1 ENDIF ENDDO ENDIF 20 CONTINUE CALL rjgadd(nring,group,rjg) RETURN END