***************************************************************** * MASTER MECHANISM V.3.0 FUNCTION NAME - HEAT * * * * * * -- OLD COMMENT - NEED UPDATING -- * * -- OLD COMMENT - NEED UPDATING -- * * -- OLD COMMENT - NEED UPDATING -- * * * * PURPOSE - Evaluation of enthalpy of a molecule * * CHEM * * * * USAGE - DHxxx = HEAT(CHEM) * * * * ARGUMENTS HEAT- is the enthalpy of the molecule CHEM * * CHEM- is the standardized full name of the mo- * * lecule. * * * * There are no direct temperature measurements of decomposi- * * tion rate constants of e.g. alkoxy radicals. The decomposi- * * tion reaction enthalpies have a large effect on the estima- * * ted rate constants (e.g. alkoxy decomposition) and pathways * * of photodissociation of carbonyls - the most exothermic re- * * action is the most likely. The reaction enthalpies are com- * * puted from groups, to ensure consistency in predicting en- * * thalpies when no direct data exists for some or all products* * and reagents. * * * * INCLUDE general.h includes all information about global* * variables: functional groups * * * * COMMON BLOCK heatgp - includes all the information to eva- * * luate enthalpy DHxxx out of the en- * * thalpy, bsonval, from benson group, * * BEN. (see: Benson,S.W.,1976,Thermo- * * chemical Kinetics) * * * * LOCAL CONSTANTS... * * * * LIGAND 7-dim. array, which contains all ligands at- * * tached to polyvalent parts of a group. * * * * LOCAL VARIABLES... * * * * INTERNAL: * * * * BASE is the polyvalent molecular part of the bsongrp * * group for the for the functional groups in CHEM * * BENGRP is bsongrp group name for a functional group * * VALUE is the actual enthalpy for a functional group * * TGROUP contents the groups of CHEM * * TEMPKG is the evaluated functional group of CHEM * * TBOND contents the bond-matrix of CHEM * * NCA number of carbons in CHEM * * IH, IN, * * IO, IR are the counter of the ligands * * IC, ICO, * * ICD are the counter of the chain bonds * * I,J DO-LOOPs indices * * * ***************************************************************** REAL FUNCTION heat(chem,nbson,bsongrp,bsonval) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'organic.h' INCLUDE 'common.h' * on input: CHARACTER(LEN=lfo) chem INTEGER nbson CHARACTER(LEN=lgb) bsongrp(mbg) REAL bsonval(mbg) * internal: CHARACTER*3 base CHARACTER(LEN=lgb) bengrp CHARACTER(LEN=lgr) tgroup(mca), tempkg INTEGER tbond(mca,mca), nca, onum,point, nring INTEGER dbflg INTEGER cnum REAL value INTEGER i,j,ic,init,ir,icd,io,ico,nc,isulf INTEGER ib,ie,fg,op(4),cp(4),icdot,icodot,ialko,ipero INTEGER check CHARACTER*12 resu INTEGER rjg(mri,2) IF (wtflag.NE.0) WRITE(82,'(a)') chem IF (wtflag.NE.0) WRITE(6,*) '*heat*' * initialize: heat = 0. value = 0. nc = INDEX(chem,' ') - 1 IF (nc.LT.1) RETURN base = ' ' bengrp = ' ' tempkg= ' ' point=0 tbond(:,:)=0 tgroup(:)=' ' CALL grbond(chem,nc,tgroup,tbond,dbflg,nring) IF(nring.NE.0)THEN CALL rjgrm(nring,tgroup,rjg) ENDIF ! count the number of node in chem nca=0 DO i=1, mca IF (tgroup(i)(1:1).ne.' ') nca=nca+1 ENDDO * treat some one-carbon molecules as special cases: * results for each step are written in fort.82 c nca = cnum(chem,nc)+onum(chem,nc) IF (nca.lt.2) THEN IF (tgroup(1).EQ.'CH2O') THEN heat = -26.0 IF (wtflag.NE.0) WRITE(82,*) 'dhnet=',heat RETURN ENDIF IF ((tgroup(1).EQ.'CO ').AND.(tgroup(2)(1:1).NE.'C')) THEN heat = -26.4 IF (wtflag.NE.0) WRITE(82,*) 'dhnet=',heat RETURN ENDIF IF (tgroup(1).EQ.'CH3O') THEN heat = 4.62 IF (wtflag.NE.0) WRITE(82,*) 'dhnet=',heat RETURN ENDIF IF (tgroup(1).EQ.'CH3.') THEN heat = 34.9 IF (wtflag.NE.0) WRITE(82,*) 'dhnet=',heat RETURN ENDIF IF (tgroup(1).EQ.'CHO.') THEN heat = 9.99 IF (wtflag.NE.0) WRITE(82,*) 'dhnet=',heat RETURN ENDIF ENDIF * treat multi-carbons: DO 100 i=1,nca tempkg = tgroup(i) IF (tempkg(1:2).EQ.' ') GOTO 100 IF (tempkg(1:3).EQ.'-O-'.OR. & (tempkg(1:2).EQ.'-O'.AND.tempkg(4:4).EQ.'-')) THEN ic = 0 icdot = 0 ico = 0 io = 0 icodot= 0 init = 0 isulf = 0 ir = 0 base = ' ' * find bonds for C based groups, starting by finding the BASE * first check that the C is not a radical (i.e group ending with '.') IF (wtflag.NE.0) THEN WRITE(82,*) 'nc=',nc WRITE(82,*) 'tempkg=',tempkg WRITE(82,*) 'ir=',ir ENDIF point = 2 base = 'O' IF (wtflag.NE.0) WRITE(82,*) 'base=',base * find O - carbon bonds: DO j=1,mca ir = 0 IF (tbond(i,j).NE.0) THEN nc = index(tgroup(j),' ') - 1 IF (tgroup(j)(nc:nc).eq.'.') ir=1 IF ( (tgroup(j)(1:2).EQ.carbonyl) .OR. & (tgroup(j)(1:3).EQ.aldehyde) ) THEN IF (ir.eq.1) THEN icodot = icodot + 1 ELSE ico = ico + 1 ENDIF ELSE IF (ir.eq.1) THEN icdot = icdot + 1 ELSE ic = ic + 1 ENDIF ENDIF ENDIF ENDDO IF (wtflag.NE.0) WRITE(82,*) 'base=',base ialko = 0 ipero = 0 icd = 0 CALL nameben(base,point,ic,icdot,io,ico,icodot, & icd,init,ialko,ipero,bengrp) CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error0 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value ENDIF !'-O-' IF (tempkg(1:1).EQ.'C') THEN ic = 0 icdot = 0 io = 0 ico = 0 icodot= 0 icd = 0 init = 0 isulf = 0 ialko = 0 ipero = 0 ir = 0 base = ' ' * treat some special groups. * ketene: JMLT Jul'06 * DHf C2H2O = -47.6 => DHf ketene group = -47.6 - Cd_(Cd) [6.26] = -53.86 * reference for ketene: Cohen, N. (1996) J.Phys.Chem.Ref.Data, 25(6), 1411-1481 IF (tempkg(1:3).EQ.ketene) THEN !value = -17.7 value = -53.86 heat = heat + value !WRITE (6,*) '--error--, ketene group contribution' !WRITE (6,*) 'not taken into account for bsongrp' !WRITE (6,*) 'calculation. Please check the program' !WRITE (6,*) 'in subroutine heat' !STOP GOTO 100 ENDIF * find bonds for C based groups, starting by finding the BASE * first check that the C is not a radical (i.e group ending with '.') nc = index(tempkg,' ') - 1 IF (tempkg(nc:nc).eq.'.') ir=1 IF (wtflag.NE.0) THEN WRITE(82,*) 'nc=',nc WRITE(82,*) 'tempkg=',tempkg WRITE(82,*) 'ir=',ir ENDIF IF (tempkg(1:2).EQ.carbonyl) THEN IF (ir.eq.1) THEN point = 4 base = 'CO*' ELSE point = 3 base = 'CO' ENDIF ELSE IF (tempkg(1:3).EQ.aldehyde) THEN IF (ir.eq.1) THEN WRITE (6,*) '--error--, HCO* group found in' WRITE (6,*) 'bsongrp calculation (subroutine heat)' WRITE (6,*) 'This base is not allowed. Please ' WRITE (6,*) 'check the input species :' WRITE (6,*) chem ELSE point = 3 base = 'CO' ENDIF ELSE IF (tempkg(1:2).EQ.'Cd') THEN IF (ir.eq.1) THEN WRITE (6,*) '--error--, Cd* group found in' WRITE (6,*) 'bsongrp calculation (subroutine heat)' WRITE (6,*) 'This base is not allowed. Please ' WRITE (6,*) 'check the input species :' WRITE (6,*) chem ELSE point = 3 base = 'Cd' ENDIF ELSE IF (ir.eq.1) THEN point = 3 base = 'C*' ELSE point = 2 base = 'C' ENDIF ENDIF IF (wtflag.NE.0) WRITE(82,*) 'base=',base * find carbon - carbon bonds: DO j=1,mca ir = 0 IF (tbond(i,j).NE.0) THEN nc = index(tgroup(j),' ') - 1 IF (tgroup(j)(nc:nc).eq.'.') ir=1 IF ( (tgroup(j)(1:2).EQ.carbonyl) .OR. & (tgroup(j)(1:3).EQ.aldehyde) ) THEN IF (ir.eq.1) THEN icodot = icodot + 1 ELSE ico = ico + 1 ENDIF ELSE IF (tgroup(j)(1:3).EQ.'-O-') THEN io = io + 1 ELSE IF (tgroup(j)(1:2).EQ.'Cd') THEN icd = icd + 1 ELSE IF (ir.eq.1) THEN icdot = icdot + 1 ELSE ic = ic + 1 ENDIF ENDIF ENDIF ENDDO IF (wtflag.NE.0) WRITE(82,*) 'base=',base * find carbon - functional group bonds: * first the program finds the open and closing parenthesis (since functional * groups are included into parenthesis) and count number of groups. fg=0 DO j=1,4 op(j)=0 cp(j)=0 ENDDO DO j=point-1,lgr IF (tempkg(j:j).EQ.'(') THEN IF (wtflag.NE.0) WRITE(82,*)'(',j fg = fg + 1 op(fg)=j ENDIF IF (tempkg(j:j).EQ.')') THEN IF (wtflag.NE.0) WRITE(82,*)')',j cp(fg)=j ENDIF ENDDO IF (fg.gt.0) THEN DO j=1,fg ib=op(j) ie=cp(j) IF (wtflag.NE.0) THEN WRITE(82,*)ib,ie WRITE(82,*)'tempkg',tempkg(ib:ie) ENDIF IF (tempkg(ib:ie).eq.alkoxy) THEN ialko=ialko+1 ELSE IF (tempkg(ib:ie).eq.alkyl_peroxy) THEN ipero = ipero + 1 ELSE IF (tempkg(ib:ie).eq.hydroxy) THEN io = io + 1 bengrp='O_('//base(1:point-1) nc=index(bengrp,' ') bengrp(nc:nc)=')' CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error1 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value ELSE IF (tempkg(ib:ie).eq.hydro_peroxide) THEN io = io + 1 bengrp='O_('//base(1:point-1) nc=index(bengrp,' ') bengrp(nc:nc+3)=')(O)' CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error2 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value bengrp='O_(O)' CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error3 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value ELSE IF (tempkg(ib:ie).eq.nitrate) THEN init = init + 1 bengrp='ONO2_('//base(1:point-1) nc=index(bengrp,' ') bengrp(nc:nc)=')' CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error4 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value ELSE IF (tempkg(ib:ie).eq.sulfate) THEN isulf = isulf + 1 bengrp='OSO3_('//base(1:point-1) nc=index(bengrp, ' ' ) bengrp(nc:nc)=')' CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.ne.0) WRITE(82,*) bengrp, value IF (check.ne.0) then WRITE (6,*) '--error4 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value ELSE IF (tempkg(ib:ie).eq.peroxy_nitrate) THEN io = io + 1 bengrp='O_('//base(1:point-1) nc=index(bengrp,' ') bengrp(nc:nc+7)=')(ONO2)' CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error5 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value bengrp='ONO2_(O)' CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error6 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value ELSE IF (tempkg(ib:ie).eq.nitro) THEN io = io + 1 bengrp='O_('//base(1:point-1) nc=index(bengrp,' ') bengrp(nc:nc+6)=')(NO2)' CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error7 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp,' ',tempkg WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value bengrp='NO2_(O)' CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error8 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem,' ',chem STOP value=0. ENDIF heat=heat+value ELSE WRITE (6,*) '--error9 in subroutine heat' WRITE (6,*) 'group contribution can not' WRITE (6,*) 'be estimated for the group' WRITE (6,*) tempkg WRITE (6,*) 'in the species' WRITE (6,*) chem WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. * WRITE(82,*)ic,icdot,io,ico,icodot,icd,init,ialko,ipero ENDIF ENDDO ENDIF CALL nameben(base,point,ic,icdot,io,ico,icodot, & icd,init,ialko,ipero,bengrp) CALL getben(bengrp,nbson,bsongrp,bsonval,value,check) IF (wtflag.NE.0) WRITE(82,*) bengrp,value IF (check.NE.0) THEN WRITE (6,*) '--error10 in subroutine heat' WRITE (6,*) 'group contribution for the ' WRITE (6,*) 'following group not found' WRITE (6,*) bengrp WRITE(99,*) 'heat',bengrp,' ',chem STOP value=0. ENDIF heat=heat+value ENDIF 100 CONTINUE * to keep only 5 numbers after comma resu=' ' WRITE(resu,'(e12.5)') heat IF (wtflag.NE.0) WRITE(82,'(a12)') resu READ(resu,'(e12.5)') heat IF (wtflag.NE.0) WRITE(82,*) 'dhnet=',heat RETURN END