SUBROUTINE nuklefithi(t,rh,rhoa,x,nwc,nac,rc,jnuc) ! calculates binary nucleation rate using revised theory, stauffer+binder&stauffer kinetics ! and noppel hydrate correction ! t temperature [K] ! rh relative humidity %/100 ! rhow concentration of water vapour [1/m^3] ! rha relative acidity %/100 ! rhoa concentration of h2so4 vapour [1/m^3] ! x mole fraction in teh core of the critical cluster ! nwtot total number of water molecules in the critical cluster ! natot total number of h2so4 molecules in the critical cluster ! rc radius of the critical cluster core [m] ! jnuc nucleation rate [1/m^3s] USE real16 USE constants USE hydrates IMPLICIT NONE INTEGER j1 REAL(REAL_16) :: t,rh,rhow,rha,rhoa,x,rc,vc,jnuc, jnuc2 real(real_16) :: ntot,nwc,nac ! validity: ! t = 300.15K - 400.15K ! rh = 0.01 - 1 (1% - 100%) ! rhoa = 2*10^15 - 5*10^21 /m^3 (2*10^9 - 5*10^15/cm^3) ! jnuc = 10^-1 - 10^14/(cm^3s) ! ntot >= 4 ! make sure that you check also this, otherwise results can be rubbish!! ! x>=0.15 ! make sure that you check also this, otherwise results can be rubbish!! !hi temp x= 0.847011529956499 - 0.002965596681859677*t + & & 0.05926531222362889*Log(rh) - 0.0003631920982114802*t*Log(rh) + & & 0.02300735131008404*Log(rh)**2 - 0.0000851373757047879*t*Log(rh)**2 + & & 0.002174171592972587*Log(rh)**3 - 7.923002731097429e-6*t*Log(rh)**3 - & & 0.006622663242677592*Log(rhoa/1.e6) + & & 0.00005878351930618956*t*Log(rhoa/1.e6) jnuc= -0.001569745387175332 - 0.1342450856797245*t + & & 0.1005067182690175*t**2 - 0.0004601032625944248*t**3 + & & 0.1874155345616552/x**2 + 0.0104122021949141/x + & & 0.001950770887486148*Log(rh) + 0.1680380731937475*t*Log(rh) - & & 0.02257545214945428*t**2*Log(rh) + & & 0.0000827148525354003*t**3*Log(rh) + & & (0.002502896602782628*Log(rh))/x**2 + & & (0.01552154487373872*Log(rh))/x + 0.000154083599132041*Log(rh)**2 - & & 0.02803005713673646*t*Log(rh)**2 + & & 0.001545869791064423*t**2*Log(rh)**2 - & & 4.527012995558728e-6*t**3*Log(rh)**2 + & & (0.0915323112970841*Log(rh)**2)/x**2 + & & (0.07116518392455503*Log(rh)**2)/x - & & 0.005092666464919691*Log(rh)**3 - 0.0079684608373626*t*Log(rh)**3 + & & 0.00004468280779999966*t**2*Log(rh)**3 - & & 8.79425326170835e-8*t**3*Log(rh)**3 + & & (0.1339909859611695*Log(rh)**3)/x**2 + & & (0.831112029665779*Log(rh)**3)/x - & & 0.02272226993056786*Log(rhoa/1.e6) - & & 1.565123155966037*t*Log(rhoa/1.e6) + & & 0.003807170798570766*t**2*Log(rhoa/1.e6) + & & 0.00001641085384332953*t**3*Log(rhoa/1.e6) + & & (1.294987606109814*Log(rhoa/1.e6))/x**2 + & & (0.04748213867867968*Log(rhoa/1.e6))/x + & & 0.003106456643285619*Log(rh)*Log(rhoa/1.e6) + & & 0.3045177689813154*t*Log(rh)*Log(rhoa/1.e6) - & & 0.0005640120058411354*t**2*Log(rh)*Log(rhoa/1.e6) - & & 2.032666211033406e-6*t**3*Log(rh)*Log(rhoa/1.e6) - & & (0.3515835365109146*Log(rh)*Log(rhoa/1.e6))/x**2 + & & (0.1037494194279776*Log(rh)*Log(rhoa/1.e6))/x + & & 0.07754300076253439*Log(rh)**2*Log(rhoa/1.e6) - & & 0.001963146205019902*t*Log(rh)**2*Log(rhoa/1.e6) - & & 0.00001304119073568482*t**2*Log(rh)**2*Log(rhoa/1.e6) + & & 6.623693300681445e-8*t**3*Log(rh)**2*Log(rhoa/1.e6) + & & (0.01134695792517722*Log(rh)**2*Log(rhoa/1.e6))/x**2 + & & (0.0972804474950142*Log(rh)**2*Log(rhoa/1.e6))/x - & & 0.1531427628782814*Log(rhoa/1.e6)**2 + & & 0.05753924492517699*t*Log(rhoa/1.e6)**2 - & & 0.0003065107065724253*t**2*Log(rhoa/1.e6)**2 - & & 2.960965968850208e-8*t**3*Log(rhoa/1.e6)**2 - & & (0.0982514182025573*Log(rhoa/1.e6)**2)/x**2 + & & (0.3362860198323058*Log(rhoa/1.e6)**2)/x - & & 0.5521732040508044*Log(rh)*Log(rhoa/1.e6)**2 - & & 0.002070431390446516*t*Log(rh)*Log(rhoa/1.e6)**2 + & & 0.00001440324612102496*t**2*Log(rh)*Log(rhoa/1.e6)**2 + & & 8.83000427843853e-9*t**3*Log(rh)*Log(rhoa/1.e6)**2 + & & (0.01198331714250616*Log(rh)*Log(rhoa/1.e6)**2)/x**2 - & & (0.07000246307134552*Log(rh)*Log(rhoa/1.e6)**2)/x + & & 0.1265442035303987*Log(rhoa/1.e6)**3 - & & 0.001360286418822358*t*Log(rhoa/1.e6)**3 + & & 5.905978942513288e-6*t**2*Log(rhoa/1.e6)**3 - & & 4.171501234425879e-9*t**3*Log(rhoa/1.e6)**3 + & & (0.001708065264911778*Log(rhoa/1.e6)**3)/x**2 - & & (0.006432296088358141*Log(rhoa/1.e6)**3)/x ntot= 7.510239772212755e-6 + 0.0005020543717858126*t - & & 0.00003686018555428167*t**2 + 1.082558571899109e-6*t**3 - & & 0.0002702823459545526/x - 4.300475182632171e-6*Log(rh) - & & 0.000730132746532732*t*Log(rh) + 0.0002520622067147548*t**2*Log(rh) - & & 1.016483987242821e-6*t**3*Log(rh) - & & (0.001142825737843263*Log(rh))/x - 4.421559550727262e-6*Log(rh)**2 - & & 0.002348602119724249*t*Log(rh)**2 + & & 3.00649923314284e-7*t**2*Log(rh)**2 + & & 2.447973651342882e-8*t**3*Log(rh)**2 - & & (0.002502258291246978*Log(rh)**2)/x - & & 0.0001670569160183319*Log(rh)**3 + & & 0.0002075039029766036*t*Log(rh)**3 - & & 1.130128595080389e-6*t**2*Log(rh)**3 + & & 1.802682362218632e-9*t**3*Log(rh)**3 - & & (0.0168244622970241*Log(rh)**3)/x + & & 0.0000985954120966784*Log(rhoa/1.e6) + & & 0.004512847128248536*t*Log(rhoa/1.e6) - & & 0.000051255749468906*t**2*Log(rhoa/1.e6) + & & 4.607487783359696e-8*t**3*Log(rhoa/1.e6) - & & (0.002143177270467462*Log(rhoa/1.e6))/x + & & 0.00006365278270556093*Log(rh)*Log(rhoa/1.e6) - & & 0.002885292129285572*t*Log(rh)*Log(rhoa/1.e6) + & & 6.51706496257436e-6*t**2*Log(rh)*Log(rhoa/1.e6) + & & 2.326013038006477e-8*t**3*Log(rh)*Log(rhoa/1.e6) - & & (0.01103185560619721*Log(rh)*Log(rhoa/1.e6))/x + & & 0.0004492390899906145*Log(rh)**2*Log(rhoa/1.e6) + & & 0.00006894159835203836*t*Log(rh)**2*Log(rhoa/1.e6) - & & 3.503018074400659e-7*t**2*Log(rh)**2*Log(rhoa/1.e6) + & & 1.07451436139538e-10*t**3*Log(rh)**2*Log(rhoa/1.e6) + & & (0.00169646418409145*Log(rh)**2*Log(rhoa/1.e6))/x + & & 0.000831843754899915*Log(rhoa/1.e6)**2 - & & 5.351078116383922e-6*t*Log(rhoa/1.e6)**2 + & & 1.664320030743163e-6*t**2*Log(rhoa/1.e6)**2 - & & 3.051079180252276e-9*t**3*Log(rhoa/1.e6)**2 - & & (0.0003062512887774901*Log(rhoa/1.e6)**2)/x + & & 0.003553741933599263*Log(rh)*Log(rhoa/1.e6)**2 + & & 0.0000306009050550714*t*Log(rh)*Log(rhoa/1.e6)**2 - & & 2.110041590842608e-7*t**2*Log(rh)*Log(rhoa/1.e6)**2 - & & 2.114356501960609e-11*t**3*Log(rh)*Log(rhoa/1.e6)**2 + & & (0.0007498898835321218*Log(rh)*Log(rhoa/1.e6)**2)/x - & & 0.00143534432169805*Log(rhoa/1.e6)**3 + & & 7.855995385362244e-6*t*Log(rhoa/1.e6)**3 - & & 3.45127705481677e-8*t**2*Log(rhoa/1.e6)**3 + & & 5.215472343422993e-11*t**3*Log(rhoa/1.e6)**3 - & & (0.00002142302928436071*Log(rhoa/1.e6)**3)/x ntot=exp(ntot) nac =x*ntot nwc =(1.-x)*ntot rc=exp(-1.6525507+0.45852848*x+0.33483673*log(ntot)) rc=rc*1.e-9 jnuc=exp(jnuc)*1.e6 jnuc2=jnuc RETURN END SUBROUTINE nuklefithi