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_vel_io.h90 in branches/devukmo2010/NEMO/OPA_SRC/OBS – NEMO

Context Navigation

source: branches/devukmo2010/NEMO/OPA_SRC/OBS/obs_vel_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.6 KB

Line
1	SUBROUTINE read_taondbc( cdfilename, inpfile, kunit, ldwp, ldgrid )
2	!!---------------------------------------------------------------------
3	!!
4	!! ROUTINE read_enactfile
5	!!
6	!! ** Purpose : Read from file the TAO data fro NDBC.
7	!!
8	!! ** Method : The data file is a NetCDF file.
9	!!
10	!! ** Action :
11	!!
12	!! ** Reference : http://tao.noaa.gov/tao/data_deliv/deliv_ndbc.shtml
13	!! History :
14	!! ! 09-01 (K. Mogensen) Original version.
15	!!----------------------------------------------------------------------
16	!! * Arguments
17	CHARACTER(LEN=*) :: cdfilename ! Input filename
18	TYPE(obfbdata) :: inpfile ! Output obfbdata structure
19	INTEGER :: kunit ! Unit for output
20	LOGICAL :: ldwp ! Print info
21	LOGICAL :: ldgrid ! Save grid info in data structure
22	!! * Local declarations
23	INTEGER :: iobs ! Number of observations
24	INTEGER :: ilev ! Number of levels
25	INTEGER :: ilat ! Number of latitudes
26	INTEGER :: ilon ! Number of longtudes
27	INTEGER :: itim ! Number of obs. times
28	INTEGER :: i_file_id
29	INTEGER :: i_dimid_id
30	INTEGER :: i_phi_id
31	INTEGER :: i_lam_id
32	INTEGER :: i_depth_id
33	INTEGER :: i_var_id
34	INTEGER :: i_time_id
35	INTEGER :: i_time2_id
36	INTEGER :: i_qc_var_id
37	CHARACTER(LEN=40) :: cl_fld_lam
38	CHARACTER(LEN=40) :: cl_fld_phi
39	CHARACTER(LEN=40) :: cl_fld_depth
40	CHARACTER(LEN=40) :: cl_fld_var_u
41	CHARACTER(LEN=40) :: cl_fld_var_v
42	CHARACTER(LEN=40) :: cl_fld_var_qc_uv1
43	CHARACTER(LEN=40) :: cl_fld_var_qc_uv2
44	CHARACTER(LEN=40) :: cl_fld_time
45	CHARACTER(LEN=40) :: cl_fld_time2
46	INTEGER :: ja
47	INTEGER :: jo
48	INTEGER :: jk
49	INTEGER :: jt
50	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: &
51	& zv, &
52	& zu, &
53	& zuv1qc, &
54	& zuv2qc
55	REAL(wp), ALLOCATABLE, DIMENSION(:) :: &
56	& zdep, &
57	& zlat, &
58	& zlon, &
59	& zjuld
60	REAL(wp) :: zl
61	INTEGER, ALLOCATABLE, DIMENSION(:) :: &
62	& itime, &
63	& itime2
64	CHARACTER(LEN=50) :: cdjulref
65	CHARACTER(LEN=12), PARAMETER :: cl_name = 'read_taondbc'
66	CHARACTER(len=1) :: cns, cew
67
68	!-----------------------------------------------------------------------
69	! Initialization
70	!-----------------------------------------------------------------------
71	cl_fld_lam = 'lon'
72	cl_fld_phi = 'lat'
73	cl_fld_depth = 'depth'
74	cl_fld_time = 'time'
75	cl_fld_time2 = 'time2'
76
77	!-----------------------------------------------------------------------
78	! Open file
79	!-----------------------------------------------------------------------
80
81	CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
82	& i_file_id ), cl_name, __LINE__ )
83
84	!-----------------------------------------------------------------------
85	! Read the heading of the file
86	!-----------------------------------------------------------------------
87	IF(ldwp) WRITE(kunit,*)
88	IF(ldwp) WRITE(kunit,*) ' read_taondbc :'
89	IF(ldwp) WRITE(kunit,*) ' ~~~~~~~~~~~~'
90
91	!---------------------------------------------------------------------
92	! Read the number of observations and of levels to allocate array
93	!---------------------------------------------------------------------
94	CALL chkerr( nf90_inq_dimid ( i_file_id, 'time', i_dimid_id ), &
95	& cl_name, __LINE__ )
96	CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = itim ), &
97	& cl_name, __LINE__ )
98	CALL chkerr( nf90_inq_dimid ( i_file_id, 'depth', i_dimid_id ), &
99	& cl_name, __LINE__ )
100	CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilev ), &
101	& cl_name, __LINE__ )
102	CALL chkerr( nf90_inq_dimid ( i_file_id, 'lat', i_dimid_id ), &
103	& cl_name, __LINE__ )
104	CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilat ), &
105	& cl_name, __LINE__ )
106	CALL chkerr( nf90_inq_dimid ( i_file_id, 'lon', i_dimid_id ), &
107	& cl_name, __LINE__ )
108	CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilon ), &
109	& cl_name, __LINE__ )
110
111	iobs = itim * ilat * ilon
112	IF(ldwp)WRITE(kunit,*) ' No. of data records = ', iobs
113	IF(ldwp)WRITE(kunit,*) ' No. of levels = ', ilev
114	IF(ldwp)WRITE(kunit,*)
115
116	!---------------------------------------------------------------------
117	! Allocate arrays
118	!---------------------------------------------------------------------
119
120	CALL init_obfbdata( inpfile )
121	CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 0, ldgrid )
122	inpfile%cname(1) = 'UVEL'
123	inpfile%cname(2) = 'VVEL'
124	inpfile%coblong(1) = 'Zonal current'
125	inpfile%coblong(2) = 'Meridional current'
126	inpfile%cobunit(1) = 'Meters per second'
127	inpfile%cobunit(2) = 'Meters per second'
128
129	ALLOCATE( &
130	& zu(ilon,ilat,ilev,itim), &
131	& zv(ilon,ilat,ilev,itim), &
132	& zdep(ilev), &
133	& zuv1qc(ilon,ilat,ilev,itim), &
134	& zuv2qc(ilon,ilat,ilev,itim), &
135	& itime(itim), &
136	& itime2(itim), &
137	& zlat(ilat), &
138	& zlon(ilon), &
139	& zjuld(itim) &
140	& )
141
142	!---------------------------------------------------------------------
143	! Read the time/position variables
144	!---------------------------------------------------------------------
145
146	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time, i_time_id ), &
147	& cl_name, __LINE__ )
148	CALL chkerr( nf90_get_var ( i_file_id, i_time_id, itime ), &
149	& cl_name, __LINE__ )
150
151	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time2, i_time2_id ), &
152	& cl_name, __LINE__ )
153	CALL chkerr( nf90_get_var ( i_file_id, i_time2_id, itime2 ), &
154	& cl_name, __LINE__ )
155
156	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ), &
157	& cl_name, __LINE__ )
158	CALL chkerr( nf90_get_var ( i_file_id, i_depth_id, zdep ), &
159	& cl_name, __LINE__ )
160
161	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ), &
162	& cl_name, __LINE__ )
163	CALL chkerr( nf90_get_var ( i_file_id, i_phi_id, zlat ), &
164	& cl_name, __LINE__ )
165
166	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ), &
167	& cl_name, __LINE__ )
168	CALL chkerr( nf90_get_var ( i_file_id, i_lam_id, zlon ), &
169	& cl_name, __LINE__ )
170
171	!---------------------------------------------------------------------
172	! Read the variables
173	!---------------------------------------------------------------------
174
175	! ADCP format assumed
176	cl_fld_var_u = 'u_1205'
177	IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
178	! Try again with current meter format
179	cl_fld_var_u = 'U_320'
180	IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
181	CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
182	ENDIF
183	ENDIF
184	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, zu ), &
185	& cl_name, __LINE__ )
186
187	! ADCP format assumed
188	cl_fld_var_v = 'v_1206'
189	IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
190	! Try again with current meter format
191	cl_fld_var_v = 'V_321'
192	IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
193	CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
194	ENDIF
195	ENDIF
196	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, zv ), &
197	& cl_name, __LINE__ )
198
199	!---------------------------------------------------------------------
200	! Read the QC attributes
201	!---------------------------------------------------------------------
202
203	! ADCP format assumed
204	cl_fld_var_qc_uv1 = 'QU_5205'
205	IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
206	! Try again with current meter format
207	cl_fld_var_qc_uv1 = 'QCS_5300'
208	IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
209	! Try again with high freq. current meter format
210	cl_fld_var_qc_uv1 = 'QCU_5320'
211	IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
212	CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
213	ENDIF
214	ENDIF
215	ENDIF
216	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, zuv1qc), &
217	& cl_name, __LINE__ )
218
219	! ADCP format assumed
220	cl_fld_var_qc_uv2 = 'QV_5206'
221	IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
222	! Try again with current meter format
223	cl_fld_var_qc_uv2 = 'QCD_5310'
224	IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
225	! Try again with high freq. current meter format
226	cl_fld_var_qc_uv2 = 'QCV_5321'
227	IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
228	CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
229	ENDIF
230	ENDIF
231	ENDIF
232	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, zuv2qc), &
233	& cl_name, __LINE__ )
234
235	!---------------------------------------------------------------------
236	! Close file
237	!---------------------------------------------------------------------
238
239	CALL chkerr( nf90_close( i_file_id ), cl_name, __LINE__ )
240
241	!---------------------------------------------------------------------
242	! Convert to to 19500101 based Julian date
243	!---------------------------------------------------------------------
244	DO jt = 1, itim
245	zjuld(jt) = REAL(itime(jt),wp) + REAL(itime2(jt),wp)/86400000.0_wp &
246	& - 2433283.0_wp
247	END DO
248	inpfile%cdjuldref = '19500101000000'
249
250	!---------------------------------------------------------------------
251	! Copy info to obfbdata structure
252	!---------------------------------------------------------------------
253
254	iobs = 0
255	DO jt = 1, itim
256	DO ja = 1, ilat
257	DO jo = 1, ilon
258	iobs = iobs + 1
259	zl = zlon(jo)
260	IF ( zl > 180.0_wp ) zl = zl - 360.0_wp
261	IF ( zl < 0 ) THEN
262	cew = 'w'
263	ELSE
264	cew = 'e'
265	ENDIF
266	IF ( zlat(jo) < 0 ) THEN
267	cns = 's'
268	ELSE
269	cns = 'n'
270	ENDIF
271	WRITE(inpfile%cdwmo(iobs),'(A1,I2.2,A1,I3.3)') &
272	& cns, ABS(NINT(zlat(ja))), cew, ABS(NINT(zl))
273	DO jk = 1, ilev
274	inpfile%pob(jk,iobs,1) = zu(jo,ja,jk,jt)
275	inpfile%pob(jk,iobs,2) = zv(jo,ja,jk,jt)
276	inpfile%pdep(jk,iobs) = zdep(jk)
277	inpfile%ivlqc(jk,iobs,1:2) = INT( MAX( zuv1qc(jo,ja,jk,jt), zuv2qc(jo,ja,jk,jt) ) )
278	END DO
279	inpfile%plam(iobs) = zlon(jo)
280	inpfile%pphi(iobs) = zlat(ja)
281	inpfile%ptim(iobs) = zjuld(jt)
282	END DO
283	END DO
284	END DO
285
286	! No position, time, depth and variable QC in input files
287	DO jo = 1, iobs
288	inpfile%ipqc(jo) = 1
289	inpfile%itqc(jo) = 1
290	inpfile%ivqc(jo,1:2) = 1
291	DO jk = 1, ilev
292	inpfile%idqc(jk,jo) = 1
293	END DO
294	END DO
295
296	!---------------------------------------------------------------------
297	! Set the platform information
298	!---------------------------------------------------------------------
299	inpfile%cdtyp(:)=' 820'
300
301	!---------------------------------------------------------------------
302	! Set QC flags for missing data and rescale to m/s
303	!---------------------------------------------------------------------
304
305	DO jo = 1, iobs
306	DO jk = 1, ilev
307	IF ( ( ABS(inpfile%pob(jk,jo,1)) > 10000.0_wp ) .OR. &
308	& ( ABS(inpfile%pob(jk,jo,2)) > 10000.0_wp ) ) THEN
309	inpfile%ivlqc(jk,jo,:) = 4
310	inpfile%pob(jk,jo,1) = fbrmdi
311	inpfile%pob(jk,jo,2) = fbrmdi
312	ELSE
313	inpfile%pob(jk,jo,1) = 0.01 * inpfile%pob(jk,jo,1)
314	inpfile%pob(jk,jo,2) = 0.01 * inpfile%pob(jk,jo,2)
315	ENDIF
316	END DO
317	END DO
318
319	!---------------------------------------------------------------------
320	! Set file indexes
321	!---------------------------------------------------------------------
322
323	DO jo = 1, inpfile%nobs
324	inpfile%kindex(jo) = jo
325	END DO
326
327	!---------------------------------------------------------------------
328	! Initialize flags since they are not in the TAO input files
329	!---------------------------------------------------------------------
330
331	inpfile%ioqcf(:,:) = 0
332	inpfile%ipqcf(:,:) = 0
333	inpfile%itqcf(:,:) = 0
334	inpfile%idqcf(:,:,:) = 0
335	inpfile%ivqcf(:,:,:) = 0
336	inpfile%ivlqcf(:,:,:,:) = 0
337
338	!---------------------------------------------------------------------
339	! Deallocate data
340	!---------------------------------------------------------------------
341	DEALLOCATE( &
342	& zu, &
343	& zv, &
344	& zdep, &
345	& zuv1qc, &
346	& zuv2qc, &
347	& itime, &
348	& itime2, &
349	& zlat, &
350	& zlon, &
351	& zjuld &
352	& )
353
354	END SUBROUTINE read_taondbc

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

Download in other formats:

Original Format