OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
sc_att.f
Go to the documentation of this file.
1  subroutine sc_att(gaclac,tlm,navqc,att_ang,attangfl,
2  1 iret)
3 c
4 c sc_att(gaclac,tlm,navqc,att_ang,attangfl,iret)
5 c
6 c Purpose: process spacecraft provided attitude to every scan line
7 c
8 c Calling Arguments:
9 c
10 c Name Type I/O Description
11 c -------- ---- --- -----------
12 c gaclac I*4 I flag for GAC or LAC data. If LAC
13 c data, a time exists for each scan
14 c line, else only once every 5 lines
15 c and the lines are 4scan lines apart
16 c tlm struct I telemetry data structure containing
17 c the S/C attitude
18 c navqc struct I navigation quality control info
19 c att_ang R*4 O 3 by nlines array of spacecraft yaw,
20 c roll and pitch
21 c attangfl I*4 O array of flags for the attitude values
22 c iret I*4 O return code, 0 - good
23 c
24 c By: W. Robinson, GSC, 25 Mar 93
25 c
26 c Notes:
27 c
28 c Modification History:
29 c
30  implicit none
31 #include "tlm_str.fin"
32 #include "navqc_s.fin"
33  type(tlm_struct) :: tlm
34  type(navqc_struct) :: navqc
35 c
36  integer*4 gaclac, iret, attangfl(maxlin)
37  real*4 att_ang(3,maxlin)
38 c
39  real*4 toldif(3)
40 c
41  integer*4 i1, i2, nper, ilin, nlines, i
42  logical found, end
43  real*4 tolmult, diff(3)
44 
45 c
46 c
47 c set up some controls
48 c
49  nper = 1
50  tolmult = 1.
51  if( gaclac .eq. 1 ) then
52  nper = 5 ! # actual lines per tlm line
53  tolmult = 4. ! second tolerence multiplier
54  end if
55 c
56  nlines = nper * tlm%ntlm
57 c
58 c flag any unflagged attitude with pitch, roll, or
59 c yaw out of tolerence
60 c
61  do ilin = 1, tlm%ntlm
62  if( tlm%sc_att%flag(ilin) .eq. 0 ) then
63  if( ( tlm%sc_att%att(1,ilin) .lt. navqc%sc_att(1,1) ) .or.
64  1 ( tlm%sc_att%att(1,ilin) .gt. navqc%sc_att(2,1) ) .or.
65  1 ( tlm%sc_att%att(2,ilin) .lt. navqc%sc_att(1,2) ) .or.
66  1 ( tlm%sc_att%att(2,ilin) .gt. navqc%sc_att(2,2) ) .or.
67  1 ( tlm%sc_att%att(3,ilin) .lt. navqc%sc_att(1,3) ) .or.
68  1 ( tlm%sc_att%att(3,ilin) .gt. navqc%sc_att(2,3) ) )
69  1 tlm%sc_att%flag(ilin) = 1
70  end if
71  end do
72 c
73 c check the consistency of angles
74 c
75  i2 = 0 ! i1, i2 are pointers to consecutive good values
76  end = .FALSE. ! true if the last unflagged value was found
77  found = .false. ! to signal that a consistent pair was found
78 c
79 c start out by finding the next unflagged S/C attitude value
80 c
81  call fndflg(tlm%sc_att%flag, tlm%ntlm, 1, i1 )
82  if( i1 .le. 0 ) then
83 c
84 c no unflagged values found at all, return with error
85 c
86  iret = -1
87  write( 6, 100 )
88  100 format(' SC_ATT: no unflagged S/C based attitude values found')
89  go to 990
90  end if
91 c
92 c place the next unflagged location in i2 and compare values
93 c
94  do while( .not. end )
95  call fndflg(tlm%sc_att%flag, tlm%ntlm, (i1 + 1), i2 )
96  if( i2 .le. 0 ) then
97  end = .TRUE.
98  else
99  found = .true.
100 c
101 c do the actual consistency checks
102 c
103  do i = 1,3
104  diff(i) = tlm%sc_att%att(i,i2) - tlm%sc_att%att(i,i1)
105  toldif(i) = navqc%att_del(i) * ( i2 - i1 ) *
106  1 nper * tolmult
107  end do
108 c
109  if( ( diff(1) .gt. toldif(1) ) .or.
110  1 ( diff(2) .gt. toldif(2) ) .or.
111  1 ( diff(3) .gt. toldif(3) ) ) then
112  tlm%sc_att%flag(i1) = 1
113  tlm%sc_att%flag(i2) = 1
114  end if
115 c
116 c for next pair, move secind pointer to the first
117  i1 = i2
118  end if
119  end do
120 c
121 c make sure a consistent pair was found
122 c
123  if( .not. found ) then
124  iret = -1
125  write( 6, 500 )
126  500 format(' SC_ATT: no consistent pairs of S/C based attitude were
127  1 found')
128  go to 990
129  end if
130 c
131 c fit the attitude values to the line-by-line array
132 c
133  call fitrng(tlm%sc_att%att, tlm%ntlm, 3, tlm%sc_att%flag,
134  1 nper, att_ang, attangfl)
135 c
136 c and end
137 c
138  990 continue
139  return
140  end
#define real
Definition: DbAlgOcean.cpp:26
subroutine sc_att(gaclac, tlm, navqc, att_ang, attangfl, iret)
Definition: sc_att.f:3
subroutine fndflg(flag, nflag, istndx, next)
Definition: fndflg.f:2
subroutine fitrng(meas, nmeas, nquant, flag, nper, measout, flgout)
Definition: fitrng.f:3
subroutine diff(x, conec, n, dconecno, dn, dconecmk, units, u, inno, i, outno, o, input, deriv)
Definition: ffnet.f:205