OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
getorbit.f
Go to the documentation of this file.
1  subroutine getorbit(iyr,iday,msec,iorbno,inorad,cline1,cline2)
2 c
3 c $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $
4 c $Log: getorbit.f,v $
5 c Revision 1.3 1996/04/24 20:30:48 seawifsd
6 c comments out 4 lines using 'd'(instead of 'c') based on the recommendation
7 c from Bob that the orbit number returned by this function will be consistent
8 c with the orbit number in the schedule file.
9 c
10 c Revision 1.2 1996/01/05 20:12:34 seawifsd
11 c Corrected element-file search to handle year boundaries
12 c
13 c Revision 1.1 1995/01/17 23:02:17 seawifsd
14 c Initial revision
15 c
16 c Revision 1.1 1994/08/30 20:53:29 seawifsd
17 c Initial revision
18 c
19 c Revision 1.1 1994/07/13 19:07:24 seawifst
20 c Initial revision
21 c
22 c Revision 1.3 1994/05/23 20:08:16 seawifst
23 c New version from Watson. <Mark>
24 c
25 c Revision 1.3 1994/04/18 17:10:13 seawifst
26 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $ $Log: getorbit.f,v $
27 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.4/swfnav/getorbit.f,v 1.2 1996/01/05 20:12:34 seawifsd Exp seawifsd $ Revision 1.3 1996/04/24 20:30:48 seawifsd
28 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.4/swfnav/getorbit.f,v 1.2 1996/01/05 20:12:34 seawifsd Exp seawifsd $ comments out 4 lines using 'd'(instead of 'c') based on the recommendation
29 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.4/swfnav/getorbit.f,v 1.2 1996/01/05 20:12:34 seawifsd Exp seawifsd $ from Bob that the orbit number returned by this function will be consistent
30 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.4/swfnav/getorbit.f,v 1.2 1996/01/05 20:12:34 seawifsd Exp seawifsd $ with the orbit number in the schedule file.
31 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.4/swfnav/getorbit.f,v 1.2 1996/01/05 20:12:34 seawifsd Exp seawifsd $
32 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $ Revision 1.2 1996/01/05 20:12:34 seawifsd
33 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $ Corrected element-file search to handle year boundaries
34 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $
35 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $ Revision 1.1 1995/01/17 23:02:17 seawifsd
36 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $ Initial revision
37 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $
38 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $ Revision 1.1 1994/08/30 20:53:29 seawifsd
39 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $ Initial revision
40 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $
41 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $ Revision 1.1 1994/07/13 19:07:24 seawifst
42 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $ Initial revision
43 c Added $Header: /app/shared/RCS/irix-5.2/seawifsd/src/mops/mopsV4.5/swfnav/getorbit.f,v 1.3 1996/04/24 20:30:48 seawifsd Exp seawifsd $
44 c Revision 1.3 1994/05/23 20:08:16 seawifst
45 c New version from Watson. <Mark>
46 c
47 c Orbit number fraction is computed by first computing true
48 c anomaly instead of mean anomaly, and adding to the argument
49 c of perigee.
50 c
51 c Revision 1.4 1994/07/28 20:08:16 seawifst
52 c New version from Watson. <Mark>
53 c
54 c NORAD Two-line elements are returned from the subroutine.
55 c They are as character*69.
56 c
57 c
58 c.......................................................................
59 c Originally: rdnor.f - 20 August 92
60 c
61 c Altered and revised to: rnorad.f
62 c Kenneth S. Lambert
63 c Sea Grant - University of Maryland
64 c 15 July 1993
65 c
66 c Altered and revised to: getorbit.f
67 c Watson Gregg
68 c Code 902.3
69 c NASA/GSFC
70 c December 1993
71 c Modified for better orbit number calculation, using argument
72 c of perigee and mean anomaly, 4/18/94, WWG
73 c
74 c Modified to compute and use true anomaly in orbit number
75 c calculation, 5/93, Robert Woodward, GSC
76 c
77 c NORAD Two-line elements are returned from the subroutine.
78 c They are as character*69, 7/28/94, WWG
79 c
80 c Corrected element-file search to handle year boundaries
81 c 1/3/96, BAF
82 c
83 c Minor modifications for Sun OS compatibility. removed lenstr and
84 c filenv subroutines, as they are available as separate modules,
85 c add parens around parameter statement, and reversed save and
86 c implicit statements. B. A. Franz, 11/14/97.
87 c
88 c Given year, day of year, and time (GMT, in milliseconds), computes
89 c orbit number for SeaStar/SeaWiFS, for use by the SeaWiFS Data
90 c Processing System. Requires a recent NORAD Two-Line Element
91 c File for SeaStar. I recommend that the element file be no more
92 c than 1 week old, but if the file is updated monthly only a few (1-3)
93 c minutes of error should result. A few minutes is of no
94 c consequence to HRPT stations, since the error occurs at the
95 c crossing of the equator on ascending node (always night), but
96 c may result in error of lunar calibration files created by the
97 c SDPS.
98 c
99 c
100 c Calling argument list:
101 c Input
102 c iyr (I4,1) - year of data
103 c iday (I4,1) - day of year of data
104 c msec (I4,1) - time of day in milliseconds (GMT) of data
105 c Output
106 c iorbno (I4,1) - orbit number for the data file
107 c inorad (I4,1) - error return flag:
108 c .eq. 0 - proper return
109 c .ne. 0 - error reading input format
110 c cline1 (A69) - first line of NORAD Two-Line Elements
111 c cline2 (A69) - second line of NORAD Two-Line Elements
112 c
113 c Local Variables
114 c ifound (I4,1) - flag describing whether satellite was found
115 c iepyr (I4,1) - four digit epoch year of element set
116 c epday (R8,1) - epoch day (day of year & fraction: XXX.XXXXXXXX)
117 c elem (R8,6) - element array:
118 c (1) semi-major axis (km)
119 c (2) eccentricity
120 c (3) inclination (deg)
121 c (4) right ascension of ascending node (deg)
122 c (5) argument of perigee (deg)
123 c (6) mean anomaly (deg)
124 c iorbit (i4,1) - orbit number (revolution number) for epoch
125 c pi (R8,1) - Pi
126 c radeg (R8,1) - Radians to degrees conversion factor
127 c re (R8,1) - Earth equatorial radius (km)
128 c gm (R8,1) - Earth gravitational constant (km3/s2)
129 c bj2 (R8,1) - 2nd Spherical Harmonic Term
130 c
131 c.......................................................................
132 
133  implicit real*8 (a-h,o-z)
134  save !required for IRIX compilers
135  parameter(maxfilesrch = 30)
136  logical*1 found
137  character*69 cline1,cline2
138  character*128 noradf
139  real*8 elem(6)
140  real*8 rmanom8,reanom8,dkeplr
141  data isatnum/24883/
142  data imon/1/
143 
144 c Constants
145  pi = dacos(-1.0d0)
146  re = 6378.137d0
147  radeg = 180.0d0/pi
148  gm = 398600.5d0
149  bj2 = 1082.63d-6
150 c
151 c Variable declarations
152  pi2 = 2.0d0*pi ! 2*pi
153  inorad = 0 ! error flag
154 
155 c Open NORAD Two-Line Element file; search back in time to find
156 c most recent file
157 
158  jyr = iyr
159  jday = iday
160  icnt = 0 ! Count of number of days searched
161  found = .false.
162 
163 c !
164 c ! Begin search
165 c !
166  do while ( (icnt .lt. maxfilesrch) .and. (.not. found) )
167 
168  icnt = icnt+1
169 
170 c !
171 c ! If the file day goes to zero, convert to previous year
172 c !
173  if (jday .lt. 1) then
174 
175  jyr = iyr-1
176 
177 c !
178 c ! Check for leap year before setting new day number
179 c !
180  rlp = jyr/4.0
181  ilp = rlp
182  rchk = rlp - ilp
183 
184  if (rchk .eq. 0.0) then
185  jday = 366 ! leap year
186  else
187  jday = 365 ! non-leap year
188  endif
189 
190  endif
191 
192 c !
193 c ! Try to open the file
194 c !
195  call selfilnm(jyr,jday,noradf)
196  open(4,file=noradf,status='old',form='formatted',err=300)
197  found = .true.
198 300 continue
199 
200  jday = jday-1
201 
202  enddo
203 
204 c !
205 c ! Verify that a file was found. Exit on error.
206 c !
207  if (.not. found) then
208 
209  write(6,*)
210  write(6,*)' ERROR '
211  write(6,*)
212  write(6,*)' RECENT NORAD TWO LINE ELEMENT FILE NOT FOUND'
213  write(6,*)' FOR SEASTAR: '
214  write(6,*)' File does not exist or most recent file'
215  write(6,*)' exceeds 1 month old'
216  write(6,*)' Obtain updated element file'
217 
218  inorad = 1
219  return
220 
221  endif
222 
223 c !
224 c ! Search through file and read two line elements. look for satellite no.
225 c !
226  ieof = 0
227  ifound = 0
228  do while ((ieof .eq. 0) .and. (ifound .eq. 0))
229  read(4,'(a)',end=100,err=101) cline1
230  if (cline1(1:1) .eq. '1') then
231  read(4,'(a)',end=100,err=101) cline2
232  if (cline2(1:1) .eq. '2') then
233  read(cline1(3:7),'(i5)') isat
234  if (isat .eq. isatnum) ifound = 1
235  read(cline1(10:11),'(i2)') idyr
236  read(cline1(19:32),'(i2,f12.8)') iepyr2, epday
237  read(cline1(34:43),'(f9.8)')rndot2
238  read(cline2(8:63),'(2f9.4,i8,2f9.4)') elem(3),elem(4),
239  . iecc,
240  . elem(5),elem(6)
241  read(cline2(52:63),'(f12.8)') xmm
242  read(cline2(64:68),'(i5)') iorbit
243  else
244  backspace(4)
245  endif
246  endif
247 
248  enddo
249 
250 c Satellite found
251  if (ifound .eq. 1) then
252 
253 c Convert integer eccentricity (from assumed decimal) to real.
254  elem(2) = dble(iecc)*1.0d-7
255 
256 c Compute semi-major axis using method of SGP4
257  if (xmm .gt. 1.0d-10) then !trap for divide by zero
258  xno = xmm*pi2/1440.0d0 !mean motion in radians/min
259  tothrd = 2.0d0/3.0d0
260  xincl = elem(3)/radeg !inclination
261  eo = elem(2)
262  ck2 = abs(0.5d0*bj2) !1/2*j2*ae**2
263  xke = sqrt(gm/re**3)*60.0d0
264  a1 = (xke/xno)**tothrd
265  cosio = cos(xincl)
266  theta2 = cosio*cosio
267  x3thm1 = 3.0d0*theta2-1.0d0
268  eosq = eo*eo
269  betao2 = 1.0d0-eosq
270  betao = sqrt(betao2)
271  del1 = 1.5d0*ck2*x3thm1/(a1*a1*betao*betao2)
272  ao = a1*(1.0d0-del1*(0.5d0*tothrd+del1*
273  * (1.0d0+134.0d0/81.0d0*del1)))
274  delo = 1.5d0*ck2*x3thm1/(ao*ao*betao*betao2)
275  xnodp = xno/(1.0d0+delo)
276  aodp = ao/(1.0d0-delo) !semi-major axis in Earth radii
277  elem(1) = aodp*re !semi-major axis in km
278  else
279  inorad = 2
280  endif
281 c write(6,*)'semi-major axis = ',elem(1)
282 c Compute period using method of Casey and Way, 1991 (IEEE Trans.
283 c Geoscience and Remote Sensing)
284  dsma2 = elem(1)*elem(1)
285  dsma3 = dsma2*elem(1)
286  clsspd = 2.0*pi*sqrt(dsma3/gm) !classical period
287  cosarg = 4.0d0*cosio*cosio - 1.0
288  pcorr = 1.0 - 3.0/2.0*bj2*re*re/dsma2*cosarg
289  pdsec = clsspd*pcorr
290 c write(6,*)'pdsec = ',pdsec
291 c
292 c Output iepyr as four digits, keep within range of 1950 - 2049
293  if (iepyr2 .lt. 50) then
294  iepyr = 2000 + iepyr2
295  else
296  iepyr = 1900 + iepyr2
297  endif
298 c
299 c Convert to Julian day
300 c Compute floating point days since Jan 1.5, 2000
301 c Note that the Julian day starts at noon on the specified date
302  sec = msec*0.001d0
303  tdata = jd(iyr,imon,iday) - 2451545.0d0
304  * + (sec-43200.d0)/86400.d0
305 c write(6,*)'iyr,iday,msec,sec,tdata = ',iyr,iday,msec,sec,tdata
306  iepday = epday
307  fracday = epday - iepday
308  sec = fracday*86400.0d0
309  tepoch = jd(iepyr,imon,iepday) - 2451545.0d0
310  * + (sec-43200.d0)/86400.d0
311 c Compute orbit number as function of time difference
312 c New as of May, 1994 -- use true anomaly instead of mean anomaly
313 c fracorb = (elem(5) + elem(6))/360.0D0
314  rmanom8 = elem(6)/radeg !mean anomaly in radians
315  reanom8 = dkeplr(rmanom8,elem(2)) !eccentric anomaly
316  a = ((1-elem(2))/(1+elem(2)))**0.5
317  rtanom = 2.0 * datan(dtan((reanom8/2.0)/a)) * radeg !true anom.
318  if (rtanom .lt. .0)rtanom = rtanom + 360.0
319  fracorb = (elem(5) + rtanom)/360.0d0
320 c if (fracorb .ge. 1.0D0)then
321 c rorbit = iorbit + (fracorb-1.0D0)
322 c else
323  rorbit = iorbit + fracorb
324 c endif
325  diff = (tdata-tepoch)*86400.0d0
326  rorb = diff/pdsec + rorbit
327  iorbno = rorb
328  else !SeaStar satellite number not found in NORAD TLE file
329  print *, 'SeaStar not found in NORAD TLE file...'
330  inorad = 1
331  endif
332  go to 400
333 
334 
335 100 ieof = 1
336  print *, 'SeaStar not found in NORAD TLE file...'
337  inorad = 1
338  go to 400
339 
340 101 print *, 'Error reading ',radfilnm
341  goto 400
342 
343 400 close(4)
344  return
345  end
346 c
347 c ******************************************************************
348  subroutine selfilnm(myr,idoy,fnme)
349 c
350 c Given year, day of year, returns appropriate file name for
351 c daily NORAD Two-Line Element file for SeaStar.
352 c
353  character*128 fnme
354  character cday1*1,cday2*2,cday3*3,cday*3,c1*1,cyr*2
355  character*10 chead
356  character*4 cdat
357  character*1 zero
358 c
359 c chead = '/ftp/pub/mission-ops/sel'
360  chead = '$NORAD/sel'
361  cdat = '.dat'
362  zero = '0'
363 c
364 c Convert day
365  jday = idoy
366  if (jday .lt. 10)then
367  write(cday1,'(i1)')jday
368  cday = zero//zero//cday1
369  else if (jday .lt. 100)then
370  write(cday2,'(i2)')jday
371  cday = zero//cday2
372  else
373  write(cday3,'(i3)')jday
374  cday = cday3
375  endif
376 c
377 c Convert year
378  if (myr .le. 1999)then
379  itmp = myr - 1900
380  write(cyr,'(i2)')itmp
381  else if (myr .eq. 2000)then
382  cyr = zero//zero
383  else if (myr .lt. 2010)then
384  itmp = myr - 2000
385  write(c1,'(i1)')itmp
386  cyr = zero//c1
387  else
388  itmp = myr - 2000
389  write(cyr,'(i2)')itmp
390  endif
391 c
392 c File name
393  fnme = chead//cday//cyr//cdat
394  call filenv(fnme,fnme)
395 c
396  return
397  end
398 c
399 C ******************************************************************
400  FUNCTION dkeplr(M,E)
401  IMPLICIT REAL*8(a-h,o-z)
402  SAVE ! REQUIRED FOR IRIX
403  real*8 m,pi2/6.283185307179586d0/,tol/0.5d-15/
404 C
405 C SUBROUTINE TO SOLVE KEPLER'S EQUATION
406 C KEPLER'S EQUATION RELATES GEOMETRY OR POSITION IN ORBIT PLANE
407 C TO TIME.
408 C
409 C M - MEAN ANOMALY (O<M<2PI)
410 C E - ECCENTRICITY
411 C EA - ECCENTRIC ANOMALY
412 C
413  ea=0
414  IF(m)1,2,1
415  1 ea=m + e*dsin(m)
416  DO 22 i=1,12
417  oldea=ea
418  fe=ea-e*dsin(ea)-m
419  ea=ea-fe/(1-e*dcos(ea-0.5d0*fe))
420 C TEST FOR CONVERGENCE
421  delea=dabs(ea-oldea)
422  IF(delea.LE.tol)GO TO 2
423  22 CONTINUE
424  2 ea=dmod(ea,pi2)
425  dkeplr=ea
426  RETURN
427  END
428 C
function dkeplr(M, E)
Definition: getorbit.f:401
int32_t jday(int16_t i, int16_t j, int16_t k)
Definition: jday.c:4
#define real
Definition: DbAlgOcean.cpp:26
subroutine filenv(infil, outfil)
Definition: filenv.f:2
README for MOD_PR03(V6.1.0) 2. POINTS OF CONTACT it can be either SDP Toolkit or MODIS Packet for Terra input files The orbit validation configuration parameter(LUN 600281) must be either "TRUE" or "FALSE". It needs to be "FALSE" when running in Near Real Time mode
#define re
Definition: l1_czcs_hdf.c:701
Definition: jd.py:1
subroutine diff(x, conec, n, dconecno, dn, dconecmk, units, u, inno, i, outno, o, input, deriv)
Definition: ffnet.f:205
#define pi
Definition: vincenty.c:23
subroutine selfilnm(myr, idoy, fnme)
Definition: getorbit.f:349
subroutine getorbit(iyr, iday, msec, iorbno, inorad, cline1, cline2)
Definition: getorbit.f:2
#define abs(a)
Definition: misc.h:90