************************************************************************ * MASTER MECHANISM - ROUTINE NAME : myrdaldata * * * * PURPOSE : compute the parameters involved in the Myrdal & Yalkowsi * * group contribution method for vapor pressure estimates. * * * * INPUT : * * ----- * * - chem : The formula for which parameters are estimated * * - weight : The molecular weight of chem * * * * output : * * ------ * * - Tb : The boiling point of chem, computed by the Joback * * group contribution method * * - HBN : Hydrogen bond number * * - tau : effective number of torsional bonds * * * * ------------------- * * Joback group contributions for boiling point are given in * * Reid et al., 1986, except for -ONO2 and -COOONO2 (see Camredon * * and 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 myrdaldata(chem,weight,Tb,HBN,tau) IMPLICIT NONE INCLUDE 'general.h' * input: CHARACTER(LEN=lfo) chem REAL weight * output: REAL Tb,HBN,tau * internal: CHARACTER(LEN=lgr) group(mca) INTEGER bond(mca,mca),dbflg,nring INTEGER i, j, k, nc, nca INTEGER sp2, sp3, indring INTEGER is,ifl,ibr,icl REAL JdeltaTb(29) INTEGER Jobgroup(29) REAL NH2, OH, COOH INTEGER rjg(mri,2) ! ring-join group pairs INTEGER rgallpath(mri,mca),rgpath(mca), nshare INTEGER begrg, endrg INTEGER rngflg ! 0 = 'no', 1 = 'yes' * Joback data for boiling points (see meaning of the index in the * subroutine comments). DATA JdeltaTb / 23.58, 22.88, 21.74, 18.25, 18.18, 24.96, & 24.14, -0.03, 38.13, 66.86, 92.88, 22.42, & 76.75, 72.24, 169.09, 81.10, 68.78, 112.10, & 157.42, 27.15, 21.78, 21.32, 26.73, 31.01, & 31.22, 94.97, 76.34, 152.54, 115.30 / * -------------------------------------------- * build groups and bonds matrix of the species * ----------------------------------------------------- nc = INDEX(chem,' ') - 1 CALL grbond(chem,nc,group,bond,dbflg,nring) * count the number of nodes nca=0 DO i=1,mca IF (group(i)(1:1).NE.' ') nca=nca+1 ENDDO * -------------------------------------------- * get Joback group * -------------------------------------------- CALL jobakgr(group,bond,nring,JobGroup) *---------------------------------- * Compute boiling point Tb (K), by Joback's method *---------------------------------- Tb=0. DO i = 1,29 Tb = Tb + JdeltaTb(i)*Jobgroup(i) ENDDO Tb = Tb + 198. *--------------------------------------- * Compute the effective number of torsional bonds (tau) * (requires non ring sp3 and sp2 and the number of independent rings) *--------------------------------------- * non ring non terminal SP3 : * =========================== * -O- (12), -CH2- (2), >CH- (3), >C< (4), -ONO2 (18), * -PAN (19x2), -CO-O- (16), -OOH (29) sp3 = 0 sp3 = Jobgroup(12) + Jobgroup(2) + Jobgroup(3) + Jobgroup(4) + & Jobgroup(18) + Jobgroup(19) + Jobgroup(19) + Jobgroup(16)+ & Jobgroup(29) * non ring non terminal SP2 : * =========================== * -CHO (14) , -COOH (15), -CO- (13), -CdH=(6), -CO-O- (16) , * -ONO2 (18), -PAN (19x2), >Cd= (7), -NO2(28) sp2 = 0 sp2 = Jobgroup(14) + Jobgroup(15) + Jobgroup(13) + Jobgroup(6) + & Jobgroup(16) + Jobgroup(18) + Jobgroup(19) + Jobgroup(19)+ & Jobgroup(7) + Jobgroup(28) * number of independent rings in the system * ========================================= indring=nring * If more than 2 rings, stop (need more checks ....) IF (nring.gt.2) THEN WRITE(6,*) '--error---, in myrdaldata' WRITE(6,*) ' number of rings is greater than 2' STOP ENDIF * If more than 1 ring, check whether 2 rings are independent or not IF (nring.eq.2) THEN DO i=1,mri DO j=1,mca rgallpath(i,j)=0 ENDDO ENDDO * get the joining nodes for rings and restore ring-join characters to groups CALL rjgrm(nring,group,rjg) CALL rjgadd(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,rgpath) DO j=1,mca IF (rgpath(j).eq.1) rgallpath(i,j)=1 ENDDO ENDDO * if 2 nodes are shared by 2 rings => rings are not independent indring=1 DO i=1,nring-1 DO j=i+1,nring nshare=0 DO k=1,mca IF (rgallpath(i,k)+rgallpath(i,k).eq.2) THEN nshare=nshare+1 ENDIF ENDDO IF (nshare.le.1) indring=indring+1 ENDDO ENDDO ENDIF * Compute tau * ============ tau=sp3+0.5*sp2+0.5*indring-1. IF (tau.LT.0) THEN tau=0 ENDIF *--------------------------------------- * Compute the Hydrogen Bond Number (HBN) *--------------------------------------- * OH = -OH(11) + -OOH(29); COOH = -COOH(15) ; NH2 = 0 OH = Jobgroup(11) + Jobgroup(29) COOH = Jobgroup(15) HBN=(sqrt(OH+COOH))/weight *--------------------------------------- * compute the vapor pressure at a given T *--------------------------------------- c logPsat = -(86 + 0.4*tau + 1421*HBN)*(Tb-T)/(19.1*T)+ c & (-90.0-2.1*tau)/19.1*((Tb-T)/T-log(Tb/T)) RETURN END