function taucloud(sza,az,sat,pt,rs,rad) c c author: ed celarier c procedure name: taucloud c procedure type: fortran function c version date: 27.vi.97 c c purpose: c calculates the putative cloud optical thickness for a particular c viewing geometry, and for a terrain of a certain pressure and c reflectivity, given the toms-measured radiance in one of the c reflectivity channels. c c calling parameters: c name type i/o units description c -------- ---- --- ----- -------------- c taucloud r8 o calculated putative cloud optical c thickness c sza r8 i deg solar zenith angle c az r8 i deg solar-fov-satellite azimuth c sat r8 i deg satellite zenith angle c pt r8 i atm terrain surface pressure c rs r8 i frac surface reflectivity c rad r8 i i/f toms-measured radiance c c external routines required: c radlow calculates pairs (tcl, radiance) for low tcl. c radhigh calculates pairs (tcl, radiance) for high tcl. c lagrangeco calculates order and coefficients for lagrange c polynomial interpolation. c c notes & caveats: c c revision history: c c============================================================================ implicit none integer*4 ntcl_l parameter(ntcl_l=5) integer*4 ntcl_h parameter(ntcl_h=6) c -- calling parameters real*8 taucloud,sza,az,sat,pt,rs,rad c -- local variables real*8 outrad(0:ntcl_l+ntcl_h-1), tcl(0:ntcl_l+ntcl_h-1) real*8 outrad_l(0:ntcl_l-1), outrad_h(0:ntcl_h-1) real*8 outtcl_l(0:ntcl_l-1), outtcl_h(0:ntcl_h-1) equivalence(outrad_l(0), outrad(0)) equivalence(outrad_h(0), outrad(ntcl_l)) equivalence(outtcl_l(0), tcl(0)) equivalence(outtcl_h(0), tcl(ntcl_l)) integer*4 i0, deg, nout_l, nout_h, i, inrange real*8 coef(0:3), sum logical success c call radlow(rs,sza,az,sat,pt,outrad_l,outtcl_l,nout_l,success) if(.not.success) return if (rad .le. outrad_l(nout_l-1)) then if (rad .le. outrad_l(0)) then taucloud= 0.d0 return endif call lagrangeco(rad,outrad,nout_l, i0,deg,coef,inrange) else call radhigh(sza,az,sat,rs,outrad_h,outtcl_h,nout_h,success) if (.not.success) return if (rad .gt. outrad_h(nout_h-1)) then taucloud= 100.d0 return endif call lagrangeco(rad,outrad,nout_l+nout_h,i0,deg,coef,inrange) endif sum=0.d0 do i=0, deg sum=sum+coef(i)*tcl(i0+i) end do taucloud= sum return end