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_write.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_write.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: 19.8 KB
Line 
1MODULE obs_write
2   !!======================================================================
3   !!                       ***  MODULE obs_write   ***
4   !! Observation diagnosticss: Write observation related diagnostics
5   !!=====================================================================
6
7   !!----------------------------------------------------------------------
8   !!   obs_wri_prof   : Write profile observations in feedback format
9   !!   obs_wri_surf   : Write surface observations in feedback format
10   !!   obs_wri_stats  : Print basic statistics on the data being written out
11   !!----------------------------------------------------------------------
12
13   !! * Modules used
14   USE par_kind, ONLY : &   ! Precision variables
15      & wp
16   USE in_out_manager       ! I/O manager
17   USE dom_oce              ! Ocean space and time domain variables
18   USE obs_types            ! Observation type integer to character translation
19   USE julian, ONLY : &         ! Julian date routines
20      & greg2jul
21   USE obs_utils, ONLY : &  ! Observation operator utility functions
22      & chkerr
23   USE obs_profiles_def     ! Type definitions for profiles
24   USE obs_surf_def         ! Type defintions for surface observations
25   USE obs_fbm              ! Observation feedback I/O
26   USE obs_grid             ! Grid tools
27   USE obs_conv             ! Conversion between units
28   USE obs_const
29   USE obs_mpp              ! MPP support routines for observation diagnostics
30   USE lib_mpp        ! MPP routines
31
32   IMPLICIT NONE
33
34   !! * Routine accessibility
35   PRIVATE
36   PUBLIC obs_wri_prof, &    ! Write profile observation files
37      &   obs_wri_surf, &    ! Write surface observation files
38      &   obswriinfo
39   
40   TYPE obswriinfo
41      INTEGER :: inum
42      INTEGER, POINTER, DIMENSION(:) :: ipoint
43      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: cdname
44      CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: cdlong
45      CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: cdunit
46   END TYPE obswriinfo
47
48   !!----------------------------------------------------------------------
49   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
50   !! $Id$
51   !! Software governed by the CeCILL license (see ./LICENSE)
52   !!----------------------------------------------------------------------
53
54CONTAINS
55
56   SUBROUTINE obs_wri_prof( profdata, clfiletype, padd, pext )
57      !!-----------------------------------------------------------------------
58      !!
59      !!                     *** ROUTINE obs_wri_prof  ***
60      !!
61      !! ** Purpose : Write profile feedback files
62      !!
63      !! ** Method  : NetCDF
64      !!
65      !! ** Action  :
66      !!
67      !! History :
68      !!      ! 06-04  (A. Vidard) Original
69      !!      ! 06-04  (A. Vidard) Reformatted
70      !!      ! 06-10  (A. Weaver) Cleanup
71      !!      ! 07-01  (K. Mogensen) Use profile data types
72      !!      ! 07-03  (K. Mogensen) General handling of profiles
73      !!      ! 09-01  (K. Mogensen) New feedback format
74      !!      ! 15-02  (M. Martin) Combined routine for writing profiles
75      !!-----------------------------------------------------------------------
76
77      !! * Arguments
78      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data
79      CHARACTER(LEN=25), INTENT(IN) :: clfiletype    ! Base name for file name
80      TYPE(obswriinfo), OPTIONAL    :: padd          ! Additional info for each variable
81      TYPE(obswriinfo), OPTIONAL    :: pext          ! Extra info
82
83      !! * Local declarations
84      TYPE(obfbdata) :: fbdata
85      CHARACTER(LEN=40) :: clfname
86      CHARACTER(LEN=ilenlong) :: cllongname  ! Long name of variable
87      CHARACTER(LEN=ilenunit) :: clunits     ! Units of variable
88      CHARACTER(LEN=ilengrid) :: clgrid      ! Grid of variable
89      CHARACTER(LEN=12) :: clfmt            ! writing format
90      INTEGER :: idg                        ! number of digits
91      INTEGER :: ilevel
92      INTEGER :: jvar
93      INTEGER :: jvar2
94      INTEGER :: jsal
95      INTEGER :: jo
96      INTEGER :: jk
97      INTEGER :: ik
98      INTEGER :: ja
99      INTEGER :: je
100      INTEGER :: iadd
101      INTEGER :: iext
102      REAL(wp) :: zpres
103
104      IF ( PRESENT( padd ) ) THEN
105         iadd = padd%inum
106      ELSE
107         iadd = 0
108      ENDIF
109
110      IF ( PRESENT( pext ) ) THEN
111         iext = pext%inum
112      ELSE
113         iext = 0
114      ENDIF
115
116      CALL init_obfbdata( fbdata )
117
118      ! Find maximum level
119      ilevel = 0
120      DO jvar = 1, profdata%nvar
121         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) )
122      END DO
123
124      CALL alloc_obfbdata( fbdata, profdata%nvar, profdata%nprof, ilevel, &
125            &                 1 + iadd, iext, .TRUE. )
126      fbdata%caddname(1)   = 'Hx'
127      DO jvar = 1, profdata%nvar
128         fbdata%cname(jvar)      = profdata%cvars(jvar)
129         fbdata%coblong(jvar)    = profdata%clong(jvar)
130         fbdata%cobunit(jvar)    = profdata%cunit(jvar)
131         fbdata%cgrid(jvar)      = profdata%cgrid(jvar)
132         fbdata%caddlong(1,jvar) = 'Model interpolated ' // TRIM(profdata%clong(jvar))
133         fbdata%caddunit(1,jvar) = profdata%cunit(jvar)
134         IF (iadd > 0) THEN
135            DO ja = 1, iadd
136               fbdata%caddname(1+ja) = padd%cdname(ja)
137               fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar)
138               fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar)
139            END DO
140         ENDIF
141         IF (iext > 0) THEN
142            DO je = 1, iext
143               fbdata%cextname(je) = pext%cdname(je)
144               fbdata%cextlong(je) = pext%cdlong(je,1)
145               fbdata%cextunit(je) = pext%cdunit(je,1)
146            END DO
147         ENDIF
148      END DO
149
150      WRITE(clfname, FMT="(A,'fb_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc
151
152      IF(lwp) THEN
153         WRITE(numout,*)
154         WRITE(numout,*) 'obs_wri_prof :'
155         WRITE(numout,*) '~~~~~~~~~~~~~'
156         WRITE(numout,*) 'Writing '//TRIM(clfiletype)//' feedback file : ', TRIM(clfname)
157      ENDIF
158
159      ! Transform obs_prof data structure into obfb data structure
160      fbdata%cdjuldref = '19500101000000'
161      DO jo = 1, profdata%nprof
162         fbdata%plam(jo)      = profdata%rlam(jo)
163         fbdata%pphi(jo)      = profdata%rphi(jo)
164         WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo)
165         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:)
166         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:)
167         IF ( profdata%nqc(jo) > 255 ) THEN
168            fbdata%ioqc(jo)    = IBSET(profdata%nqc(jo),2)
169            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo)
170            fbdata%ioqcf(2,jo) = profdata%nqc(jo)
171         ELSE
172            fbdata%ioqc(jo)    = profdata%nqc(jo)
173            fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo)
174         ENDIF
175         fbdata%ipqc(jo)      = profdata%ipqc(jo)
176         fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo)
177         fbdata%itqc(jo)      = profdata%itqc(jo)
178         fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo)
179         fbdata%cdwmo(jo)     = profdata%cwmo(jo)
180         fbdata%kindex(jo)    = profdata%npfil(jo)
181         DO jvar = 1, profdata%nvar
182            IF (ln_grid_global) THEN
183               fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
184               fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
185            ELSE
186               fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
187               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
188            ENDIF
189         END DO
190         CALL greg2jul( 0, &
191            &           profdata%nmin(jo), &
192            &           profdata%nhou(jo), &
193            &           profdata%nday(jo), &
194            &           profdata%nmon(jo), &
195            &           profdata%nyea(jo), &
196            &           fbdata%ptim(jo),   &
197            &           krefdate = 19500101 )
198         ! Reform the profiles arrays for output
199         DO jvar = 1, profdata%nvar
200            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar)
201               ik = profdata%var(jvar)%nvlidx(jk)
202               fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk)
203               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk)
204               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk)
205               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk)
206               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk)
207               IF ( profdata%var(jvar)%nvqc(jk) > 255 ) THEN
208                  fbdata%ivlqc(ik,jo,jvar) = IBSET(profdata%var(jvar)%nvqc(jk),2)
209                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk)
210!$AGRIF_DO_NOT_TREAT
211                  fbdata%ivlqcf(2,ik,jo,jvar) = IAND(profdata%var(jvar)%nvqc(jk),b'0000000011111111')
212!$AGRIF_END_DO_NOT_TREAT
213               ELSE
214                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk)
215                  fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk)
216               ENDIF
217               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
218               IF (iadd > 0) THEN
219                  DO ja = 1, iadd
220                     fbdata%padd(ik,jo,1+ja,jvar) = &
221                        & profdata%var(jvar)%vadd(jk,padd%ipoint(ja))
222                  END DO
223               ENDIF
224            END DO
225         END DO
226         IF (iext > 0) THEN
227            DO jk = profdata%npvstaext(jo), profdata%npvendext(jo)
228               ik = profdata%vext%nelidx(jk)
229               DO je = 1, iext
230                  fbdata%pext(ik,jo,je) = &
231                     & profdata%vext%eobs(jk,pext%ipoint(je))
232               END DO
233            END DO
234         ENDIF
235      END DO
236
237      ! Convert insitu temperature to potential temperature using the model
238      ! salinity if no potential temperature
239      IF (iext > 0) THEN
240         DO jvar = 1, profdata%nvar
241            IF ( TRIM(profdata%cvars(jvar)) == 'POTM' ) THEN
242               jsal = 0
243               DO jvar2 = 1, profdata%nvar
244                  IF ( TRIM(profdata%cvars(jvar2)) == 'PSAL' ) THEN
245                     jsal = jvar2
246                     EXIT
247                  ENDIF
248               END DO
249               IF (jsal > 0) THEN
250                  DO je = 1, iext
251                     IF ( TRIM(fbdata%cextname(je)) == 'TEMP' ) THEN
252                        DO jo = 1, fbdata%nobs
253                           IF ( fbdata%pphi(jo) < 9999.0 ) THEN
254                              DO jk = 1, fbdata%nlev
255                                 IF ( ( fbdata%pob(jk,jo,jvar)   >= 9999.0 ) .AND. &
256                                    & ( fbdata%pdep(jk,jo)        < 9999.0 ) .AND. &
257                                    & ( fbdata%padd(jk,jo,1,jsal) < 9999.0 ) .AND. &
258                                    & ( fbdata%pext(jk,jo,je)     < 9999.0 ) ) THEN
259                                    zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), &
260                                       &              REAL(fbdata%pphi(jo),wp) )
261                                    fbdata%pob(jk,jo,jvar) = potemp( &
262                                       &                     REAL(fbdata%padd(jk,jo,1,jsal), wp), &
263                                       &                     REAL(fbdata%pext(jk,jo,je), wp),     &
264                                       &                     zpres, 0.0_wp )
265                                 ENDIF
266                              END DO
267                           ENDIF
268                        END DO
269                        EXIT
270                     ENDIF
271                  END DO
272               ENDIF
273               EXIT
274            ENDIF
275         END DO
276      ENDIF
277
278      ! Write the obfbdata structure
279      CALL write_obfbdata( clfname, fbdata )
280
281      ! Output some basic statistics
282      CALL obs_wri_stats( fbdata )
283
284      CALL dealloc_obfbdata( fbdata )
285
286   END SUBROUTINE obs_wri_prof
287
288   SUBROUTINE obs_wri_surf( surfdata, clfiletype, padd, pext )
289      !!-----------------------------------------------------------------------
290      !!
291      !!                     *** ROUTINE obs_wri_surf  ***
292      !!
293      !! ** Purpose : Write surface observation files
294      !!
295      !! ** Method  : NetCDF
296      !!
297      !! ** Action  :
298      !!
299      !!      ! 07-03  (K. Mogensen) Original
300      !!      ! 09-01  (K. Mogensen) New feedback format.
301      !!      ! 15-02  (M. Martin) Combined surface writing routine.
302      !!-----------------------------------------------------------------------
303
304      !! * Modules used
305      IMPLICIT NONE
306
307      !! * Arguments
308      TYPE(obs_surf), INTENT(INOUT) :: surfdata      ! Full set of surface data
309      CHARACTER(LEN=25), INTENT(IN) :: clfiletype    ! Base name for file name
310      TYPE(obswriinfo), OPTIONAL    :: padd          ! Additional info for each variable
311      TYPE(obswriinfo), OPTIONAL    :: pext          ! Extra info
312
313      !! * Local declarations
314      TYPE(obfbdata) :: fbdata
315      CHARACTER(LEN=40) :: clfname         ! netCDF filename
316      CHARACTER(LEN=ilenlong) :: cllongname  ! Long name of variable
317      CHARACTER(LEN=ilenunit) :: clunits     ! Units of variable
318      CHARACTER(LEN=ilengrid) :: clgrid      ! Grid of variable
319      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf'
320      INTEGER :: jo
321      INTEGER :: ja
322      INTEGER :: je
323      INTEGER :: jvar
324      INTEGER :: iadd
325      INTEGER :: iext
326
327      IF ( PRESENT( padd ) ) THEN
328         iadd = padd%inum
329      ELSE
330         iadd = 0
331      ENDIF
332
333      IF ( PRESENT( pext ) ) THEN
334         iext = pext%inum
335      ELSE
336         iext = 0
337      ENDIF
338
339      CALL init_obfbdata( fbdata )
340
341      CALL alloc_obfbdata( fbdata, surfdata%nvar, surfdata%nsurf, 1, &
342            &                 1 + iadd, iext, .TRUE. )
343      fbdata%caddname(1)   = 'Hx'
344      DO jvar = 1, surfdata%nvar
345         fbdata%cname(jvar)      = surfdata%cvars(jvar)
346         fbdata%coblong(jvar)    = surfdata%clong(jvar)
347         fbdata%cobunit(jvar)    = surfdata%cunit(jvar)
348         fbdata%cgrid(jvar)      = surfdata%cgrid(jvar)
349         fbdata%caddlong(1,jvar) = 'Model interpolated ' // TRIM(surfdata%clong(jvar))
350         fbdata%caddunit(1,jvar) = surfdata%cunit(jvar)
351         IF (iadd > 0) THEN
352            DO ja = 1, iadd
353               fbdata%caddname(1+ja) = padd%cdname(ja)
354               fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar)
355               fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar)
356            END DO
357         ENDIF
358         IF (iext > 0) THEN
359            DO je = 1, iext
360               fbdata%cextname(je) = pext%cdname(je)
361               fbdata%cextlong(je) = pext%cdlong(je,1)
362               fbdata%cextunit(je) = pext%cdunit(je,1)
363            END DO
364         ENDIF
365      END DO
366
367      WRITE(clfname, FMT="(A,'fb_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc
368
369      IF(lwp) THEN
370         WRITE(numout,*)
371         WRITE(numout,*) 'obs_wri_surf :'
372         WRITE(numout,*) '~~~~~~~~~~~~~'
373         WRITE(numout,*) 'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ', TRIM(clfname)
374      ENDIF
375
376      ! Transform surf data structure into obfbdata structure
377      fbdata%cdjuldref = '19500101000000'
378      DO jo = 1, surfdata%nsurf
379         fbdata%plam(jo)      = surfdata%rlam(jo)
380         fbdata%pphi(jo)      = surfdata%rphi(jo)
381         WRITE(fbdata%cdtyp(jo),'(I4)') surfdata%ntyp(jo)
382         fbdata%ivqc(jo,:)    = 0
383         fbdata%ivqcf(:,jo,:) = 0
384         IF ( surfdata%nqc(jo) > 255 ) THEN
385            fbdata%ioqc(jo)    = 4
386            fbdata%ioqcf(1,jo) = 0
387!$AGRIF_DO_NOT_TREAT
388            fbdata%ioqcf(2,jo) = IAND(surfdata%nqc(jo),b'0000000011111111')
389!$AGRIF_END_DO_NOT_TREAT
390         ELSE
391            fbdata%ioqc(jo)    = surfdata%nqc(jo)
392            fbdata%ioqcf(:,jo) = 0
393         ENDIF
394         fbdata%ipqc(jo)      = 0
395         fbdata%ipqcf(:,jo)   = 0
396         fbdata%itqc(jo)      = 0
397         fbdata%itqcf(:,jo)   = 0
398         fbdata%cdwmo(jo)     = surfdata%cwmo(jo)
399         fbdata%kindex(jo)    = surfdata%nsfil(jo)
400         DO jvar = 1, surfdata%nvar
401            IF (ln_grid_global) THEN
402               fbdata%iobsi(jo,jvar) = surfdata%mi(jo,jvar)
403               fbdata%iobsj(jo,jvar) = surfdata%mj(jo,jvar)
404            ELSE
405               fbdata%iobsi(jo,jvar) = mig(surfdata%mi(jo,jvar))
406               fbdata%iobsj(jo,jvar) = mjg(surfdata%mj(jo,jvar))
407            ENDIF
408         END DO
409         CALL greg2jul( 0, &
410            &           surfdata%nmin(jo), &
411            &           surfdata%nhou(jo), &
412            &           surfdata%nday(jo), &
413            &           surfdata%nmon(jo), &
414            &           surfdata%nyea(jo), &
415            &           fbdata%ptim(jo),   &
416            &           krefdate = 19500101 ) 
417         fbdata%pdep(1,jo)     = 0.0
418         fbdata%idqc(1,jo)     = 0
419         fbdata%idqcf(:,1,jo)  = 0
420         DO jvar = 1, surfdata%nvar
421            fbdata%padd(1,jo,1,jvar) = surfdata%rmod(jo,jvar)
422            fbdata%pob(1,jo,jvar)    = surfdata%robs(jo,jvar)
423            IF ( surfdata%nqc(jo) > 255 ) THEN
424               fbdata%ivqc(jo,jvar)       = 4
425               fbdata%ivlqc(1,jo,jvar)    = 4
426               fbdata%ivlqcf(1,1,jo,jvar) = 0
427!$AGRIF_DO_NOT_TREAT
428               fbdata%ivlqcf(2,1,jo,jvar) = IAND(surfdata%nqc(jo),b'0000000011111111')
429!$AGRIF_END_DO_NOT_TREAT
430            ELSE
431               fbdata%ivqc(jo,jvar)       = surfdata%nqc(jo)
432               fbdata%ivlqc(1,jo,jvar)    = surfdata%nqc(jo)
433               fbdata%ivlqcf(:,1,jo,jvar) = 0
434            ENDIF
435            fbdata%iobsk(1,jo,jvar)  = 0
436            IF (iadd > 0) THEN
437               DO ja = 1, iadd
438                  fbdata%padd(1,jo,1+ja,jvar) = &
439                     & surfdata%radd(jo,padd%ipoint(ja),jvar)
440               END DO
441            ENDIF
442         END DO
443         IF (iext > 0) THEN
444            DO je = 1, iext
445               fbdata%pext(1,jo,je) = &
446                  & surfdata%rext(jo,pext%ipoint(je))
447            END DO
448         ENDIF
449      END DO
450
451      ! Write the obfbdata structure
452      CALL write_obfbdata( clfname, fbdata )
453
454      ! Output some basic statistics
455      CALL obs_wri_stats( fbdata )
456
457      CALL dealloc_obfbdata( fbdata )
458
459   END SUBROUTINE obs_wri_surf
460
461   SUBROUTINE obs_wri_stats( fbdata )
462      !!-----------------------------------------------------------------------
463      !!
464      !!                     *** ROUTINE obs_wri_stats  ***
465      !!
466      !! ** Purpose : Output some basic statistics of the data being written out
467      !!
468      !! ** Method  :
469      !!
470      !! ** Action  :
471      !!
472      !!      ! 2014-08  (D. Lea) Initial version
473      !!-----------------------------------------------------------------------
474
475      !! * Arguments
476      TYPE(obfbdata) :: fbdata
477
478      !! * Local declarations
479      INTEGER :: jvar
480      INTEGER :: jo
481      INTEGER :: jk
482      INTEGER :: inumgoodobs
483      INTEGER :: inumgoodobsmpp
484      REAL(wp) :: zsumx
485      REAL(wp) :: zsumx2
486      REAL(wp) :: zomb
487     
488
489      IF (lwp) THEN
490         WRITE(numout,*) ''
491         WRITE(numout,*) 'obs_wri_stats :'
492         WRITE(numout,*) '~~~~~~~~~~~~~~~'
493      ENDIF
494
495      DO jvar = 1, fbdata%nvar
496         zsumx = 0.0_wp
497         zsumx2 = 0.0_wp
498         inumgoodobs = 0
499         DO jo = 1, fbdata%nobs
500            DO jk = 1, fbdata%nlev
501               IF ( ( fbdata%pob(jk,jo,jvar) < 9999.0 ) .AND. &
502                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
503                  & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN
504
505                  zomb = fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar)
506                  zsumx = zsumx + zomb
507                  zsumx2 = zsumx2 + zomb**2
508                  inumgoodobs = inumgoodobs + 1
509               ENDIF
510            ENDDO
511         ENDDO
512
513         CALL obs_mpp_sum_integer( inumgoodobs, inumgoodobsmpp )
514         CALL mpp_sum('obs_write', zsumx)
515         CALL mpp_sum('obs_write', zsumx2)
516
517         IF (lwp) THEN
518            WRITE(numout,*) 'Type: ', fbdata%cname(jvar), '  Total number of good observations: ', inumgoodobsmpp
519            IF ( inumgoodobsmpp > 0 ) THEN
520               WRITE(numout,*) 'Overall mean obs minus model of the good observations: ', zsumx/inumgoodobsmpp
521               WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ', sqrt( zsumx2/inumgoodobsmpp )
522            ENDIF
523            WRITE(numout,*) ''
524         ENDIF
525
526      ENDDO
527
528   END SUBROUTINE obs_wri_stats
529
530END MODULE obs_write
Note: See TracBrowser for help on using the repository browser.