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_read_vel.F90 in branches/UKMO/2015_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: branches/UKMO/2015_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90 @ 5422

Last change on this file since 5422 was 5422, checked in by deazer, 9 years ago

Pre removal of svn keywords

File size: 25.3 KB
Line 
1MODULE obs_read_vel
2   !!======================================================================
3   !!                       ***  MODULE obs_read_vel  ***
4   !! Observation diagnostics: Read the velocity profile observations
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !!   obs_rea_vel_dri : Driver for reading profile obs
9   !!----------------------------------------------------------------------
10
11   !! * Modules used   
12   USE par_kind                 ! Precision variables
13   USE par_oce                  ! Ocean parameters
14   USE in_out_manager           ! I/O manager
15   USE dom_oce                  ! Ocean space and time domain variables
16   USE obs_mpp                  ! MPP support routines for observation diagnostics
17   USE julian                   ! Julian date routines
18   USE obs_utils                ! Observation operator utility functions
19   USE obs_prep                 ! Prepare observation arrays
20   USE obs_grid                 ! Grid search
21   USE obs_sort                 ! Sorting observation arrays
22   USE obs_profiles_def         ! Profile definitions
23   USE obs_conv                 ! Various conversion routines
24   USE obs_types                ! Observation type definitions
25   USE netcdf                   ! NetCDF library
26   USE obs_oper                 ! Observation operators
27   USE obs_vel_io               ! Velocity profile files I/O (non-FB files)
28   USE lib_mpp                  ! For ctl_warn/stop
29
30   IMPLICIT NONE
31
32   !! * Routine accessibility
33   PRIVATE
34
35   PUBLIC obs_rea_vel_dri  ! Read the profile observations
36
37   !!----------------------------------------------------------------------
38   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
39   !! $Id$
40   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42
43CONTAINS
44 
45   SUBROUTINE obs_rea_vel_dri( kformat, &
46      &                        profdata, knumfiles, cfilenames, &
47      &                        kvars, kextr, kstp, ddobsini, ddobsend, &
48      &                        ldignmis, ldavtimset, ldmod )
49      !!---------------------------------------------------------------------
50      !!
51      !!                   *** ROUTINE obs_rea_pro_dri ***
52      !!
53      !! ** Purpose : Read from file the profile observations
54      !!
55      !! ** Method  : Depending on kformat either ENACT, CORIOLIS or
56      !!              feedback data files are read
57      !!
58      !! ** Action  :
59      !!
60      !! References :
61      !!
62      !! History : 
63      !!      ! :  2009-01 (K. Mogensen) : New merged version of old routines
64      !!----------------------------------------------------------------------
65      !! * Modules used
66   
67      !! * Arguments
68      INTEGER :: kformat   ! Format of input data
69      !                    ! 1: ENACT
70      !                    ! 2: Coriolis
71      TYPE(obs_prof), INTENT(OUT) :: profdata    ! Profile data to be read
72      INTEGER, INTENT(IN) :: knumfiles           ! Number of files to read in
73      CHARACTER(LEN=128), INTENT(IN) ::  cfilenames(knumfiles) ! File names to read in
74      INTEGER, INTENT(IN) :: kvars       ! Number of variables in profdata
75      INTEGER, INTENT(IN) :: kextr       ! Number of extra fields for each var in profdata
76      INTEGER, INTENT(IN) :: kstp        !  Ocean time-step index
77      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
78      LOGICAL, INTENT(IN) :: ldavtimset  ! Set time to be equal to the end of the day
79      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
80      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
81      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
82
83      !! * Local declarations
84      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_vel_dri'
85      INTEGER :: jvar
86      INTEGER :: ji
87      INTEGER :: jj
88      INTEGER :: jk
89      INTEGER :: ij
90      INTEGER :: iflag
91      INTEGER :: inobf
92      INTEGER :: i_file_id
93      INTEGER :: inowin
94      INTEGER :: iyea
95      INTEGER :: imon
96      INTEGER :: iday
97      INTEGER :: ihou
98      INTEGER :: imin
99      INTEGER :: isec
100      INTEGER, DIMENSION(knumfiles) :: &
101         & irefdate
102      INTEGER, DIMENSION(ntyp1770+1) :: &
103         & itypuv,    &
104         & itypuvmpp 
105      INTEGER :: iuv3dtmpp
106      INTEGER, DIMENSION(:), ALLOCATABLE :: &
107         & iobsiu,   &
108         & iobsju,   &
109         & iprocu,   &
110         & iobsiv,   &
111         & iobsjv,   &
112         & iprocv,   &
113         & iindx,    &
114         & ifileidx, &
115         & iprofidx
116      INTEGER :: itype
117      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
118         & zphi, &
119         & zlam
120      real(wp), DIMENSION(:), ALLOCATABLE :: &
121         & zdat
122      LOGICAL :: &
123         & llvalprof
124      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
125         & inpfiles
126      real(wp), DIMENSION(knumfiles) :: &
127         & djulini, &
128         & djulend
129      INTEGER :: iprof
130      INTEGER :: iproftot
131      INTEGER :: iuv3dt
132      INTEGER :: ios
133      INTEGER :: ioserrcount
134      INTEGER, DIMENSION(kvars) :: iv3dt
135      CHARACTER(len=8) :: cl_refdate
136   
137      ! Local initialization
138      iprof = 0
139      iuv3dt = 0
140
141      !-----------------------------------------------------------------------
142      ! Check data the model part is just with feedback data files
143      !-----------------------------------------------------------------------
144      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
145         CALL ctl_stop( 'Model can only be read from feedback data' )
146         RETURN
147      ENDIF
148
149      !-----------------------------------------------------------------------
150      ! Count the number of files needed and allocate the obfbdata type
151      !-----------------------------------------------------------------------
152     
153      inobf = knumfiles
154
155      ALLOCATE( inpfiles(inobf) )
156
157      prof_files : DO jj = 1, inobf
158         
159         !---------------------------------------------------------------------
160         ! Prints
161         !---------------------------------------------------------------------
162         IF(lwp) THEN
163            WRITE(numout,*)
164            WRITE(numout,*) ' obs_rea_vel_dri : Reading from file = ', &
165               & TRIM( TRIM( cfilenames(jj) ) )
166            WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
167            WRITE(numout,*)
168         ENDIF
169
170         !---------------------------------------------------------------------
171         !  Initialization: Open file and get dimensions only
172         !---------------------------------------------------------------------
173         
174         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
175            &                      i_file_id )
176         
177         IF ( iflag /= nf90_noerr ) THEN
178
179            IF ( ldignmis ) THEN
180               inpfiles(jj)%nobs = 0
181               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
182                  &           ' not found' )
183            ELSE
184               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
185                  &           ' not found' )
186            ENDIF
187
188         ELSE 
189           
190            !------------------------------------------------------------------
191            !  Close the file since it is opened in read_proffile
192            !------------------------------------------------------------------
193           
194            iflag = nf90_close( i_file_id )
195
196            !------------------------------------------------------------------
197            !  Read the profile file into inpfiles
198            !------------------------------------------------------------------
199            IF ( kformat == 0 ) THEN
200               CALL init_obfbdata( inpfiles(jj) )
201               IF(lwp) THEN
202                  WRITE(numout,*)
203                  WRITE(numout,*)'Reading from feedback file :', &
204                     &           TRIM( cfilenames(jj) )
205               ENDIF
206               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
207                  &                ldgrid = .TRUE. )
208               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
209                  CALL ctl_stop( 'Model not in input data' )
210                  RETURN
211               ENDIF
212            ELSEIF ( kformat == 1 ) THEN
213               CALL read_taondbc( TRIM( cfilenames(jj) ), inpfiles(jj), &
214                  &               numout, lwp, .TRUE. )
215            ELSE
216               CALL ctl_stop( 'File format unknown' )
217            ENDIF
218           
219            !------------------------------------------------------------------
220            !  Change longitude (-180,180)
221            !------------------------------------------------------------------
222
223            DO ji = 1, inpfiles(jj)%nobs 
224
225               IF ( inpfiles(jj)%plam(ji) < -180. ) &
226                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
227
228               IF ( inpfiles(jj)%plam(ji) >  180. ) &
229                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
230
231            END DO
232
233            !------------------------------------------------------------------
234            !  Calculate the date  (change eventually)
235            !------------------------------------------------------------------
236            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
237            READ(cl_refdate,'(I8)') irefdate(jj)
238           
239            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
240            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
241               &           krefdate = irefdate(jj) )
242            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
243            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
244               &           krefdate = irefdate(jj) )
245
246            IF ( ldavtimset ) THEN
247               DO ji = 1, inpfiles(jj)%nobs
248                  !
249                  !  for daily averaged data force the time
250                  !  to be the  end of the day
251                  !
252                  inpfiles(jj)%ptim(ji) = &
253                     & INT(inpfiles(jj)%ptim(ji)) + 1
254               END DO
255            ENDIF
256           
257            IF ( inpfiles(jj)%nobs > 0 ) THEN
258               inpfiles(jj)%iproc = -1
259               inpfiles(jj)%iobsi = -1
260               inpfiles(jj)%iobsj = -1
261            ENDIF
262            inowin = 0
263            DO ji = 1, inpfiles(jj)%nobs
264               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
265                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
266                  inowin = inowin + 1
267               ENDIF
268            END DO
269            ALLOCATE( zlam(inowin)  )
270            ALLOCATE( zphi(inowin)  )
271            ALLOCATE( iobsiu(inowin) )
272            ALLOCATE( iobsju(inowin) )
273            ALLOCATE( iprocu(inowin) )
274            ALLOCATE( iobsiv(inowin) )
275            ALLOCATE( iobsjv(inowin) )
276            ALLOCATE( iprocv(inowin) )
277            inowin = 0
278            DO ji = 1, inpfiles(jj)%nobs
279               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
280                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
281                  inowin = inowin + 1
282                  zlam(inowin) = inpfiles(jj)%plam(ji)
283                  zphi(inowin) = inpfiles(jj)%pphi(ji)
284               ENDIF
285            END DO
286
287            CALL obs_grid_search( inowin, zlam, zphi, iobsiu, iobsju, iprocu, &
288               & 'U' )
289            CALL obs_grid_search( inowin, zlam, zphi, iobsiv, iobsjv, iprocv, &
290               & 'V' )
291
292            inowin = 0
293            DO ji = 1, inpfiles(jj)%nobs
294               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
295                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
296                  inowin = inowin + 1
297                  inpfiles(jj)%iproc(ji,1) = iprocu(inowin)
298                  inpfiles(jj)%iobsi(ji,1) = iobsiu(inowin)
299                  inpfiles(jj)%iobsj(ji,1) = iobsju(inowin)
300                  inpfiles(jj)%iproc(ji,2) = iprocv(inowin)
301                  inpfiles(jj)%iobsi(ji,2) = iobsiv(inowin)
302                  inpfiles(jj)%iobsj(ji,2) = iobsjv(inowin)
303                  IF ( inpfiles(jj)%iproc(ji,1) /= &
304                     & inpfiles(jj)%iproc(ji,2) ) THEN
305                     CALL ctl_stop( 'Error in obs_read_vel:', &
306                        & 'U and V observation on different processors')
307                  ENDIF
308               ENDIF
309            END DO
310            DEALLOCATE( zlam, zphi, iobsiu, iobsju, iprocu,  &
311               & iobsiv, iobsjv, iprocv )
312
313            DO ji = 1, inpfiles(jj)%nobs
314               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
315                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
316                  IF ( nproc == 0 ) THEN
317                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
318                  ELSE
319                     IF ( inpfiles(jj)%iproc(ji,1) /=  nproc ) CYCLE
320                  ENDIF
321                  llvalprof = .FALSE.
322                  IF ( ( ( nproc == 0 ) .AND. &
323                     & ( inpfiles(jj)%iproc(ji,1) <=  nproc ) ) .OR. &
324                     & ( inpfiles(jj)%iproc(ji,1) ==  nproc ) ) THEN
325                     loop_uv_count : DO ij = 1,inpfiles(jj)%nlev
326                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
327                           & CYCLE
328                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
329                           & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
330                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
331                           iuv3dt = iuv3dt + 1
332                           llvalprof = .TRUE.
333                        ENDIF
334                     END DO loop_uv_count
335                  ENDIF
336                  IF ( llvalprof ) iprof = iprof + 1
337               ENDIF
338            END DO
339
340         ENDIF
341         
342      END DO prof_files
343
344      !-----------------------------------------------------------------------
345      ! Get the time ordered indices of the input data
346      !-----------------------------------------------------------------------
347
348      !---------------------------------------------------------------------
349      !  Loop over input data files to count total number of profiles
350      !---------------------------------------------------------------------
351      iproftot = 0
352      DO jj = 1, inobf
353         DO ji = 1, inpfiles(jj)%nobs
354            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
355               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
356               iproftot = iproftot + 1
357            ENDIF
358         END DO
359      END DO
360
361      ALLOCATE( iindx(iproftot), ifileidx(iproftot), &
362         &      iprofidx(iproftot), zdat(iproftot) )
363      jk = 0
364      DO jj = 1, inobf
365         DO ji = 1, inpfiles(jj)%nobs
366            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
367               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
368               jk = jk + 1
369               ifileidx(jk) = jj
370               iprofidx(jk) = ji
371               zdat(jk)     = inpfiles(jj)%ptim(ji)
372            ENDIF
373         END DO
374      END DO
375      CALL sort_dp_indx( iproftot, &
376         &               zdat,     &
377         &               iindx   )
378     
379      iv3dt(:) = -1
380      iv3dt(1:2) = iuv3dt
381      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
382         &                 kstp, jpi, jpj, jpk )
383     
384      ! * Read obs/positions, QC, all variable and assign to profdata
385
386      profdata%nprof     = 0
387      profdata%nvprot(:) = 0
388
389      iprof = 0
390
391      iuv3dt = 0
392      itypuv   (:) = 0
393      itypuvmpp(:) = 0
394     
395      DO jk = 1, iproftot
396         
397         jj = ifileidx(iindx(jk))
398         ji = iprofidx(iindx(jk))
399         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
400            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
401           
402            IF ( nproc == 0 ) THEN
403               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
404            ELSE
405               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
406            ENDIF
407           
408            llvalprof = .FALSE.
409
410            loop_prof : DO ij = 1, inpfiles(jj)%nlev
411               
412               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
413                  & CYCLE
414               
415               IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
416                  & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
417                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
418
419                  llvalprof = .TRUE.
420                  EXIT loop_prof
421
422               ENDIF
423
424            END DO loop_prof
425           
426            ! Set profile information
427           
428            IF ( llvalprof ) THEN
429               
430               iprof = iprof + 1
431
432               CALL jul2greg( isec,                   &
433                  &           imin,                   &
434                  &           ihou,                   &
435                  &           iday,                   &
436                  &           imon,                   &
437                  &           iyea,                   &
438                  &           inpfiles(jj)%ptim(ji), &
439                  &           irefdate(jj) )
440
441
442               ! Profile time coordinates
443               profdata%nyea(iprof) = iyea
444               profdata%nmon(iprof) = imon
445               profdata%nday(iprof) = iday
446               profdata%nhou(iprof) = ihou
447               profdata%nmin(iprof) = imin
448               
449               ! Profile space coordinates
450               profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
451               profdata%rphi(iprof) = inpfiles(jj)%pphi(ji)
452
453               ! Coordinate search parameters
454               profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1)
455               profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1)
456               profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2)
457               profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2)
458               
459               ! Profile WMO number
460               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
461               
462               ! Instrument type
463               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
464901            IF ( ios /= 0 ) THEN
465                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 
466                  ioserrcount = ioserrcount + 1
467                  itype = 0
468               ENDIF
469               profdata%ntyp(iprof) = itype
470               
471               ! QC stuff
472
473               profdata%nqc(iprof)     = inpfiles(jj)%ioqc(ji)
474               profdata%nqcf(:,iprof)  = inpfiles(jj)%ioqcf(:,ji)
475               profdata%ipqc(iprof)    = inpfiles(jj)%ipqc(ji)
476               profdata%ipqcf(:,iprof) = inpfiles(jj)%ipqcf(:,ji)
477               profdata%itqc(iprof)    = inpfiles(jj)%itqc(ji)
478               profdata%itqcf(:,iprof) = inpfiles(jj)%itqcf(:,ji)
479               profdata%ivqc(iprof,:)  = inpfiles(jj)%ivqc(ji,:)
480               profdata%ivqcf(:,iprof,:) = inpfiles(jj)%ivqcf(:,ji,:)
481
482               ! Bookkeeping data to match profiles
483               profdata%npidx(iprof) = iprof
484               profdata%npfil(iprof) = iindx(jk)
485
486               ! Observation QC flag (whole profile)
487               profdata%nqc(iprof)  = 0 !TODO
488
489               loop_uv : DO ij = 1, inpfiles(jj)%nlev           
490                   
491                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
492                     & CYCLE
493
494                  IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
495                     & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
496                     & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
497                     iuv3dt = iuv3dt + 1
498                  ELSE
499                     CYCLE
500                  ENDIF
501
502                  ! Depth of U observation
503                  profdata%var(1)%vdep(iuv3dt) = &
504                     &                inpfiles(jj)%pdep(ij,ji)
505                 
506                  ! Depth of U observation QC
507                  profdata%var(1)%idqc(iuv3dt) = &
508                     &                inpfiles(jj)%idqc(ij,ji)
509                 
510                  ! Depth of U observation QC flags
511                  profdata%var(1)%idqcf(:,iuv3dt) = &
512                     &                inpfiles(jj)%idqcf(:,ij,ji)
513                 
514                  ! Profile index
515                  profdata%var(1)%nvpidx(iuv3dt) = iprof
516                 
517                  ! Vertical index in original profile
518                  profdata%var(1)%nvlidx(iuv3dt) = ij
519
520                  ! Profile U value
521
522                  profdata%var(1)%vobs(iuv3dt) = &
523                     &                inpfiles(jj)%pob(ij,ji,1)
524                  IF ( ldmod ) THEN
525                     profdata%var(1)%vmod(iuv3dt) = &
526                        &                inpfiles(jj)%padd(ij,ji,1,1)
527                  ENDIF
528                 
529                  ! Profile U qc
530                  profdata%var(1)%nvqc(iuv3dt) = &
531                     & inpfiles(jj)%ivlqc(ij,ji,1)
532                 
533                  ! Profile U qc flags
534                  profdata%var(1)%nvqcf(:,iuv3dt) = &
535                     & inpfiles(jj)%ivlqcf(:,ij,ji,1)
536                 
537                 
538                  ! Depth of V observation
539                  profdata%var(2)%vdep(iuv3dt) = &
540                     &                inpfiles(jj)%pdep(ij,ji)
541                 
542                  ! Depth of V observation QC
543                  profdata%var(2)%idqc(iuv3dt) = &
544                     &                inpfiles(jj)%idqc(ij,ji)
545                 
546                  ! Depth of V observation QC flags
547                  profdata%var(2)%idqcf(:,iuv3dt) = &
548                     &                inpfiles(jj)%idqcf(:,ij,ji)
549                 
550                  ! Profile index
551                  profdata%var(2)%nvpidx(iuv3dt) = iprof
552                 
553                  ! Vertical index in original profile
554                  profdata%var(2)%nvlidx(iuv3dt) = ij
555                 
556                  ! Profile V value
557                  profdata%var(2)%vobs(iuv3dt) = &
558                     &                inpfiles(jj)%pob(ij,ji,2)
559                  IF ( ldmod ) THEN
560                     profdata%var(2)%vmod(iuv3dt) = &
561                        &                inpfiles(jj)%padd(ij,ji,1,2)
562                  ENDIF
563                     
564                  ! Profile V qc
565                  profdata%var(2)%nvqc(iuv3dt) = &
566                     & inpfiles(jj)%ivlqc(ij,ji,2)
567                 
568                  ! Profile V qc flags
569                  profdata%var(2)%nvqcf(:,iuv3dt) = &
570                        & inpfiles(jj)%ivlqcf(:,ij,ji,2)
571                 
572                  ! Observation type
573                  itypuv( profdata%ntyp(iprof) + 1 ) = &
574                     & itypuv( profdata%ntyp(iprof) + 1 ) + 1
575
576
577               END DO loop_uv
578
579            ENDIF
580
581         ENDIF
582
583      END DO
584
585      !-----------------------------------------------------------------------
586      ! Sum up over processors
587      !-----------------------------------------------------------------------
588     
589      CALL obs_mpp_sum_integer ( iuv3dt, iuv3dtmpp )
590     
591      CALL obs_mpp_sum_integers( itypuv, itypuvmpp, ntyp1770 + 1 )
592     
593      !-----------------------------------------------------------------------
594      ! Output number of observations.
595      !-----------------------------------------------------------------------
596      IF(lwp) THEN
597         WRITE(numout,*) 
598         WRITE(numout,'(1X,A)') 'Profile U,V velocity data'
599         WRITE(numout,'(1X,A)') '-------------------------'
600         WRITE(numout,*) 
601         DO ji = 0, ntyp1770
602            IF ( itypuvmpp(ji+1) > 0 ) THEN
603               WRITE(numout,'(1X,A3,A3,I8)') ctypshort(ji), ' = ', &
604                  & itypuvmpp(ji+1)
605            ENDIF
606         END DO
607         WRITE(numout,'(1X,A)') '--------------'
608         WRITE(numout,'(1X,A6,I8)') &
609            & 'Total profile UV data                                 = ',&
610            & iuv3dtmpp
611         WRITE(numout,'(1X,A)') '--------------'
612      ENDIF
613     
614      profdata%nvprot(1)    = iuv3dt
615      profdata%nvprot(2)    = iuv3dt
616      profdata%nvprotmpp(1) = iuv3dtmpp
617      profdata%nvprotmpp(2) = iuv3dtmpp
618      profdata%nprof        = iprof
619
620      !-----------------------------------------------------------------------
621      ! Model level search
622      !-----------------------------------------------------------------------
623      CALL obs_level_search( jpk, gdept_1d,          &
624         & profdata%nvprot(1), profdata%var(1)%vdep, &
625         & profdata%var(1)%mvk )
626      CALL obs_level_search( jpk, gdept_1d,          &
627         & profdata%nvprot(2), profdata%var(2)%vdep, &
628         & profdata%var(2)%mvk )
629     
630      !-----------------------------------------------------------------------
631      ! Set model equivalent to 99999
632      !-----------------------------------------------------------------------
633      IF ( .NOT. ldmod ) THEN
634         DO jvar = 1, kvars
635            profdata%var(jvar)%vmod(:) = fbrmdi
636         END DO
637      ENDIF
638      !-----------------------------------------------------------------------
639      ! Deallocate temporary data
640      !-----------------------------------------------------------------------
641      DEALLOCATE( ifileidx, iprofidx, zdat )
642
643      !-----------------------------------------------------------------------
644      ! Deallocate input data
645      !-----------------------------------------------------------------------
646      DO jj = 1, inobf
647         CALL dealloc_obfbdata( inpfiles(jj) )
648      END DO
649      DEALLOCATE( inpfiles )
650
651   END SUBROUTINE obs_rea_vel_dri
652   
653END MODULE obs_read_vel
Note: See TracBrowser for help on using the repository browser.