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

source: branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_vel.F90 @ 2001

Last change on this file since 2001 was 2001, checked in by djlea, 14 years ago

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