OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
Reflective_Cal.c
Go to the documentation of this file.
1 #include "Reflective_Cal.h"
2 #include "Reflective_CalP.h"
3 #include "L1B_Tables.h"
4 #include "HDF_Lib.h"
5 #include "PGS_Error_Codes.h"
6 #include "FNames.h"
7 #include <math.h>
8 
9 /* The following value is currently the largest uncertainty index value,
10  * for the reflective bands. If an index is calculated to be
11  * larger than this value, then it is set to the bad data value.
12  */
13 #define MAX_UNCERTAINTY_UI 15
14 static char *invalidlutfile =
15  "This is most likely due to an invalid LUT file.";
16 
17 extern int16 RFLAG;
18 extern int16 RSCL_FLAG;
19 
20 PGSt_SMF_status Reflective_Cal (int16 S,
21  L1A_granule_t *L1A_Gran,
22  L1B_granule_t *L1B_Gran,
23  L1A_Scan_t *L1A_Scan,
24  L1B_Scan_t *L1B_Scan,
26  refl_tables_t *refl_tables,
27  common_QA_tables_t *QA_tables,
28  QA_Common_t *QA_Common)
29 
30 /*
31 !C*****************************************************************************
32 !Description:
33 
34  This module corrects the raw digital signals, DN, for known instrumental
35  effects to produce corrected digital signals, dn* for every scan, frame,
36  subframe, band and detector. Corrections are applied for the effect of
37  instrument and focal plane temperature on detector responsivity, for the
38  electronic background, for the angular dependence of the response of the
39  scan mirror, for non-linearities in the Analog to Digital Converters, and
40  for the effect of an out-of-band spectral leak in the SWIR bands 5, 6 and 7.
41  Detectors within each spectral band are placed on a common scale by
42  scaling dn* by relative calibration coefficients of the detectors in each
43  band, to produce dn**. Each final dn** value, if valid, is scaled to an
44  integer in the range of [0-32767] and placed in an unsigned, 16-bit integer
45  variable (which has a full range of [0-65535]). If a valid value cannot be
46  computed, the scaled integer is set to a value in the range of [32768-65535].
47  Specific values in the range of [32768-65535] are used to denote why a valid
48  value could not be obtained (a list of these is in the L1B file
49  specifications). This routine also computes the uncertainty in the
50  reflectance product for every pixel, and converts the uncertainty to a
51  4-bit uncertainty index, stored in the 4 least significant bits of an 8-bit
52  unsigned integer.
53 
54 !Input Parameters:
55 
56  int16 S current scan index
57  L1A_granule_t *L1A_Gran contains mirror side index of current scan
58  L1B_granule_t *L1B_Gran contains calibration coefficients and scale, offset
59  factors
60  L1A_Scan_t *L1A_Scan contains earth view DN values
61  Preprocess_Data_t *PP contains focal plane and instrument temperatures,
62  ADC indexes, average electronic background DNs,
63  saturation DN values and scan-dependent parts of
64  swir correction algorithms
65  refl_tables_t *refl_tables contains the reflective lookup table values used
66  in reflective corrections
67  common_QA_tables_t *QA_tables contains the dead detector lookup table value
68  QA_Common_t *QA_Common contains NAD door open and sector rotation information
69 
70 !Output Parameters:
71 
72  L1B_Scan_t *L1B_Scan contains scaled integers and uncertainty indices
73  L1B_granule_t *L1B_Gran contains some granule level QA values
74 
75 !Revision History:
76 
77  Revision 02.33 October 15, 2004 Razor Issue #199
78  Changed the logic of setting the SWIR correction band detector index
79  for the SWIR band detector based on a new "swir_oob_sending_detector_table".
80  Liqin Tan, SAIC GSO (ltan@saicmodis.com)
81 
82  Revision 02.32 March 27, 2003, Razor Issue #173
83  Initialized some variables for ANSI-C compliance.
84  Liqin Tan, SAIC GSO (ltan@saicmodis.com)
85 
86  Revision 02.31 March 26, 2003 Razor Issue #191
87  Change use of Band 28 to band designated by Reflective LUT
88  Alice Isaacman, SAIC GSO (Alice.R.Isaacman.1@gsfc.nasa.gov)
89 
90  Revision 02.30, Oct. 3, 2002 Razor Issue #187
91  Remove R_star from code and replace it by 1/(m1*E_sun_over_pi)
92  Liqin Tan(ltan@saicmodis.com)
93 
94  Revision 02.29, March 25, 2001 Razor Issue #178
95  Removed ADC Correction
96  Alice Isaacman (Alice.R.Isaacman.1@gsfc.nasa.gov)
97 
98  Revision 02.28, March 16, 2001, Razor issue #159
99  Removed check on saturation of DN_ev using DN_sat LUT and replaced it with a
100  check on saturation of dn_ev using a new LUT dn_sat_ev. See MCST Memo M0991,
101  "Update to Level 1B Handling of Reflective Solar Band Detector Electronics
102  Saturation", G. Fireman and F. Adimi
103  Alice Isaacman (Alice.R.Isaacman.1@gsfc.nasa.gov)
104 
105  Revision 02.27, Dec 7, 2000, Razor issue 146, 147
106  New SWIR algorithm, per Jack Xiong's memo.
107  In-lined the SWIR correction algorithm since it is now only a couple of lines.
108  Removed obsolete DN_sat_prime.
109  Jim Rogers (rogers@mcst.gsfc.nasa.gov)
110 
111  Revision 02.26 Oct. 6, 1999
112  Corrected uncertainty calculation (missing the 100 for %) and restructured
113  uncertainty calculations to make more understandable. Added additional
114  comments and refined comments for clarity. Incorporated dn** nomenclature.
115  Jim Rogers (rogers@mcst.gsfc.nasa.gov)
116 
117  Revision 02.25 Sept. 29, 1999
118  Corrected the implementation of SWIR band correction to be on dn, not dn*.
119  Changed the name of "SWIR_correction" to "SWIR_out_of_band_correction"
120  as per Bruce B's request. Removed UI_ptr from argument list since we
121  expect new SWIR uncertainty algorithm to require new module.
122  Added and clarified documentation of the function.
123  Rearranged some calculations to better match algorithm.
124  Jim Rogers (rogers@mcst.gsfc.nasa.gov)
125 
126  Revision 02.24 Sept. 2, 1999
127  Implemented changes to meet the requirements of the new SWIR algorithm. See SDF.
128  Zhenying Gu(zgu@mcst.gsfc.nasa.gov)
129 
130  Revision 02.23 August 26, 1999
131  Added checking if ev data read from L1A are valid.
132  Zhenying Gu (zgu@mcst.gsfc.nasa.gov)
133  Jim Rogers (rogers@mcst.gsfc.nasa.gov)
134 
135  Revision 02.22 August 1999
136  Implemented changes to meet the requirement of new ADC algorithms. See SDF.
137  Zhenying Gu (zgu@mcst.gsfc.nasa.gov)
138  Jim Rogers (rogers@mcst.gsfc.nasa.gov)
139 
140  Revision 02.21 May 23, 1999
141  Many changes leading up to the May 30 delivery. See SDF.
142  Jim Rogers (rogers@mcst.gsfc.nasa.gov)
143 
144  Revision 02.11 Feb 22, 1999
145  Changed the call to Scaled_Int_to_Radiance to a simple statement, using the
146  new logic of how to calculate radiance from scaled integer.
147  Jim Rogers (rogers@mcst.gsfc.nasa.gov)
148 
149  Revision 02.10 April, 15 1998
150  Changed Preprocess_Refl_t *PP_refl paramter to Preprocess_Data_t *PP
151  (since some temperatures in the PP->Preprocess_Emiss structure are needed).
152  Changed the DN_to_DN_star() parameters for the new algorithm.
153  David Catozzi (cato@ltpmail.gsfc.nasa.gov)
154 
155  Revision 02.10 April, 13 1998
156  Removed the detector number inversion stuff (D_inv). The L1A
157  data already is in inverted det order - no need to do it again.
158  David Catozzi (cato@ltpmail.gsfc.nasa.gov)
159 
160  Revision 02.10 April, 8 1998
161  Added bounds checking logic to the uncertainty (S_L) to
162  uncertainty_index conversion algorithm.
163  David Catozzi (cato@ltpmail.gsfc.nasa.gov)
164 
165  Revision 02.10 April, 6 1998
166  Got rid of the FLOAT_TO_PIXEL Macro call, replacing it with a
167  Float_To_Pixel() function call.
168  Changed the rad_scale and rad_offset to counts_scale and counts_offset,
169  and L_ev to DN_star in the Float_To_Pixel() parameter list since we want
170  a scaled int of DN_star and not of L_ev.
171  Added the get_uncertainties() call to calculate uncertainties.
172  David Catozzi (cato@ltpmail.gsfc.nasa.gov)
173 
174  Revision 02.10 Mar. 1998
175  Added the SWIR_correction(). Including adding:
176  momo parameter, SWIR_correction_table to the refl_tables_t
177  Changed Preprocess_Data_t *PP to Preprocess_Refl_t *PP_refl
178  David Catozzi (cato@ltpmail.gsfc.nasa.gov)
179 
180  Revision 02.00 Dec. 1996
181  Plugged in lookup tables, trending_predictions, and
182  Preprocess_data_t *PP as an input parameter;
183  eliminated DED as an input parameter;
184  expanded processing scope from one band to one scan.
185  Zhidong Hao (hao@barebackride.gsfc.nasa.gov)
186 
187  Revision 01.01 1996/04/05
188  Update to match Version 1 Design Document
189  John Hannon(hannon@highwire.gsfc.nasa.gov)
190  Joan Baden (baden@highwire.gsfc.nasa.gov)
191 
192  Revision 01.00 1993
193  Initial development
194  Geir Kvaran(geir@highwire.gsfc.nasa.gov)
195 
196 !Team-unique Header:
197 
198  This software is developed by the MODIS Characterization Support
199  Team (MCST)for the National Aeronautics and Space Administration,
200  Goddard Space Flight Center, under contract NAS5-32373.
201 
202 !References and Credits:
203 
204  HDF portions developed at the National Center for Supercomputing
205  Applications at the University of Illinois at Urbana-Champaign.
206 
207 !Design Notes:
208 
209  Summary of important symbology in this function:
210 
211  DN = raw digital number, obtained directly from the Level 1A file.
212  dn = DN corrected for electronic zero point value (which usually
213  comes from the averaged SV DN).
214  dn* = dn corrected for instrument effects such as RVS and instrument
215  temperature.
216  dn** = dn* placed on a common scale (one per band) by accounting for the
217  relative calibration coefficients of the detectors in each band.
218  SI = scaled integer
219  UI = uncertainty index
220 
221  The calculations needed to calculate dn** and the uncertainty in the
222  reflectance product are performed at four major levels of indexing:
223  (1) by L1A band groups, (2) by band within a group, (3) by detector
224  within a band and (4) by frame within the resolution of a band group
225  (an index that includes both 1km-frame and sub-frame). Some
226  calculations related to dn* but not dependent on the 1km-frame index
227  are performed at level 3 to maintain efficiency.
228 
229  The following indicates the general flow of calculations:
230 
231  LOOP through L1A band groups
232  LOOP through bands of this group
233  - if thermal emissive band, skip to end of this loop
234  - set various band-dependent indexes and quantities
235  LOOP through detectors for this band
236  - calculate and store some quantities independent of 1km-frame
237  LOOP through frames at the resolution of this band group
238  - extract values of pixel quantities from arrays
239  that have band-group-dependent variable names
240  (includes extracting addresses of where to assign
241  scaled integer and uncertainty index)
242  - check quantities to ensure that pixel can be calibrated
243  - calculate dn
244  - if SWIR band, apply a correction to dn to account for the
245  out-of-band (OOB) leak
246  - calculate dn* by applying RVS and temperature corrections
247  - calculate dn** by applying relative calibration coefficient
248  factor.
249  - scale dn** to scaled integer
250  - calculate reflectance uncertainty index
251  END LOOP through frames at this resolution
252  END LOOP through detectors for this band
253  END LOOP through bands of this group
254  END LOOP through L1A band groups
255 
256  Note that the detector order convention for all variables and indexes
257  within variables is the "product" convention.
258 
259  The 38 MODIS bands are:
260  1,2,3,4,5,6,7,8,9,10,11,12,13lo,13hi,14lo,14hi,
261  15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,
262  30,31,32,33,34,35,36
263  The set of 490 MODIS detectors follows the band ordering indicated above
264  with detectors for each band being inserted into the set (i.e., the
265  first 40 detectors of the set are from band 1, the next 40 are from band 2,
266  the next 20 are from band 3, and so on).
267 
268  The 22 reflective solar bands are MODIS bands:
269  1,2,3,4,5,6,7,8,9,10,11,12,13lo,13hi,14lo,14hi,
270  15,16,17,18,19,26
271  The set of 330 reflective-band detectors follows a similar logic as that
272  described above for the MODIS-detectors.
273 
274  Another band group used in this function consists of the SWIR bands,
275  which are a subset of the reflective solar bands. The SWIR bands are:
276  5,6,7,26
277 
278  For an explanation of the "L1A" band groups and the "L1B" band groups,
279  see the design notes in the file "Granule.h"
280 
281 !END********************************************************************
282 */
283 {
284  PGSt_SMF_status returnStatus = MODIS_S_OK;
285  char *location = "Reflective_Cal";
286 
287  /* Major loop indices */
288  int16 R; /* L1A band group index (0,3) */
289  int16 B; /* band index within one L1A band group */
290  int16 D; /* detector index within band */
291  int16 F; /* frame index within resolution of the band group */
292 
293  /* Other indices (see comments in design notes above) */
294  int16 L1B_B; /* band index within the L1B band group */
295  int16 B_38; /* band index within set of all MODIS bands (0-37) */
296  int16 B_refl; /* band index within set of reflective bands (0-21) */
297  int16 D_refl; /* detector index within set of refl. bands (0-329) */
298  int16 D_490; /* detector index within set of MODIS bands (0-489) */
299  int16 B_swir; /* SWIR band index (0-3) */
300  int32 T; /* track index (combined scan and detector) */
301  int16 MS; /* index of mirror side for this scan (0,1) */
302  int16 subsamp; /* sub-sample (or sub-frame) index */
303  int16 focal_plane; /* focal plane assembly index for a given band */
304 
305  /* Variables used in calculation of scaled integer and uncertainty index */
306  int16 DN_ev; /* earth view DN */
307  float32 dn_ev; /* DN with background subtracted. */
308  float32 dn_star; /* dn corrected for known instrument effects */
309  float32 dn_star_star; /* dn* adjusted for detector variablility within a
310  band of the relative calibration coefficients. */
311  float32 RVS; /* Response vs. Scan Angle correction coefficient */
312  float32 DN_obc_avg; /* averaged electronics background DN to be
313  subtract from DN_ev */
314  float32 dT_inst; /* difference in T_inst from reference */
315  float32 dT_fpa; /* difference in T_fp from reference */
316  float32 temp_correction[4]; /* holds correction to dn_ev */
317  boolean temp_correction_valid; /* flags invalid T_ins or T_fp */
318  /**************************************************************/
319  /* obsolete due to UI algorithm update, 2/19/2011 by Xu Geng */
320  /*float32 sigma_RVS; */ /* Uncertainty in RVS (from tables) */
321  /*float32 sigma_m1_norm_sq[4]; */ /* holds m1 contribution to sigma^2 */
322  /*float32 sigma_RVS_over_RVS; */ /* temporary variable used in uncertainty */
323  /*float32 sigma_Kinst_norm_sq[4]; */ /* holds Kinst contribution to sigma^2 */
324  /*float32 sigma_PV_resid_elec_sq[4];*/ /* holds residual electronic crosstalk
325  contribution to sigma^2 */
326  /*float32 RSB_NEdL_R_star_sq[4];*/ /* holds (NEdL * R_star)^2 */
327  /*float32 sigma_R_EV; */ /* deviation of R* linear fit residual contribution
328  to sigma^2 */
329  /*float32 sigma_Tinst_norm_sq[4]; */ /* holds Tinst contribution to sigma^2 */
330  /*float32 sigma_RSB_ADC_sq = 0.0; */ /* holds RSB ADC contribution to sigma^2 */
331  /**************************************************************/
332  uint16 SI; /* scaled integer */
333  uint16 *SI_ptr; /* address of SI variable to set */
334  uint8 *UI_ptr; /* address of UI variable to set */
335  float32 uncertainty; /* fractional uncertainty in reflectance */
336  float32 u2, u4; /* uncertainty terms */
337  float32 *u4_coeffs; /* coefficients read from LUTs to calculate u4 */
338  int32 ui; /* temporary uncertainty index value */
339  float32 dn_swir_corr; /* swir correction for dn_ev */
340  boolean dn_swir_corr_error; /* flag for error in swir correction for dn_ev */
341  float32 sigma_dn_swir; /* holds part of uncertainty term */
342  float32 reflectance;
343 
344  /* Variables requiring initialization (these remain unchanged in function) */
345 
346  /* mapping of reflective band index (B_refl) to FPA index */
347 
348  int16 fpa_index[NUM_REFLECTIVE_BANDS] = {
349  /* band = 1 2 3 4 5 6 7 8 9 10 11 */
351  /* band = 12 13L 13H 14L 14H 15 16 17 18 19 26 */
353 
354  /* Definition of number of subsamples at each resolution */
355 
356  int16 samples_per_frame_at_res[NUM_L1A_RESOLUTIONS] = {4,2,1,1};
357 
358  int16 bX_det_index = 0; /* detector index for SWIR OOB Correction band */
359  int16 bX_frame_index = 0; /* 1km frame index for SWIR OOB Correction band */
360  float32 dn_X = -1.0; /* dn of SWIR OOB Correction band pixel. */
361 
362  /* # subsamples in a swir band */
363  int16 num_swir_subsamples[NUM_SWIR_BANDS] = {2, 2, 2, 1};
364  /* ratio of # detectors to 1km num */
365  int16 swir_detector_ratio[NUM_SWIR_BANDS] = {2, 2, 2, 1};
366  SWIR_correction_tables_t *swir_tables = &refl_tables->SWIR_correction_tables;
367 
368  int16 saturated_dn[NUM_REFLECTIVE_BANDS] =
369  {4095, 4095, 4095, 4095, 4095, 4095, 4095, 4095, 4095, 32767,
370  4095, 32767, 32767, 4095, 4095, 4095, 4095, 32767, 4095, 4095,
371  4095, 4095};
372 
373  /************* END DECLARATIONS, BEGIN CODE STATEMENTS ********************/
374 
375  /*Initialize extended indices, to be incremented within loops*/
376 
377  D_refl = 0;
378  D_490 = 0;
379  B_refl = 0;
380  B_38 = 0;
381 
382  /* Initialize the mirror side index for this scan. */
383 
384  MS = L1A_Gran->MirrorSide[S];
385 
386  /*
387  * If the mirror side is not 0 or 1, it is not a valid value. It is most
388  * likely this is a missing scan. The calculation below should not be
389  * proceeded.
390  */
391 
392  if (MS != 0 && MS != 1)
393  SMF_ERROR(MODIS_F_NOK, "Invalid mirror side value in Reflective_Cal()");
394 
395  /* If no rescaling then adjust saturated limits */
396  /* -------------------------------------------- */
397  if ((RSCL_FLAG & 1) == 0) saturated_dn[12] = 4095;
398  if ((RSCL_FLAG & 2) == 0) saturated_dn[17] = 4095;
399  if ((RSCL_FLAG & 4) == 0) saturated_dn[9] = 4095;
400  if ((RSCL_FLAG & 8) == 0) saturated_dn[11] = 4095;
401 
402  /*
403  * Loop through L1A band groups.
404  */
405 
406  for (R = 0; R < NUM_L1A_RESOLUTIONS; R++)
407  {
408  if ((RFLAG & (1 << R)) != 0) {
409  B_refl += L1A_BANDS_AT_RES[R];
410  B_38 += L1A_BANDS_AT_RES[R];
412  continue;
413  }
414 
415  /*
416  * Loop through bands within this L1A band group. Note that
417  * we also increment the MODIS band index at the end of each loop.
418  */
419 
420  for (B = 0; B < L1A_BANDS_AT_RES[R]; B++, B_38++)
421  {
422 
423  /*
424  * Skip thermal emissive bands (but, don't forget to increment D_490)
425  */
426 
428  {
429  D_490 += DETECT_PER_BAND_AT_RES[R];
430  continue;
431  }
432 
433  /*
434  * Set various band-dependent (not detector and frame dependent) indexes
435  * and quantities. To be efficient, don't put these into inner loop.
436  */
437 
438  /* Determine band index within the L1B band group. Only MODIS band 26
439  * needs special treatment. MODIS Band 26 is in the 4th and last L1A band
440  * group but it gets placed as the last band in the 3rd L1B band group.
441  */
442 
443  if (R == INDEX_1000M_EMISS) /* Last L1A band group */
444  {
445  L1B_B = L1B_BANDS_AT_RES[INDEX_1000M_REFL] - 1;
446  }
447  else /* Any other L1A band group */
448  {
449  L1B_B = B;
450  }
451 
452  /* obsolete, 2/19/2011 by Xu Geng
453  * Get the value of sigma RVS from tables.
454  */
455  /* sigma_RVS = refl_tables->Sigma_RVS_RSB[B_refl][MS]; */
456 
457  /*
458  * Select index of focal plane array corresponding to this reflective
459  * band. Will be used later when calculating temperature corrections
460  * for dn*.
461  */
462 
463  focal_plane = fpa_index[B_refl];
464 
465  /*
466  * Determine and set the SWIR band index. If this band is not a SWIR
467  * band, set -1 as a flag to know that the SWIR band correction is not
468  * to be applied.
469  */
470 
471  switch ( B_38 ) {
472  case 4: /* MODIS band 5 */
473  B_swir = 0;
474  break;
475 
476  case 5: /* MODIS band 6 */
477  B_swir = 1;
478  break;
479 
480  case 6: /* MODIS band 7 */
481  B_swir = 2;
482  break;
483 
484  case 27: /* MODIS band 26 */
485  B_swir = 3;
486  break;
487 
488  default: /* Any other reflective band that is not a SWIR band */
489  B_swir = -1;
490  break;
491 
492  } /* end switch */
493 
494  /*
495  * Loop through Detectors for this band. Note that we also increment
496  * the reflective detector index and the MODIS detector index, D_490.
497  */
498 
499  for (D = 0; D < DETECT_PER_BAND_AT_RES[R]; D++, D_refl++, D_490++)
500  {
501 
502 
503  /*
504  * Calculate and store some quantities independent of 1km-frame.
505  * (sub-frame quantities stored in arrays over sub-frame)
506  */
507 
508  /*
509  * Compute temperature correction to dn_ev. The correction factor is a
510  * multiplicative one and is:
511  * 1 + instrument temperature contribution + FPA temperature
512  * contribution See "Level 1B Uncertainty Calculations for Reflective
513  * Solar Bands" by Bruce Berriman and Gail Reichert, MCST Document #
514  * M0703, May 27, 1999 for algorithm.
515  */
516 
517  /*
518  * Use "temp_correction_valid" as a flag to denote that both instrument
519  * temperature and FPA temperatures were valid (> 0). If either of
520  * these are not valid, the respective correction contribution is not
521  * included in the correction factor (implying that there is no
522  * correction to dn_ev). However, the uncertainty index for this pixel
523  * is set to the bad data value.
524  */
525 
526  temp_correction_valid = True; /* Assume for now. */
527 
528  /*
529  * First, set the temp_correction values to 1.0.
530  */
531 
532  for (subsamp = 0; subsamp < SUBSAMPLES_AT_RES[R]; subsamp++)
533  temp_correction[subsamp] = 1.0;
534 
535  /*
536  * Add in instrument temperature correction contribution if
537  * temperature is valid.
538  */
539 
540  if (PP->PP_Emiss.T_ins[S] > 0)
541  {
542  dT_inst = PP->PP_Emiss.T_ins[S] - refl_tables->T_inst_ref;
543  for (subsamp = 0; subsamp < SUBSAMPLES_AT_RES[R]; subsamp++)
544  temp_correction[subsamp] +=
545  refl_tables->K_inst[B_refl][D][subsamp][MS] * dT_inst;
546  }
547  else
548  {
549  dT_inst = 0;
550  temp_correction_valid = False;
551  }
552 
553  /*
554  * Add in FPA temperature correction contribution if
555  * temperature is valid.
556  */
557 
558  if (PP->PP_Emiss.T_fp[focal_plane][S] > 0)
559  {
560  dT_fpa = PP->PP_Emiss.T_fp[focal_plane][S] - refl_tables->T_FPA_ref[focal_plane];
561  for (subsamp = 0; subsamp < SUBSAMPLES_AT_RES[R]; subsamp++)
562  temp_correction[subsamp] +=
563  refl_tables->K_FPA[B_refl][D][subsamp][MS] * dT_fpa;
564  }
565  else
566  {
567  dT_fpa = 0;
568  temp_correction_valid = False;
569  }
570 
571 
572  /*
573  * If the temperature correction is valid, compute quantities that are
574  * used in the calculation of uncertainty. See the memo: "PFM RSB
575  * Reflectance Uncertainty Algorithm (ReflUncert) - update 1 and 2, K.
576  * (Vincent) Chiang, G. Godden, etc. November 23 (24 for update 2), 1999.
577  */
578 
579  /*****************************************************************
580  * obsolete due to UI algorithm update, 2/19/2011 by Xu Geng
581  */
582  /*
583  if (temp_correction_valid) {
584 
585  for (subsamp = 0; subsamp < SUBSAMPLES_AT_RES[R]; subsamp++)
586  {
587  */
588  /*
589  * compute contribution of Kinst to square of uncertainty.
590  */
591  /*
592  t = refl_tables->Sigma_K_inst[B_refl][D][subsamp][MS] *
593  dT_inst / temp_correction[subsamp];
594  sigma_Kinst_norm_sq[subsamp] = t * t;
595  */
596 
597  /*
598  * compute contribution of Tinst to square of uncertainty.
599  */
600 
601  /*
602  t = refl_tables->Sigma_T_inst *
603  refl_tables->K_inst[B_refl][D][subsamp][MS] /
604  temp_correction[subsamp];
605  sigma_Tinst_norm_sq[subsamp] = t * t;
606  */
607 
608  /*
609  * compute PART contribution of NEdL to square of uncertainty.
610  */
611 
612  /*
613  t = refl_tables->RSB_NEdL[B_refl][D][subsamp][MS] /
614  refl_tables->m1[B_refl][D][subsamp][MS] /
615  refl_tables->E_sun_over_pi[D_refl];
616 
617  RSB_NEdL_R_star_sq[subsamp] = t * t;
618  */
619 
620  /*
621  * compute contribution of m1 to square of uncertainty.
622  */
623 
624  /*
625  t = refl_tables->Sigma_m1[B_refl][D][subsamp][MS] /
626  refl_tables->m1[B_refl][D][subsamp][MS];
627  sigma_m1_norm_sq[subsamp] = t * t;
628  */
629 
630  /*
631  * compute variance of residual electronic crosstalk.
632  */
633 
634  /*
635  sigma_PV_resid_elec_sq[subsamp] =
636  refl_tables->Sigma_PV_Resid_Elec[B_refl][D][subsamp] *
637  refl_tables->Sigma_PV_Resid_Elec[B_refl][D][subsamp];
638 
639  }
640 
641  sigma_RSB_ADC_sq = refl_tables->Sigma_RSB_ADC[B_refl][D] *
642  refl_tables->Sigma_RSB_ADC[B_refl][D];
643  }
644  */
645  /****************************************************************/
646 
647  /*
648  * Set the track index for this scan and detector.
649  */
650 
651  T = S * DETECT_PER_BAND_AT_RES[R] + D;
652 
653  /*
654  * Set the SWIR Correction band detector index for this detector.
655  * (this is only needed for SWIR bands).
656  */
657 
658  if (B_swir >= 0)
659  bX_det_index = D / swir_detector_ratio[B_swir];
660  if ( swir_tables->SWIR_corr_sending_detector[bX_det_index] >= 0 &&
661  swir_tables->SWIR_corr_sending_detector[bX_det_index] < DETECTORS_PER_1KM_BAND)
662  bX_det_index = swir_tables->SWIR_corr_sending_detector[bX_det_index];
663  else {
664  returnStatus = MODIS_F_OUT_OF_RANGE;
665  L1BErrorMsg(location, returnStatus,
666  "Detector to use for SWIR OOB Correction is out of range.",
667  NULL, REFLECTIVE_TABLES_FILE, invalidlutfile, True);
668  return returnStatus;
669  }
670 
671 
672  /*
673  * Loop through frames at this resolution. This is equivalent to a loop
674  * through 1km frames and a loop through subsamples, where the loop
675  * through subsamples is the most rapidly varying one.
676  */
677 
678 
679  for (F = 0; F < EV_1km_FRAMES * BAND_RATIO_AT_RES[R]; F++)
680  {
681 /************************* Begin Band 26 Section **************************/
682 #ifdef WRITE_BAND_26_SDS
683 
684  /*
685  * Here, for computing band 26 only, we want to skip all other
686  * reflective bands.
687  */
688 
690  && R != INDEX_1000M_EMISS)
691  continue;
692 
693 #endif /* WRITE_BAND_26_SDS */
694 /************************** End Band 26 Section ***************************/
695 
696  /*
697  * Set the subsample index for this frame
698  */
699 
700  subsamp = (F % samples_per_frame_at_res[R]);
701 
702  /*
703  * Extract values of quantities from arrays that have
704  * band-group-dependent variable names (includes extracting
705  * addresses of where to assign scaled integer and uncertainty
706  * index).
707  */
708 
709  if (R == INDEX_250M)
710  {
711  DN_ev = L1A_Scan->EV_250m[D][B][F];
712  DN_obc_avg = PP->DN_OBC_Avg.DN_obc_250m_avg[T][B][subsamp];
713  RVS = L1B_Gran->RSB_Cal_Coeff.RVS_250m[B][D][F][MS];
714  SI_ptr = &L1B_Scan->SI.EV_250m_RefSB[B][D][F];
715  UI_ptr = &L1B_Scan->UI.EV_250m_RefSB_UI[B][D][F];
716  }
717  else if(R == INDEX_500M)
718  {
719  DN_ev = L1A_Scan->EV_500m[D][B][F];
720  DN_obc_avg = PP->DN_OBC_Avg.DN_obc_500m_avg[T][B][subsamp];
721  RVS = L1B_Gran->RSB_Cal_Coeff.RVS_500m[B][D][F][MS];
722  SI_ptr = &L1B_Scan->SI.EV_500m_RefSB[B][D][F];
723  UI_ptr = &L1B_Scan->UI.EV_500m_RefSB_UI[B][D][F];
724  }
725  else if(R == INDEX_1000M_DAY)
726  {
727  DN_ev = L1A_Scan->EV_1km_day[D][B][F];
728  DN_obc_avg = PP->DN_OBC_Avg.DN_obc_1km_day_avg[T][B][subsamp];
729  RVS = L1B_Gran->RSB_Cal_Coeff.RVS_1km_RefSB[B][D][F][MS];
730  SI_ptr = &L1B_Scan->SI.EV_1km_RefSB[B][D][F];
731  UI_ptr = &L1B_Scan->UI.EV_1km_RefSB_UI[B][D][F];
732  }
733  else
734  {
735  DN_ev = L1A_Scan->EV_1km_night[D][B][F];
736  DN_obc_avg = PP->DN_OBC_Avg.DN_obc_1km_night_avg[T][BAND26][subsamp];
737  RVS = L1B_Gran->RSB_Cal_Coeff.RVS_1km_RefSB[L1B_B][D][F][MS];
738  SI_ptr = &L1B_Scan->SI.EV_1km_RefSB[L1B_B][D][F];
739  UI_ptr = &L1B_Scan->UI.EV_1km_RefSB_UI[L1B_B][D][F];
740  }
741 
742  /* Initialize *SI_ptr */
743  *SI_ptr = 0;
744 
745  /*
746  * Check quantities to ensure that pixel can be calibrated. If the pixel
747  * cannot be calibrated, set a specific value of scaled integer to flag
748  * the reason why the pixel could not be calibrated. Also, set the
749  * uncertainty index to the bad data value. Specific values to be set
750  * are described in the L1B EV file specifications and come from macros
751  * in Granule.h.
752  */
753 
754  /*
755  * Check if the DN value read from the L1A granule is out of the range
756  * [-1 to 4095]. If so, this indicates corrupted data or a code bug.
757  */
758 
759  if (DN_ev < MISSING_L1A_FLAG || DN_ev > saturated_dn[B_refl])
760  Bad_L1A_Error_Out("EV_250m or EV_500m or EV_1km_day or "
761  "band 26 in EV_1km_night",
762  " out of range in middle L1A files, Reflective_Cal(), "
763  "Reflective_Cal.c");
764 
765  /*
766  * Check for the DN value being flagged as missing by L1A.
767  */
768 
769  if ( DN_ev == MISSING_L1A_FLAG )
770  {
771  *SI_ptr = (uint16)L1A_DN_MISSING_SI;
772  *UI_ptr = (uint8)BAD_DATA_UI;
773  L1B_Gran->missing_pixels[B_38]++;
774  L1B_Gran->valid_pixels[B_38]--;
775  L1B_Gran->bad_data_flag[B_38] = 1;
776  QA_Common->num_missing_data_in_scans[D_490]++;
777  continue;
778  }
779 
780  /*
781  * Check for a dead detector.
782  */
783 
784  if ( QA_tables->dead_detector[D_490])
785  {
786  *SI_ptr = (uint16)DEAD_DETECTOR_SI;
787  *UI_ptr = (uint8)BAD_DATA_UI;
788  L1B_Gran->valid_pixels[B_38]--;
789  L1B_Gran->dead_detector_pixels[B_38]++;
790  QA_Common->num_dead_detector_EV_data[D_490]++;
791  continue;
792  }
793 
794  /*
795  * Check for a dead subframe.
796  * bits 0 to 3 for noisy subframes, bits 4 to 7 for dead subframes
797  */
798 
799  if(D_490 < NUM_HIGH_RESOLUTION_DETECTORS){
800  if ( QA_tables->Detector_Quality_Flag2_Values[D_490][subsamp+4])
801  {
802  *SI_ptr = (uint16)DEAD_SUBFRAME_SI;
803  *UI_ptr = (uint8)BAD_DATA_UI;
804  L1B_Gran->valid_pixels[B_38]--;
805  L1B_Gran->dead_subframe_pixels[B_38]++;
806  QA_Common->num_dead_subframe_EV_data[D_490]++;
807  continue;
808  }
809  }
810 
811  /*
812  * Check if the instrument is in a sector rotation.
813  */
814 
815  if (QA_Common->Sector_Rotation[S] == True)
816  {
817  *SI_ptr = (uint16)SECTOR_ROTATION_SI;
818  *UI_ptr = (uint8)BAD_DATA_UI;
819  L1B_Gran->valid_pixels[B_38]--;
820  L1B_Gran->bad_data_flag[B_38] = 1;
821  QA_Common->num_sector_rotation_EV_data[D_490]++;
822  continue;
823  }
824 
825  /*
826  * Check if the instrument has both sides of PCLW electronics on at the same time.
827  */
828 
829  if (QA_Common->Electronic_Anomaly[S] == True)
830  {
831  *SI_ptr = (uint16)UNABLE_CALIBRATE_SI;
832  *UI_ptr = (uint8)BAD_DATA_UI;
833  L1B_Gran->valid_pixels[B_38]--;
834  L1B_Gran->bad_data_flag[B_38] = 1;
835  continue;
836  }
837 
838  /* Check that DN_ev is not saturated. */
839 
840  if (DN_ev == saturated_dn[B_refl]) {
841  *SI_ptr = (uint16)SATURATED_DETECTOR_SI;
842  *UI_ptr = (uint8)BAD_DATA_UI;
843  L1B_Gran->saturated_pixels[B_38]++;
844  L1B_Gran->valid_pixels[B_38]--;
845  L1B_Gran->bad_data_flag[B_38] = 1;
846  QA_Common->num_saturated_EV_data[D_490]++;
847  continue;
848  }
849 
850  /*
851  * Check that average electronic background DN is valid.
852  * A negative value is assigned to average electronic background DN only if
853  * a valid value could not be determined from SV or BB data.
854  */
855 
856  if (DN_obc_avg < 0)
857  {
858  *SI_ptr = (uint16)ZERO_POINT_DN_SI;
859  *UI_ptr = (uint8)BAD_DATA_UI;
860  L1B_Gran->valid_pixels[B_38]--;
861  L1B_Gran->bad_data_flag[B_38] = 1;
862  QA_Common->num_no_bg_DN_EV_data[D_490]++;
863  continue;
864  }
865 
866  /*************** Checks complete ***********/
867 
868 
869  /*
870  * Subtract average electronic background DN from earth view DN.
871  * See memo "Level 1B Uncertainty Calculations for Reflective Solar
872  * Bands" by Bruce Berriman and Gail Reichert, MCST Document # M0703,
873  * May 27, 1999 for algorithm.
874  */
875 
876  dn_ev = DN_ev - DN_obc_avg;
877 
878  /*
879  * Determine if the dn_ev is saturated.
880  */
881 
882  if (dn_ev >= refl_tables->dn_sat_ev[B_refl][D][subsamp][MS]) {
883  if (B_refl != 9 && B_refl != 11 && B_refl != 12 && B_refl != 17) {
884  *SI_ptr = (uint16)SATURATED_DETECTOR_SI;
885  *UI_ptr = (uint8)BAD_DATA_UI;
886  L1B_Gran->saturated_pixels[B_38]++;
887  L1B_Gran->valid_pixels[B_38]--;
888  L1B_Gran->bad_data_flag[B_38] = 1;
889  QA_Common->num_saturated_EV_data[D_490]++;
890  continue;
891  } else
892  *SI_ptr = (uint16)UNRESCALED_HIGH_SI;
893  }
894 
895  /*
896  * For SWIR band, if the switch is on, correct dn_ev.
897  * See "SWIR Correction Algorithm Change in L1B", Draft,
898  * Jack Xiong, Dec. 1, 2000.
899  */
900 
901  if (B_swir >= 0 && swir_tables->SWIR_correction_switch == ON) {
902  bX_frame_index = F / num_swir_subsamples[B_swir];
903  dn_X = L1B_Scan->dn_X[bX_det_index][bX_frame_index];
904  if (dn_X < 0)
905  {
906  dn_swir_corr = 0;
907  dn_swir_corr_error = True;
908  sigma_dn_swir = 0;
909  }
910  else {
911  dn_swir_corr = swir_tables->X_OOB_0[B_swir][D][subsamp][MS] +
912  swir_tables->X_OOB_1[B_swir][D][subsamp][MS] * dn_X +
913  swir_tables->X_OOB_2[B_swir][D][subsamp][MS] * dn_X * dn_X;
914  dn_swir_corr_error = False;
915  sigma_dn_swir = refl_tables->swir_ui_factor[B_swir] * dn_swir_corr;
916  }
917  dn_ev -= dn_swir_corr;
918  }
919  else {
920  dn_swir_corr = 0;
921  dn_swir_corr_error = False;
922  sigma_dn_swir = 0;
923  }
924 
925  /*
926  * Convert dn to dn*.
927  * See memo "Level 1B Uncertainty Calculations for Reflective Solar Bands",
928  * Bruce Berriman and Gail Reichert, MCST Document # M0703, May 27, 1999.
929  */
930 
931  dn_star = dn_ev * temp_correction[subsamp] / RVS;
932 
933  /*
934  * Convert dn* to dn**.
935  * Use equation (5) in "Calculation of the Digital Signals Written to the
936  * Level 1B Data Products for the Reflective Solar Bands", Bruce Berriman
937  * and Jim Rogers, MCST Document # M0825, October 27, 1999.
938  */
939 
940  reflectance = refl_tables->m0[B_refl][D][subsamp][MS] + dn_star *
941  L1B_Gran->RSB_Cal_Coeff.m1_des_sq[B_refl][D][subsamp][MS];
942 
943  dn_star_star = reflectance /
944  L1B_Gran->RSB_Cal_Coeff.m1_des_sq_max[B_refl];
945 
946  /*
947  * Check to see if dn** is below the bottom end of the range for scaling to
948  * the scaled integer or is above the top end of the dynamic range for scaling.
949  * Otherwise, convert dn** to the scaled integer.
950  */
951 
952  if ( dn_star_star < L1B_Gran->SO.dn_star_Min[B_refl])
953  {
954  *SI_ptr = (uint16) RSB_DN_STAR_BELOW_MIN_SI;
955  *UI_ptr = (uint8) BAD_DATA_UI;
956  L1B_Gran->negative_value_below_noise_pixels[B_38]++;
957  L1B_Gran->valid_pixels[B_38]--;
958  L1B_Gran->bad_data_flag[B_38] = 1;
959  QA_Common->num_bad_dn_star_star_RSB_EV_data[D_490]++;
960  continue;
961  }
962  else if ( dn_star_star > L1B_Gran->SO.dn_star_Max[B_refl])
963  {
964  *SI_ptr = (uint16) TEB_OR_RSB_GT_MAX_SI;
965  *UI_ptr = (uint8)BAD_DATA_UI;
966  L1B_Gran->valid_pixels[B_38]--;
967  L1B_Gran->bad_data_flag[B_38] = 1;
968  QA_Common->num_exceed_max_for_scaling[D_490]++;
969 
970  if (B_refl == 9 && (RFLAG & 2) == 2 && (RSCL_FLAG & 4) == 4) {
971  L1B_Scan->EV_500m_Aggr1km_RefSB[0][D][F] =
972  (uint16)(dn_star_star/L1B_Gran->SO.counts_scale_RefSB[2]
973  + L1B_Gran->SO.counts_offset_RefSB[2] + 0.5);
974  *SI_ptr = (uint16) RESCALED_L1B_SI;
975  } else if (B_refl == 11 && (RFLAG & 2) == 2 && (RSCL_FLAG & 8) == 8) {
976  L1B_Scan->EV_500m_Aggr1km_RefSB[1][D][F] =
977  (uint16)(dn_star_star/L1B_Gran->SO.counts_scale_RefSB[3]
978  + L1B_Gran->SO.counts_offset_RefSB[3] + 0.5);
979  *SI_ptr = (uint16) RESCALED_L1B_SI;
980  } else if (B_refl == 12 && (RFLAG & 1) == 1 && (RSCL_FLAG & 1) == 1) {
981  L1B_Scan->EV_250m_Aggr1km_RefSB[0][D][F] =
982  (uint16)(dn_star_star/L1B_Gran->SO.counts_scale_RefSB[0]
983  + L1B_Gran->SO.counts_offset_RefSB[0] + 0.5);
984  *SI_ptr = (uint16) RESCALED_L1B_SI;
985  } else if (B_refl == 17 && (RFLAG & 1) == 1 && (RSCL_FLAG & 2) == 2) {
986  L1B_Scan->EV_250m_Aggr1km_RefSB[1][D][F] =
987  (uint16)(dn_star_star/L1B_Gran->SO.counts_scale_RefSB[1]
988  + L1B_Gran->SO.counts_offset_RefSB[1] + 0.5);
989  *SI_ptr = (uint16) RESCALED_L1B_SI;
990  }
991  continue;
992  }
993  else if (*SI_ptr == (uint16)UNRESCALED_HIGH_SI)
994  {
995  if (B_refl == 9 && (RFLAG & 2) == 2 && (RSCL_FLAG & 4) == 4) {
996  L1B_Scan->EV_500m_Aggr1km_RefSB[0][D][F] =
997  (uint16)(dn_star_star/L1B_Gran->SO.counts_scale_RefSB[2]
998  + L1B_Gran->SO.counts_offset_RefSB[2] + 0.5);
999  } else if (B_refl == 11 && (RFLAG & 2) == 2 && (RSCL_FLAG & 8) == 8) {
1000  L1B_Scan->EV_500m_Aggr1km_RefSB[1][D][F] =
1001  (uint16)(dn_star_star/L1B_Gran->SO.counts_scale_RefSB[3]
1002  + L1B_Gran->SO.counts_offset_RefSB[3] + 0.5);
1003  } else if (B_refl == 12 && (RFLAG & 1) == 1 && (RSCL_FLAG & 1) == 1) {
1004  L1B_Scan->EV_250m_Aggr1km_RefSB[0][D][F] =
1005  (uint16)(dn_star_star/L1B_Gran->SO.counts_scale_RefSB[0]
1006  + L1B_Gran->SO.counts_offset_RefSB[0] + 0.5);
1007  } else if (B_refl == 17 && (RFLAG & 1) == 1 && (RSCL_FLAG & 2) == 2) {
1008  L1B_Scan->EV_250m_Aggr1km_RefSB[1][D][F] =
1009  (uint16)(dn_star_star/L1B_Gran->SO.counts_scale_RefSB[1]
1010  + L1B_Gran->SO.counts_offset_RefSB[1] + 0.5);
1011  }
1012  continue;
1013  }
1014  else
1015  SI = (uint16)(dn_star_star/L1B_Gran->SO.counts_scale_RefSB[B_refl]
1016  + L1B_Gran->SO.counts_offset_RefSB[B_refl] + 0.5);
1017 
1018  /*
1019  * Check if the NAD door is closed. Set the most significant bit to 1 if
1020  * NAD door is closed.
1021  */
1022 
1023  if (QA_Common->NAD_Door_Open[S] == False)
1024  {
1025  SI = SI|0x8000;
1026  QA_Common->num_nadir_door_closed_EV_data[D_490]++;
1027 
1028  if (SI > NAD_CLOSED_UPPER_SI)
1030  }
1031 
1032  *SI_ptr = (uint16)SI;
1033 
1034  /***********************************************************************
1035  * 2/19/2011, Xu Geng
1036  * The algorithm for uncertainty calculation has been updated.
1037  * Please see Junqiang Sun, et. al., "RSB Uncertainty algorithm update",
1038  * (MCST Internal Memo).
1039  * Please ignore the old Memo mentioned below.
1040  ***********************************************************************/
1041 
1042  /*
1043  * Calculate uncertainty in the reflectance product and convert to
1044  * uncertainty index.
1045  * See Kwo-Fu (Vincent) Chiang, et. al., "PFM Reflectance Uncertainty
1046  * Algorithm (ReflUncert) - update 2", MCST Internal Memo,
1047  * November 24, 1999, for algorithm.
1048  * Note that the last term of the uncertainty uses dn*, not dn**.
1049  */
1050 
1051  /*
1052  * The following are conditions under which the uncertainty index is set
1053  * to the bad data value (maximum percentage error):
1054  * - dn_ev <= TOLERANCE (could get divide by zero,
1055  * negative or tiny number)
1056  * - dn_star <= TOLERANCE (could get divide by zero,
1057  * negative or tiny number)
1058  * - temp. correction invalid (unsure of how big correction
1059  * would have been)
1060  * - NAD is closed (the scaled integers are set to
1061  * unusable values)
1062  * - SWIR band error (could not use SWIR OOB Correction band
1063  * to get correction)
1064  */
1065 
1066  if (dn_ev <= TOLERANCE || dn_star <= TOLERANCE
1067  || !temp_correction_valid
1068  || QA_Common->NAD_Door_Open[S] == False
1069  || dn_swir_corr_error)
1070  {
1071  *UI_ptr = (uint8)BAD_DATA_UI;
1072  }
1073  else
1074  {
1075 
1076  /*
1077  * Compute the residual uncertainty of the R* linear fit.
1078  */
1079  /*
1080  *obsolete due to UI algorithm update, 2/19/2011, Xu Geng
1081  */
1082  /*
1083  resid_coeff =
1084  refl_tables->Sigma_R_Star_Lin_Resid_Ucoeff
1085  [B_refl][D][subsamp][MS];
1086  EVAL_4TH_ORDER_POLYNOMIAL(sigma_R_EV,resid_coeff,reflectance);
1087  sigma_R_EV /= reflectance;
1088  */
1089 
1090  /*
1091  * Compute RVS term
1092  */
1093  /* obsolete, 2/19/2011 by Xu Geng */
1094  /*sigma_RVS_over_RVS = sigma_RVS / RVS; */
1095 
1096 
1097  /*
1098  * Calculate U4 term
1099  * u4 = (u4_coeffs[0]+u4_coeffs[1]*dn_ev+u4_coeffs[2]*dn_ev*dn_ev)/dn_ev
1100  */
1101  u4_coeffs = refl_tables->u4_coeffs[B_refl][D][subsamp][MS];
1102  u4 = u4_coeffs[0]/dn_ev+u4_coeffs[1]+u4_coeffs[2]*dn_ev;
1103 
1104  /*
1105  * Get the pre-calculated u2
1106  */
1107  u2 = L1B_Gran->RSB_Cal_Coeff.u2[D_refl][F/samples_per_frame_at_res[R]][MS];
1108 
1109  /*
1110  * Compute the fractional uncertainty in the reflectance product.
1111  * This is the square root of the sum of the squares of the individual
1112  * contributions from the following 5 terms:
1113  * U1: The common term which is AOI and time independent.
1114  * U2: The uncertainty due to calibrations using calibrators and the linear approximation in RVS AOI dependence.
1115  * U3: The temperature impact.
1116  * U4: Scene dependent noise to signal ratio.
1117  * U5: The uncertainty due to cross talk correction for SWIR bands.
1118  */
1119 
1120  uncertainty = sqrt( (double)
1121  (refl_tables->u1[D_refl] * refl_tables->u1[D_refl] +
1122  u2 * u2 +
1123  refl_tables->u3[D_refl][MS] * refl_tables->u3[D_refl][MS] +
1124  u4 * u4 +
1125  (sigma_dn_swir * sigma_dn_swir) /
1126  (dn_ev * dn_ev))
1127  );
1128 
1129 
1130  /****************************************************************************
1131  * obsolete due to UI algorithm update, 2/19/2011, Xu Geng
1132 
1133  uncertainty = sqrt( (double)
1134  (sigma_m1_norm_sq[subsamp] +
1135  sigma_RVS_over_RVS * sigma_RVS_over_RVS +
1136  sigma_Kinst_norm_sq[subsamp] +
1137  sigma_Tinst_norm_sq[subsamp] +
1138  sigma_PV_resid_elec_sq[subsamp] +
1139  (sigma_RSB_ADC_sq + sigma_dn_swir) /
1140  (dn_ev * dn_ev) +
1141  sigma_R_EV * sigma_R_EV +
1142  RSB_NEdL_R_star_sq[subsamp] /
1143  (dn_star * dn_star))
1144  );
1145  ****************************************************************************/
1146 
1147  /*
1148  * Calculate the uncertainty index using the formula from the
1149  * L1B Product User's Guide:
1150  *
1151  * UI = n * log(percent_uncertainty / m)
1152  *
1153  * The value of n and m are band dependent and come from lookup tables.
1154  * The factor of 100 in the formula below converts the fractional
1155  * uncertainty to % uncertainty.
1156  */
1157 
1158  if (uncertainty > TOLERANCE)
1159  ui = refl_tables->RSB_UI_scaling_factor[B_refl] *
1160  log((double) (100. * uncertainty /
1161  refl_tables->RSB_specified_uncertainty[B_refl]));
1162  else
1163  ui = 0;
1164 
1165  /*
1166  * Ensure that uncertainty index lies within the [0-15] range
1167  * and place value in the uncertainty index variable.
1168  * Note that MAX_UNCERTAINTY_UI is <= BAD_DATA_UI, which is 15.
1169  */
1170 
1171  if (ui > MAX_UNCERTAINTY_UI) ui = BAD_DATA_UI;
1172  else if(ui < 0) ui = 0;
1173 
1174  *UI_ptr = (uint8)ui;
1175  }
1176 
1177  } /* End of loop over frames */
1178  } /* End of loop over detectors */
1179  B_refl++; /* Increment B_refl*/
1180  } /* End of loop over bands */
1181  } /* End of loop over L1A band groups */
1182 
1183 
1184  return(MODIS_S_OK);
1185 }
1186 
1187 /************************* Begin Band 26 Section **************************/
1188 #ifdef WRITE_BAND_26_SDS
1189 
1190 int32 Reflective_Cal_Band_Flag; /* external variable */
1191 
1192 PGSt_SMF_status Copy_Band_26_Data (L1B_Scan_t *L1B_Scan)
1193 /*
1194 !C**********************************************************************
1195 !Description:
1196  This function copies band 26 data from the EV_1km_RefSB structure member
1197  of L1B_Scan to the appropriate Band_26 structure member.
1198 
1199 !Input Parameters:
1200  L1B_Scan_t * L1B_Scan Contains all EV data for 1 scan, the structure
1201  members "SI.EV_1kmRefSB" and "UI.EV_1km_RefSB_UI"
1202  have been filled in function Reflective_Cal.
1203 !Output Parameters:
1204  L1B_Scan_t * L1B_Scan Structure members "Band26.SI" and
1205  "Band26.UI" are now filled.
1206 
1207 !Revision History:
1208  Revision 01.00 May 4, 1999
1209  Initial development, Jim Rogers (rogers@mcst.gsfc.nasa.gov)
1210 
1211 !Team-unique Header:
1212  This software is developed by the MODIS Characterization Support
1213  Team (MCST)for the National Aeronautics and Space Administration,
1214  Goddard Space Flight Center, under contract NAS5-32373.
1215 
1216 !References and Credits:
1217  HDF portions developed at the National Center for Supercomputing
1218  Applications at the University of Illinois at Urbana-Champaign.
1219 
1220 !Design Notes:
1221  Band 26 is the last band in the EV_1km_RefSB arrays in L1B_Scan.
1222 
1223 !END********************************************************************
1224 */
1225 {
1226  PGSt_SMF_status returnStatus = MODIS_S_OK;
1227  int32 B = NUM_1000M_REFL_BANDS - 1; /* index of band 26 data */
1228  int32 D; /* detector index */
1229  int32 F; /* frame index */
1230 
1231  for (D = 0; D < DETECTORS_PER_1KM_BAND; D++) {
1232  for (F = 0; F < EV_1km_FRAMES; F++) {
1233  L1B_Scan->Band26.SI[D][F] = L1B_Scan->SI.EV_1km_RefSB[B][D][F];
1234  L1B_Scan->Band26.UI[D][F] = L1B_Scan->UI.EV_1km_RefSB_UI[B][D][F];
1235  }
1236  }
1237  return returnStatus;
1238 }
1239 #endif /* WRITE_BAND_26_SDS */
1240 /************************** End Band 26 Section ***************************/
1241 
1242 
1243 
1244 extern PGSt_SMF_status Band_26_Crosstalk_Correction (
1245  L1B_Scan_t *L1B_Scan,
1246  int16 *b5_frame_offset,
1247 #ifdef USE_B5_RAD_OFFSET
1248  float32 b5_rad_offset,
1249 #endif /* USE_B5_RAD_OFFSET */
1250  float32 *b26_fr_b5_scaled_corr,
1251  QA_Common_t *QA_Common,
1252  uint32 *valid_pixels,
1253  uint32 *negative_value_below_noise_pixels,
1254  int16 *bad_data_flag,
1255  boolean isdaymode,
1256  boolean perform_B26_correction)
1257 /*
1258 !C**********************************************************************
1259 !Description:
1260  For one scan of calibrated earth-view data, this routine performs
1261  a crosstalk correction to Band 26 based on the values of the
1262  Band 5 Scaled Integers (SIs). If no errors occur the corrected
1263  Band 26 value is output.
1264 
1265 !Input Parameters:
1266  L1B_Scan_t *L1B_Scan (->SI, ->UI) (Bands 5 & 26)
1267  L1A_Scan_t *L1A_Scan contains earth view DN values
1268  int16 *b5_frame_offset Frame offset to use for Band 5
1269  float32 b5_rad_offset Band 5 radiance offset. (It is not
1270  necessary to use this term unless
1271  the LUT value of dn* min for band
1272  5 is set to a value other than 0.)
1273  float32 *b26_fr_b5_scaled_corr
1274  already-scaled correction factors
1275  common_QA_tables_t *QA_tables contains the dead detector lookup table
1276  values
1277  boolean isdaymode day mode indicator
1278  boolean perform_B26_correction correction switch
1279 
1280 !Output Parameters:
1281  L1B_Scan_t *L1B_Scan (->SI, ->UI) (Band 26)
1282  common_QA_tables_t *QA_tables contains possibly updated error counts
1283 
1284 !Revision History:
1285  $Log: Reflective_Cal.c,v $
1286  Revision 1.24 2011-04-07 14:41:47-04 xgeng
1287  RSB uncertainty algorithm update
1288 
1289  Revision 1.22 2010-11-15 10:40:39-05 xgeng
1290  No calibration is peformed for the scan if both sides of PCLW electronics are on at the same time.
1291 
1292  Revision 1.21 2008/11/18 19:49:15 xgeng
1293  merge branch for V6.0.0
1294 
1295  Revision 1.20.2.2 2008/06/05 14:06:46 xgeng
1296  Filled the dead subframe with value of DEAD_SUBFRAME_SI
1297 
1298  Revision 1.20 2005/01/18 19:34:49 ltan
1299  MOD_PR02_TERRA update to V5.0.4
1300 
1301 
1302  Revision 1.02 April 25, 2003 Razor Issue # 190
1303  Remove passed parameter L1A_Gran; no longer needed to differentiate which
1304  platform is being processed because procedure is now applied to MODIS/Aqua
1305  as well.
1306  Alice Isaacman SAIC GSO (Alice.R.Isaacman.1@gsfc.nasa.gov)
1307 
1308  Revision 1.01 April 22, 2002
1309  Correct typo in original code; check on SI_26, not UI_26
1310  Alice Isaacman SAIC GSO (Alice.R.Isaacman.1@gsfc.nasa.gov)
1311 
1312  Original Code Razor Issue 182
1313  Applicable to MODIS/TERRA (PFM) processing only.
1314  Alice Isaacman SAIC GSO (Alice.R.Isaacman.1@gsfc.nasa.gov)
1315 
1316 !Team-unique Header:
1317  This software is developed by the MODIS Characterization Support
1318  Team (MCST)for the National Aeronautics and Space Administration,
1319  Goddard Space Flight Center, under contract NAS5-32373.
1320 
1321 !References and Credits:
1322  HDF portions developed at the National Center for Supercomputing
1323  Applications at the University of Illinois at Urbana-Champaign.
1324 
1325 !Design Notes:
1326 
1327 !END********************************************************************
1328 */
1329 {
1330  PGSt_SMF_status returnStatus = MODIS_S_OK;
1331  int16 D = 0; /* detector index within band */
1332  int16 D_490 = 0; /* detector index within all MODIS detectors*/
1333  int16 F = 0; /* Frame index within resolution of 1 km bands */
1334  int16 B5_F = 0; /* Calculated Band 5 frame to use */
1335  float32 det_corr_fac = 0.; /* Scaled correction factor for a given detector */
1336  uint16 calc_corr_fac = 0.; /* Calculated correction factor for a pixel */
1337  uint16 SI_5; /* Aggregated Band 5 scaled integer */
1338  uint8 UI_5; /* Band 5 uncertainty */
1339  uint16 *SI_26_ptr; /* Pointer to Band 26 scaled integer */
1340  uint8 *UI_26_ptr; /* Pointer to Band 26 uncertainty */
1341 
1342 
1343  /*
1344  * Double check to be sure this is a day mode scan and that the Band 26
1345  * correction switch is set.
1346  * Return without penalty if conditions are not met.
1347  */
1348 
1349  if ( (! isdaymode) || (! perform_B26_correction) )
1350  return MODIS_S_OK;
1351 
1352  /* Loop through Detectors */
1353 
1355 
1356  for (D = 0; D < DETECTORS_PER_1KM_BAND; D++, D_490++)
1357  {
1358 
1359  det_corr_fac = b26_fr_b5_scaled_corr[D];
1360  for (F = 0; F < EV_1km_FRAMES; F++)
1361 
1362  {
1363 
1364  /*
1365  * Calculate the new frame for Band 5. If out of bounds, leave the
1366  * Band 26 SI and Band 26 UI alone.
1367  */
1368  B5_F = F + b5_frame_offset[D];
1369  if (B5_F < 0 || B5_F >= EV_1km_FRAMES) continue;
1370 
1371  /* Pull up the SI for the aggregated Band 5 and Band 26 radiance data. */
1372 
1373  SI_5 = L1B_Scan->EV_500m_Aggr1km_RefSB[BAND_5_AGGR_INDEX][D][B5_F];
1374  UI_5 = L1B_Scan->EV_500m_Aggr1km_RefSB_UI[BAND_5_AGGR_INDEX][D][B5_F];
1375  SI_26_ptr = &L1B_Scan->SI.EV_1km_RefSB[ BAND_26_1KM_INDEX][D][F];
1376  UI_26_ptr = &L1B_Scan->UI.EV_1km_RefSB_UI[BAND_26_1KM_INDEX][D][F];
1377 
1378  /*
1379  * If the Band 26 SI is invalid, do not correct the Band 26 value and
1380  * do not change the Band 26 UI.
1381  */
1382  if ( *SI_26_ptr > (uint16) DN15_SAT) continue;
1383 
1384  /*
1385  * If the Band 5 SI is invalid, set the Band 26 UI to 15 and do not
1386  * correct the Band 26 value.
1387  */
1388 
1389  if ( SI_5 > (uint16) DN15_SAT)
1390  {
1391  *UI_26_ptr = (uint8) BAD_DATA_UI;
1392  continue;
1393  }
1394 
1395  /* Calculate the correction = Band 5 SI * b26_fr_b5_scaled_corr[det] */
1396 
1397 #ifdef USE_B5_RAD_OFFSET
1398 
1399  /*
1400  * Use the Band 5 offset term in the calculation. This will not
1401  * become necessary unless the LUT value of dn* min is set
1402  * to a number other than 0.
1403  */
1404 
1405  calc_corr_fac = (uint16) (((float32) SI_5 - b5_rad_offset)
1406  * det_corr_fac + .5);
1407 
1408 #else
1409 
1410  calc_corr_fac = (uint16) ((float32) SI_5 * det_corr_fac + .5);
1411 
1412 #endif /* USE_B5_RAD_OFFSET */
1413 
1414  /*
1415  * If the correction which would be subtracted from the Band 26 SI value
1416  * is larger than the Band 26 SI value (i.e. if the resulting SI after
1417  * "correction" were to be less than 0), set Band 26 UI to 15 and
1418  * set the Band 26 value to RSB_DN_STAR_BELOW_MIN_SI.
1419  */
1420 
1421  if ( calc_corr_fac > *SI_26_ptr)
1422  {
1423  *UI_26_ptr = (uint8) BAD_DATA_UI;
1424  *SI_26_ptr = (uint16) RSB_DN_STAR_BELOW_MIN_SI;
1425  negative_value_below_noise_pixels[MODIS_BAND26_INDEX]++;
1426  valid_pixels[MODIS_BAND26_INDEX]--;
1427  bad_data_flag[MODIS_BAND26_INDEX] = 1;
1428  QA_Common->num_bad_dn_star_star_RSB_EV_data[D_490]++;
1429  continue;
1430  }
1431 
1432  /* Perform the correction. */
1433 
1434  *SI_26_ptr -= calc_corr_fac;
1435 
1436  /* If the Band 5 UI value was maximal set the Band 26 UI likewise. */
1437 
1438  if (UI_5 == (uint8) BAD_DATA_UI) *UI_26_ptr = (uint8) BAD_DATA_UI;
1439 
1440  } /* Loop through frames */
1441  } /* Loop through detectors */
1442 
1443  return returnStatus;
1444 }
1445 
uint16 EV_500m_Aggr1km_RefSB[NUM_500M_BANDS][DETECTORS_PER_1KM_BAND][EV_1km_FRAMES]
Definition: Granule.h:985
#define VIS
Definition: Granule.h:542
#define MODIS_S_OK
integer, parameter int16
Definition: cubeio.f90:3
int32 num_bad_dn_star_star_RSB_EV_data[NUM_DETECTORS]
Definition: Granule.h:1086
#define BAND_26_1KM_INDEX
float32 DN_obc_1km_night_avg[MAX_1KM_TRACK_DIM][NUM_1000M_NIGHT_BANDS][NUM_1KM_SUBSAMP]
Definition: Preprocess.h:121
float32 DN_obc_500m_avg[MAX_500M_TRACK_DIM][NUM_500M_BANDS][NUM_500M_SUBSAMP]
Definition: Preprocess.h:119
int16 RSCL_FLAG
Definition: Granule.c:76
uint16 SI[DETECTORS_PER_1KM_BAND][EV_1km_FRAMES]
Definition: Granule.h:949
#define RSB_DN_STAR_BELOW_MIN_SI
Definition: Granule.h:522
float32 X_OOB_0[NUM_SWIR_BANDS][MAX_DETECTORS_PER_SWIR_BAND][MAX_NUM_SWIR_SUBSAMPLES][NUM_MIRROR_SIDES]
Definition: L1B_Tables.h:624
int32 Reflective_Cal_Band_Flag
uint32 dead_subframe_pixels[NUM_BANDS]
Definition: Granule.h:883
uint16 EV_1km_RefSB[NUM_1000M_REFL_BANDS][DETECTORS_PER_1KM_BAND][EV_1km_FRAMES]
Definition: Granule.h:901
float32 m1_des_sq[NUM_REFLECTIVE_BANDS][MAX_DETECTORS_PER_BAND][MAX_SAMPLES_PER_BAND][NUM_MIRROR_SIDES]
Definition: Granule.h:818
float32 RVS_500m[NUM_500M_BANDS][DETECTORS_PER_500M_BAND][EV_500m_FRAMES][NUM_MIRROR_SIDES]
Definition: Granule.h:830
#define SWIR
Definition: Granule.h:544
#define SATURATED_DETECTOR_SI
Definition: Granule.h:519
#define BAD_DATA_UI
Definition: Granule.h:533
uint16 EV_500m_RefSB[NUM_500M_BANDS][DETECTORS_PER_500M_BAND][EV_500m_FRAMES]
Definition: Granule.h:897
L1B_ScaleOffset_t SO
Definition: Granule.h:865
uint32 valid_pixels[NUM_BANDS]
Definition: Granule.h:878
int32 num_sector_rotation_EV_data[NUM_DETECTORS]
Definition: Granule.h:1082
@ INDEX_1000M_DAY
Definition: Granule.h:571
@ NIR
Definition: hybrid.c:24
int32 num_nadir_door_closed_EV_data[NUM_DETECTORS]
Definition: Granule.h:1088
#define SECTOR_ROTATION_SI
Definition: Granule.h:525
int32 num_saturated_EV_data[NUM_DETECTORS]
Definition: Granule.h:1083
uint8 UI[DETECTORS_PER_1KM_BAND][EV_1km_FRAMES]
Definition: Granule.h:950
@ INDEX_500M
Definition: Granule.h:570
#define NULL
Definition: decode_rs.h:63
#define UNRESCALED_HIGH_SI
Definition: Granule.h:529
#define MODIS_BAND26_INDEX
Definition: Granule.h:446
#define UNABLE_CALIBRATE_SI
Definition: Granule.h:528
Band_26_t Band26
Definition: Granule.h:1022
#define L1A_DN_MISSING_SI
Definition: Granule.h:518
float32 RVS_250m[NUM_250M_BANDS][DETECTORS_PER_250M_BAND][EV_250m_FRAMES][NUM_MIRROR_SIDES]
Definition: Granule.h:825
SWIR_correction_tables_t SWIR_correction_tables
Definition: L1B_Tables.h:725
#define MODIS_F_OUT_OF_RANGE
int32 num_exceed_max_for_scaling[NUM_DETECTORS]
Definition: Granule.h:1087
float32 u2[NUM_REFLECTIVE_DETECTORS][EV_1km_FRAMES][NUM_MIRROR_SIDES]
Definition: Granule.h:839
#define MODIS_BAND26_INDEX_AT_RES
Definition: Granule.h:447
boolean Sector_Rotation[MAX_NUM_SCANS]
Definition: Granule.h:1075
#define MISSING_L1A_FLAG
Definition: Granule.h:515
@ INDEX_250M
Definition: Granule.h:569
#define ON
Definition: l1.h:43
Preprocess_Emiss_t PP_Emiss
Definition: Preprocess.h:176
float64 dn_sat_ev[NUM_REFLECTIVE_BANDS][MAX_DETECTORS_PER_BAND][MAX_SAMPLES_PER_BAND][NUM_MIRROR_SIDES]
Definition: L1B_Tables.h:732
int16 BAND_RATIO_AT_RES[NUM_L1A_RESOLUTIONS]
Definition: Granule.c:73
float32 m1_des_sq_max[NUM_REFLECTIVE_BANDS]
Definition: Granule.h:820
#define REFLECTIVE_BAND_26_ONLY
#define DETECTORS_PER_1KM_BAND
Definition: Granule.h:438
int16 EV_1km_day[DETECTORS_PER_1KM_BAND][NUM_1000M_DAY_BANDS][EV_1km_FRAMES]
Definition: Granule.h:787
float32 K_FPA[NUM_REFLECTIVE_BANDS][MAX_DETECTORS_PER_BAND][MAX_SAMPLES_PER_BAND][NUM_MIRROR_SIDES]
Definition: L1B_Tables.h:660
uint16 EV_250m_RefSB[NUM_250M_BANDS][DETECTORS_PER_250M_BAND][EV_250m_FRAMES]
Definition: Granule.h:893
#define DN15_SAT
Definition: Granule.h:1103
const double F
PGSt_SMF_status Band_26_Crosstalk_Correction(L1B_Scan_t *L1B_Scan, int16 *b5_frame_offset, float32 *b26_fr_b5_scaled_corr, QA_Common_t *QA_Common, uint32 *valid_pixels, uint32 *negative_value_below_noise_pixels, int16 *bad_data_flag, boolean isdaymode, boolean perform_B26_correction)
float32 DN_obc_250m_avg[MAX_250M_TRACK_DIM][NUM_250M_BANDS][NUM_250M_SUBSAMP]
Definition: Preprocess.h:118
float32 u4_coeffs[NUM_REFLECTIVE_BANDS][MAX_DETECTORS_PER_BAND][MAX_SAMPLES_PER_BAND][NUM_MIRROR_SIDES][NUM_2ND_ORDER_COEFFS]
Definition: L1B_Tables.h:749
boolean Electronic_Anomaly[MAX_NUM_SCANS]
Definition: Granule.h:1076
uint32 saturated_pixels[NUM_BANDS]
Definition: Granule.h:879
float32 swir_ui_factor[NUM_SWIR_BANDS]
Definition: L1B_Tables.h:751
#define DEAD_SUBFRAME_SI
Definition: Granule.h:527
uint8 EV_500m_RefSB_UI[NUM_500M_BANDS][DETECTORS_PER_500M_BAND][EV_500m_FRAMES]
Definition: Granule.h:916
float32 T_FPA_ref[NUM_FOCAL_PLANES]
Definition: L1B_Tables.h:678
uint8 EV_500m_Aggr1km_RefSB_UI[NUM_500M_BANDS][DETECTORS_PER_1KM_BAND][EV_1km_FRAMES]
Definition: Granule.h:1002
float32 T_fp[NUM_FOCAL_PLANES][MAX_NUM_SCANS]
Definition: Preprocess.h:152
int32 SUBSAMPLES_AT_RES[NUM_L1A_RESOLUTIONS]
Definition: Preprocess.c:21
float32 counts_scale_RefSB[NUM_REFLECTIVE_BANDS]
Definition: Granule.h:805
float32 RSB_specified_uncertainty[NUM_REFLECTIVE_BANDS]
Definition: L1B_Tables.h:721
float32 m0[NUM_REFLECTIVE_BANDS][MAX_DETECTORS_PER_BAND][MAX_SAMPLES_PER_BAND][NUM_MIRROR_SIDES]
Definition: L1B_Tables.h:665
L1B_Scan_UI_t UI
Definition: Granule.h:987
int16 L1A_BANDS_AT_RES[NUM_L1A_RESOLUTIONS]
Definition: Granule.c:63
@ BAND26
Definition: Granule.h:643
float32 X_OOB_2[NUM_SWIR_BANDS][MAX_DETECTORS_PER_SWIR_BAND][MAX_NUM_SWIR_SUBSAMPLES][NUM_MIRROR_SIDES]
Definition: L1B_Tables.h:634
#define TEB_OR_RSB_GT_MAX_SI
Definition: Granule.h:523
#define EV_1km_FRAMES
Definition: Granule.h:469
const int NUM_REFLECTIVE_BANDS
#define NUM_SWIR_BANDS
Definition: L1B_Tables.h:386
float32 dn_star_Max[NUM_REFLECTIVE_BANDS]
Definition: Granule.h:797
#define DEAD_DETECTOR_SI
Definition: Granule.h:521
#define INDEX_1000M_EMISS
Definition: Granule.h:576
endif() set(LIBS $
Definition: CMakeLists.txt:6
float32 u1[NUM_REFLECTIVE_DETECTORS]
Definition: L1B_Tables.h:739
#define RESCALED_L1B_SI
Definition: Granule.h:530
void SMF_ERROR(PGSt_SMF_code code, char *messagestring)
Definition: Granule.c:1345
PGSt_SMF_status Copy_Band_26_Data(L1B_Scan_t *L1B_Scan)
uint8 EV_250m_RefSB_UI[NUM_250M_BANDS][DETECTORS_PER_250M_BAND][EV_250m_FRAMES]
Definition: Granule.h:912
float32 dn_X[DETECTORS_PER_1KM_BAND][EV_1km_FRAMES]
Definition: Granule.h:1027
int32 num_missing_data_in_scans[NUM_DETECTORS]
Definition: Granule.h:1079
int16 EV_500m[DETECTORS_PER_500M_BAND][NUM_500M_BANDS][EV_500m_FRAMES]
Definition: Granule.h:783
#define ZERO_POINT_DN_SI
Definition: Granule.h:520
#define NUM_HIGH_RESOLUTION_DETECTORS
Definition: Granule.h:425
uint8 Detector_Quality_Flag2_Values[NUM_HIGH_RESOLUTION_DETECTORS][NUM_BITS_IN_UINT8]
Definition: L1B_Tables.h:897
#define MAX_UNCERTAINTY_UI
#define MODIS_F_NOK
uint8 EV_1km_RefSB_UI[NUM_1000M_REFL_BANDS][DETECTORS_PER_1KM_BAND][EV_1km_FRAMES]
Definition: Granule.h:920
instead the metadata field ProcessingEnvinronment is filled in from the output of a call to the POSIX compliant function uname from within the L1B code A small bug in L1B_Tables an incorrect comparison of RVS coefficients for TEBs to RVS coefficients for RSBs was being made This was replaced with a comparison between TEB coefficients This error never resulted in an incorrect RVS correction but did lead to recalculating the coefficients for each detector in a thermal band even if the coefficients were the same for all detectors To reduce to overall size of the reflective LUT HDF fill values were eliminated from all LUTs previously dimensioned where and where NUM_TIMES is the number of time dependent table pieces In Preprocess a small error where the trailing dropped scan counter was incremented when the leading dropped scan counter should have been was fixed This counter is internal only and is not yet used for any chiefly to casting of were added to make it LINUX compatible Output of code run on LINUX machines displays differences of at most scaled sector incalculable values of the Emissive calibration factor and incalculable values of SV or BB averages was moved outside the loop over frames in Emissive_Cal c since none of these quantities are frame dependent Initialization of b1 and XMS values in Preprocess c routine Process_OBCENG_Emiss was moved inside the detector loops The code was altered so that if up to five scans are dropped between the leading middle or middle trailing the leading or trailing granule will still be used in emissive calibration to form a cross granule average QA bits and are set for a gap between the leading middle and middle trailing granules respectively This may in rare instances lead to a change in emissive calibration coefficients for scans at the beginning or end of a granule A small bug in the Band correction algorithm was corrected an uncertainty value was being checked against an upper bound whereas the proper quantity to be checked was the corresponding SI
Definition: HISTORY.txt:595
int8 dead_detector[NUM_DETECTORS]
Definition: L1B_Tables.h:889
#define True
Definition: Granule.h:537
#define TOLERANCE
Definition: Granule.h:535
int32 num_dead_detector_EV_data[NUM_DETECTORS]
Definition: Granule.h:1080
uint32 missing_pixels[NUM_BANDS]
Definition: Granule.h:880
void Bad_L1A_Error_Out(char *name, char *message)
Definition: Granule.c:1616
float32 counts_offset_RefSB[NUM_REFLECTIVE_BANDS]
Definition: Granule.h:806
int16 SWIR_corr_sending_detector[DETECTORS_PER_1KM_BAND]
Definition: L1B_Tables.h:620
#define REFLECTIVE_TABLES_FILE
Definition: FNames.h:74
float32 T_inst_ref
Definition: L1B_Tables.h:676
int32 num_dead_subframe_EV_data[NUM_HIGH_RESOLUTION_DETECTORS]
Definition: Granule.h:1081
int16 EV_250m[DETECTORS_PER_250M_BAND][NUM_250M_BANDS][EV_250m_FRAMES]
Definition: Granule.h:779
#define BAND_5_AGGR_INDEX
int16 bad_data_flag[NUM_BANDS]
Definition: Granule.h:885
int32 num_no_bg_DN_EV_data[NUM_DETECTORS]
Definition: Granule.h:1084
DN_OBC_Avg_t DN_OBC_Avg
Definition: Preprocess.h:174
RSB_Cal_Coeff_t RSB_Cal_Coeff
Definition: Granule.h:863
float32 X_OOB_1[NUM_SWIR_BANDS][MAX_DETECTORS_PER_SWIR_BAND][MAX_NUM_SWIR_SUBSAMPLES][NUM_MIRROR_SIDES]
Definition: L1B_Tables.h:629
int16 EV_1km_night[DETECTORS_PER_1KM_BAND][NUM_1000M_NIGHT_BANDS][EV_1km_FRAMES]
Definition: Granule.h:791
float32 RSB_UI_scaling_factor[NUM_REFLECTIVE_BANDS]
Definition: L1B_Tables.h:723
int16 L1B_BANDS_AT_RES[NUM_L1A_RESOLUTIONS]
Definition: Granule.c:58
int16 RFLAG
Definition: Granule.c:75
int16 DETECT_PER_BAND_AT_RES[NUM_L1A_RESOLUTIONS]
Definition: Granule.c:68
#define R
Definition: make_L3_v1.1.c:96
#define NAD_CLOSED_UPPER_SI
Definition: Granule.h:531
void L1BErrorMsg(char *L1B_location, PGSt_SMF_code code, char *input_message, char *assoc_function, int32 lun, char *other_msg, boolean error_out)
Definition: Granule.c:918
@ NUM_L1A_RESOLUTIONS
Definition: Granule.h:573
#define NUM_1000M_REFL_BANDS
Definition: Granule.h:432
float32 K_inst[NUM_REFLECTIVE_BANDS][MAX_DETECTORS_PER_BAND][MAX_SAMPLES_PER_BAND][NUM_MIRROR_SIDES]
Definition: L1B_Tables.h:655
uint32 dead_detector_pixels[NUM_BANDS]
Definition: Granule.h:882
uint16 EV_250m_Aggr1km_RefSB[NUM_250M_BANDS][DETECTORS_PER_1KM_BAND][EV_1km_FRAMES]
Definition: Granule.h:981
int MS[]
Definition: Usds.c:106
int16 MirrorSide[MAX_NUM_SCANS]
Definition: Granule.h:751
PGSt_SMF_status Reflective_Cal(int16 S, L1A_granule_t *L1A_Gran, L1B_granule_t *L1B_Gran, L1A_Scan_t *L1A_Scan, L1B_Scan_t *L1B_Scan, Preprocess_Data_t *PP, refl_tables_t *refl_tables, common_QA_tables_t *QA_tables, QA_Common_t *QA_Common)
L1B_Scan_SI_t SI
Definition: Granule.h:973
float32 RVS_1km_RefSB[NUM_1000M_REFL_BANDS][DETECTORS_PER_1KM_BAND][EV_1km_FRAMES][NUM_MIRROR_SIDES]
Definition: Granule.h:835
boolean NAD_Door_Open[MAX_NUM_SCANS]
Definition: Granule.h:1074
float32 T_ins[MAX_NUM_SCANS]
Definition: Preprocess.h:155
uint32 negative_value_below_noise_pixels[NUM_BANDS]
Definition: Granule.h:884
#define False
Definition: Granule.h:538
#define INDEX_1000M_REFL
Definition: Granule.h:575
float32 u3[NUM_REFLECTIVE_DETECTORS][NUM_MIRROR_SIDES]
Definition: L1B_Tables.h:744
float32 DN_obc_1km_day_avg[MAX_1KM_TRACK_DIM][NUM_1000M_DAY_BANDS][NUM_1KM_SUBSAMP]
Definition: Preprocess.h:120