subroutine get_co2cld_cfsr( debug, sat, lat, lon, theta, & year, month, jday, pres, temp, mixr, o3mr, tozone, psfc, prmsl, ts, land, & tcold, cloud_frc, wtrcld_frc, csrbs, scene_type, shifted_FM_opt, ip, pct, & eca, tct, ptrp, pwin, co2_flag, hc_flag, ci_flag, utls_flag, & nearnad_flag, rclr, cth) c!F77------------------------------------------------------------------- c!Description: Compute cloud top pressure, effective cloud emissivity, c and cloud top temperature. c c!Input parameters: c debug Debug write flag c sat NOAA spacecraft c lat Latitude c lon Longitude c theta Viewing zenith angle c year Year c month Month c jday Day of year c pres Atm. pressure profile from input ancillary data c temp Atm. temperature profile from ancillary data c mixr Atm. water vapor mixing ratio profile from c ancillary data c o3mr Ozone mixing ratio profile from ancillary data c tozone Total column ozone from ancillary data c psfc Surface pressure c prmsl Pressure at mean sea level c ts Surface temperature c land Land/sea flag (0=water, 1=land) c tcold Observed cloud brightness temperatures (K) for c HIRS IR bands 4, 5, 6, 7, 8 c cloud_frc Collocated AVHRR cloud fraction within current HIRS FOV c wtrcld_frc Collocated AVHRR water cloud phase fraction within current HIRS FOV c csrbs HIRS clear sky radiance biases (CSRBs) c scene_type Scene type index (1=ocean, 2=AN land, 3=DN land) c shifted_FM_opt shifted/unshifted forward model option c 1=unshifted (original), 2=shifted FM and Planck coefficients c c!Output parameters: c ip Index indicating retrieval method and CO2 c band pair selected c pct Cloud top pressure (hPa) c eca Cloud effective emissivity c tct Cloud top temperature (K) c ptrp Pressure at tropopause (hPa) c pwin IRW cloud top pressure (hPa) c co2_flag Indicates CO2 slicing was successful c (0=missing, 1=no, 2=yes) c hc_flag Indicates high cloud was detected c (0=missing, 1=no, 2=yes) c ci_flag Indicates "cirrus" cloud was detected c (0=missing, 1=no, 2=yes) c utls_flag Indicates upper tropospheric/lower stratospheric clouds c (50S-50N only, 0=missing, 1=no, 2=yes) c nearnad_flag Indicates near-nadir view, VZA <= 32 degrees c (0=missing, 1=no, 2=yes) c rclr Calculated clear-sky radiances for bands 4-8, 10-12 c c!Revision history: 7/10 R. Frey c Initial version c 11/10 R. Frey c Added 'cloud_frc' c Added 'cloud_frc' in call to IRW_retrieval c Added 'ecawin' in call to marine_locld_retrieval c 01/11 R. Frey c Added 'rclr' to calling argument list and output c of calc_rt c 06/11 R. Frey c Added 'csrbs' and 'scene_type' c 07/11 R. Frey c Added 'shifted_FM_opt' c 02/12 R. Frey c Added 'psfc' in calls to IRW_retrieval and c marine_locld_retrieval c 10/13 Renamed 'os_top_flag' to 'utls_flag' c 12/13 Added 'wtrcld_frc' c 01/14 Modified to use CFSR reanalysis files c!Calls: c convert_profiles_cfsr c get_profile_data_cfsr c IRW_retrieval c calc_rt c CO2_retrieval c marine_locld_retrieval c c!End c----------------------------------------------------------------------- implicit none save integer plev parameter (plev = 101) integer nbct parameter (nbct = 5) integer ntbct parameter (ntbct = 8) integer nsct parameter (nsct = 4) integer kwc parameter (kwc = 5) c scalar arguments character*6 sat real lat, lon, theta, psfc, ts, ptrp, pwin, pct, & eca, prmsl, cloud_frc, cth, wtrcld_frc, tozone integer debug, year, month, jday, ci_flag, hc_flag, land, ip, & co2_flag, utls_flag, nearnad_flag, scene_type, & shifted_FM_opt c array arguments real tcold(ntbct), pres(26), temp(26), mixr(26), rclr(ntbct), & csrbs(180, 8, 3), o3mr(6) c local scalars real tw, ecawin, tct, tctmlc, near_nadir_vza_limit, beta, & tctwin, pctco2, tctco2, ecaco2, pctmlc, ecamlc integer iw1, k, ltrp, isp, lco2, ret_index, jj, & lctp, ipco2, ipmlc, lmlc, & met_year, met_day, lwin, ipwin c Local variables for binary file output. real output(408,270,15) integer il, lines_tot real modis_planck c local arrays double precision a0(12), a1(12), a2(12) real ra(plev,nbct), rclr_s(plev), rclr_s2(plev), tp(plev), & ttpp(plev), taup(plev,ntbct), rwarm(nbct), delr(nbct), & wat1, tprof1(101), wprof1(101), sfc_emis(ntbct), & z(plev) c----------------------------------------------------------------------- c data statements c Near nadir VZA definition. data near_nadir_vza_limit /32.0/ c----------------------------------------------------------------------- c Initializations ret_index = 0 lctp = 0 c----------------------------------------------------------------------- c Convert input temperature and moisture profiles to 101 levels. call convert_profiles_cfsr(debug, lat, lon, pres, temp, & mixr, wat1, tprof1, wprof1) c----------------------------------------------------------------------- c Compute additional profile data for CO2-slicing algorithm. call get_profile_data_cfsr(debug, lat, year, month, jday, land, & theta, sat, psfc, prmsl, tprof1, wprof1, o3mr, tozone, shifted_FM_opt, & z, isp, taup, sfc_emis, ptrp, ltrp, ttpp, rclr_s, rclr_s2) c----------------------------------------------------------------------- c Compute the IRW ("window") cloud height. tw = tcold(kwc) call IRW_retrieval(debug, tw, tprof1, ltrp, isp, ttpp, psfc, & cloud_frc, lwin, iw1, pwin, ecawin, ipwin, & tctwin) c----------------------------------------------------------------------- c Perform radiative transfer calculations for CO2-slicing method. call calc_rt(debug, isp, lwin, ltrp, ts, sfc_emis, psfc, & tprof1, taup, tcold, rclr_s, rclr_s2, csrbs, scene_type, & lat, shifted_FM_opt, beta, delr, ra, rwarm, rclr) c----------------------------------------------------------------------- c Compute CO2-slicing cloud top pressure. Variable 'co2_flag' is c set to a value of 2 if a solution is found. call CO2_retrieval(debug, land, beta, wtrcld_frc, delr, ra, ltrp, iw1, & tprof1, taup, rwarm, ecawin, shifted_FM_opt, pctco2, ecaco2, & tctco2, ipco2, lco2, co2_flag) if( (co2_flag .eq. 2 .and. cloud_frc .gt. 0.15) .or. & (co2_flag .eq. 2 .and. cloud_frc .le. 0.15 .and. & pctco2 .lt. 440.0) ) then pct = pctco2 eca = ecaco2 lctp = lco2 ip = ipco2 tct = tctco2 ret_index = 2 cth = z(lco2) else if (co2_flag .eq. 1 .and. cloud_frc .gt. 0.15) then pct = pwin eca = ecawin lctp = lwin ip = ipwin tct = tctwin ret_index = 1 cth = z(lwin) end if c write(*,'(''111 '',2i5,7f10.4)') land, ret_index, lat, lon, beta, cloud_frc, c * wtrcld_frc, pct, eca c----------------------------------------------------------------------- c Check for low cloud IRW retrievals over water. Perform "lapse rate" c method where appropriate. lmlc = -99 ipmlc = -99 pctmlc = -99.9 ecamlc = -99.9 tctmlc = -99.9 if ( pct .gt. 600.0 .and. co2_flag .eq. 1 .and. & cloud_frc .gt. 0.15) then if(land .eq. 0) then call marine_locld_retrieval(debug, lat, month, isp, psfc, ltrp, & ttpp, z, tprof1, tw, lwin, ecawin, pctmlc, tctmlc, ipmlc, & lmlc, ecamlc) lctp = lmlc pct = pctmlc eca = ecamlc ip = ipmlc tct = tctmlc ret_index = 3 cth = z(lmlc) end if end if c----------------------------------------------------------------------- if(ret_index .ne. 0) then if(pct .gt. (psfc+2.5) .or. cth .lt. 0.0) then write(*,'(''Cloud height below surface! '', 4i5,9f9.2)') ip, * ret_index, lctp, isp, lat, lon, cth, tct, pct, psfc, tw, * ttpp(lctp), ts end if end if c----------------------------------------------------------------------- c Set flags. c Near-nadir view if(theta .le. near_nadir_vza_limit) then nearnad_flag = 2 else nearnad_flag = 1 end if c High Cloud Flag. if( pct .lt. 440.0 .and. pct .gt. 0.0) then hc_flag = 2 else hc_flag = 1 end if c If band 35 BT > band 33 BT, set flag indicating stratospheric cloud. if(abs(lat) .lt. 50.0) then if( hc_flag .eq. 2 .and. (tcold(2) - tcold(4)) .gt. 0.5) then utls_flag = 2 else utls_flag = 1 end if else utls_flag = 0 end if c Cirrus Flag. if(pct .gt. 0.0 .and. pct .le. 680.0 .and. eca .gt. 0.0 .and. eca .le. 0.95) then ci_flag = 2 else ci_flag = 1 end if c----------------------------------------------------------------------- c Write output debug information if(debug .gt. 0) then write(*,'(/,''Output from CO2-slicing:'')') write(*,'(''Land/sea flag from ancillary data '',i10)') land write(*,'(''IRW/marine low cloud heights '',2f10.3)') pwin,pctmlc write(*,'(''Final CO2 cloud height '',f10.3)') pctco2 write(*,'(''Final cloud height '',f10.3)') pct write(*,'(''Cloud effective emissivity '',f10.3)') eca write(*,'(''Cloud temperature '',f10.3)') tct write(*,'(''Index of solution chosen'',i10)') ip write(*,'(''retrieval index (1=IRW, 2=CO2, 3=lapse rate)'', i10)') & ret_index write(*,'(1x)') write(*,'(''Flag values (0=missing, 1=no, 2=yes)'')') write(*,'(''co2_flag '', i10)') co2_flag write(*,'(''hc_flag '', i10)') hc_flag write(*,'(''ci_flag '', i10)') ci_flag write(*,'(''utls_flag '', i10)') utls_flag write(*,'(''nearnad_flag '', i10)') nearnad_flag write(*,'(1x)') end if c----------------------------------------------------------------------- return end