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.

obsprof_io.h90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

Context Navigation

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obsprof_io.h90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago
set proper svn properties to all files...
Property svn:keywords set to `Id`
File size: 36.7 KB

Line
1
2	SUBROUTINE read_enactfile( cdfilename, inpfile, kunit, ldwp, ldgrid )
3	!!---------------------------------------------------------------------
4	!!
5	!! ROUTINE read_enactfile
6	!!
7	!! ** Purpose : Read from file the profile ENACT observations.
8	!!
9	!! ** Method : The data file is a NetCDF file.
10	!!
11	!! ** Action :
12	!!
13	!! History :
14	!! ! 09-01 (K. Mogensen) Original based on old versions
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 :: i_file_id
26	INTEGER :: i_obs_id
27	INTEGER :: i_lev_id
28	INTEGER :: i_phi_id
29	INTEGER :: i_lam_id
30	INTEGER :: i_depth_id
31	INTEGER :: i_var_id
32	INTEGER :: i_pl_num_id
33	INTEGER :: i_reference_date_time_id
34	INTEGER :: i_format_version_id
35	INTEGER :: i_juld_id
36	INTEGER :: i_data_type_id
37	INTEGER :: i_wmo_inst_type_id
38	INTEGER :: i_qc_var_id
39	INTEGER :: i_dc_ref_id
40	INTEGER :: i_qc_flag_id
41	CHARACTER(LEN=40) :: cl_fld_lam
42	CHARACTER(LEN=40) :: cl_fld_phi
43	CHARACTER(LEN=40) :: cl_fld_depth
44	CHARACTER(LEN=40) :: cl_fld_var_tp
45	CHARACTER(LEN=40) :: cl_fld_var_s
46	CHARACTER(LEN=40) :: cl_fld_var_ti
47	CHARACTER(LEN=40) :: cl_fld_var_juld_qc
48	CHARACTER(LEN=40) :: cl_fld_var_pos_qc
49	CHARACTER(LEN=40) :: cl_fld_var_depth_qc
50	CHARACTER(LEN=40) :: cl_fld_var_qc_t
51	CHARACTER(LEN=40) :: cl_fld_var_qc_s
52	CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t
53	CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s
54	CHARACTER(LEN=40) :: cl_fld_reference_date_time
55	CHARACTER(LEN=40) :: cl_fld_juld
56	CHARACTER(LEN=40) :: cl_fld_data_type
57	CHARACTER(LEN=40) :: cl_fld_pl_num
58	CHARACTER(LEN=40) :: cl_fld_format_version
59	CHARACTER(LEN=40) :: cl_fld_wmo_inst_type
60	CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles
61	CHARACTER(LEN=40) :: cl_fld_qc_flags_levels
62
63	CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile'
64	CHARACTER(LEN=16) :: cl_data_type = ''
65	CHARACTER(LEN=4 ) :: cl_format_version = ''
66	INTEGER, DIMENSION(1) :: istart1, icount1
67	INTEGER, DIMENSION(2) :: istart2, icount2
68	CHARACTER(len=imaxlev) :: clqc
69	CHARACTER(len=1) :: cqc
70	INTEGER :: ji, jk
71	INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1
72	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2
73
74	!-----------------------------------------------------------------------
75	! Initialization
76	!-----------------------------------------------------------------------
77
78	cl_fld_lam = 'LONGITUDE'
79	cl_fld_phi = 'LATITUDE'
80	cl_fld_depth = 'DEPH_CORRECTED'
81	cl_fld_reference_date_time = 'REFERENCE_DATE_TIME'
82	cl_fld_juld = 'JULD'
83	cl_fld_data_type = 'DATA_TYPE'
84	cl_fld_format_version = 'FORMAT_VERSION'
85	cl_fld_wmo_inst_type = 'WMO_INST_TYPE'
86	cl_fld_pl_num = 'PLATFORM_NUMBER'
87
88	cl_fld_var_qc_t = 'POTM_CORRECTED_QC'
89	cl_fld_var_prof_qc_t = 'PROFILE_POTM_QC'
90	cl_fld_var_tp = 'POTM_CORRECTED'
91	cl_fld_var_qc_s = 'PSAL_CORRECTED_QC'
92	cl_fld_var_prof_qc_s = 'PROFILE_PSAL_QC'
93	cl_fld_var_s = 'PSAL_CORRECTED'
94	cl_fld_var_depth_qc = 'DEPH_CORRECTED_QC'
95	cl_fld_var_juld_qc = 'JULD_QC'
96	cl_fld_var_pos_qc = 'POSITION_QC'
97	cl_fld_var_ti = 'TEMP'
98	cl_fld_qc_flags_profiles = 'QC_FLAGS_PROFILES'
99	cl_fld_qc_flags_levels = 'QC_FLAGS_LEVELS'
100
101	icount1(1) = 1
102
103	!-----------------------------------------------------------------------
104	! Open file
105	!-----------------------------------------------------------------------
106
107	CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
108	& i_file_id ), cl_name, __LINE__ )
109
110	!-----------------------------------------------------------------------
111	! Read the heading of the file
112	!-----------------------------------------------------------------------
113
114	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_data_type, &
115	& i_data_type_id ), cl_name, __LINE__ )
116	CALL chkerr( nf90_get_var ( i_file_id, i_data_type_id, &
117	& cl_data_type ), cl_name, __LINE__ )
118	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_format_version, &
119	& i_format_version_id ), cl_name, __LINE__ )
120	CALL chkerr( nf90_get_var ( i_file_id, i_format_version_id, &
121	& cl_format_version ), cl_name, __LINE__ )
122
123	CALL str_c_to_for( cl_data_type )
124	CALL str_c_to_for( cl_format_version )
125
126	IF(ldwp)WRITE(kunit,*)
127	IF(ldwp)WRITE(kunit,*) ' read_enactfile :'
128	IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
129	IF(ldwp)WRITE(kunit,*) ' Data type = ', &
130	& TRIM( ADJUSTL( cl_data_type ) )
131	IF(ldwp)WRITE(kunit,*) ' Format version = ', &
132	& TRIM( ADJUSTL( cl_format_version ) )
133
134	IF ( ( ( INDEX( cl_data_type,"ENACT v1.0" ) == 1 ) .OR. &
135	& ( INDEX( cl_data_type,"ENACT v1.4" ) == 1 ) .OR. &
136	& ( INDEX( cl_data_type,"ENACT v1.5" ) == 1 ) .OR. &
137	& ( INDEX( cl_data_type,"ENSEMBLES EN3 v1" ) == 1 ) ) &
138	& .AND. &
139	& ( INDEX( cl_format_version,"2.0" ) == 1 ) ) THEN
140	IF(ldwp)WRITE(kunit,*)' Valid input file'
141	ELSE
142	CALL fatal_error( 'Invalid input file', __LINE__ )
143	ENDIF
144
145	!---------------------------------------------------------------------
146	! Read the number of observations and levels to allocate arrays
147	!---------------------------------------------------------------------
148
149	CALL chkerr( nf90_inq_dimid ( i_file_id, 'N_PROF', i_obs_id ), &
150	& cl_name, __LINE__ )
151	CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), &
152	& cl_name, __LINE__ )
153	CALL chkerr( nf90_inq_dimid ( i_file_id, 'N_LEVELS', i_lev_id ), &
154	& cl_name, __LINE__ )
155	CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
156	& cl_name, __LINE__ )
157	IF(ldwp)WRITE(kunit,*) ' No. of data records = ', iobs
158	IF(ldwp)WRITE(kunit,*) ' No. of levels = ', ilev
159	IF(ldwp)WRITE(kunit,*)
160	IF (ilev > imaxlev) THEN
161	CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
162	ENDIF
163
164	!---------------------------------------------------------------------
165	! Allocate arrays
166	!---------------------------------------------------------------------
167
168	CALL init_obfbdata( inpfile )
169	CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
170	inpfile%cname(1) = 'POTM'
171	inpfile%cname(2) = 'PSAL'
172	inpfile%coblong(1) = 'Potential temperature'
173	inpfile%coblong(2) = 'Practical salinity'
174	inpfile%cobunit(1) = 'Degrees Celsius'
175	inpfile%cobunit(2) = 'PSU'
176	inpfile%cextname(1) = 'TEMP'
177	inpfile%cextlong(1) = 'Insitu temperature'
178	inpfile%cextunit(1) = 'Degrees Celsius'
179
180	!---------------------------------------------------------------------
181	! Read the QC atributes
182	!---------------------------------------------------------------------
183
184	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ), &
185	& cl_name, __LINE__ )
186	istart2(1) = 1
187	icount2(2) = 1
188	icount2(1) = ilev
189	DO ji = 1, iobs
190	istart2(2) = ji
191	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, &
192	& start = istart2, count = icount2), &
193	& cl_name, __LINE__ )
194	DO jk = 1, ilev
195	inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
196	END DO
197	END DO
198	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ), &
199	& cl_name, __LINE__ )
200	DO ji = 1, iobs
201	istart2(2) = ji
202	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, &
203	& start = istart2, count = icount2), &
204	& cl_name, __LINE__ )
205	DO jk = 1, ilev
206	inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
207	END DO
208	END DO
209	! No depth QC in files
210	DO ji = 1, iobs
211	DO jk = 1, ilev
212	inpfile%idqc(jk,ji) = 1
213	inpfile%idqcf(:,jk,ji) = 0
214	END DO
215	END DO
216
217	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ), &
218	& cl_name, __LINE__ )
219	DO ji = 1,iobs
220	istart1(1) = ji
221	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, &
222	& start = istart1, count = icount1), &
223	& cl_name, __LINE__ )
224	inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
225	END DO
226	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ), &
227	& cl_name, __LINE__ )
228	DO ji = 1,iobs
229	istart1(1) = ji
230	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, &
231	& start = istart1, count = icount1), &
232	& cl_name, __LINE__ )
233	inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
234	END DO
235	!! CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ), &
236	!! & cl_name, __LINE__ )
237	!! !DO ji = 1,iobs
238	!! istart1(1) = ji
239	!! CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, &
240	!! & start = istart1, count = icount1), &
241	!! & cl_name, __LINE__ )
242	!! inpfile%itqc(ji) = IACHAR( cqc ) - IACHAR( '0' )
243	!! inpfile%itqcf(:,ji) = 0
244	!! END DO
245	! Since the flags are not set in the ENACT files we reset them to 0
246	inpfile%itqc(:) = 1
247	inpfile%itqcf(:,:) = 0
248	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ), &
249	& cl_name, __LINE__ )
250	DO ji = 1,iobs
251	istart1(1) = ji
252	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, &
253	& start = istart1, count = icount1), &
254	& cl_name, __LINE__ )
255	inpfile%ipqc(ji) = IACHAR( cqc ) - IACHAR( '0' )
256	inpfile%ipqcf(:,ji) = 0
257	END DO
258	DO ji = 1,iobs
259	inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
260	END DO
261	IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN
262	ALLOCATE( &
263	& iqc1(iobs) &
264	& )
265	CALL chkerr( nf90_get_var ( i_file_id, i_qc_flag_id, iqc1 ), &
266	& cl_name, __LINE__ )
267	DO ji = 1,iobs
268	inpfile%ioqcf(1,ji) = iqc1(ji)
269	inpfile%ivqcf(1,ji,:) = iqc1(ji)
270	inpfile%ioqcf(2,ji) = 0
271	inpfile%ivqcf(2,ji,:) = 0
272	END DO
273	DEALLOCATE( &
274	& iqc1 &
275	& )
276	ELSE
277	IF(ldwp) WRITE(kunit,*)'No QC profile flags in file'
278	inpfile%ioqcf(:,:) = 0
279	inpfile%ivqcf(:,:,:) = 0
280	ENDIF
281	IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_levels, i_qc_flag_id ) == nf90_noerr ) THEN
282	ALLOCATE( &
283	& iqc2(ilev,iobs) &
284	& )
285	CALL chkerr( nf90_get_var ( i_file_id, i_qc_flag_id, iqc2 ), &
286	& cl_name, __LINE__ )
287	DO ji = 1,iobs
288	DO jk = 1,ilev
289	inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji)
290	inpfile%ivlqcf(2,jk,ji,:) = 0
291	END DO
292	END DO
293	DEALLOCATE( &
294	& iqc2 &
295	& )
296	ELSE
297	IF(ldwp) WRITE(kunit,*)'No QC level flags in file'
298	inpfile%ivlqcf(:,:,:,:) = 0
299	ENDIF
300
301	!---------------------------------------------------------------------
302	! Read the time/position variables
303	!---------------------------------------------------------------------
304
305	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ), &
306	& cl_name, __LINE__ )
307	CALL chkerr( nf90_get_var ( i_file_id, i_juld_id, inpfile%ptim ), &
308	& cl_name, __LINE__ )
309
310	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ), &
311	& cl_name, __LINE__ )
312	CALL chkerr( nf90_get_var ( i_file_id, i_depth_id, inpfile%pdep ), &
313	& cl_name, __LINE__ )
314
315	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ), &
316	& cl_name, __LINE__ )
317	CALL chkerr( nf90_get_var ( i_file_id, i_phi_id, inpfile%pphi ), &
318	& cl_name, __LINE__ )
319
320	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ), &
321	& cl_name, __LINE__ )
322	CALL chkerr( nf90_get_var ( i_file_id, i_lam_id, inpfile%plam ), &
323	& cl_name, __LINE__ )
324
325	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_reference_date_time, i_reference_date_time_id ), &
326	& cl_name, __LINE__ )
327	CALL chkerr( nf90_get_var ( i_file_id, i_reference_date_time_id, inpfile%cdjuldref ), &
328	& cl_name, __LINE__ )
329
330	!---------------------------------------------------------------------
331	! Read the platform information
332	!---------------------------------------------------------------------
333
334	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ), &
335	& cl_name, __LINE__ )
336	CALL chkerr( nf90_get_var ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ), &
337	& cl_name, __LINE__ )
338
339	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ), &
340	& cl_name, __LINE__ )
341	CALL chkerr( nf90_get_var ( i_file_id, i_pl_num_id, inpfile%cdwmo ), &
342	& cl_name, __LINE__ )
343
344	!---------------------------------------------------------------------
345	! Read the variables
346	!---------------------------------------------------------------------
347
348	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_tp, i_var_id ), &
349	& cl_name, __LINE__ )
350	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pob(:,:,1) ), &
351	& cl_name, __LINE__ )
352
353	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ), &
354	& cl_name, __LINE__ )
355	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pob(:,:,2) ), &
356	& cl_name, __LINE__ )
357
358	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_ti, i_var_id ), &
359	& cl_name, __LINE__ )
360	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pext(:,:,1) ), &
361	& cl_name, __LINE__ )
362
363	!---------------------------------------------------------------------
364	! Close file
365	!---------------------------------------------------------------------
366
367	CALL chkerr( nf90_close( i_file_id ), cl_name, __LINE__ )
368
369	!---------------------------------------------------------------------
370	! Set file indexes
371	!---------------------------------------------------------------------
372	DO ji = 1, inpfile%nobs
373	inpfile%kindex(ji) = ji
374	END DO
375
376	END SUBROUTINE read_enactfile
377
378	SUBROUTINE read_coriofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
379	!!---------------------------------------------------------------------
380	!!
381	!! ROUTINE read_coriofile
382	!!
383	!! ** Purpose : Read from file the profile CORIO observations.
384	!!
385	!! ** Method : The data file is a NetCDF file.
386	!!
387	!! ** Action :
388	!!
389	!! History :
390	!! ! 09-01 (K. Mogensen) Original based on old versions
391	!!----------------------------------------------------------------------
392	!! * Arguments
393	CHARACTER(LEN=*) :: cdfilename ! Input filename
394	TYPE(obfbdata) :: inpfile ! Output enactfile structure
395	INTEGER :: kunit ! Unit for output
396	LOGICAL :: ldwp ! Print info
397	LOGICAL :: ldgrid ! Save grid info in data structure
398	INTEGER :: &
399	& iobs, &
400	& ilev
401	!! * Local declarations
402	INTEGER :: &
403	& i_file_id, &
404	& i_obs_id, &
405	& i_lev_id, &
406	& i_phi_id, &
407	& i_lam_id, &
408	& i_depth_id, &
409	& i_pres_id, &
410	& i_var_id, &
411	& i_pl_num_id, &
412	& i_format_version_id, &
413	& i_juld_id, &
414	& i_data_type_id, &
415	& i_wmo_inst_type_id, &
416	& i_qc_var_id, &
417	& i_dc_ref_id
418	CHARACTER(LEN=40) :: &
419	& cl_fld_lam, &
420	& cl_fld_phi, &
421	& cl_fld_depth, &
422	& cl_fld_depth_qc, &
423	& cl_fld_pres, &
424	& cl_fld_pres_qc, &
425	& cl_fld_var_t, &
426	& cl_fld_var_s, &
427	& cl_fld_var_ti, &
428	& cl_fld_var_pos_qc, &
429	& cl_fld_var_qc_t, &
430	& cl_fld_var_qc_s, &
431	& cl_fld_var_prof_qc_t, &
432	& cl_fld_var_prof_qc_s, &
433	& cl_fld_dc_ref, &
434	& cl_fld_juld, &
435	& cl_fld_pl_num, &
436	& cl_fld_wmo_inst_type
437	CHARACTER(LEN=14), PARAMETER :: &
438	& cl_name = 'read_coriofile'
439	CHARACTER(LEN=4 ) :: &
440	& cl_format_version = ''
441	INTEGER, DIMENSION(1) :: &
442	& istart1, icount1
443	INTEGER, DIMENSION(2) :: &
444	& istart2, icount2
445	CHARACTER(len=imaxlev) :: &
446	& clqc
447	CHARACTER(len=1) :: &
448	& cqc
449	CHARACTER(len=256) :: &
450	& cdjulref
451	INTEGER :: &
452	& ji, jk
453	INTEGER :: &
454	& iformat
455	LOGICAL :: &
456	& lsal
457	REAL(fbdp), DIMENSION(:,:), ALLOCATABLE :: &
458	& zpres
459	INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
460	& ipresqc
461	CHARACTER(len=256) :: &
462	& cerr
463	!-----------------------------------------------------------------------
464	! Initialization
465	!-----------------------------------------------------------------------
466
467	icount1(1) = 1
468	lsal = .TRUE.
469
470	!-----------------------------------------------------------------------
471	! Open file
472	!-----------------------------------------------------------------------
473
474	CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
475	& i_file_id ), cl_name, __LINE__ )
476
477	!-----------------------------------------------------------------------
478	! Check format and set variables accordingly
479	!-----------------------------------------------------------------------
480
481	IF ( ( nf90_inq_dimid( i_file_id, 'N_PROF', i_obs_id ) == nf90_noerr ) .AND. &
482	& ( nf90_inq_dimid( i_file_id, 'N_LEVELS', i_lev_id ) == nf90_noerr ) ) THEN
483	iformat = 1
484	ELSEIF ( ( nf90_inq_dimid( i_file_id, 'mN_PROF', i_obs_id ) == nf90_noerr ) .AND. &
485	& ( nf90_inq_dimid( i_file_id, 'mN_ZLEV', i_lev_id ) == nf90_noerr ) ) THEN
486	iformat = 2
487	ELSE
488	WRITE(cerr,'(2A)')'Invalid data format in ',cl_name
489	CALL fatal_error( cerr, __LINE__ )
490	ENDIF
491	IF ( iformat == 1 ) THEN
492	cl_fld_lam = 'LONGITUDE'
493	cl_fld_phi = 'LATITUDE'
494	cl_fld_depth = 'DEPH'
495	cl_fld_depth_qc = 'DEPH_QC'
496	cl_fld_pres = 'PRES'
497	cl_fld_pres_qc = 'PRES_QC'
498	cl_fld_juld = 'JULD'
499	cl_fld_wmo_inst_type = 'WMO_INST_TYPE'
500	cl_fld_dc_ref = 'DC_REFERENCE'
501	cl_fld_pl_num = 'PLATFORM_NUMBER'
502	cl_fld_var_qc_t = 'TEMP_QC'
503	cl_fld_var_prof_qc_t = 'PROFILE_TEMP_QC'
504	cl_fld_var_t = 'TEMP'
505	cl_fld_var_qc_s = 'PSAL_QC'
506	cl_fld_var_prof_qc_s = 'PROFILE_PSAL_QC'
507	cl_fld_var_s = 'PSAL'
508	cl_fld_var_pos_qc = 'POSITION_QC'
509	ELSEIF ( iformat==2 ) THEN
510	cl_fld_lam = 'LONGITUDE'
511	cl_fld_phi = 'LATITUDE'
512	cl_fld_depth = 'DEPH'
513	cl_fld_depth_qc = 'QC_DEPH'
514	cl_fld_pres = 'PRES'
515	cl_fld_pres_qc = 'QC_PRES'
516	cl_fld_juld = 'JULD'
517	cl_fld_wmo_inst_type = 'INST_TYPE'
518	cl_fld_dc_ref = 'REFERENCE'
519	cl_fld_pl_num = 'PLATFORM_NUMBER'
520	cl_fld_var_qc_t = 'QC_TEMP'
521	cl_fld_var_prof_qc_t = 'Q_PROFILE_TEMP'
522	cl_fld_var_t = 'TEMP'
523	cl_fld_var_qc_s = 'QC_PSAL'
524	cl_fld_var_prof_qc_s = 'Q_PROFILE_PSAL'
525	cl_fld_var_s = 'PSAL'
526	cl_fld_var_pos_qc = 'Q_POSITION'
527	ENDIF
528
529	!-----------------------------------------------------------------------
530	! Read the heading of the file
531	!-----------------------------------------------------------------------
532
533	IF(ldwp)WRITE(kunit,*)
534	IF(ldwp)WRITE(kunit,*) ' read_coriofile :'
535	IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
536	IF(ldwp)WRITE(kunit,*) ' Format version = ', iformat
537
538	!---------------------------------------------------------------------
539	! Read the number of observations and levels to allocate arrays
540	!---------------------------------------------------------------------
541
542	CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), &
543	& cl_name, __LINE__ )
544	CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
545	& cl_name, __LINE__ )
546	IF(ldwp)WRITE(kunit,*) ' No. of data records = ', iobs
547	IF(ldwp)WRITE(kunit,*) ' No. of levels = ', ilev
548	IF(ldwp)WRITE(kunit,*)
549	IF (ilev > imaxlev) THEN
550	CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
551	ENDIF
552
553	!---------------------------------------------------------------------
554	! Allocate arrays
555	!---------------------------------------------------------------------
556
557	CALL init_obfbdata( inpfile )
558	CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
559	inpfile%cname(1) = 'POTM'
560	inpfile%cname(2) = 'PSAL'
561	inpfile%coblong(1) = 'Potential temperature'
562	inpfile%coblong(2) = 'Practical salinity'
563	inpfile%cobunit(1) = 'Degrees Celsius'
564	inpfile%cobunit(2) = 'PSU'
565	inpfile%cextname(1) = 'TEMP'
566	inpfile%cextlong(1) = 'Insitu temperature'
567	inpfile%cextunit(1) = 'Degrees Celsius'
568	ALLOCATE( &
569	& zpres(ilev,iobs), &
570	& ipresqc(ilev,iobs) &
571	& )
572	!---------------------------------------------------------------------
573	! Get julian data reference (iformat==2)
574	!---------------------------------------------------------------------
575
576	IF (iformat==2) THEN
577	CALL chkerr ( nf90_get_att( i_file_id, nf90_global, &
578	& "Reference_date_time", cdjulref ), &
579	& cl_name, __LINE__ )
580	inpfile%cdjuldref = cdjulref(7:10)//cdjulref(4:5)// &
581	& cdjulref(1:2)//cdjulref(12:13)//cdjulref(15:16)//cdjulref(18:19)
582	ENDIF
583
584	!---------------------------------------------------------------------
585	! Read the QC attributes
586	!---------------------------------------------------------------------
587
588	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ), &
589	& cl_name, __LINE__ )
590	istart2(1) = 1
591	icount2(2) = 1
592	icount2(1) = ilev
593	DO ji = 1, iobs
594	istart2(2) = ji
595	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, &
596	& start = istart2, count = icount2), &
597	& cl_name, __LINE__ )
598	DO jk = 1, ilev
599	inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
600	END DO
601	END DO
602	IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN
603	DO ji = 1, iobs
604	istart2(2) = ji
605	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, &
606	& start = istart2, count = icount2), &
607	& cl_name, __LINE__ )
608	DO jk = 1, ilev
609	inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
610	END DO
611	END DO
612	ELSE
613	inpfile%ivlqc(:,:,2) = 4
614	inpfile%pob(:,:,2) = fbrmdi
615	lsal = .FALSE.
616	ENDIF
617
618	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ), &
619	& cl_name, __LINE__ )
620	DO ji = 1,iobs
621	istart1(1) = ji
622	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, &
623	& start = istart1, count = icount1), &
624	& cl_name, __LINE__ )
625	inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
626	END DO
627	IF (lsal) THEN
628	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ), &
629	& cl_name, __LINE__ )
630	DO ji = 1,iobs
631	istart1(1) = ji
632	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, &
633	& start = istart1, count = icount1), &
634	& cl_name, __LINE__ )
635	inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
636	END DO
637	ELSE
638	inpfile%ivqc(:,2) = 4
639	ENDIF
640	DO ji = 1,iobs
641	inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
642	END DO
643	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ), &
644	& cl_name, __LINE__ )
645	DO ji = 1, iobs
646	istart1(1) = ji
647	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, cqc, &
648	& start = istart1, count = icount1), &
649	& cl_name, __LINE__ )
650	inpfile%ipqc(ji) = IACHAR( cqc ) - IACHAR( '0' )
651	END DO
652
653	!---------------------------------------------------------------------
654	! Read the time/position variables
655	!---------------------------------------------------------------------
656
657	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ), &
658	& cl_name, __LINE__ )
659	CALL chkerr( nf90_get_var ( i_file_id, i_juld_id, inpfile%ptim ), &
660	& cl_name, __LINE__ )
661	IF (iformat==1) THEN
662	CALL chkerr ( nf90_get_att( i_file_id, i_juld_id, &
663	& "units", cdjulref ), &
664	& cl_name, __LINE__ )
665	inpfile%cdjuldref = cdjulref(12:15)//cdjulref(17:18)// &
666	& cdjulref(20:21)//cdjulref(23:24)//cdjulref(26:27)//&
667	& cdjulref(29:30)
668	ENDIF
669
670	IF ( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ) == nf90_noerr ) THEN
671	CALL chkerr( nf90_get_var ( i_file_id, i_depth_id, inpfile%pdep ), &
672	& cl_name, __LINE__ )
673	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth_qc, i_qc_var_id ), &
674	& cl_name, __LINE__ )
675	DO ji = 1, iobs
676	istart2(2) = ji
677	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, &
678	& start = istart2, count = icount2), &
679	& cl_name, __LINE__ )
680	DO jk = 1, ilev
681	inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
682	END DO
683	END DO
684	ELSE
685	inpfile%pdep(:,:) = fbrmdi
686	inpfile%idqc(:,:) = 4
687	ENDIF
688
689	IF ( nf90_inq_varid( i_file_id, cl_fld_pres, i_pres_id ) == nf90_noerr ) THEN
690	CALL chkerr( nf90_get_var ( i_file_id, i_pres_id, zpres ), &
691	& cl_name, __LINE__ )
692	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pres_qc, i_qc_var_id ), &
693	& cl_name, __LINE__ )
694	DO ji = 1, iobs
695	istart2(2) = ji
696	CALL chkerr( nf90_get_var ( i_file_id, i_qc_var_id, clqc, &
697	& start = istart2, count = icount2), &
698	& cl_name, __LINE__ )
699	DO jk = 1, ilev
700	ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
701	END DO
702	END DO
703	ELSE
704	zpres(:,:) = fbrmdi
705	ipresqc(:,:) = 4
706	ENDIF
707
708	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ), &
709	& cl_name, __LINE__ )
710	CALL chkerr( nf90_get_var ( i_file_id, i_phi_id, inpfile%pphi ), &
711	& cl_name, __LINE__ )
712
713	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ), &
714	& cl_name, __LINE__ )
715	CALL chkerr( nf90_get_var ( i_file_id, i_lam_id, inpfile%plam ), &
716	& cl_name, __LINE__ )
717
718	!---------------------------------------------------------------------
719	! Read the platform information
720	!---------------------------------------------------------------------
721
722	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ), &
723	& cl_name, __LINE__ )
724	CALL chkerr( nf90_get_var ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ), &
725	& cl_name, __LINE__ )
726
727	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ), &
728	& cl_name, __LINE__ )
729	CALL chkerr( nf90_get_var ( i_file_id, i_pl_num_id, inpfile%cdwmo ), &
730	& cl_name, __LINE__ )
731
732
733	!---------------------------------------------------------------------
734	! Read the variables
735	!---------------------------------------------------------------------
736
737	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_t, i_var_id ), &
738	& cl_name, __LINE__ )
739	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pext(:,:,1) ), &
740	& cl_name, __LINE__ )
741
742	IF (lsal) THEN
743	CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ), &
744	& cl_name, __LINE__ )
745	CALL chkerr( nf90_get_var ( i_file_id, i_var_id, inpfile%pob(:,:,2) ), &
746	& cl_name, __LINE__ )
747	ENDIF
748
749	!---------------------------------------------------------------------
750	! Close file
751	!---------------------------------------------------------------------
752
753	CALL chkerr( nf90_close( i_file_id ), cl_name, __LINE__ )
754
755	!---------------------------------------------------------------------
756	! Set file indexes
757	!---------------------------------------------------------------------
758	DO ji = 1, inpfile%nobs
759	inpfile%kindex(ji) = ji
760	END DO
761
762	!---------------------------------------------------------------------
763	! Coriolis data conversion from insitu to potential temperature
764	!---------------------------------------------------------------------
765	!---------------------------------------------------------------------
766	! Convert pressure to depth if depth not present
767	!---------------------------------------------------------------------
768	DO ji = 1, inpfile%nobs
769	IF ( inpfile%pphi(ji) < 9999.0 ) THEN
770	DO jk = 1, inpfile%nlev
771	IF ( inpfile%pdep(jk,ji) >= 9999.0 ) THEN
772	IF ( zpres(jk,ji) < 9999.0 ) THEN
773	inpfile%pdep(jk,ji) = &
774	& p_to_dep( REAL(zpres(jk,ji),wp), REAL(inpfile%pphi(ji),wp) )
775	inpfile%idqc(jk,ji) = ipresqc(jk,ji)
776	ENDIF
777	ENDIF
778	END DO
779	ENDIF
780	END DO
781
782	!---------------------------------------------------------------------
783	! Convert depth to pressure if pressure not present
784	!---------------------------------------------------------------------
785	DO ji = 1, inpfile%nobs
786	IF ( inpfile%pphi(ji) < 9999.0 ) THEN
787	DO jk = 1, inpfile%nlev
788	IF ( zpres(jk,ji) >= 9999.0 ) THEN
789	IF ( inpfile%pdep(jk,ji) < 9999.0 ) THEN
790	zpres(jk,ji) = dep_to_p( REAL(inpfile%pdep(jk,ji),wp), &
791	& REAL(inpfile%pphi(ji),wp) )
792	ipresqc(jk,ji) = inpfile%idqc(jk,ji)
793	ENDIF
794	ENDIF
795	END DO
796	ENDIF
797	END DO
798
799	!---------------------------------------------------------------------
800	! Convert insitu temperature to potential temperature if
801	! salinity, insitu temperature and pressure are present
802	!---------------------------------------------------------------------
803	DO ji = 1, inpfile%nobs
804	DO jk = 1, inpfile%nlev
805	IF (( inpfile%pob(jk,ji,2) < 9999.0 ) .AND. &
806	&( inpfile%pext(jk,ji,1) < 9999.0 ) .AND. &
807	&( zpres(jk,ji) < 9999.0 ) ) THEN
808	inpfile%pob(jk,ji,1) = potemp( REAL(inpfile%pob(jk,ji,2), wp), &
809	& REAL(inpfile%pext(jk,ji,1), wp), &
810	& REAL(zpres(jk,ji),wp), &
811	& 0.0_wp )
812	ELSE
813	inpfile%pob(jk,ji,1) = fbrmdi
814	ENDIF
815	END DO
816	END DO
817
818	!---------------------------------------------------------------------
819	! Initialize flags since they are not in the CORIOLIS input files
820	!---------------------------------------------------------------------
821
822	inpfile%ioqcf(:,:) = 0
823	inpfile%ipqcf(:,:) = 0
824	inpfile%itqcf(:,:) = 0
825	inpfile%idqcf(:,:,:) = 0
826	inpfile%ivqcf(:,:,:) = 0
827	inpfile%ivlqcf(:,:,:,:) = 0
828
829	END SUBROUTINE read_coriofile

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

Download in other formats:

Original Format