subroutine oznot(lamda,iofset,ilat,xlat,clfrac,ref, 1 grref,clref,pteran,pcloud,xnval,ozonin,fteran,ramcor, 2 frstoz,lprint,skipit,iplow,iphigh,dnd318,estozn) c c*********************************************************************** c c oznot c c september, 2001 by charlie wellemeyer of ssai c c purpose c computes initial ozone estimate using the 317.5 channel c c method c selects table interp. indices and computes offset address c into tables. on first call, brackets measured n-value with c table n-values, computes total ozone by linear interpolation using c the sensitivity dndx. on subsequent calls, the initial bracketting c is re-used. c c variables c name type i/o description c ---- ---- --- ------------ c c arguments c lamda i*4 i index of first wavelength c iofset i*4 i offset index for table interps c xlat r*4 i latitude c clfrac r*4 i fractional cloud cover calculated from reflec c ref r*4 i calculated reflectivity c grref r*4 i reflectivity of the ground c clref r*4 i reflectivity of clouds c pteran r*4 i terrain pressure c pcloud r*4 i cloud pressure c xnval(12) r*4 i single wavelength n-values c ozonin r*4 i last sample's ozone estimate c fteran r*4 i fractional terrain factor c ramcor r*4 i raman scattering correction c frstoz l*4 i equals .true. for the first call to oznot c lprint l*4 i if = .true., print c iplow i*4 i/o profile index at low bound c iphigh i*4 i/o profile index at high bound c dnd318 r*4 o sensitivity for estimate c estozn r*4 o total ozone estimate c c internal c ilow i*4 low index corresponding to latitude band c (1 for low, 9 for high) c ihigh i*4 high index corresponding to latitude band c (8 for low, 12 for high) c xlown r*4 n value a low bound c xhighn r*4 n value a high bound c iplow i*4 profile index at low bound c iphigh i*4 profile index at high bound c qval r*4 q value at ozone sensitive wavelength c xnvalm r*4 measured 318 nm nvalue c xnvalc r*4 calculated 318 nm nvalue c terroz r*4 Layer 0 ozone amounts for standard profiles c c*********************************************************************** c implicit none c -- input parameters real xlat, clfrac, ref, grref, clref, xnval(12), 1 ozonin, fteran, pteran, pcloud, xnvalm real ramcor(9,6) integer lamda, iofset(12), ilat, iloprf, ihiprf logical lprint(30),skipit c -- internal parameters real xlown, xhighn, dnd318 real oznind, rmcrgr, rmcrcl real ezgr, ssgr, tgr, sbgr, ezcl, sscl, tcl, sbcl real radgr,radcl,xnvalc, omeglo, omeghi, qval logical frstoz integer ihigh(3),ilow(3), iprofl, iplow, iphigh, ioz integer ninter c -- output parameters real estozn c -- common area and data statements include 'stndprof.com' data ilow/1,4,12/, ihigh/3,11,21/ c c -- determine profile indices c iloprf = iplow ihiprf = iphigh c if (lprint(17)) then write (6,1000) lamda, iofset(1), xlat write (6,1100) clfrac, ref, grref, clref, 1 pteran, pcloud, xnval(lamda), 1 ozonin, fteran endif c c -- load in measured n value c xnvalm = xnval(lamda) c c -- initialize bracketing values c xlown=0.0 xhighn=0.0 c c for first call, use nvbrac to establish bracketting profiles c if (frstoz) then c c -- determine i0, tr, and sb for wavelength lamda c -- at terrain height and cloud height at next ozone node c 100 continue c iprofl = iloprf - 1 call iztrsb(lamda,xlat,iprofl,pteran,pcloud, 1 iofset(lamda),lprint,ezgr,ssgr,tgr,sbgr,ezcl,sscl,tcl,sbcl) c c -- calculate raman corrections for ground and cloud c call getrng(lamda,pteran,pcloud,grref,clref,ramcor,lprint, 1 rmcrgr,rmcrcl) c c -- determine calculated n value for ozone wavelength c -- for clear, cloudy, or partially cloudy cases c if (clfrac.le.0.) then radgr = ezgr+ref*tgr/(1.0-ref*sbgr) radgr = radgr + radgr * rmcrgr xnvalc=-1.0*alog10(radgr) else if (clfrac.ge.1.) then radcl = ezcl+ref*tcl/(1.0-ref*sbcl) radcl = radcl + radcl * rmcrcl xnvalc=-1.0*alog10(radcl) else radgr=ezgr+grref*tgr/(1.0-grref*sbgr) radgr = radgr + radgr * rmcrgr radcl=ezcl+clref*tcl/(1.0-clref*sbcl) radcl = radcl + radcl * rmcrcl xnvalc=-1.0*alog10(clfrac*radcl+(1.0-clfrac)*radgr) endif c c perform n-value bracketting c call nvbrac(xnvalm,xnvalc,ilow(ilat),ihigh(ilat), 1 lprint,skipit,iloprf,xlown,xhighn,iplow,iphigh) c if (xhighn.eq.0.0 .or. xlown.eq.0.0) go to 100 c c -- bracketting table lookups complete, compute ozone c else c c for subsequent calls, use bracketting profiles defined in first call c iprofl = iloprf - 1 do 200 ioz=1,2 c c -- determine i0, tr, and sb for wavelength lamda c -- at terrain height and cloud height at two ozone nodes c call iztrsb(lamda,xlat,iprofl,pteran,pcloud, 1 iofset(lamda),lprint,ezgr,ssgr,tgr,sbgr,ezcl,sscl,tcl,sbcl) c c -- calculate raman corrections for ground and cloud c call getrng(lamda,pteran,pcloud,grref,clref,ramcor,lprint, 1 rmcrgr,rmcrcl) c c -- determine calculated n value for ozone wavelength c -- for clear, cloudy, or partially cloudy cases c if (clfrac.le.0.) then radgr = ezgr+ref*tgr/(1.0-ref*sbgr) radgr = radgr + radgr * rmcrgr xnvalc=-1.0*alog10(radgr) else if (clfrac.ge.1.) then radcl = ezcl+ref*tcl/(1.0-ref*sbcl) radcl = radcl + radcl * rmcrcl xnvalc=-1.0*alog10(radcl) else radgr=ezgr+grref*tgr/(1.0-grref*sbgr) radgr = radgr + radgr * rmcrgr radcl=ezcl+clref*tcl/(1.0-clref*sbcl) radcl = radcl + radcl * rmcrcl xnvalc=-1.0*alog10(clfrac*radcl+(1.0-clfrac)*radgr) endif c c -- store interpolation points c if(ioz.eq.1) then xlown = xnvalc iplow = iprofl + 1 iprofl = iprofl + 1 else xhighn = xnvalc iphigh = iprofl + 1 endif c 200 continue c endif c c -- table lookups complete, compute ozone c omeghi = profl(iphigh) - terroz(iphigh)*fteran omeglo = profl(iplow) - terroz(iplow)*fteran dnd318 = 100.*(xhighn-xlown) / (omeghi-omeglo) estozn = omeglo + 100.*(xnvalm-xlown)/dnd318 c if (lprint(17)) write (6,1200) xlown, 1 xhighn, xnvalc, xnvalm, qval if (lprint(17)) write (6,1300) omeglo, 1 omeghi, estozn, dnd318 c return c c formats c 1000 format (/'Subroutine oznot'/'Input: lamda = ',i8, 1 ' iofset = ',i8/,' xlat = ',f8.2) 1100 format (' clfrac = ',f8.4,' ref = ',f8.4, 1 ' grref = ',f8.4,' clref = ',f8.4,/, 2 ' pteran = ',f8.4,' pcloud = ',f8.4,' xnvalm = ',f8.4/ 2 ' ozonin = ',f8.2,' fteran = ',f8.4) 1200 format ('Intern: xlown = ',f8.4,' xhighn = ',f8.4, 1 ' xnvalc = ',f8.4,' xnvalm = ',f8.4 2 /' qval = ',f8.4) 1300 format ('Output: omeglo = ',f8.2,' omeghi = ',f8.2, 1 ' estozn = ',f8.2,' dnd318 = ',f8.4) c end