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_surf.F90 in NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_read_surf.F90 @ 15487

Last change on this file since 15487 was 15487, checked in by dford, 8 months ago

Remove some comments and add some spaces.

File size: 28.2 KB
Line 
1MODULE obs_read_surf
2   !!======================================================================
3   !!                       ***  MODULE obs_read_surf  ***
4   !! Observation diagnostics: Read the surface data from feedback files
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !!   obs_rea_surf : Driver for reading surface data from feedback files
9   !!----------------------------------------------------------------------
10
11   !! * Modules used
12   USE par_kind                 ! Precision variables
13   USE in_out_manager           ! I/O manager
14   USE dom_oce                  ! Ocean space and time domain variables
15   USE obs_mpp                  ! MPP support routines for observation diagnostics
16   USE julian                   ! Julian date routines
17   USE obs_utils                ! Observation operator utility functions
18   USE obs_grid                 ! Grid search
19   USE obs_sort                 ! Sorting observation arrays
20   USE obs_surf_def             ! Surface observation definitions
21   USE obs_types                ! Observation type definitions
22   USE obs_fbm                  ! Feedback routines
23   USE netcdf                   ! NetCDF library
24   USE obs_group_def, ONLY : &  ! Observation variable information
25      & cobsname_uvel, &
26      & cobsname_vvel
27
28   IMPLICIT NONE
29
30   !! * Routine accessibility
31   PRIVATE
32
33   PUBLIC obs_rea_surf      ! Read the surface observations from the point data
34
35   !!----------------------------------------------------------------------
36   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
37   !! $Id$
38   !! Software governed by the CeCILL license (see ./LICENSE)
39   !!----------------------------------------------------------------------
40
41CONTAINS
42
43   SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, &
44      &                     kvars, kadd, kextr, kstp, ddobsini, ddobsend, &
45      &                     ptime_mean_period, ld_time_mean_bkg, &
46      &                     ldignmis, ldmod, ldnightav, cdvars )
47      !!---------------------------------------------------------------------
48      !!
49      !!                   *** ROUTINE obs_rea_surf ***
50      !!
51      !! ** Purpose : Read from file the surface data
52      !!
53      !! ** Method  : Read in the data from feedback format files and
54      !!              put into the NEMO internal surface data structure
55      !!
56      !! ** Action  :
57      !!
58      !!
59      !! History : 
60      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
61      !!      ! :  2015-02 (M. Martin)   Unify the different surface data type reading.
62      !!----------------------------------------------------------------------
63      !! * Modules used
64
65      !! * Arguments
66      TYPE(obs_surf), INTENT(INOUT) :: &
67         & surfdata                             ! Surface data to be read
68      INTEGER,  INTENT(IN) :: knumfiles         ! Number of corio format files to read
69      CHARACTER(LEN=128), INTENT(IN) :: &
70         & cdfilenames(knumfiles)               ! File names to read in
71      INTEGER,  INTENT(IN) :: kvars             ! Number of variables in surfdata
72      INTEGER,  INTENT(IN) :: kadd              ! Number of additional fields
73                                                !   in addition to those in the input file(s)
74      INTEGER,  INTENT(IN) :: kextr             ! Number of extra fields
75                                                !   in addition to those in the input file(s)
76      INTEGER,  INTENT(IN) :: kstp              ! Ocean time-step index
77      REAL(dp), INTENT(IN) :: ddobsini          ! Obs. ini time in YYYYMMDD.HHMMSS
78      REAL(dp), INTENT(IN) :: ddobsend          ! Obs. end time in YYYYMMDD.HHMMSS
79      REAL(wp), INTENT(IN) :: ptime_mean_period ! Averaging period in hours
80      LOGICAL,  INTENT(IN) :: ld_time_mean_bkg  ! Will reset times to end of averaging period
81      LOGICAL,  INTENT(IN) :: ldignmis          ! Ignore missing files
82      LOGICAL,  INTENT(IN) :: ldmod             ! Initialize model from input data
83      LOGICAL,  INTENT(IN) :: ldnightav         ! Observations represent a night-time average
84      CHARACTER(len=8), DIMENSION(kvars), INTENT(IN) :: cdvars  ! Expected variable names
85
86      !! * Local declarations
87      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_surf'
88      CHARACTER(len=8) :: clrefdate
89      CHARACTER(len=ilenname), DIMENSION(:),   ALLOCATABLE :: clvarsin
90      CHARACTER(len=ilenlong), DIMENSION(:),   ALLOCATABLE :: cllongin
91      CHARACTER(len=ilenunit), DIMENSION(:),   ALLOCATABLE :: clunitin
92      CHARACTER(len=ilengrid), DIMENSION(:),   ALLOCATABLE :: clgridin
93      CHARACTER(len=ilenname), DIMENSION(:),   ALLOCATABLE :: claddvarsin
94      CHARACTER(len=ilenlong), DIMENSION(:,:), ALLOCATABLE :: claddlongin
95      CHARACTER(len=ilenunit), DIMENSION(:,:), ALLOCATABLE :: claddunitin
96      CHARACTER(len=ilenname), DIMENSION(:),   ALLOCATABLE :: clextvarsin
97      CHARACTER(len=ilenlong), DIMENSION(:),   ALLOCATABLE :: clextlongin
98      CHARACTER(len=ilenunit), DIMENSION(:),   ALLOCATABLE :: clextunitin
99      INTEGER :: ji
100      INTEGER :: jj
101      INTEGER :: jk
102      INTEGER :: jind
103      INTEGER :: jvar
104      INTEGER :: jext
105      INTEGER :: jadd
106      INTEGER :: jadd2
107      INTEGER :: iadd
108      INTEGER :: iaddin
109      INTEGER :: iextr
110      INTEGER :: iflag
111      INTEGER :: inobf
112      INTEGER :: i_file_id
113      INTEGER :: inowin
114      INTEGER :: iyea
115      INTEGER :: imon
116      INTEGER :: iday
117      INTEGER :: ihou
118      INTEGER :: imin
119      INTEGER :: isec
120      INTEGER :: itype
121      INTEGER :: iobsmpp
122      INTEGER :: iobs
123      INTEGER :: iobstot
124      INTEGER :: ios
125      INTEGER :: ioserrcount
126      INTEGER, PARAMETER :: jpsurfmaxtype = 1024
127      INTEGER, DIMENSION(knumfiles) :: irefdate
128      INTEGER, DIMENSION(jpsurfmaxtype+1) :: &
129         & ityp, &
130         & itypmpp
131      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
132         & iobsi,    &
133         & iobsj,    &
134         & iproc
135      INTEGER, DIMENSION(:), ALLOCATABLE :: &
136         & iindx,    &
137         & ifileidx, &
138         & isurfidx
139      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
140         & zphi, &
141         & zlam
142      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
143         & zdat
144      REAL(wp), DIMENSION(knumfiles) :: &
145         & djulini, &
146         & djulend
147      LOGICAL :: llvalprof
148      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
149         & inpfiles
150      CHARACTER(LEN=256) :: cout1  ! Diagnostic output line
151
152      ! Local initialization
153      iobs = 0
154
155      !-----------------------------------------------------------------------
156      ! Count the number of files needed and allocate the obfbdata type
157      !-----------------------------------------------------------------------
158
159      inobf = knumfiles
160
161      ALLOCATE( inpfiles(inobf) )
162
163      iadd  = 0
164      iextr = 0
165
166      surf_files : DO jj = 1, inobf
167
168         !---------------------------------------------------------------------
169         ! Prints
170         !---------------------------------------------------------------------
171         IF(lwp) THEN
172            WRITE(numout,*)
173            WRITE(numout,*) ' obs_rea_surf : Reading from file = ', &
174               & TRIM( TRIM( cdfilenames(jj) ) )
175            WRITE(numout,*) ' ~~~~~~~~~~~'
176            WRITE(numout,*)
177         ENDIF
178
179         !---------------------------------------------------------------------
180         !  Initialization: Open file and get dimensions only
181         !---------------------------------------------------------------------
182
183         iflag = nf90_open( TRIM( TRIM( cdfilenames(jj) ) ), nf90_nowrite, &
184            &                      i_file_id )
185
186         IF ( iflag /= nf90_noerr ) THEN
187
188            IF ( ldignmis ) THEN
189               inpfiles(jj)%nobs = 0
190               CALL ctl_warn( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // &
191                  &           ' not found' )
192            ELSE
193               CALL ctl_stop( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // &
194                  &           ' not found' )
195            ENDIF
196
197         ELSE 
198
199            !------------------------------------------------------------------
200            !  Close the file since it is opened in read_obfbdata
201            !------------------------------------------------------------------
202
203            iflag = nf90_close( i_file_id )
204
205            !------------------------------------------------------------------
206            !  Read the surface file into inpfiles
207            !------------------------------------------------------------------
208            CALL init_obfbdata( inpfiles(jj) )
209            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), &
210               &                ldgrid = .TRUE. )
211
212            IF ( inpfiles(jj)%nvar /= kvars ) THEN
213               CALL ctl_stop( 'Feedback format error: ', &
214                  &           ' unexpected number of vars in feedback file', &
215                  &           TRIM(cdfilenames(jj)) )
216            ENDIF
217
218            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
219               CALL ctl_stop( 'Model not in input data in', &
220                  &           TRIM(cdfilenames(jj)) )
221               RETURN
222            ENDIF
223
224            IF ( (iextr > 0) .AND. (inpfiles(jj)%next /= iextr) ) THEN
225               CALL ctl_stop( 'Number of extra variables not consistent', &
226                  &           ' with previous files for this type in', &
227                  &           TRIM(cdfilenames(jj)) )
228            ELSE
229               iextr = inpfiles(jj)%next
230            ENDIF
231
232            ! Ignore model counterpart
233            iaddin = inpfiles(jj)%nadd
234            DO ji = 1, iaddin
235               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'Hx' ) THEN
236                  iaddin = iaddin - 1
237                  EXIT
238               ENDIF
239            END DO
240            IF ( ldmod .AND. ( inpfiles(jj)%nadd == iaddin ) ) THEN
241               CALL ctl_stop( 'Model not in input data', &
242                  &           TRIM(cdfilenames(jj)) )
243            ENDIF
244
245            IF ( (iadd > 0) .AND. (iaddin /= iadd) ) THEN
246               CALL ctl_stop( 'Number of additional variables not consistent', &
247                  &           ' with previous files for this type in', &
248                  &           TRIM(cdfilenames(jj)) )
249            ELSE
250               iadd = iaddin
251            ENDIF
252
253            IF ( jj == 1 ) THEN
254               ALLOCATE( clvarsin( inpfiles(jj)%nvar ) )
255               ALLOCATE( cllongin( inpfiles(jj)%nvar ) )
256               ALLOCATE( clunitin( inpfiles(jj)%nvar ) )
257               ALLOCATE( clgridin( inpfiles(jj)%nvar ) )
258               DO ji = 1, inpfiles(jj)%nvar
259                 clvarsin(ji) = inpfiles(jj)%cname(ji)
260                 cllongin(ji) = inpfiles(jj)%coblong(ji)
261                 clunitin(ji) = inpfiles(jj)%cobunit(ji)
262                 clgridin(ji) = inpfiles(jj)%cgrid(ji)
263                 IF ( clvarsin(ji) /= cdvars(ji) ) THEN
264                    CALL ctl_stop( 'Feedback file variables do not match', &
265                        &           ' expected variable names for this type' )
266                 ENDIF
267               END DO
268               IF ( iadd > 0 ) THEN
269                  ALLOCATE( claddvarsin( iadd ) )
270                  ALLOCATE( claddlongin( iadd, inpfiles(jj)%nvar ) )
271                  ALLOCATE( claddunitin( iadd, inpfiles(jj)%nvar ) )
272                  jadd = 0
273                  DO ji = 1, inpfiles(jj)%nadd
274                    IF ( TRIM(inpfiles(jj)%caddname(ji)) /= 'Hx' ) THEN
275                       jadd = jadd + 1
276                       claddvarsin(jadd) = inpfiles(jj)%caddname(ji)
277                       DO jk = 1, inpfiles(jj)%nvar
278                          claddlongin(jadd,jk) = inpfiles(jj)%caddlong(ji,jk)
279                          claddunitin(jadd,jk) = inpfiles(jj)%caddunit(ji,jk)
280                       END DO
281                    ENDIF
282                  END DO
283               ENDIF
284               IF ( iextr > 0 ) THEN
285                  ALLOCATE( clextvarsin( iextr ) )
286                  ALLOCATE( clextlongin( iextr ) )
287                  ALLOCATE( clextunitin( iextr ) )
288                  DO ji = 1, iextr
289                    clextvarsin(ji) = inpfiles(jj)%cextname(ji)
290                    clextlongin(ji) = inpfiles(jj)%cextlong(ji)
291                    clextunitin(ji) = inpfiles(jj)%cextunit(ji)
292                  END DO
293               ENDIF
294            ELSE
295               DO ji = 1, inpfiles(jj)%nvar
296                  IF ( inpfiles(jj)%cname(ji) /= clvarsin(ji) ) THEN
297                     CALL ctl_stop( 'Feedback file variables not consistent', &
298                        &           ' with previous files for this type in', &
299                        &           TRIM(cdfilenames(jj)) )
300                  ENDIF
301               END DO
302               IF ( iadd > 0 ) THEN
303                  jadd = 0
304                  DO ji = 1, inpfiles(jj)%nadd
305                     IF ( TRIM(inpfiles(jj)%caddname(ji)) /= 'Hx' ) THEN
306                        jadd = jadd + 1
307                        IF ( inpfiles(jj)%caddname(ji) /= claddvarsin(jadd) ) THEN
308                           CALL ctl_stop( 'Feedback file additional variables not consistent', &
309                              &           ' with previous files for this type in', &
310                              &           TRIM(cdfilenames(jj)) )
311                        ENDIF
312                     ENDIF
313                  END DO
314               ENDIF
315               IF ( iextr > 0 ) THEN
316                  DO ji = 1, iextr
317                     IF ( inpfiles(jj)%cextname(ji) /= clextvarsin(ji) ) THEN
318                        CALL ctl_stop( 'Feedback file extra variables not consistent', &
319                           &           ' with previous files for this type in', &
320                           &           TRIM(cdfilenames(jj)) )
321                     ENDIF
322                  END DO
323               ENDIF
324
325            ENDIF
326
327            IF (lwp) WRITE(numout,*) 'Observation file contains ', inpfiles(jj)%nobs, ' observations'
328
329            !------------------------------------------------------------------
330            !  Change longitude (-180,180)
331            !------------------------------------------------------------------
332
333            DO ji = 1, inpfiles(jj)%nobs
334
335               IF ( inpfiles(jj)%plam(ji) < -180. ) &
336                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
337
338               IF ( inpfiles(jj)%plam(ji) >  180. ) &
339                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
340
341            END DO
342
343            !------------------------------------------------------------------
344            !  Calculate the date  (change eventually)
345            !------------------------------------------------------------------
346            clrefdate=inpfiles(jj)%cdjuldref(1:8)
347            READ(clrefdate,'(I8)') irefdate(jj)
348
349            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
350            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
351               &           krefdate = irefdate(jj) )
352            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
353            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
354               &           krefdate = irefdate(jj) )
355
356            IF ( ldnightav ) THEN
357
358               IF ( lwp ) THEN
359                  WRITE(numout,*)'Resetting time of night-time averaged observations', &
360                     &             ' to the end of the day'
361               ENDIF
362
363               DO ji = 1, inpfiles(jj)%nobs
364                  !  for night-time averaged data force the time
365                  !  to be the last time-step of the day, but still within the day.
366                  IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN
367                     inpfiles(jj)%ptim(ji) = &
368                        & INT(inpfiles(jj)%ptim(ji)) + 0.9999
369                  ELSE
370                     inpfiles(jj)%ptim(ji) = &
371                        & INT(inpfiles(jj)%ptim(ji)) - 0.0001
372                  ENDIF
373               END DO
374            ENDIF
375
376            IF ( inpfiles(jj)%nobs > 0 ) THEN
377               inpfiles(jj)%iproc(:,:) = -1
378               inpfiles(jj)%iobsi(:,:) = -1
379               inpfiles(jj)%iobsj(:,:) = -1
380            ENDIF
381
382            ! If observations are representing a time mean then set the time
383            ! of the obs to the end of that meaning period relative to the start of the run
384            IF ( ld_time_mean_bkg ) THEN
385               DO ji = 1, inpfiles(jj)%nobs
386                  ! Only do this for obs within time window
387                  IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
388                     & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
389                     inpfiles(jj)%ptim(ji) = djulini(jj) + (ptime_mean_period/24.0)
390                  ENDIF
391               END DO
392            ENDIF
393
394            inowin = 0
395            DO ji = 1, inpfiles(jj)%nobs
396               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
397                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
398                  inowin = inowin + 1
399               ENDIF
400            END DO
401            ALLOCATE( zlam (inowin)       )
402            ALLOCATE( zphi (inowin)       )
403            ALLOCATE( iobsi(inowin,kvars) )
404            ALLOCATE( iobsj(inowin,kvars) )
405            ALLOCATE( iproc(inowin,kvars) )
406            inowin = 0
407            DO ji = 1, inpfiles(jj)%nobs
408               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
409                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
410                  inowin = inowin + 1
411                  zlam(inowin) = inpfiles(jj)%plam(ji)
412                  zphi(inowin) = inpfiles(jj)%pphi(ji)
413               ENDIF
414            END DO
415
416            ! Do grid search
417            ! Assume anything other than velocity is on T grid
418            ! Save resource by not repeating for the same grid
419            jind = 0
420            DO jvar = 1, kvars
421               IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_uvel ) THEN
422                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), &
423                     &                  iproc(:,jvar), 'U' )
424               ELSE IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_vvel ) THEN
425                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), &
426                     &                  iproc(:,jvar), 'V' )
427               ELSE
428                  IF ( jind > 0 ) THEN
429                     iobsi(:,jvar) = iobsi(:,jind)
430                     iobsj(:,jvar) = iobsj(:,jind)
431                     iproc(:,jvar) = iproc(:,jind)
432                  ELSE
433                     jind = jvar
434                     CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), &
435                        &                  iproc(:,jvar), 'T' )
436                  ENDIF
437               ENDIF
438            END DO
439
440            inowin = 0
441            DO ji = 1, inpfiles(jj)%nobs
442               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
443                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
444                  inowin = inowin + 1
445                  DO jvar = 1, kvars
446                     inpfiles(jj)%iproc(ji,jvar) = iproc(inowin,jvar)
447                     inpfiles(jj)%iobsi(ji,jvar) = iobsi(inowin,jvar)
448                     inpfiles(jj)%iobsj(ji,jvar) = iobsj(inowin,jvar)
449                  END DO
450               ENDIF
451            END DO
452            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
453
454            DO ji = 1, inpfiles(jj)%nobs
455               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
456                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
457                  IF ( nproc == 0 ) THEN
458                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
459                  ELSE
460                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
461                  ENDIF
462                  llvalprof = .FALSE.
463                  IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN
464                     iobs = iobs + 1
465                  ENDIF
466               ENDIF
467            END DO
468
469         ENDIF
470
471      END DO surf_files
472
473      !-----------------------------------------------------------------------
474      ! Get the time ordered indices of the input data
475      !-----------------------------------------------------------------------
476
477      !---------------------------------------------------------------------
478      !  Loop over input data files to count total number of profiles
479      !---------------------------------------------------------------------
480      iobstot = 0
481      DO jj = 1, inobf
482         DO ji = 1, inpfiles(jj)%nobs
483            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
484               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
485               iobstot = iobstot + 1
486            ENDIF
487         END DO
488      END DO
489
490      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
491         &      isurfidx(iobstot), zdat(iobstot) )
492      jk = 0
493      DO jj = 1, inobf
494         DO ji = 1, inpfiles(jj)%nobs
495            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
496               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
497               jk = jk + 1
498               ifileidx(jk) = jj
499               isurfidx(jk) = ji
500               zdat(jk)     = inpfiles(jj)%ptim(ji)
501            ENDIF
502         END DO
503      END DO
504      CALL sort_dp_indx( iobstot, &
505         &               zdat,     &
506         &               iindx   )
507
508      CALL obs_surf_alloc( surfdata, iobs, kvars, kadd+iadd, kextr+iextr, kstp, jpi, jpj )
509
510      ! Read obs/positions, QC, all variable and assign to surfdata
511
512      iobs = 0
513
514      surfdata%cvars(:)  = clvarsin(:)
515      surfdata%clong(:)  = cllongin(:)
516      surfdata%cunit(:)  = clunitin(:)
517      surfdata%cgrid(:)  = clgridin(:)
518      IF ( iadd > 0 ) THEN
519         surfdata%caddvars(kadd+1:)   = claddvarsin(:)
520         surfdata%caddlong(kadd+1:,:) = claddlongin(:,:)
521         surfdata%caddunit(kadd+1:,:) = claddunitin(:,:)
522      ENDIF
523      IF ( iextr > 0 ) THEN
524         surfdata%cextvars(kextr+1:) = clextvarsin(:)
525         surfdata%cextlong(kextr+1:) = clextlongin(:)
526         surfdata%cextunit(kextr+1:) = clextunitin(:)
527      ENDIF
528
529      ityp   (:) = 0
530      itypmpp(:) = 0
531
532      ioserrcount = 0
533
534      DO jk = 1, iobstot
535
536         jj = ifileidx(iindx(jk))
537         ji = isurfidx(iindx(jk))
538         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
539            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
540
541            IF ( nproc == 0 ) THEN
542               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
543            ELSE
544               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
545            ENDIF
546
547            ! Set observation information
548
549            IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN
550
551               iobs = iobs + 1
552
553               CALL jul2greg( isec,                   &
554                  &           imin,                   &
555                  &           ihou,                   &
556                  &           iday,                   &
557                  &           imon,                   &
558                  &           iyea,                   &
559                  &           inpfiles(jj)%ptim(ji), &
560                  &           irefdate(jj) )
561
562
563               ! Surface time coordinates
564               surfdata%nyea(iobs) = iyea
565               surfdata%nmon(iobs) = imon
566               surfdata%nday(iobs) = iday
567               surfdata%nhou(iobs) = ihou
568               surfdata%nmin(iobs) = imin
569
570               ! Surface space coordinates
571               surfdata%rlam(iobs) = inpfiles(jj)%plam(ji)
572               surfdata%rphi(iobs) = inpfiles(jj)%pphi(ji)
573
574               ! Coordinate search parameters
575               DO jvar = 1, kvars
576                  surfdata%mi(iobs,jvar) = inpfiles(jj)%iobsi(ji,jvar)
577                  surfdata%mj(iobs,jvar) = inpfiles(jj)%iobsj(ji,jvar)
578               END DO
579
580               ! WMO number
581               surfdata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji)
582
583               ! Instrument type
584               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
585901            IF ( ios /= 0 ) THEN
586                  IF (ioserrcount == 0) THEN
587                     CALL ctl_warn ( 'Problem converting an instrument type ', &
588                        &            'to integer. Setting type to zero' )
589                  ENDIF
590                  ioserrcount = ioserrcount + 1
591                  itype = 0
592               ENDIF
593               surfdata%ntyp(iobs) = itype
594               IF ( itype < jpsurfmaxtype + 1 ) THEN
595                  ityp(itype+1) = ityp(itype+1) + 1
596               ELSE
597                  IF(lwp)WRITE(numout,*) 'WARNING: Increase jpsurfmaxtype in ', &
598                     &                   cpname
599               ENDIF
600
601               ! Bookkeeping data to match observations
602               surfdata%nsidx(iobs) = iobs
603               surfdata%nsfil(iobs) = iindx(jk)
604
605               DO jvar = 1, kvars
606
607                  ! QC flags
608                  surfdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,jvar)
609
610                  ! Observed value
611                  surfdata%robs(iobs,jvar) = inpfiles(jj)%pob(1,ji,jvar)
612
613                  ! Additional variables
614                  surfdata%rmod(iobs,jvar) = fbrmdi
615                  IF ( iadd > 0 ) THEN
616                     jadd2 = 0
617                     DO jadd = 1, inpfiles(jj)%nadd
618                        IF ( TRIM(inpfiles(jj)%caddname(jadd)) == 'Hx' ) THEN
619                           IF ( ldmod ) THEN
620                              surfdata%rmod(iobs,jvar) = inpfiles(jj)%padd(1,ji,jadd,jvar)
621                           ENDIF
622                        ELSE
623                           jadd2 = jadd2 + 1
624                           surfdata%radd(iobs,kadd+jadd2,jvar) = &
625                              &                inpfiles(jj)%padd(1,ji,jadd,jvar)
626                        ENDIF
627                     END DO
628                  ENDIF
629
630               END DO
631                 
632               ! Extra variables
633               IF ( iextr > 0 ) THEN
634                  DO jext = 1, iextr
635                     surfdata%rext(iobs,kextr+jext) = inpfiles(jj)%pext(1,ji,jext)
636                  END DO
637               ENDIF
638            ENDIF
639         ENDIF
640
641      END DO
642
643      !-----------------------------------------------------------------------
644      ! Sum up over processors
645      !-----------------------------------------------------------------------
646
647      CALL obs_mpp_sum_integer( iobs, iobsmpp )
648      CALL obs_mpp_sum_integers( ityp, itypmpp, jpsurfmaxtype + 1 )
649
650      !-----------------------------------------------------------------------
651      ! Output number of observations.
652      !-----------------------------------------------------------------------
653      IF (lwp) THEN
654         DO jvar = 1, surfdata%nvar       
655            IF ( jvar == 1 ) THEN
656               cout1=TRIM(surfdata%cvars(1))                 
657            ELSE
658               WRITE(cout1,'(A,A1,A)') TRIM(cout1), '/', TRIM(surfdata%cvars(jvar))           
659            ENDIF
660         END DO
661 
662         WRITE(numout,*)
663         WRITE(numout,'(1X,A)')TRIM( cout1 )//' data'
664         WRITE(numout,'(1X,A)')'--------------'
665         DO jj = 1,8
666            IF ( itypmpp(jj) > 0 ) THEN
667               WRITE(numout,'(1X,A4,I4,A3,I10)') 'Type ', jj, ' = ', itypmpp(jj)
668            ENDIF
669         END DO
670         WRITE(numout,'(1X,A)') &
671            & '---------------------------------------------------------------'
672         WRITE(numout,'(1X,A,I8)') &
673            & 'Total data for variable '//TRIM( cout1 )// &
674            & '           = ', iobsmpp
675         WRITE(numout,'(1X,A)') &
676            & '---------------------------------------------------------------'
677         WRITE(numout,*)
678
679      ENDIF
680
681      !-----------------------------------------------------------------------
682      ! Deallocate temporary data
683      !-----------------------------------------------------------------------
684      DEALLOCATE( ifileidx, isurfidx, zdat, clvarsin, &
685         &        cllongin, clunitin, clgridin )
686      IF ( iadd > 0 ) THEN
687         DEALLOCATE( claddvarsin, claddlongin, claddunitin)
688      ENDIF
689      IF ( iextr > 0 ) THEN
690         DEALLOCATE( clextvarsin, clextlongin, clextunitin )
691      ENDIF
692
693      !-----------------------------------------------------------------------
694      ! Deallocate input data
695      !-----------------------------------------------------------------------
696      DO jj = 1, inobf
697         IF ( inpfiles(jj)%lalloc ) THEN
698            CALL dealloc_obfbdata( inpfiles(jj) )
699         ENDIF
700      END DO
701      DEALLOCATE( inpfiles )
702
703   END SUBROUTINE obs_rea_surf
704
705END MODULE obs_read_surf
Note: See TracBrowser for help on using the repository browser.