Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

obs_read_surf.F90 @ 15799

Last change on this file since 15799 was 15799, checked in by dford, 2 years ago
More generic interface and structure for OBS code. See Met Office utils tickets 471 and 530.
File size: 28.2 KB

Line
1	MODULE 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
41	CONTAINS
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
585	901 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
705	END MODULE obs_read_surf

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_read_surf.F90 @ 15799

Download in other formats: