subroutine process_HIRS_CSRBs_orbit(debug, month, sat, nscans, HIRS_2d, HIRS_1d, * cfsr_dir, year, s_jday, dom, along_track_idx, across_track_idx, * cloud_probability, land_cover, cloud_phase, shifted_FM_opt, csrb_stats_file, * n, sum_obsclr, sum_calclr, ssq_raddiff, csrb_stats_file_open) c----------------------------------------------------------------------------------- c Description: Loop through HIRS L1b data and calculate cloud top pressures using c the CO2-slicing algorithm that follows the MODIS algorithm as closely c as possible. Calculate observed minus calculated clear-sky HIRS c radiance differences where collocated PATMOS-X cloud fractions are c zero and CO2-slicing does not indicate transmissive cirrus. c c Processes one HIRS orbit per call. c c Input parameters: c debug Debug write flag c month HIRS data month c sat satellite c nscans Number scan lines in HIRS orbit c HIRS_2d 2D HIRS input data c HIRS_1d 1D HIRS input data c cfsr_dir directory that contains CFSR reanalysis profile data c year HIRS data year c s_jday HIRS starting day of year c dom HIRS starting day of month c along_track_idx AVHRR scan line numbers of collocated pixels c across_track_idx AVHRR element numbers of collocated pixels c cloud_probability collocated PATMOS-X (AVHRR GAC) cloud probabilities c land_cover collocated PATMOS-X (AVHRR GAC) land/water/coast flag c cloud_phase collocated PATMOS-X (AVHRR GAC) cloud phase index c shifted_FM_opt shifted/unshifted forward model option c 1=unshifted (original), 2=shifted FM and Planck coefficients c csrb_stats_file output data file containing radiance difference statistics c c Output parameters: c n number radiance differences for selected HIRS bands, c for lat/lon bin, scene type c sum_obsclr Sum of observed clear-sky radiances for selected HIRS c bands, for lat/lon bin, scene type c sum_calclr Sum of calculated clear-sky radiances for selected HIRS c bands, for lat/lon bin, scene type c ssq_raddiff Sum of squares of radiances differences for selected c HIRS bands, for lat/lon bin, scene type c csrb_stats_file_open Logical variable indicating whether or c not output file has been successfully c opened. c c Revision history: 01/11 R. Frey Original version modified from c process_HIRS_orbit.f c 03/11 R. Frey Added 'csrb_stats_file_open' c 04/11 R. Frey Added 4th dimension to output c arrays (scene type) c 04/11 R. Frey Added 'scene_type', 'andn' c 04/11 R. Frey Added 'land_cover', routine c get_land_fraction, 'land_frc', c routine get_scene_type c 06/11 R. Frey changed "get_co2cld_nceprean1" to c "get_co2cld_forCSRB" c 06/11 R. Frey added 'shifted_FM_opt' c 01/14 R. Frey added 'wtrcld_frc' c (water cloud phase processing) c 01/14 R. Frey Modified to use CFSR renalysis files c c Calls: integer function get_ancillary c real function rf_hirsplanck c subroutine get_satnode c subroutine get_cloud_fraction c subroutine get_land_fraction c subroutine get_scene_type c subroutine get_co2cld_forCSRB c subroutine bin_stats c subroutine get_cloud_waterphase_fraction c c----------------------------------------------------------------------------------- IMPLICIT NONE save c----------------------------------------------------------------------------------- c Parameters. integer ntbct parameter (ntbct = 8) integer num_2d_SDS parameter (num_2d_SDS = 13) integer num_1d_SDS parameter (num_1d_SDS = 3) real dtr parameter (dtr = 3.14159 / 180.0) c The following HIRS spots for +/- 32 deg. vza processing. integer beg_elem parameter (beg_elem = 13) integer end_elem parameter (end_elem = 44) integer nlat_bins parameter (nlat_bins = 180) integer nlon_bins parameter (nlon_bins = 360) integer nscns parameter (nscns = 3) c----------------------------------------------------------------------------------- c Calling argument variables. character*120 cfsr_dir character*6 sat character*120 csrb_stats_file integer debug, nscans, year, s_jday, dom, along_track_idx(100,56,1100), * across_track_idx(100,56,1100), month, land_cover(409,15000), * shifted_FM_opt, cloud_phase(409,15000) real*8 n(nlon_bins, nlat_bins, ntbct, nscns) real*8 sum_obsclr(nlon_bins, nlat_bins, ntbct, nscns) real*8 sum_calclr(nlon_bins, nlat_bins, ntbct, nscns) real*8 ssq_raddiff(nlon_bins, nlat_bins, ntbct, nscns) real HIRS_2d(56,1100,num_2d_SDS), HIRS_1d(1100,num_1d_SDS), * cloud_probability(409,15000) logical csrb_stats_file_open c----------------------------------------------------------------------------------- c Local variables. integer method, co2_flag, hc_flag, ci_flag, line, elem, s_time, jday, * os_top_flag, nearnad_flag, landsea, dn_flag, out_flag, sat_node, * andn, irt, nbad, jj, i, j, k, m, scene_type, mbnds(ntbct), * obs_flag real nlat1, nlat2, node(1100), lat, lon, pres(26), temp(26), mixr(26), land, * sfctmp, prmsl, theta, tcold(ntbct), prsfc, sza_rad, cos_sza, tct, land_frc, * pct, eca, ptrp, pwin, sza, cloud_frc, hirs_vis, rclr(ntbct), obsclr(ntbct), * testbt, wtrcld_frc, o3mr(6), tozone logical calibration c----------------------------------------------------------------------------------- c External functions. integer get_ancillary real rf_hirsplanck c----------------------------------------------------------------------------------- data mbnds /4,5,6,7,8,10,11,12/ c----------------------------------------------------------------------------------- c Initializations. csrb_stats_file_open = .false. do m = 1, nscns do k = 1, ntbct do j = 1, nlat_bins do i = 1, nlon_bins n(i,j,k,m) = 0.d0 sum_obsclr(i,j,k,m) = 0.d0 sum_calclr(i,j,k,m) = 0.d0 ssq_raddiff(i,j,k,m) = 0.d0 enddo enddo enddo enddo c----------------------------------------------------------------------------------- c Loop through HIRS scan lines. c Begin at scan line 50 to account for approximate 5 minute overlap from ortbit c to orbit. do line = 50, nscans c do line = 1, nscans c----------------------------------------------------------------------------------- if(debug .gt. 0) then write(*,'(''Processing HIRS scan line '',i5)') line end if c----------------------------------------------------------------------------------- c Get satellite node (ascending=1 / descending=2). if( (line+1) .le. nscans) then nlat1 = HIRS_2d(28,line,1) nlat2 = HIRS_2d(28,line+1,1) if(nlat1 .eq. 0.0 .or. nlat2 .eq. 0.0) then node(line) = node(line-1) else call get_satnode(nlat1, nlat2, debug, sat_node) node(line) = sat_node*1.0 end if else node(line) = node(line-1) end if andn = int(node(line)) c Get scan day. jday = int(HIRS_1d(line,2)) c Get scan time. s_time = int(HIRS_1d(line,3)) c----------------------------------------------------------------------------------- c Loop through pixels on each scan line. do elem = beg_elem, end_elem c----------------------------------------------------------------------------------- c Get input HIRS data for current FOV. lat = HIRS_2d(elem,line,1) lon = HIRS_2d(elem,line,2) sza = HIRS_2d(elem,line,3) theta = HIRS_2d(elem,line,4) tcold(1) = HIRS_2d(elem,line,5) tcold(2) = HIRS_2d(elem,line,6) tcold(3) = HIRS_2d(elem,line,7) tcold(4) = HIRS_2d(elem,line,8) tcold(5) = HIRS_2d(elem,line,9) tcold(6) = HIRS_2d(elem,line,10) tcold(7) = HIRS_2d(elem,line,11) tcold(8) = HIRS_2d(elem,line,12) c Get day/night flag. Day=1, night=2. if(sza .le. 90.0) then dn_flag = 1 else dn_flag = 2 end if c Correct visible reflectance for solar zenith. sza_rad = dtr * sza cos_sza = cos(sza_rad) hirs_vis = HIRS_2d(elem,line,13) / cos_sza c----------------------------------------------------------------------------------- if(debug .gt. 0) then write(*,'(''Input data for line, element: '', 2i10)') line, elem write(*,'(7f15.3)') lat,lon,theta,sza,node(line),dn_flag*1.0,s_time*1.0 write(*,'(9f15.3,/)') tcold(1),tcold(2),tcold(3),tcold(4),tcold(5), & tcold(6),tcold(7),tcold(8),hirs_vis end if c----------------------------------------------------------------------------------- c Get ancillary data. c Use ancillary data from CFSR reanalysis files. irt = get_ancillary(debug, cfsr_dir, year, month, jday, dom, s_time, lat, & lon, pres, temp, mixr, land, sfctmp, prsfc, prmsl, & o3mr, tozone) landsea = int(land) c----------------------------------------------------------------------------------- c Get collocated AVHRR (from PATMOS-X) cloud data for the current HIRS FOV. c Collocated AVHRR GAC pixel cloud probabilities are combined to yield c a HIRS FOV cloud fraction. call get_cloud_fraction(debug, line, elem, along_track_idx, across_track_idx, * cloud_probability, cloud_frc) c----------------------------------------------------------------------------------- c Get AVHRR water cloud phase fraction (from PATMOS-X) for current HIRS FOV. call get_cloud_waterphase_fraction(debug, line, elem, along_track_idx, * across_track_idx, cloud_phase, wtrcld_frc) c----------------------------------------------------------------------------------- c Get collocated land cover fraction (portion of AVHRR GAC pixels in HIRS c IFOV that are classified as either land or coast by PATMOS-X). call get_land_fraction(debug, line, elem, along_track_idx, across_track_idx, * land_cover, land_frc) c----------------------------------------------------------------------------------- c Set scene type. call get_scene_type(debug, landsea, andn, land_frc, scene_type) c----------------------------------------------------------------------------------- c Initialize CO2-slicing outputs. pct = -99.9 tct = -99.9 eca = -99.9 method = -99 co2_flag = 0 hc_flag = 0 ci_flag = 0 os_top_flag = 0 nearnad_flag = 0 c----------------------------------------------------------------------------------- c Perform CO2-slicing algorithm if input data is valid. c Check here for calibration "stripe" or other bad input data. Assume all c bands are invalid if IR window data (band 8) is invalid. if(HIRS_2d(elem,line,9) .gt. 0.0 .and. HIRS_2d(elem,line,9) .lt. 340.0) then call get_co2cld_forCSRB_cfsr( debug, sat, lat, lon, theta, year, month, & jday, pres, temp, mixr, o3mr, tozone, prsfc, prmsl, sfctmp, landsea, tcold, & cloud_frc, wtrcld_frc, shifted_FM_opt, method, pct, eca, tct, ptrp, & pwin, co2_flag, hc_flag, ci_flag, os_top_flag, nearnad_flag, rclr ) end if c----------------------------------------------------------------------------------- c Collect ond bin observed clear-sky radiances. if(method .ne. -99) then if(cloud_frc .eq. 0.0 .and. (hc_flag .ne. 2 .and. method .gt. 2)) then c Convert observed clear-sky BTs to radiances. do k = 1, ntbct testbt = tcold(k) c Test for NaNs. if( tcold(k) .eq. testbt) then obsclr(k) = rf_hirsplanck(tcold(k),mbnds(k), 1) obs_flag = 1 else obs_flag = 0 end if enddo c Bin the observed ('obsclr') and calculated ('rclr') clear-sky radiances c and update statistics. if(obs_flag .eq. 1) then call bin_stats(debug, lat, lon, obsclr, rclr, csrb_stats_file, * scene_type, n, sum_obsclr, sum_calclr, ssq_raddiff, * csrb_stats_file_open) end if end if end if c----------------------------------------------------------------------------------- enddo enddo c----------------------------------------------------------------------------------- return end