Changeset 6854 for branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

Timestamp:

2016-08-08T12:26:45+02:00 (8 years ago)

Author:

dford

Message:

Initial implementation of observation operator for LogChl?.

File:

• branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90 (modified) (3 diffs)

branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

@@ -11 +11 @@
    !!   obs_wri_seaice: Write seaice observation related diagnostics
    !!   obs_wri_vel   : Write velocity observation diagnostics in NetCDF format
+   !!   obs_wri_logchl: Write logchl observation related diagnostics
    !!   obs_wri_stats : Print basic statistics on the data being written out
    !!----------------------------------------------------------------------
@@ -45 +46 @@
       &   obs_wri_seaice, & ! Write seaice observation related diagnostics
       &   obs_wri_vel, &    ! Write velocity observation related diagnostics
+      &   obs_wri_logchl, & ! Write logchl observation related diagnostics
       &   obswriinfo
    
@@ -930 +932 @@
    END SUBROUTINE obs_wri_vel
 
+   SUBROUTINE obs_wri_logchl( cprefix, logchldata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_logchl  ***
+      !!
+      !! ** Purpose : Write logchl observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: logchldata   ! Full set of logchl
+      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
+
+      !! * Local declarations 
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname             ! netCDF filename
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_logchl'
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      CALL alloc_obfbdata( fbdata, 1, logchldata%nsurf, 1, &
+         &                 1 + nadd, next, .TRUE. )
+
+      fbdata%cname(1)      = 'LOGCHL'
+      fbdata%coblong(1)    = 'logchl concentration'
+      fbdata%cobunit(1)    = 'mg/m3'
+      DO je = 1, next
+         fbdata%cextname(je) = pext%cdname(je)
+         fbdata%cextlong(je) = pext%cdlong(je,1)
+         fbdata%cextunit(je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated LOGCHL'
+      fbdata%caddunit(1,1) = 'mg/m3'
+      fbdata%cgrid(1)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(1+ja) = padd%cdname(ja)
+         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+      END DO
+
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_logchl :'
+         WRITE(numout,*)'~~~~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing logchl feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, logchldata%nsurf
+         fbdata%plam(jo)      = logchldata%rlam(jo)
+         fbdata%pphi(jo)      = logchldata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') logchldata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( logchldata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = logchldata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = MAX(logchldata%nqc(jo),1)
+            fbdata%ioqcf(:,jo) = 0
+         ENDIF
+         fbdata%ipqc(jo)      = 0
+         fbdata%ipqcf(:,jo)   = 0
+         fbdata%itqc(jo)      = 0
+         fbdata%itqcf(:,jo)   = 0
+         fbdata%cdwmo(jo)     = ''
+         fbdata%kindex(jo)    = logchldata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = logchldata%mi(jo)
+            fbdata%iobsj(jo,1) = logchldata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(logchldata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(logchldata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           logchldata%nmin(jo), &
+            &           logchldata%nhou(jo), &
+            &           logchldata%nday(jo), &
+            &           logchldata%nmon(jo), &
+            &           logchldata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = logchldata%rmod(jo,1)
+         fbdata%pob(1,jo,1)    = logchldata%robs(jo,1)
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( logchldata%nqc(jo) > 10 ) THEN
+            fbdata%ivlqc(1,jo,1) = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = logchldata%nqc(jo) - 10
+         ELSE
+            fbdata%ivlqc(1,jo,1) = MAX(logchldata%nqc(jo),1)
+            fbdata%ivlqcf(:,1,jo,1) = 0
+         ENDIF
+         fbdata%iobsk(1,jo,1)  = 0
+         DO ja = 1, nadd
+            fbdata%padd(1,jo,1+ja,1) = &
+               & logchldata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,je) = &
+               & logchldata%rext(jo,pext%ipoint(je))
+         END DO
+
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+      
+      ! Output some basic statistics
+      CALL obs_wri_stats( fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_logchl
+
    SUBROUTINE obs_wri_stats( fbdata )
       !!-----------------------------------------------------------------------