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/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

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