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

Last change on this file since 2287 was 2287, checked in by smasson, 10 years ago

update licence of all NEMO files…

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