program binatesti77 implicit none real t,rh,rhoa,j,x,ntot,r t = 248.15 rh = 0.5 rhoa = 1.0e1 call binapara77(t,rh,rhoa,j,x,ntot,r) print *,t print *,rh print *,rhoa print *,j print *,x print *,ntot print *,r end program binatesti77 SUBROUTINE binapara77(t,rh,rhoa,jnuc,x,ntot,rc) c Fortran 77 subroutine binapara c c Calculates parametrized values of nucleation rate, c mole fraction of sulphuric acid c total number of particles, and the radius of the critical cluster c in H2O-H2SO4 system if temperature, saturatio ratio of water and c sulfuric acid concentration are given. c c Copyright (C) 2002 Hanna Vehkamäki c c Division of Atmospheric Sciences c Department of Physical Sciences c P.O. Box 64 c FIN-00014 University of Helsinki c Finland c c hanna.vehkamaki@helsinki.fi IMPLICIT NONE real t real rh real rhoa real jnuc real ntot real x real rc real rhotres c t: temperature in K (190.15-300.15K) c rh: saturatio ratio of water (0.0001-1) c rhoa: sulfuric acid concentration in 1/cm3 (10^4-10^11 1/cm3) c jnuc: nucleation rate in 1/cm3s (10^-7-10^10 1/cm3s) c ntot: total number of molecules in the critical cluster (ntot>4) c x: molefraction of H2SO4 in the critical cluster c rc: radius of the critical cluster in nm c rhotres: treshold concentration of h2so4 (1/cm^3) c which produces nucleation rate 1/(cm^3 s) as a function of rh and t if(t .lt. 190.15) then print *,'Warning: temperature < 190.15 K, using 190.15 K' t=190.15 end if if(t .gt. 300.15) then print *,'Warning: temperature > 300.15 K, using 300.15 K' t=300.15 end if if(rh .lt. 0.0001) then print *,'Warning: saturation ratio of water < 0.0001,', & ' using 0.0001' rh=0.0001 end if if(rh .gt. 1.0) then print *,'Warning: saturation ratioof water > 1 using 1' rh=1.0 end if if(rhoa .lt. 1.e4) then print *,'Warning: sulfuric acid concentration < 1e4 1/cm3,', & ' using 1e4 1/cm3' rhoa=1.e4 end if if(rhoa .gt. 1.e11) then print *,'Warning: sulfuric acid concentration > 1e11 1/cm3,', & ' using 1e11 1/cm3' rhoa=1.e11 end if x= 0.7409967177282139 - 0.002663785665140117*t & + 0.002010478847383187*Log(rh) & - 0.0001832894131464668*t*Log(rh) & + 0.001574072538464286*Log(rh)**2 & - 0.00001790589121766952*t*Log(rh)**2 & + 0.0001844027436573778*Log(rh)**3 & - 1.503452308794887e-6*t*Log(rh)**3 & - 0.003499978417957668*Log(rhoa) & + 0.0000504021689382576*t*Log(rhoa) jnuc= 0.1430901615568665 + 2.219563673425199*t - & 0.02739106114964264*t**2 + & 0.00007228107239317088*t**3 + 5.91822263375044/x + & 0.1174886643003278*Log(rh) + 0.4625315047693772*t*Log(rh) - & 0.01180591129059253*t**2*Log(rh) + & 0.0000404196487152575*t**3*Log(rh) + & (15.79628615047088*Log(rh))/x - & 0.215553951893509*Log(rh)**2 - & 0.0810269192332194*t*Log(rh)**2 + & 0.001435808434184642*t**2*Log(rh)**2 - & 4.775796947178588e-6*t**3*Log(rh)**2 - & (2.912974063702185*Log(rh)**2)/x - & 3.588557942822751*Log(rh)**3 + & 0.04950795302831703*t*Log(rh)**3 - & 0.0002138195118737068*t**2*Log(rh)**3 + & 3.108005107949533e-7*t**3*Log(rh)**3 - & (0.02933332747098296*Log(rh)**3)/x + & 1.145983818561277*Log(rhoa) - & 0.6007956227856778*t*Log(rhoa) + & 0.00864244733283759*t**2*Log(rhoa) - & 0.00002289467254710888*t**3*Log(rhoa) - & (8.44984513869014*Log(rhoa))/x + & 2.158548369286559*Log(rh)*Log(rhoa) + & 0.0808121412840917*t*Log(rh)*Log(rhoa) - & 0.0004073815255395214*t**2*Log(rh)*Log(rhoa) - & 4.019572560156515e-7*t**3*Log(rh)*Log(rhoa) + & (0.7213255852557236*Log(rh)*Log(rhoa))/x + & 1.62409850488771*Log(rh)**2*Log(rhoa) - & 0.01601062035325362*t*Log(rh)**2*Log(rhoa) + & 0.00003771238979714162*t**2*Log(rh)**2*Log(rhoa) + & 3.217942606371182e-8*t**3*Log(rh)**2*Log(rhoa) - & (0.01132550810022116*Log(rh)**2*Log(rhoa))/x + & 9.71681713056504*Log(rhoa)**2 - & 0.1150478558347306*t*Log(rhoa)**2 + & 0.0001570982486038294*t**2*Log(rhoa)**2 + & 4.009144680125015e-7*t**3*Log(rhoa)**2 + & (0.7118597859976135*Log(rhoa)**2)/x - & 1.056105824379897*Log(rh)*Log(rhoa)**2 + & 0.00903377584628419*t*Log(rh)*Log(rhoa)**2 - & 0.00001984167387090606*t**2*Log(rh)*Log(rhoa)**2 + & 2.460478196482179e-8*t**3*Log(rh)*Log(rhoa)**2 - & (0.05790872906645181*Log(rh)*Log(rhoa)**2)/x - & 0.1487119673397459*Log(rhoa)**3 + & 0.002835082097822667*t*Log(rhoa)**3 - & 9.24618825471694e-6*t**2*Log(rhoa)**3 + & 5.004267665960894e-9*t**3*Log(rhoa)**3 - & (0.01270805101481648*Log(rhoa)**3)/x jnuc=exp(jnuc) c 1/(cm3s) ntot =-0.002954125078716302 - 0.0976834264241286*t + & 0.001024847927067835*t**2 - 2.186459697726116e-6*t**3 - & 0.1017165718716887/x - 0.002050640345231486*Log(rh) - & 0.007585041382707174*t*Log(rh) + & 0.0001926539658089536*t**2*Log(rh) - & 6.70429719683894e-7*t**3*Log(rh) - & (0.2557744774673163*Log(rh))/x + & 0.003223076552477191*Log(rh)**2 + & 0.000852636632240633*t*Log(rh)**2 - & 0.00001547571354871789*t**2*Log(rh)**2 + & 5.666608424980593e-8*t**3*Log(rh)**2 + & (0.03384437400744206*Log(rh)**2)/x + & 0.04743226764572505*Log(rh)**3 - & 0.0006251042204583412*t*Log(rh)**3 + & 2.650663328519478e-6*t**2*Log(rh)**3 - & 3.674710848763778e-9*t**3*Log(rh)**3 - & (0.0002672510825259393*Log(rh)**3)/x - & 0.01252108546759328*Log(rhoa) + & 0.005806550506277202*t*Log(rhoa) - & 0.0001016735312443444*t**2*Log(rhoa) + & 2.881946187214505e-7*t**3*Log(rhoa) + & (0.0942243379396279*Log(rhoa))/x - & 0.0385459592773097*Log(rh)*Log(rhoa) - & 0.0006723156277391984*t*Log(rh)*Log(rhoa) + & 2.602884877659698e-6*t**2*Log(rh)*Log(rhoa) + & 1.194163699688297e-8*t**3*Log(rh)*Log(rhoa) - & (0.00851515345806281*Log(rh)*Log(rhoa))/x - & 0.01837488495738111*Log(rh)**2*Log(rhoa) + & 0.0001720723574407498*t*Log(rh)**2*Log(rhoa) - & 3.717657974086814e-7*t**2*Log(rh)**2*Log(rhoa) - & 5.148746022615196e-10*t**3*Log(rh)**2*Log(rhoa) + & (0.0002686602132926594*Log(rh)**2*Log(rhoa))/x - & 0.06199739728812199*Log(rhoa)**2 + & 0.000906958053583576*t*Log(rhoa)**2 - & 9.11727926129757e-7*t**2*Log(rhoa)**2 - & 5.367963396508457e-9*t**3*Log(rhoa)**2 - & (0.007742343393937707*Log(rhoa)**2)/x + & 0.0121827103101659*Log(rh)*Log(rhoa)**2 - & 0.0001066499571188091*t*Log(rh)*Log(rhoa)**2 + & 2.534598655067518e-7*t**2*Log(rh)*Log(rhoa)**2 - & 3.635186504599571e-10*t**3*Log(rh)*Log(rhoa)**2 + & (0.0006100650851863252*Log(rh)*Log(rhoa)**2)/x + & 0.0003201836700403512*Log(rhoa)**3 - & 0.0000174761713262546*t*Log(rhoa)**3 + & 6.065037668052182e-8*t**2*Log(rhoa)**3 - & 1.421771723004557e-11*t**3*Log(rhoa)**3 + & (0.0001357509859501723*Log(rhoa)**3)/x ntot=exp(ntot) rc=exp(-1.6524245+0.42316402*x+0.33466487*log(ntot)) C nm if(ntot .lt. 4.0 ) then if ( t .lt. 195.15) then print *,'Warning: critical cluster < 4 molecules', & ' and T<195.15 : rough estimate J=1e5/(cm3s)' jnuc=1.e5 else print *,'Warning: critical cluster < 4 molecules:', & ' accuracy of the parameterisation reduced,', & ' J_theor/J_para up to 50' end if end if if(jnuc .lt. 1.e-7) then print *,'Warning: nucleation rate < 1e-7/cm3s,', & ' using 0.0/cm3s' jnuc=0.0 end if if(jnuc .gt. 1.e10) then print *,'Warning: nucleation rate > 1e6/cm3s,', & ' using 1e10/cm3s' jnuc=1.e10 end if rhotres=exp( -279.2430007512709 + 11.73439886096903*rh & + 22700.92970508331/t & - (1088.644983466801*rh)/t + 1.144362942094912*t & - 0.03023314602163684*rh*t - 0.001302541390154324*t**2 & - 6.386965238433532*Log(rh) + (854.980361026715*Log(rh))/t & + 0.00879662256826497*t*Log(rh)) c 1/cm3 RETURN END SUBROUTINE binapara77