New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

obs_sla_io.h90 in branches/devukmo2010/NEMO/OPA_SRC/OBS – NEMO

Context Navigation

source: branches/devukmo2010/NEMO/OPA_SRC/OBS/obs_sla_io.h90 @ 2128

Last change on this file since 2128 was 2128, checked in by rfurner, 14 years ago
merged branches OBS, ASM, Rivers, BDY & mixed_dynldf ready for vn3.3 merge
File size: 14.2 KB

Line
1	SUBROUTINE read_avisofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
2	!!---------------------------------------------------------------------
3	!!
4	!! ROUTINE read_avisofile
5	!!
6	!! ** Purpose : Read from file the AVISO SLA observations.
7	!!
8	!! ** Method : The data file is a NetCDF file.
9	!!
10	!! ** Action :
11	!!
12	!! References : http://www.aviso.oceanobs.com
13	!!
14	!! History :
15	!! ! 09-01 (K. Mogensen) Original based on old versions
16	!!----------------------------------------------------------------------
17	!! * Arguments
18	CHARACTER(LEN=*) :: cdfilename ! Input filename
19	TYPE(obfbdata) :: inpfile ! Output obfbdata structure
20	INTEGER :: kunit ! Unit for output
21	LOGICAL :: ldwp ! Print info
22	LOGICAL :: ldgrid ! Save grid info in data structure
23	!! * Local declarations
24	CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile'
25	INTEGER :: i_file_id ! netcdf IDS
26	INTEGER :: i_tracks_id
27	INTEGER :: i_cycles_id
28	INTEGER :: i_data_id
29	INTEGER :: i_var_id
30	INTEGER, PARAMETER :: imaxdim = 2 ! Assumed maximum for no. dims. in file
31	INTEGER, DIMENSION(2) :: idims ! Dimensions in file
32	INTEGER :: iilen ! Length of netCDF attributes
33	INTEGER :: itype ! Typeof netCDF attributes
34	REAL(fbdp) :: zsca ! Scale factor
35	REAL(fbdp) :: zfill ! Fill value
36	CHARACTER(len=3) :: cmission ! Mission global attribute
37	INTEGER :: itracks ! Maximum number of passes in file
38	INTEGER :: icycles ! Maximum number of cycles for each pass
39	INTEGER :: idata ! Number of data per parameter in current file
40	REAL(fbdp) :: zdeltat ! Time gap getween two measurements in seconds
41	INTEGER, DIMENSION(:), POINTER :: &
42	& iptracks, & ! List of passes contained in current file
43	& ipnbpoints, & ! Number of points per pass
44	& ipdataindexes ! Index of data in theoretical profile
45	INTEGER, DIMENSION(:,:), POINTER :: &
46	& ipcycles ! List of cycles per pass
47	REAL(fbdp), DIMENSION(:), POINTER :: &
48	& zphi, & ! Latitudes
49	& zlam ! Longitudes
50	REAL(fbdp), DIMENSION(:,:), POINTER :: &
51	& zbegindates ! Date of point with index 0
52	REAL(fbdp) :: zbeginmiss ! Missing data for dates
53	REAL(fbsp), DIMENSION(:,:), POINTER :: &
54	& zsla ! SLA data
55	REAL(fbdp), DIMENSION(:), POINTER :: &
56	& zjuld ! Julian date
57	LOGICAL, DIMENSION(:), POINTER :: &
58	& llskip ! Skip observation
59	CHARACTER(len=14) :: cdjuldref ! Julian data reference
60	INTEGER :: imission ! Mission number converted from Mission global
61	! netCDF atttribute.
62	CHARACTER(len=255) :: ctmp
63	INTEGER :: iobs
64	INTEGER :: jl
65	INTEGER :: jm
66	INTEGER :: jj
67	INTEGER :: ji
68	INTEGER :: jk
69	INTEGER :: jobs
70	INTEGER :: jcycle
71
72	! Open the file
73
74	CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, i_file_id ), &
75	& cpname, __LINE__ )
76
77	! Get the netCDF dimensions
78
79	CALL chkerr( nf90_inq_dimid( i_file_id, 'Tracks', i_tracks_id ), &
80	& cpname, __LINE__ )
81	CALL chkerr( nf90_inquire_dimension( i_file_id, i_tracks_id, &
82	& len = itracks ), &
83	& cpname, __LINE__ )
84
85	CALL chkerr( nf90_inq_dimid( i_file_id, 'Cycles', i_cycles_id ), &
86	& cpname, __LINE__ )
87	CALL chkerr( nf90_inquire_dimension( i_file_id, i_cycles_id, &
88	& len = icycles ), &
89	& cpname, __LINE__ )
90
91	CALL chkerr( nf90_inq_dimid( i_file_id, 'Data', i_data_id ), &
92	& cpname, __LINE__ )
93	CALL chkerr( nf90_inquire_dimension( i_file_id, i_data_id, &
94	& len = idata ), &
95	& cpname, __LINE__ )
96
97	! Allocate memory for input data
98
99	ALLOCATE( &
100	& iptracks ( itracks ), &
101	& ipnbpoints ( itracks ), &
102	& ipcycles ( icycles, itracks ), &
103	& zphi ( idata ), &
104	& zlam ( idata ), &
105	& zbegindates ( icycles, itracks ), &
106	& ipdataindexes( idata ), &
107	& zsla ( icycles, idata ), &
108	& zjuld ( idata*icycles ), &
109	& llskip ( idata*icycles ) &
110	& )
111
112	! Get time gap getween two measurements in seconds
113
114	CALL chkerr( nf90_inq_varid( i_file_id, 'DeltaT', i_var_id ), &
115	& cpname, __LINE__ )
116	CALL chkdim( i_file_id, i_var_id, 0, idims, cpname, __LINE__ )
117	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, zdeltat), &
118	& cpname, __LINE__ )
119	zsca = 1.0
120	IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
121	& == nf90_noerr) THEN
122	CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
123	& 'scale_factor',zsca), cpname, __LINE__)
124	ENDIF
125	zdeltat = zsca * zdeltat
126
127	! Get List of passes contained in current file
128
129	CALL chkerr( nf90_inq_varid( i_file_id, 'Tracks', i_var_id ), &
130	& cpname, __LINE__ )
131	idims(1) = itracks
132	CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
133	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, iptracks), &
134	& cpname, __LINE__ )
135
136	! Get Number of points per pass
137
138	CALL chkerr( nf90_inq_varid( i_file_id, 'NbPoints', i_var_id ), &
139	& cpname, __LINE__ )
140	idims(1) = itracks
141	CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
142	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, ipnbpoints),&
143	& cpname, __LINE__ )
144
145	! Get list of cycles per pass
146
147	CALL chkerr( nf90_inq_varid( i_file_id, 'Cycles', i_var_id ), &
148	& cpname, __LINE__ )
149	idims(1) = icycles
150	idims(2) = itracks
151	CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
152	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, ipcycles), &
153	& cpname, __LINE__ )
154
155	! Get longitudes
156
157	CALL chkerr( nf90_inq_varid( i_file_id, 'Longitudes', i_var_id ), &
158	& cpname, __LINE__ )
159	idims(1) = idata
160	CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
161	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, zlam), &
162	& cpname, __LINE__ )
163	zsca = 1.0
164	IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
165	& == nf90_noerr) THEN
166	CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
167	& 'scale_factor',zsca), cpname, __LINE__)
168	ENDIF
169	zlam(:) = zsca * zlam(:)
170
171	! Get latitudes
172
173	CALL chkerr( nf90_inq_varid( i_file_id, 'Latitudes', i_var_id ), &
174	& cpname, __LINE__ )
175	idims(1) = idata
176	CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
177	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, zphi), &
178	& cpname, __LINE__ )
179	zsca = 1.0
180	IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
181	& == nf90_noerr) THEN
182	CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
183	& 'scale_factor',zsca), cpname, __LINE__)
184	ENDIF
185	zphi(:) = zsca * zphi(:)
186
187	! Get date of point with index 0
188
189	CALL chkerr( nf90_inq_varid( i_file_id, 'BeginDates', i_var_id ), &
190	& cpname, __LINE__ )
191	idims(1) = icycles
192	idims(2) = itracks
193	CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
194	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, zbegindates), &
195	& cpname, __LINE__ )
196	CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, &
197	& 'units', len = iilen, &
198	& xtype = itype), cpname, __LINE__ )
199	IF (( itype /= NF90_CHAR ) .OR. ( iilen > 255 )) THEN
200	CALL fatal_error('Error decoding BeginDates unit', __LINE__ )
201	ENDIF
202	CALL chkerr( nf90_get_att( i_file_id, i_var_id, 'units', &
203	& ctmp ), cpname, __LINE__ )
204	jl=1
205	DO jm = 1, LEN(TRIM(ctmp))
206	IF ((ctmp(jm:jm)>='0').AND.(ctmp(jm:jm)<='9')) THEN
207	cdjuldref(jl:jl) = ctmp(jm:jm)
208	jl=jl+1
209	ENDIF
210	IF (jl>14) EXIT
211	END DO
212	CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', &
213	& xtype = itype), cpname, __LINE__ )
214	IF ( itype /= NF90_DOUBLE ) THEN
215	CALL fatal_error('Error decoding BeginDates missing data', __LINE__ )
216	ENDIF
217	CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', &
218	& zbeginmiss ), cpname, __LINE__ )
219
220	! Get indices of data in theoretical profile
221
222	CALL chkerr( nf90_inq_varid( i_file_id, 'DataIndexes', i_var_id ), &
223	& cpname, __LINE__ )
224	idims(1) = idata
225	CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
226	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, ipdataindexes), &
227	& cpname, __LINE__ )
228
229	! Get SLA data
230
231	CALL chkerr( nf90_inq_varid( i_file_id, 'SLA', i_var_id ), &
232	& cpname, __LINE__ )
233	idims(1) = icycles
234	idims(2) = idata
235	CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
236	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, zsla), &
237	& cpname, __LINE__ )
238	zsca = 1.0
239	IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
240	& == nf90_noerr) THEN
241	CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
242	& 'scale_factor',zsca), cpname, __LINE__ )
243	ENDIF
244	zfill = 0.0
245	IF (nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue') &
246	& == nf90_noerr) THEN
247	CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
248	& '_FillValue',zfill), cpname, __LINE__ )
249	ENDIF
250	WHERE(zsla(:,:) /= zfill)
251	zsla(:,:) = zsca * zsla(:,:)
252	ELSEWHERE
253	zsla(:,:) = fbrmdi
254	END WHERE
255
256	! Get the global Mission netCDF attribute
257
258	cmission=' '
259	CALL chkerr( nf90_inquire_attribute( i_file_id, nf90_global, &
260	& 'Mission', len = iilen, &
261	& xtype = itype), cpname, __LINE__ )
262	IF (( itype /= NF90_CHAR ) .OR. ( iilen > 3 )) THEN
263	CALL fatal_error('Error decoding Mission global attribute', __LINE__ )
264	ENDIF
265	CALL chkerr( nf90_get_att( i_file_id, nf90_global, 'Mission', &
266	& cmission ), cpname, __LINE__ )
267
268	! Convert it to an integer
269	imission = 0
270	DO jm = 1, imaxmissions
271	IF (cmission==cmissions(jm)) THEN
272	imission = jm
273	EXIT
274	ENDIF
275	END DO
276
277	! Close the file
278
279	CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
280
281	! Compute Julian dates for all observations
282
283	jm = 0
284	jl = 0
285	DO jj = 1, itracks
286	DO ji = 1, ipnbpoints(jj)
287	jl = jl + 1
288	DO jk = 1, icycles
289	jm = jm + 1
290	IF (zbegindates(jk,jj)==zbeginmiss) THEN
291	llskip(jm) = .TRUE.
292	zjuld(jm) = fbrmdi
293	ELSE
294	llskip(jm) = .FALSE.
295	zjuld(jm) = zbegindates(jk,jj) + &
296	& (ipdataindexes(jl) * zdeltat / 86400._wp )
297	ENDIF
298	END DO
299	END DO
300	END DO
301
302	! Get rid of missing data
303
304	jm = 0
305	DO jobs = 1, idata
306	DO jcycle = 1, icycles
307	jm = jm + 1
308	IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE.
309	END DO
310	END DO
311
312	! Allocate obfbdata
313
314	iobs = COUNT( .NOT.llskip(:) )
315	CALL init_obfbdata( inpfile )
316	CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
317	inpfile%cname(1) = 'SLA'
318
319	! Fill the obfbdata structure from input data
320
321	inpfile%cdjuldref = cdjuldref
322	iobs = 0
323	jm = 0
324	DO jobs = 1, idata
325	DO jcycle = 1, icycles
326	jm = jm + 1
327	IF (llskip(jm)) CYCLE
328	iobs = iobs + 1
329	! Characters
330	WRITE(inpfile%cdwmo(iobs),'(A3,A5)') cmissions(imission), ' '
331	WRITE(inpfile%cdtyp(iobs),'(I4)') imission
332	! Real values
333	inpfile%plam(iobs) = zlam(jobs)
334	inpfile%pphi(iobs) = zphi(jobs)
335	inpfile%pob(1,iobs,1) = zsla(jcycle,jobs)
336	inpfile%ptim(iobs) = zjuld(jm)
337	inpfile%pdep(1,iobs) = 0.0
338	! Integers
339	inpfile%kindex(iobs) = iobs
340	inpfile%ioqc(iobs) = 1
341	inpfile%ivqc(iobs,1) = 1
342	inpfile%ivlqc(1,iobs,1) = 1
343	inpfile%ipqc(iobs) = 0
344	inpfile%ipqcf(:,iobs) = 0
345	inpfile%itqc(iobs) = 0
346	inpfile%itqcf(:,iobs) = 0
347	inpfile%ivqcf(:,iobs,1) = 0
348	inpfile%ioqcf(:,iobs) = 0
349	inpfile%idqc(1,iobs) = 0
350	inpfile%idqcf(1,1,iobs) = 0
351	inpfile%ivlqcf(:,1,iobs,1) = 0
352	END DO
353	END DO
354
355
356	! Deallocate memory for input data
357
358	DEALLOCATE( &
359	& iptracks, &
360	& ipnbpoints, &
361	& ipcycles, &
362	& zphi, &
363	& zlam, &
364	& zbegindates, &
365	& ipdataindexes, &
366	& zsla, &
367	& zjuld, &
368	& llskip &
369	& )
370
371	END SUBROUTINE read_avisofile
372

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format