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