OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
get_l1a_record.f
Go to the documentation of this file.
1  subroutine get_l1a_record( prod_ID, npix, irec, dat, nav_orb_vec,
2  1 nav_sun_ref, nav_sen_mat, nav_scan_ell, iret)
3 
4  real*4 nav_orb_vec(3), nav_sun_ref(3), nav_sen_mat(3,3),
5  1 nav_scan_ell(6)
6  integer*4 prod_ID
7  integer*2 dat(8,1285)
8  integer*4 l1_id, or_id, su_id, se_id, sc_id, nf_id, ind
9  integer*4 istart(3), istr(3), idims(3), nflags(8)
10  integer sfn2index, sfselect, sfrdata
11  logical first/.true./
12  data istart/3*0/, istr/3*1/, idims/3*1/
13 
14  common /idcom/l1_id, or_id, su_id, se_id, sc_id, nf_id
15 
16 
17  if (irec.eq.0) then
18 
19  ind = sfn2index(prod_id, 'l1a_data')
20  if (ind.eq.-1) then
21  iret = -1
22  write(*,*) 'Error getting index for l1a_data'
23  return
24  end if
25  l1_id = sfselect(prod_id, ind)
26  if (l1_id.eq.-1) then
27  iret = -1
28  write(*,*) 'Error selecting l1a_data'
29  return
30  end if
31 
32  ind = sfn2index(prod_id, 'orb_vec')
33  if (ind.eq.-1) then
34  iret = -1
35  write(*,*) 'Error getting index for orb_vec'
36  return
37  end if
38  or_id = sfselect(prod_id, ind)
39  if (or_id.eq.-1) then
40  iret = -1
41  write(*,*) 'Error selecting orb_vec'
42  return
43  end if
44 
45  ind = sfn2index(prod_id, 'sun_ref')
46  if (ind.eq.-1) then
47  iret = -1
48  write(*,*) 'Error getting index for sun_ref'
49  return
50  end if
51  su_id = sfselect(prod_id, ind)
52  if (su_id.eq.-1) then
53  iret = -1
54  write(*,*) 'Error selecting sun_ref'
55  return
56  end if
57 
58  ind = sfn2index(prod_id, 'sen_mat')
59  if (ind.eq.-1) then
60  iret = -1
61  write(*,*) 'Error getting index for sen_mat'
62  return
63  end if
64  se_id = sfselect(prod_id, ind)
65  if (se_id.eq.-1) then
66  iret = -1
67  write(*,*) 'Error selecting sen_mat'
68  return
69  end if
70 
71  ind = sfn2index(prod_id, 'scan_ell')
72  if (ind.eq.-1) then
73  iret = -1
74  write(*,*) 'Error getting index for scan_ell'
75  return
76  end if
77  sc_id = sfselect(prod_id, ind)
78  if (sc_id.eq.-1) then
79  iret = -1
80  write(*,*) 'Error selecting scan_ell'
81  return
82  end if
83 
84  ind = sfn2index(prod_id, 'nflag')
85  if (ind.eq.-1) then
86  iret = -1
87  write(*,*) 'Error getting index for nflag'
88  return
89  end if
90  nf_id = sfselect(prod_id, ind)
91  if (sc_id.eq.-1) then
92  iret = -1
93  write(*,*) 'Error selecting nflag'
94  return
95  end if
96 
97  end if
98 
99  istart(2) = irec
100  idims(1) = 8
101  iret = sfrdata(nf_id, istart, istr, idims, nflags)
102  if (iret.eq.-1) then
103  write(*,*) 'End of l1a_data'
104  return
105  end if
106 
107  dowhile(nflags(1).ne.0)
108  irec = irec + 1
109  istart(2) = irec
110  iret = sfrdata(nf_id, istart, istr, idims, nflags)
111  if (iret.eq.-1) then
112  write(*,*) 'End of l1a_data'
113  return
114  end if
115  end do
116 
117  istart(2) = 0
118  istart(3) = irec
119  idims(1) = 8
120  idims(2) = npix
121  iret = sfrdata(l1_id, istart, istr, idims, dat)
122  if (iret.eq.-1) then
123  write(*,*) 'End of l1a_data'
124  return
125  end if
126 
127  idims(1) = 3
128  idims(2) = 3
129  iret = sfrdata(se_id, istart, istr, idims, nav_sen_mat)
130  if (iret.eq.-1) then
131  write(*,*) 'Error reading sen_mat'
132  return
133  end if
134 
135  istart(2) = irec
136  idims(2) = 1
137  iret = sfrdata(or_id, istart, istr, idims, nav_orb_vec)
138  if (iret.eq.-1) then
139  write(*,*) 'Error reading orb_vec'
140  return
141  end if
142 
143  iret = sfrdata(su_id, istart, istr, idims, nav_sun_ref)
144  if (iret.eq.-1) then
145  write(*,*) 'Error reading sun_ref'
146  return
147  end if
148 
149  idims(1) = 6
150  iret = sfrdata(sc_id, istart, istr, idims, nav_scan_ell)
151  if (iret.eq.-1) then
152  write(*,*) 'Error reading scan_ell'
153  return
154  end if
155 
156  irec = irec + 1
157 
158  return
159  end
160 
subroutine get_l1a_record(prod_ID, npix, irec, dat, nav_orb_vec, nav_sun_ref, nav_sen_mat, nav_scan_ell, iret)
Definition: get_l1a_record.f:3
#define real
Definition: DbAlgOcean.cpp:26