OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
orbcomp.f
Go to the documentation of this file.
1  subroutine orbcomp(input, nframes, orbit, ier)
2 
3 c $header$
4 c $log$
5 c
6 c purpose: this routine performs filtering of the gps data for
7 c subsequent navigation processing. it unpacks the gps data from
8 c the converted spacecraft telemetry and fits the valid data to an
9 c orbit model. the filtered vectors are stored at 1-minute
10 c intervals in the structure orbit. filtering methods are
11 c described in the document tbd.
12 c
13 c the orbit filtering routines information from three external
14 c files: elements.dat, a direct-access binary file which stores
15 c the mean element sets used to initialize the orbit
16 c integrator and save the results of the orbit filtering;
17 c asap_parms.dat, which contains the gravitational model
18 c terms and other parameters needed by asap to integrate
19 c the orbit; and
20 c orbctl.nl, which contains user-specifiable parameters
21 c in fortran namelist format (see below).
22 c all files are assumed to be located in the directory specified
23 c by the environmental variable orbctl.
24 c
25 c calling arguments:
26 c
27 c name Type i/o description
28 c -------- ---- --- -----------
29 c input struct i input data structure
30 c nframes i*4 i number of frames in input structure
31 c orbit struct i output orbit data structure
32 c ier i*4 i error code: =0, success
33 c
34 c
35 c parameters in namelist /orbctl/:
36 c
37 c name Type Default description
38 c -------- ---- ------- -----------
39 c updtol(6) r*8 0.002, 1.d-5, tolerance for iteration of orbital
40 c 0.001, 0.001, element updates
41 c 0.1, 0.001
42 c s0(6) r*8 1.d4,2*4.d6, state weights for least-squares
43 c 3*4.d5 determination of element updates
44 c gps_scal_p r*8 1.0 scale factor for gps position vectors
45 c fit l*4 .true. Use fitted elements if available
46 c iplt i*4 0 If >0, write asap output to file
47 c pmaglm(2) r*8 7070., 7110 validation limits for checking
48 c orbit position magnitude
49 c li, mi i*4 21, 12 order and degree of gravity model
50 c ndmax i*4 7 maximum days to propagate previous
51 c orbital elements
52 c
53 c by: frederick s. patt, gsc, december 21, 1993
54 c
55 c notes:
56 c
57 c modification history:
58 c
59 c modified to allow for processing of non-contiguous data: added calls
60 c to add_elements and vec2mean, and changes logic of calls to put_elements.
61 c f.s. patt, gsc, october 26, 1994.
62 c
63 c modified to limit maximum updates to elements per iteration.
64 c f. s. patt, gsc, january 28, 1996.
65 c
66 c modified to add limit checks to orbit position magnitude
67 c f. s. patt, gsc, may 8, 1996.
68 c
69 c modified to limit number of iterations on gps fitting.
70 c f. s. patt, saic gsc, july 22, 1998.
71 c
72 c modified to return error if initial elements are more than n days
73 c prior to data, where n is a namelist parameter defaulting to 7.
74 c f. s. patt, saic gsc, january 11, 2001.
75 c
76 c modified to force gps fitting for multi-orbit gac files.
77 c f. s. patt, saic, april 2, 2003.
78 c
79 c modified to update error message for stale elements.dat file to
80 c reflect end of NASA data collection on December 23, 2004.
81 c f. s. patt, saic, january 5, 2005.
82 
83  implicit none
84 #include "nav_cnst.fin"
85 #include "input_s.fin"
86 #include "orbit_s.fin"
87 
88  type(input_struct) :: input(maxlin)
89  type(orbit_struct) :: orbit
90 
91  real*8 gpsvec(6,maxlin),gpsec(maxlin),asap(6,maxlin),tsap(maxlin)
92  real*8 vecs(6,maxlin),driv(6,3,maxlin)
93  real*8 orbinit(6),orbupd(6),orbend(6),updorb(6),maxupd(6)
94  real*8 secinit,secst,secend,cdrg,ge,aj2,tdif,oneorb
95  real*8 updtol(6),s0(6),gps_scal_p,tdifmax,wdifac,pmaglm(2)
96  integer*4 nsig(maxlin),nframes,igyr,igday,ngps,jd,i,j,ilast,ir
97  integer*4 iyinit,idinit,irec,iddif,nstp,nstr,niter,maxit
98  integer*4 lun,li,mi,iplt,ier,nmin,ndmax
99  logical iter,fit,write,init
100  character*80 filnm
101 c namelist parameters
102  namelist /orbctl/updtol,s0,gps_scal_p,fit,nmin,iplt,pmaglm,li,mi,
103  * ndmax
104  data ge/3.9860050d5/,aj2/0.10826270e-02/
105  data li/21/,mi/21/,iplt/0/,nmin/3/,lun/17/
106  data updtol/0.002d0,1.d-5,1.d-3,1.d-3,0.1d0,1.d-3/
107  data s0/1.d4,2*4.d6,3*4.d5/
108  data gps_scal_p/1.d0/,tdifmax/86400.d0/,ndmax/7/
109  data pmaglm/7070.d0, 7110.d0/
110  data fit/.true./
111  data maxit/10/
112  data oneorb/5940.d0/
113 
114 c Open file and read namelist
115  filnm = '$ORBCTL/orbctl.nl'
116  call filenv(filnm,filnm)
117  open (18,file=filnm,status='old')
118  read (18,nml=orbctl)
119  write (*,nml=orbctl)
120  close (18)
121 
122 c set maximum update per iteration to 500 times tolerance
123 c(a swag, may get more sophisticated in the future)
124  do i=1,6
125  maxupd(i) = 500.* updtol(i)
126  end do
127 
128 c unpack gps data
129  call read_gps(input,nframes,gps_scal_p,pmaglm,gpsvec,nsig,
130  * igyr,igday,gpsec,secst,secend,ngps)
131 
132 c If multi-orbit gac data, force gps fitting
133  if ((input(1)%sc_id(2).eq.15).and.((secend-secst).gt.oneorb)) then
134  fit = .false.
135  end if
136 
137 c If less than minimum number of gps, use fitted elements
138  if (ngps.lt.nmin) fit = .true.
139 
140 c get initial elements from last processing
141  call get_elements(igyr,igday,secst,secend,fit,orbinit,cdrg,
142  * iyinit,idinit,secinit,irec,ier)
143  if (ier.ne.0) go to 999
144 
145 c If elements are not recent, propagate orbit and insert placeholders in
146 c element file
147  iddif = jd(igyr,1,igday) - jd(iyinit,1,idinit)
148  tdif = iddif*864.d2 + secst - secinit
149  if (tdif.gt.tdifmax) then
150 
151 c check for stale elements.dat tfile
152  if (tdif.gt.(ndmax*tdifmax)) then
153  ier = 1
154  orbit%nvec = 0
155  print *,' '
156  print *,'**************************************************'
157  print *,' '
158  print *,' ELEMENTS MORE THAN',ndmax,' DAYS PRIOR TO DATA'
159  print *,' '
160  print *,' FOR DATA PRIOR TO DECEMBER 24, 2004'
161  print *,' PLEASE DOWNLOAD THE LATEST ELEMENTS.DAT FILE'
162  print *,' FROM THE NASA/GSFC SEAWIFS PROJECT'
163  print *,' '
164  print *,' FOR ALL SUBSEQUENT DATA'
165  print *,' PLEASE CONTACT ORBIMAGE (www.orbimage.com)'
166  print *,' '
167  print *,'**************************************************'
168  print *,' '
169  go to 999
170 
171  else
172 
173  call add_elements(orbinit,cdrg,iyinit,idinit,secinit,
174  * igyr,igday,secst,tdifmax,irec)
175 
176 c reduce state weights to account for uncertainty in propagation
177  wdifac = (tdif/tdifmax)**2
178  do i=1,6
179  s0(i) = s0(i)/wdifac
180  end do
181 
182  end if
183  end if
184 
185  write = .not.fit
186 
187 c If less than minimum number of data points or we are using fitted elements
188 c do not fit elements to gps.
189  if (ngps.lt.nmin) then
190  iter = .false.
191  write = .false.
192  else
193  iter = (.not.fit)
194  end if
195 
196  do i=1,6
197  orbupd(i) = orbinit(i)
198  end do
199 
200 c compute number of integrated vectors required at 1 minute intervals
201  iddif = jd(igyr,1,igday) - jd(iyinit,1,idinit)
202  nstp = iddif*1440.d0 + (secend - secinit)/60.d0 + 90
203 
204 c Call asap to integrate orbit
205  call asaps(li,mi,iplt,orbupd,iyinit,idinit,secinit,nstp,cdrg,
206  * tsap,asap)
207 
208  niter = 0
209 
210  do while (iter.and.(niter.lt.maxit))
211 
212 c now start fitting algorithm
213 
214 c rotate asap vectors to ecef and interpolate to gps times
215  call asap_rot_int(nstp,iyinit,idinit,tsap,asap,ngps,
216  * igyr,igday,gpsec,vecs)
217 
218 c compute partial derivatives for orbit vectors with respect to elements
219  call pderiv(ngps,igyr,igday,gpsec,vecs,orbupd,iyinit,idinit,
220  * secinit,driv)
221 
222 c compute updates to orbital elements
223  call fitgps(ngps,gpsvec,nsig,vecs,driv,s0,updorb)
224 
225 c update orbital elements
226  iter = .false.
227 
228 c Do some checks on updates
229 
230 c If semimajor axis or mean anomaly change by large amounts, hold other
231 c elements constant
232  if ((abs(updorb(1)).gt.maxupd(1)).or.
233  * (abs(updorb(6)).gt.maxupd(6))) then
234  do i=2,5
235  updorb(i) = 0.d0
236  end do
237 
238  else
239 
240 c Else check for update in other elements greater than maximum iteration
241  do i=2,5
242  if (abs(updorb(i)).gt.maxupd(i))
243  * updorb(i) = sign(maxupd(i),updorb(i))
244  end do
245  end if
246 
247 c If eccentricity would be negative, limit correction
248  if ((updorb(2)+orbupd(2)).lt.0.d0) updorb(2) = -orbupd(2)
249 
250 c apply updates
251  do i=1,6
252  orbupd(i) = orbupd(i) + updorb(i)
253 
254 c check if elements have converged within tolerance; if not,
255 c another iteration is required
256  if (abs(updorb(i)).gt.updtol(i)) iter = .true.
257  end do
258  orbupd(6) = orbupd(6) - updorb(5)
259  print *,updorb
260 
261  call asaps(li,mi,iplt,orbupd,iyinit,idinit,secinit,nstp,cdrg,
262  * tsap,asap)
263 
264  niter = niter + 1
265 
266  end do
267 
268  if (niter.ge.maxit) then
269  ier = 1
270  write = .false.
271  print *, ' ORBCOMP: MAX ITERATIONS PERFORMED'
272  end if
273 
274 c now perform final orbit processing
275  call asap_rots(iyinit,idinit,tsap,asap,nstp,vecs)
276 
277  nstr = iddif*1440.d0 + (secst - secinit)/60.d0
278  orbit%nvec = nstp - nstr + 1
279  orbit%iyr = iyinit
280  orbit%iday = idinit
281  do i=nstr,nstp
282  orbit%torb(i-nstr+1) = tsap(i)
283  do j=1,3
284  orbit%pos(j,i-nstr+1) = vecs(j,i)
285  orbit%vel(j,i-nstr+1) = vecs(j+3,i)
286  end do
287  end do
288 
289 c If elements were computed for this interval, write elements for start
290 c and end of interval to file
291  if (write) then
292 
293 c Open elements file
294  filnm = '$ELEMENTS/elements.dat'
295  call filenv(filnm,filnm)
296  open(lun,file=filnm,status='old',access='direct',err=990,
297  * recl=128)
298 
299 c first write any placeholder records at ascending node crossings
300  ir = irec
301  init = .true.
302  do i=2,nstr
303  if ((asap(3,i).gt.0.).and.(asap(3,i-1)).lt.0.) then
304  ir = ir + 1
305  call vec2mean(asap(1,i),ge,aj2,orbupd,orbend,ier)
306  call put_elements(lun,orbend,cdrg,iyinit,idinit,tsap(i),
307  * ir,init)
308  ilast = i
309  end if
310  end do
311 
312 c Write fitted elements to file
313  init = .false.
314  if (ir.eq.irec) then
315  call put_elements(lun,orbupd,cdrg,iyinit,idinit,secinit,
316  * irec,init)
317  else
318  call put_elements(lun,orbend,cdrg,iyinit,idinit,tsap(ilast),
319  * ir,init)
320  end if
321 
322 c Write elements for remainder of interval at ascending node crossings
323  do i=nstr+1,nstp
324  if ((asap(3,i).gt.0.).and.(asap(3,i-1)).lt.0.) then
325  init = .true.
326  ir = ir + 1
327  call vec2mean(asap(1,i),ge,aj2,orbupd,orbend,ier)
328  call put_elements(lun,orbend,cdrg,iyinit,idinit,tsap(i),
329  * ir,init)
330 
331 c If not end of interval, write as fitted elements
332  if ((nstp-i).gt.90) then
333  init = .false.
334  call put_elements(lun,orbend,cdrg,iyinit,idinit,tsap(i),
335  * ir,init)
336  end if
337  end if
338  end do
339 
340  close (lun)
341  end if
342  return
343 
344  990 print *, 'PUT_ELEMENTS: Error opening elements file'
345  close(lun)
346 
347  999 return
348  end
int navigation(int32_t fileID)
Definition: l1_octs_hdf.c:696
===========================================================================V4.1.3 12/18/2002============================================================================Changes which do not affect scientific output:1. The R *LUT was eliminated and the equivalent formulation for R *, i.e. 1/(m1 *e_sun_over_pi), was substituted for it in the only instance of its use, which is in the calculation of the RSB uncertainty index. This reduces the size of the Reflective LUT HDF file by approximately 1/4 to 1/3. The equivalent formulation of R *differed from the new by at most 0.056% in test granules and uncertainty differences of at most 1 count(out of a range of 0-15) were found in no more than 1 in 100, 000 pixels. 2. In Preprocess.c, 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 purpose. 3. NEW MYD02OBC Metadata Configuration Files. MCST wishes to have the OBC files archived even when the Orbit Number is recorded as "-1". Accordingly, ECS has delivered new MCF files for OBC output having all elements in the OrbitCalculatedSpatialDomain container set to "MANDATORY=FALSE". 4. pgs_in.version is now reset to "1" in Metadata.c before the call to look up the geolocation gringpoint information.============================================================================V4.1.1 CODE SPECIFIC TO MODIS/AQUA(FM1) 10/03/2002============================================================================Two changes were made to the code which do not affect scientific output:1. A bug which caused PGE02 to fail when scans were dropped between granules was fixed.(The length of the error message generated was shortened.) 2. Messages regarding an invalid MCST LUT Version or an invalid Write High Resolution Night Mode Output value in the PCF file were added.==============================================================================V4.1.0 CODE SPECIFIC TO MODIS/AQUA(FM1)(NEVER USED IN PRODUCTION) 07/30/2002==============================================================================Changes which impact scientific output of code:1. The LUT type of the RVS corrections was changed to piecewise linear. In addition the RVS LUTs were changed from listing the RVS corrections to listing the quadratic coefficients necessary to make the RVS corrections. The coefficients are now calculated by interpolating on the granule collection time and the RVS corrections are then generated using the interpolated coefficients. Previously used Emissive and Reflective RVS LUT tables were eliminated and new ones introduced. Several changes were made to the code which should not affect scientific output. They are:1. The ADC correction algorithm and related LUTs were stripped from the code.(The ADC correction has always been set to "0" so this has no scientific impact.) 2. Some small changes to the code, chiefly to casting of variables, were added to make it LINUX-compatible. Output of code run on LINUX machines displays differences of at most 1 scaled integer(SI) from output of code run on IRIX machines. The data type of the LUT "dn_sat_ev" was changed to float64 to avoid discrepancies seen between MOD_PR02 run on LINUX systems and IRIX systems where values were flagged under one operating system but not the other. 3. Checking for non-functioning detectors, sector rotation, incalculable values of the Emissive calibration factor "b1", 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. 4. The code was altered so that if up to five scans are dropped between the leading/middle or middle/trailing granules, the leading or trailing granule will still be used in emissive calibration to form a cross-granule average. QA bits 25 and 26 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. 5.(MODIS/AQUA ONLY) The name of the seed(error message) file was changed from "MODIS_36100.h" to "MODIS_36110.h". 6. Metadata.c was changed so that the source of the geolocation metadata is the input geolocation file rather than the L1A granule. 7. To reduce to overall size of the reflective LUT HDF files, fill values were eliminated from all LUTs previously dimensioned "BDSM"([NUM_REFLECTIVE_BANDS] *[MAX_DETECTORS_PER_BAND] *[MAX_SAMPLES_PER_BAND] *[NUM_MIRROR_SIDES]) in the LUT HDF files. Each table piece is stored in the HDF file with dimensions NUM_REFLECTIVE_INDICES, where NUM_REFLECTIVE_INDICES=[NUM_250M_BANDS *DETECTORS_PER_250M_BAND *SAMPLES_PER_250M_BAND *NUM_MIRROR_SIDES]+[NUM_500M_BANDS *DETECTORS_PER_500M_BAND *SAMPLES_PER_500M_BAND *NUM_MIRROR_SIDES]+[NUM_1000M_BANDS *DETECTORS_PER_1KM_BAND *SAMPLES_PER_1KM_BAND *NUM_MIRROR_SIDES] with SAMPLES_PER_250M_BAND=4, SAMPLES_PER_500M_BAND=2, and SAMPLES_PER_1KM_BAND=1. Values within each table piece appear in the order listed above. The overall dimensions of time dependent BDSM LUTs are now[NUM_TIMES] *[NUM_REFLECTIVE_INDICES], where NUM_TIMES is the number of time dependent table pieces. 8. Checking for non-functioning detectors, sector rotation, incalculable values of the Emissive calibration factor "b1", 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. 9. The code was altered so that if up to five scans are dropped between the leading/middle or middle/trailing granules, the leading or trailing granule will still be used in emissive calibration to form a cross-granule average. QA bits 25 and 26 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. 10. The array of b1s in Preprocess.c was being initialized to -1 outside the loop over bands, which meant that if b1 could not be computed, the value of b1 from the previous band for that scan/detector combination was used. The initialization was moved inside the band loop.============================================================================V3.1.0(Original Aqua-specific code version) 02/06/2002============================================================================AQUA-Specific changes made:1. A correction to a problem with blackbody warmup on bands 33, 35, and 36 was inserted. PC Bands 33, 35, and 36 on MODIS Aqua saturate on BB warmup before 310K, which means current code will not provide correct b1 calibration coefficients when the BB temperatures are above the saturation threshold. A LUT with default b1s and band-dependent temperature thresholds will be inserted in code. If the BB temperature is over the saturation threshold for the band, the default b1 from the table is used. 2. The number of possible wavelengths in the Emissive LUT RSR file was changed to 67 in order to accommodate the Aqua RSR tables. 3. Several changes to the upper and lower bound limits on LUT values were inserted. Changes to both Aqua and Terra Code:1. A check was put into Emissive_Cal.c to see whether the value of b1 being used to calibrate a pixel is negative. If so, the pixel is flagged with the newly created flag TEB_B1_NOT_CALCULATED, value 65526, and the number of pixels for which this occurs is counted in the QA_common table. 2. The array of b1s in Preprocess.c was being initialized to -1 outside the loop over bands, which meant that if b1 could not be computed, the value of b1 from the previous band for that scan/detector combination was used. The initialization was moved inside the band loop. 3. Minor code changes were made to eliminate compiler warnings when the code is compiled in 64-bit mode. 4. Temperature equations were upgraded to be MODIS/Aqua or MODIS/Terra specific and temperature conversion coefficients for Aqua were inserted.========================================================================================================================================================ALL CHANGES BELOW ARE TO COMMON TERRA/AQUA CODE USED BEFORE 02/06/2002========================================================================================================================================================v3.0.1 11/26/2001============================================================================Several small changes to the code were made, none of which changes the scientific output:1. The code was changed so that production of 250m and 500m resolution data when all scans of a granule are in night mode may be turned off/on through the PCF file. 2. A check on the times of the leading and trailing granules was inserted. If a leading or trailing granule does not immediately precede or follow(respectively) the middle granule, it is treated as a missing granule and a warning message is printed. 3. The code now reads the "MCST Version Number"(e.g. "3.0.1.0_Terra") from the PCF file and checks it against the MCST Version number contained in the LUT HDF files. This was done to allow the user to make sure the code is being run using the correct LUT files.(The designators "0_Terra", "1_Terra", etc.) refer to the LUT versions.) 4. A small bug in Preprocess.c was corrected code
Definition: HISTORY.txt:661
float mean(float *xs, int sample_size)
Definition: numerical.c:81
double reflect(double *pnts, double y[], double psum[], short ndim, FITSTRUCT *auxdata, double(*func)(FITSTRUCT *, double[]), short ibig, float fac)
Definition: amoeba.c:87
void initialize(int pixref_flag, int blkref_flag)
Definition: Usds.c:1371
#define sign(x)
Definition: misc.h:95
void fit(float x[], float y[], int ndata, float sig[], int mwt, float *a, float *b, float *siga, float *sigb, float *chi2, float *q)
#define real
Definition: DbAlgOcean.cpp:26
subroutine asap_rot_int(nstp, iyinit, idinit, tsap, asap, ngps, igyr, igday, gpsec, vecs)
Definition: asap_rot_int.f:3
subroutine add_elements(orbinit, cdrg, iyinit, idinit, secinit, igyr, igday, secst, tdifmax, irec)
Definition: add_elements.f:3
subroutine vec2mean(vec, ge, aj2, xinit, xmean, ier)
Definition: vec2mean.f:2
subroutine filenv(infil, outfil)
Definition: filenv.f:2
void interpolate(int16_t PA_flag, int16_t parm_flag, double DT1, double DT2, float in_lat, float in_lon, float *lat_list, float *lon_list, void *data_p1, void *data_p2, int8_t *qc1, int8_t *qc2, float *intpdata, float *anc_unc, int32_t *int_qc)
Definition: getanc.c:1314
int state(double tjdTDB, JPLIntUtilType *util, double posvel[13][6], double *pnut)
subroutine ecef(gha, posi, veli, pose, vele)
Definition: ecef.f:2
if(BUILD_JPL) add_executable(interp_hycom interp_hycom.f) add_executable(interp_hycom_ascii interp_hycom_ascii.f) add_executable(tec tec.c) add_executable(swh swh.c) target_link_libraries(interp_hycom netcdff dfutils $
Definition: CMakeLists.txt:127
subroutine pderiv(ngps, igyr, igday, gpsec, vecs, orbinit, iyinit, idinit, secinit, driv)
Definition: pderiv.f:3
subroutine asaps(LI, MI, IPLT, ORBIN, IYR, IDAY, SEC, NSTP, CDRG, TVEC, XVEC)
Definition: asaps.f:3
subroutine read_gps(input, nframes, scal_p, xmaglm, gpsvec, nsig, igyr, igday, gpsec, secst, secend, ngps)
Definition: read_gps.f:3
Definition: jd.py:1
===========================================================================V5.0.48(Terra) 03/20/2015 Changes shown below are differences from MOD_PR02 V5.0.46(Terra)============================================================================Changes noted for V6.1.20(Terra) below were also instituted for this version.============================================================================V6.1.20(Terra) 03/12/2015 Changes shown below are differences from MOD_PR02 V6.1.18(Terra)============================================================================Changes from v6.1.18 which may affect scientific output:A situation can occur in which a scan which contains sector rotated data has a telemetry value indicating the completeness of the sector rotation. This issue is caused by the timing of the instrument command to perform the sector rotation and the recording of the telemetry point that reports the status of sector rotation. In this case a scan is considered valid by L1B and pass through the calibration - reporting extremely high radiances. Operationally the TEB calibration uses a 40 scan average coefficient, so the 20 scans(one mirror side) after the sector rotation are contaminated with anomalously high radiance values. A similar timing issue appeared before the sector rotation was fixed in V6.1.2. Our analysis indicates the ‘SET_FR_ENC_DELTA’ telemetry correlates well with the sector rotation encoder position. The use of this telemetry point to determine scans that are sector rotated should fix the anomaly occured before and after the sector rotation(usually due to the lunar roll maneuver). The fix related to the sector rotation in V6.1.2 is removed in this version.============================================================================V6.1.18(Terra) 10/01/2014 Changes shown below are differences from MOD_PR02 V6.1.16(Terra)============================================================================Added doi attributes to NRT(Near-Real-Time) product.============================================================================V6.1.16(Terra) 01/27/2014 Changes shown below are differences from MOD_PR02 V6.1.14(Terra)============================================================================Migrate to SDP Toolkit 5.2.17============================================================================V6.1.14(Terra) 06/26/2012 Changes shown below are differences from MOD_PR02 V6.1.12(Terra)============================================================================Added the doi metadata to L1B product============================================================================V6.1.12(Terra) 04/25/2011 Changes shown below are differences from MOD_PR02 V6.1.8(Terra)============================================================================1. The algorithm to calculate uncertainties for reflective solar bands(RSB) is updated. The current uncertainty in L1B code includes 9 terms from prelaunch analysis. The new algorithm regroups them with the new added contributions into 5 terms:u1:the common term(AOI and time independent) and
Definition: HISTORY.txt:126
set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -DWITH_MPI") target_link_libraries(afrt_nc4 $
Definition: CMakeLists.txt:16
subroutine asap_rots(iyinit, idinit, tsap, asap, nstp, vecs)
Definition: asap_rots.f:2
#define semimajor
Definition: vincenty.c:25
subroutine get_elements(iyr, iday, sec, secend, fit, orbout, cdrg, iyorb, idorb, secorb, irec, ier)
Definition: get_elements.f:3
#define f
Definition: l1_czcs_hdf.c:702
subroutine orbcomp(input, nframes, orbit, ier)
Definition: orbcomp.f:2
subroutine fitgps(ngps, gps, nsig, vecs, driv, s0, updorb)
Definition: fitgps.f:2
#define abs(a)
Definition: misc.h:90
this program makes no use of any feature of the SDP Toolkit that could generate such a then geolocation is calculated at that and then aggregated up to Resolved feature request Bug by adding three new int8 SDSs for each high resolution offsets between the high resolution geolocation and a bi linear interpolation extrapolation of the positions This can be used to reconstruct the high resolution geolocation Resolved Bug by delaying cumulation of gflags until after validation of derived products Resolved Bug by setting Latitude and Longitude to the correct fill resolving to support Near Real Time because they may be unnecessary if use of entrained ephemeris and attitude data is turned on(as it will be in Near-Real-Time processing).
subroutine direct(N, M, N1, M1, NN, MM, C)
Definition: tmd.lp.f:1299
void rotate(float **r, float **qt, int n, int i, float a, float b)
algorithm
Definition: DDProcess.h:25
subroutine put_elements(lun, orbupd, cdrg, iyr, iday, sec, irec, init)
Definition: put_elements.f:2