program process_csrb_cfsr c --------------------------------------------------------------------------------- c c Description: Calculate observed minus calculated HIRS radiances for one HIRS c orbit. Output various statistics to a daily, global, 1-degree c resolution lat/lon file. New daily files are created as needed. c Statistics for a given day are updated with each additional orbit c processed. c c Command line inputs in order: c c HIRS HDF ("L1b") input file c CFSR reanlysis input profile directory c HIRS/AVHRR collocation index file c Collocated AVHRR (PATMOS-X) level 2 file c debug level index c shifted/unshifted forward model option c 1=unshifted (original), 2=shifted FM and Planck coefficients c output product file c c Output of program: c c output product file: c contains global data at 1-degree resolution (360x180x8x4x3) c 360 long. bins x 180 lat. bins x 8 HIRS bands x 4 statistics x 3 scene types c c statistics for each lat/lon bin and HIRS band (bands 4-8, 10-12), for each c of the following scene types: c ocean (index 1) c land, ascending node (index 2) c land, descending node (index 3) c statistics: c sum of observed minus calculated radiance c sum of observed minus calculated brightness temperature c number of radiance differences (N) c sum of squares of radiance differences c c Revision history: c 01/11 R. Frey Original version modified from process_hirs_ncep1.f c 03/11 R. Frey Added 'csrb_stats_file_open' c 04/11 R. Frey Added scene types to output arrays (4th dimension) c 06/11 R. Frey Added shifted/unshifted FM option ('shifted_FM_opt') c 01/14 R. Frey Added 'cloud_phase' c 01/14 R. Frey Modified to use CFSR data c 04/14 R. Frey Added 'avhrr_ctp' c c Calls: c subroutine get_HIRS_orbit c subroutine get_month c subroutine get_dayofmonth c subroutine get_orbital_col_indecis c subroutine get_patmos_cld_orbit c subroutine rf_hirspfco_101 c subroutine process_HIRS_orbit c subroutine message c c ---------------------------------------------------------------------------------- IMPLICIT NONE c----------------------------------------------------------------------------------- c Parameter definitions. integer num_2d_SDS parameter (num_2d_SDS = 13) integer num_1d_SDS parameter (num_1d_SDS = 3) integer ntbct parameter (ntbct = 8) integer nlat_bins parameter (nlat_bins = 180) integer nlon_bins parameter (nlon_bins = 360) integer nscns parameter (nscns = 3) c----------------------------------------------------------------------------------- c Declarations. character*160 errmsg character*120 parm, cfsr_dir integer debug, level, status, shifted_FM_opt c HIRS input data and associated variables. character*120 input_rad_file character*6 sat real*4 HIRS_2d(56,1100,num_2d_SDS), HIRS_1d(1100,num_1d_SDS) integer month, year, s_jday, s_time, dom, nscans c PATMOS-X (AVHRR) collocation input data and associated variables. character*120 collocate_index_file, PATMOS_L2_file real cloud_probability(409,15000) integer along_track_idx(100,56,1100), across_track_idx(100,56,1100) integer land_cover(409,15000) integer cloud_phase(409,15000) integer avhrr_ctp(409,15000) c Pixel clear-sky radiance and brightness temperature differences. real obs_minus_calc_clrrad(ntbct), obs_minus_calc_clrbt(ntbct) c Output file, output arrays. character*120 csrb_stats_file real*8 sum_obsclr(nlon_bins, nlat_bins, ntbct, nscns) real*8 sum_calclr(nlon_bins, nlat_bins, ntbct, nscns) real*8 n(nlon_bins, nlat_bins, ntbct, nscns) real*8 ssq_raddiff(nlon_bins, nlat_bins, ntbct, nscns) logical csrb_stats_file_open c----------------------------------------------------------------------------------- c Read command line arguments. call getarg(1,input_rad_file) call getarg(2,cfsr_dir) call getarg(3,collocate_index_file) call getarg(4,PATMOS_L2_file) call getarg(5,parm) read(parm,'(i4)') debug call getarg(6,parm) read(parm,'(i4)') shifted_FM_opt call getarg(7,csrb_stats_file) c----------------------------------------------------------------------------------- c Get HIRS geolocation and radiance data for current orbit. call get_HIRS_orbit(input_rad_file, HIRS_2d, HIRS_1d, sat, nscans) c Check length of input data. if(nscans .lt. 2 .or. nscans .gt. 1100) then level = 3 status = -1 write( errmsg,'(''Number scan lines too few or too many: '',i10)') nscans call message( 'process_hirs_ncep1', errmsg, status, level ) end if c Get HIRS starting day-of-year, time, and month (1-12). year = int(HIRS_1d(1,1)) s_jday = int(HIRS_1d(1,2)) s_time = int(HIRS_1d(1,3)) call get_month(year, s_jday, month) c Get day of month. call get_dayofmonth(year, month, s_jday, dom) c Get HIRS instrument/coefficient data for current satellite. call rf_hirspfco_101(sat, shifted_FM_opt) write(*,'(/,''Processing HIRS data from '',a6)') sat write(*,'(''Processing orbit beginning at '',4i10)') year, month, s_jday, s_time write(*,'(''Beginning day of month: '', i10)') dom write(*,'(''Number of HIRS scan lines is '',i5,/)') nscans c----------------------------------------------------------------------------------- c Get AVHRR (GAC) collocation indecis for current orbit. call get_orbital_col_indecis(debug, collocate_index_file, along_track_idx, * across_track_idx) c----------------------------------------------------------------------------------- c Get collocated PATMOS (AVHRR) cloud data for current orbit. call get_PATMOS_orbit(debug, PATMOS_L2_file, cloud_probability, land_cover, * cloud_phase, avhrr_ctp) c----------------------------------------------------------------------------------- c Process HIRS data. call 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 Write radiance difference statistics to output binary file. if(csrb_stats_file_open) then write(30, rec=1, err=100) n, sum_obsclr, sum_calclr, ssq_raddiff go to 200 else write(*,'(''Cannot write to output file - no valid CSRB data'')') go to 200 end if 100 write(*,'(''Error writing statistics to output file'')') 200 close(30) c----------------------------------------------------------------------------------- end