!**************************************************************************** * * * Estimate the boiling points with the nannoolal method (2004) * * * **************************************************************************** SUBROUTINE nannoolal_tb(chem,group,bond,nring,Tb,Nangroup) IMPLICIT NONE INCLUDE 'general.h' * input: CHARACTER(LEN=lfo) chem CHARACTER(LEN=lgr) group(mca) INTEGER bond(mca,mca),nring * output REAL Tb,Nangroup(219) * internal CHARACTER(LEN=lgr) tgroup(mca),neigh(mca,4),nejgh(mca,4) INTEGER tbond(mca,mca) 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 nbnei(mca),nei_ind(mca,4),nbatom INTEGER nbnej(mca),nej_ind(mca,4) INTEGER ic, ih, in, io, ir, is, ifl, ibr, icl REAL contrib(219),sum,GI INTEGER ncd,conjug INTEGER ncdcase, cdtable(4),tcdtable(4), cdsub(4) INTEGER cdcarbo(4,2),cdeth(4,2),lring(2) INTEGER track(mco,mca) INTEGER trlen(mco) INTEGER ntr,maxln INTEGER ngrp CHARACTER*1 nodetype(mca) REAL alifun(20),cdfun(20),arofun(20) ! REAL alifun(21),cdfun(21),arofun(21) REAL mapfun(mca,3,20) ! REAL mapfun(mca,3,21) INTEGER funflg(mca),nfcd,nfcr INTEGER rxnflg INTEGER tabester(4,2) ! 1= -O- side, 2= CO side INTEGER ierr,node,ntot REAL sumgroup(19),sum1,sum2 *---------------------------------------- * sum of contributions for each group *---------------------------------------- * count the number of nodes nca=0 sum=0 ntot=0 DO i=1,mca ring(i)=0 tgroup(i)=group(i) nbnei(i)=0 nbnej(i)=0 DO j=1,mca tbond(i,j)=bond(i,j) ENDDO IF (tgroup(i)(1:1).NE.' ') nca=nca+1 DO j=1,4 neigh(i,j)=' ' nejgh(i,j)=' ' nei_ind(i,j) = 0 nej_ind(i,j) = 0 ENDDO ENDDO Nangroup=0 contrib=0 lring=0 rxnflg = 0 * data for chemmap ierr=0 alifun=0 cdfun=0 arofun=0 mapfun=0 nodetype(:)=' ' funflg=0 nfcd=0 nfcr=0 tabester=0 ***************************************** ***************************************** ************ Contributions ************** contrib(1)=177.3066 contrib(2)=251.8338 contrib(3)=157.9527 contrib(4)=239.4531 contrib(5)=240.6785 contrib(6)=249.5809 contrib(7)=266.8769 contrib(8)=201.0115 contrib(9)=239.4957 contrib(10)=222.1163 contrib(11)=209.9749 contrib(12)=250.9584 contrib(13)=291.2291 contrib(14)=244.3581 contrib(15)=235.3462 contrib(16)=315.4128 contrib(17)=348.2779 contrib(18)=367.9649 contrib(19)=106.5492 contrib(20)=49.2701 contrib(21)=53.1871 contrib(22)=78.7578 contrib(23)=103.5672 contrib(24)=-19.5575 contrib(25)=330.9117 contrib(26)=287.1863 contrib(27)=267.4170 contrib(28)=205.7363 contrib(29)=292.5816 contrib(30)=419.4959 contrib(31)=377.6775 contrib(32)=556.3944 contrib(33)=349.9409 contrib(34)=390.2446 contrib(35)=443.8712 contrib(36)=488.0819 contrib(37)=361.4775 contrib(38)=146.4836 contrib(39)=820.7118 contrib(40)=321.1759 contrib(41)=441.4388 contrib(42)=223.0992 contrib(43)=126.2952 contrib(44)=1080.3139 contrib(45)=636.2020 contrib(46)=642.0427 contrib(47)=1142.6119 contrib(48)=1052.6072 contrib(49)=1364.5333 contrib(50)=1487.4109 contrib(51)=618.9782 contrib(52)=553.8090 contrib(53)=434.0811 contrib(54)=461.5784 contrib(55)=864.5074 contrib(56)=304.3321 contrib(57)=719.2462 contrib(58)=475.7958 contrib(59)=586.1413 contrib(60)=500.2434 contrib(61)=412.6276 contrib(62)= 475.9623 contrib(63)= 512.2893 contrib(64)= 422.2307 contrib(65)= 37.1936 contrib(66)= 453.3397 contrib(67)= 306.7139 contrib(68)= 866.5843 contrib(69)= 821.4141 contrib(70)= 282.0181 contrib(71)= 207.9312 contrib(72)= 920.3617 contrib(73)=1153.1344 contrib(74)= 494.2668 contrib(75)=1041.0851 contrib(76)=1251.2675 contrib(77)= 778.9151 contrib(78)= 540.0895 contrib(79)= 879.7062 contrib(80)= 660.4645 contrib(81)=1018.4865 contrib(82)=1559.9840 contrib(83)= 510.4223 contrib(84)=1149.9670 contrib(85)=1209.2972 contrib(86)= 347.7717 contrib(87)= 664.0903 contrib(88)= 957.6388 contrib(89)= 928.9954 contrib(90)= 560.1024 contrib(91)= 229.2288 contrib(92)= 606.1797 contrib(93)= 215.3416 contrib(94)= 273.1755 contrib(95)=1218.1878 contrib(96)=2082.3288 contrib(97)= 201.3224 contrib(98)=0 contrib(99)= 886.7613 contrib(100)=1045.0343 contrib(101)=-109.6269 contrib(102)= 111.0590 contrib(103)=1573.3769 contrib(104)=1483.1289 contrib(105)=1506.8136 contrib(106)= 484.6371 contrib(107)=1379.4485 contrib(108)= 659.7336 contrib(109)= 492.0707 contrib(110)=0 contrib(111)=971.0365 contrib(112)=0 contrib(113)=428.8911 contrib(114)=0 contrib(115)=612.9506 contrib(116)=562.1791 contrib(117)=761.6006 contrib(118)=40.4205 contrib(119)=-82.2328 contrib(120)=-247.8893 contrib(121)=-20.3996 contrib(122)=15.4720 contrib(123)=-172.4201 contrib(124)=-99.8035 contrib(125)=-62.3740 contrib(126)=-40.0058 contrib(127)=-27.2705 contrib(128)=-3.5075 contrib(129)=16.1061 contrib(130)=25.8348 contrib(131)=35.8330 contrib(132)=51.9098 contrib(133)=111.8372 contrib(135)=291.8 contrib(136)=314.61 contrib(137)=286.97 contrib(138)=38.7 contrib(139)=146.73 contrib(140)=135.4 contrib(141)=226.5 contrib(142)=211.68 contrib(143)=46.38 contrib(144)=-74.02 contrib(145)=306.4 contrib(146)=435.09 contrib(147)=1334.67 contrib(148)=288.62 contrib(149)=797.43 contrib(150)=-1477.97 contrib(151)=130.37 contrib(152)=-1184.98 contrib(153)=0 contrib(154)=43.97 contrib(155)=-1048.12 contrib(156)=-614.36 contrib(157)=174.03 contrib(158)=510.35 contrib(159)=124.35 contrib(160)=182.63 contrib(161)=-562.31 contrib(162)=663.8 contrib(163)=395.41 contrib(164)=27.27 contrib(165)=239.81 contrib(166)=101.85 contrib(167)=317.02 contrib(168)=-215.35 contrib(169)=758.99 contrib(170)=217.64 contrib(171)=501.28 contrib(172)=117.2 contrib(173)=612.88 contrib(174)=-183.3 contrib(175)=-55.99 contrib(176)=-356.5 contrib(177)=-263.08 contrib(178)=91.5 contrib(179)=178.78 contrib(180)=322.57 contrib(181)=15.7 contrib(182)=17.04 contrib(183)=394.55 contrib(184)=963.65 contrib(185)=293.6 contrib(186)=329.01 contrib(187)=1006.39 contrib(188)=163.55 contrib(189)=431.1 contrib(190)=22.52 contrib(191)=-205.62 contrib(192)=517.07 contrib(193)=707.94 contrib(194)=-303.97 contrib(195)=-391.37 contrib(196)=-3628.9 contrib(197)=381.01 contrib(198)=-574.22 contrib(199)=176.55 contrib(200)=124.19 contrib(201)=582.18 contrib(202)=140.96 contrib(203)=397.58 contrib(204)=674.69 contrib(205)=-11.94 contrib(206)=65.14 contrib(207)=-101.23 contrib(208)=-348.74 contrib(209)=-370.97 contrib(210)=-888.61 contrib(211)=0 contrib(212)=-271.94 ** PAN = 7 + 38 + 72 c contrib(213)=1333.72 ** PAN : compernolle 2010 contrib(213)=1467.2 ** OOH = -O- + OH contrib(214)=774.75 ! compernolle c contrib(214)=590.35 ! 36 + 38 c contrib(215)=536.73 ! 35 + 38 c contrib(216)=496.42 ! 34 + 38 c contrib(217)=507.96 ! 33 + 38 c contrib(218)=634.57 ! 37 + 38 ** CO(OOH) : compernolle 2010 contrib(219)=1110.64 ***************************************** ***************************************** * 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,tgroup,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,tbond,rngflg,ring) ENDDO ENDIF IF (nring.GT.0) THEN DO i=1,nca k=1 CALL gettrack(tbond,i,nca,ntr,track,trlen) DO j=1,ntr IF ((trlen(j).GT.2).AND. & (tbond(i,track(j,trlen(j))).GT.0)) THEN IF (trlen(j).NE.lring(k)) THEN lring(k)=trlen(j) k=k+1 IF (k.EQ.nring) GOTO 123 ! to be updated for species having 3 cycles ENDIF ENDIF ENDDO ENDDO ENDIF 123 CONTINUE IF (nring.GT.0) THEN DO i=1,nring IF ((lring(i).EQ.3).OR.(lring(i).EQ.4)) THEN Nangroup(125) = Nangroup(125) +1 ELSE IF (lring(i).EQ.5) THEN Nangroup(126) = Nangroup(126) +1 ENDIF ENDDO ENDIF ************** DO i=1,nca DO j=1,nca IF (tbond(i,j).NE.0) THEN nbnei(i)=nbnei(i)+1 !number of neighbours neigh(i,nbnei(i))=tgroup(j) !groups of neighbours nei_ind(i,nbnei(i))=j ! JMLT: peroxide case: identify next-but-one neighbor IF(tgroup(j).EQ.'-O-')THEN nbnej(i) = 0 DO k=1,nca IF (tbond(j,k).NE.0.AND.k.NE.i) THEN nbnej=nbnej(i)+1 !number of next neighbors nejgh(i,nbnej(j))=tgroup(k) !groups of next neighbours nej_ind(i,nbnej(i))=k ENDIF ENDDO ENDIF ENDIF ENDDO ENDDO ************* IF (chem(1:9).EQ.'CHO-O-CHO') THEN Nangroup(76)=1 GOTO 987 ENDIF ********************************************************** * group definitions * ********************************************************** DO 100 i=1,nca IF (tgroup(i).EQ.'CH3') THEN IF((neigh(i,1)(1:1).NE.'N').AND. & (neigh(i,1).NE.'-O-').AND.(neigh(i,1)(1:1).NE.'F').AND. & (neigh(i,1)(1:2).NE.'Cl').AND. & (neigh(i,1)(1:1).NE.'c')) THEN Nangroup(1)=Nangroup(1)+1 GOTO 100 ELSE IF (neigh(i,1).EQ.'c') THEN Nangroup(3)=Nangroup(3)+1 GOTO 100 ELSE Nangroup(2)=Nangroup(2)+1 GOTO 100 ENDIF ELSE IF ((tgroup(i).EQ.'CH2').OR. & (tgroup(i)(1:4).EQ.'CH2(')) THEN IF (ring(i).NE.1) THEN IF ((neigh(i,1)(1:1).EQ.'c').OR. & (neigh(i,2)(1:1).EQ.'c')) THEN Nangroup(8)=Nangroup(8)+1 ELSE IF ((neigh(i,1).EQ.'-O-').OR. & (neigh(i,2).EQ.'-O-').OR. & (INDEX(tgroup(i),'O').NE.0)) THEN Nangroup(7)=Nangroup(7)+1 ELSE Nangroup(4)=Nangroup(4)+1 ENDIF ELSE Nangroup(9)=Nangroup(9)+1 ENDIF ELSE IF ((tgroup(i).EQ.'CH').OR. & (tgroup(i)(1:3).EQ.'CH(')) THEN IF (ring(i).NE.1) THEN IF ((neigh(i,1).EQ.'-O-').OR. & (neigh(i,2).EQ.'-O-').OR. & (INDEX(tgroup(i),'O').NE.0)) THEN Nangroup(7)=Nangroup(7)+1 ELSE Nangroup(5)=Nangroup(5)+1 ENDIF ELSE IF (INDEX(tgroup(i),'O').NE.0) THEN Nangroup(12)=Nangroup(12)+1 ELSE Nangroup(10)=Nangroup(10)+1 ENDIF ENDIF ELSE IF ((tgroup(i).EQ.'C').OR.(tgroup(i)(1:2).EQ.'C(')) THEN IF (ring(i).NE.1) THEN IF ((neigh(i,1)(1:1).EQ.'N').OR. & (neigh(i,1)(1:3).EQ.'-O-').OR. & (neigh(i,1)(1:1).EQ.'F').OR. & (neigh(i,1)(1:2).EQ.'Cl').OR. & (INDEX(tgroup(i),'O').NE.0)) & THEN Nangroup(7)=Nangroup(7)+1 ELSE IF ((neigh(i,1)(1:1).EQ.'c').OR. & (neigh(i,2)(1:1).EQ.'c')) THEN Nangroup(8)=Nangroup(8)+1 ELSE Nangroup(6)=Nangroup(6)+1 ENDIF ELSE IF ((neigh(i,1)(1:1).EQ.'c').OR. & (neigh(i,2)(1:1).EQ.'c')) THEN Nangroup(14)=Nangroup(14)+1 ELSE IF ((INDEX(tgroup(i),'O').NE.0).OR. & (INDEX(tgroup(i),'(N').NE.0)) THEN Nangroup(12)=Nangroup(12)+1 ELSE IF ((neigh(i,1).EQ.'-O-').OR. & (neigh(i,1).EQ.'-N-')) THEN Nangroup(13)=Nangroup(13)+1 ELSE Nangroup(11)=Nangroup(11)+1 ENDIF ENDIF ENDIF IF (tgroup(i)(1:2).EQ.'cH') THEN Nangroup(15)=Nangroup(15)+1 ELSE IF (tgroup(i)(1:1).EQ.'c') THEN IF ((neigh(i,1)(1:1).NE.'N').AND. & (neigh(i,1)(1:3).NE.'-O-').AND. & (neigh(i,1)(1:1).NE.'F').AND. & (neigh(i,1)(1:2).NE.'Cl').AND. & (INDEX(tgroup(i),'O').EQ.0)) THEN Nangroup(16)=Nangroup(16)+1 ELSE Nangroup(17)=Nangroup(17)+1 ENDIF IF ((nbnei(i).EQ.3).AND.(neigh(i,1)(1:1).EQ.'c').AND. & (neigh(i,2)(1:1).EQ.'c').AND. & (neigh(i,3)(1:1).EQ.'c')) THEN Nangroup(18)=Nangroup(18)+1 ENDIF ENDIF *carbon double bond IF (tgroup(i)(1:2).EQ.'Cd') THEN CALL cdcase_gt2(chem,bond,group,rxnflg,nring, & ncd,ncdcase,conjug, & cdtable,tcdtable,cdsub,cdcarbo,cdeth) IF (ncdcase.EQ.1) THEN IF (conjug.EQ.1) THEN IF ((ring(cdtable(1)).EQ.1).AND. & (ring(cdtable(4)).EQ.1)) THEN Nangroup(88)=1 c GOTO 100 ELSE Nangroup(89)=1 c GOTO 100 ENDIF ENDIF ELSE IF (ncdcase.EQ.2) THEN Nangroup(118) = Nangroup(118) + 0.5 c Nangroup(51) = Nangroup(51) - 0.5 c GOTO 100 ENDIF IF ((tgroup(i)(1:4).EQ.'CdH2').OR. & ((neigh(i,1)(1:4).EQ.'CdH2').AND. & (tbond(i,nei_ind(i,1)).EQ.2)).OR. & ((neigh(i,2)(1:4).EQ.'CdH2').AND. & (tbond(i,nei_ind(i,2)).EQ.2)).OR. & ((neigh(i,3)(1:4).EQ.'CdH2').AND. & (tbond(i,nei_ind(i,3)).EQ.2))) THEN Nangroup(61)=Nangroup(61)+0.5 ELSE IF (ring(i).NE.1) THEN IF (((neigh(i,1)(1:4).NE.'CdH2').AND. & (tbond(i,nei_ind(i,1)).EQ.2)).OR. & ((neigh(i,2)(1:4).NE.'CdH2').AND. & (tbond(i,nei_ind(i,2)).EQ.2)).OR. & ((neigh(i,3)(1:4).NE.'CdH2').AND. & (tbond(i,nei_ind(i,3)).EQ.2))) THEN Nangroup(58)=Nangroup(58)+0.5 ENDIF IF (tbond(i,nei_ind(i,1)).NE.2) THEN IF (neigh(i,1)(1:1).EQ.'c') THEN Nangroup(59)=Nangroup(59)+0.5 Nangroup(58)=Nangroup(58)-0.5 c GOTO 110 ELSE DO j=1,nca IF (tbond(nei_ind(i,2),j).EQ.1) THEN IF (tgroup(j)(1:1).EQ.'c') THEN Nangroup(59)=Nangroup(59)+0.5 Nangroup(58)=Nangroup(58)-0.5 c GOTO 110 ENDIF ENDIF ENDDO ENDIF ELSE IF (tbond(i,nei_ind(i,2)).NE.2) THEN IF (neigh(i,2)(1:1).EQ.'c') THEN Nangroup(59)=Nangroup(59)+0.5 Nangroup(58)=Nangroup(58)-0.5 c GOTO 110 ELSE DO j=1,nca IF (tbond(nei_ind(i,1),j).EQ.1) THEN IF (tgroup(j)(1:1).EQ.'c') THEN Nangroup(59)=Nangroup(59)+0.5 Nangroup(58)=Nangroup(58)-0.5 c GOTO 110 ENDIF ENDIF ENDDO ENDIF ENDIF DO j=1,nbnei(i) IF (tbond(i,nei_ind(i,j)).NE.2) THEN IF ((neigh(i,j)(1:1).EQ.'N').OR. & (neigh(i,j)(1:1).EQ.'F').OR. & (neigh(i,j)(1:3).EQ.'-O-').OR. & (neigh(i,j)(1:2).EQ.'Cl')) THEN Nangroup(60)=Nangroup(60)+1 Nangroup(58)=Nangroup(58)-1 EXIT ENDIF ENDIF ENDDO c IF (tbond(i,nei_ind(i,1)).NE.2) THEN c IF ((neigh(i,1)(1:1).EQ.'N').OR. c & (neigh(i,1)(1:1).EQ.'F').OR. c & (neigh(i,1)(1:3).EQ.'-O-').OR. c & (neigh(i,1)(1:2).EQ.'Cl')) THEN c Nangroup(60)=Nangroup(60)+1 c Nangroup(58)=Nangroup(58)-1 cc GOTO 110 c ELSE c DO j=1,nca c IF ((tbond(nei_ind(i,2),j).EQ.1).OR. c & (tbond(nei_ind(i,2),j).EQ.3)) THEN c IF ((tgroup(j)(1:1).EQ.'N').OR. c & (tgroup(j)(1:1).EQ.'F').OR. c & (tgroup(j)(1:3).EQ.'-O-').OR. c & (tgroup(j)(1:2).EQ.'Cl')) THEN c Nangroup(60)=Nangroup(60)+0.5 c Nangroup(58)=Nangroup(58)-0.5 cc GOTO 110 c ENDIF c ENDIF c ENDDO c ENDIF c ELSE IF (tbond(i,nei_ind(i,2)).NE.2) THEN c IF ((neigh(i,2)(1:1).EQ.'N').OR. c & (neigh(i,2)(1:1).EQ.'F').OR. c & (neigh(i,2)(1:3).EQ.'-O-').OR. c & (neigh(i,2)(1:2).EQ.'Cl')) THEN c Nangroup(60)=Nangroup(60)+0.5 c Nangroup(58)=Nangroup(58)-0.5 cc GOTO 110 c ELSE c DO j=1,nca c IF ((tbond(nei_ind(i,1),j).EQ.1).OR. c & (tbond(nei_ind(i,1),j).EQ.3)) THEN c IF ((tgroup(j)(1:1).EQ.'N').OR. c & (tgroup(j)(1:1).EQ.'F').OR. c & (tgroup(j)(1:3).EQ.'-O-').OR. c & (tgroup(j)(1:2).EQ.'Cl')) THEN c Nangroup(60)=Nangroup(60)+0.5 c Nangroup(58)=Nangroup(58)-0.5 cc GOTO 110 c ENDIF c ENDIF c ENDDO c ENDIF c ENDIF ELSE IF (((ring(nei_ind(i,1)).EQ.1).AND. & (tbond(i,nei_ind(i,1)).EQ.2)).OR. & ((ring(nei_ind(i,2)).EQ.1).AND. & (tbond(i,nei_ind(i,2)).EQ.2)).OR. & ((ring(nei_ind(i,3)).EQ.1).AND. & (tbond(i,nei_ind(i,3)).EQ.2))) THEN Nangroup(62)=Nangroup(62)+0.5 ELSE Nangroup(58)=Nangroup(58)+0.5 ENDIF ENDIF * alcohol IF ((nca.LT.5).AND.(INDEX(tgroup(i),'(OH)').NE.0) & .AND.(INDEX(tgroup(i),'CO(OH)').EQ.0) & .AND.(INDEX(tgroup(i),'c').EQ.0)) THEN Nangroup(36)=Nangroup(36)+1 ELSE IF ((tgroup(i)(1:7).EQ.'CH2(OH)').AND.(nca.GE.5)) THEN Nangroup(35)=Nangroup(35)+1 ELSE IF ((tgroup(i)(1:6).EQ.'CH(OH)').AND.(nca.GE.3)) THEN Nangroup(34)=Nangroup(34)+1 ELSE IF (tgroup(i)(1:5).EQ.'C(OH)') THEN Nangroup(33)=Nangroup(33)+1 ELSE IF (tgroup(i)(1:9).EQ.'C(OH)(OH)') THEN Nangroup(33)=Nangroup(33)+2 ELSE IF ((tgroup(i)(1:1).EQ.'c').AND. & (INDEX(tgroup(i),'(OH)').NE.0)) THEN Nangroup(37)=Nangroup(37)+1 ELSE IF (tgroup(i)(1:6).EQ.'Cd(OH)') THEN Nangroup(33)=Nangroup(33)+1 ENDIF * hydroperoxyde IF ((INDEX(tgroup(i),'(OOH)').NE.0).AND. & (INDEX(tgroup(i),'CO(OOH)').EQ.0)) THEN Nangroup(214)=Nangroup(214)+1 ENDIF * aldehyde IF (INDEX(tgroup(i),'CHO').NE.0) THEN IF (neigh(i,1)(1:1).EQ.'c') THEN Nangroup(90)=Nangroup(90)+1 ! arom-sustituent aldehyde ELSE IF (neigh(i,1)(1:1).EQ.'C') THEN Nangroup(52)=Nangroup(52)+1 ! aldehyde ELSE IF (neigh(i,1).EQ.'-O-') THEN Nangroup(46)=Nangroup(46)+1 ! formic acid ester !Nangroup(38)=Nangroup(38)-1 ! JMLT: assign -O- later ENDIF ENDIF *carbonyl IF (tgroup(i).EQ.'CO') THEN ! carbonyl group IF ((neigh(i,1)(1:1).EQ.'C').AND. & (neigh(i,2)(1:1).EQ.'C')) THEN Nangroup(51)=Nangroup(51)+1 ! ketone ELSE IF (((neigh(i,1).EQ.'-O-').AND. & ((neigh(i,2)(1:1).EQ.'C').OR. & ((neigh(i,2)(1:1).EQ.'c')))).OR. & ((neigh(i,2).EQ.'-O-').AND. & ((neigh(i,1)(1:1).EQ.'C').OR. & ((neigh(i,1)(1:1).EQ.'c')))))THEN IF (ring(i).EQ.0) THEN Nangroup(45)=Nangroup(45)+1 ! ester !Nangroup(38)=Nangroup(38)-1 ! JMLT: assign -O- later ELSE Nangroup(47)=Nangroup(47)+1 ! lactone !Nangroup(38)=Nangroup(38)-1 ! JMLT: assign -O- later ENDIF ELSE IF ((neigh(i,1)(1:1).EQ.'c') & .OR.(neigh(i,2).EQ.'c')) THEN Nangroup(92)=Nangroup(92)+1 ! arom.substit. ketone ELSE IF ((neigh(i,1).EQ.'-O-').AND. & (neigh(i,2).EQ.'-O-')) THEN IF (ring(i).EQ.0) THEN Nangroup(79) = Nangroup(79) + 1 ! non-cyclic carbonate !Nangroup(38) = Nangroup(38) - 2 ! JMLT: assign -O- later ELSE Nangroup(103) = Nangroup(103) + 1 ! cyclic carbonate !Nangroup(38) = Nangroup(38) - 2 ! JMLT: assign -O- later ENDIF ENDIF IF ((neigh(i,1)(1:1).EQ.'N').AND. & (neigh(i,2)(1:1).EQ.'N')) THEN Nangroup(100)=Nangroup(100)+1 ELSE IF ((neigh(i,1)(1:1).EQ.'N') & .OR.(neigh(i,2)(1:1).EQ.'N')) THEN Nangroup(109)=Nangroup(109)+1 ENDIF ENDIF *ether IF (INDEX(tgroup(i),'-O-').NE.0) THEN IF(((neigh(i,1)(1:1).EQ.'C').OR.(neigh(i,1)(1:2).EQ.'Si')) & .AND. & ((neigh(i,2)(1:1).EQ.'C').OR.(neigh(i,2)(1:2).EQ.'Si'))) & THEN * JMLT, Oct -15: ether corrections (code restructured) IF ((neigh(i,1).EQ.'CO').AND.(neigh(i,2).EQ.'CO')) THEN IF (ring(i).EQ.0) THEN Nangroup(76)=Nangroup(76)+1 ! anhydride Nangroup(45)=Nangroup(45)-2 ! not 2 esters !JMLT: ether re-correction no longer needed !Nangroup(38)=Nangroup(38)+1 ELSE Nangroup(96)=Nangroup(96)+1 ! cyclic anhydride Nangroup(47)=Nangroup(47)-2 ! not lactone !JMLT: ether re-correction no longer needed !Nangroup(38)=Nangroup(38)+1 ENDIF ! correction for CO-O-CHO, priority is given to the non-terminal ester ! => groups considered are ester (45) (already assigned) + CHO (52) ! => need to DE-consider terminal ester (46) ELSE IF (((neigh(i,1).EQ.'CHO').AND.(neigh(i,2).EQ.'CO')) & .OR. & ((neigh(i,1).EQ.'CO').AND.(neigh(i,2).EQ.'CHO'))) & THEN Nangroup(52)=Nangroup(52)+1 ! add aldehyde Nangroup(46)=Nangroup(46)-1 ! remove ester !JMLT: ether re-correction no longer needed !Nangroup(38)=Nangroup(38)+1 ! {esters, lactones, carbonates} dealt with above, so not assigned here ELSE IF ((neigh(i,1).EQ.'CO').OR.(neigh(i,2).EQ.'CO') .OR. & (neigh(i,1).EQ.'CHO').OR.(neigh(i,2).EQ.'CHO')) & THEN !print*,'here' ! If we made it this far, it's an ether ELSE Nangroup(38)=Nangroup(38)+1 ! ether ENDIF ELSE IF ((neigh(i,1)(1:1).EQ.'c').AND.(neigh(i,2).EQ.'c')) & THEN Nangroup(65)=Nangroup(65)+1 ! furan ! JMLT: assign peroxy only if no complicating adjacent groups! ELSE IF ((neigh(i,1).EQ.'-O-').OR.(neigh(i,2).EQ.'-O-')) & THEN IF ((neigh(i,1).EQ.'CO').OR.(neigh(i,2).EQ.'CO') .OR. & (neigh(i,1).EQ.'CHO').OR.(neigh(i,2).EQ.'CHO')) & THEN IF ((nejgh(i,1).EQ.'CO').OR.(nejgh(i,2).EQ.'CO') .OR. & (nejgh(i,1).EQ.'CHO').OR.(nejgh(i,2).EQ.'CHO')) & THEN ! peroxide RCO-O-O-RCO- : esters have priority over peroxide ! => do NOT assign ether or correct for peroxide (esters assigned elsewhere) !print*,neigh(i,1),tgroup(i),neigh(i,2),nbnej(i),"* ",nejgh(i,1) CONTINUE !print*,'here three' ELSE ! peroxide RCO-O-O- : esters have priority over peroxide ! => assign ether not peroxide (+ ester already assigned) !print*,'here too' Nangroup(38)=Nangroup(38)+1 ! ether Nangroup(94)=Nangroup(94)-0.5 ! not peroxide ENDIF ELSE ! peroxides with no complicating neighbours Nangroup(94)=Nangroup(94) + 0.5 ! peroxide ENDIF ENDIF ENDIF *acid IF (tgroup(i)(1:6).EQ.'CO(OH)') THEN Nangroup(44)=Nangroup(44)+1 ENDIF IF (tgroup(i)(1:7).EQ.'CO(OOH)') THEN Nangroup(219)=Nangroup(219)+1 ENDIF *PAN CO(OONO2) = C (connected to at least one O) + -O- + ONO2 IF (tgroup(i)(1:9).EQ.'CO(OONO2)') THEN Nangroup(213)=Nangroup(213)+1 ENDIF 110 CONTINUE *nitrate IF (INDEX(tgroup(i),'(ONO2)(ONO2)').NE.0) THEN Nangroup(72)=Nangroup(72)+2 ELSE IF (INDEX(tgroup(i),'(ONO2)').NE.0) THEN Nangroup(72)=Nangroup(72)+1 ENDIF *nitrite IF (INDEX(tgroup(i),'(NO2)').NE.0) THEN IF (tgroup(i)(1:1).EQ.'C') THEN Nangroup(68)=Nangroup(68)+1 ELSE IF (tgroup(i)(1:1).EQ.'c') THEN Nangroup(69)=Nangroup(69)+1 ENDIF ENDIF 100 CONTINUE * correction for >C=C-C=C< structures IF ((Nangroup(89).EQ.1).AND.(Nangroup(61).EQ.2)) THEN Nangroup(61)=0 ELSE IF ((Nangroup(89).EQ.1).AND.(Nangroup(61).EQ.1) & .AND.(Nangroup(58).EQ.1)) THEN Nangroup(58)=0 Nangroup(61)=0 ELSE IF ((Nangroup(89).EQ.1).AND.(Nangroup(58).EQ.2)) THEN Nangroup(58)=0 ENDIF * -OOH compernolle Nangroup(214) = Nangroup(214) + Nangroup(215) + Nangroup(216) & + Nangroup(217) + Nangroup(218) Nangroup(215)=0 Nangroup(216)=0 Nangroup(217)=0 Nangroup(218)=0 ********************************************************** * steric corrections * ********************************************************** nc = INDEX(chem,' ') - 1 CALL number(chem,nc,ic,ih,in,io,ir,is,ifl,ibr,icl) nbatom=ic+in+io+ir+is+ifl+ibr+icl IF (ih.EQ.0) Nangroup(123) = 1 IF (ih.EQ.1) Nangroup(124) = 1 CALL chemmap(chem,nca,group,bond,ngrp,nodetype, & alifun,cdfun,arofun,mapfun,funflg, & tabester,nfcd,nfcr,ierr) IF (ierr.ne.0) THEN WRITE(6,*) 'STOP in chemmap, using chem:' WRITE(6,*) chem(1:60) STOP ENDIF DO i=1,nca nbnei(i)=0 DO j=1,4 neigh(i,j)=' ' nei_ind(i,j)=0 ENDDO ENDDO DO i=1,nca DO j=1,nca IF ((tbond(i,j).NE.0).AND.(tbond(i,j).NE.3)) THEN nbnei(i)=nbnei(i)+1 !number of neighbours neigh(i,nbnei(i))=tgroup(j) !groups of neighbours nei_ind(i,nbnei(i))=j ENDIF ENDDO ENDDO DO i=1,nca DO j=1,nca IF ((tbond(i,j).EQ.1).AND.(nodetype(i).NE.'d').AND. & (nodetype(j).NE.'d')) THEN IF ((nbnei(i).EQ.2).AND.(nbnei(j).EQ.4)) THEN IF ((nodetype(nei_ind(i,1)).EQ.'d').OR. & (nodetype(nei_ind(i,2)).EQ.'d')) THEN Nangroup(130) = Nangroup(130) + 0.5 ENDIF ELSE IF ((nbnei(i).EQ.4).AND.(nbnei(j).EQ.2)) THEN IF ((nodetype(nei_ind(j,1)).EQ.'d').OR. & (nodetype(nei_ind(j,2)).EQ.'d')) THEN Nangroup(130) = Nangroup(130) + 0.5 ENDIF ENDIF IF ((nbnei(i).EQ.3).AND.(nbnei(j).EQ.3)) THEN Nangroup(131) = Nangroup(131) + 0.5 ELSE ntot=nbnei(i)+nbnei(j) IF (ntot.EQ.7) Nangroup(132) = Nangroup(132) + 0.5 IF (ntot.EQ.8) Nangroup(133) = Nangroup(133) + 0.5 ENDIF ENDIF ENDDO ENDDO DO i=1,nca IF ((nodetype(i).EQ.'d').AND.(nbnei(i).EQ.2).AND. & (nodetype(nei_ind(i,1)).EQ.'d').AND. & (nodetype(nei_ind(i,2)).EQ.'d').AND. & (tbond(i,nei_ind(i,1)).EQ.2).AND. & (tbond(i,nei_ind(i,2)).EQ.2)) THEN Nangroup(87) = Nangroup(87) + 1 Nangroup(58) = Nangroup(58) - 1 ENDIF ENDDO ********************************************************** * group contributions * ********************************************************** sumgroup(1)=Nangroup(33)+Nangroup(34)+Nangroup(35) & +Nangroup(36)+Nangroup(37) & +Nangroup(214) c & +Nangroup(215)+Nangroup(216)+Nangroup(217)+Nangroup(218) sumgroup(2)=Nangroup(37) sumgroup(3)=Nangroup(44)+Nangroup(219) sumgroup(4)=Nangroup(38) sumgroup(5)=Nangroup(39) sumgroup(6)=Nangroup(45)+Nangroup(46)+Nangroup(47) sumgroup(7)=Nangroup(51)+Nangroup(92) sumgroup(8)=Nangroup(52)+Nangroup(90) sumgroup(9)=Nangroup(65) sumgroup(10)=Nangroup(54) sumgroup(11)=Nangroup(56) sumgroup(12)=Nangroup(53) sumgroup(13)=Nangroup(40)+Nangroup(41) sumgroup(14)=Nangroup(42)+Nangroup(97) sumgroup(15)=Nangroup(80) sumgroup(16)=Nangroup(57) sumgroup(17)=Nangroup(69) sumgroup(18)=Nangroup(66) sumgroup(19)=Nangroup(67) IF (sumgroup(1).NE.0) THEN !OH interactions IF (sumgroup(1).GT.1) THEN Nangroup(135)=sumgroup(1)*(sumgroup(1)-1) ENDIF IF (sumgroup(3).NE.0) THEN Nangroup(139)=sumgroup(1)*sumgroup(3)*2 ENDIF IF (sumgroup(4).NE.0) THEN Nangroup(140)=sumgroup(1)*sumgroup(4)*2 ENDIF IF (sumgroup(6).NE.0) THEN Nangroup(142)=sumgroup(1)*sumgroup(6)*2 ENDIF IF (sumgroup(7).NE.0) THEN Nangroup(143)=sumgroup(1)*sumgroup(7)*2 ENDIF IF (sumgroup(9).NE.0) THEN Nangroup(146)=sumgroup(1)*sumgroup(9)*2 ENDIF ENDIF IF (sumgroup(3).NE.0) THEN !CO(OH) interactions IF (sumgroup(3).GT.1) THEN Nangroup(172)=sumgroup(3)*(sumgroup(3)-1) ENDIF IF (sumgroup(4).NE.0) THEN Nangroup(173)=sumgroup(3)*sumgroup(4)*2 ENDIF IF (sumgroup(6).NE.0) THEN Nangroup(174)=sumgroup(3)*sumgroup(6)*2 ENDIF IF (sumgroup(7).NE.0) THEN Nangroup(175)=sumgroup(3)*sumgroup(7)*2 ENDIF ENDIF IF (sumgroup(4).NE.0) THEN ! -O- interactions IF (sumgroup(4).GT.1) THEN Nangroup(178)=sumgroup(4)*(sumgroup(4)-1) ENDIF IF (sumgroup(6).NE.0) THEN Nangroup(180)=sumgroup(4)*sumgroup(6)*2 ENDIF IF (sumgroup(7).NE.0) THEN Nangroup(181)=sumgroup(4)*sumgroup(7)*2 ENDIF IF (sumgroup(8).NE.0) THEN Nangroup(182)=sumgroup(4)*sumgroup(8)*2 ENDIF IF (sumgroup(9).NE.0) THEN Nangroup(186)=sumgroup(4)*sumgroup(9)*2 ENDIF ENDIF IF (sumgroup(6).NE.0) THEN ! ester interactions IF (sumgroup(6).GT.1) THEN Nangroup(189)=sumgroup(6)*(sumgroup(6)-1) ENDIF IF (sumgroup(7).NE.0) THEN Nangroup(190)=sumgroup(6)*sumgroup(7)*2 ENDIF IF (sumgroup(9).NE.0) THEN Nangroup(193)=sumgroup(6)*sumgroup(9)*2 ENDIF ENDIF IF (sumgroup(7).NE.0) THEN ! carbonyles interactions IF (sumgroup(7).GT.1) THEN Nangroup(194)=sumgroup(7)*(sumgroup(7)-1) ENDIF IF (sumgroup(8).NE.0) THEN Nangroup(195)=sumgroup(8)*sumgroup(7)*2 ENDIF IF (sumgroup(9).NE.0) THEN Nangroup(199)=sumgroup(9)*sumgroup(7)*2 ENDIF ENDIF IF (sumgroup(8).NE.0) THEN ! aldehydes interactions IF (sumgroup(8).GT.1) THEN Nangroup(201)=sumgroup(8)*(sumgroup(8)-1) ENDIF IF (sumgroup(9).NE.0) THEN Nangroup(204)=sumgroup(8)*sumgroup(9)*2 ENDIF ENDIF ********************************************************** * compute GI * ********************************************************** 987 CONTINUE sum1=0. sum2=0 DO i=135,212 IF (Nangroup(i).GT.0) THEN sum1=sum1+Nangroup(i) sum2=sum2+Nangroup(i)*contrib(i) ENDIF ENDDO sum1=sum1-1 IF (sum1.LT.1) THEN GI=0. ELSE GI=(1./nbatom)*(sum2/sum1) ENDIF ********************************************************** * screen printing for tests * ********************************************************** ! DO i=1,219 ! IF (Nangroup(i).NE.0) THEN ! WRITE(6,*) 'Nangroup(',i,')=',Nangroup(i) ! ENDIF ! ENDDO ********************************************************** * check errors * ********************************************************** DO i=1,219 IF (Nangroup(i).LT.0) THEN WRITE(6,*) '--error in nannoolal_tb.f --' WRITE(6,*) 'Nangroup !negatif - see fort.43' WRITE(6,*) 'Nangroup(',i,')=',Nangroup(i) !WRITE(43,*) 'chem=',chem(1:50) DO j=1,219 IF (Nangroup(j).NE.0) THEN WRITE(43,*) 'Nangroup(',j,')=',Nangroup(j) ENDIF ENDDO STOP ENDIF sum=Nangroup(i)*2 IF (mod(sum,2.).NE.0) THEN WRITE(6,*) '--error in nannoolal_tb.f --' WRITE(6,*) 'number on Nangroup not an integer' WRITE(6,*) 'Nangroup(',i,')=',Nangroup(i) WRITE(6,*) 'chem=',chem(1:50) DO j=1,219 IF (Nangroup(j).NE.0) THEN WRITE(6,*) 'Nangroup(',j,')=',Nangroup(j) ENDIF ENDDO STOP ENDIF ENDDO ********************************************************** * compute Tb * ********************************************************** sum=0. DO i=1,134 IF (Nangroup(i).NE.0) THEN sum=sum+Nangroup(i)*contrib(i) ENDIF ENDDO DO i=213,219 IF (Nangroup(i).NE.0) THEN sum=sum+Nangroup(i)*contrib(i) ENDIF ENDDO sum=sum+GI Tb=(sum/(nbatom**0.6583 + 1.6868))+84.3395 ******************************* CALL rjgadd(nring,tgroup,rjg) !STOP RETURN END