Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asminc.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asminc.F90	(revision 2236)
@@ -0,0 +1,963 @@
+MODULE asminc
+   !!======================================================================
+   !!                       ***  MODULE asminc  ***
+   !! Assimilation increment : Apply an increment generated by data
+   !!                          assimilation
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   'key_asminc' : Switch on the assimilation increment interface
+   !!----------------------------------------------------------------------
+   !!   asm_inc_init : Initialize the increment arrays and IAU weights
+   !!   calc_date    : Compute the calendar date YYYYMMDD on a given step
+   !!   tra_asm_inc  : Apply the tracer (T and S) increments
+   !!   dyn_asm_inc  : Apply the dynamic (u and v) increments
+   !!   ssh_asm_inc  : Apply the SSH increment
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp
+   USE in_out_manager, ONLY : & ! I/O manager 
+      & lwp,      &
+      & numnam,   &
+      & numout,   &
+      & ctl_warn, &
+      & ctl_stop, &
+      & nit000,   &
+      & nstop,    &
+      & ln_rstart
+   USE par_oce, ONLY : & ! Ocean space and time domain variables
+      & jpi,  & 
+      & jpj,  &
+      & jpk,  &
+      & jpkm1
+   USE dom_oce, ONLY : & ! Ocean space and time domain
+      & rdt,    &
+      & n_cla,  &
+      & neuler, &
+      & ln_zps, &
+      & tmask,  &
+      & umask,  &
+      & vmask
+#if defined key_c1d
+   USE c1d, ONLY : &    ! 1D initialization
+      & lk_c1d
+#endif
+   USE oce, ONLY : &      ! Dynamics and active tracers defined in memory
+      & ub, un, ua,    &
+      & vb, vn, va,    &
+      & tb, tn, ta,    &
+      & sb, sn, sa,    &
+      & sshb, sshn,    &
+      & rhd, rhop,     &
+      & rotb, rotn,    &
+      & hdivb, hdivn,  &
+      & gtu, gsu, gru, &
+      & gtv, gsv, grv 
+   USE divcur, ONLY : &   ! Horizontal divergence and relative vorticity
+      & div_cur
+   USE cla_div, ONLY : &  ! Specific update of the horizontal divergence
+      & div_cla           ! (specific to ORCA_R2)
+   USE eosbn2, ONLY : &   ! Equation of state - in situ and potential density
+      & eos
+   USE zpshde, ONLY : &   ! Partial step : Horizontal Derivative
+      & zps_hde
+!   USE phycst, ONLY : &   ! Calendar parameters
+!      & rjjss  
+   USE iom                ! Library to read input files
+   USE asmpar             ! Parameters for the assmilation interface
+   USE dom_oce, ONLY : &
+      & ndastp
+!   USE daymod, ONLY : &
+!      & nmonth_len         ! length of month in days
+!      & nbiss, &
+!      & nobis, &
+ 
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC asm_inc_init, & !: Initialize the increment arrays and IAU weights
+      &   calc_date,    & !: Compute the calendar date YYYYMMDD on a given step
+      &   tra_asm_inc,  & !: Apply the tracer (T and S) increments
+      &   dyn_asm_inc,  & !: Apply the dynamic (u and v) increments
+      &   ssh_asm_inc     !: Apply the SSH increment
+
+   !! * Private Module variables
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: &
+      & t_bkg,    &       !: Background temperature 
+      & s_bkg,    &       !: Background salinity
+      & u_bkg,    &       !: Background u-component velocity
+      & v_bkg,    &       !: Background v-component velocity
+      & t_bkginc, &       !: Increment to the background temperature
+      & s_bkginc, &       !: Increment to the background salinity
+      & u_bkginc, &       !: Increment to the u-component velocity 
+      & v_bkginc          !: Increment to the v-component velocity 
+         
+   REAL(wp), PRIVATE, DIMENSION(:,:), ALLOCATABLE :: &
+      & ssh_bkg,   &      !: Background sea surface height
+      & ssh_bkginc        !: Increment to the background sea surface height
+
+   REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE :: &
+      & wgtiau            !: IAU weights for each time step
+
+   !! * Shared Module variables
+   LOGICAL, PUBLIC, PARAMETER :: &
+#if defined key_asminc
+      & lk_asminc = .TRUE.   !: Logical switch for assimilation increment interface
+#else
+      & lk_asminc = .FALSE.  !: No assimilation increments
+#endif
+
+   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE. !: No output of the background state fields
+   LOGICAL, PUBLIC :: ln_trjwri = .FALSE. !: No output of the state trajectory fields
+   LOGICAL, PUBLIC :: ln_asmiau = .FALSE. !: No applying forcing with an assimilation increment
+   LOGICAL, PUBLIC :: ln_asmdin = .FALSE. !: No direct initialization
+   LOGICAL, PUBLIC :: ln_trainc = .FALSE. !: No tracer (T and S) assimilation increments
+   LOGICAL, PUBLIC :: ln_dyninc = .FALSE. !: No dynamics (u and v) assimilation increments
+   LOGICAL, PUBLIC :: ln_sshinc = .FALSE. !: No sea surface height assimilation increment
+   LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check
+
+   REAL, PUBLIC :: salfixmin   !: Ensure that the salinity is larger than 
+   !                           !: this  value if (ln_salfix)
+#if defined key_asminc
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: &
+      & ssh_iau           !: IAU-weighted sea surface height increment
+#endif
+
+   INTEGER, PUBLIC :: nitbkg     !: Time step of the background state used in the Jb term
+                                 !: (relative to the cycle interval [0,nitend-nit000-1])
+   INTEGER, PUBLIC :: nitdin     !: Time step of the background state for direct initialization
+                                 !: (relative to the cycle interval [0,nitend-nit000-1])
+   INTEGER, PUBLIC :: nitiaustr  !: Time step of the start of the IAU interval 
+                                 !: (relative to the cycle interval [0,nitend-nit000-1])
+   INTEGER, PUBLIC :: nitiaufin  !: Time step of the end of the IAU interval 
+                                 !: (relative to the cycle interval [0,nitend-nit000-1])
+   INTEGER, PUBLIC :: niaufn     !: Type of IAU weighing function
+                                 !:   0 = Constant weighting
+                                 !:   1 = Linear hat-like, centred in middle of IAU interval 
+
+CONTAINS
+
+   SUBROUTINE asm_inc_init
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE asm_inc_init  ***
+      !!          
+      !! ** Purpose : Initialize the assimilation increment and IAU weights.
+      !!
+      !! ** Method  : Initialize the assimilation increment and IAU weights.
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  07-03  (M. Martin) Met Office version
+      !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Modules used
+      NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri, &
+         &                 ln_trainc, ln_dyninc, ln_sshinc, &
+         &                 ln_asmdin, ln_asmiau, &
+         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, &
+         &                 nittrjfrq, ln_salfix, salfixmin
+
+      !! * Local declarations
+      INTEGER :: jt
+
+      INTEGER :: imid
+      INTEGER :: inum
+      INTEGER :: iiauper         ! Number of time steps in the IAU period
+      INTEGER :: icycper         ! Number of time steps in the cycle
+      INTEGER :: iitend_date     ! Date YYYYMMDD of final time step
+      INTEGER :: iitbkg_date     ! Date YYYYMMDD of background time step for Jb term
+      INTEGER :: iitdin_date     ! Date YYYYMMDD of background time step for DI
+      INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step
+      INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step
+
+      REAL(wp) :: znorm        ! Normalization factor for IAU weights
+      REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights 
+                               ! (should be equal to one)
+      REAL(wp) :: z_inc_dateb  ! Start date of interval on which increment is valid
+      REAL(wp) :: z_inc_datef  ! End date of interval on which increment is valid
+      REAL(wp) :: zdate_bkg    ! Date in background state file for DI
+      REAL(wp) :: zdate_inc    ! Time axis in increments file
+
+      !-----------------------------------------------------------------------
+      ! Read Namelist nam_asminc : assimilation increment interface
+      !-----------------------------------------------------------------------
+
+      ! Set default values
+      ln_bkgwri = .FALSE.
+      ln_trjwri = .FALSE.
+      ln_trainc = .FALSE.
+      ln_dyninc = .FALSE.
+      ln_sshinc = .FALSE.
+      ln_asmdin = .FALSE.
+      ln_asmiau = .TRUE.
+      ln_salfix = .FALSE.
+      salfixmin = -9999
+      nitbkg    = 0
+      nitdin    = 0      
+      nitiaustr = 1
+      nitiaufin = 150      ! = 10 days with ORCA2
+      niaufn    = 0
+      nittrjfrq = 1
+
+      REWIND ( numnam )
+      READ   ( numnam, nam_asminc )
+
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'asm_inc_init : Assimilation increment initialization :'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namasm : set assimilation increment parameters'
+         WRITE(numout,*) '             Logical switch for writing out background state         ', &
+            &            ' ln_bkgwri = ', ln_bkgwri
+         WRITE(numout,*) '             Logical switch for writing out state trajectory         ', &
+            &            ' ln_trjwri = ', ln_trjwri
+         WRITE(numout,*) '             Logical switch for applying tracer increments           ', &
+            &            ' ln_trainc = ', ln_trainc
+         WRITE(numout,*) '             Logical switch for applying velocity increments         ', &
+            &            ' ln_dyninc = ', ln_dyninc
+         WRITE(numout,*) '             Logical switch for applying SSH increments              ', &
+            &            ' ln_sshinc = ', ln_sshinc
+         WRITE(numout,*) '             Logical switch for Direct Initialization (DI)           ', &
+            &            ' ln_asmdin = ', ln_asmdin
+         WRITE(numout,*) '             Logical switch for Incremental Analysis Updating (IAU)  ', &
+            &            ' ln_asmiau = ', ln_asmiau
+         WRITE(numout,*) '             Timestep of background in [0,nitend-nit000-1]           ', &
+            &            '    nitbkg = ', nitbkg
+         WRITE(numout,*) '             Timestep of background for DI in [0,nitend-nit000-1]    ', &
+            &            '    nitdin = ', nitdin
+         WRITE(numout,*) '             Timestep of start of IAU interval in [0,nitend-nit000-1]', &
+            &            ' nitiaustr = ', nitiaustr
+         WRITE(numout,*) '             Timestep of end of IAU interval in [0,nitend-nit000-1]  ', &
+            &            ' nitiaufin = ', nitiaufin
+         WRITE(numout,*) '             Type of IAU weighting function                          ', &
+            &            '    niaufn = ', niaufn
+         WRITE(numout,*) '             Frequency of trajectory output for 4D-VAR               ', &
+            &            ' nittrjfrq = ', nittrjfrq
+         WRITE(numout,*) '             Logical switch for ensuring that the sa > salfixmin     ', &
+            &            ' ln_salfix = ', ln_salfix
+         WRITE(numout,*) '             Minimum salinity after applying the increments          ', &
+            &            ' salfixmin = ', salfixmin
+      ENDIF
+
+      nitbkg_r    = nitbkg    + nit000 - 1  ! Background time referenced to nit000
+      nitdin_r    = nitdin    + nit000 - 1  ! Background time for DI referenced to nit000
+      nitiaustr_r = nitiaustr + nit000 - 1  ! Start of IAU interval referenced to nit000
+      nitiaufin_r = nitiaufin + nit000 - 1  ! End of IAU interval referenced to nit000
+
+      iiauper = nitiaufin_r - nitiaustr_r + 1  ! IAU interval length
+      icycper = nitend      - nit000      + 1  ! Cycle interval length
+
+      ! Date of final time step
+      CALL calc_date( nit000, nitend, ndate0, iitend_date )
+
+      ! Background time for Jb referenced to ndate0
+      CALL calc_date( nit000, nitbkg_r, ndate0, iitbkg_date )
+
+      ! Background time for DI referenced to ndate0
+      CALL calc_date( nit000, nitdin_r, ndate0, iitdin_date )
+
+      ! IAU start time referenced to ndate0
+      CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )
+
+      ! IAU end time referenced to ndate0
+      CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Time steps referenced to current cycle:'
+         WRITE(numout,*) '       iitrst      = ', nit000 - 1
+         WRITE(numout,*) '       nit000      = ', nit000
+         WRITE(numout,*) '       nitend      = ', nitend
+         WRITE(numout,*) '       nitbkg_r    = ', nitbkg_r
+         WRITE(numout,*) '       nitdin_r    = ', nitdin_r
+         WRITE(numout,*) '       nitiaustr_r = ', nitiaustr_r
+         WRITE(numout,*) '       nitiaufin_r = ', nitiaufin_r
+         WRITE(numout,*) '       nittrjfrq   = ', nittrjfrq
+         WRITE(numout,*)
+         WRITE(numout,*) '   Dates referenced to current cycle:'
+         WRITE(numout,*) '       ndastp         = ', ndastp
+         WRITE(numout,*) '       ndate0         = ', ndate0
+         WRITE(numout,*) '       iitend_date    = ', iitend_date
+         WRITE(numout,*) '       iitbkg_date    = ', iitbkg_date
+         WRITE(numout,*) '       iitdin_date    = ', iitdin_date
+         WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date
+         WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date
+      ENDIF
+
+      IF ( nacc /= 0 ) &
+         & CALL ctl_stop( ' nacc /= 0 and key_asminc :',  &
+         &                ' Assimilation increments have only been implemented', &
+         &                ' for synchronous time stepping' )
+
+      IF ( ( ln_asmdin ).AND.( ln_asmiau ) )   &
+         & CALL ctl_stop( ' ln_asmdin and ln_asmiau :', &
+         &                ' Choose Direct Initialization OR Incremental Analysis Updating')
+
+      IF (      ( ( .NOT. ln_asmdin ).AND.( .NOT. ln_asmiau ) ) &
+           .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) ) ) &
+         & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc and ln_sshinc is set to .true.', &
+         &                ' but ln_asmdin and ln_asmiau are both set to .false. :', &
+         &                ' Inconsistent options')
+
+      IF ( ( ln_bkgwri ).AND.( ( ln_asmdin ).OR.( ln_asmiau ) ) )  &
+         & CALL ctl_stop( ' ln_bkgwri and either ln_asmdin or ln_asmiau are set to .true.:', &
+         &                ' The background state must be written before applying the increments')
+
+      IF ( ( niaufn /= 0 ).AND.( niaufn /= 1 ) ) &
+         & CALL ctl_stop( ' niaufn /= 0 or niaufn /=1 :',  &
+         &                ' Type IAU weighting function is invalid')
+
+      IF ( ( .NOT. ln_trainc ).AND.( .NOT. ln_dyninc ).AND.( .NOT. ln_sshinc ) &
+         &                     )  &
+         & CALL ctl_warn( ' ln_trainc, ln_dyninc and ln_sshinc are set to .false. :', &
+         &                ' The assimilation increments are not applied')
+
+      IF ( ( ln_asmiau ).AND.( nitiaustr == nitiaufin ) ) &
+         & CALL ctl_stop( ' nitiaustr = nitiaufin :',  &
+         &                ' IAU interval is of zero length')
+
+      IF ( ( ln_asmiau ).AND.( ( nitiaustr_r < nit000 ).OR.( nitiaufin_r > nitend ) ) ) &
+         & CALL ctl_stop( ' nitiaustr or nitiaufin :',  &
+         &                ' IAU starting or final time step is outside the cycle interval', &
+         &                 ' Valid range nit000 to nitend')
+
+      IF ( ( nitbkg_r < nit000 - 1 ).OR.( nitbkg_r > nitend ) ) &
+         & CALL ctl_stop( ' nitbkg :',  &
+         &                ' Background time step is outside the cycle interval')
+
+      IF ( ( nitdin_r < nit000 - 1 ).OR.( nitdin_r > nitend ) ) &
+         & CALL ctl_stop( ' nitdin :',  &
+         &                ' Background time step for Direct Initialization is outside', &
+         &                ' the cycle interval')
+
+      IF ( nstop > 0 ) RETURN       ! if there are any errors then go no further
+
+      !--------------------------------------------------------------------
+      ! Initialize the Incremental Analysis Updating weighting function
+      !--------------------------------------------------------------------
+
+      IF ( ln_asmiau ) THEN
+
+         ALLOCATE( wgtiau( icycper ) )
+
+         wgtiau(:) = 0.0
+
+         IF ( niaufn == 0 ) THEN
+
+            !---------------------------------------------------------
+            ! Constant IAU forcing 
+            !---------------------------------------------------------
+
+            DO jt = 1, iiauper
+               wgtiau(jt+nitiaustr-1) = 1.0 / REAL( iiauper )
+            END DO
+
+         ELSEIF ( niaufn == 1 ) THEN
+
+            !---------------------------------------------------------
+            ! Linear hat-like, centred in middle of IAU interval 
+            !---------------------------------------------------------
+
+            ! Compute the normalization factor
+            znorm = 0.0
+            IF ( MOD( iiauper, 2 ) == 0 ) THEN  ! Even number of time steps in IAU interval
+               imid = iiauper / 2 
+               DO jt = 1, imid
+                  znorm = znorm + REAL( jt )
+               END DO
+               znorm = 2.0 * znorm
+            ELSE                               ! Odd number of time steps in IAU interval
+               imid = ( iiauper + 1 ) / 2        
+               DO jt = 1, imid - 1
+                  znorm = znorm + REAL( jt )
+               END DO
+               znorm = 2.0 * znorm + REAL( imid )
+            ENDIF
+            znorm = 1.0 / znorm
+
+            DO jt = 1, imid - 1
+               wgtiau(jt+nitiaustr-1) = REAL( jt ) * znorm
+            END DO
+            DO jt = imid, iiauper
+               wgtiau(jt+nitiaustr-1) = REAL( iiauper - jt + 1 ) * znorm
+            END DO
+
+         ENDIF
+
+         ! Test that the integral of the weights over the weighting interval equals 1
+          IF(lwp) THEN
+             WRITE(numout,*)
+             WRITE(numout,*) 'asm_inc_init : IAU weights'
+             WRITE(numout,*) '~~~~~~~~~~~~'
+             WRITE(numout,*) '             time step         IAU  weight'
+             WRITE(numout,*) '             =========     ====================='
+             ztotwgt = 0.0
+             DO jt = 1, icycper
+                ztotwgt = ztotwgt + wgtiau(jt)
+                WRITE(numout,*) '         ', jt, '       ', wgtiau(jt) 
+             END DO   
+             WRITE(numout,*) '         ==================================='
+             WRITE(numout,*) '         Time-integrated weight = ', ztotwgt
+             WRITE(numout,*) '         ==================================='
+          ENDIF
+         
+      ENDIF
+
+      !--------------------------------------------------------------------
+      ! Allocate and initialize the increment arrays
+      !--------------------------------------------------------------------
+
+      ALLOCATE( t_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( s_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( u_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( v_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( ssh_bkginc(jpi,jpj)   )
+#if defined key_asminc
+      ALLOCATE( ssh_iau(jpi,jpj)      )
+#endif
+      t_bkginc(:,:,:) = 0.0
+      s_bkginc(:,:,:) = 0.0
+      u_bkginc(:,:,:) = 0.0
+      v_bkginc(:,:,:) = 0.0
+      ssh_bkginc(:,:) = 0.0
+#if defined key_asminc
+      ssh_iau(:,:)    = 0.0
+#endif
+      IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) ) THEN
+
+         !--------------------------------------------------------------------
+         ! Read the increments from file
+         !--------------------------------------------------------------------
+
+         CALL iom_open( c_asminc, inum )
+
+         CALL iom_get( inum, 'time', zdate_inc ) 
+
+         CALL iom_get( inum, 'z_inc_dateb', z_inc_dateb )
+         CALL iom_get( inum, 'z_inc_datef', z_inc_datef )
+         z_inc_dateb = zdate_inc
+         z_inc_datef = zdate_inc
+
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', &
+               &            ' between dates ', NINT( z_inc_dateb ),' and ',  &
+               &            NINT( z_inc_datef )
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         IF (     ( NINT( z_inc_dateb ) < ndastp      ) &
+            & .OR.( NINT( z_inc_datef ) > iitend_date ) ) &
+            & CALL ctl_warn( ' Validity time of assimilation increments is ', &
+            &                ' outside the assimilation interval' )
+
+         IF ( ( ln_asmdin ).AND.( NINT( zdate_inc ) /= iitdin_date ) ) &
+            & CALL ctl_warn( ' Validity time of assimilation increments does ', &
+            &                ' not agree with Direct Initialization time' )
+
+         IF ( ln_trainc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 )
+            CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 )
+            ! Apply the masks
+            t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:)
+            s_bkginc(:,:,:) = s_bkginc(:,:,:) * tmask(:,:,:)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( t_bkginc(:,:,:) ) > 1.0e+10 ) t_bkginc(:,:,:) = 0.0
+            WHERE( ABS( s_bkginc(:,:,:) ) > 1.0e+10 ) s_bkginc(:,:,:) = 0.0
+         ENDIF
+
+         IF ( ln_dyninc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'bckinu', u_bkginc, 1 )              
+            CALL iom_get( inum, jpdom_autoglo, 'bckinv', v_bkginc, 1 )              
+            ! Apply the masks
+            u_bkginc(:,:,:) = u_bkginc(:,:,:) * umask(:,:,:)
+            v_bkginc(:,:,:) = v_bkginc(:,:,:) * vmask(:,:,:)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( u_bkginc(:,:,:) ) > 1.0e+10 ) u_bkginc(:,:,:) = 0.0
+            WHERE( ABS( v_bkginc(:,:,:) ) > 1.0e+10 ) v_bkginc(:,:,:) = 0.0
+         ENDIF
+        
+         IF ( ln_sshinc ) THEN
+            CALL iom_get( inum, jpdom_autoglo, 'bckineta', ssh_bkginc, 1 )
+            ! Apply the masks
+            ssh_bkginc(:,:) = ssh_bkginc(:,:) * tmask(:,:,1)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( ssh_bkginc(:,:) ) > 1.0e+10 ) ssh_bkginc(:,:) = 0.0
+         ENDIF
+
+         CALL iom_close( inum )
+ 
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Allocate and initialize the background state arrays
+      !-----------------------------------------------------------------------
+
+      IF ( ln_asmdin ) THEN
+
+         ALLOCATE( t_bkg(jpi,jpj,jpk) )
+         ALLOCATE( s_bkg(jpi,jpj,jpk) )
+         ALLOCATE( u_bkg(jpi,jpj,jpk) )
+         ALLOCATE( v_bkg(jpi,jpj,jpk) )
+         ALLOCATE( ssh_bkg(jpi,jpj)   )
+
+         t_bkg(:,:,:) = 0.0
+         s_bkg(:,:,:) = 0.0
+         u_bkg(:,:,:) = 0.0
+         v_bkg(:,:,:) = 0.0
+         ssh_bkg(:,:) = 0.0
+
+         !--------------------------------------------------------------------
+         ! Read from file the background state at analysis time
+         !--------------------------------------------------------------------
+
+         CALL iom_open( c_asmdin, inum )
+
+         CALL iom_get( inum, 'zdate', zdate_bkg ) 
+        
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', &
+               &  NINT( zdate_bkg )
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         IF ( NINT( zdate_bkg ) /= iitdin_date ) &
+            & CALL ctl_warn( ' Validity time of assimilation background state does', &
+            &                ' not agree with Direct Initialization time' )
+
+         IF ( ln_trainc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg )
+            CALL iom_get( inum, jpdom_autoglo, 'sn', s_bkg )
+            t_bkg(:,:,:) = t_bkg(:,:,:) * tmask(:,:,:)
+            s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:)
+         ENDIF
+
+         IF ( ln_dyninc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg )
+            CALL iom_get( inum, jpdom_autoglo, 'vn', v_bkg )
+            u_bkg(:,:,:) = u_bkg(:,:,:) * umask(:,:,:)
+            v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:)
+         ENDIF
+        
+         IF ( ln_sshinc ) THEN
+            CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh_bkg )
+            ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1)
+         ENDIF
+
+         CALL iom_close( inum )
+
+      ENDIF
+
+   END SUBROUTINE asm_inc_init
+
+   SUBROUTINE calc_date( kit000, kt, kdate0, kdate )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_date  ***
+      !!          
+      !! ** Purpose : Compute the calendar date YYYYMMDD at a given time step.
+      !!
+      !! ** Method  : Compute the calendar date YYYYMMDD at a given time step.
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  07-04  (A. Weaver) 
+      !!        !  10-05  (D. Lea)        Update to work with NEMO vn3.2
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Arguments
+
+      INTEGER, INTENT(IN) :: kit000  ! Initial time step
+      INTEGER, INTENT(IN) :: kt      ! Current time step referenced to kit000
+      INTEGER, INTENT(IN) :: kdate0  ! Initial date
+      INTEGER, INTENT(OUT) :: kdate  ! Current date reference to kdate0
+
+      !! * Local declarations
+
+      INTEGER :: iyea0    ! Initial year
+      INTEGER :: imon0    ! Initial month
+      INTEGER :: iday0    ! Initial day
+      INTEGER :: iyea     ! Current year
+      INTEGER :: imon     ! Current month
+      INTEGER :: iday     ! Current day
+      INTEGER :: idaystp  ! Number of days between initial and current date
+      INTEGER :: idaycnt  ! Day counter
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+
+      !-----------------------------------------------------------------------
+      ! Compute the calendar date YYYYMMDD
+      !-----------------------------------------------------------------------
+
+      ! Initial date
+      iyea0 =   kdate0 / 10000
+      imon0 = ( kdate0 - ( iyea0 * 10000 ) ) / 100
+      iday0 =   kdate0 - ( iyea0 * 10000 ) - ( imon0 * 100 ) 
+
+      ! Check that kt >= kit000 - 1
+      IF ( kt < kit000 - 1 ) CALL ctl_stop( ' kt must be >= kit000 - 1')
+
+      ! If kt = kit000 - 1 then set the date to the restart date
+      IF ( kt == kit000 - 1 ) THEN
+
+         kdate = ndastp
+         RETURN
+
+      ENDIF
+
+      ! Compute the number of days from the initial date
+      idaystp = INT( REAL( kt - kit000 ) * rdt / 86400. )
+   
+      iday    = iday0
+      imon    = imon0
+      iyea    = iyea0
+      idaycnt = 0
+
+      CALL calc_month_len( iyea, imonth_len )
+
+      DO WHILE ( idaycnt < idaystp )
+         iday = iday + 1
+         IF ( iday > imonth_len(imon) )  THEN
+            iday = 1
+            imon = imon + 1
+         ENDIF
+         IF ( imon > 12 ) THEN
+            imon = 1
+            iyea = iyea + 1
+            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
+         ENDIF                 
+         idaycnt = idaycnt + 1
+      END DO
+
+      kdate = iyea * 10000 + imon * 100 + iday
+
+   END SUBROUTINE
+
+   SUBROUTINE calc_month_len( iyear, imonth_len )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_month_len  ***
+      !!          
+      !! ** Purpose : Compute the number of days in a months given a year.
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  10-05  (D. Lea)   New routine based on day_init 
+      !!----------------------------------------------------------------------
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+      INTEGER :: iyear         !: year
+
+      ! length of the month of the current year (from nleapy, read in namelist)
+      IF ( nleapy < 2 ) THEN 
+         imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+         IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years
+            IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN
+               imonth_len(2) = 29
+            ENDIF
+         ENDIF
+      ELSE
+         imonth_len(:) = nleapy   ! all months with nleapy days per year
+      ENDIF
+
+   END SUBROUTINE
+
+   SUBROUTINE tra_asm_inc( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE tra_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the tracer (T and S) assimilation increments
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  07-03  (M. Martin) Met Office version
+      !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kt               ! Current time step
+
+      !! * Local declarations
+      INTEGER :: ji,jj,jk
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
+
+      IF ( ln_asmiau ) THEN
+
+         !--------------------------------------------------------------------
+         ! Incremental Analysis Updating
+         !--------------------------------------------------------------------
+
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+
+            ! Update the tracer tendencies
+            DO jk = 1, jpkm1
+               ta(:,:,jk) = ta(:,:,jk) + t_bkginc(:,:,jk) * zincwgt  
+               sa(:,:,jk) = sa(:,:,jk) + s_bkginc(:,:,jk) * zincwgt
+            END DO
+
+            ! Salinity fix
+            IF (ln_salfix) THEN
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji= 1, jpi
+                        sa(ji,jj,jk) = MAX( sa(ji,jj,jk), salfixmin )
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+
+         ENDIF
+
+         IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work
+            DEALLOCATE( t_bkginc )
+            DEALLOCATE( s_bkginc )
+         ENDIF
+
+
+      ELSEIF ( ln_asmdin ) THEN
+
+         !--------------------------------------------------------------------
+         ! Direct Initialization
+         !--------------------------------------------------------------------
+            
+         IF ( kt == nitdin_r ) THEN
+
+            neuler = 0  ! Force Euler forward step
+
+            ! Initialize the now fields with the background + increment
+            tn(:,:,:) = t_bkg(:,:,:) + t_bkginc(:,:,:)   
+            sn(:,:,:) = s_bkg(:,:,:) + s_bkginc(:,:,:)   
+
+            ! Optional salinity fix
+            IF (ln_salfix) THEN
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji= 1, jpi
+                        sn(ji,jj,jk) = MAX( sn(ji,jj,jk), salfixmin )
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+
+            tb(:,:,:) = tn(:,:,:)                        ! Update before fields
+            sb(:,:,:) = sn(:,:,:)
+
+            CALL eos( tb, sb, rhd, rhop )                ! Before potential and in situ densities
+         
+#if ! defined key_c1d
+            IF( ln_zps ) &
+               &  CALL zps_hde( nit000, tb, sb, rhd,  &  ! Partial steps: before horizontal derivative
+               &                gtu, gsu, gru,        &  ! of T, S, rd at the bottom ocean level
+               &                gtv, gsv, grv )
+#endif
+
+            DEALLOCATE( t_bkginc )
+            DEALLOCATE( s_bkginc )
+            DEALLOCATE( t_bkg    )
+            DEALLOCATE( s_bkg    )
+         ENDIF
+         
+      ENDIF
+
+   END SUBROUTINE tra_asm_inc
+
+   SUBROUTINE dyn_asm_inc( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dyn_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the dynamics (u and v) assimilation increments.
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating.
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  07-03  (M. Martin) Met Office version
+      !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kt   ! Current time step
+
+      !! * Local declarations
+      INTEGER :: jk
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
+
+      IF ( ln_asmiau ) THEN
+
+         !--------------------------------------------------------------------
+         ! Incremental Analysis Updating
+         !--------------------------------------------------------------------
+
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+
+            ! Update the dynamic tendencies
+            DO jk = 1, jpkm1
+               ua(:,:,jk) = ua(:,:,jk) + u_bkginc(:,:,jk) * zincwgt
+               va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt
+            END DO
+           
+            IF ( kt == nitiaufin_r ) THEN
+               DEALLOCATE( u_bkginc )
+               DEALLOCATE( v_bkginc )
+            ENDIF
+
+         ENDIF
+
+      ELSEIF ( ln_asmdin ) THEN 
+
+         !--------------------------------------------------------------------
+         ! Direct Initialization
+         !--------------------------------------------------------------------
+         
+         IF ( kt == nitdin_r ) THEN
+
+            neuler = 0                    ! Force Euler forward step
+
+            ! Initialize the now fields with the background + increment
+            un(:,:,:) = u_bkg(:,:,:) + u_bkginc(:,:,:)
+            vn(:,:,:) = v_bkg(:,:,:) + v_bkginc(:,:,:)  
+
+            ub(:,:,:) = un(:,:,:)         ! Update before fields
+            vb(:,:,:) = vn(:,:,:)
+ 
+            CALL div_cur( kt )                  ! Compute divergence and curl for now fields
+            IF( n_cla == 1 ) CALL div_cla( kt ) ! Cross Land Advection (Update Hor. divergence)
+
+            rotb (:,:,:) = rotn (:,:,:)   ! Update before fields
+            hdivb(:,:,:) = hdivn(:,:,:)
+
+            DEALLOCATE( u_bkg    )
+            DEALLOCATE( v_bkg    )
+            DEALLOCATE( u_bkginc )
+            DEALLOCATE( v_bkginc )
+
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE dyn_asm_inc
+
+   SUBROUTINE ssh_asm_inc( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ssh_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the sea surface height assimilation increment.
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating.
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  07-03  (M. Martin) Met Office version
+      !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kt   ! Current time step
+
+      !! * Local declarations
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
+
+      IF ( ln_asmiau ) THEN
+
+         !--------------------------------------------------------------------
+         ! Incremental Analysis Updating
+         !--------------------------------------------------------------------
+
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+
+            ! Save the tendency associated with the IAU weighted SSH increment
+            ! (applied in dynspg.*)
+#if defined key_asminc
+            ssh_iau(:,:) = ssh_bkginc(:,:) * zincwgt
+#endif
+            IF ( kt == nitiaufin_r ) THEN
+               DEALLOCATE( ssh_bkginc )
+            ENDIF
+
+         ENDIF
+
+      ELSEIF ( ln_asmdin ) THEN
+
+         !--------------------------------------------------------------------
+         ! Direct Initialization
+         !--------------------------------------------------------------------
+
+         IF ( kt == nitdin_r ) THEN
+
+            neuler = 0                    ! Force Euler forward step
+
+            ! Initialize the now fields the background + increment
+            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)  
+
+            sshb(:,:) = sshn(:,:)         ! Update before fields
+
+            DEALLOCATE( ssh_bkg    )
+            DEALLOCATE( ssh_bkginc )
+
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE ssh_asm_inc
+
+END MODULE asminc
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asmpar.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 2236)
@@ -0,0 +1,32 @@
+MODULE asmpar
+   !!======================================================================
+   !!                       ***  MODULE asmpar  ***
+   !! Assimilation increment : Parameters for assimilation interface
+   !!======================================================================
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   !! * Shared Modules variables
+   CHARACTER (LEN=40), PUBLIC, PARAMETER :: &
+      & c_asmbkg = 'assim_background_state_Jb',  & !: Filename for storing the 
+                                                   !: background state for use 
+                                                   !: in the Jb term
+      & c_asmdin = 'assim_background_state_DI',  & !: Filename for storing the 
+                                                   !: background state for direct 
+                                                   !: initialization
+      & c_asmtrj = 'assim_trj',                  & !: Filename for storing the 
+                                                   !: reference trajectory
+      & c_asminc = 'assim_background_increments'   !: Filename for storing the 
+                                                   !: increments to the background
+                                                   !: state
+
+   INTEGER, PUBLIC :: nitbkg_r      !: Background time step referenced to nit000
+   INTEGER, PUBLIC :: nitdin_r      !: Direct Initialization time step referenced to nit000
+   INTEGER, PUBLIC :: nitiaustr_r   !: IAU starting time step referenced to nit000
+   INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000
+   INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR
+
+END MODULE asmpar
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asmtrj.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asmtrj.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ASM/asmtrj.F90	(revision 2236)
@@ -0,0 +1,283 @@
+MODULE asmtrj
+   !!======================================================================
+   !!                       ***  MODULE asmtrj  ***
+   !! Assimilation trajectory interface: Write to file the background state
+   !!                                    and the model state trajectory
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   'key_asminc' : Switch on the assimilation increment interface
+   !!----------------------------------------------------------------------
+   !!   asm_bkg_wri  : Write out the background state
+   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var)
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE oce                ! Dynamics and active tracers defined in memory
+   USE sbc_oce            ! Ocean surface boundary conditions
+   USE zdf_oce            ! Vertical mixing variables
+   USE zdfddm             ! Double diffusion mixing parameterization
+   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory
+   USE ldfslp             ! Slopes of neutral surfaces
+   USE tradmp             ! Tracer damping
+
+#if defined key_zdftke
+   USE zdftke             ! TKE vertical physics
+#endif
+   USE eosbn2             ! Equation of state (eos_bn2 routine)
+   USE zdfmxl             ! Mixed layer depth
+   USE sol_oce, ONLY : &  ! Solver variables defined in memory
+      & gcx
+   USE in_out_manager, ONLY : &  ! I/O manager
+      & lwp,     &
+      & numout
+   USE dom_oce, ONLY : &
+      & ndastp
+   USE iom                 ! I/O module
+   USE asmpar              ! Parameters for the assmilation interface
+   USE zdfmxl, ONLY : &   ! mixed layer depth
+      & hmlp
+#if defined key_traldf_c2d
+   USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine)
+#endif
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC asm_bkg_wri, &  !: Write out the background state
+      &   asm_trj_wri     !: Write out the background state
+
+CONTAINS
+
+   SUBROUTINE asm_bkg_wri( kt )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                  ***  ROUTINE asm_bkg_wri ***
+      !!
+      !! ** Purpose : Write to file the background state for later use in the
+      !!              inner loop of data assimilation or for direct initialization
+      !!              in the outer loop.
+      !!
+      !! ** Method  : Write out the background state for use in the Jb term
+      !!              in the cost function and for use with direct initialization
+      !!              at analysis time.
+      !!
+      !! ** Action  :
+      !!                   
+      !! References : 
+      !!
+      !! History :
+      !!        ! 07-03 (M. Martin) Met. Office version
+      !!        ! 07-03 (K. Mogensen) Adapt to NEMOVAR and use IOM instead of IOIPSL
+      !!        ! 07-04 (A. Weaver) Name change (formally asmbkg.F90). Distinguish
+      !!                            background states in Jb term and at analysis time.
+      !!                            Include state trajectory routine (currently empty)
+      !!        ! 07-07 (A. Weaver) Add tke_rst and flt_rst for case nitbkg=0 
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT( IN ) :: kt               ! Current time-step
+
+      !! * Local declarations
+      CHARACTER (LEN=50) :: cl_asmbkg
+      CHARACTER (LEN=50) :: cl_asmdin
+      LOGICAL :: llok          ! Check if file exists
+      INTEGER :: inum          ! File unit number
+      REAL(wp) :: zdate        ! Date
+
+      !--------------------------------------------------------------------
+      ! Write out background at time step nitbkg_r or nitdin_r
+      !--------------------------------------------------------------------
+
+      IF ( kt == nitbkg_r ) THEN
+
+         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
+         cl_asmbkg = TRIM( cl_asmbkg )
+
+         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
+
+         IF( .NOT. llok ) THEN
+            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// &
+               &                    TRIM( c_asmbkg )
+
+            ! Define the output file        
+            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
+
+            ! Treat special case when nitbkg = 0
+            IF ( nitbkg_r == nit000 - 1 ) THEN
+               zdate = REAL( ndastp )
+#if defined key_zdftke
+               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
+               ! Read turbulent kinetic energy ( en )
+               CALL tke_rst( nit000, 'READ' )
+#endif
+            ELSE
+               zdate = REAL( ndastp )
+            ENDIF
+
+            ! Write the information
+            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un      )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn      )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tn      )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , sn      )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn    )
+#if defined key_zdftke
+            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en      )
+#endif
+            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx     )
+
+            CALL iom_close( inum )
+
+         ENDIF
+
+      ENDIF
+
+      IF ( kt == nitdin_r ) THEN
+
+         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
+         cl_asmdin = TRIM( cl_asmdin )
+
+         INQUIRE( FILE = cl_asmdin, EXIST = llok )
+
+         IF( .NOT. llok ) THEN
+            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// &
+               &                    TRIM( c_asmdin )
+
+            ! Define the output file        
+            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
+
+            ! Treat special case when nitbkg = 0
+            IF ( nitdin_r == nit000 - 1) THEN
+               zdate = REAL( ndastp )
+            ELSE
+               zdate = REAL( ndastp )
+            ENDIF
+
+            ! Write the information
+            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate   )
+            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un      )
+            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn      )
+            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tn      )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , sn      )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn    )
+
+            CALL iom_close( inum )
+
+         ENDIF
+
+      ENDIF
+                                  
+   END SUBROUTINE asm_bkg_wri
+
+   SUBROUTINE asm_trj_wri( kt )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                  ***  ROUTINE asm_trj_wri ***
+      !!
+      !! ** Purpose : Write to file the model state trajectory for use with
+      !!              4D-Var.
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  :
+      !!                   
+      !! References : 
+      !!
+      !! History :
+      !!        ! 07-04 (A. Weaver) 
+      !!        ! 09-03 (F. Vigilant) Add hmlp (zdfmxl) for no tracer nmldp=2 
+      !!        ! 09-06 (F. Vigilant) special case when kt=nit000-1
+      !!        ! 09-07 (F. Vigilant) add computation of eiv at restart
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT( IN ) :: kt             ! Current time-step
+
+      !! * Local declarations
+      INTEGER :: inum                  ! File unit number
+      INTEGER :: it
+      CHARACTER (LEN=50) :: cl_asmtrj
+      REAL(wp) :: zdate            ! Date
+
+      !------------------------------------------------------------------------
+      ! Write a single file for each trajectory time step
+      !------------------------------------------------------------------------
+      IF ( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. &
+         & ( kt == nitend ) ) THEN
+         
+         ! Treat special case when kt = nit000-1
+         IF ( kt == nit000 - 1 ) THEN
+#if defined key_zdftke
+            IF(lwp) WRITE(numout,*) ' Computing  zdf_tke coeff. form restart...'
+            ! Compute the vertical eddy viscosity and diffusivity coefficients
+            CALL zdf_tke( nit000 )
+#endif
+#if defined key_zdfddm
+            IF(lwp) WRITE(numout,*) ' Computing zdf_ddm coeff. from restart...'
+            ! Compute the vertical eddy viscosity and diffusivity coefficients (salt effect)
+            CALL zdf_ddm( nit000 )
+#endif
+            IF(lwp) WRITE(numout,*) ' Computing zdf_mxl coeff. from restart...'
+            ! Compute the turbocline depth and the mixed layer depth
+            CALL zdf_mxl( nit000 ) 
+#if defined key_ldfslp
+            IF(lwp) WRITE(numout,*) ' Compute the slopes of neutral surface...'
+            CALL bn2( tb, sb, rn2 ) 
+            CALL ldf_slp( nit000, rhd, rn2 )
+#endif
+#if defined key_traldf_c2d
+            IF(lwp) WRITE(numout,*) ' Computing ldf_eiv coeff. from restart...'
+            ! Compute eddy induced velocity coefficient
+            IF( lk_traldf_eiv )   CALL ldf_eiv( nit000 )
+#endif
+          ENDIF
+
+
+         it = kt - nit000 + 1
+
+         ! Define the output file        
+         WRITE(cl_asmtrj, FMT='(A,A,I5.5)' ) TRIM( c_asmtrj ), '_', it
+         cl_asmtrj = TRIM( cl_asmtrj )
+         CALL iom_open( cl_asmtrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
+
+         ! Output trajectory fields
+         CALL iom_rstput( it, it, inum, 'emp'   , emp    )
+         CALL iom_rstput( it, it, inum, 'emps'  , emps   )
+         CALL iom_rstput( it, it, inum, 'un'    , un     )
+         CALL iom_rstput( it, it, inum, 'vn'    , vn     )
+         CALL iom_rstput( it, it, inum, 'tn'    , tn     )
+         CALL iom_rstput( it, it, inum, 'sn'    , sn     )
+         CALL iom_rstput( it, it, inum, 'avmu'  , avmu   )
+         CALL iom_rstput( it, it, inum, 'avmv'  , avmv   )
+         CALL iom_rstput( it, it, inum, 'avt'   , avt    )
+#if defined key_ldfslp
+         CALL iom_rstput( it, it, inum, 'uslp'  , uslp   )
+         CALL iom_rstput( it, it, inum, 'vslp'  , vslp   )
+         CALL iom_rstput( it, it, inum, 'wslpi' , wslpi  )
+         CALL iom_rstput( it, it, inum, 'wslpj' , wslpj  )
+#endif
+#if defined key_zdfddm
+         CALL iom_rstput( it, it, inum, 'avs'   , avs    )
+#endif
+         CALL iom_rstput( it, it, inum, 'ta'    , ta     )
+         CALL iom_rstput( it, it, inum, 'sa'    , sa     )
+         CALL iom_rstput( it, it, inum, 'tb'    , tb     )
+         CALL iom_rstput( it, it, inum, 'sb'    , sb     )
+#if defined key_tradmp
+         CALL iom_rstput( it, it, inum, 'strdmp', strdmp )
+         CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   )
+#endif
+         CALL iom_rstput( it, it, inum, 'aeiu'  , aeiu   )
+         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv   )
+         CALL iom_rstput( it, it, inum, 'aeiw'  , aeiw   )
+
+         CALL iom_close( inum )
+         
+      ENDIF
+
+   END SUBROUTINE asm_trj_wri
+
+END MODULE asmtrj
+   
+   
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 2236)
@@ -6,4 +6,5 @@
    !! History :  1.0  !  2001-05  (J. Chanut, A. Sellar)  Original code
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version     
+   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions
    !!----------------------------------------------------------------------
 #if defined key_bdy 
@@ -54,7 +55,7 @@
    !! Unstructured open boundary data variables
    !!----------------------------------------------------------------------
-   INTEGER, DIMENSION(jpbgrd) ::   nblen                  !: Size of bdy data on a proc for each grid type
-   INTEGER, DIMENSION(jpbgrd) ::   nblenrim               !: Size of bdy data on a proc for first rim ind
-   INTEGER, DIMENSION(jpbgrd) ::   nblendta               !: Size of bdy data in file
+   INTEGER, DIMENSION(jpbgrd) ::   nblen    = 0           !: Size of bdy data on a proc for each grid type
+   INTEGER, DIMENSION(jpbgrd) ::   nblenrim = 0           !: Size of bdy data on a proc for first rim ind
+   INTEGER, DIMENSION(jpbgrd) ::   nblendta = 0           !: Size of bdy data in file
 
    INTEGER, DIMENSION(jpbdim,jpbgrd) ::   nbi, nbj        !: i and j indices of bdy dta
@@ -73,4 +74,9 @@
    REAL(wp), DIMENSION(jpbdim) ::   sshtide               !: Tidal boundary array : SSH
    REAL(wp), DIMENSION(jpbdim) ::   utide, vtide          !: Tidal boundary array : U and V
+#if defined key_lim2
+   REAL(wp), DIMENSION(jpbdim) ::  &
+      frld_bdy, hicif_bdy,  & !: Now clim of ice leads fraction, ice  
+      hsnif_bdy               !: thickness and snow thickness
+#endif
 
 #else
@@ -84,5 +90,5 @@
    !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE bdy_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_par.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_par.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_par.F90	(revision 2236)
@@ -6,6 +6,7 @@
    !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.3  !  2010-09  (D. Storkey and E. O'Dea) update for Shelf configurations
    !!----------------------------------------------------------------------
-#if defined key_bdy
+#if defined   key_bdy
    !!----------------------------------------------------------------------
    !!   'key_bdy' :                    Unstructured Open Boundary Condition
@@ -15,10 +16,9 @@
    PUBLIC
 
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_bdy  = .TRUE.  !: Unstructured Ocean Boundary Condition flag
-   INTEGER, PUBLIC, PARAMETER ::   jpbdta  = 5000    !: Max length of bdy field in file
-   INTEGER, PUBLIC, PARAMETER ::   jpbdim  = 5000    !: Max length of bdy field on a processor
-   INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000    !: Max number of time dumps per file
-   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3	     !: Number of horizontal grid types used  (T, u, v, f)
+   LOGICAL, PUBLIC, PARAMETER ::   lk_bdy  = .TRUE.   !: Unstructured Ocean Boundary Condition flag
+   INTEGER, PUBLIC, PARAMETER ::   jpbdta  = 20000    !: Max length of bdy field in file
+   INTEGER, PUBLIC, PARAMETER ::   jpbdim  = 20000    !: Max length of bdy field on a processor
+   INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000     !: Max number of time dumps per file
+   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 6	      !: Number of horizontal grid types used  (T, u, v, f)
 #else
    !!----------------------------------------------------------------------
@@ -29,7 +29,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE bdy_par
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 2236)
@@ -8,4 +8,6 @@
    !!             -   !  2007-07  (D. Storkey) add bdy_dta_bt
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations 
+   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
    !!----------------------------------------------------------------------
 #if defined key_bdy
@@ -14,6 +16,5 @@
    !!----------------------------------------------------------------------
    !!   bdy_dta    : read u, v, t, s data along open boundaries
-   !!   bdy_dta_bt : read depth-mean velocities and elevation along open
-   !!                boundaries        
+   !!   bdy_dta_bt : read depth-mean velocities and elevation along open boundaries        
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
@@ -25,4 +26,7 @@
    USE ioipsl
    USE in_out_manager  ! I/O logical units
+#if defined key_lim2
+   USE ice_2
+#endif
 
    IMPLICIT NONE
@@ -32,26 +36,31 @@
    PUBLIC   bdy_dta_bt 
 
-   INTEGER ::   numbdyt, numbdyu, numbdyv                      !: logical units for T-, U-, & V-points data file, resp.
-   INTEGER ::   ntimes_bdy                                     !: exact number of time dumps in data files
-   INTEGER ::   nbdy_b, nbdy_a                                 !: record of bdy data file for before and after model time step
-   INTEGER ::   numbdyt_bt, numbdyu_bt, numbdyv_bt             !: logical unit for T-, U- & V-points data file, resp.
-   INTEGER ::   ntimes_bdy_bt                                  !: exact number of time dumps in data files
-   INTEGER ::   nbdy_b_bt, nbdy_a_bt                           !: record of bdy data file for before and after model time step
-
-   INTEGER, DIMENSION (jpbtime) ::   istep, istep_bt           !: time array in seconds in each data file
-
-   REAL(wp) ::  zoffset                                        !: time offset between time origin in file & start time of model run
-
-   REAL(wp), DIMENSION(jpbdim,jpk,2) ::   tbdydta, sbdydta     !: time interpolated values of T and S bdy data   
-   REAL(wp), DIMENSION(jpbdim,jpk,2) ::   ubdydta, vbdydta     !: time interpolated values of U and V bdy data 
-   REAL(wp), DIMENSION(jpbdim,2)     ::   ubtbdydta, vbtbdydta !: Arrays used for time interpolation of bdy data   
-   REAL(wp), DIMENSION(jpbdim,2)     ::   sshbdydta            !: bdy data of ssh
+   INTEGER ::   numbdyt, numbdyu, numbdyv                      ! logical units for T-, U-, & V-points data file, resp.
+   INTEGER ::   ntimes_bdy                                     ! exact number of time dumps in data files
+   INTEGER ::   nbdy_b, nbdy_a                                 ! record of bdy data file for before and after time step
+   INTEGER ::   numbdyt_bt, numbdyu_bt, numbdyv_bt             ! logical unit for T-, U- & V-points data file, resp.
+   INTEGER ::   ntimes_bdy_bt                                  ! exact number of time dumps in data files
+   INTEGER ::   nbdy_b_bt, nbdy_a_bt                           ! record of bdy data file for before and after time step
+
+   INTEGER, DIMENSION (jpbtime) ::   istep, istep_bt           ! time array in seconds in each data file
+
+   REAL(wp) ::  zoffset                                        ! time offset between time origin in file & start time of model run
+
+   REAL(wp), DIMENSION(jpbdim,jpk,2) ::   tbdydta, sbdydta     ! time interpolated values of T and S bdy data   
+   REAL(wp), DIMENSION(jpbdim,jpk,2) ::   ubdydta, vbdydta     ! time interpolated values of U and V bdy data 
+   REAL(wp), DIMENSION(jpbdim,2)     ::   ubtbdydta, vbtbdydta ! Arrays used for time interpolation of bdy data   
+   REAL(wp), DIMENSION(jpbdim,2)     ::   sshbdydta            ! bdy data of ssh
+
+#if defined key_lim2
+   REAL(wp), DIMENSION(jpbdim,2)     ::   frld_bdydta          ! }
+   REAL(wp), DIMENSION(jpbdim,2)     ::   hicif_bdydta         ! } Arrays used for time interp. of ice bdy data 
+   REAL(wp), DIMENSION(jpbdim,2)     ::   hsnif_bdydta         ! }
+#endif
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -67,5 +76,5 @@
       !!                the file. If so read it in. Time interpolate.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt                             ! ocean time-step index (for timesplitting option, otherwise zero)
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index (for timesplitting option, otherwise zero)
       !!
       CHARACTER(LEN=80), DIMENSION(3) ::   clfile               ! names of input files
@@ -79,5 +88,5 @@
       INTEGER ::   itimer, totime
       INTEGER ::   ii, ij                                       ! array addresses
-      INTEGER ::   ipi, ipj, ipk, inum                          ! temporary integers (NetCDF read)
+      INTEGER ::   ipi, ipj, ipk, inum                          ! local integers (NetCDF read)
       INTEGER ::   iyear0, imonth0, iday0
       INTEGER ::   ihours0, iminutes0, isec0
@@ -91,6 +100,7 @@
       !!---------------------------------------------------------------------------
 
-      IF( ln_bdy_dyn_frs .OR. ln_bdy_tra_frs ) THEN  ! If these are both false then this routine 
-                                                     ! does nothing.
+
+      IF( ln_bdy_dyn_frs .OR. ln_bdy_tra_frs    &
+         &               .OR. ln_bdy_ice_frs ) THEN  ! If these are both false then this routine does nothing
 
       ! -------------------- !
@@ -102,5 +112,6 @@
       ! Some time variables for monthly climatological forcing:
       ! *******************************************************
- !!gm  here  use directely daymod variables
+
+!!gm  here  use directely daymod calendar variables
  
       iman = INT( raamo )      ! Number of months in a year
@@ -121,6 +132,6 @@
          !                                             !-------------------!
          istep(:) = 0
-         nbdy_b    = 0
-         nbdy_a    = 0
+         nbdy_b   = 0
+         nbdy_a   = 0
 
          ! Get time information from bdy data file
@@ -151,9 +162,7 @@
             igrd_start = 1
             igrd_end   = 3
-            IF(.NOT. ln_bdy_tra_frs .AND. .NOT. ln_bdy_ice_frs) THEN
-               ! No T-grid file.
+            IF(.NOT. ln_bdy_tra_frs .AND. .NOT. ln_bdy_ice_frs) THEN       ! No T-grid file.
                igrd_start = 2
-            ELSEIF ( .NOT. ln_bdy_dyn_frs ) THEN
-               ! No U-grid or V-grid file.
+            ELSEIF ( .NOT. ln_bdy_dyn_frs ) THEN                           ! No U-grid or V-grid file.
                igrd_end   = 1         
             ENDIF
@@ -165,10 +174,7 @@
 
                SELECT CASE( igrd )
-                  CASE (1) 
-                     numbdyt = inum
-                  CASE (2) 
-                     numbdyu = inum
-                  CASE (3) 
-                     numbdyv = inum
+                  CASE (1)   ;   numbdyt = inum
+                  CASE (2)   ;   numbdyu = inum
+                  CASE (3)   ;   numbdyv = inum
                END SELECT
 
@@ -196,5 +202,5 @@
                IF(lwp) WRITE(numout,*) 'offset: ',zoffset
                IF(lwp) WRITE(numout,*) 'totime: ',totime
-               IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr
+               IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr(1:ntimes_bdy)
 
                ! Check that there are not too many times in the file. 
@@ -205,11 +211,10 @@
 
                ! Check that time array increases:
-        
                it = 1
-               DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 )
-                 it = it + 1
+               DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 ) 
+                  it = it + 1
                END DO
-
-               IF( it.NE.ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN
+               !
+               IF( it /= ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN
                      WRITE(ctmp1,*) 'Check file: ', clfile(igrd)
                      CALL ctl_stop( 'Time array in unstructured boundary data files',   &
@@ -227,17 +232,21 @@
                END IF
                !
-               IF    ( igrd == 1 ) THEN
-                 ntimes_bdyt = ntimes_bdy
-                 zoffsett = zoffset
-                 istept(:) = INT( zstepr(:) + zoffset )
-               ELSEIF(igrd == 2 ) THEN
-                 ntimes_bdyu = ntimes_bdy
-                 zoffsetu = zoffset
-                 istepu(:) = INT( zstepr(:) + zoffset )
-               ELSEIF(igrd == 3 ) THEN
-                 ntimes_bdyv = ntimes_bdy
-                 zoffsetv = zoffset
-                 istepv(:) = INT( zstepr(:) + zoffset )
-               ENDIF
+               SELECT CASE( igrd )
+                  CASE (1)
+                    ntimes_bdyt = ntimes_bdy
+                    zoffsett = zoffset
+                    istept(:) = INT( zstepr(:) + zoffset )
+                    numbdyt = inum
+                  CASE (2)
+                    ntimes_bdyu = ntimes_bdy
+                    zoffsetu = zoffset
+                    istepu(:) = INT( zstepr(:) + zoffset )
+                    numbdyu = inum
+                  CASE (3)
+                    ntimes_bdyv = ntimes_bdy
+                    zoffsetv = zoffset
+                    istepv(:) = INT( zstepr(:) + zoffset )
+                    numbdyv = inum
+               END SELECT
                !
             END DO                                         ! end loop over T, U & V grid 
@@ -259,8 +268,6 @@
             ENDIF
 
-            IF( igrd_start == 1 ) THEN
-               istep(:) = istept(:)
-            ELSE
-               istep(:) = istepu(:)
+            IF( igrd_start == 1 ) THEN   ;   istep(:) = istept(:)
+            ELSE                         ;   istep(:) = istepu(:)
             ENDIF
 
@@ -287,10 +294,10 @@
             it = 1
             DO WHILE( istep(it+1) <= 0 .AND. it <= ntimes_bdy - 1 )
-              it = it + 1
+               it = it + 1
             END DO
             nbdy_b = it
             !
-            WRITE(numout,*) 'Time offset is ',zoffset
-            WRITE(numout,*) 'First record to read is ',nbdy_b
+            IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset
+            IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b
 
          ENDIF ! endif (nbdy_dta == 1)
@@ -300,38 +307,48 @@
          ! *****************************************************************
 
-         IF( nbdy_dta == 0) THEN      ! boundary data arrays are filled with initial conditions
+         IF( nbdy_dta == 0 ) THEN      ! boundary data arrays are filled with initial conditions
             !
             IF (ln_bdy_tra_frs) THEN
-              igrd = 1            ! T-points data 
-              DO ib = 1, nblen(igrd)
-                ii = nbi(ib,igrd)
-                ij = nbj(ib,igrd)
-                DO ik = 1, jpkm1
-                  tbdy(ib,ik) = tn(ii, ij, ik)
-                  sbdy(ib,ik) = sn(ii, ij, ik)
-                ENDDO
-              END DO
+               igrd = 1            ! T-points data 
+               DO ib = 1, nblen(igrd)
+                  ii = nbi(ib,igrd)
+                  ij = nbj(ib,igrd)
+                  DO ik = 1, jpkm1
+                     tbdy(ib,ik) = tn(ii,ij,ik)
+                     sbdy(ib,ik) = sn(ii,ij,ik)
+                  END DO
+               END DO
             ENDIF
 
             IF(ln_bdy_dyn_frs) THEN
-              igrd = 2            ! U-points data 
-              DO ib = 1, nblen(igrd)
-                ii = nbi(ib,igrd)
-                ij = nbj(ib,igrd)
-                DO ik = 1, jpkm1
-                  ubdy(ib,ik) = un(ii, ij, ik)
-                ENDDO
-              END DO
-
-              igrd = 3            ! V-points data 
-              DO ib = 1, nblen(igrd)            
-                ii = nbi(ib,igrd)
-                ij = nbj(ib,igrd)
-                DO ik = 1, jpkm1
-                  vbdy(ib,ik) = vn(ii, ij, ik)
-                ENDDO
-              END DO
+               igrd = 2            ! U-points data 
+               DO ib = 1, nblen(igrd)
+                  ii = nbi(ib,igrd)
+                  ij = nbj(ib,igrd)
+                  DO ik = 1, jpkm1
+                     ubdy(ib,ik) = un(ii, ij, ik)
+                  END DO
+               END DO
+               !
+               igrd = 3            ! V-points data 
+               DO ib = 1, nblen(igrd)            
+                  ii = nbi(ib,igrd)
+                  ij = nbj(ib,igrd)
+                  DO ik = 1, jpkm1
+                     vbdy(ib,ik) = vn(ii, ij, ik)
+                  END DO
+               END DO
             ENDIF
             !
+#if defined key_lim2
+            IF( ln_bdy_ice_frs ) THEN
+               igrd = 1            ! T-points data
+               DO ib = 1, nblen(igrd)
+                  frld_bdy (ib) =  frld(nbi(ib,igrd), nbj(ib,igrd))
+                  hicif_bdy(ib) = hicif(nbi(ib,igrd), nbj(ib,igrd))
+                  hsnif_bdy(ib) = hsnif(nbi(ib,igrd), nbj(ib,igrd))
+               END DO
+            ENDIF
+#endif
          ELSEIF( nbdy_dta == 1 ) THEN    ! Set first record in the climatological case:   
             !
@@ -352,4 +369,5 @@
 
             IF(ln_bdy_tra_frs) THEN
+               !
                igrd = 1                                           ! Temperature
                IF( nblendta(igrd) <=  0 ) THEN 
@@ -357,8 +375,8 @@
                   nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar)
                ENDIF
-               WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd)
+               IF(lwp) WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd)
                ipi = nblendta(igrd)
                CALL iom_get ( numbdyt, jpdom_unknown, 'votemper', zdta(1:ipi,1:ipj,1:ipk), nbdy_a )
-
+               !
                DO ib = 1, nblen(igrd)
                   DO ik = 1, jpkm1
@@ -372,8 +390,8 @@
                   nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar)
                ENDIF
-               WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd)
+               IF(lwp) WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd)
                ipi = nblendta(igrd)
                CALL iom_get ( numbdyt, jpdom_unknown, 'vosaline', zdta(1:ipi,1:ipj,1:ipk), nbdy_a )
-
+               !
                DO ib = 1, nblen(igrd)
                   DO ik = 1, jpkm1
@@ -383,6 +401,6 @@
             ENDIF  ! ln_bdy_tra_frs
  
-            IF(ln_bdy_dyn_frs) THEN
-
+            IF( ln_bdy_dyn_frs ) THEN
+               !
                igrd = 2                                           ! u-velocity
                IF ( nblendta(igrd) .le. 0 ) THEN 
@@ -390,5 +408,5 @@
                  nblendta(igrd) = iom_file(numbdyu)%dimsz(1,idvar)
                ENDIF
-               WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd)
+               IF(lwp) WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd)
                ipi = nblendta(igrd)
                CALL iom_get ( numbdyu, jpdom_unknown,'vozocrtx',zdta(1:ipi,1:ipj,1:ipk),nbdy_a )
@@ -404,5 +422,5 @@
                  nblendta(igrd) = iom_file(numbdyv)%dimsz(1,idvar)
                ENDIF
-               WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd)
+               IF(lwp) WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd)
                ipi = nblendta(igrd)
                CALL iom_get ( numbdyv, jpdom_unknown,'vomecrty',zdta(1:ipi,1:ipj,1:ipk),nbdy_a )
@@ -414,93 +432,142 @@
             ENDIF ! ln_bdy_dyn_frs
 
-
-            IF ((.NOT.ln_bdy_clim) .AND. (istep(1) > 0)) THEN
-               ! First data time is after start of run
-               ! Put first value in both time levels
+#if defined key_lim2
+            IF( ln_bdy_ice_frs ) THEN
+              !
+              igrd=1                                              ! leads fraction
+              IF(lwp) WRITE(numout,*) 'Dim size for ildsconc is ',nblendta(igrd)
+              ipi=nblendta(igrd)
+              CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a )
+              DO ib=1, nblen(igrd)
+                frld_bdydta(ib,2) =  zdta(nbmap(ib,igrd),1,1)
+              END DO
+              !
+              igrd=1                                              ! ice thickness
+              IF(lwp) WRITE(numout,*) 'Dim size for iicethic is ',nblendta(igrd)
+              ipi=nblendta(igrd)
+              CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a )
+              DO ib=1, nblen(igrd)
+                hicif_bdydta(ib,2) =  zdta(nbmap(ib,igrd),1,1)
+              END DO
+              !
+              igrd=1                                              ! snow thickness
+              IF(lwp) WRITE(numout,*) 'Dim size for isnowthi is ',nblendta(igrd)
+              ipi=nblendta(igrd)
+              CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a )
+              DO ib=1, nblen(igrd)
+                hsnif_bdydta(ib,2) =  zdta(nbmap(ib,igrd),1,1)
+              END DO
+            ENDIF ! just if ln_bdy_ice_frs is set
+#endif
+
+            IF( .NOT.ln_bdy_clim .AND. istep(1) > 0 ) THEN     ! First data time is after start of run
+               nbdy_b = nbdy_a                                 ! Put first value in both time levels
+               IF( ln_bdy_tra_frs ) THEN
+                 tbdydta(:,:,1) = tbdydta(:,:,2)
+                 sbdydta(:,:,1) = sbdydta(:,:,2)
+               ENDIF
+               IF( ln_bdy_dyn_frs ) THEN
+                 ubdydta(:,:,1) = ubdydta(:,:,2)
+                 vbdydta(:,:,1) = vbdydta(:,:,2)
+               ENDIF
+#if defined key_lim2
+               IF( ln_bdy_ice_frs ) THEN
+                  frld_bdydta (:,1) =  frld_bdydta(:,2)
+                  hicif_bdydta(:,1) = hicif_bdydta(:,2)
+                  hsnif_bdydta(:,1) = hsnif_bdydta(:,2)
+               ENDIF
+#endif
+            END IF
+            !
+         END IF   ! nbdy_dta == 0/1
+ 
+         ! In the case of constant boundary forcing fill bdy arrays once for all
+         IF( ln_bdy_clim .AND. ntimes_bdy == 1 ) THEN
+            IF( ln_bdy_tra_frs ) THEN
+               tbdy  (:,:) = tbdydta  (:,:,2)
+               sbdy  (:,:) = sbdydta  (:,:,2)
+            ENDIF
+            IF( ln_bdy_dyn_frs) THEN
+               ubdy  (:,:) = ubdydta  (:,:,2)
+               vbdy  (:,:) = vbdydta  (:,:,2)
+            ENDIF
+#if defined key_lim2
+            IF( ln_bdy_ice_frs ) THEN
+               frld_bdy (:) = frld_bdydta (:,2)
+               hicif_bdy(:) = hicif_bdydta(:,2)
+               hsnif_bdy(:) = hsnif_bdydta(:,2)
+            ENDIF
+#endif
+
+            IF( ln_bdy_tra_frs .OR. ln_bdy_ice_frs) CALL iom_close( numbdyt )
+            IF( ln_bdy_dyn_frs                    ) CALL iom_close( numbdyu )
+            IF( ln_bdy_dyn_frs                    ) CALL iom_close( numbdyv )
+         END IF
+         !
+      ENDIF                                            ! End if nit000
+
+
+      !                                                !---------------------!
+      IF( nbdy_dta == 1 .AND. ntimes_bdy > 1 ) THEN    !  at each time step  !
+         !                                             !---------------------!
+         ! Read one more record if necessary
+         !**********************************
+
+         IF( ln_bdy_clim .AND. imois /= nbdy_b ) THEN      ! remember that nbdy_b=0 for kt=nit000
+            nbdy_b = imois
+            nbdy_a = imois + 1
+            nbdy_b = MOD( nbdy_b, iman )   ;   IF( nbdy_b == 0 ) nbdy_b = iman
+            nbdy_a = MOD( nbdy_a, iman )   ;   IF( nbdy_a == 0 ) nbdy_a = iman
+            lect=.true.
+         ELSEIF( .NOT.ln_bdy_clim .AND. itimer >= istep(nbdy_a) ) THEN
+
+            IF( nbdy_a < ntimes_bdy ) THEN
+               nbdy_b = nbdy_a
+               nbdy_a = nbdy_a + 1
+               lect  =.true.
+            ELSE
+               ! We have reached the end of the file
+               ! put the last data time into both time levels
                nbdy_b = nbdy_a
                IF(ln_bdy_tra_frs) THEN
-                 tbdydta(:,:,1) = tbdydta(:,:,2)
-                 sbdydta(:,:,1) = sbdydta(:,:,2)
+                  tbdydta(:,:,1) =  tbdydta(:,:,2)
+                  sbdydta(:,:,1) =  sbdydta(:,:,2)
                ENDIF
                IF(ln_bdy_dyn_frs) THEN
-                 ubdydta(:,:,1) = ubdydta(:,:,2)
-                 vbdydta(:,:,1) = vbdydta(:,:,2)
-               ENDIF
-            END IF
-
-         END IF ! nbdy_dta == 0/1
- 
-         ! In the case of constant boundary forcing fill bdy arrays once for all
-         IF ((ln_bdy_clim).AND.(ntimes_bdy==1)) THEN
-            IF(ln_bdy_tra_frs) THEN
-              tbdy  (:,:) = tbdydta  (:,:,2)
-              sbdy  (:,:) = sbdydta  (:,:,2)
-            ENDIF
-            IF(ln_bdy_dyn_frs) THEN
-              ubdy  (:,:) = ubdydta  (:,:,2)
-              vbdy  (:,:) = vbdydta  (:,:,2)
-            ENDIF
-
-            IF(ln_bdy_tra_frs .or. ln_bdy_ice_frs) CALL iom_close( numbdyt )
-            IF(ln_bdy_dyn_frs) CALL iom_close( numbdyu )
-            IF(ln_bdy_dyn_frs) CALL iom_close( numbdyv )
-         END IF
-
-      ENDIF                                            ! End if nit000
-
-
-      !                                                !---------------------!
-      !                                                !  at each time step  !
-      !                                                !---------------------!
-
-      IF( nbdy_dta == 1 .AND. ntimes_bdy > 1 ) THEN 
-         !
-         ! Read one more record if necessary
-         !**********************************
-
-        IF( ln_bdy_clim .AND. imois /= nbdy_b ) THEN      ! remember that nbdy_b=0 for kt=nit000
-           nbdy_b = imois
-           nbdy_a = imois + 1
-           nbdy_b = MOD( nbdy_b, iman )   ;   IF( nbdy_b == 0 ) nbdy_b = iman
-           nbdy_a = MOD( nbdy_a, iman )   ;   IF( nbdy_a == 0 ) nbdy_a = iman
-           lect=.true.
-        ELSEIF( .NOT.ln_bdy_clim .AND. itimer >= istep(nbdy_a) ) THEN
-
-           IF ( nbdy_a < ntimes_bdy ) THEN
-              nbdy_b = nbdy_a
-              nbdy_a = nbdy_a + 1
-              lect  =.true.
-           ELSE
-              ! We have reached the end of the file
-              ! put the last data time into both time levels
-              nbdy_b = nbdy_a
-              IF(ln_bdy_tra_frs) THEN
-                tbdydta(:,:,1) =  tbdydta(:,:,2)
-                sbdydta(:,:,1) =  sbdydta(:,:,2)
-              ENDIF
-              IF(ln_bdy_dyn_frs) THEN
-                ubdydta(:,:,1) =  ubdydta(:,:,2)
-                vbdydta(:,:,1) =  vbdydta(:,:,2)
-              ENDIF
+                  ubdydta(:,:,1) =  ubdydta(:,:,2)
+                  vbdydta(:,:,1) =  vbdydta(:,:,2)
+               ENDIF
+#if defined key_lim2
+               IF(ln_bdy_ice_frs) THEN
+                  frld_bdydta (:,1) =  frld_bdydta (:,2)
+                  hicif_bdydta(:,1) =  hicif_bdydta(:,2)
+                  hsnif_bdydta(:,1) =  hsnif_bdydta(:,2)
+               ENDIF
+#endif
             END IF ! nbdy_a < ntimes_bdy
-
+            !
         END IF
          
-        IF( lect ) THEN
-           ! Swap arrays
-           IF(ln_bdy_tra_frs) THEN
+        IF( lect ) THEN           ! Swap arrays
+           IF( ln_bdy_tra_frs ) THEN
              tbdydta(:,:,1) =  tbdydta(:,:,2)
              sbdydta(:,:,1) =  sbdydta(:,:,2)
            ENDIF
-           IF(ln_bdy_dyn_frs) THEN
+           IF( ln_bdy_dyn_frs ) THEN
              ubdydta(:,:,1) =  ubdydta(:,:,2)
              vbdydta(:,:,1) =  vbdydta(:,:,2)
            ENDIF
- 
+#if defined key_lim2
+           IF( ln_bdy_ice_frs ) THEN
+             frld_bdydta (:,1) =  frld_bdydta (:,2)
+             hicif_bdydta(:,1) =  hicif_bdydta(:,2)
+             hsnif_bdydta(:,1) =  hsnif_bdydta(:,2)
+           ENDIF
+#endif 
            ! read another set
            ipj  = 1
            ipk  = jpk
 
-           IF(ln_bdy_tra_frs) THEN
+           IF( ln_bdy_tra_frs ) THEN
               ! 
               igrd = 1                                   ! temperature
@@ -543,5 +610,30 @@
               END DO
            ENDIF ! ln_bdy_dyn_frs
-
+           !
+#if defined key_lim2
+           IF(ln_bdy_ice_frs) THEN
+             !
+             igrd = 1                                    ! ice concentration
+             ipi=nblendta(igrd)
+             CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a )
+             DO ib=1, nblen(igrd)
+               frld_bdydta(ib,2) =  zdta( nbmap(ib,igrd), 1, 1 )
+             END DO
+             !
+             igrd=1                                      ! ice thickness
+             ipi=nblendta(igrd)
+             CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a )
+             DO ib=1, nblen(igrd)
+               hicif_bdydta(ib,2) =  zdta( nbmap(ib,igrd), 1, 1 )
+             END DO
+             !
+             igrd=1                                      ! snow thickness
+             ipi=nblendta(igrd)
+             CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a )
+             DO ib=1, nblen(igrd)
+               hsnif_bdydta(ib,2) =  zdta( nbmap(ib,igrd), 1, 1 )
+             END DO
+           ENDIF ! ln_bdy_ice_frs
+#endif
            !
            IF(lwp) WRITE(numout,*) 'bdy_dta : first record file used nbdy_b ',nbdy_b
@@ -559,6 +651,8 @@
        ! ********************
        ! 
-       IF( ln_bdy_clim ) THEN   ;   zxy = REAL( nday                  , wp ) / REAL( nmonth_len(nbdy_b), wp ) + 0.5 - i15
-       ELSE                     ;   zxy = REAL( istep(nbdy_b) - itimer, wp ) / REAL( istep(nbdy_b) - istep(nbdy_a), wp )
+       IF( ln_bdy_clim ) THEN   ;   zxy = REAL( nday                   ) / REAL( nmonth_len(nbdy_b) ) + 0.5 - i15
+       ELSEIF( istep(nbdy_b) == istep(nbdy_a) ) THEN 
+                                    zxy = 0.0_wp
+       ELSE                     ;   zxy = REAL( istep(nbdy_b) - itimer ) / REAL( istep(nbdy_b) - istep(nbdy_a) )
        END IF
 
@@ -589,4 +683,15 @@
           ENDIF
 
+#if defined key_lim2
+          IF(ln_bdy_ice_frs) THEN
+            igrd=1
+            DO ib=1, nblen(igrd)
+               frld_bdy(ib) = zxy *  frld_bdydta(ib,2) + (1.-zxy) *  frld_bdydta(ib,1)
+              hicif_bdy(ib) = zxy * hicif_bdydta(ib,2) + (1.-zxy) * hicif_bdydta(ib,1)
+              hsnif_bdy(ib) = zxy * hsnif_bdydta(ib,2) + (1.-zxy) * hsnif_bdydta(ib,1)
+            END DO
+          ENDIF ! just if ln_bdy_ice_frs is true
+#endif
+
       END IF                       !end if ((nbdy_dta==1).AND.(ntimes_bdy>1))
     
@@ -602,9 +707,9 @@
       !
       ENDIF ! ln_bdy_dyn_frs .OR. ln_bdy_tra_frs
-
+      !
    END SUBROUTINE bdy_dta
 
 
-   SUBROUTINE bdy_dta_bt( kt, jit )
+   SUBROUTINE bdy_dta_bt( kt, jit, icycl )
       !!---------------------------------------------------------------------------
       !!                      ***  SUBROUTINE bdy_dta_bt  ***
@@ -620,4 +725,5 @@
       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
       INTEGER, INTENT( in ) ::   jit         ! barotropic time step index
+      INTEGER, INTENT( in ) ::   icycl       ! number of cycles need for final file close
       !                                      ! (for timesplitting option, otherwise zero)
       !!
@@ -639,5 +745,5 @@
       REAL(wp), DIMENSION(jpbtime)      ::   zstepr             ! REAL time array from data files
       REAL(wp), DIMENSION(jpbdta,1)     ::   zdta               ! temporary array for data fields
-      CHARACTER(LEN=80), DIMENSION(3)   ::   clfile
+      CHARACTER(LEN=80), DIMENSION(6)   ::   clfile
       CHARACTER(LEN=70 )                ::   clunits            ! units attribute of time coordinate
       !!---------------------------------------------------------------------------
@@ -688,5 +794,5 @@
 
       !                                                !-------------------!
-      IF( kt == nit000 ) THEN                          !  First call only  !
+      IF( kt == nit000 .and. jit ==2 ) THEN            !  First call only  !
          !                                             !-------------------!
          istep_bt(:) = 0
@@ -712,20 +818,20 @@
                                                      ! necessary time dumps in file are included
 
-          clfile(1) = filbdy_data_bt_T
-          clfile(2) = filbdy_data_bt_U
-          clfile(3) = filbdy_data_bt_V
-
-          DO igrd = 1,3
+          clfile(4) = filbdy_data_bt_T
+          clfile(5) = filbdy_data_bt_U
+          clfile(6) = filbdy_data_bt_V
+
+          DO igrd = 4,6
 
             CALL iom_open( clfile(igrd), inum )
-            CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy, cdunits=clunits ) 
+            CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy_bt, cdunits=clunits ) 
 
             SELECT CASE( igrd )
-               CASE (1) 
-                  numbdyt = inum
-               CASE (2) 
-                  numbdyu = inum
-               CASE (3) 
-                  numbdyv = inum
+               CASE (4) 
+                  numbdyt_bt = inum
+               CASE (5) 
+                  numbdyu_bt = inum
+               CASE (6) 
+                  numbdyv_bt = inum
             END SELECT
 
@@ -757,5 +863,5 @@
 
             ! Check that time array increases (or interp will fail):
-            DO it = 2, ntimes_bdy
+            DO it = 2, ntimes_bdy_bt
                IF ( zstepr(it-1) >= zstepr(it) ) THEN
                   CALL ctl_stop('Time array in unstructured boundary data file', &
@@ -778,38 +884,30 @@
                ! The same applies to the last time level: see setting of lect below.
 
-               IF ( ntimes_bdy == 1 ) CALL ctl_stop( &
+               IF ( ntimes_bdy_bt == 1 ) CALL ctl_stop( &
                     'There is only one time dump in data files', &
                     'Set ln_bdy_clim=.true. in namelist for constant bdy forcing.' )
 
                zinterval_s = zstepr(2) - zstepr(1)
-               zinterval_e = zstepr(ntimes_bdy) - zstepr(ntimes_bdy-1)
-
-               IF ( zstepr(1) - zinterval_s / 2.0 > 0 ) THEN	          
-                  IF(lwp) WRITE(numout,*) 'First bdy time relative to nit000:', zstepr(1)
-                  IF(lwp) WRITE(numout,*) 'Interval between first two times: ', zinterval_s
-                  CALL ctl_stop( 'First data time is after start of run', & 
-                       'by more than half a meaning period', &
-                       'Check file: ' // TRIM(clfile(igrd)) )
+               zinterval_e = zstepr(ntimes_bdy_bt) - zstepr(ntimes_bdy_bt-1)
+
+               IF( zstepr(1) + zoffset > 0 ) THEN
+                     WRITE(ctmp1,*) 'Check file: ', clfile(igrd)
+                     CALL ctl_stop( 'First time dump in bdy file is after model initial time', ctmp1 )
                END IF
-
-               IF ( zstepr(ntimes_bdy) + zinterval_e / 2.0 < totime ) THEN
-                  IF(lwp) WRITE(numout,*) 'Last bdy time relative to nit000:', zstepr(ntimes_bdy)
-                  IF(lwp) WRITE(numout,*) 'Interval between last two times: ', zinterval_e
-                  CALL ctl_stop( 'Last data time is before end of run', & 
-                       'by more than half a meaning period', &
-                       'Check file: ' // TRIM(clfile(igrd))  )
+               IF( zstepr(ntimes_bdy_bt) + zoffset < totime ) THEN
+                     WRITE(ctmp1,*) 'Check file: ', clfile(igrd)
+                     CALL ctl_stop( 'Last time dump in bdy file is before model final time', ctmp1 )
                END IF
-
             END IF ! .NOT. ln_bdy_clim
 
-            IF ( igrd .EQ. 1) THEN
+            IF ( igrd .EQ. 4) THEN
               ntimes_bdyt = ntimes_bdy_bt
               zoffsett = zoffset
               istept(:) = INT( zstepr(:) + zoffset )
-            ELSE IF (igrd .EQ. 2) THEN
+            ELSE IF (igrd .EQ. 5) THEN
               ntimes_bdyu = ntimes_bdy_bt
               zoffsetu = zoffset
               istepu(:) = INT( zstepr(:) + zoffset )
-            ELSE IF (igrd .EQ. 3) THEN
+            ELSE IF (igrd .EQ. 6) THEN
               ntimes_bdyv = ntimes_bdy_bt
               zoffsetv = zoffset
@@ -865,6 +963,6 @@
           nbdy_b_bt = it
 
-          WRITE(numout,*) 'Time offset is ',zoffset
-          WRITE(numout,*) 'First record to read is ',nbdy_b_bt
+          IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset
+          IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b_bt
 
         ENDIF ! endif (nbdy_dta == 1)
@@ -875,15 +973,15 @@
         IF ( nbdy_dta == 0) THEN
           ! boundary data arrays are filled with initial conditions
-          igrd = 2            ! U-points data 
+          igrd = 5            ! U-points data 
           DO ib = 1, nblen(igrd)              
             ubtbdy(ib) = un(nbi(ib,igrd), nbj(ib,igrd), 1)
           END DO
 
-          igrd = 3            ! V-points data 
+          igrd = 6            ! V-points data 
           DO ib = 1, nblen(igrd)              
             vbtbdy(ib) = vn(nbi(ib,igrd), nbj(ib,igrd), 1)
           END DO
 
-          igrd = 1            ! T-points data 
+          igrd = 4            ! T-points data 
           DO ib = 1, nblen(igrd)              
             sshbdy(ib) = sshn(nbi(ib,igrd), nbj(ib,igrd))
@@ -910,9 +1008,9 @@
          ! Read first record:
           ipj=1
-          igrd=1
+          igrd=4
           ipi=nblendta(igrd)
 
           ! ssh
-          igrd=1
+          igrd=4
           IF ( nblendta(igrd) .le. 0 ) THEN 
             idvar = iom_varid( numbdyt_bt,'sossheig' )
@@ -929,5 +1027,5 @@
  
           ! u-velocity
-          igrd=2
+          igrd=5
           IF ( nblendta(igrd) .le. 0 ) THEN 
             idvar = iom_varid( numbdyu_bt,'vobtcrtx' )
@@ -944,5 +1042,5 @@
 
           ! v-velocity
-          igrd=3
+          igrd=6
           IF ( nblendta(igrd) .le. 0 ) THEN 
             idvar = iom_varid( numbdyv_bt,'vobtcrty' )
@@ -1010,10 +1108,10 @@
           ipj=1
           ipk=jpk
-          igrd=1
+          igrd=4
           ipi=nblendta(igrd)
 
           
           ! ssh
-          igrd=1
+          igrd=4
           ipi=nblendta(igrd)
 
@@ -1025,5 +1123,5 @@
 
           ! u-velocity
-          igrd=2
+          igrd=5
           ipi=nblendta(igrd)
 
@@ -1035,5 +1133,5 @@
 
           ! v-velocity
-          igrd=3
+          igrd=6
           ipi=nblendta(igrd)
 
@@ -1064,5 +1162,5 @@
         END IF
 
-          igrd=1
+          igrd=4
           DO ib=1, nblen(igrd)
             sshbdy(ib) = zxy      * sshbdydta(ib,2) + &
@@ -1070,5 +1168,5 @@
           END DO
 
-          igrd=2
+          igrd=5
           DO ib=1, nblen(igrd)
             ubtbdy(ib) = zxy      * ubtbdydta(ib,2) + &
@@ -1076,5 +1174,5 @@
           END DO
 
-          igrd=3
+          igrd=6
           DO ib=1, nblen(igrd)
             vbtbdy(ib) = zxy      * vbtbdydta(ib,2) + &
@@ -1090,5 +1188,5 @@
 
       ! Closing of the 3 files
-      IF( kt == nitend ) THEN
+      IF( kt == nitend   .and. jit == icycl ) THEN
           CALL iom_close( numbdyt_bt )
           CALL iom_close( numbdyu_bt )
@@ -1109,5 +1207,5 @@
       WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt
    END SUBROUTINE bdy_dta
-   SUBROUTINE bdy_dta_bt( kt, kit )      ! Empty routine
+   SUBROUTINE bdy_dta_bt( kt, kit, icycle )      ! Empty routine
       WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt, kit
    END SUBROUTINE bdy_dta_bt
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydyn.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 2236)
@@ -8,4 +8,6 @@
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
    !!            3.2  !  2008-04  (R. Benshila) consider velocity instead of transport 
+   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations 
+   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
    !!----------------------------------------------------------------------
 #if defined key_bdy 
@@ -34,9 +36,8 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -54,11 +55,11 @@
       INTEGER, INTENT( in ) ::   kt   ! Main time step counter
       !!
-      INTEGER  ::   ib, ik, igrd      ! dummy loop indices
-      INTEGER  ::   ii, ij            ! 2D addresses
-      REAL(wp) ::   zwgt              ! boundary weight
+      INTEGER  ::   jb, jk         ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
       !!----------------------------------------------------------------------
       !
-      IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing. 
-
+      IF(ln_bdy_dyn_frs) THEN       ! If this is false, then this routine does nothing. 
+         !
          IF( kt == nit000 ) THEN
             IF(lwp) WRITE(numout,*)
@@ -68,33 +69,37 @@
          !
          igrd = 2                      ! Relaxation of zonal velocity
-         DO ib = 1, nblen(igrd)
-            DO ik = 1, jpkm1
-               ii = nbi(ib,igrd)
-               ij = nbj(ib,igrd)
-               zwgt = nbw(ib,igrd)
-               ua(ii,ij,ik) = ( ua(ii,ij,ik) * ( 1.- zwgt ) + ubdy(ib,ik) * zwgt ) * umask(ii,ij,ik)
+         DO jb = 1, nblen(igrd)
+            DO jk = 1, jpkm1
+               ii   = nbi(jb,igrd)
+               ij   = nbj(jb,igrd)
+               zwgt = nbw(jb,igrd)
+               ua(ii,ij,jk) = ( ua(ii,ij,jk) * ( 1.- zwgt ) + ubdy(jb,jk) * zwgt ) * umask(ii,ij,jk)
             END DO
          END DO
          !
          igrd = 3                      ! Relaxation of meridional velocity
-         DO ib = 1, nblen(igrd)
-            DO ik = 1, jpkm1
-               ii = nbi(ib,igrd)
-               ij = nbj(ib,igrd)
-               zwgt = nbw(ib,igrd)
-               va(ii,ij,ik) = ( va(ii,ij,ik) * ( 1.- zwgt ) + vbdy(ib,ik) * zwgt ) * vmask(ii,ij,ik)
+         DO jb = 1, nblen(igrd)
+            DO jk = 1, jpkm1
+               ii   = nbi(jb,igrd)
+               ij   = nbj(jb,igrd)
+               zwgt = nbw(jb,igrd)
+               va(ii,ij,jk) = ( va(ii,ij,jk) * ( 1.- zwgt ) + vbdy(jb,jk) * zwgt ) * vmask(ii,ij,jk)
             END DO
          END DO 
-         !
-         CALL lbc_lnk( ua, 'U', -1. )   ! Boundary points should be updated
-         CALL lbc_lnk( va, 'V', -1. )   !
+         CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated
          !
       ENDIF ! ln_bdy_dyn_frs
-
+      !
    END SUBROUTINE bdy_dyn_frs
 
 
-#if defined key_dynspg_exp || defined key_dynspg_ts
+# if defined   key_dynspg_exp   ||   defined key_dynspg_ts
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_exp'        OR              explicit sea surface height
+   !!   'key_dynspg_ts '                  split-explicit sea surface height
+   !!----------------------------------------------------------------------
+   
 !! Option to use Flather with dynspg_flt not coded yet...
+
    SUBROUTINE bdy_dyn_fla( pssh )
       !!----------------------------------------------------------------------
@@ -119,5 +124,5 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh
 
-      INTEGER  ::   ib, igrd                         ! dummy loop indices
+      INTEGER  ::   jb, igrd                         ! dummy loop indices
       INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses
       REAL(wp) ::   zcorr                            ! Flather correction
@@ -132,39 +137,41 @@
 
          ! Fill temporary array with ssh data (here spgu):
-         igrd = 1
+         igrd = 4
          spgu(:,:) = 0.0
-         DO ib = 1, nblenrim(igrd)
-            ii = nbi(ib,igrd)
-            ij = nbj(ib,igrd)
-            IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy(ib)
-            IF( ln_bdy_tides )   spgu(ii, ij) = spgu(ii, ij) + sshtide(ib)
+         DO jb = 1, nblenrim(igrd)
+            ii = nbi(jb,igrd)
+            ij = nbj(jb,igrd)
+            IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy(jb)
+            IF( ln_bdy_tides )   spgu(ii, ij) = spgu(ii, ij) + sshtide(jb)
          END DO
          !
-         igrd = 2      ! Flather bc on u-velocity; 
+         igrd = 5      ! Flather bc on u-velocity; 
          !             ! remember that flagu=-1 if normal velocity direction is outward
          !             ! I think we should rather use after ssh ?
-         DO ib = 1, nblenrim(igrd)
-            ii  = nbi(ib,igrd)
-            ij  = nbj(ib,igrd) 
-            iim1 = ii + MAX( 0, INT( flagu(ib) ) )   ! T pts i-indice inside the boundary
-            iip1 = ii - MIN( 0, INT( flagu(ib) ) )   ! T pts i-indice outside the boundary 
+         DO jb = 1, nblenrim(igrd)
+            ii  = nbi(jb,igrd)
+            ij  = nbj(jb,igrd) 
+            iim1 = ii + MAX( 0, INT( flagu(jb) ) )   ! T pts i-indice inside the boundary
+            iip1 = ii - MIN( 0, INT( flagu(jb) ) )   ! T pts i-indice outside the boundary 
             !
-            zcorr = - flagu(ib) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
-            zforc = ubtbdy(ib) + utide(ib)
+            zcorr = - flagu(jb) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
+            zforc = ubtbdy(jb) + utide(jb)
             ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1) 
          END DO
          !
-         igrd = 3      ! Flather bc on v-velocity
+         igrd = 6      ! Flather bc on v-velocity
          !             ! remember that flagv=-1 if normal velocity direction is outward
-         DO ib = 1, nblenrim(igrd)
-            ii  = nbi(ib,igrd)
-            ij  = nbj(ib,igrd) 
-            ijm1 = ij + MAX( 0, INT( flagv(ib) ) )   ! T pts j-indice inside the boundary
-            ijp1 = ij - MIN( 0, INT( flagv(ib) ) )   ! T pts j-indice outside the boundary 
+         DO jb = 1, nblenrim(igrd)
+            ii  = nbi(jb,igrd)
+            ij  = nbj(jb,igrd) 
+            ijm1 = ij + MAX( 0, INT( flagv(jb) ) )   ! T pts j-indice inside the boundary
+            ijp1 = ij - MIN( 0, INT( flagv(jb) ) )   ! T pts j-indice outside the boundary 
             !
-            zcorr = - flagv(ib) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
-            zforc = vbtbdy(ib) + vtide(ib)
+            zcorr = - flagv(jb) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
+            zforc = vbtbdy(jb) + vtide(jb)
             va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1)
          END DO
+         CALL lbc_lnk( ua_e, 'U', -1. )   ! Boundary points should be updated
+         CALL lbc_lnk( va_e, 'V', -1. )   !
          !
       ENDIF ! ln_bdy_dyn_fla .or. ln_bdy_tides
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyice.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyice.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyice.F90	(revision 2236)
@@ -0,0 +1,83 @@
+MODULE bdyice
+   !!======================================================================
+   !!                       ***  MODULE  bdyice  ***
+   !! Unstructured Open Boundary Cond. :  Flow Relaxation Scheme applied sea-ice
+   !!======================================================================
+   !!  History :  3.3  !  2010-09 (D. Storkey)  Original code
+   !!----------------------------------------------------------------------
+#if defined   key_bdy   &&   defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_bdy'            and                 Unstructured Open Boundary Conditions
+   !!   'key_lim2'                                                 LIM-2 sea ice model
+   !!----------------------------------------------------------------------
+   !!   bdy_ice        : Relaxation of tracers on unstructured open boundaries
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE ice_2           ! LIM_2 ice variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE bdy_oce         ! ocean open boundary conditions
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! write to numout file
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_ice    ! routine called in sbcmod
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_ice( kt )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_ice  ***
+      !!                    
+      !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 
+      !!              of unstructured open boundaries. Currently only tested for LIM2.
+      !! 
+      !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three-
+      !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382.
+      !!------------------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! model time step index
+      !!
+      INTEGER  ::   jb, jk, jgrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! local scalar
+      REAL(wp) ::   zwgt, zwgt1    ! local scalar
+      !!------------------------------------------------------------------------------
+      !
+      jgrd = 1      ! Everything is at T-points here
+      !
+      IF( ln_bdy_ice_frs ) THEN     ! update ice fields by relaxation at the boundary
+         DO jb = 1, nblen(jgrd)
+            DO jk = 1, jpkm1
+               ii    = nbi(jb,jgrd)
+               ij    = nbj(jb,jgrd)
+               zwgt  = nbw(jb,jgrd)
+               zwgt1 = 1.e0 - nbw(jb,jgrd)
+               frld (ii,ij) = ( frld (ii,ij) * zwgt1 + frld_bdy (jb) * zwgt ) * tmask(ii,ij,1)     ! Leads fraction 
+               hicif(ii,ij) = ( hicif(ii,ij) * zwgt1 + hicif_bdy(jb) * zwgt ) * tmask(ii,ij,1)     ! Ice depth 
+               hsnif(ii,ij) = ( hsnif(ii,ij) * zwgt1 + hsnif_bdy(jb) * zwgt ) * tmask(ii,ij,1)     ! Snow depth
+            END DO
+         END DO 
+         CALL lbc_lnk( frld, 'T', 1. )                                         ! lateral boundary conditions
+         CALL lbc_lnk( hicif, 'T', 1. )   ;   CALL lbc_lnk( hsnif, 'T', 1. )
+         !
+      ELSE                          ! we have called this routine without ln_bdy_ice_frs not set
+         IF( kt == nit000 )   CALL ctl_warn( 'E R R O R (possible) called bdy_ice when ln_bdy_ice_frs is false?' )
+      ENDIF
+      !      
+   END SUBROUTINE bdy_ice
+#else
+   !!---------------------------------------------------------------------------------
+   !!   Default option                                                    Empty module
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_ice( kt )      ! Empty routine
+      WRITE(*,*) 'bdy_ice: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_ice
+#endif
+
+   !!=================================================================================
+END MODULE bdyice
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 2236)
@@ -8,4 +8,6 @@
    !!             -   !  2007-01  (D. Storkey) Tidal forcing
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.3  !  2010-09  (E.O'Dea) updates for Shelf configurations
+   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
    !!----------------------------------------------------------------------
 #if defined key_bdy
@@ -17,4 +19,5 @@
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain
+   USE obc_par         ! ocean open boundary conditions
    USE bdy_oce         ! unstructured open boundary conditions
    USE bdytides        ! tides at open boundaries initialization (tide_init routine)
@@ -30,9 +33,8 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!---------------------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
    
@@ -48,5 +50,4 @@
       !!
       !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries
-      !!
       !!----------------------------------------------------------------------      
       INTEGER ::   ii, ij, ik, igrd, ib, ir   ! dummy loop indices
@@ -54,6 +55,6 @@
       INTEGER ::   ib_len, ibr_max
       INTEGER ::   iw, ie, is, in 
-      INTEGER ::   inum                 ! temporary logical unit
-      INTEGER ::   id_dummy             ! temporary integers
+      INTEGER ::   inum                 ! local logical unit
+      INTEGER ::   id_dummy             ! local integers
       INTEGER ::   igrd_start, igrd_end ! start and end of loops on igrd
       INTEGER, DIMENSION (2)             ::   kdimsz
@@ -63,10 +64,11 @@
       REAL(wp) , DIMENSION(jpidta,jpjdta) ::   zmask           ! global domain mask
       REAL(wp) , DIMENSION(jpbdta,1)      ::   zdta            ! temporary array 
-      CHARACTER(LEN=80),DIMENSION(3)      ::   clfile
+      CHARACTER(LEN=80),DIMENSION(6)      ::   clfile
       !!
       NAMELIST/nambdy/filbdy_mask, filbdy_data_T, filbdy_data_U, filbdy_data_V,          &
+         &            filbdy_data_bt_T, filbdy_data_bt_U, filbdy_data_bt_V,              &
          &            ln_bdy_tides, ln_bdy_clim, ln_bdy_vol, ln_bdy_mask,                &
-         &            ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs,                    &
-         &            nbdy_dta   , nb_rimwidth  , volbdy
+         &            ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs,ln_bdy_ice_frs,     &
+         &            nbdy_dta, nb_rimwidth, volbdy
       !!----------------------------------------------------------------------
 
@@ -75,80 +77,71 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~'
       !
-      IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,',   &
-           ' and unstructured open boundary condition are not compatible' )
-
-#if defined key_obc
-      CALL ctl_stop( 'Straight open boundaries,',   &
-           ' and unstructured open boundaries are not compatible' )
-#endif
-
-      ! Read namelist parameters
+      IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   &
+         &                               ' and unstructured open boundary condition are not compatible' )
+
+      IF( lk_obc      )   CALL ctl_stop( 'Straight open boundaries,',   &
+         &                               ' and unstructured open boundaries are not compatible' )
+
       ! ---------------------------
-      REWIND( numnam )
+      REWIND( numnam )                    ! Read namelist parameters
       READ  ( numnam, nambdy )
 
-      ! control prints
+      !                                   ! control prints
       IF(lwp) WRITE(numout,*) '         nambdy'
 
-      ! Check nbdy_dta value
+      !                                         ! check type of data used (nbdy_dta value)
       IF(lwp) WRITE(numout,*) 'nbdy_dta =', nbdy_dta      
-      IF(lwp) WRITE(numout,*) ' '
-      SELECT CASE( nbdy_dta )
-      CASE( 0 )
-        IF(lwp) WRITE(numout,*) '         initial state used for bdy data'        
-      CASE( 1 )
-        IF(lwp) WRITE(numout,*) '         boundary data taken from file'
-      CASE DEFAULT
-        CALL ctl_stop( 'nbdy_dta must be 0 or 1' )
+      IF(lwp) WRITE(numout,*)
+      SELECT CASE( nbdy_dta )                   ! 
+      CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'        
+      CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file'
+      CASE DEFAULT   ;   CALL ctl_stop( 'nbdy_dta must be 0 or 1' )
       END SELECT
 
-      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nb_rimwidth = ', nb_rimwidth
 
-      IF(lwp) WRITE(numout,*) ' '
-      IF(lwp) WRITE(numout,*) '         volbdy = ', volbdy
-
-      IF (ln_bdy_vol) THEN
-        SELECT CASE ( volbdy ) ! Check volbdy value
-        CASE( 1 )
-          IF(lwp) WRITE(numout,*) '         The total volume will be constant'
-        CASE( 0 )
-          IF(lwp) WRITE(numout,*) '         The total volume will vary according'
-          IF(lwp) WRITE(numout,*) '         to the surface E-P flux'
-        CASE DEFAULT
-          CALL ctl_stop( 'volbdy must be 0 or 1' )
-        END SELECT
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '      volbdy = ', volbdy
+
+      IF( ln_bdy_vol ) THEN                     ! check volume conservation (volbdy value)
+         SELECT CASE ( volbdy )
+         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will be constant'
+         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will vary according to the surface E-P flux'
+         CASE DEFAULT   ;   CALL ctl_stop( 'volbdy must be 0 or 1' )
+         END SELECT
+         IF(lwp) WRITE(numout,*)
       ELSE
-        IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      IF (ln_bdy_tides) THEN
-        IF(lwp) WRITE(numout,*) ' '
+         IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries'
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_bdy_tides ) THEN
         IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      IF (ln_bdy_dyn_fla) THEN
-        IF(lwp) WRITE(numout,*) ' '
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_bdy_dyn_fla ) THEN
         IF(lwp) WRITE(numout,*) 'Flather condition on U, V at unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      IF (ln_bdy_dyn_frs) THEN
-        IF(lwp) WRITE(numout,*) ' '
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_bdy_dyn_frs ) THEN
         IF(lwp) WRITE(numout,*) 'FRS condition on U and V at unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      IF (ln_bdy_tra_frs) THEN
-        IF(lwp) WRITE(numout,*) ' '
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_bdy_tra_frs ) THEN
         IF(lwp) WRITE(numout,*) 'FRS condition on T & S fields at unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      ! Read tides namelist 
-      ! ------------------------
-      IF( ln_bdy_tides )   CALL tide_init
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_bdy_ice_frs ) THEN
+        IF(lwp) WRITE(numout,*) 'FRS condition on ice fields at unstructured open boundaries'
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_bdy_tides )   CALL tide_init      ! Read tides namelist 
+
 
       ! Read arrays defining unstructured open boundaries
@@ -160,8 +153,8 @@
       !          = 0  elsewhere   
  
-      IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN
+      IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN          ! EEL configuration at 5km resolution
          zmask(         :                ,:) = 0.e0
          zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0          
-      ELSE IF ( ln_bdy_mask ) THEN
+      ELSE IF( ln_bdy_mask ) THEN
          CALL iom_open( filbdy_mask, inum )
          CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) )
@@ -171,6 +164,5 @@
       ENDIF
 
-      ! Save mask over local domain      
-      DO ij = 1, nlcj
+      DO ij = 1, nlcj      ! Save mask over local domain      
          DO ii = 1, nlci
             bdytmask(ii,ij) = zmask( mig(ii), mjg(ij) )
@@ -187,8 +179,6 @@
          END DO
       END DO
-
-      ! Lateral boundary conditions
-      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )
-      CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )
+      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond.
+
 
       ! Read discrete distance and mapping indices
@@ -200,18 +190,16 @@
       IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN
          icount = 0
-         ! Define west boundary (from ii=2 to ii=1+nb_rimwidth):
-         DO ir = 1, nb_rimwidth         
+         DO ir = 1, nb_rimwidth                  ! Define west boundary (from ii=2 to ii=1+nb_rimwidth):
             DO ij = 3, jpjglo-2
-               icount=icount+1
+               icount = icount + 1
                nbidta(icount,:) = ir + 1 + (jpizoom-1)
-               nbjdta(icount,:) = ij + (jpjzoom-1) 
+               nbjdta(icount,:) = ij     + (jpjzoom-1) 
                nbrdta(icount,:) = ir
             END DO
          END DO
-
-         ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth):
-         DO ir=1,nb_rimwidth         
+         !
+         DO ir = 1, nb_rimwidth                  ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth):
             DO ij=3,jpjglo-2
-               icount=icount+1
+               icount = icount + 1
                nbidta(icount,:) = jpiglo-ir + (jpizoom-1)
                nbidta(icount,2) = jpiglo-ir-1 + (jpizoom-1) ! special case for u points
@@ -220,30 +208,42 @@
             END DO
          END DO
-            
+         !       
       ELSE            ! Read indices and distances in unstructured boundary data files 
-
-         IF( ln_bdy_tides ) THEN 
-            ! Read tides input files for preference in case there are
-            ! no bdydata files. 
-            clfile(1) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc'
-            clfile(2) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc'
-            clfile(3) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc'
-         ELSE
+         !
+         IF( ln_bdy_tides ) THEN             ! Read tides input files for preference in case there are no bdydata files
+            clfile(4) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc'
+            clfile(5) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc'
+            clfile(6) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc'
+         ENDIF
+         IF( ln_bdy_dyn_fla .AND. .NOT. ln_bdy_tides ) THEN 
+            clfile(4) = filbdy_data_bt_T
+            clfile(5) = filbdy_data_bt_U
+            clfile(6) = filbdy_data_bt_V
+         ENDIF
+
+         IF( ln_bdy_tra_frs ) THEN 
             clfile(1) = filbdy_data_T
+            IF( .NOT. ln_bdy_dyn_frs ) THEN 
+               clfile(2) = filbdy_data_T     ! Dummy read re read T file for sake of 6 files
+               clfile(3) = filbdy_data_T     !
+            ENDIF
+         ENDIF          
+         IF( ln_bdy_dyn_frs ) THEN 
+            IF( .NOT. ln_bdy_tra_frs )   clfile(1) = filbdy_data_U      ! Dummy Read 
             clfile(2) = filbdy_data_U
-            clfile(3) = filbdy_data_V
-         ENDIF          
-
-         ! how many files are we to read in?
-         igrd_start = 1
-         igrd_end   = 3
-         IF(.NOT. ln_bdy_tides ) THEN
-            IF(.NOT. (ln_bdy_dyn_fla) .AND..NOT. (ln_bdy_tra_frs)) THEN
-               ! No T-grid file.
-               igrd_start = 2
-            ELSEIF ( .NOT. ln_bdy_dyn_frs .AND..NOT. ln_bdy_dyn_fla ) THEN
-               ! No U-grid or V-grid file.
-               igrd_end   = 1         
-            ENDIF
+            clfile(3) = filbdy_data_V 
+         ENDIF
+
+         !                                   ! how many files are we to read in?
+         IF(ln_bdy_tides .OR. ln_bdy_dyn_fla)   igrd_start = 4
+         !
+         IF(ln_bdy_tra_frs    ) THEN   ;   igrd_start = 1
+         ELSEIF(ln_bdy_dyn_frs) THEN   ;   igrd_start = 2
+         ENDIF
+         !
+         IF( ln_bdy_tra_frs   )   igrd_end = 1
+         !
+         IF(ln_bdy_dyn_fla .OR. ln_bdy_tides) THEN   ;   igrd_end = 6
+         ELSEIF( ln_bdy_dyn_frs             ) THEN   ;   igrd_end = 3
          ENDIF
 
@@ -251,10 +251,8 @@
             CALL iom_open( clfile(igrd), inum )
             id_dummy = iom_varid( inum, 'nbidta', kdimsz=kdimsz )  
-            WRITE(numout,*) 'kdimsz : ',kdimsz
+            IF(lwp) WRITE(numout,*) 'kdimsz : ',kdimsz
             ib_len = kdimsz(1)
-            IF( ib_len > jpbdta) CALL ctl_stop(          &
-                'Boundary data array in file too long.', &
-                'File :', TRIM(clfile(igrd)),            &
-                'increase parameter jpbdta.' )
+            IF( ib_len > jpbdta)   CALL ctl_stop(  'Boundary data array in file too long.',                  &
+                &                                  'File :', TRIM(clfile(igrd)),'increase parameter jpbdta.' )
 
             CALL iom_get( inum, jpdom_unknown, 'nbidta', zdta(1:ib_len,:) )
@@ -264,19 +262,19 @@
             CALL iom_get( inum, jpdom_unknown, 'nbjdta', zdta(1:ib_len,:) )
             DO ii = 1,ib_len
-              nbjdta(ii,igrd) = INT( zdta(ii,1) )
-            END DO
-            CALL iom_get ( inum, jpdom_unknown, 'nbrdta', zdta(1:ib_len,:) )
+               nbjdta(ii,igrd) = INT( zdta(ii,1) )
+            END DO
+            CALL iom_get( inum, jpdom_unknown, 'nbrdta', zdta(1:ib_len,:) )
             DO ii = 1,ib_len
-              nbrdta(ii,igrd) = INT( zdta(ii,1) )
+               nbrdta(ii,igrd) = INT( zdta(ii,1) )
             END DO
             CALL iom_close( inum )
 
-            ! Check that rimwidth in file is big enough:
-            ibr_max = MAXVAL( nbrdta(:,igrd) )
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max
-            IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth
-            IF (ibr_max < nb_rimwidth) CALL ctl_stop( &
-                'nb_rimwidth is larger than maximum rimwidth in file' )
+            IF( igrd < 4) THEN            ! Check that rimwidth in file is big enough for Frs case(barotropic is one):
+               ibr_max = MAXVAL( nbrdta(:,igrd) )
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max
+               IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth
+               IF (ibr_max < nb_rimwidth)   CALL ctl_stop( 'nb_rimwidth is larger than maximum rimwidth in file' )
+            ENDIF !Check igrd < 4
             !
          END DO
@@ -293,19 +291,19 @@
 
       DO igrd = igrd_start, igrd_end
-        icount  = 0
-        icountr = 0
-        nblen(igrd) = 0
-        nblenrim(igrd) = 0
-        nblendta(igrd) = 0
-        DO ir=1, nb_rimwidth
-          DO ib = 1, jpbdta
-          ! check if point is in local domain and equals ir
-            IF(  nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND.   &
-               & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND.   &
-               & nbrdta(ib,igrd) == ir  ) THEN
-               !
-               icount = icount  + 1
-               !
-               IF( ir == 1 )   icountr = icountr+1
+         icount  = 0
+         icountr = 0
+         nblen   (igrd) = 0
+         nblenrim(igrd) = 0
+         nblendta(igrd) = 0
+         DO ir=1, nb_rimwidth
+            DO ib = 1, jpbdta
+               ! check if point is in local domain and equals ir
+               IF(  nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND.   &
+                  & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND.   &
+                  & nbrdta(ib,igrd) == ir  ) THEN
+                  !
+                  icount = icount  + 1
+                  !
+                  IF( ir == 1 )   icountr = icountr+1
                   IF (icount > jpbdim) THEN
                      IF(lwp) WRITE(numout,*) 'bdy_ini: jpbdim too small'
@@ -328,10 +326,7 @@
       DO igrd = igrd_start, igrd_end
          DO ib = 1, nblen(igrd)
-            ! tanh formulation
-            nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 )
-            ! quadratic
-!           nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2
-            ! linear
-!           nbw(ib,igrd) =  FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth)
+            nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 )                     ! tanh formulation
+!           nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2      ! quadratic
+!           nbw(ib,igrd) =  FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth)          ! linear
          END DO
       END DO 
@@ -384,8 +379,6 @@
 
       ! Lateral boundary conditions
-      CALL lbc_lnk( fmask        , 'F', 1. )
-      CALL lbc_lnk( bdytmask(:,:), 'T', 1. )
-      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )
-      CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )
+      CALL lbc_lnk( fmask        , 'F', 1. )   ;   CALL lbc_lnk( bdytmask(:,:), 'T', 1. )
+      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )
 
       IF( ln_bdy_vol .OR. ln_bdy_dyn_fla ) THEN      ! Indices and directions of rim velocity components
@@ -437,5 +430,4 @@
       ! Compute total lateral surface for volume correction:
       ! ----------------------------------------------------
- 
       bdysurftot = 0.e0 
       IF( ln_bdy_vol ) THEN  
@@ -455,5 +447,5 @@
                &                    * tmask_i(nbi(ib,igrd),nbj(ib,igrd)+1)
          END DO
-
+         !
          IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain
       END IF   
@@ -468,4 +460,9 @@
       ubtbdy(:) = 0.e0
       vbtbdy(:) = 0.e0
+#if defined key_lim2
+      frld_bdy(:) = 0.e0
+      hicif_bdy(:) = 0.e0
+      hsnif_bdy(:) = 0.e0
+#endif
 
       ! Read in tidal constituents and adjust for model start time
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 2236)
@@ -7,4 +7,5 @@
    !!            2.3  !  2008-01  (J.Holt)  Add date correction. Origins POLCOMS v6.3 2007
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.3  !  2010-09  (D.Storkey and E.O'Dea)  bug fixes
    !!----------------------------------------------------------------------
 #if defined key_bdy
@@ -31,4 +32,5 @@
    USE bdy_par         ! Unstructured boundary parameters
    USE bdy_oce         ! ocean open boundary conditions
+   USE daymod          ! calendar
 
    IMPLICIT NONE
@@ -39,25 +41,23 @@
    PUBLIC   tide_update   ! routine called in bdydyn
 
-   LOGICAL, PUBLIC            ::   ln_tide_date            !: =T correct tide phases and amplitude for model start date
-
-   INTEGER, PARAMETER ::   jptides_max = 15      !: Max number of tidal contituents
-   INTEGER            ::   ntide                 !: Actual number of tidal constituents
+   LOGICAL, PUBLIC            ::   ln_tide_date          !: =T correct tide phases and amplitude for model start date
+   INTEGER, PUBLIC, PARAMETER ::   jptides_max = 15      !: Max number of tidal contituents
+   INTEGER, PUBLIC            ::   ntide                 !: Actual number of tidal constituents
 
    CHARACTER(len=80), PUBLIC                         ::   filtide    !: Filename root for tidal input files
    CHARACTER(len= 4), PUBLIC, DIMENSION(jptides_max) ::   tide_cpt   !: Names of tidal components used.
 
-   INTEGER , DIMENSION(jptides_max) ::   nindx        !: ???
-   REAL(wp), DIMENSION(jptides_max) ::   tide_speed   !: Phase speed of tidal constituent (deg/hr)
+   INTEGER , PUBLIC, DIMENSION(jptides_max) ::   nindx        !: ???
+   REAL(wp), PUBLIC, DIMENSION(jptides_max) ::   tide_speed   !: Phase speed of tidal constituent (deg/hr)
    
-   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   ssh1, ssh2   !: Tidal constituents : SSH
-   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   u1  , u2     !: Tidal constituents : U
-   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   v1  , v2     !: Tidal constituents : V
+   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   ssh1, ssh2   ! Tidal constituents : SSH
+   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   u1  , u2     ! Tidal constituents : U
+   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   v1  , v2     ! Tidal constituents : V
    
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -87,9 +87,11 @@
       !                                               ! Count number of components specified
       ntide = jptides_max
-      itide = 1
-      DO WHILE( tide_cpt(itide) /= '' )
-         ntide = itide
-         itide = itide + 1
+      DO itide = 1, jptides_max
+        IF( tide_cpt(itide) == '' ) THEN
+           ntide = itide-1
+           exit
+        ENDIF
       END DO
+
       !                                               ! find constituents in standard list
       DO itide = 1, ntide
@@ -145,5 +147,5 @@
       CHARACTER(len=80) :: clfile         ! full file name for tidal input file 
       INTEGER ::   ipi, ipj, inum, idvar  ! temporary integers (netcdf read)
-      INTEGER, DIMENSION(3) :: lendta=0   ! length of data in the file (note may be different from nblendta!)
+      INTEGER, DIMENSION(6) :: lendta=0   ! length of data in the file (note may be different from nblendta!)
       REAL(wp) ::  z_arg, z_atde, z_btde, z1t, z2t           
       REAL(wp), DIMENSION(jpbdta,1) ::   zdta   ! temporary array for data fields
@@ -161,5 +163,5 @@
          IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
          CALL iom_open( clfile, inum )
-         igrd = 1
+         igrd = 4
          IF( nblendta(igrd) <= 0 ) THEN 
             idvar = iom_varid( inum,'z1' )
@@ -183,5 +185,5 @@
          IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
          CALL iom_open( clfile, inum )
-         igrd = 2
+         igrd = 5
          IF( lendta(igrd) <= 0 ) THEN 
             idvar = iom_varid( inum,'u1' )
@@ -204,5 +206,5 @@
          if(lwp) write(numout,*) 'Reading data from file ', clfile
          CALL iom_open( clfile, inum )
-         igrd = 3
+         igrd = 6
          IF( lendta(igrd) <= 0 ) THEN 
             idvar = iom_varid( inum,'v1' )
@@ -252,5 +254,5 @@
             ENDIF
             !                                         !  elevation         
-            igrd = 1
+            igrd = 4
             DO ib = 1, nblenrim(igrd)                
                z1t = z_atde * ssh1(ib,itide) + z_btde * ssh2(ib,itide)
@@ -260,5 +262,5 @@
             END DO
             !                                         !  u       
-            igrd = 2
+            igrd = 5
             DO ib = 1, nblenrim(igrd)                
                z1t = z_atde * u1(ib,itide) + z_btde * u2(ib,itide)
@@ -268,5 +270,5 @@
             END DO
             !                                         !  v       
-            igrd = 3
+            igrd = 6
             DO ib = 1, nblenrim(igrd)                
                z1t = z_atde * v1(ib,itide) + z_btde * v2(ib,itide)
@@ -320,15 +322,15 @@
       !
       DO itide = 1, ntide
-         igrd=1                              ! SSH on tracer grid.
+         igrd=4                              ! SSH on tracer grid.
          DO ib = 1, nblenrim(igrd)
             sshtide(ib) =sshtide(ib)+ ssh1(ib,itide)*z_cost(itide) + ssh2(ib,itide)*z_sist(itide)
             !    if(lwp) write(numout,*) 'z',ib,itide,sshtide(ib), ssh1(ib,itide),ssh2(ib,itide)
          END DO
-         igrd=2                              ! U grid
+         igrd=5                              ! U grid
          DO ib=1, nblenrim(igrd)
             utide(ib) = utide(ib)+ u1(ib,itide)*z_cost(itide) + u2(ib,itide)*z_sist(itide)
             !    if(lwp) write(numout,*) 'u',ib,itide,utide(ib), u1(ib,itide),u2(ib,itide)
          END DO
-         igrd=3                              ! V grid
+         igrd=6                              ! V grid
          DO ib=1, nblenrim(igrd)
             vtide(ib) = vtide(ib)+ v1(ib,itide)*z_cost(itide) + v2(ib,itide)*z_sist(itide)
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytra.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 2236)
@@ -25,9 +25,8 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -48,28 +47,27 @@
       !!----------------------------------------------------------------------
       !
-      IF(ln_bdy_tra_frs) THEN ! If this is false, then this routine does nothing. 
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'bdy_tra : Flow Relaxation Scheme for tracers'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-      ENDIF
+      IF(ln_bdy_tra_frs) THEN       ! If this is false, then this routine does nothing. 
+         !
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'bdy_tra : Flow Relaxation Scheme for tracers'
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
+         !
+         igrd = 1                       ! Everything is at T-points here
+         DO ib = 1, nblen(igrd)
+            DO ik = 1, jpkm1
+               ii = nbi(ib,igrd)
+               ij = nbj(ib,igrd)
+               zwgt = nbw(ib,igrd)
+               ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)         
+               sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)
+            END DO
+         END DO 
+         !
+         CALL lbc_lnk( ta, 'T', 1. )   ; CALL lbc_lnk( sa, 'T', 1. )    ! Boundary points should be updated
+         !
+      ENDIF ! ln_bdy_tra_frs
       !
-      igrd = 1                       ! Everything is at T-points here
-      DO ib = 1, nblen(igrd)
-         DO ik = 1, jpkm1
-            ii = nbi(ib,igrd)
-            ij = nbj(ib,igrd)
-            zwgt = nbw(ib,igrd)
-            ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)         
-            sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)
-        END DO
-      END DO 
-      !
-      CALL lbc_lnk( ta, 'T', 1. )   ! Boundary points should be updated
-      CALL lbc_lnk( sa, 'T', 1. )   !
-      !
-      ENDIF ! ln_bdy_tra_frs
-
    END SUBROUTINE bdy_tra
    
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 2236)
@@ -11,5 +11,5 @@
 #if   defined key_bdy   &&   defined key_dynspg_flt
    !!----------------------------------------------------------------------
-   !!   'key_bdy'            and      unstructured open boundary conditions
+   !!   'key_bdy'            AND      unstructured open boundary conditions
    !!   'key_dynspg_flt'                              filtered free surface
    !!----------------------------------------------------------------------
@@ -30,9 +30,8 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -73,5 +72,5 @@
       INTEGER  ::   ji, jj, jk, jb, jgrd
       INTEGER  ::   ii, ij
-      REAL(wp) ::   zubtpecor, z_cflxemp, ztranst, zraur
+      REAL(wp) ::   zubtpecor, z_cflxemp, ztranst
       !!-----------------------------------------------------------------------------
 
@@ -84,11 +83,9 @@
       ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
       ! -----------------------------------------------------------------------
-      z_cflxemp = 0.e0
-      zraur = 1.e0 / rau0
-      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) * zraur ) 
-      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )   ! sum over the global domain
+      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
+      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
 
-      ! Barotropic velocity through the unstructured open boundary
-      ! ----------------------------------------------------------
+      ! Transport through the unstructured open boundary
+      ! ------------------------------------------------
       zubtpecor = 0.e0
       jgrd = 2                               ! cumulate u component contribution first 
@@ -112,6 +109,6 @@
       ! The normal velocity correction
       ! ------------------------------
-      IF (volbdy==1) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 
-      ELSE                  ;   zubtpecor =   zubtpecor             / bdysurftot
+      IF( volbdy==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 
+      ELSE                   ;   zubtpecor =   zubtpecor             / bdysurftot
       END IF
 
@@ -141,5 +138,4 @@
       ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected
       ! ------------------------------------------------------
-
       IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
          IF(lwp) WRITE(numout,*)
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diaar5.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 2236)
@@ -39,5 +39,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diafwb.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 2236)
@@ -40,5 +40,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diagap.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diagap.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diagap.F90	(revision 2236)
@@ -47,5 +47,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diahth.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diahth.F90	(revision 2236)
@@ -44,5 +44,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diaptr.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 2236)
@@ -102,5 +102,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diawri.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DIA/diawri.F90	(revision 2236)
@@ -30,4 +30,7 @@
    USE limwri_2 
 #endif
+   USE dtatem
+   USE dtasal
+
    IMPLICIT NONE
    PRIVATE
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/closea.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/closea.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/closea.F90	(revision 2236)
@@ -46,5 +46,5 @@
    !!  OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/daymod.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/daymod.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/daymod.F90	(revision 2236)
@@ -45,5 +45,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -67,4 +67,7 @@
       !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
       !!----------------------------------------------------------------------
+      INTEGER :: inbday, irest
+      REAL(wp) :: zjul
+      !!----------------------------------------------------------------------
 
       ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
@@ -105,13 +108,23 @@
       ! day since january 1st
       nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
-      
+
+      !compute number of days between last monday and today      
+      IF( nn_leapy==1 )THEN
+         CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (monday)
+         inbday = INT(fjulday) - NINT(zjul)       ! compute nb day between  01.01.1900 and current day fjulday 
+         irest = MOD(inbday,7)                    ! compute nb day between last monday and current day fjulday 
+         IF(irest==0 )irest = 7 
+      ENDIF
+
       ! number of seconds since the beginning of current year/month at the middle of the time-step
       nsec_year  = nday_year * nsecd - ndt05   ! 1 time step before the middle of the first time step
       nsec_month = nday      * nsecd - ndt05   ! because day will be called at the beginning of step
       nsec_day   =             nsecd - ndt05
+      nsec_week  = 0
+      IF( nn_leapy==1 ) nsec_week  = irest     * nsecd - ndt05
 
       ! control print
       IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
-           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day
+           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week
 
       ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
@@ -200,4 +213,5 @@
       nsec_year  = nsec_year  + ndt 
       nsec_month = nsec_month + ndt                 
+      IF( nn_leapy==1 ) nsec_week  = nsec_week  + ndt
       nsec_day   = nsec_day   + ndt                
       adatrj  = adatrj  + rdttra(1) / rday
@@ -228,9 +242,14 @@
          ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date
          !
+         !compute first day of the year in julian days
+         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )
+         !
          IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
               &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
          IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
-              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day
-      ENDIF
+              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
+      ENDIF
+
+      IF( nsec_week .GT. 7*86400 ) nsec_week = ndt05
       
       IF(ln_ctl) THEN
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 2236)
@@ -9,5 +9,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
    USE par_oce      ! ocean parameters
@@ -197,15 +197,17 @@
    !! calendar variables
    !! ---------------------------------------------------------------------
-   INTEGER , PUBLIC ::   nyear       !: current year
-   INTEGER , PUBLIC ::   nmonth      !: current month
-   INTEGER , PUBLIC ::   nday        !: current day of the month
-   INTEGER , PUBLIC ::   ndastp      !: time step date in yyyymmdd format
-   INTEGER , PUBLIC ::   nday_year   !: current day counted from jan 1st of the current year
-   INTEGER , PUBLIC ::   nsec_year   !: current time step counted in second since 00h jan 1st of the current year
-   INTEGER , PUBLIC ::   nsec_month  !: current time step counted in second since 00h 1st day of the current month
-   INTEGER , PUBLIC ::   nsec_day    !: current time step counted in second since 00h of the current day
-   REAL(wp), PUBLIC ::   fjulday     !: julian day 
-   REAL(wp), PUBLIC ::   adatrj      !: number of elapsed days since the begining of the whole simulation
-   !                                 !: (cumulative duration of previous runs that may have used different time-step size)
+   INTEGER , PUBLIC ::   nyear         !: current year
+   INTEGER , PUBLIC ::   nmonth        !: current month
+   INTEGER , PUBLIC ::   nday          !: current day of the month
+   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
+   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month
+   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday
+   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day
+   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
+   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days
+   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation
+   !                                   !: (cumulative duration of previous runs that may have used different time-step size)
    INTEGER , PUBLIC, DIMENSION(0: 1) ::   nyear_len     !: length in days of the previous/current year
    INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
@@ -230,4 +232,13 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag
 
+   !!----------------------------------------------------------------------
+   !! mpp reproducibility
+   !!----------------------------------------------------------------------
+#if defined key_mpp_rep1 || defined key_mpp_re2
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .TRUE.    !: agrif flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .FALSE.   !: agrif flag
+#endif
+
 CONTAINS
    LOGICAL FUNCTION Agrif_Root()
@@ -239,5 +250,4 @@
    END FUNCTION Agrif_CFixed
 #endif
-
    !!======================================================================
 END MODULE dom_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domain.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domain.F90	(revision 2236)
@@ -43,5 +43,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software is governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!-------------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domcfg.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 2236)
@@ -24,5 +24,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 2236)
@@ -40,5 +40,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2005) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 2236)
@@ -44,5 +44,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domngb.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domngb.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domngb.F90	(revision 2236)
@@ -21,5 +21,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2008) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domstp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domstp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domstp.F90	(revision 2236)
@@ -29,5 +29,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2005) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 2236)
@@ -38,5 +38,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 2236)
@@ -34,5 +34,4 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE closea          ! closed seas
-   USE c1d             ! 1D configuration
 
    IMPLICIT NONE
@@ -59,5 +58,5 @@
    !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -482,7 +481,9 @@
       !                                               ! =============== !
 
-      !                                               ! =================== !
-      IF( .NOT. lk_c1d )   CALL zgr_bat_ctl           !   Bathymetry check  !
-      !                                               ! =================== !
+#if ! defined key_c1d
+      !                          ! =================== !
+      CALL zgr_bat_ctl           !   Bathymetry check  !
+      !                          ! =================== !
+#endif
    END SUBROUTINE zgr_bat
 
@@ -984,7 +985,9 @@
       !                                               ! =============== !
 
-      !                                               ! =================== !
-      IF( .NOT. lk_c1d )   CALL zgr_bat_ctl           !   Bathymetry check  !
-      !                                               ! =================== !
+#if ! defined key_c1d
+      !                          ! =================== !
+      CALL zgr_bat_ctl           !   Bathymetry check  !
+      !                          ! =================== !
+#endif
    END SUBROUTINE zgr_zps
 
@@ -1476,7 +1479,9 @@
       !                                               ! ===========
 
-      !                                               ! =================== !
-      IF( .NOT. lk_c1d )   CALL zgr_bat_ctl           !   Bathymetry check  !
-      !                                               ! =================== !
+#if ! defined key_c1d
+      !                          ! =================== !
+      CALL zgr_bat_ctl           !   Bathymetry check  !
+      !                          ! =================== !
+#endif
 
       !                                               ! =============
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domzgr_substitute.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 2236)
@@ -108,4 +108,4 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/phycst.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/phycst.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DOM/phycst.F90	(revision 2236)
@@ -83,5 +83,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
    
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DTA/dtasal.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DTA/dtasal.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DTA/dtasal.F90	(revision 2236)
@@ -63,9 +63,6 @@
       !!   9.0  !  02-06  (G. Madec)  F90: Free form and module 
       !!----------------------------------------------------------------------
-     
-      !! * Arguments
       INTEGER, INTENT(in) ::   kt             ! ocean time step
       
-      !! * Local declarations
       INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies
       INTEGER ::   ik, ierror                     ! temporary integers
@@ -74,4 +71,5 @@
 #endif
       REAL(wp)::   zl
+      
 #if defined key_orca_lev10
       INTEGER ::   ikr, ikw, ikt, jjk 
@@ -109,12 +107,12 @@
              CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' )   ;   RETURN
          ENDIF
-#if defined key_orca_lev10
-         ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkdta  ) )
-         ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkdta,2) )
+
+#if defined key_orca_lev10
+                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkdta)   )
+         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkdta,2) )
 #else
-         ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk  ) )
-         ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) )
-#endif
-
+                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)   )
+         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) )
+#endif
          ! fill sf_sal with sn_sal and control print
          CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' )
@@ -122,5 +120,4 @@
       ENDIF
      
-     
       ! 2. Read monthly file
       ! -------------------
@@ -128,5 +125,5 @@
       CALL fld_read( kt, 1, sf_sal )
 
-      IF( lwp .AND. kt==nn_it000 ) THEN
+      IF( lwp .AND. kt == nit000 ) THEN
          WRITE(numout,*)
          WRITE(numout,*) ' read Levitus salinity ok'
@@ -247,5 +244,5 @@
       ENDIF
         
-      IF( lwp .AND. kt==nn_it000 ) THEN
+      IF( lwp .AND. kt == nit000 ) THEN
          WRITE(numout,*)' salinity Levitus '
          WRITE(numout,*)
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DTA/dtatem.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DTA/dtatem.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DTA/dtatem.F90	(revision 2236)
@@ -69,8 +69,6 @@
       !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
       !!----------------------------------------------------------------------
-      !! * Arguments
       INTEGER, INTENT( in ) ::   kt     ! ocean time-step
 
-      !! * Local declarations
       INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies
       INTEGER ::   ik, ierror                     ! temporary integers
@@ -102,8 +100,8 @@
          sn_tem = FLD_N( 'temperature',  -1.  ,  'votemper',  .false.   , .true.  ,  'yearly'  , ''       , ''         )
 
-         REWIND( numnam )            ! ... read in namlist namdta_tem 
+         REWIND( numnam )         ! ... read in namlist namdta_tem 
          READ( numnam, namdta_tem ) 
 
-         IF(lwp) THEN                ! control print
+         IF(lwp) THEN              ! control print
             WRITE(numout,*)
             WRITE(numout,*) 'dta_tem : Temperature Climatology '
@@ -116,14 +114,14 @@
 
 #if defined key_orca_lev10
-         ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta  ) )
-         ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) )
+                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta)   )
+         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) )
 #else
-         ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk  ) )
-         ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) )
+                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)   )
+         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) )
 #endif
          ! fill sf_tem with sn_tem and control print
          CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' )
          linit_tem = .TRUE.
-
+         !
       ENDIF
       
@@ -133,5 +131,5 @@
       CALL fld_read( kt, 1, sf_tem )
        
-      IF( lwp .AND. kt==nn_it000 )THEN 
+      IF( lwp .AND. kt == nit000 )THEN 
          WRITE(numout,*)
          WRITE(numout,*) ' read Levitus temperature ok'
@@ -141,5 +139,4 @@
 #if defined key_tradmp
       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN
-            
          !                                        ! =======================
          !                                        !  ORCA_R2 configuration
@@ -236,5 +233,5 @@
          END DO
             
-         IF( lwp .AND. kt==nn_it000 )THEN
+         IF( lwp .AND. kt == nit000 )THEN
             WRITE(numout,*)
             WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
@@ -260,5 +257,5 @@
    ENDIF
          
-   IF( lwp .AND. kt==nn_it000 ) THEN
+   IF( lwp .AND. kt == nit000 ) THEN
       WRITE(numout,*) ' temperature Levitus '
       WRITE(numout,*)
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/divcur.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/divcur.F90	(revision 2236)
@@ -14,6 +14,7 @@
    USE in_out_manager  ! I/O manager
    USE obc_oce         ! ocean lateral open boundary condition
-   USE bdy_oce         ! Unstructured open boundaries variables
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE sbcrnf         ! river runoff 
+   USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean
 
    IMPLICIT NONE
@@ -79,4 +80,5 @@
       !!   9.0  !  03-08  (G. Madec)  merged of cur and div, free form, F90
       !!        !  05-01  (J. Chanut, A. Sellar) unstructured open boundaries
+      !! NEMO 3.3  !  2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
       !!----------------------------------------------------------------------
       !! * Arguments
@@ -132,12 +134,4 @@
             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south
          ENDIF
-#endif         
-#if defined key_bdy
-         ! unstructured open boundaries (div must be zero behind the open boundary)
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj)
-            END DO
-         END DO
 #endif         
          IF( .NOT. AGRIF_Root() ) THEN
@@ -245,4 +239,6 @@
       END DO                                           !   End of slab
       !                                                ! ===============
+
+      IF( ln_rnf )  CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
       
       ! 4. Lateral boundary conditions on hdivn and rotn
@@ -346,12 +342,4 @@
          ENDIF
 #endif         
-#if defined key_bdy
-         ! unstructured open boundaries (div must be zero behind the open boundary)
-         DO jj = 1, jpj
-           DO ji = 1, jpi
-             hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj)
-           END DO
-         END DO
-#endif        
          IF( .NOT. AGRIF_Root() ) THEN
             IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east
@@ -374,5 +362,7 @@
       END DO                                           !   End of slab
       !                                                ! ===============
-      
+
+      IF( ln_rnf )  CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+
       ! 4. Lateral boundary conditions on hdivn and rotn
       ! ---------------------------------=======---======
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 2236)
@@ -38,5 +38,5 @@
    !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 2236)
@@ -31,5 +31,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 2236)
@@ -36,5 +36,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynbfr.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 2236)
@@ -32,5 +32,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id: dynzdf.F90 1152 2008-06-26 14:11:13Z rblod $
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 2236)
@@ -63,5 +63,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynkeg.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 2236)
@@ -29,5 +29,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2005) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynldf.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 2236)
@@ -33,5 +33,5 @@
    PUBLIC   dyn_ldf_init  ! called by opa  module 
 
-   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
+   INTEGER ::   nldf = -2   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
 
    !! * Substitutions
@@ -41,5 +41,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -68,4 +68,10 @@
       CASE ( 2 )    ;   CALL dyn_ldf_bilap  ( kt )      ! iso-level bilaplacian
       CASE ( 3 )    ;   CALL dyn_ldf_bilapg ( kt )      ! s-coord. horizontal bilaplacian
+      CASE ( 4 )                                        ! iso-level laplacian + bilaplacian
+         CALL dyn_ldf_lap    ( kt )
+         CALL dyn_ldf_bilap  ( kt )
+      CASE ( 5 )                                        ! rotated laplacian + bilaplacian (s-coord)
+         CALL dyn_ldf_iso    ( kt )
+         CALL dyn_ldf_bilapg ( kt )
       !
       CASE ( -1 )                                       ! esopa: test all possibility with control print
@@ -82,4 +88,11 @@
                         CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask,   &
             &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      CASE ( -2 )                                       ! neither laplacian nor bilaplacian schemes used
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn_ldf : no lateral diffusion on momentum setup'
+            IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         ENDIF
       END SELECT
 
@@ -123,5 +136,5 @@
       IF( ln_dynldf_lap   )   ioptio = ioptio + 1
       IF( ln_dynldf_bilap )   ioptio = ioptio + 1
-      IF( ioptio /= 1 ) CALL ctl_stop( '          use ONE of the 2 lap/bilap operator type on dynamics' )
+      IF( ioptio <  1 ) CALL ctl_warn( '          neither laplacian nor bilaplacian operator set for dynamics' )
       ioptio = 0
       IF( ln_dynldf_level )   ioptio = ioptio + 1
@@ -143,5 +156,5 @@
             IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
          ENDIF
-         IF ( ln_sco ) THEN             ! z-coordinate
+         IF ( ln_sco ) THEN             ! s-coordinate
             IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation)
             IF ( ln_dynldf_hor   )   nldf = 1      ! horizontal (   rotation)
@@ -161,5 +174,5 @@
             IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
          ENDIF
-         IF ( ln_sco ) THEN             ! z-coordinate
+         IF ( ln_sco ) THEN             ! s-coordinate
             IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
             IF ( ln_dynldf_hor   )   nldf = 3      ! horizontal (   rotation)
@@ -168,4 +181,22 @@
       ENDIF
       
+      IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN  ! mixed laplacian and bilaplacian operators
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed 
+            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 5      ! horizontal (   rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
       IF( lk_esopa )                 nldf = -1     ! esopa test
 
@@ -178,9 +209,12 @@
       IF(lwp) THEN
          WRITE(numout,*)
+         IF( nldf == -2 )   WRITE(numout,*) '              neither laplacian nor bilaplacian schemes used'
          IF( nldf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
          IF( nldf ==  0 )   WRITE(numout,*) '              laplacian operator'
-         IF( nldf ==  1 )   WRITE(numout,*) '              Rotated laplacian operator'
+         IF( nldf ==  1 )   WRITE(numout,*) '              rotated laplacian operator'
          IF( nldf ==  2 )   WRITE(numout,*) '              bilaplacian operator'
-         IF( nldf ==  3 )   WRITE(numout,*) '              Rotated bilaplacian'
+         IF( nldf ==  3 )   WRITE(numout,*) '              rotated bilaplacian'
+         IF( nldf ==  4 )   WRITE(numout,*) '              laplacian and bilaplacian operators'
+         IF( nldf ==  5 )   WRITE(numout,*) '              rotated laplacian and bilaplacian operators'
       ENDIF
       !
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynldf_iso.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 2236)
@@ -38,5 +38,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2005) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 2236)
@@ -15,4 +15,5 @@
    !!            2.3  !  2007-07  (D. Storkey) Calls to BDY routines. 
    !!            3.2  !  2009-06  (G. Madec, R.Benshila)  re-introduce the vvl option
+   !!            3.3  !  2010-09  (D. Storkey, E.O'Dea) Bug fix for BDY module
    !!-------------------------------------------------------------------------
   
@@ -34,9 +35,11 @@
    USE bdydta          ! unstructured open boundary conditions
    USE bdydyn          ! unstructured open boundary conditions
-   USE agrif_opa_update
-   USE agrif_opa_interp
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! lateral boundary condition (or mpp link)
    USE prtctl          ! Print control
+#if defined key_agrif
+   USE agrif_opa_update
+   USE agrif_opa_interp
+#endif
 
    IMPLICIT NONE
@@ -50,5 +53,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software is governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!-------------------------------------------------------------------------
 
@@ -171,35 +174,6 @@
 # elif defined key_bdy 
       !                                !* BDY open boundaries
-      !RB all this part should be in a specific routine
       IF( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN       ! except for filtered option
-         !
          CALL bdy_dyn_frs( kt )
-         !
-         IF( ln_bdy_dyn_fla ) THEN
-            ua_e(:,:) = 0.e0
-            va_e(:,:) = 0.e0
-            ! Set these variables for use in bdy_dyn_fla
-            hur_e(:,:) = hur(:,:)
-            hvr_e(:,:) = hvr(:,:)
-            DO jk = 1, jpkm1   !! Vertically integrated momentum trends
-               ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk)
-               va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk)
-            END DO
-            ua_e(:,:) = ua_e(:,:) * hur(:,:)
-            va_e(:,:) = va_e(:,:) * hvr(:,:)
-            DO jk = 1 , jpkm1
-               ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:)
-               va(:,:,jk) = va(:,:,jk) - va_e(:,:)
-            END DO
-            CALL bdy_dta_bt( kt+1, 0)
-            CALL bdy_dyn_fla( sshn_b )
-            CALL lbc_lnk( ua_e, 'U', -1. )   ! Boundary points should be updated
-            CALL lbc_lnk( va_e, 'V', -1. )   !
-            DO jk = 1 , jpkm1
-               ua(:,:,jk) = ( ua(:,:,jk) + ua_e(:,:) ) * umask(:,:,jk)
-               va(:,:,jk) = ( va(:,:,jk) + va_e(:,:) ) * vmask(:,:,jk)
-            END DO
-         ENDIF
-         !
       ENDIF
 # endif
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 2236)
@@ -38,5 +38,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_exp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 2236)
@@ -40,5 +40,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_flt.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 2236)
@@ -44,8 +44,10 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
-   USE agrif_opa_interp
    USE iom
    USE restart         ! only for lrst_oce
    USE lib_fortran
+#if defined key_agrif
+   USE agrif_opa_interp
+#endif
 
    IMPLICIT NONE
@@ -61,5 +63,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_oce.F90	(revision 2236)
@@ -44,5 +44,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!======================================================================
 END MODULE dynspg_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 2236)
@@ -7,4 +7,5 @@
    !!              -   ! 2008-01  (R. Benshila)  change averaging method
    !!             3.2  ! 2009-07  (R. Benshila, G. Madec) Complete revisit associated to vvl reactivation
+   !!             3.3  ! 2010-09  (D. Storkey, E. O'Dea) update for BDY for Shelf configurations
   !!---------------------------------------------------------------------
 #if defined key_dynspg_ts   ||   defined key_esopa
@@ -58,5 +59,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software is governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!-------------------------------------------------------------------------
 
@@ -352,5 +353,5 @@
          !                                                !  ------------------
          IF( lk_obc                     )   CALL obc_dta_bt( kt, jn   )
-         IF( lk_bdy  .OR.  ln_bdy_tides )   CALL bdy_dta_bt( kt, jn+1 )
+         IF( lk_bdy  .OR.  ln_bdy_tides )   CALL bdy_dta_bt( kt, jn+1, icycle )
 
          !                                                !* after ssh_e
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynvor.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 2236)
@@ -57,5 +57,5 @@
    !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 2236)
@@ -33,5 +33,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2005) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 2236)
@@ -41,5 +41,5 @@
    !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -104,4 +104,5 @@
       USE zdftke_old
       USE zdftke
+      USE zdfgls
       USE zdfkpp
       !!----------------------------------------------------------------------
@@ -113,7 +114,7 @@
       !
       ! Force implicit schemes
-      IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfkpp )   nzdf = 1   ! TKE or KPP physics
-      IF( ln_dynldf_iso                               )   nzdf = 1   ! iso-neutral lateral physics
-      IF( ln_dynldf_hor .AND. ln_sco                  )   nzdf = 1   ! horizontal lateral physics in s-coordinate
+      IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1   ! TKE, GLS or KPP physics
+      IF( ln_dynldf_iso                                              )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_dynldf_hor .AND. ln_sco                                 )   nzdf = 1   ! horizontal lateral physics in s-coordinate
       !
       IF( lk_esopa )    nzdf = -1                   ! Esopa key: All schemes used
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 2236)
@@ -32,5 +32,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 2236)
@@ -20,4 +20,8 @@
    USE phycst          ! physical constants
    USE in_out_manager  ! I/O manager
+#if defined key_zdfgls
+   USE zdfbfr, ONLY : bfrua, bfrva, wbotu, wbotv ! bottom stresses
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+#endif
 
    IMPLICIT NONE
@@ -65,4 +69,8 @@
       REAL(wp) ::   zzwi, zzws, zrhs       ! temporary scalars
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi        ! 3D workspace
+#if defined key_zdfgls
+      INTEGER :: ikbu, ikbv, ikbum1, ikbvm1
+      REAL(wp) :: zcbcu, zcbcv
+#endif
       !!----------------------------------------------------------------------
 
@@ -155,6 +163,19 @@
          END DO
       END DO
-      !
-      DO jk = 1, jpkm1        !==  Normalization to obtain the general momentum trend ua  ==
+
+#if defined key_zdfgls
+      ! Save bottom stress for next time step
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
+            ikbum1 = MAX( ikbu-1, 1 )
+            wbotu(ji,jj) = bfrua(ji,jj) * ua(ji,jj,ikbum1) * umask(ji,jj,ikbum1)
+         END DO
+      END DO
+      CALL lbc_lnk( wbotu(:,:), 'U', -1. )
+#endif
+
+      ! Normalization to obtain the general momentum trend ua
+      DO jk = 1, jpkm1
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -243,6 +264,19 @@
          END DO
       END DO
-      !
-      DO jk = 1, jpkm1     !==  Normalization to obtain the general momentum trend va  ==
+
+#if defined key_zdfgls
+      ! Save bottom stress for next time step
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ikbv   = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
+            ikbvm1 = MAX( ikbv-1, 1 )
+            wbotv(ji,jj) = bfrva(ji,jj) * va(ji,jj,ikbvm1) * vmask(ji,jj,ikbvm1)
+         END DO
+      END DO
+      CALL lbc_lnk( wbotv(:,:), 'V', -1. )
+#endif
+
+      ! Normalization to obtain the general momentum trend va
+      DO jk = 1, jpkm1
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 2236)
@@ -6,4 +6,6 @@
    !! History :  3.1  !  2009-02  (G. Madec, M. Leclair)  Original code
    !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA 
+   !!             -   !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   !  2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
    !!----------------------------------------------------------------------
 
@@ -26,7 +28,11 @@
    USE obc_par         ! open boundary cond. parameter
    USE obc_oce
+   USE bdy_oce
    USE diaar5, ONLY :   lk_diaar5
    USE iom
-   USE sbcrnf, ONLY : rnf_dep, rnf_mod_dep  ! River runoff
+   USE sbcrnf, ONLY  : h_rnf, nk_rnf  ! River runoff 
+#if defined key_asminc   
+   USE asminc          ! Assimilation increment
+#endif
 
    IMPLICIT NONE
@@ -42,5 +48,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -138,5 +144,5 @@
          hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1.e0 - umask(:,:,1) )
          hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1.e0 - vmask(:,:,1) )
-         !
+         ! 
       ENDIF
       !
@@ -168,4 +174,9 @@
       ENDIF
 #endif
+#if defined key_bdy
+      ssha(:,:) = ssha(:,:) * bdytmask(:,:)
+      CALL lbc_lnk( ssha, 'T', 1. ) 
+#endif
+
       !                                                ! Sea Surface Height at u-,v- and f-points (vvl case only)
       IF( lk_vvl ) THEN                                ! (required only in key_vvl case)
@@ -184,4 +195,12 @@
          CALL lbc_lnk( sshv_a, 'V', 1. )
       ENDIF
+! Include the IAU weighted SSH increment
+#if defined key_asminc
+      IF( ( lk_asminc ).AND.( ln_sshinc ).AND.( ln_asmiau ) ) THEN
+         CALL ssh_asm_inc( kt )
+         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)
+      ENDIF
+#endif
+
       !                                           !------------------------------!
       !                                           !     Now Vertical Velocity    !
@@ -193,4 +212,7 @@
             &                      - (  fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
             &                         * tmask(:,:,jk) * z1_2dt
+#if defined key_bdy
+         wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
+#endif
       END DO
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/flo_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 2236)
@@ -51,5 +51,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE flo_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/floats.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/floats.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/floats.F90	(revision 2236)
@@ -30,5 +30,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/flowri.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/FLO/flowri.F90	(revision 2236)
@@ -34,5 +34,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 2236)
@@ -110,5 +110,5 @@
    !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom.F90	(revision 2236)
@@ -70,5 +70,5 @@
    !!  OPA 9.0 , LOCEAN-IPSL (2006)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -800,5 +800,5 @@
             IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
                IF( iom_file(kiomid)%luld(idvar) ) THEN
-                  IF( iom_file(kiomid)%dimsz(1,idvar) == size(ptime) ) THEN
+                  IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
                      SELECT CASE (iom_file(kiomid)%iolib)
                      CASE (jpioipsl )   ;   CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_def.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 2236)
@@ -10,5 +10,5 @@
    !! OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!---------------------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_ioipsl.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_ioipsl.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_ioipsl.F90	(revision 2236)
@@ -37,5 +37,5 @@
    !!  OPA 9.0 , LOCEAN-IPSL (2006)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_nf90.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 2236)
@@ -38,5 +38,5 @@
    !!  OPA 9.0 , LOCEAN-IPSL (2006)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_rstdimg.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_rstdimg.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/iom_rstdimg.F90	(revision 2236)
@@ -37,5 +37,5 @@
    !!  OPA 9.0 , LOCEAN-IPSL (2006)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/restart.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/IOM/restart.F90	(revision 2236)
@@ -21,5 +21,4 @@
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
-   USE c1d             ! re-initialization of u-v mask for the 1D configuration
    USE zpshde          ! partial step: hor. derivative (zps_hde routine)
    USE eosbn2          ! equation of state            (eos bn2 routine)
@@ -29,4 +28,8 @@
    USE domvvl          ! variable volume
    USE traswp          ! swap from 4D T-S to 3D T & S and vice versa
+#if defined key_zdfgls
+   USE zdfbfr, ONLY : wbotu, wbotv ! bottom stresses
+   USE zdf_oce
+#endif
 
    IMPLICIT NONE
@@ -46,5 +49,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -142,4 +145,10 @@
 #endif
 
+#if defined key_zdfgls
+      ! Save bottom stresses
+      CALL iom_rstput( kt, nitrst, numrow, 'wbotu' , wbotu )
+      CALL iom_rstput( kt, nitrst, numrow, 'wbotv' , wbotv )
+#endif
+
       IF( kt == nitrst ) THEN
          CALL iom_close( numrow )     ! close the restart file (only at last time step)
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 2236)
@@ -38,5 +38,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -67,5 +67,5 @@
       NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  &
          &                 ln_dynldf_level, ln_dynldf_hor  , ln_dynldf_iso,   &
-         &                 rn_ahm_0       , rn_ahmb_0      , rn_ahm_0_blp
+         &                 rn_ahm_0_lap   , rn_ahmb_0      , rn_ahm_0_blp
       !!----------------------------------------------------------------------
 
@@ -83,11 +83,10 @@
          WRITE(numout,*) '      horizontal (geopotential)               ln_dynldf_hor   = ', ln_dynldf_hor
          WRITE(numout,*) '      iso-neutral                             ln_dynldf_iso   = ', ln_dynldf_iso
-         WRITE(numout,*) '      horizontal laplacian eddy viscosity     rn_ahm_0        = ', rn_ahm_0
+         WRITE(numout,*) '      horizontal laplacian eddy viscosity     rn_ahm_0_lap    = ', rn_ahm_0_lap
          WRITE(numout,*) '      background viscosity                    rn_ahmb_0       = ', rn_ahmb_0
-         WRITE(numout,*) '      horizontal bilaplacian eddy viscosity   rn_ahm_0        = ', rn_ahm_0
-
-      ENDIF
-
-      ahm0     = rn_ahm_0                  ! OLD namelist variables defined from DOCTOR namelist variables
+         WRITE(numout,*) '      horizontal bilaplacian eddy viscosity   rn_ahm_0_blp    = ', rn_ahm_0_blp
+      ENDIF
+
+      ahm0     = rn_ahm_0_lap              ! OLD namelist variables defined from DOCTOR namelist variables
       ahmb0    = rn_ahmb_0
       ahm0_blp = rn_ahm_0_blp
@@ -120,5 +119,4 @@
       IF( ln_dynldf_bilap ) THEN
          IF(lwp) WRITE(numout,*) '   biharmonic momentum diffusion'
-         IF( ahm0_blp == 0.0 ) ahm0_blp = ahm0       ! Old namelist method: bilap specified with ahm0
          IF( .NOT. ln_dynldf_lap ) ahm0 = ahm0_blp   ! Allow spatially varying coefs, which use ahm0 as input
          IF( ahm0_blp > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' )
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 2236)
@@ -29,5 +29,5 @@
       !! * Local variables
       INTEGER  ::   jk   ! dummy loop indice
-      REAL(wp) ::    zdam,  zwam,  zm00,  zm01,  zmhf,  zmhs
+      REAL(wp) ::   zdam,  zwam,  zm00,  zm01,  zmhf,  zmhs
       REAL(wp) ::   zdam2, zwam2, zm200, zm201, zmh2f, zmh2s
       REAL(wp) ::   zahmf, zahms
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 2236)
@@ -17,9 +17,8 @@
    LOGICAL , PUBLIC ::   ln_dynldf_hor   = .TRUE.      !: horizontal (geopotential) direction
    LOGICAL , PUBLIC ::   ln_dynldf_iso   = .FALSE.     !: iso-neutral direction
-   REAL(wp), PUBLIC ::   rn_ahm_0        = 40000._wp   !: lateral laplacian eddy viscosity (m2/s)
+   REAL(wp), PUBLIC ::   rn_ahm_0_lap    = 40000._wp   !: lateral laplacian eddy viscosity (m2/s)
    REAL(wp), PUBLIC ::   rn_ahmb_0       =     0._wp   !: lateral laplacian background eddy viscosity (m2/s)
    REAL(wp), PUBLIC ::   rn_ahm_0_blp    =     0._wp   !: lateral bilaplacian eddy viscosity (m4/s)
-
-   REAL(wp), PUBLIC ::   ahm0, ahmb0, ahm0_blp       ! OLD namelist names
+   REAL(wp), PUBLIC ::   ahm0, ahmb0, ahm0_blp         ! OLD namelist names
 
 #if defined key_dynldf_c3d
@@ -36,5 +35,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE ldfdyn_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 2236)
@@ -24,4 +24,5 @@
    USE phycst          ! physical constants
    USE zdfmxl          ! mixed layer depth
+   USE eosbn2
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager  ! I/O manager
@@ -33,8 +34,14 @@
    PUBLIC   ldf_slp         ! routine called by step.F90
    PUBLIC   ldf_slp_init    ! routine called by opa.F90
+   PUBLIC ldf_slp_grif   !              "
 
    LOGICAL , PUBLIC, PARAMETER              ::   lk_ldfslp = .TRUE.   !: slopes flag
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   uslp, wslpi          !: i_slope at U- and W-points
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   vslp, wslpj          !: j-slope at V- and W-points
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   wslp2                !: wslp**2 from Griffies quarter cells
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   alpha, beta          !: alpha,beta at T points
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   tfw,sfw,ftu,fsu,ftv,fsv,ftud,fsud,ftvd,fsvd
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   psix_eiv
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   psiy_eiv
    
    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   omlmask           ! mask of the surface mixed layer at T-pt
@@ -44,9 +51,11 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -304,5 +313,4 @@
       END DO
          
-
       ! III.  Specific grid points     
       ! =========================== 
@@ -339,4 +347,468 @@
       !
    END SUBROUTINE ldf_slp
+
+   SUBROUTINE ldf_slp_grif ( kt )
+     !!----------------------------------------------------------------------
+     !!                 ***  ROUTINE ldf_slp_grif  ***
+     !!
+     !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope
+     !!      of iso-pycnal surfaces referenced locally) ('key_traldfiso')
+     !!      at W-points using the Griffies quarter-cells.  Also calculates
+     !!      alpha and beta at T-points for use in the Griffies isopycnal
+     !!      scheme.
+     !!
+     !! ** Method  :   The slope in the i-direction is computed at U- and
+     !!      W-points (uslp, wslpi) and the slope in the j-direction is
+     !!      computed at V- and W-points (vslp, wslpj).
+     !!
+     !! ** Action : - alpha, beta
+     !!               wslp2 squared slope of neutral surfaces at w-points.
+     !!
+     !! History :
+     !!   9.0  !  06-10  (C. Harris)  New subroutine
+     !!----------------------------------------------------------------------
+     !! * Modules used
+     USE oce            , zdit  => ua,  &  ! use ua as workspace
+          zdis  => va,  &  ! use va as workspace
+          zdjt  => ta,  &  ! use ta as workspace
+          zdjs  => sa      ! use sa as workspace
+     !! * Arguments
+     INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+     !! * Local declarations
+     INTEGER  ::   ji, jj, jk, ip, jp, kp  ! dummy loop indices
+     INTEGER  ::   iku, ikv                ! temporary integer
+     REAL(wp) ::   &
+          zt, zs, zh, zt2, zsp5, zp1t1,   &  ! temporary scalars
+          zdenr, zrhotmp, zdndt, zdddt,   &  !     "        "
+          zdnds, zddds, znum, zden,       &  !     "        "
+          zslope, za_sxe, zslopec, zdsloper,&  !     "        "
+          zfact, zepsln, zatempw,zatempu,zatempv, &   !     "        "
+          ze1ur,ze2vr,ze3wr,zdxt,zdxs,zdyt,zdys,zdzt,zdzs,zvolf,&
+          zr_slpmax,zdxrho,zdyrho,zabs_dzrho
+     REAL(wp), DIMENSION(jpi,jpj,jpk,0:1,0:1) ::   &
+          zsx,zsy
+     REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) ::   &
+          zsx_ml_base,zsy_ml_base
+     REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+          zdkt,zdks
+     REAL(wp), DIMENSION(jpi,jpj) ::   &
+          zr_ml_basew
+     !!----------------------------------------------------------------------
+
+     ! 0. Local constant initialization
+     ! --------------------------------
+     zr_slpmax = 1.0_wp/slpmax
+
+     ! zslopec=0.004
+     ! zdsloper=1000.0
+     zepsln=1e-25
+
+     SELECT CASE ( nn_eos )
+
+     CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+        !                                                ! ===============
+        DO jk = 1, jpk                                   ! Horizontal slab
+           !                                             ! ===============
+           DO jj = 1, jpjm1
+              DO ji = 1, fs_jpim1
+                 zt = tb(ji,jj,jk)          ! potential temperature
+                 zs = sb(ji,jj,jk) - 35.0   ! salinity anomaly (s-35)
+                 zh = fsdept(ji,jj,jk)      ! depth in meters
+
+                 beta(ji,jj,jk) = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt      &
+                      &                            - 0.301985e-05 ) * zt      &
+                      &   + 0.785567e-03                                      &
+                      &   + (     0.515032e-08 * zs                           &
+                      &         + 0.788212e-08 * zt - 0.356603e-06 ) * zs     &
+                      &   +(  (   0.121551e-17 * zh                           &
+                      &         - 0.602281e-15 * zs                           &
+                      &         - 0.175379e-14 * zt + 0.176621e-12 ) * zh     &
+                      &                             + 0.408195e-10   * zs     &
+                      &     + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt     &
+                      &                             - 0.121555e-07 ) * zh
+
+                 alpha(ji,jj,jk) = - beta(ji,jj,jk) *                       &
+                      &     (((( - 0.255019e-07 * zt + 0.298357e-05 ) * zt   &
+                      &                               - 0.203814e-03 ) * zt   &
+                      &                               + 0.170907e-01 ) * zt   &
+                      &   + 0.665157e-01                                      &
+                      &   +     ( - 0.678662e-05 * zs                         &
+                      &           - 0.846960e-04 * zt + 0.378110e-02 ) * zs   &
+                      &   +   ( ( - 0.302285e-13 * zh                         &
+                      &           - 0.251520e-11 * zs                         &
+                      &           + 0.512857e-12 * zt * zt           ) * zh   &
+                      &           - 0.164759e-06 * zs                         &
+                      &        +(   0.791325e-08 * zt - 0.933746e-06 ) * zt   &
+                      &                               + 0.380374e-04 ) * zh)
+
+              ENDDO
+           ENDDO
+        ENDDO
+
+     CASE ( 1 )
+
+        alpha(:,:,:)=-rn_alpha
+        beta(:,:,:)=0.0
+
+     CASE ( 2 )
+
+        alpha(:,:,:)=-rn_alpha
+        beta (:,:,:)=rn_beta
+
+     CASE ( 3 )
+
+        DO jk =1, jpk
+           DO jj = 1, jpjm1
+              DO ji = 1, fs_jpim1
+                 zt = tb(ji,jj,jk)
+                 zs = sb(ji,jj,jk)
+                 zh = fsdept(ji,jj,jk)
+                 zt2 = zt**2
+                 zsp5 = sqrt(ABS(zs))
+                 zp1t1=zh*zt
+                 znum=9.99843699e+02+zt*(7.35212840e+00+zt*(-5.45928211e-02+3.98476704e-04*zt)) &
+                      +zs*(2.96938239e+00-7.23268813e-03*zt+2.12382341e-03*zs)  &
+                      +zh*(1.04004591e-02+1.03970529e-07*zt2+5.18761880e-06*zs+ &
+                      zh*(-3.24041825e-08-1.23869360e-11*zt2))
+                 zden=1.00000000e+00+zt*(7.28606739e-03+zt*(-4.60835542e-05+zt*(3.68390573e-07+zt*1.80809186e-10))) &
+                      +zs*(2.14691708e-03+zt*(-9.27062484e-06-1.78343643e-10*zt2)+zsp5*(4.76534122e-06+1.63410736e-09*zt2)) &
+                      + zh*(5.30848875e-06+zh*zt*(-3.03175128e-16*zt2-1.27934137e-17*zh))
+                 zdenr=1.0/zden
+                 zrhotmp=znum*zdenr
+                 zdndt=7.35212840e+00+zt*(-1.091856422e-01+1.195430112e-03*zt)-7.23268813e-03*zs &
+                      +zp1t1*(2.07941058e-07-2.4773872e-11*zh)
+                 zdddt=7.28606739e-03+zt*(-9.21671084e-05+zt*(1.105171719e-06+7.23236744e-10*zt))  &
+                      +zs*(-9.27062484e-06+zt*(-5.35030929e-10*zt+3.26821472e-09*zsp5))  &
+                      +zh*zh*(-9.09525384e-16*zt2-1.27934137e-17*zh)
+                 zdnds=2.96938239e+00-7.23268813e-03*zt+2*2.12382341e-03*zs+5.18761880e-06*zh
+                 zddds=2.14691708e-03+zt*(-9.27062484e-06-1.78343643e-10*zt2)+zsp5*(7.14801183e-06+2.45116104e-09*zt2)
+                 alpha(ji,jj,jk)=(zdndt-zrhotmp*zdddt)*zdenr
+                 beta(ji,jj,jk)=zdenr*(zdnds-zrhotmp*zddds)
+
+              END DO
+           END DO
+        END DO
+
+     CASE DEFAULT
+
+        IF(lwp) WRITE(numout,cform_err)
+        IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+        nstop = nstop + 1
+
+     END SELECT
+
+     CALL lbc_lnk( alpha, 'T', 1. )
+     CALL lbc_lnk( beta, 'T', 1. )
+
+
+     ! ---------------------------------------
+     ! 1. Horizontal tracer gradients at T-level jk
+     ! ---------------------------------------
+     DO jk = 1, jpkm1
+        DO jj = 1, jpjm1
+           DO ji = 1, fs_jpim1   ! vector opt.
+              ! i-gradient of T and S at jj
+              zdit (ji,jj,jk) = ( tb(ji+1,jj,jk)-tb(ji,jj,jk) ) * umask(ji,jj,jk)
+              zdis (ji,jj,jk) = ( sb(ji+1,jj,jk)-sb(ji,jj,jk) ) * umask(ji,jj,jk)
+              ! j-gradient of T and S at jj
+              zdjt (ji,jj,jk) = ( tb(ji,jj+1,jk)-tb(ji,jj,jk) ) * vmask(ji,jj,jk)
+              zdjs (ji,jj,jk) = ( sb(ji,jj+1,jk)-sb(ji,jj,jk) ) * vmask(ji,jj,jk)
+           END DO
+        END DO
+     END DO
+
+     IF( ln_zps ) THEN      ! partial steps correction at the last level
+# if defined key_vectopt_loop   &&   ! defined key_mpp_omp
+     jj = 1
+        DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+           DO jj = 1, jpjm1
+              DO ji = 1, jpim1
+# endif
+                 ! last ocean level
+                 iku  = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+                 ikv  = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+                 ! i-gradient of T and S
+                 zdit (ji,jj,iku) = gtu(ji,jj)
+                 zdis (ji,jj,iku) = gsu(ji,jj)
+                 ! j-gradient of T and S
+                 zdjt (ji,jj,ikv) = gtv(ji,jj)
+                 zdjs (ji,jj,ikv) = gsv(ji,jj)
+# if ! defined key_vectopt_loop   ||   defined key_mpp_omp
+              END DO
+# endif
+           END DO
+        ENDIF
+
+        ! ---------------------------------------
+        ! 1. Vertical tracer gradient at w-level jk
+        ! ---------------------------------------
+        DO jk = 2, jpk
+           zdkt(:,:,jk) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk)
+           zdks(:,:,jk) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk)
+        END DO
+
+        zdkt(:,:,1) = 0.0
+        zdks(:,:,1) = 0.0
+
+        ! ---------------------------------------
+        ! Depth of the w-point below ML base
+        ! ---------------------------------------
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              jk = nmln(ji,jj)
+              zr_ml_basew(ji,jj)=1.0/fsdepw(ji,jj,jk+1)
+           END DO
+        END DO
+
+
+        wslp2(:,:,:)=0.0
+        tfw(:,:,:) = 0.0
+        sfw(:,:,:) = 0.0
+        ftu(:,:,:) = 0.0
+        fsu(:,:,:) = 0.0
+        ftv(:,:,:) = 0.0
+        fsv(:,:,:) = 0.0
+        ftud(:,:,:) = 0.0
+        fsud(:,:,:) = 0.0
+        ftvd(:,:,:) = 0.0
+        fsvd(:,:,:) = 0.0
+        psix_eiv(:,:,:) = 0.0
+        psiy_eiv(:,:,:) = 0.0
+
+        ! ----------------------------------------------------------------------
+        ! x-z plane
+        ! ----------------------------------------------------------------------
+
+        ! calculate limited triad x-slopes zsx in interior (1=<jk=<jpk-1)
+        DO ip=0,1
+           DO kp=0,1
+
+              DO jk = 1, jpkm1
+                 DO jj = 1, jpjm1
+                    DO ji = 1, fs_jpim1   ! vector opt.
+
+                       ze1ur=1.0/e1u(ji,jj)
+                       zdxt=zdit(ji,jj,jk)*ze1ur
+                       zdxs=zdis(ji,jj,jk)*ze1ur
+
+                       ze3wr=1.0/fse3w(ji+ip,jj,jk+kp)
+                       zdzt=zdkt(ji+ip,jj,jk+kp)*ze3wr
+                       zdzs=zdks(ji+ip,jj,jk+kp)*ze3wr
+                       ! Calculate the horizontal and vertical density gradient
+                       zdxrho = alpha(ji+ip,jj,jk)*zdxt+beta(ji+ip,jj,jk)*zdxs
+                       zabs_dzrho = ABS(alpha(ji+ip,jj,jk)*zdzt+beta(ji+ip,jj,jk)*zdzs)+zepsln
+                       ! Limit by slpmax, and mask by psi-point
+                       zsx(ji+ip,jj,jk,1-ip,kp) = umask(ji,jj,jk+kp) &
+                            & *zdxrho/MAX(zabs_dzrho,zr_slpmax*ABS(zdxrho))
+                    END DO
+                 END DO
+              END DO
+
+           END DO
+        END DO
+
+        ! calculate slope of triad immediately below mixed-layer base
+        DO ip=0,1
+           DO kp=0,1
+              DO jj = 1, jpjm1
+                 DO ji = 1, fs_jpim1
+                    jk = nmln(ji+ip,jj)
+                    zsx_ml_base(ji+ip,jj,1-ip,kp)=zsx(ji+ip,jj,jk+1-kp,1-ip,kp)
+                 END DO
+              END DO
+           END DO
+        END DO
+
+        ! Below ML use limited zsx as is
+        ! Inside ML replace by linearly reducing zsx_ml_base towards surface
+        DO ip=0,1
+           DO kp=0,1
+
+              DO jk = 1, jpkm1
+
+                 DO jj = 1, jpjm1
+
+                    DO ji = 1, fs_jpim1   ! vector opt.
+                       ! k index of uppermost point(s) of triad is jk+kp-1
+                       ! must be .ge. nmln(ji,jj) for zfact=1.
+                       !                   otherwise  zfact=0.
+                       zfact = 1 - 1/(1 + (jk+kp-1)/nmln(ji+ip,jj))
+                       zsx(ji+ip,jj,jk,1-ip,kp) = zfact*zsx(ji+ip,jj,jk,1-ip,kp) + &
+                            & (1.0_wp-zfact)*(fsdepw(ji+ip,jj,jk+kp)*zr_ml_basew(ji+ip,jj))*zsx_ml_base(ji+ip,jj,1-ip,kp) 
+                    END DO
+
+                 END DO
+
+              END DO
+           END DO
+        END DO
+
+        ! Use zsx to calculate fluxes and save averaged slopes psix_eiv at psi-points
+        DO ip=0,1
+           DO kp=0,1
+
+              DO jk = 1, jpkm1
+
+                 DO jj = 1, jpjm1
+
+                    DO ji = 1, fs_jpim1   ! vector opt.
+
+                       ze1ur=1.0/e1u(ji,jj)
+                       zdxt=zdit(ji,jj,jk)*ze1ur
+                       zdxs=zdis(ji,jj,jk)*ze1ur
+
+                       ze3wr=1.0/fse3w(ji+ip,jj,jk+kp)
+                       zdzt=zdkt(ji+ip,jj,jk+kp)*ze3wr
+                       zdzs=zdks(ji+ip,jj,jk+kp)*ze3wr
+                       zslope=zsx(ji+ip,jj,jk,1-ip,kp)
+
+                       zvolf = 0.25_wp*e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk)
+
+                       ftu(ji,jj,jk)= ftu(ji,jj,jk)+zslope*zdzt*zvolf*ze1ur
+                       fsu(ji,jj,jk)= fsu(ji,jj,jk)+zslope*zdzs*zvolf*ze1ur
+                       ftud(ji,jj,jk)=ftud(ji,jj,jk)+fsahtu(ji,jj,jk)*zdxt*zvolf*ze1ur
+                       fsud(ji,jj,jk)=fsud(ji,jj,jk)+fsahtu(ji,jj,jk)*zdxs*zvolf*ze1ur
+                       tfw(ji+ip,jj,jk+kp)=tfw(ji+ip,jj,jk+kp)+(zvolf*ze3wr)*zslope*zdxt
+                       sfw(ji+ip,jj,jk+kp)=sfw(ji+ip,jj,jk+kp)+(zvolf*ze3wr)*zslope*zdxs
+                       wslp2(ji+ip,jj,jk+kp)=wslp2(ji+ip,jj,jk+kp)+ &
+                            & ((zvolf*ze3wr)/(e1t(ji+ip,jj)*e2t(ji+ip,jj)))*(zslope)**2
+                       psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp*zslope
+
+                    END DO
+                 END DO
+
+              END DO
+           END DO
+        END DO
+
+        ! ----------------------------------------------------------------------
+        ! y-z plane
+        ! ----------------------------------------------------------------------
+
+        ! calculate limited triad y-slopes zsy in interior (1=<jk=<jpk-1)
+        DO jp=0,1
+           DO kp=0,1
+
+              DO jk = 1, jpkm1
+                 DO jj = 1, jpjm1
+                    DO ji = 1, fs_jpim1   ! vector opt.
+
+                       ze2vr=1.0/e2v(ji,jj)
+                       zdyt=zdjt(ji,jj,jk)*ze2vr
+                       zdys=zdjs(ji,jj,jk)*ze2vr
+
+                       ze3wr=1.0/fse3w(ji,jj+jp,jk+kp)
+                       zdzt=zdkt(ji,jj+jp,jk+kp)*ze3wr
+                       zdzs=zdks(ji,jj+jp,jk+kp)*ze3wr
+                       ! Calculate the horizontal and vertical density gradient
+                       zdyrho = alpha(ji,jj+jp,jk)*zdyt+beta(ji,jj+jp,jk)*zdys
+                       zabs_dzrho = ABS(alpha(ji,jj+jp,jk)*zdzt+beta(ji,jj+jp,jk)*zdzs)+zepsln
+                       ! Limit by slpmax, and mask by psi-point
+                       zsy(ji,jj+jp,jk,1-jp,kp) = vmask(ji,jj,jk+kp) &
+                            & *zdyrho/MAX(zabs_dzrho,zr_slpmax*ABS(zdyrho))
+                    END DO
+                 END DO
+              END DO
+
+           END DO
+        END DO
+
+        ! calculate slope of triad immediately below mixed-layer base
+        DO jp=0,1
+           DO kp=0,1
+              DO jj = 1, jpjm1
+                 DO ji = 1, fs_jpim1
+                    jk = nmln(ji,jj+jp)
+                    zsy_ml_base(ji,jj+jp,1-jp,kp)=zsy(ji,jj+jp,jk+1-kp,1-jp,kp)
+                 END DO
+              END DO
+           END DO
+        END DO
+
+        ! Below ML use limited zsy as is
+        ! Inside ML replace by linearly reducing zsy_ml_base towards surface
+        DO jp=0,1
+           DO kp=0,1
+
+              DO jk = 1, jpkm1
+
+                 DO jj = 1, jpjm1
+
+                    DO ji = 1, fs_jpim1   ! vector opt.
+                       ! k index of uppermost point(s) of triad is jk+kp-1
+                       ! must be .ge. nmln(ji,jj) for zfact=1.
+                       !                   otherwise  zfact=0.
+                       zfact = 1 - 1/(1 + (jk+kp-1)/nmln(ji,jj+jp))
+                       zsy(ji,jj+jp,jk,1-jp,kp) = zfact*zsy(ji,jj+jp,jk,1-jp,kp) + &
+                            & (1.0_wp-zfact)*(fsdepw(ji,jj+jp,jk+kp)*zr_ml_basew(ji,jj+jp))*zsy_ml_base(ji,jj+jp,1-jp,kp) 
+                    END DO
+
+                 END DO
+
+              END DO
+           END DO
+        END DO
+
+        ! Use zsy to calculate fluxes and save averaged slopes psiy_eiv at psi-points
+        DO jp=0,1
+           DO kp=0,1
+
+              DO jk = 1, jpkm1
+
+                 DO jj = 1, jpjm1
+
+                    DO ji = 1, fs_jpim1   ! vector opt.
+
+                       ze2vr=1.0/e2v(ji,jj)
+                       zdyt=zdjt(ji,jj,jk)*ze2vr
+                       zdys=zdjs(ji,jj,jk)*ze2vr
+
+                       ze3wr=1.0/fse3w(ji,jj+jp,jk+kp)
+                       zdzt=zdkt(ji,jj+jp,jk+kp)*ze3wr
+                       zdzs=zdks(ji,jj+jp,jk+kp)*ze3wr
+                       zslope=zsy(ji,jj+jp,jk,1-jp,kp)
+
+                       zvolf = 0.25_wp*e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk)
+
+                       ftv(ji,jj,jk)= ftv(ji,jj,jk)+zslope*zdzt*zvolf*ze2vr
+                       fsv(ji,jj,jk)= fsv(ji,jj,jk)+zslope*zdzs*zvolf*ze2vr
+                       ftvd(ji,jj,jk)=ftvd(ji,jj,jk)+fsahtv(ji,jj,jk)*zdyt*zvolf*ze2vr
+                       fsvd(ji,jj,jk)=fsvd(ji,jj,jk)+fsahtv(ji,jj,jk)*zdys*zvolf*ze2vr
+                       tfw(ji,jj+jp,jk+kp)=tfw(ji,jj+jp,jk+kp)+(zvolf*ze3wr)*zslope*zdyt
+                       sfw(ji,jj+jp,jk+kp)=sfw(ji,jj+jp,jk+kp)+(zvolf*ze3wr)*zslope*zdys
+                       wslp2(ji,jj+jp,jk+kp)=wslp2(ji,jj+jp,jk+kp)+ &
+                            & ((zvolf*ze3wr)/(e1t(ji,jj+jp)*e2t(ji,jj+jp)))*(zslope)**2
+                       psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp*zslope
+
+                    END DO
+                 END DO
+
+              END DO
+           END DO
+        END DO
+
+        tfw(:,:,1)=0.0
+        sfw(:,:,1)=0.0
+        wslp2(:,:,1)=0.0
+
+        CALL lbc_lnk( wslp2, 'W', 1. )
+        CALL lbc_lnk( tfw, 'W', 1. )
+        CALL lbc_lnk( sfw, 'W', 1. )
+        CALL lbc_lnk( ftu, 'U', -1. )
+        CALL lbc_lnk( fsu, 'U', -1. )
+        CALL lbc_lnk( ftv, 'V', -1. )
+        CALL lbc_lnk( fsv, 'V', -1. )
+        CALL lbc_lnk( ftud, 'U', -1. )
+        CALL lbc_lnk( fsud, 'U', -1. )
+        CALL lbc_lnk( ftvd, 'V', -1. )
+        CALL lbc_lnk( fsvd, 'V', -1. )
+        CALL lbc_lnk( psix_eiv, 'U', -1. )
+        CALL lbc_lnk( psiy_eiv, 'V', -1. )
+
+
+      END SUBROUTINE ldf_slp_grif
 
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldftra.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 2236)
@@ -36,5 +36,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -67,5 +67,7 @@
       NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  &
          &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   &
-         &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0
+         &                 ln_traldf_grif ,                                   &
+         &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0,       &
+         &                 rn_slpmax
       !!----------------------------------------------------------------------
 
@@ -83,4 +85,5 @@
          WRITE(numout,*) '      laplacian operator            ln_traldf_lap   = ', ln_traldf_lap
          WRITE(numout,*) '      bilaplacian operator          ln_traldf_bilap = ', ln_traldf_bilap
+         WRITE(numout,*) '      griffies    operator          ln_traldf_grif  = ', ln_traldf_grif 
          WRITE(numout,*) '      lateral eddy diffusivity      rn_aht_0        = ', rn_aht_0
          WRITE(numout,*) '      background hor. diffusivity   rn_ahtb_0       = ', rn_ahtb_0
@@ -89,4 +92,5 @@
       ENDIF
 
+      slpmax = rn_slpmax
       !                                ! convert DOCTOR namelist names into OLD names
       aht0  = rn_aht_0
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldftra_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 2236)
@@ -20,9 +20,12 @@
    LOGICAL , PUBLIC ::   ln_traldf_hor   = .FALSE.   !: horizontal (geopotential) direction
    LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.    !: iso-neutral direction
+   LOGICAL , PUBLIC ::   ln_traldf_grif  = .FALSE.   !: griffies skew flux
    REAL(wp), PUBLIC ::   rn_aht_0        = 2000._wp  !: lateral eddy diffusivity (m2/s)
    REAL(wp), PUBLIC ::   rn_ahtb_0       =    0._wp  !: lateral background eddy diffusivity (m2/s)
    REAL(wp), PUBLIC ::   rn_aeiv_0       = 2000._wp  !: eddy induced velocity coefficient (m2/s)
+   REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp   !: slope limit
 
    REAL(wp), PUBLIC ::   aht0, ahtb0, aeiv0         !!: OLD namelist names
+   REAL(wp), PUBLIC ::   slpmax                     !: slope limit 
 
 #if defined key_traldf_c3d
@@ -41,5 +44,5 @@
    !!   'key_traldf_eiv'                              eddy induced velocity
    !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag
+   LOGICAL, PUBLIC, PARAMETER               ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag
       
 # if defined key_traldf_c3d
@@ -67,5 +70,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!=====================================================================
 END MODULE ldftra_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBC/obc_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 2236)
@@ -233,5 +233,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!======================================================================
 END MODULE obc_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90	(revision 2236)
@@ -0,0 +1,37 @@
+   SUBROUTINE ddatetoymdhms( ddate, kyea, kmon, kday, khou, kmin, ksec )
+      !!----------------------------------------------------------------------
+      !!
+      !!                    *** ROUTINE ddatetoymdhms ***
+      !!
+      !! ** Purpose : Convert YYYYMMDD.hhmmss to components
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      REAL(dp), INTENT(IN) :: ddate
+      INTEGER, INTENT(OUT) :: kyea
+      INTEGER, INTENT(OUT) :: kmon
+      INTEGER, INTENT(OUT) :: kday
+      INTEGER, INTENT(OUT) :: khou
+      INTEGER, INTENT(OUT) :: kmin
+      INTEGER, INTENT(OUT) :: ksec
+      !! * Local declarations
+      INTEGER :: iyymmdd
+      INTEGER :: ihhmmss
+      
+      iyymmdd = INT( ddate )
+      ihhmmss = INT( ( ddate - iyymmdd ) * 1000000 )
+      kyea = iyymmdd/10000
+      kmon = iyymmdd / 100 - 100 * kyea
+      kday = MOD( iyymmdd, 100 )
+      khou = ihhmmss/10000
+      kmin = ihhmmss / 100 - 100 * khou
+      ksec = MOD( ihhmmss, 100 )
+      
+   END SUBROUTINE ddatetoymdhms
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/diaobs.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 2236)
@@ -0,0 +1,1662 @@
+MODULE diaobs
+   !!======================================================================
+   !!                       ***  MODULE diaobs  ***
+   !! Observation diagnostics: Computation of the misfit between data and
+   !!                          their model equivalent 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   'key_diaobs' : Switch on the observation diagnostic computation
+   !!----------------------------------------------------------------------
+   !!   dia_obs_init : Reading and prepare observations
+   !!   dia_obs      : Compute model equivalent to observations
+   !!   dia_obs_wri  : Write observational diagnostics
+   !!   ini_date     : Compute the initial date YYYYMMDD.HHMMSS
+   !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE par_oce
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_read_prof            ! Reading and allocation of observations (Coriolis)
+   USE obs_read_sla             ! Reading and allocation of SLA observations  
+   USE obs_read_sst             ! Reading and allocation of SST observations  
+   USE obs_readmdt              ! Reading and allocation of MDT for SLA.
+   USE obs_read_seaice          ! Reading and allocation of Sea Ice observations  
+   USE obs_read_vel             ! Reading and allocation of velocity component observations
+   USE obs_prep                 ! Preparation of obs. (grid search etc).
+   USE obs_oper                 ! Observation operators
+   USE obs_write                ! Writing of observation related diagnostics
+   USE obs_grid                 ! Grid searching
+   USE obs_read_altbias         ! Bias treatment for altimeter
+   USE obs_profiles_def         ! Profile data definitions
+   USE obs_profiles             ! Profile data storage
+   USE obs_surf_def             ! Surface data definitions
+   USE obs_sla                  ! SLA data storage
+   USE obs_sst                  ! SST data storage
+   USE obs_seaice               ! Sea Ice data storage
+   USE obs_types                ! Definitions for observation types
+   USE mpp_map                  ! MPP mapping
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC dia_obs_init, &  ! Initialize and read observations
+      &   dia_obs,      &  ! Compute model equivalent to observations
+      &   dia_obs_wri      ! Write model equivalent to observations
+
+   !! * Shared Module variables
+   LOGICAL, PUBLIC, PARAMETER :: &
+#if defined key_diaobs
+      & lk_diaobs = .TRUE.   !: Logical switch for observation diangostics
+#else
+      & lk_diaobs = .FALSE.  !: Logical switch for observation diangostics
+#endif
+
+   !! * Module variables
+   LOGICAL, PUBLIC :: ln_t3d         !: Logical switch for temperature profiles
+   LOGICAL, PUBLIC :: ln_s3d         !: Logical switch for salinity profiles
+   LOGICAL, PUBLIC :: ln_ena         !: Logical switch for the ENACT data set
+   LOGICAL, PUBLIC :: ln_cor         !: Logical switch for the Coriolis data set
+   LOGICAL, PUBLIC :: ln_profb       !: Logical switch for profile feedback datafiles
+   LOGICAL, PUBLIC :: ln_sla         !: Logical switch for sea level anomalies 
+   LOGICAL, PUBLIC :: ln_sladt       !: Logical switch for SLA from AVISO files
+   LOGICAL, PUBLIC :: ln_slafb       !: Logical switch for SLA from feedback files
+   LOGICAL, PUBLIC :: ln_sst         !: Logical switch for sea surface temperature
+   LOGICAL, PUBLIC :: ln_reysst      !: Logical switch for Reynolds sea surface temperature
+   LOGICAL, PUBLIC :: ln_ghrsst      !: Logical switch for GHRSST data
+   LOGICAL, PUBLIC :: ln_sstfb       !: Logical switch for SST from feedback files
+   LOGICAL, PUBLIC :: ln_seaice      !: Logical switch for sea ice concentration
+   LOGICAL, PUBLIC :: ln_vel3d       !: Logical switch for velocity component (u,v) observations
+   LOGICAL, PUBLIC :: ln_velavcur    !: Logical switch for raw daily averaged netCDF current meter vel. data 
+   LOGICAL, PUBLIC :: ln_velhrcur    !: Logical switch for raw high freq netCDF current meter vel. data 
+   LOGICAL, PUBLIC :: ln_velavadcp   !: Logical switch for raw daily averaged netCDF ADCP vel. data 
+   LOGICAL, PUBLIC :: ln_velhradcp   !: Logical switch for raw high freq netCDF ADCP vel. data 
+   LOGICAL, PUBLIC :: ln_velfb       !: Logical switch for velocities from feedback files
+   LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height
+   LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity
+   LOGICAL, PUBLIC :: ln_nea         !: Remove observations near land
+   LOGICAL, PUBLIC :: ln_altbias     !: Logical switch for altimeter bias  
+   LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files
+   LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations
+
+   REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS
+   REAL(KIND=dp), PUBLIC :: dobsend   !: Observation window end date YYYYMMDD.HHMMSS
+  
+   INTEGER, PUBLIC :: n1dint       !: Vertical interpolation method
+   INTEGER, PUBLIC :: n2dint       !: Horizontal interpolation method 
+
+   INTEGER, DIMENSION(imaxavtypes) :: &
+      & endailyavtypes !: ENACT data types which are daily average
+
+   INTEGER, PARAMETER :: MaxNumFiles = 1000
+   LOGICAL, DIMENSION(MaxNumFiles) :: &
+      & ln_profb_ena, & !: Is the feedback files from ENACT data ?
+   !                    !: If so use endailyavtypes
+      & ln_profb_enatim !: Change tim for 820 enact data set.
+   
+   LOGICAL, DIMENSION(MaxNumFiles) :: &
+      & ln_velfb_av   !: Is the velocity feedback files daily average?
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
+      & ld_enact     !: Profile data is ENACT so use endailyavtypes
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
+      & ld_velav     !: Velocity data is daily averaged
+
+CONTAINS
+
+   SUBROUTINE dia_obs_init
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_obs_init  ***
+      !!          
+      !! ** Purpose : Initialize and read observations
+      !!
+      !! ** Method  : Read the namelist and call reading routines
+      !!
+      !! ** Action  : Read the namelist and call reading routines
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen) Original code
+      !!        !  06-05  (A. Weaver) Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning and add controls
+      !!        !  07-03  (K. Mogensen) General handling of profiles
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Local declarations
+      CHARACTER(len=128) :: enactfiles(MaxNumFiles)
+      CHARACTER(len=128) :: coriofiles(MaxNumFiles)
+      CHARACTER(len=128) :: profbfiles(MaxNumFiles)
+      CHARACTER(len=128) :: sstfiles(MaxNumFiles)      
+      CHARACTER(len=128) :: sstfbfiles(MaxNumFiles) 
+      CHARACTER(len=128) :: slafilesact(MaxNumFiles)      
+      CHARACTER(len=128) :: slafilespas(MaxNumFiles)      
+      CHARACTER(len=128) :: slafbfiles(MaxNumFiles)
+      CHARACTER(len=128) :: seaicefiles(MaxNumFiles)           
+      CHARACTER(len=128) :: velcurfiles(MaxNumFiles)  
+      CHARACTER(len=128) :: veladcpfiles(MaxNumFiles)    
+      CHARACTER(len=128) :: velavcurfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velhrcurfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velavadcpfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velhradcpfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velfbfiles(MaxNumFiles)
+      CHARACTER(LEN=128) :: reysstname
+      CHARACTER(LEN=12)  :: reysstfmt
+      CHARACTER(LEN=128) :: bias_file
+      CHARACTER(LEN=20)  :: datestr=" ", timestr=" "
+      NAMELIST/namobs/ln_ena, ln_cor, ln_profb, ln_t3d, ln_s3d,       &
+         &            ln_sla, ln_sladt, ln_slafb,                     &
+         &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       &
+         &            enactfiles, coriofiles, profbfiles,             &
+         &            slafilesact, slafilespas, slafbfiles,           &
+         &            sstfiles, sstfbfiles,                           &
+         &            ln_seaice, seaicefiles,                         &
+         &            dobsini, dobsend, n1dint, n2dint,               &
+         &            nmsshc, mdtcorr, mdtcutoff,                     &
+         &            ln_reysst, ln_ghrsst, reysstname, reysstfmt,    &
+         &            ln_grid_search_lookup,                          &
+         &            grid_search_file, grid_search_res,              &
+         &            ln_grid_global, bias_file, ln_altbias,          &
+         &            endailyavtypes, ln_s_at_t, ln_profb_ena,        &
+         &            ln_vel3d, ln_velavcur, velavcurfiles,           &
+         &            ln_velhrcur, velhrcurfiles,                     &
+         &            ln_velavadcp, velavadcpfiles,                   &
+         &            ln_velhradcp, velhradcpfiles,                   &
+         &            ln_velfb, velfbfiles, ln_velfb_av,              &
+         &            ln_profb_enatim, ln_ignmis
+
+      INTEGER :: jprofset
+      INTEGER :: jveloset
+      INTEGER :: jvar
+      INTEGER :: jnumenact
+      INTEGER :: jnumcorio
+      INTEGER :: jnumprofb
+      INTEGER :: jnumslaact
+      INTEGER :: jnumslapas
+      INTEGER :: jnumslafb
+      INTEGER :: jnumsst
+      INTEGER :: jnumsstfb
+      INTEGER :: jnumseaice
+      INTEGER :: jnumvelavcur
+      INTEGER :: jnumvelhrcur  
+      INTEGER :: jnumvelavadcp
+      INTEGER :: jnumvelhradcp   
+      INTEGER :: jnumvelfb
+      INTEGER :: ji
+      INTEGER :: jset
+      LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d
+
+      !-----------------------------------------------------------------------
+      ! Read namelist parameters
+      !-----------------------------------------------------------------------
+      ! default values already set except:
+
+      ln_t3d = .FALSE.
+      ln_s3d = .FALSE.
+      ln_vel3d = .FALSE.
+      ln_sla = .FALSE.
+      ln_altbias = .FALSE.
+      ln_ssh = .FALSE.
+      ln_sst = .FALSE.
+      ln_seaice = .FALSE.
+      ln_reysst = .FALSE.
+      ln_ghrsst = .FALSE.
+      ln_sss = .FALSE.
+      ln_profb = .FALSE.
+      ln_ena = .TRUE.
+      ln_cor = .FALSE.
+      ln_sladt = .TRUE.
+      ln_slafb = .FALSE.
+      ln_sstfb = .FALSE.
+      ln_velavcur = .FALSE.
+      ln_velhrcur = .FALSE.
+      ln_velavadcp = .FALSE.
+      ln_velhradcp = .FALSE.
+      ln_velfb = .FALSE.
+      ln_nea = .FALSE.
+      ln_grid_search_lookup = .FALSE.
+      ln_grid_global = .FALSE.
+      ln_s_at_t = .TRUE.
+      grid_search_file = 'xypos'
+      bias_file='bias.nc'
+      enactfiles(:) = ''
+      coriofiles(:) = ''
+      profbfiles(:) = ''
+      slafilesact(:) = ''
+      slafilespas(:) = ''
+      slafbfiles(:) = ''
+      sstfiles(:)   = ''
+      sstfbfiles(:) = ''
+      seaicefiles(:) = ''
+      velcurfiles(:) = ''
+      veladcpfiles(:) = ''
+      velavcurfiles(:) = ''
+      velhrcurfiles(:) = ''
+      velavadcpfiles(:) = ''
+      velhradcpfiles(:) = ''
+      velfbfiles(:) = ''
+      reysstname = 'sst_yYYYYmMM.nc'
+      reysstfmt = 'monthly'
+      endailyavtypes(:) = -1
+      endailyavtypes(1) = 820
+      ln_profb_ena(:) = .FALSE.
+      ln_profb_enatim(:) = .TRUE.
+      ln_velfb_av(:) = .FALSE.
+      ln_ignmis = .FALSE.
+      CALL ini_date( dobsini )
+      CALL fin_date( dobsend )
+      n1dint = 1
+      n2dint = 3
+
+      ! Read Namelist namobs : control observation diagnostics
+      REWIND( numnam )
+      READ  ( numnam, namobs )
+
+      ! Count number of files for each type
+      IF (ln_ena) THEN
+         lmask(:) = .FALSE.
+         WHERE (enactfiles(:) /= '') lmask(:) = .TRUE.
+         jnumenact = COUNT(lmask)
+      ENDIF
+      IF (ln_cor) THEN
+         lmask(:) = .FALSE.
+         WHERE (coriofiles(:) /= '') lmask(:) = .TRUE.
+         jnumcorio = COUNT(lmask)
+      ENDIF
+      IF (ln_profb) THEN
+         lmask(:) = .FALSE.
+         WHERE (profbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumprofb = COUNT(lmask)
+      ENDIF
+      IF (ln_sladt) THEN
+         lmask(:) = .FALSE.
+         WHERE (slafilesact(:) /= '') lmask(:) = .TRUE.
+         jnumslaact = COUNT(lmask)
+         lmask(:) = .FALSE.
+         WHERE (slafilespas(:) /= '') lmask(:) = .TRUE.
+         jnumslapas = COUNT(lmask)
+      ENDIF
+      IF (ln_slafb) THEN
+         lmask(:) = .FALSE.
+         WHERE (slafbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumslafb = COUNT(lmask)
+         lmask(:) = .FALSE.
+      ENDIF
+      IF (ln_ghrsst) THEN
+         lmask(:) = .FALSE.
+         WHERE (sstfiles(:) /= '') lmask(:) = .TRUE.
+         jnumsst = COUNT(lmask)
+      ENDIF      
+      IF (ln_sstfb) THEN
+         lmask(:) = .FALSE.
+         WHERE (sstfbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumsstfb = COUNT(lmask)
+         lmask(:) = .FALSE.
+      ENDIF
+      IF (ln_seaice) THEN
+         lmask(:) = .FALSE.
+         WHERE (seaicefiles(:) /= '') lmask(:) = .TRUE.
+         jnumseaice = COUNT(lmask)
+      ENDIF
+      IF (ln_velavcur) THEN
+         lmask(:) = .FALSE.
+         WHERE (velavcurfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelavcur = COUNT(lmask)
+      ENDIF
+      IF (ln_velhrcur) THEN
+         lmask(:) = .FALSE.
+         WHERE (velhrcurfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelhrcur = COUNT(lmask)
+      ENDIF
+      IF (ln_velavadcp) THEN
+         lmask(:) = .FALSE.
+         WHERE (velavadcpfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelavadcp = COUNT(lmask)
+      ENDIF
+      IF (ln_velhradcp) THEN
+         lmask(:) = .FALSE.
+         WHERE (velhradcpfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelhradcp = COUNT(lmask)
+      ENDIF
+      IF (ln_velfb) THEN
+         lmask(:) = .FALSE.
+         WHERE (velfbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelfb = COUNT(lmask)
+         lmask(:) = .FALSE.
+      ENDIF
+      
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_obs_init : Observation diagnostic initialization'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+#if defined key_datetime_out
+         CALL DATE_AND_TIME(datestr,timestr)         
+         WRITE(numout,*) 'dia_obs_init date_and_time ',datestr,' ',timestr
+#endif
+         WRITE(numout,*) '          Namelist namobs : set observation diagnostic parameters' 
+         WRITE(numout,*) '             Logical switch for T profile observations          ln_t3d = ', ln_t3d
+         WRITE(numout,*) '             Logical switch for S profile observations          ln_s3d = ', ln_s3d
+         WRITE(numout,*) '             Logical switch for ENACT insitu data set           ln_ena = ', ln_ena
+         WRITE(numout,*) '             Logical switch for Coriolis insitu data set        ln_cor = ', ln_cor
+         WRITE(numout,*) '             Logical switch for feedback insitu data set      ln_profb = ', ln_profb
+         WRITE(numout,*) '             Logical switch for SLA observations                ln_sla = ', ln_sla
+         WRITE(numout,*) '             Logical switch for AVISO SLA data                ln_sladt = ', ln_sladt
+         WRITE(numout,*) '             Logical switch for feedback SLA data             ln_slafb = ', ln_slafb
+         WRITE(numout,*) '             Logical switch for SSH observations                ln_ssh = ', ln_ssh
+         WRITE(numout,*) '             Logical switch for SST observations                ln_sst = ', ln_sst
+         WRITE(numout,*) '             Logical switch for Reynolds observations        ln_reysst = ', ln_reysst    
+         WRITE(numout,*) '             Logical switch for GHRSST observations          ln_ghrsst = ', ln_ghrsst
+         WRITE(numout,*) '             Logical switch for feedback SST data             ln_sstfb = ', ln_sstfb
+         WRITE(numout,*) '             Logical switch for SSS observations                ln_sss = ', ln_sss
+         WRITE(numout,*) '             Logical switch for Sea Ice observations         ln_seaice = ', ln_seaice
+         WRITE(numout,*) '             Logical switch for velocity observations         ln_vel3d = ', ln_vel3d
+         WRITE(numout,*) '             Logical switch for velocity daily av. cur.    ln_velavcur = ', ln_velavcur
+         WRITE(numout,*) '             Logical switch for velocity high freq. cur.   ln_velhrcur = ', ln_velhrcur
+         WRITE(numout,*) '             Logical switch for velocity daily av. ADCP   ln_velavadcp = ', ln_velavadcp
+         WRITE(numout,*) '             Logical switch for velocity high freq. ADCP  ln_velhradcp = ', ln_velhradcp
+         WRITE(numout,*) '             Logical switch for feedback velocity data        ln_velfb = ', ln_velfb
+         WRITE(numout,*) '             Global distribtion of observations         ln_grid_global = ',ln_grid_global
+         WRITE(numout,*) &
+   '             Logical switch for obs grid search w/lookup table  ln_grid_search_lookup = ',ln_grid_search_lookup
+         IF (ln_grid_search_lookup) &
+            WRITE(numout,*) '             Grid search lookup file header       grid_search_file = ', grid_search_file
+         IF (ln_ena) THEN
+            DO ji = 1, jnumenact
+               WRITE(numout,'(1X,2A)') '             ENACT input observation file name          enactfiles = ', &
+                  TRIM(enactfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_cor) THEN
+            DO ji = 1, jnumcorio
+               WRITE(numout,'(1X,2A)') '             Coriolis input observation file name       coriofiles = ', &
+                  TRIM(coriofiles(ji))
+            END DO
+         ENDIF
+         IF (ln_profb) THEN
+            DO ji = 1, jnumprofb
+               IF (ln_profb_ena(ji)) THEN
+                  WRITE(numout,'(1X,2A)') '       Enact feedback input observation file name       profbfiles = ', &
+                     TRIM(profbfiles(ji))
+               ELSE
+                  WRITE(numout,'(1X,2A)') '             Feedback input observation file name       profbfiles = ', &
+                     TRIM(profbfiles(ji))
+               ENDIF
+               WRITE(numout,'(1X,2A)') '       Enact feedback input time setting switch    ln_profb_enatim = ', ln_profb_enatim(ji)
+            END DO
+         ENDIF
+         IF (ln_sladt) THEN
+            DO ji = 1, jnumslaact
+               WRITE(numout,'(1X,2A)') '             Active SLA input observation file name    slafilesact = ', &
+                  TRIM(slafilesact(ji))
+            END DO
+            DO ji = 1, jnumslapas
+               WRITE(numout,'(1X,2A)') '             Passive SLA input observation file name   slafilespas = ', &
+                  TRIM(slafilespas(ji))
+            END DO
+         ENDIF
+         IF (ln_slafb) THEN
+            DO ji = 1, jnumslafb
+               WRITE(numout,'(1X,2A)') '             Feedback SLA input observation file name   slafbfiles = ', &
+                  TRIM(slafbfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_ghrsst) THEN
+            DO ji = 1, jnumsst
+               WRITE(numout,'(1X,2A)') '             GHRSST input observation file name           sstfiles = ', &
+                  TRIM(sstfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_sstfb) THEN
+            DO ji = 1, jnumsstfb
+               WRITE(numout,'(1X,2A)') '             Feedback SST input observation file name   sstfbfiles = ', &
+                  TRIM(sstfbfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_seaice) THEN
+            DO ji = 1, jnumseaice
+               WRITE(numout,'(1X,2A)') '             Sea Ice input observation file name       seaicefiles = ', &
+                  TRIM(seaicefiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velavcur) THEN
+            DO ji = 1, jnumvelavcur
+               WRITE(numout,'(1X,2A)') '             Vel. cur. daily av. input file name     velavcurfiles = ', &
+                  TRIM(velavcurfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velhrcur) THEN
+            DO ji = 1, jnumvelhrcur
+               WRITE(numout,'(1X,2A)') '             Vel. cur. high freq. input file name    velhvcurfiles = ', &
+                  TRIM(velhrcurfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velavadcp) THEN
+            DO ji = 1, jnumvelavadcp
+               WRITE(numout,'(1X,2A)') '             Vel. ADCP daily av. input file name    velavadcpfiles = ', &
+                  TRIM(velavadcpfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velhradcp) THEN
+            DO ji = 1, jnumvelhradcp
+               WRITE(numout,'(1X,2A)') '             Vel. ADCP high freq. input file name   velhvadcpfiles = ', &
+                  TRIM(velhradcpfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velfb) THEN
+            DO ji = 1, jnumvelfb
+               IF (ln_velfb_av(ji)) THEN
+                  WRITE(numout,'(1X,2A)') '             Vel. feedback daily av. input file name    velfbfiles = ', &
+                     TRIM(velfbfiles(ji))
+               ELSE
+                  WRITE(numout,'(1X,2A)') '             Vel. feedback input observation file name  velfbfiles = ', &
+                     TRIM(velfbfiles(ji))
+               ENDIF
+            END DO
+         ENDIF
+         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS        dobsini = ', dobsini
+         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS          dobsend = ', dobsend
+         WRITE(numout,*) '             Type of vertical interpolation method          n1dint = ', n1dint
+         WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint
+         WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea
+         WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc
+         WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr
+         WRITE(numout,*) '             MDT cutoff for computed correction          mdtcutoff = ', mdtcutoff
+         WRITE(numout,*) '             Logical switch for alt bias                ln_altbias = ', ln_altbias
+         WRITE(numout,*) '             Logical switch for ignoring missing files   ln_ignmis = ', ln_ignmis
+         WRITE(numout,*) '             ENACT daily average types                             = ',endailyavtypes
+
+      ENDIF
+      
+      IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN
+         CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' )
+         RETURN
+      ENDIF
+
+      CALL obs_typ_init
+      
+      CALL mppmap_init
+      
+      ! Parameter control
+#if defined key_diaobs
+      IF ( ( .NOT. ln_t3d ).AND.( .NOT. ln_s3d ).AND.( .NOT. ln_sla ).AND. &
+         & ( .NOT. ln_vel3d ).AND.                                         &
+         & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. &
+         & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ) ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', &
+            &                    ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d are all set to .FALSE.'
+         nwarn = nwarn + 1
+      ENDIF
+#endif
+
+      CALL obs_grid_setup( )
+      IF ( ( n1dint < 0 ).OR.( n1dint > 1 ) ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' Choice of vertical (1D) interpolation method', &
+            &                    ' is not available'
+         nstop = nstop + 1
+      ENDIF
+      IF ( ( n2dint < 0 ).OR.( n2dint > 4 ) ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' Choice of horizontal (2D) interpolation method', &
+            &                    ' is not available'
+         nstop = nstop + 1
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Depending on switches read the various observation types
+      !-----------------------------------------------------------------------
+      !  - Temperature/salinity profiles
+
+      IF ( ln_t3d .OR. ln_s3d ) THEN
+
+         ! Set the number of variables for profiles to 2 (T and S)
+         nprofvars = 2
+         ! Set the number of extra variables for profiles to 1 (insitu temp).
+         nprofextr = 1
+
+         ! Count how may insitu data sets we have and allocate data.
+         jprofset = 0
+         IF ( ln_ena ) jprofset = jprofset + 1
+         IF ( ln_cor ) jprofset = jprofset + 1
+         IF ( ln_profb ) jprofset = jprofset + jnumprofb
+         nprofsets = jprofset
+         IF ( nprofsets > 0 ) THEN
+            ALLOCATE(ld_enact(nprofsets))
+            ALLOCATE(profdata(nprofsets))
+            ALLOCATE(prodatqc(nprofsets))
+         ENDIF
+
+         jprofset = 0
+          
+         ! ENACT insitu data
+
+         IF ( ln_ena ) THEN
+
+#if defined key_datetime_out
+            IF (lwp) THEN
+               CALL DATE_AND_TIME(datestr,timestr)         
+               WRITE(numout,*) 'Read enact date_and_time ',datestr,' ',timestr
+            ENDIF
+#endif            
+            jprofset = jprofset + 1
+            
+            ld_enact(jprofset) = .TRUE.
+
+            CALL obs_rea_pro_dri( 1, profdata(jprofset),          &
+               &                  jnumenact, enactfiles(1:jnumenact), &
+               &                  nprofvars, nprofextr,        &
+               &                  nitend-nit000+2,             &
+               &                  dobsini, dobsend, ln_t3d, ln_s3d, &
+               &                  ln_ignmis, ln_s_at_t, .TRUE., .FALSE., &
+               &                  kdailyavtypes = endailyavtypes )
+
+            DO jvar = 1, 2
+
+               CALL obs_prof_staend( profdata(jprofset), jvar )
+
+            END DO
+
+            CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+               &              ln_t3d, ln_s3d, ln_nea, &
+               &              kdailyavtypes=endailyavtypes )
+            
+         ENDIF
+
+         ! Coriolis insitu data
+
+         IF ( ln_cor ) THEN
+           
+            jprofset = jprofset + 1
+
+            ld_enact(jprofset) = .FALSE.
+
+            CALL obs_rea_pro_dri( 2, profdata(jprofset),          &
+               &                  jnumcorio, coriofiles(1:jnumcorio), &
+               &                  nprofvars, nprofextr,        &
+               &                  nitend-nit000+2,             &
+               &                  dobsini, dobsend, ln_t3d, ln_s3d, &
+               &                  ln_ignmis, ln_s_at_t, .FALSE., .FALSE. )
+
+            DO jvar = 1, 2
+
+               CALL obs_prof_staend( profdata(jprofset), jvar )
+
+            END DO
+
+            CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+                 &            ln_t3d, ln_s3d, ln_nea )
+            
+         ENDIF
+ 
+         ! Feedback insitu data
+
+         IF ( ln_profb ) THEN
+           
+            DO jset = 1, jnumprofb
+               
+               jprofset = jprofset + 1
+               ld_enact (jprofset) = ln_profb_ena(jset)
+
+               CALL obs_rea_pro_dri( 0, profdata(jprofset),          &
+                  &                  1, profbfiles(jset:jset), &
+                  &                  nprofvars, nprofextr,        &
+                  &                  nitend-nit000+2,             &
+                  &                  dobsini, dobsend, ln_t3d, ln_s3d, &
+                  &                  ln_ignmis, ln_s_at_t, &
+                  &                  ld_enact(jprofset).AND.&
+                  &                  ln_profb_enatim(jset), &
+                  &                  .FALSE., kdailyavtypes = endailyavtypes )
+               
+               DO jvar = 1, 2
+                  
+                  CALL obs_prof_staend( profdata(jprofset), jvar )
+                  
+               END DO
+               
+               IF ( ld_enact(jprofset) ) THEN
+                  CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+                     &              ln_t3d, ln_s3d, ln_nea, &
+                     &              kdailyavtypes = endailyavtypes )
+               ELSE
+                  CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+                     &              ln_t3d, ln_s3d, ln_nea )
+               ENDIF
+               
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea level anomalies
+      IF ( ln_sla ) THEN
+#if defined key_datetime_out
+         IF (lwp) THEN
+            CALL DATE_AND_TIME(datestr,timestr)         
+            WRITE(numout,*) 'Read SLA date_and_time ',datestr,' ',timestr
+         ENDIF
+#endif
+         ! Set the number of variables for sla to 1
+         nslavars = 1
+
+         ! Set the number of extra variables for sla to 2
+         nslaextr = 2
+         
+         ! Set the number of sla data sets to 2
+         nslasets = 0
+         IF ( ln_sladt ) THEN
+            nslasets = nslasets + 2
+         ENDIF
+         IF ( ln_slafb ) THEN
+            nslasets = nslasets + jnumslafb
+         ENDIF
+         
+         ALLOCATE(sladata(nslasets))
+         ALLOCATE(sladatqc(nslasets))
+         sladata(:)%nsurf=0
+         sladatqc(:)%nsurf=0
+
+         nslasets = 0
+
+         ! AVISO SLA data
+
+         IF ( ln_sladt ) THEN
+
+            ! Active SLA observations
+            
+            nslasets = nslasets + 1
+            
+            CALL obs_rea_sla( 1, sladata(nslasets), jnumslaact, &
+               &              slafilesact(1:jnumslaact), &
+               &              nslavars, nslaextr, nitend-nit000+2, &
+               &              dobsini, dobsend, ln_ignmis, .FALSE. )
+#if defined key_datetime_out
+            IF (lwp) THEN
+               CALL DATE_AND_TIME(datestr,timestr)         
+               WRITE(numout,*) 'obs_pre_sla date_and_time ',datestr,' ',timestr
+            ENDIF
+#endif
+            CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
+               &              ln_sla, ln_nea )
+            
+            ! Passive SLA observations
+            
+            nslasets = nslasets + 1
+            
+#if defined key_datetime_out
+            IF (lwp) THEN
+               CALL DATE_AND_TIME(datestr,timestr)         
+               WRITE(numout,*) 'obs_pre_sla date_and_time ',datestr,' ',timestr
+            ENDIF
+#endif
+            CALL obs_rea_sla( 1, sladata(nslasets), jnumslapas, &
+               &              slafilespas(1:jnumslapas), &
+               &              nslavars, nslaextr, nitend-nit000+2, &
+               &              dobsini, dobsend, ln_ignmis, .FALSE. )
+            
+#if defined key_datetime_out
+            IF (lwp) THEN
+               CALL DATE_AND_TIME(datestr,timestr)         
+               WRITE(numout,*) 'obs_pre_sla date_and_time ',datestr,' ',timestr
+            ENDIF
+#endif
+            CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
+               &              ln_sla, ln_nea )
+
+         ENDIF
+         
+         ! Feedback SLA data
+
+         IF ( ln_slafb ) THEN
+
+            DO jset = 1, jnumslafb
+            
+               nslasets = nslasets + 1
+            
+               CALL obs_rea_sla( 0, sladata(nslasets), 1, &
+                  &              slafbfiles(jset:jset), &
+                  &              nslavars, nslaextr, nitend-nit000+2, &
+                  &              dobsini, dobsend, ln_ignmis, .FALSE. )
+#if defined key_datetime_out
+               IF (lwp) THEN
+                  CALL DATE_AND_TIME(datestr,timestr)         
+                  WRITE(numout,*) 'obs_pre_sla date_and_time ',datestr,' ',timestr
+               ENDIF
+#endif
+               CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
+                  &              ln_sla, ln_nea )
+
+            END DO               
+
+         ENDIF
+         
+#if defined key_datetime_out
+         IF (lwp) THEN
+            CALL DATE_AND_TIME(datestr,timestr)         
+            WRITE(numout,*) 'obs_rea_mdt date_and_time ',datestr,' ',timestr
+         ENDIF
+#endif
+         CALL obs_rea_mdt( nslasets, sladatqc, n2dint )
+            
+         ! read in altimeter bias
+         
+         IF ( ln_altbias ) THEN     
+            CALL obs_rea_altbias ( nslasets, sladatqc, n2dint, bias_file )
+         ENDIF
+     
+      ENDIF
+
+      !  - Sea surface height
+      IF ( ln_ssh ) THEN
+         IF(lwp) WRITE(numout,*) ' SSH currently not available'
+      ENDIF
+
+      !  - Sea surface temperature
+      IF ( ln_sst ) THEN
+#if defined key_datetime_out
+         IF (lwp) THEN
+            CALL DATE_AND_TIME(datestr,timestr)         
+            WRITE(numout,*) 'Read SST date_and_time ',datestr,' ',timestr
+         ENDIF
+#endif
+
+         ! Set the number of variables for sst to 1
+         nsstvars = 1
+
+         ! Set the number of extra variables for sst to 0
+         nsstextr = 0
+
+         nsstsets = 0
+
+         IF (ln_reysst) nsstsets = nsstsets + 1
+         IF (ln_ghrsst) nsstsets = nsstsets + 1
+         IF ( ln_sstfb ) THEN
+            nsstsets = nsstsets + jnumsstfb
+         ENDIF
+
+         ALLOCATE(sstdata(nsstsets))
+         ALLOCATE(sstdatqc(nsstsets))
+         sstdata(:)%nsurf=0
+         sstdatqc(:)%nsurf=0         
+
+         nsstsets = 0
+
+         IF (ln_reysst) THEN
+
+            nsstsets = nsstsets + 1
+
+            CALL obs_rea_sst_rey( reysstname, reysstfmt, sstdata(nsstsets), &
+               &                  nsstvars, nsstextr, &
+               &                  nitend-nit000+2, dobsini, dobsend )
+            CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, &
+               &              ln_nea )
+
+        ENDIF
+        
+        IF (ln_ghrsst) THEN
+        
+            nsstsets = nsstsets + 1
+          
+            CALL obs_rea_sst( 1, sstdata(nsstsets), jnumsst, &
+               &              sstfiles(1:jnumsst), &
+               &              nsstvars, nsstextr, nitend-nit000+2, &
+               &              dobsini, dobsend, ln_ignmis, .FALSE. )
+#if defined key_datetime_out
+            IF (lwp) THEN
+               CALL DATE_AND_TIME(datestr,timestr)         
+               WRITE(numout,*) 'obs_pre_sst date_and_time ',datestr,' ',timestr
+            ENDIF
+#endif
+            CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, &
+               &              ln_nea )
+
+        ENDIF
+               
+         ! Feedback SST data
+
+         IF ( ln_sstfb ) THEN
+
+            DO jset = 1, jnumsstfb
+            
+               nsstsets = nsstsets + 1
+            
+               CALL obs_rea_sst( 0, sstdata(nsstsets), 1, &
+                  &              sstfbfiles(jset:jset), &
+                  &              nsstvars, nsstextr, nitend-nit000+2, &
+                  &              dobsini, dobsend, ln_ignmis, .FALSE. )
+#if defined key_datetime_out
+               IF (lwp) THEN
+                  CALL DATE_AND_TIME(datestr,timestr)         
+                  WRITE(numout,*) 'obs_pre_sst date_and_time ',datestr,' ',timestr
+               ENDIF
+#endif
+               CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), &
+                  &              ln_sst, ln_nea )
+
+            END DO               
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface salinity
+      IF ( ln_sss ) THEN
+         IF(lwp) WRITE(numout,*) ' SSS currently not available'
+      ENDIF
+
+      !  - Sea Ice Concentration
+      
+      IF ( ln_seaice ) THEN
+
+#if defined key_datetime_out
+         IF (lwp) THEN
+            CALL DATE_AND_TIME(datestr,timestr)         
+            WRITE(numout,*) 'Read sea ice data date_and_time ',datestr,' ',timestr
+         ENDIF
+#endif
+
+         ! Set the number of variables for seaice to 1
+         nseaicevars = 1
+
+         ! Set the number of extra variables for seaice to 0
+         nseaiceextr = 0
+         
+         ! Set the number of data sets to 1
+         nseaicesets = 1
+
+         ALLOCATE(seaicedata(nseaicesets))
+         ALLOCATE(seaicedatqc(nseaicesets))
+         seaicedata(:)%nsurf=0
+         seaicedatqc(:)%nsurf=0
+
+         CALL obs_rea_seaice( 1, seaicedata(nseaicesets), jnumseaice, &
+            &                 seaicefiles(1:jnumseaice), &
+            &                 nseaicevars, nseaiceextr, nitend-nit000+2, &
+            &                 dobsini, dobsend, ln_ignmis, .FALSE. )
+
+#if defined key_datetime_out
+         IF (lwp) THEN
+            CALL DATE_AND_TIME(datestr,timestr)         
+            WRITE(numout,*) 'obs_pre_seaice date_and_time ',datestr,' ',timestr
+         ENDIF
+#endif
+
+         CALL obs_pre_seaice( seaicedata(nseaicesets), seaicedatqc(nseaicesets), &
+            &                 ln_seaice, ln_nea )
+ 
+      ENDIF
+
+      IF (ln_vel3d) THEN
+
+         ! Set the number of variables for profiles to 2 (U and V)
+         nvelovars = 2
+
+         ! Set the number of extra variables for profiles to 2 to store 
+         ! rotation parameters
+         nveloextr = 2
+
+         jveloset = 0
+         
+         IF ( ln_velavcur ) jveloset = jveloset + 1
+         IF ( ln_velhrcur ) jveloset = jveloset + 1
+         IF ( ln_velavadcp ) jveloset = jveloset + 1
+         IF ( ln_velhradcp ) jveloset = jveloset + 1
+         IF (ln_velfb) jveloset = jveloset + jnumvelfb
+
+         nvelosets = jveloset
+         IF ( nvelosets > 0 ) THEN
+            ALLOCATE( velodata(nvelosets) )
+            ALLOCATE( veldatqc(nvelosets) )
+            ALLOCATE( ld_velav(nvelosets) )
+         ENDIF
+         
+         jveloset = 0
+         
+         ! Daily averaged data
+
+         IF ( ln_velavcur ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .TRUE.
+            
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavcur, &
+               &                  velavcurfiles(1:jnumvelavcur), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhrcur ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .FALSE.
+               
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhrcur, &
+               &                  velhrcurfiles(1:jnumvelhrcur), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         ! Daily averaged data
+
+         IF ( ln_velavadcp ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .TRUE.
+            
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavadcp, &
+               &                  velavadcpfiles(1:jnumvelavadcp), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhradcp ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .FALSE.
+               
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhradcp, &
+               &                  velhradcpfiles(1:jnumvelhradcp), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         IF ( ln_velfb ) THEN
+
+            DO jset = 1, jnumvelfb
+            
+               jveloset = jveloset + 1
+
+               ld_velav(jveloset) = ln_velfb_av(jset)
+               
+               CALL obs_rea_vel_dri( 0, velodata(jveloset), 1, &
+                  &                  velfbfiles(jset:jset), &
+                  &                  nvelovars, nveloextr, &
+                  &                  nitend-nit000+2,              &
+                  &                  dobsini, dobsend, ln_ignmis, &
+                  &                  ld_velav(jveloset), &
+                  &                  .FALSE. )
+               
+               DO jvar = 1, 2
+                  CALL obs_prof_staend( velodata(jveloset), jvar )
+               END DO
+               
+               CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+                  &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+
+
+            END DO
+            
+         ENDIF
+
+      ENDIF
+
+#if defined key_datetime_out
+      IF (lwp) THEN
+         CALL DATE_AND_TIME(datestr,timestr)         
+         WRITE(numout,*) 'end dia_obs_init date_and_time ',datestr,' ',timestr
+      ENDIF
+#endif
+     
+   END SUBROUTINE dia_obs_init
+
+   SUBROUTINE dia_obs( kstp )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_obs  ***
+      !!          
+      !! ** Purpose : Call the observation operators on each time step
+      !!
+      !! ** Method  : Call the observation operators on each time step to
+      !!              compute the model equivalent of the following date:
+      !!               - T profiles
+      !!               - S profiles
+      !!               - Sea surface height (referenced to a mean)
+      !!               - Sea surface temperature
+      !!               - Sea surface salinity
+      !!               - Velocity component (U,V) profiles
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen) Original code
+      !!        !  06-05  (K. Mogensen) Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  07-03  (K. Mogensen) General handling of profiles
+      !!        !  07-04  (G. Smith) Generalized surface operators
+      !!        !  08-10  (M. Valdivieso) obs operator for velocity profiles
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &             ! Ocean space and time domain variables
+         & rdt,           &                       
+         & gdept_0,       &             
+         & tmask, umask, vmask                            
+      USE phycst, ONLY : &              ! Physical constants
+         & rday                         
+      USE oce, ONLY : &                 ! Ocean dynamics and tracers variables
+         & tn,  &             
+         & sn,  &
+         & un, vn,  &
+         & sshn
+#if defined key_ice_lim
+      USE ice, ONLY : &                     ! LIM Ice model variables
+         & frld
+#endif
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kstp                         ! Current timestep
+      !! * Local declarations
+#if ! defined key_ice_lim
+      REAL(wp), DIMENSION(jpi,jpj) :: frld
+#endif
+      INTEGER :: idaystp                ! Number of timesteps per day
+      INTEGER :: jprofset               ! Profile data set loop variable
+      INTEGER :: jslaset                ! SLA data set loop variable
+      INTEGER :: jsstset                ! SST data set loop variable
+      INTEGER :: jseaiceset             ! sea ice data set loop variable
+      INTEGER :: jveloset               ! velocity profile data loop variable
+      INTEGER :: jvar                   ! Variable number    
+      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
+ 
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_obs : Call the observation operators', kstp
+         WRITE(numout,*) '~~~~~~~'
+#if defined key_datetime_out
+         CALL DATE_AND_TIME(datestr,timestr)         
+      WRITE(numout,*) 'dia_obs date_and_time ',datestr,' ',timestr
+#endif
+      ENDIF
+
+      idaystp = NINT( rday / rdt )
+
+      !-----------------------------------------------------------------------
+      ! No LIM => frld == 0.0_wp
+      !-----------------------------------------------------------------------
+#if ! defined key_ice_lim
+      frld(:,:) = 0.0_wp
+#endif
+      !-----------------------------------------------------------------------
+      ! Depending on switches call various observation operators
+      !-----------------------------------------------------------------------
+
+      !  - Temperature/salinity profiles
+      IF ( ln_t3d .OR. ln_s3d ) THEN
+         DO jprofset = 1, nprofsets
+            IF ( ld_enact(jprofset) ) THEN
+               CALL obs_pro_opt( prodatqc(jprofset),                          &
+                  &              kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,&
+                  &              gdept_0, tmask, n1dint, n2dint,              &
+                  &              kdailyavtypes = endailyavtypes )
+            ELSE
+               CALL obs_pro_opt( prodatqc(jprofset),                          &
+                  &              kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,&
+                  &              gdept_0, tmask, n1dint, n2dint               )
+            ENDIF
+         END DO
+      ENDIF
+
+      !  - Sea surface anomaly
+      IF ( ln_sla ) THEN
+         DO jslaset = 1, nslasets
+            CALL obs_sla_opt( sladatqc(jslaset),            &
+               &              kstp, jpi, jpj, nit000, sshn, &
+               &              tmask(:,:,1), n2dint )
+         END DO         
+      ENDIF
+
+      !  - Sea surface temperature
+      IF ( ln_sst ) THEN
+         DO jsstset = 1, nsstsets
+            CALL obs_sst_opt( sstdatqc(jsstset),                 &
+               &              kstp, jpi, jpj, nit000, tn(:,:,1), &
+               &              tmask(:,:,1), n2dint )
+         END DO
+      ENDIF
+
+      !  - Sea surface salinity
+      IF ( ln_sss ) THEN
+         IF(lwp) WRITE(numout,*) ' SSS currently not available'
+      ENDIF
+
+#if defined key_ice_lim
+      IF ( ln_seaice ) THEN
+         DO jseaiceset = 1, nseaicesets
+            CALL obs_seaice_opt( seaicedatqc(jseaiceset),      &
+               &              kstp, jpi, jpj, nit000, 1.-frld, &
+               &              tmask(:,:,1), n2dint )
+         END DO
+      ENDIF      
+#endif
+
+      !  - Velocity profiles
+      IF ( ln_vel3d ) THEN
+         DO jveloset = 1, nvelosets
+           ! zonal component of velocity
+           CALL obs_vel_opt( veldatqc(jveloset), kstp, jpi, jpj, jpk, &
+              &              nit000, idaystp, un, vn, gdept_0, umask, vmask, &
+                             n1dint, n2dint, ld_velav(jveloset) )
+         END DO
+      ENDIF
+
+#if defined key_datetime_out
+      IF(lwp) THEN
+         CALL DATE_AND_TIME(datestr,timestr)         
+         WRITE(numout,*) 'dia_obs finished date_and_time ',datestr,' ',timestr
+      ENDIF
+#endif
+
+   END SUBROUTINE dia_obs
+  
+   SUBROUTINE dia_obs_wri 
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_obs_wri  ***
+      !!          
+      !! ** Purpose : Call observation diagnostic output routines
+      !!
+      !! ** Method  : Call observation diagnostic output routines
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen) Original code
+      !!        !  06-05  (K. Mogensen) Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  07-03  (K. Mogensen) General handling of profiles
+      !!        !  08-09  (M. Valdivieso) Velocity component (U,V) profiles
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      !! * Local declarations
+
+      INTEGER :: jprofset                 ! Profile data set loop variable
+      INTEGER :: jveloset                 ! Velocity data set loop variable
+      INTEGER :: jslaset                  ! SLA data set loop variable
+      INTEGER :: jsstset                  ! SST data set loop variable
+      INTEGER :: jseaiceset               ! Sea Ice data set loop variable
+      INTEGER :: jset
+      INTEGER :: jfbini
+      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
+      CHARACTER(LEN=10) :: cdtmp
+      !-----------------------------------------------------------------------
+      ! Depending on switches call various observation output routines
+      !-----------------------------------------------------------------------
+
+#if defined key_datetime_out
+      IF (lwp) THEN
+         CALL DATE_AND_TIME(datestr,timestr)         
+         WRITE(numout,*) 'dia_obs_wri date_and_time ',datestr,' ',timestr
+      ENDIF
+#endif
+
+      !  - Temperature/salinity profiles
+
+      IF( ln_t3d .OR. ln_s3d ) THEN
+
+         ! Copy data from prodatqc to profdata structures
+         DO jprofset = 1, nprofsets
+
+            CALL obs_prof_decompress( prodatqc(jprofset), &
+                 &                    profdata(jprofset), .TRUE., numout )
+
+         END DO
+
+         ! Write the profiles.
+
+         jprofset = 0
+          
+
+         ! ENACT insitu data
+
+         IF ( ln_ena ) THEN
+           
+            jprofset = jprofset + 1
+
+            CALL obs_wri_p3d( 'enact', profdata(jprofset) )
+
+         ENDIF
+
+         ! Coriolis insitu data
+
+         IF ( ln_cor ) THEN
+            
+            jprofset = jprofset + 1
+
+            CALL obs_wri_p3d( 'corio', profdata(jprofset) )
+            
+         ENDIF
+         
+         ! Feedback insitu data
+
+         IF ( ln_profb ) THEN
+
+            jfbini = jprofset + 1
+
+            DO jprofset = jfbini, nprofsets
+               
+               jset = jprofset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'profb_',jset
+               CALL obs_wri_p3d( cdtmp, profdata(jprofset) )
+
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface anomaly
+      IF ( ln_sla ) THEN
+
+         ! Copy data from sladatqc to sladata structures
+         DO jslaset = 1, nslasets
+
+              CALL obs_surf_decompress( sladatqc(jslaset), &
+                 &                    sladata(jslaset), .TRUE., numout )
+
+         END DO
+
+         jslaset = 0 
+
+         ! Write the AVISO SLA data
+
+         IF ( ln_sladt ) THEN
+            
+            jslaset = 1
+            CALL obs_wri_sla( 'aviso_act', sladata(jslaset) )
+            jslaset = 2
+            CALL obs_wri_sla( 'aviso_pas', sladata(jslaset) )
+
+         ENDIF
+
+         IF ( ln_slafb ) THEN
+            
+            jfbini = jslaset + 1
+
+            DO jslaset = jfbini, nslasets
+               
+               jset = jslaset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'slafb_',jset
+               CALL obs_wri_sla( cdtmp, sladata(jslaset) )
+
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface temperature
+      IF ( ln_sst ) THEN
+
+         ! Copy data from sstdatqc to sstdata structures
+         DO jsstset = 1, nsstsets
+     
+              CALL obs_surf_decompress( sstdatqc(jsstset), &
+                 &                    sstdata(jsstset), .TRUE., numout )
+
+         END DO
+
+         jsstset = 0 
+
+         ! Write the AVISO SST data
+
+         IF ( ln_reysst ) THEN
+            
+            jsstset = jsstset + 1
+            CALL obs_wri_sst( 'reynolds', sstdata(jsstset) )
+
+         ENDIF
+
+         IF ( ln_ghrsst ) THEN
+            
+            jsstset = jsstset + 1
+            CALL obs_wri_sst( 'ghr', sstdata(jsstset) )
+
+         ENDIF
+
+         IF ( ln_sstfb ) THEN
+            
+            jfbini = jsstset + 1
+
+            DO jsstset = jfbini, nsstsets
+               
+               jset = jsstset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'sstfb_',jset
+               CALL obs_wri_sst( cdtmp, sstdata(jsstset) )
+
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface salinity
+      IF ( ln_sss ) THEN
+         IF(lwp) WRITE(numout,*) ' SSS currently not available'
+      ENDIF
+
+      !  - Sea Ice Concentration
+      IF ( ln_seaice ) THEN
+
+         ! Copy data from seaicedatqc to seaicedata structures
+         DO jseaiceset = 1, nseaicesets
+
+              CALL obs_surf_decompress( seaicedatqc(jseaiceset), &
+                 &                    seaicedata(jseaiceset), .TRUE., numout )
+
+         END DO
+
+         ! Write the Sea Ice data
+         DO jseaiceset = 1, nseaicesets
+      
+            WRITE(cdtmp,'(A,I2.2)')'seaicefb_',jseaiceset
+            CALL obs_wri_seaice( cdtmp, seaicedata(jseaiceset) )
+
+         END DO
+
+      ENDIF
+      
+      ! Velocity data
+      IF( ln_vel3d ) THEN
+
+         ! Copy data from veldatqc to velodata structures
+         DO jveloset = 1, nvelosets
+
+            CALL obs_prof_decompress( veldatqc(jveloset), &
+                 &                    velodata(jveloset), .TRUE., numout )
+
+         END DO
+
+         ! Write the profiles.
+
+         jveloset = 0
+
+         ! Daily averaged data
+
+         IF ( ln_velavcur ) THEN
+            
+            jveloset = jveloset + 1
+
+            CALL obs_wri_vel( 'velavcurr', velodata(jveloset), n2dint )
+
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhrcur ) THEN
+            
+            jveloset = jveloset + 1
+
+            CALL obs_wri_vel( 'velhrcurr', velodata(jveloset), n2dint )
+
+         ENDIF
+
+         ! Daily averaged data
+
+         IF ( ln_velavadcp ) THEN
+            
+            jveloset = jveloset + 1
+
+            CALL obs_wri_vel( 'velavadcp', velodata(jveloset), n2dint )
+
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhradcp ) THEN
+            
+            jveloset = jveloset + 1
+            
+            CALL obs_wri_vel( 'velhradcp', velodata(jveloset), n2dint )
+               
+         ENDIF
+
+         ! Feedback velocity data
+
+         IF ( ln_velfb ) THEN
+
+            jfbini = jveloset + 1
+
+            DO jveloset = jfbini, nvelosets
+               
+               jset = jveloset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'velfb_',jset
+               CALL obs_wri_vel( cdtmp, velodata(jveloset), n2dint )
+
+            END DO
+
+         ENDIF
+         
+      ENDIF
+
+#if defined key_datetime_out
+      IF (lwp) THEN
+         CALL DATE_AND_TIME(datestr,timestr)         
+         WRITE(numout,*) 'dia_obs_wri end date_and_time ',datestr,' ',timestr
+      ENDIF
+#endif
+
+   END SUBROUTINE dia_obs_wri
+
+   SUBROUTINE ini_date( ddobsini )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ini_date  ***
+      !!          
+      !! ** Purpose : Get initial data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : Get initial data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get initial data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  06-10  (G. Smith) Calculates initial date the same as method for final date
+      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!----------------------------------------------------------------------
+      USE phycst, ONLY : &            ! Physical constants
+         & rday
+!      USE daymod, ONLY : &            ! Time variables
+!         & nmonth_len           
+      USE dom_oce, ONLY : &           ! Ocean space and time domain variables
+         & rdt
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(KIND=dp), INTENT(OUT) :: ddobsini                         ! Initial date in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      INTEGER :: iyea        ! date - (year, month, day, hour, minute)
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: imday         ! Number of days in month.
+      REAL(KIND=wp) :: zdayfrc ! Fraction of day
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+
+      !!----------------------------------------------------------------------
+      !! Initial date initialization (year, month, day, hour, minute)
+      !! (This assumes that the initial date is for 00z))
+      !!----------------------------------------------------------------------
+      iyea =   ndate0 / 10000
+      imon = ( ndate0 - iyea * 10000 ) / 100
+      iday =   ndate0 - iyea * 10000 - imon * 100
+      ihou = 0
+      imin = 0
+
+      !!----------------------------------------------------------------------
+      !! Compute number of days + number of hours + min since initial time
+      !!----------------------------------------------------------------------
+      iday = iday + ( nit000 -1 ) * rdt / rday
+      zdayfrc = ( nit000 -1 ) * rdt / rday
+      zdayfrc = zdayfrc - aint(zdayfrc)
+      ihou = int( zdayfrc * 24 )
+      imin = int( (zdayfrc * 24 - ihou) * 60 )
+
+      !!-----------------------------------------------------------------------
+      !! Convert number of days (iday) into a real date
+      !!----------------------------------------------------------------------
+
+      CALL calc_month_len( iyea, imonth_len )
+      
+      DO WHILE ( iday > imonth_len(imon) )
+         iday = iday - imonth_len(imon)
+         imon = imon + 1 
+         IF ( imon > 12 ) THEN
+            imon = 1
+            iyea = iyea + 1
+            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
+         ENDIF
+      END DO
+
+      !!----------------------------------------------------------------------
+      !! Convert it into YYYYMMDD.HHMMSS format.
+      !!----------------------------------------------------------------------
+      ddobsini = iyea * 10000_dp + imon * 100_dp + &
+         &       iday + ihou * 0.01_dp + imin * 0.0001_dp
+
+
+   END SUBROUTINE ini_date
+
+   SUBROUTINE fin_date( ddobsfin )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE fin_date  ***
+      !!          
+      !! ** Purpose : Get final data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : Get final data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get final data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!----------------------------------------------------------------------
+      USE phycst, ONLY : &            ! Physical constants
+         & rday
+!      USE daymod, ONLY : &            ! Time variables
+!         & nmonth_len                
+      USE dom_oce, ONLY : &           ! Ocean space and time domain variables
+         & rdt
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(KIND=dp), INTENT(OUT) :: ddobsfin                   ! Final date in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      INTEGER :: iyea        ! date - (year, month, day, hour, minute)
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: imday         ! Number of days in month.
+      REAL(KIND=wp) :: zdayfrc       ! Fraction of day
+         
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+            
+      !-----------------------------------------------------------------------
+      ! Initial date initialization (year, month, day, hour, minute)
+      ! (This assumes that the initial date is for 00z)
+      !-----------------------------------------------------------------------
+      iyea =   ndate0 / 10000
+      imon = ( ndate0 - iyea * 10000 ) / 100
+      iday =   ndate0 - iyea * 10000 - imon * 100
+      ihou = 0
+      imin = 0
+      
+      !-----------------------------------------------------------------------
+      ! Compute number of days + number of hours + min since initial time
+      !-----------------------------------------------------------------------
+      iday    = iday +  nitend  * rdt / rday
+      zdayfrc =  nitend  * rdt / rday
+      zdayfrc = zdayfrc - AINT( zdayfrc )
+      ihou    = INT( zdayfrc * 24 )
+      imin    = INT( ( zdayfrc * 24 - ihou ) * 60 )
+
+      !-----------------------------------------------------------------------
+      ! Convert number of days (iday) into a real date
+      !----------------------------------------------------------------------
+
+      CALL calc_month_len( iyea, imonth_len )
+      
+      DO WHILE ( iday > imonth_len(imon) )
+         iday = iday - imonth_len(imon)
+         imon = imon + 1 
+         IF ( imon > 12 ) THEN
+            imon = 1
+            iyea = iyea + 1
+            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
+         ENDIF
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Convert it into YYYYMMDD.HHMMSS format
+      !-----------------------------------------------------------------------
+      ddobsfin = iyea * 10000_dp + imon * 100_dp    + iday &
+         &     + ihou * 0.01_dp  + imin * 0.0001_dp
+
+    END SUBROUTINE fin_date
+    
+END MODULE diaobs
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/find_obs_proc.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/find_obs_proc.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/find_obs_proc.h90	(revision 2236)
@@ -0,0 +1,54 @@
+   SUBROUTINE find_obs_proc(kldi,klei,kldj,klej,kmyproc,kobsp,kobsi,kobsj,kno)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE find_obs_proc ***
+      !!          
+      !! ** Purpose : From the array kobsp containing the results of the grid
+      !!              grid search on each processor the processor return a
+      !!              decision of which processors should hold the observation.
+      !!
+      !! ** Method : Use i and j and halo regions to decide which processor to 
+      !!             put ob in. Intended to avoid the mpp calls required by
+      !!             obs_mpp_find_obs_proc
+      !!
+      !! History : 
+      !!! 03-08  (D. Lea)  Original code
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+
+      INTEGER, INTENT(IN) :: kldi               ! Start of inner domain in i
+      INTEGER, INTENT(IN) :: klei               ! End of inner domain in i
+      INTEGER, INTENT(IN) :: kldj               ! Start of inner domain in j
+      INTEGER, INTENT(IN) :: klej               ! End of inner domain in j
+
+      INTEGER, INTENT(IN) :: kmyproc
+      INTEGER, INTENT(IN) :: kno
+
+      INTEGER, DIMENSION(kno), INTENT(IN) :: kobsi
+      INTEGER, DIMENSION(kno), INTENT(IN) :: kobsj
+      INTEGER, DIMENSION(kno), INTENT(INOUT) :: kobsp
+      
+      !! * local variables
+      INTEGER :: &
+         & ji
+          
+      ! first and last indoor i- and j-indexes      kldi, klei,   kldj, klej
+      ! exclude any obs in the bottom-left overlap region
+      ! also any obs outside to whole region (defined by nlci and nlcj)
+      ! I am assuming that kobsp does not need to be the correct processor 
+      ! number
+      
+      DO ji = 1, kno
+         IF (kobsi(ji) < kldi .OR. kobsj(ji) < kldj &
+            .OR. kobsi(ji) > klei  .OR. kobsj(ji) > klej) THEN
+            IF (lwp .AND. kobsp(ji) /= -1) WRITE(numout,*) &
+               & 'kobs: ',kobsi(ji), kobsj(ji), kobsp(ji)
+            kobsp(ji)=1000000
+         ENDIF
+      END DO
+
+      ! Ensure that observations not in processor are masked
+
+      WHERE(kobsp(:) /= kmyproc) kobsp(:)=1000000
+
+   END SUBROUTINE find_obs_proc
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/grt_cir_dis.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/grt_cir_dis.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/grt_cir_dis.h90	(revision 2236)
@@ -0,0 +1,27 @@
+   REAL(KIND=wp) FUNCTION grt_cir_dis( pa1, pa2, pb1, pb2, pc1, pc2 )
+      !!----------------------------------------------------------------------
+      !!                     *** FUNCTION grt_cir_dis ***
+      !!
+      !! ** Purpose : Great circle distance between pts (lat1,lon1) 
+      !!               & (lat2,lon2)
+      !!                   
+      !! ** Method   : Geometry.
+      !!
+      !! History :
+      !!        !  1995-12 (G. Madec, E. Durand, A. Weaver, N. Daget) Original 
+      !!        !  2006-03 (A. Vidard) Migration to NEMOVAR 
+      !!        !  2006-10 (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+      
+      !! * Arguments
+      REAL(KIND=wp) :: pa1   !  sin(lat1)
+      REAL(KIND=wp) :: pa2   !  sin(lat2)
+      REAL(KIND=wp) :: pb1   !  cos(lat1) * cos(lon1)
+      REAL(KIND=wp) :: pb2   !  cos(lat2) * cos(lon2)
+      REAL(KIND=wp) :: pc1   !  cos(lat1) * sin(lon1)
+      REAL(KIND=wp) :: pc2   !  cos(lat2) * sin(lon2)
+
+      grt_cir_dis = &
+         &  ASIN( SQRT( 1.0 - ( pa1 * pa2 + pb1 * pb2 + pc1 * pc2 )**2 ) )
+      
+   END FUNCTION grt_cir_dis
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90	(revision 2236)
@@ -0,0 +1,26 @@
+   REAL(KIND=wp) FUNCTION grt_cir_dis_saa( pa, pb, pc )
+      !!----------------------------------------------------------------------
+      !!                     *** FUNCTION grt_cir_dis_saa ***
+      !!
+      !! ** Purpose : Great circle distance between pts (lat1,lon1) 
+      !!               & (lat2,lon2) with a small-angle approximation
+      !!
+      !! ** Method  : Geometry
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      !  95-12 (G. Madec, E. Durand, A. Weaver, N. Daget) Original 
+      !!      !  06-03 (A. Vidard) Migration to NEMOVAR 
+      !!      !  06-10 (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+      
+      !! * Arguments
+      REAL(KIND=wp) :: pa   !  lon1 - lon2
+      REAL(KIND=wp) :: pb   !  lat1 - lat2
+      REAL(KIND=wp) :: pc   !  cos(lat2)
+
+      grt_cir_dis_saa = SQRT( pa * pa + ( pb * pc )**2 )
+
+   END FUNCTION grt_cir_dis_saa
+ 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/linquad.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/linquad.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/linquad.h90	(revision 2236)
@@ -0,0 +1,53 @@
+   LOGICAL FUNCTION linquad( px, py, pxv, pyv )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION linquad ***
+      !!
+      !! ** Purpose : Determine whether a point P(x,y) lies within or on the
+      !!              boundary of a quadrangle (ABCD) of any shape on a plane.
+      !!
+      !! ** Method  : Check if the vectorial products PA x PC, PB x PA, 
+      !!              PC x PD, and PD x PB are all negative.
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  2001-11  (N. Daget, A. Weaver)
+      !!        !  2006-08  (A. Weaver) NEMOVAR migration
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: px        ! (lon) of the point P(x,y) 
+      REAL(KIND=wp), INTENT(IN) :: py        ! (lat) of the point P(x,y)               
+      REAL(KIND=wp), DIMENSION(4), INTENT(IN) :: &
+         & pxv,  &                  ! (lon, lat) of the surrounding cell
+         & pyv                     
+  
+      !! * Local declarations
+      REAL(KIND=wp) :: zst1
+      REAL(KIND=wp) :: zst2
+      REAL(KIND=wp) :: zst3
+      REAL(KIND=wp) :: zst4
+
+      !-----------------------------------------------------------------------
+      ! Test to see if the point is within the cell
+      !-----------------------------------------------------------------------
+      linquad = .FALSE.
+      zst1 =   ( px - pxv(1) ) * ( py - pyv(4) ) &
+         &   - ( py - pyv(1) ) * ( px - pxv(4) )
+      IF ( zst1 <= 0.0 ) THEN
+         zst2 =   ( px - pxv(4) ) * ( py - pyv(3) ) &
+         &   - ( py - pyv(4) ) * ( px - pxv(3) )
+         IF ( zst2 <= 0.0 ) THEN
+            zst3 =   ( px - pxv(3) ) * ( py - pyv(2) ) &
+               &   - ( py - pyv(3) ) * ( px - pxv(2) )
+            IF ( zst3 <= 0.0) THEN
+               zst4 =   ( px - pxv(2) ) * ( py - pyv(1) ) &
+                  &   - ( py - pyv(2) ) * ( px - pxv(1) )
+               IF ( zst4 <= 0.0 ) linquad = .TRUE.
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END FUNCTION linquad
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/maxdist.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/maxdist.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/maxdist.h90	(revision 2236)
@@ -0,0 +1,70 @@
+   REAL FUNCTION maxdist( pxv, pyv )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION maxdist ***
+      !!
+      !! ** Purpose : Compute the maximum distance between any points within
+      !!              a cell
+      !!
+      !! ** Method  : Call to grt_cir_dis
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  2006-08  (K. Mogensen)
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), DIMENSION(4), INTENT(IN) :: &
+          & pxv, &                 ! (lon, lat) of the surrounding cell
+          & pyv    
+
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(4) :: &
+          &  zxv, &
+          &  zyv, &
+          &  za,  &
+          &  zb,  &
+          &  zc
+      REAL(KIND=wp) :: zdist
+      
+      INTEGER :: ji
+      INTEGER :: jj
+      
+      !-----------------------------------------------------------------------
+      ! Convert data to radians
+      !-----------------------------------------------------------------------
+      DO ji = 1, 4
+         zxv(ji) = pxv(ji) * rad
+         zyv(ji) = pyv(ji) * rad
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Prepare input to grt_cir_dis
+      !-----------------------------------------------------------------------
+      DO ji = 1, 4
+         za(ji) = SIN( zyv(ji) )
+         zb(ji) = COS( zyv(ji) ) * COS( zxv(ji) )
+         zc(ji) = COS( zyv(ji) ) * SIN( zxv(ji) )
+      END DO
+      
+      !-----------------------------------------------------------------------
+      ! Get max distance between any points in the area
+      !-----------------------------------------------------------------------
+      maxdist = 0.0
+      DO jj = 1, 4
+         DO ji = jj+1, 4
+            zdist = grt_cir_dis( za(jj), za(ji), zb(jj), &
+               &                 zb(ji), zc(jj), zc(ji))
+            IF ( zdist > maxdist ) THEN
+               maxdist = zdist
+            ENDIF
+         END DO
+      END DO
+      
+      !-----------------------------------------------------------------------
+      ! Convert to degrees.
+      !-----------------------------------------------------------------------
+      maxdist = maxdist / rad
+
+   END FUNCTION maxdist
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/mpp_map.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 2236)
@@ -0,0 +1,106 @@
+MODULE mpp_map
+   !!======================================================================
+   !!                       ***  MODULE mpp_mpa  ***
+   !! NEMOVAR: MPP global grid point mapping to processors
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !! mppmap      : Global array which maps i,j to area number.
+   !! mppmap_init : Initialize mppmap.
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind, ONLY : &   ! Precision variables
+      & wp
+   USE par_oce, ONLY : &    ! Ocean parameters
+      & jpi,   &
+      & jpj
+   USE dom_oce, ONLY : &    ! Ocean space and time domain variables
+      & mig,   &
+      & mjg,   &  
+      & nldi,  &
+      & nlei,  &
+      & nldj,  &
+      & nlej,  &
+      & narea 
+#if defined key_mpp_mpi
+   USE lib_mpp, ONLY : &    ! MPP library
+      & mpi_comm_opa
+#endif
+   USE in_out_manager
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC &
+      & mppmap_init,        &
+      & mppmap
+
+   !! * Module variables
+
+   INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+      & mppmap
+
+CONTAINS
+
+   SUBROUTINE mppmap_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mppmap_init ***
+      !!          
+      !! ** Purpose : Setup a global map of processor rank for all gridpoints
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  07-08  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: imppmap
+#if defined key_mpp_mpi
+      !! * Local declarations
+      INTEGER :: ierr
+#     include <mpif.h>
+#endif
+
+      ALLOCATE( &
+         & mppmap(jpiglo,jpjglo) &
+         & )
+
+      ! Initialize local imppmap
+
+      ALLOCATE( &
+         & imppmap(jpiglo,jpjglo) &
+         & )
+      imppmap(:,:) = 0
+
+      ! Setup local grid points
+      imppmap(mig(nldi):mig(nlei),mjg(nldj):mjg(nlej)) = narea 
+      
+      ! Get global data
+
+#if defined key_mpp_mpi
+
+      ! Call the MPI library to find the max across processors
+
+      CALL mpi_allreduce( imppmap, mppmap, jpiglo*jpjglo, mpi_integer, &
+         &                mpi_max, mpi_comm_opa, ierr )
+#elif defined key_mpp_shmem
+#error "Only MPI support for MPP in NEMOVAR"
+#else      
+      
+      ! Just copy the data
+
+      mppmap(:,:) = imppmap(:,:)
+
+#endif
+
+   END SUBROUTINE mppmap_init
+
+END MODULE mpp_map
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_const.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_const.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_const.F90	(revision 2236)
@@ -0,0 +1,17 @@
+MODULE obs_const
+   !!=====================================================================
+   !!                       ***  MODULE obs_const  ***
+   !! Observation diagnostics: Constants used by many modules
+   !!===================================================================== 
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & sp         
+   IMPLICIT NONE
+
+   !! * Routine/type accessibility
+   PUBLIC
+
+   REAL(kind=sp), PARAMETER :: obfillflt=99999.
+
+END MODULE obs_const
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_conv.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_conv.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_conv.F90	(revision 2236)
@@ -0,0 +1,40 @@
+MODULE obs_conv
+   !!=====================================================================
+   !!                       ***  MODULE  obs_conv  ***
+   !! Observation diagnostics: Various conversion functions
+   !!=====================================================================
+   !!
+   !!   potemp   : Compute potential temperature from insitu temperature,
+   !!              salinity and pressure
+   !!   fspott   : Compute potential temperature from insitu temperature,
+   !!              salinity and pressure
+   !!   atg      : Compute adiabatic temperature gradient deg c per decibar
+   !!   theta    : Compute potential temperature from insitu temperature,
+   !!              salinity and pressure
+   !!   depth    : Compute depth from pressure and latitude.
+   !!   p_to_dep : Compute depth from pressure and latitude 
+   !!              (approximate version)
+   !!   dep_to_p : Compute pressure from depth and latitude 
+   !!              (approximate version)
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp   
+   IMPLICIT NONE
+ 
+   !! * Function accessibility
+   PRIVATE
+   PUBLIC &
+      & potemp,   &
+      & fspott,   &
+      & atg,      &
+      & theta,    &
+      & depth,    &
+      & p_to_dep, &
+      & dep_to_p
+   
+CONTAINS
+
+#include "obs_conv_functions.h90"
+
+END MODULE obs_conv
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_conv_functions.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_conv_functions.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_conv_functions.h90	(revision 2236)
@@ -0,0 +1,288 @@
+   REAL(KIND=wp) FUNCTION potemp( ps, pt, pp, ppr )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION potemp  ***
+      !!          
+      !! ** Purpose : Compute potential temperature
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: potemp(35,20,2000,0) = 19.621967
+      !!
+      !! References : T. J. Mcdougall, D. R. Jackett, D. G. Wright 
+      !!              and R. Feistel
+      !!              Accurate and computationally efficient algoritms for
+      !!              potential temperatures and density of seawater
+      !!              Journal of atmospheric and oceanic technology
+      !!              Vol 20, 2003, pp 730-741
+      !!              
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+
+      REAL(KIND=wp), INTENT(IN) :: ps
+      REAL(KIND=wp), INTENT(IN) :: pt
+      REAL(KIND=wp), INTENT(IN) :: pp
+      REAL(KIND=wp), INTENT(IN) :: ppr
+
+      !! * Local declarations
+      REAL(KIND=wp) :: zpol
+      REAL(KIND=wp), PARAMETER :: a1 =  1.067610e-05
+      REAL(KIND=wp), PARAMETER :: a2 = -1.434297e-06
+      REAL(KIND=wp), PARAMETER :: a3 = -7.566349e-09
+      REAL(KIND=wp), PARAMETER :: a4 = -8.535585e-06
+      REAL(KIND=wp), PARAMETER :: a5 =  3.074672e-08
+      REAL(KIND=wp), PARAMETER :: a6 =  1.918639e-08
+      REAL(KIND=wp), PARAMETER :: a7 =  1.788718e-10
+
+      zpol = a1 + a2 * ps + a3 * ( pp + ppr ) + a4 * pt &
+         & + a5 * ps * pt + a6 * pt * pt + a7 * pt * ( pp + ppr )
+      
+      potemp = pt + ( pp - ppr ) * zpol
+      
+   END FUNCTION potemp
+
+   REAL(KIND=wp) FUNCTION fspott( pft, pfs, pfp )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION fspott  ***
+      !!          
+      !! ** Purpose : Compute potential temperature
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : Check value: fspott(10,25,1000) = 8.4678516
+      !!
+      !! References : A. E. Gill
+      !!              Atmosphere-Ocean Dynamics
+      !!              Volume 30 (International Geophysics)
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) NEMO adopting of OPAVAR code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp) :: pft   ! in situ temperature in degrees celcius
+      REAL(KIND=wp) :: pfs   ! salinity in psu
+      REAL(KIND=wp) :: pfp   ! pressure in bars
+      
+      fspott = &
+         &  pft - pfp * (   (            3.6504e-4                     &
+         &                    + pft * (  8.3198e-5                     &
+         &                    + pft * ( -5.4065e-7                     &
+         &                    + pft *    4.0274e-9  ) ) )              &
+         &                + ( pfs - 35.0 ) * (         1.7439e-5       &
+         &                                     - pft * 2.9778e-7 )     &
+         &                + pfp * (            8.9309e-7               &
+         &                          + pft * ( -3.1628e-8               &
+         &                          + pft *    2.1987e-10 )            &
+         &                          - ( pfs - 35.0 ) *  4.1057e-9      &
+         &                          + pfp * (          -1.6056e-10     &
+         &                                    + pft * 5.0484e-12 ) ) )
+
+   END FUNCTION fspott
+
+   REAL(KIND=wp) FUNCTION atg( p_s, p_t, p_p )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION atg  ***
+      !!          
+      !! ** Purpose : Compute adiabatic temperature gradient deg c per decibar
+      !!
+      !! ** Method  : A regression formula is used
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: atg(40,40,10000) = 3.255974e-4
+      !!
+      !! References : N. P. Fotonoff and R.C. Millard jr., 
+      !!              Algoritms for computation of fundamental
+      !!              properties of seawater
+      !!              Unesco technical papers in marine science 44
+      !!              Unesco 1983
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code based on the F77 code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+
+      REAL(KIND=wp), INTENT(IN) :: p_s    ! Salinity in PSU
+      REAL(KIND=wp), INTENT(IN) :: p_t    ! Temperature in centigrades
+      REAL(KIND=wp), INTENT(IN) :: p_p    ! Pressure in decibars.
+
+      !! * Local declarations
+      
+      REAL(KIND=wp) :: z_ds
+
+      z_ds = p_s - 35.0
+      atg = ((( -2.1687e-16 * p_t + 1.8676e-14 ) * p_t - 4.6206e-13 ) * p_p      &
+         &  + (( 2.7759e-12 * p_t - 1.1351e-10 ) * z_ds + (( - 5.4481e-14 * p_t  &  
+         &  + 8.733e-12 ) * p_t - 6.7795e-10 ) * p_t  + 1.8741e-8)) * p_p        &
+         &  + ( -4.2393e-8 * p_t + 1.8932e-6 ) * z_ds                          &
+         &  + (( 6.6228e-10 * p_t - 6.836e-8 ) * p_t + 8.5258e-6 ) * p_t + 3.5803e-5
+
+   END FUNCTION atg
+      
+   REAL(KIND=wp) FUNCTION theta( p_s, p_t0, p_p0, p_pr )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION theta  ***
+      !!          
+      !! ** Purpose : Compute potential temperature
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: theta(40,40,10000,0) = 36.89073
+      !!
+      !! References : N. P. Fotonoff and R.C. Millard jr., 
+      !!              Algoritms for computation of fundamental
+      !!              properties of seawater
+      !!              Unesco technical papers in marine science 44
+      !!              Unesco 1983
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code based on the F77 code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_s
+      REAL(KIND=wp), INTENT(IN) :: p_t0
+      REAL(KIND=wp), INTENT(IN) :: p_p0
+      REAL(KIND=wp), INTENT(IN) :: p_pr
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_p
+      REAL(KIND=wp) :: z_t
+      REAL(KIND=wp) :: z_h
+      REAL(KIND=wp) :: z_xk
+      REAL(KIND=wp) :: z_q
+
+      z_p = p_p0
+      z_t = p_t0
+      z_h = p_pr - z_p
+      z_xk = z_h * atg( p_s, z_t, z_p ) 
+      Z_t = z_t + 0.5 * z_xk
+      z_q = z_xk
+      z_p = z_p + 0.5 * z_h
+      z_xk = z_h * atg( p_s, z_t, z_p )
+      z_t = z_t + 0.29289322 * ( z_xk - z_q )
+      z_q = 0.58578644 * z_xk + 0.121320344 * z_q
+      z_xk = z_h * atg( p_s, z_t, z_p )
+      z_t = z_t + 1.707106781 * ( z_xk - z_q )
+      z_q = 3.414213562 * z_xk - 4.121320244 * z_q
+      z_p = z_p + 0.5 * z_h
+      z_xk = z_h * atg( p_s, z_t, z_p )
+      theta = z_t + ( z_xk - 2.0 * z_q ) / 6.0
+
+   END FUNCTION theta
+
+   REAL(KIND=wp) FUNCTION depth( p_p, p_lat )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION depth  ***
+      !!          
+      !! ** Purpose : Compute depth from pressure and latitudes
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: depth(10000,30) = 9712.653
+      !!
+      !! References : N. P. Fotonoff and R.C. Millard jr., 
+      !!              Algoritms for computation of fundamental
+      !!              properties of seawater
+      !!              Unesco technical papers in marine science 44
+      !!              Unesco 1983
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code based on the F77 code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_p     ! Pressure in decibars
+      REAL(KIND=wp), INTENT(IN) :: p_lat   ! Latitude in degrees
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_x
+      REAL(KIND=wp) :: z_gr
+      
+      z_x = SIN( p_lat / 57.29578 )
+      z_x = z_x * z_x
+      z_gr = 9.780318 * ( 1.0 + ( 5.2788e-3 + 2.36e-5 * z_x ) * z_x ) + 1.092e-6 * p_p
+      depth = ((( -1.82e-15 * p_p + 2.279e-10 ) * p_p - 2.2512e-5 ) * p_p + 9.72659 ) * p_p
+      depth = depth / z_gr
+
+   END FUNCTION depth
+
+   REAL(KIND=wp) FUNCTION p_to_dep( p_p, p_lat )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION p_to_dep  ***
+      !!          
+      !! ** Purpose : Compute depth from pressure and latitudes
+      !!
+      !! ** Method  : A regression formula is used. This version is less
+      !!              accurate the "depth" but invertible.
+      !!
+      !! ** Action  : 
+      !!
+      !! References : P.M Saunders
+      !!              Pratical conversion of pressure to depth
+      !!              Journal of physical oceanography Vol 11, 1981, pp 573-574
+      !!
+      !! History :
+      !!        !  07-05  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_p    ! Pressure in decibars
+      REAL(KIND=wp), INTENT(IN) :: p_lat  ! Latitude in degrees
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_x
+      REAL(KIND=wp) :: z_c1
+      REAL(KIND=wp) :: z_c2
+
+      z_x = SIN( p_lat / 57.29578 )
+      z_x = z_x * z_x
+      z_c1 = ( 5.92  + 5.25 * z_x ) * 1e-3 
+      z_c2 = 2.21e-6 
+      p_to_dep = (1 - z_c1)  * p_p - z_c2 * p_p * p_p
+
+   END FUNCTION p_to_dep
+
+   REAL(KIND=wp) FUNCTION dep_to_p( p_dep, p_lat )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION dep_to_p  ***
+      !!          
+      !! ** Purpose : Compute depth from pressure and latitudes
+      !!
+      !! ** Method  : The expression used in p_to_dep is inverted.
+      !!
+      !! ** Action  : 
+      !!
+      !! References : P.M Saunders
+      !!              Pratical conversion of pressure to depth
+      !!              Journal of physical oceanography Vol 11, 1981, pp 573-574
+      !!
+      !! History :
+      !!        !  07-05  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_dep    ! Depth in meters
+      REAL(KIND=wp), INTENT(IN) :: p_lat    ! Latitude in degrees
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_x
+      REAL(KIND=wp) :: z_c1
+      REAL(KIND=wp) :: z_c2
+      REAL(KIND=wp) :: z_d
+
+      z_x = SIN( p_lat / 57.29578 )
+      z_x = z_x * z_x
+      z_c1 = ( 5.92  + 5.25 * z_x ) * 1e-3 
+      z_c2 = 2.21e-6 
+      z_d = ( z_c1 - 1 ) * ( z_c1 - 1  ) - 4 * z_c2 * p_dep
+      dep_to_p = (( 1 - z_c1 ) - SQRT( z_d )) / ( 2 * z_c2 )
+
+   END FUNCTION dep_to_p
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_fbm.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 2236)
@@ -0,0 +1,1992 @@
+MODULE obs_fbm
+   !!======================================================================
+   !!                       ***  MODULE obs_fbm  ***
+   !! Observation operators : I/O + tools for feedback files
+   !!======================================================================
+   !! History : 
+   !!             !  08-11  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   init_obfbdata     :  Initialize sizes in obfbdata structure
+   !!   alloc_obfbdata    :  Allocate data in an obfbdata structure
+   !!   dealloc_obfbdata  :  Dellocate data in an obfbdata structure
+   !!   copy_obfbdata     :  Copy an obfbdata structure
+   !!   subsamp_obfbdata  :  Sumsample an obfbdata structure
+   !!   merge_obfbdata    :  Merge multiple obfbdata structures into an one.
+   !!   write_obfbdata    :  Write an obfbdata structure into a netCDF file.
+   !!   read_obfbdata     :  Read an obfbdata structure from a netCDF file.
+   !!----------------------------------------------------------------------
+   USE netcdf
+   USE obs_utils      ! Various utilities for observation operators
+
+   IMPLICIT NONE
+   PUBLIC
+
+   ! Type kinds for feedback data.
+
+   INTEGER, PARAMETER :: fbsp = SELECTED_REAL_KIND( 6, 37) !: single precision
+   INTEGER, PARAMETER :: fbdp = SELECTED_REAL_KIND(12,307) !: double precision
+
+   ! Parameters for string lengths.
+
+   INTEGER, PARAMETER    :: ilenwmo  = 8    !: Length of station identifier
+   INTEGER, PARAMETER    :: ilentyp  = 4    !: Length of type
+   INTEGER, PARAMETER    :: ilenname = 8    !: Length of variable names
+   INTEGER, PARAMETER    :: ilengrid = 1    !: Grid (e.g. 'T') length
+   INTEGER, PARAMETER    :: ilenjuld = 14   !: Lenght of reference julian date
+   INTEGER, PARAMETER    :: idefnqcf = 2    !: Default number of words in QC
+                                            !  flags
+   INTEGER, PARAMETER    :: ilenlong = 128  !: Length of long name
+   INTEGER, PARAMETER    :: ilenunit = 32   !: Length of units
+   
+   ! Missinge data indicators 
+   
+   INTEGER, PARAMETER    :: fbimdi = -99999   !: Integers
+   REAL(fbsp), PARAMETER :: fbrmdi =  99999   !: Reals
+   
+   ! Main data structure for observation feedback data.
+
+   TYPE obfbdata
+      LOGICAL :: lalloc         !: Allocation status for data
+      LOGICAL :: lgrid          !: Include grid search info
+      INTEGER :: nvar           !: Number of variables
+      INTEGER :: nobs           !: Number of observations
+      INTEGER :: nlev           !: Number of levels
+      INTEGER :: nadd           !: Number of additional entries
+      INTEGER :: next           !: Number of extra variables
+      INTEGER :: nqcf           !: Number of words per qc flag
+      CHARACTER(LEN=ilenwmo), DIMENSION(:), POINTER :: &
+         & cdwmo                !: Identifier
+      CHARACTER(LEN=ilentyp), DIMENSION(:), POINTER :: &
+         & cdtyp                !: Instrument type
+      CHARACTER(LEN=ilenjuld) :: &
+         & cdjuldref            !: Julian date reference
+      INTEGER, DIMENSION(:), POINTER :: &
+         & kindex               !: Index of observations in the original file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & ioqc, &              !: Observation QC
+         & ipqc, &              !: Position QC
+         & itqc                 !: Time QC
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & ioqcf, &             !: Observation QC flags
+         & ipqcf, &             !: Position QC flags
+         & itqcf                !: Time QC flags
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & idqc                 !: Depth QC
+      INTEGER, DIMENSION(:,:,:), POINTER :: &
+         & idqcf                !: Depth QC flags
+      REAL(KIND=fbdp), DIMENSION(:), POINTER :: &
+         & plam, &              !: Longitude
+         & pphi, &              !: Latitude
+         & ptim                 !: Time
+      REAL(KIND=fbsp), DIMENSION(:,:), POINTER :: &
+         & pdep                 !: Depth
+      CHARACTER(LEN=ilenname), DIMENSION(:), POINTER  :: &
+         & cname                !: Name of variable
+      REAL(fbsp), DIMENSION(:,:,:), POINTER :: &
+         & pob                  !: Observation
+      CHARACTER(LEN=ilenlong), DIMENSION(:), POINTER :: &
+         & coblong              !: Observation long name (for output)
+      CHARACTER(LEN=ilenunit), DIMENSION(:), POINTER :: &
+         & cobunit              !: Observation units (for output)
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & ivqc                 !: Variable QC
+      INTEGER, DIMENSION(:,:,:), POINTER :: &
+         & ivqcf                !: Variable QC flags
+      INTEGER, DIMENSION(:,:,:), POINTER :: &
+         & ivlqc                !: Variable level QC
+      INTEGER, DIMENSION(:,:,:,:), POINTER :: &
+         & ivlqcf               !: Variable level QC flags
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & iproc, &             !: Processor of obs (no I/O for this variable).
+         & iobsi, &             !: Global i index
+         & iobsj                !: Global j index
+      INTEGER, DIMENSION(:,:,:), POINTER :: &
+         & iobsk                !: k index
+      CHARACTER(LEN=ilengrid), DIMENSION(:), POINTER  :: &
+         & cgrid                !: Grid for this variable
+      CHARACTER(LEN=ilenname), DIMENSION(:), POINTER :: &
+         & caddname             !: Additional entries names
+      CHARACTER(LEN=ilenlong), DIMENSION(:,:), POINTER :: &
+         & caddlong             !: Additional entries long name (for output)
+      CHARACTER(LEN=ilenunit), DIMENSION(:,:), POINTER :: &
+         & caddunit             !: Additional entries units (for output)
+      REAL(fbsp), DIMENSION(:,:,:,:)   , POINTER :: &
+         & padd                 !: Additional entries
+      CHARACTER(LEN=ilenname), DIMENSION(:), POINTER :: &
+         & cextname             !: Extra variables names
+      CHARACTER(LEN=ilenlong), DIMENSION(:), POINTER :: &
+         & cextlong             !: Extra variables long name (for output)
+      CHARACTER(LEN=ilenunit), DIMENSION(:), POINTER :: &
+         & cextunit             !: Extra variables units (for output)
+      REAL(fbsp), DIMENSION(:,:,:)   , POINTER :: &
+         & pext                 !: Extra variables
+   END TYPE obfbdata
+
+   PRIVATE putvaratt_obfbdata
+
+CONTAINS
+
+   SUBROUTINE init_obfbdata( fbdata )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE init_obfbdata  ***
+      !!
+      !! ** Purpose :   Initialize sizes in obfbdata structure
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) :: fbdata      ! obsfbdata structure
+
+      fbdata%nvar   = 0
+      fbdata%nobs   = 0
+      fbdata%nlev   = 0
+      fbdata%nadd   = 0
+      fbdata%next   = 0
+      fbdata%nqcf   = idefnqcf
+      fbdata%lalloc = .FALSE.
+      fbdata%lgrid  = .FALSE.
+
+   END SUBROUTINE init_obfbdata
+   
+   SUBROUTINE alloc_obfbdata( fbdata, kvar, kobs, klev, kadd, kext, lgrid, &
+      &                       kqcf)
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE alloc_obfbdata  ***
+      !!
+      !! ** Purpose :   Allocate data in an obfbdata structure
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) ::  fbdata          ! obsfbdata structure to be allocated
+      INTEGER, INTENT(IN) :: kvar        ! Number of variables
+      INTEGER, INTENT(IN) :: kobs        ! Number of observations
+      INTEGER, INTENT(IN) :: klev        ! Number of levels
+      INTEGER, INTENT(IN) :: kadd        ! Number of additional entries
+      INTEGER, INTENT(IN) :: kext        ! Number of extra variables
+      LOGICAL, INTENT(IN) :: lgrid       ! Include grid search information
+      INTEGER, OPTIONAL ::  kqcf         ! Number of words for QC flags
+      !! * Local variables
+      INTEGER :: ji
+      INTEGER :: jv
+
+      ! Check allocation status and deallocate previous allocated structures
+
+      IF ( fbdata%lalloc ) THEN
+         CALL dealloc_obfbdata( fbdata )
+      ENDIF
+
+      ! Set dimensions
+
+      fbdata%lalloc = .TRUE.
+      fbdata%nvar   = kvar
+      fbdata%nobs   = kobs
+      fbdata%nlev   = MAX( klev, 1 )
+      fbdata%nadd   = kadd
+      fbdata%next   = kext
+      IF ( PRESENT(kqcf) ) THEN
+         fbdata%nqcf = kqcf
+      ELSE
+         fbdata%nqcf = idefnqcf
+      ENDIF
+
+      ! Set data not depending on number of observations
+
+      fbdata%cdjuldref  = REPEAT( 'X', ilenjuld )
+
+      ! Allocate and initialize standard data 
+
+      ALLOCATE( &
+         & fbdata%cname(fbdata%nvar),   &
+         & fbdata%coblong(fbdata%nvar), &
+         & fbdata%cobunit(fbdata%nvar)  &
+         & )
+      DO ji = 1, fbdata%nvar
+         WRITE(fbdata%cname(ji),'(A,I2.2)')'V_',ji
+         fbdata%coblong(ji) = REPEAT( ' ', ilenlong )
+         fbdata%cobunit(ji) = REPEAT( ' ', ilenunit )
+      END DO
+
+      ! Optionally also store grid search information
+      
+      IF ( lgrid ) THEN
+         ALLOCATE ( &
+            & fbdata%cgrid(fbdata%nvar) &
+            & )
+         fbdata%cgrid(:)      = REPEAT( 'X', ilengrid )
+         fbdata%lgrid         = .TRUE.
+      ENDIF
+         
+      ! Allocate and initialize additional entries if present
+         
+      IF ( fbdata%nadd > 0 ) THEN
+         ALLOCATE( &
+            & fbdata%caddname(fbdata%nadd),              &
+            & fbdata%caddlong(fbdata%nadd, fbdata%nvar), &
+            & fbdata%caddunit(fbdata%nadd, fbdata%nvar)  &
+            & )
+         DO ji = 1, fbdata%nadd
+            WRITE(fbdata%caddname(ji),'(A,I2.2)')'A',ji
+         END DO
+         DO jv = 1, fbdata%nvar
+            DO ji = 1, fbdata%nadd
+               fbdata%caddlong(ji,jv) = REPEAT( ' ', ilenlong )
+               fbdata%caddunit(ji,jv) = REPEAT( ' ', ilenunit )
+            END DO
+         END DO
+      ENDIF
+         
+      ! Allocate and initialize additional variables if present
+         
+      IF ( fbdata%next > 0 ) THEN
+         ALLOCATE( &
+            & fbdata%cextname(fbdata%next), &
+            & fbdata%cextlong(fbdata%next), &
+            & fbdata%cextunit(fbdata%next)  &
+            & )
+         DO ji = 1, fbdata%next
+            WRITE(fbdata%cextname(ji),'(A,I2.2)')'E_',ji
+            fbdata%cextlong(ji) = REPEAT( ' ', ilenlong )
+            fbdata%cextunit(ji) = REPEAT( ' ', ilenunit )
+         END DO
+      ENDIF
+
+      ! Data depending on number of observations is only allocated if nobs>0
+
+      IF ( fbdata%nobs > 0 ) THEN
+
+         ALLOCATE( &
+            & fbdata%cdwmo(fbdata%nobs),                                      &
+            & fbdata%cdtyp(fbdata%nobs),                                      &
+            & fbdata%ioqc(fbdata%nobs),                                       &
+            & fbdata%ioqcf(fbdata%nqcf,fbdata%nobs),                          &
+            & fbdata%ipqc(fbdata%nobs),                                       &
+            & fbdata%ipqcf(fbdata%nqcf,fbdata%nobs),                          &
+            & fbdata%itqc(fbdata%nobs),                                       &
+            & fbdata%itqcf(fbdata%nqcf,fbdata%nobs),                          &
+            & fbdata%idqc(fbdata%nlev,fbdata%nobs),                           &
+            & fbdata%idqcf(fbdata%nqcf,fbdata%nlev,fbdata%nobs),              &
+            & fbdata%plam(fbdata%nobs),                                       &
+            & fbdata%pphi(fbdata%nobs),                                       &
+            & fbdata%pdep(fbdata%nlev,fbdata%nobs),                           &
+            & fbdata%ptim(fbdata%nobs),                                       &
+            & fbdata%kindex(fbdata%nobs),                                     &
+            & fbdata%ivqc(fbdata%nobs,fbdata%nvar),                           &
+            & fbdata%ivqcf(fbdata%nqcf,fbdata%nobs,fbdata%nvar),              &
+            & fbdata%ivlqc(fbdata%nlev,fbdata%nobs,fbdata%nvar),              &
+            & fbdata%ivlqcf(fbdata%nqcf,fbdata%nlev,fbdata%nobs,fbdata%nvar), &
+            & fbdata%pob(fbdata%nlev,fbdata%nobs,fbdata%nvar)                 &
+            & )
+         fbdata%kindex(:)       = fbimdi
+         fbdata%cdwmo(:)        = REPEAT( 'X', ilenwmo )
+         fbdata%cdtyp(:)        = REPEAT( 'X', ilentyp )
+         fbdata%ioqc(:)         = fbimdi
+         fbdata%ioqcf(:,:)      = fbimdi
+         fbdata%ipqc(:)         = fbimdi
+         fbdata%ipqcf(:,:)      = fbimdi
+         fbdata%itqc(:)         = fbimdi
+         fbdata%itqcf(:,:)      = fbimdi
+         fbdata%idqc(:,:)       = fbimdi
+         fbdata%idqcf(:,:,:)    = fbimdi
+         fbdata%plam(:)         = fbrmdi
+         fbdata%pphi(:)         = fbrmdi
+         fbdata%pdep(:,:)       = fbrmdi
+         fbdata%ptim(:)         = fbrmdi
+         fbdata%ivqc(:,:)       = fbimdi
+         fbdata%ivqcf(:,:,:)    = fbimdi
+         fbdata%ivlqc(:,:,:)    = fbimdi
+         fbdata%ivlqcf(:,:,:,:) = fbimdi
+         fbdata%pob(:,:,:)      = fbrmdi
+         
+         ! Optionally also store grid search information
+         
+         IF ( lgrid ) THEN
+            ALLOCATE ( &
+               & fbdata%iproc(fbdata%nobs,fbdata%nvar),            &
+               & fbdata%iobsi(fbdata%nobs,fbdata%nvar),            &
+               & fbdata%iobsj(fbdata%nobs,fbdata%nvar),            &
+               & fbdata%iobsk(fbdata%nlev,fbdata%nobs,fbdata%nvar) &
+               & )
+            fbdata%iproc(:,:)    = fbimdi
+            fbdata%iobsi(:,:)    = fbimdi
+            fbdata%iobsj(:,:)    = fbimdi
+            fbdata%iobsk(:,:,:)  = fbimdi
+            fbdata%lgrid         = .TRUE.
+         ENDIF
+         
+         ! Allocate and initialize additional entries if present
+         
+         IF ( fbdata%nadd > 0 ) THEN
+            ALLOCATE( &
+               & fbdata%padd(fbdata%nlev,fbdata%nobs,fbdata%nadd,fbdata%nvar) &
+               & )
+            fbdata%padd(:,:,:,:) = fbrmdi
+         ENDIF
+         
+         ! Allocate and initialize additional variables if present
+         
+         IF ( fbdata%next > 0 ) THEN
+            ALLOCATE( &
+               & fbdata%pext(fbdata%nlev,fbdata%nobs,fbdata%next) &
+               & )
+            fbdata%pext(:,:,:) = fbrmdi
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE alloc_obfbdata
+
+   SUBROUTINE dealloc_obfbdata( fbdata )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dealloc_obfbdata  ***
+      !!
+      !! ** Purpose :   Deallocate data in an obfbdata strucure
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) :: fbdata      ! obsfbdata structure
+
+      ! Deallocate data 
+
+      DEALLOCATE( &
+         & fbdata%cname,  &
+         & fbdata%coblong,&
+         & fbdata%cobunit &
+         & )
+
+      ! Deallocate optional grid search information
+      
+      IF ( fbdata%lgrid ) THEN
+         DEALLOCATE ( &
+            & fbdata%cgrid  &
+            & )
+      ENDIF
+
+      ! Deallocate additional entries
+
+      IF ( fbdata%nadd > 0 ) THEN
+         DEALLOCATE( &
+            & fbdata%caddname, &
+            & fbdata%caddlong, &
+            & fbdata%caddunit  &
+            & )
+      ENDIF
+
+      ! Deallocate extra variables
+
+      IF ( fbdata%next > 0 ) THEN
+         DEALLOCATE( &
+            & fbdata%cextname, &
+            & fbdata%cextlong, &
+            & fbdata%cextunit  &
+            & )
+      ENDIF
+
+      ! Deallocate arrays depending on number of obs (if nobs>0 only).
+
+      IF ( fbdata%nobs > 0 ) THEN
+
+         DEALLOCATE( &
+            & fbdata%cdwmo,  &
+            & fbdata%cdtyp,  &
+            & fbdata%ioqc,   &
+            & fbdata%ioqcf,  &
+            & fbdata%ipqc,   &
+            & fbdata%ipqcf,  &
+            & fbdata%itqc,   &
+            & fbdata%itqcf,  &
+            & fbdata%idqc,   &
+            & fbdata%idqcf,  &
+            & fbdata%plam,   &
+            & fbdata%pphi,   &
+            & fbdata%pdep,   &
+            & fbdata%ptim,   &
+            & fbdata%kindex, &
+            & fbdata%ivqc,   &
+            & fbdata%ivqcf,  &
+            & fbdata%ivlqc,  &
+            & fbdata%ivlqcf, &
+            & fbdata%pob     &
+            & )
+
+
+         ! Deallocate optional grid search information
+      
+         IF ( fbdata%lgrid ) THEN
+            DEALLOCATE ( &
+               & fbdata%iproc, &
+               & fbdata%iobsi, &
+               & fbdata%iobsj, &
+               & fbdata%iobsk  & 
+               & )
+         ENDIF
+
+         ! Deallocate additional entries
+
+         IF ( fbdata%nadd > 0 ) THEN
+            DEALLOCATE( &
+               & fbdata%padd       &
+               & )
+         ENDIF
+
+         ! Deallocate extra variables
+
+         IF ( fbdata%next > 0 ) THEN
+            DEALLOCATE( &
+               & fbdata%pext       &
+               & )
+         ENDIF
+
+      ENDIF
+
+      ! Reset arrays sizes
+
+      fbdata%lalloc = .FALSE.
+      fbdata%lgrid  = .FALSE.
+      fbdata%nvar   = 0
+      fbdata%nobs   = 0
+      fbdata%nlev   = 0
+      fbdata%nadd   = 0
+      fbdata%next   = 0
+   
+   END SUBROUTINE dealloc_obfbdata
+
+   SUBROUTINE copy_obfbdata( fbdata1, fbdata2, kadd, kext, lgrid, kqcf )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE copy_obfbdata  ***
+      !!
+      !! ** Purpose :   Copy an obfbdata structure
+      !!
+      !! ** Method  :   Copy all data from fbdata1 to fbdata2
+      !!                If fbdata2 is allocated it needs to be compliant
+      !!                with fbdata1.
+      !!                Additional entries can be added by setting nadd
+      !!                Additional extra fields can be added by setting next
+      !!                Grid information can be included with lgrid=.true.
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) :: fbdata1               ! Input obsfbdata structure
+      TYPE(obfbdata) :: fbdata2               ! Output obsfbdata structure
+      INTEGER, INTENT(IN), OPTIONAL :: kadd   ! Number of additional entries
+      INTEGER, INTENT(IN), OPTIONAL :: kext   ! Number of extra variables
+      INTEGER, INTENT(IN), OPTIONAL :: kqcf   ! Number of words per qc flags
+      LOGICAL, OPTIONAL :: lgrid              ! Grid info on output file
+
+      !! * Local variables
+      INTEGER :: nadd
+      INTEGER :: next
+      INTEGER :: nqcf
+      LOGICAL :: llgrid
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jq
+
+      ! Check allocation status of fbdata1
+
+      IF ( .NOT. fbdata1%lalloc ) THEN
+         CALL fatal_error( 'copy_obfbdata: input data not allocated', &
+            &              __LINE__ )
+      ENDIF
+      
+      ! If nadd,next not specified use the ones from fbdata1
+      ! Otherwise check that they have large than the original ones
+      
+      IF ( PRESENT(kadd) ) THEN
+         nadd = kadd
+         IF ( nadd < fbdata1%nadd ) THEN
+            CALL warning    ( 'copy_obfbdata: ' // &
+               &              'nadd smaller than input nadd', __LINE__ )
+         ENDIF
+      ELSE
+         nadd = fbdata1%nadd
+      ENDIF
+      IF ( PRESENT(kext) ) THEN
+         next = kext
+         IF ( next < fbdata1%next ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'next smaller than input next', __LINE__ )
+         ENDIF
+      ELSE
+         next = fbdata1%next
+      ENDIF
+      IF ( PRESENT(lgrid) ) THEN
+         llgrid = lgrid
+         IF ( fbdata1%lgrid .AND. (.NOT. llgrid) ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'switching off grid info not possible', &
+               &              __LINE__ )
+         ENDIF
+      ELSE
+         llgrid = fbdata1%lgrid
+      ENDIF
+      IF ( PRESENT(kqcf) ) THEN
+         nqcf = kqcf
+         IF ( nqcf < fbdata1%nqcf ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'nqcf smaller than input nqcf', __LINE__ )
+         ENDIF
+      ELSE
+         nqcf = fbdata1%nqcf
+      ENDIF
+
+      ! Check allocation status of fbdata2 and 
+      ! a) check that it conforms in size if already allocated
+      ! b) allocate it if not already allocated
+      
+      IF ( fbdata2%lalloc ) THEN
+         IF ( fbdata1%nvar > fbdata2%nvar ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output kvar smaller than input kvar', __LINE__ )
+         ENDIF
+         IF ( fbdata1%nobs > fbdata2%nobs ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output kobs smaller than input kobs', __LINE__ )
+         ENDIF
+         IF ( fbdata1%nlev > fbdata2%nlev ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output klev smaller than input klev', __LINE__ )
+         ENDIF
+         IF ( fbdata1%nadd > fbdata2%nadd ) THEN
+            CALL warning    ( 'copy_obfbdata: ' // &
+               &              'output nadd smaller than input nadd', __LINE__ )
+         ENDIF
+         IF ( fbdata1%next > fbdata2%next ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output next smaller than input next', __LINE__ )
+         ENDIF
+         IF ( fbdata1%lgrid .NEQV. fbdata2%lgrid ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'lgrid inconsistent', __LINE__ )
+         ENDIF
+         IF ( fbdata1%next > fbdata2%next ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output next smaller than input next', __LINE__ )
+         ENDIF
+         IF ( fbdata1%nqcf > fbdata2%nqcf ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output  smaller than input kext', __LINE__ )
+         ENDIF
+      ELSE
+         CALL alloc_obfbdata( fbdata2, fbdata1%nvar, fbdata1%nobs, &
+            &                 fbdata1%nlev, nadd, next, llgrid, kqcf = nqcf )
+      ENDIF
+
+      ! Copy the header data
+
+      fbdata2%cdjuldref = fbdata1%cdjuldref
+
+      DO ji = 1, fbdata1%nobs
+         fbdata2%cdwmo(ji)  = fbdata1%cdwmo(ji)
+         fbdata2%cdtyp(ji)  = fbdata1%cdtyp(ji)
+         fbdata2%ioqc(ji)   = fbdata1%ioqc(ji)
+         fbdata2%ipqc(ji)   = fbdata1%ipqc(ji)
+         fbdata2%itqc(ji)   = fbdata1%itqc(ji)
+         fbdata2%plam(ji)   = fbdata1%plam(ji)
+         fbdata2%pphi(ji)   = fbdata1%pphi(ji)
+         fbdata2%ptim(ji)   = fbdata1%ptim(ji)
+         fbdata2%kindex(ji) = fbdata1%kindex(ji)
+         DO jq = 1, fbdata1%nqcf
+            fbdata2%ioqcf(jq,ji)  = fbdata1%ioqcf(jq,ji)
+            fbdata2%ipqcf(jq,ji)  = fbdata1%ipqcf(jq,ji)
+            fbdata2%itqcf(jq,ji)  = fbdata1%itqcf(jq,ji)
+         END DO
+         DO jk = 1, fbdata1%nlev
+            fbdata2%idqc(jk,ji)  = fbdata1%idqc(jk,ji)
+            fbdata2%pdep(jk,ji)  = fbdata1%pdep(jk,ji)
+            DO jq = 1, fbdata1%nqcf
+               fbdata2%idqcf(jq,jk,ji) = fbdata1%idqcf(jq,jk,ji)
+            END DO
+         END DO
+      END DO
+
+      ! Copy the variable data
+
+      DO jv = 1, fbdata1%nvar
+         fbdata2%cname(jv) = fbdata1%cname(jv)
+         fbdata2%coblong(jv) = fbdata1%coblong(jv)
+         fbdata2%cobunit(jv) = fbdata1%cobunit(jv)
+         DO ji = 1, fbdata1%nobs
+            fbdata2%ivqc(ji,jv)  = fbdata1%ivqc(ji,jv)
+            DO jq = 1, fbdata1%nqcf
+               fbdata2%ivqcf(jq,ji,jv) = fbdata1%ivqcf(jq,ji,jv)
+            END DO
+            DO jk = 1, fbdata1%nlev
+               fbdata2%ivlqc(jk,ji,jv)  = fbdata1%ivlqc(jk,ji,jv)
+               fbdata2%pob(jk,ji,jv)    = fbdata1%pob(jk,ji,jv)
+               DO jq = 1, fbdata1%nqcf
+                  fbdata2%ivlqcf(jq,jk,ji,jv) = fbdata1%ivlqcf(jq,jk,ji,jv)
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Copy grid information
+      
+      IF ( fbdata1%lgrid ) THEN
+         DO jv = 1, fbdata1%nvar
+            fbdata2%cgrid(jv) = fbdata1%cgrid(jv)
+            DO ji = 1, fbdata1%nobs
+               fbdata2%iproc(ji,jv) = fbdata1%iproc(ji,jv)
+               fbdata2%iobsi(ji,jv) = fbdata1%iobsi(ji,jv)
+               fbdata2%iobsj(ji,jv) = fbdata1%iobsj(ji,jv)
+               DO jk = 1, fbdata1%nlev
+                  fbdata2%iobsk(jk,ji,jv)  = fbdata1%iobsk(jk,ji,jv)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Copy additional information
+      
+      DO je = 1, MIN( fbdata1%nadd, fbdata2%nadd )
+         fbdata2%caddname(je) = fbdata1%caddname(je)
+      END DO
+      DO jv = 1, fbdata1%nvar
+         DO je = 1, MIN( fbdata1%nadd, fbdata2%nadd )
+            fbdata2%caddlong(je,jv) = fbdata1%caddlong(je,jv)
+            fbdata2%caddunit(je,jv) = fbdata1%caddunit(je,jv)
+            DO ji = 1, fbdata1%nobs
+               DO jk = 1, fbdata1%nlev
+                  fbdata2%padd(jk,ji,je,jv) = fbdata1%padd(jk,ji,je,jv)
+               END DO
+            END DO
+         END DO
+      END DO
+      
+      ! Copy extra information
+
+      DO je = 1, fbdata1%next
+         fbdata2%cextname(je) = fbdata1%cextname(je)
+         fbdata2%cextlong(je) = fbdata1%cextlong(je)
+         fbdata2%cextunit(je) = fbdata1%cextunit(je)
+      END DO
+      DO je = 1, fbdata1%next
+         DO ji = 1, fbdata1%nobs
+            DO jk = 1, fbdata1%nlev
+               fbdata2%pext(jk,ji,je) = fbdata1%pext(jk,ji,je)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE copy_obfbdata
+
+   SUBROUTINE subsamp_obfbdata( fbdata1, fbdata2, llvalid )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE susbamp_obfbdata  ***
+      !!
+      !! ** Purpose :   Subsample an obfbdata structure based on the
+      !!                logical mask.
+      !!
+      !! ** Method  :   Copy all data from fbdata1 to fbdata2 if
+      !!                llvalid(obs)==true
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) :: fbdata1           ! Input obsfbdata structure
+      TYPE(obfbdata) :: fbdata2           ! Output obsfbdata structure
+      LOGICAL, DIMENSION(fbdata1%nobs) :: llvalid     ! Grid info on output file
+      !! * Local variables
+      INTEGER :: nobs
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jq
+      INTEGER :: ij
+
+      ! Check allocation status of fbdata1
+
+      IF ( .NOT. fbdata1%lalloc ) THEN
+         CALL fatal_error( 'copy_obfbdata: input data not allocated', &
+            &              __LINE__ )
+      ENDIF
+      
+      ! Check allocation status of fbdata2 and abort if already allocated
+      
+      IF ( fbdata2%lalloc ) THEN
+         CALL fatal_error( 'subsample_obfbdata: ' // &
+            &              'fbdata2 already allocated', __LINE__ )
+      ENDIF
+      
+      ! Count number of subsampled observations
+
+      nobs = COUNT(llvalid)
+      
+      ! Allocate new data structure
+
+      CALL alloc_obfbdata( fbdata2, fbdata1%nvar, nobs, &
+         &                 fbdata1%nlev, fbdata1%nadd, fbdata1%next, &
+         &                 fbdata1%lgrid, kqcf = fbdata1%nqcf )
+
+      ! Copy the header data
+
+      fbdata2%cdjuldref = fbdata1%cdjuldref
+      
+      ij = 0
+      DO ji = 1, fbdata1%nobs
+         IF ( llvalid(ji) ) THEN
+            ij = ij +1
+            fbdata2%cdwmo(ij)  = fbdata1%cdwmo(ji)
+            fbdata2%cdtyp(ij)  = fbdata1%cdtyp(ji)
+            fbdata2%ioqc(ij)   = fbdata1%ioqc(ji)
+            fbdata2%ipqc(ij)   = fbdata1%ipqc(ji)
+            fbdata2%itqc(ij)   = fbdata1%itqc(ji)
+            fbdata2%plam(ij)   = fbdata1%plam(ji)
+            fbdata2%pphi(ij)   = fbdata1%pphi(ji)
+            fbdata2%ptim(ij)   = fbdata1%ptim(ji)
+            fbdata2%kindex(ij) = fbdata1%kindex(ji)
+            DO jq = 1, fbdata1%nqcf
+               fbdata2%ioqcf(jq,ij)  = fbdata1%ioqcf(jq,ji)
+               fbdata2%ipqcf(jq,ij)  = fbdata1%ipqcf(jq,ji)
+               fbdata2%itqcf(jq,ij)  = fbdata1%itqcf(jq,ji)
+            END DO
+            DO jk = 1, fbdata1%nlev
+               fbdata2%idqc(jk,ij)  = fbdata1%idqc(jk,ji)
+               fbdata2%pdep(jk,ij)  = fbdata1%pdep(jk,ji)
+               DO jq = 1, fbdata1%nqcf
+                  fbdata2%idqcf(jq,jk,ij) = fbdata1%idqcf(jq,jk,ji)
+               END DO
+            END DO
+         ENDIF
+      END DO
+
+      ! Copy the variable data
+
+      DO jv = 1, fbdata1%nvar
+         fbdata2%cname(jv) = fbdata1%cname(jv)
+         fbdata2%coblong(jv) = fbdata1%coblong(jv)
+         fbdata2%cobunit(jv) = fbdata1%cobunit(jv)
+         ij = 0
+         DO ji = 1, fbdata1%nobs
+            IF ( llvalid(ji) ) THEN
+               ij = ij + 1
+               fbdata2%ivqc(ij,jv)  = fbdata1%ivqc(ji,jv)
+               DO jq = 1, fbdata1%nqcf
+                  fbdata2%ivqcf(jq,ij,jv) = fbdata1%ivqcf(jq,ji,jv)
+               END DO
+               DO jk = 1, fbdata1%nlev
+                  fbdata2%ivlqc(jk,ij,jv)  = fbdata1%ivlqc(jk,ji,jv)
+                  fbdata2%pob(jk,ij,jv)    = fbdata1%pob(jk,ji,jv)
+                  DO jq = 1, fbdata1%nqcf
+                     fbdata2%ivlqcf(jq,jk,ij,jv) = fbdata1%ivlqcf(jq,jk,ji,jv)
+                  END DO
+               END DO
+            ENDIF
+         END DO
+      END DO
+
+      ! Copy grid information
+      
+      IF ( fbdata1%lgrid ) THEN
+         DO jv = 1, fbdata1%nvar
+            fbdata2%cgrid(jv) = fbdata1%cgrid(jv)
+            ij = 0
+            DO ji = 1, fbdata1%nobs
+               IF ( llvalid(ji) ) THEN
+                  ij = ij + 1
+                  fbdata2%iproc(ij,jv) = fbdata1%iproc(ji,jv)
+                  fbdata2%iobsi(ij,jv) = fbdata1%iobsi(ji,jv)
+                  fbdata2%iobsj(ij,jv) = fbdata1%iobsj(ji,jv)
+                  DO jk = 1, fbdata1%nlev
+                     fbdata2%iobsk(jk,ij,jv)  = fbdata1%iobsk(jk,ji,jv)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+
+      ! Copy additional information
+      
+      DO je = 1, fbdata1%nadd
+         fbdata2%caddname(je) = fbdata1%caddname(je)
+      END DO
+      DO jv = 1, fbdata1%nvar
+         DO je = 1, fbdata1%nadd
+            fbdata2%caddlong(je,jv) = fbdata1%caddlong(je,jv)
+            fbdata2%caddunit(je,jv) = fbdata1%caddunit(je,jv)
+            ij = 0
+            DO ji = 1, fbdata1%nobs
+               IF ( llvalid(ji) ) THEN
+                  ij = ij + 1
+                  DO jk = 1, fbdata1%nlev
+                     fbdata2%padd(jk,ij,je,jv) = fbdata1%padd(jk,ji,je,jv)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      END DO
+      
+      ! Copy extra information
+
+      DO je = 1, fbdata1%next
+         fbdata2%cextname(je) = fbdata1%cextname(je)
+         fbdata2%cextlong(je) = fbdata1%cextlong(je)
+         fbdata2%cextunit(je) = fbdata1%cextunit(je)
+      END DO
+      DO je = 1, fbdata1%next
+         ij = 0
+         DO ji = 1, fbdata1%nobs
+            IF ( llvalid(ji) ) THEN
+               ij = ij + 1
+               DO jk = 1, fbdata1%nlev
+                  fbdata2%pext(jk,ij,je) = fbdata1%pext(jk,ji,je)
+               END DO
+            ENDIF
+         END DO
+      END DO
+
+   END SUBROUTINE subsamp_obfbdata
+
+   SUBROUTINE merge_obfbdata( nsets, fbdatain, fbdataout, iset, inum, iind )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE merge_obfbdata  ***
+      !!
+      !! ** Purpose :   Merge multiple obfbdata structures into an one.
+      !!
+      !! ** Method  :   The order of elements is based on the indices in
+      !!                iind.
+      !!                All input data are assumed to be consistent. This
+      !!                is assumed to be checked before calling this routine.
+      !!                Likewise output data is assume to be consistent as 
+      !!                well without error checking.
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN):: nsets      ! Number of input data sets 
+      TYPE(obfbdata), DIMENSION(nsets) :: fbdatain  ! Input obsfbdata structure
+      TYPE(obfbdata) :: fbdataout      ! Output obsfbdata structure
+      INTEGER, INTENT(IN), DIMENSION(fbdataout%nobs) :: &
+         & iset                 ! Set number for a given obs.
+      INTEGER, INTENT(IN), DIMENSION(fbdataout%nobs) :: &
+         & inum                 ! Number within set for an obs
+      INTEGER, INTENT(IN), DIMENSION(fbdataout%nobs) :: &
+         & iind                 ! Indices for copying.
+      !! * Local variables
+
+      INTEGER :: js
+      INTEGER :: jo
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jq
+
+      ! Check allocation status of fbdatain 
+      
+      DO js = 1, nsets
+         IF ( .NOT. fbdatain(js)%lalloc ) THEN
+            CALL fatal_error( 'merge_obfbdata: input data not allocated', &
+               &              __LINE__ )
+         ENDIF
+      END DO
+
+      ! Check allocation status of fbdataout
+      
+      IF ( .NOT.fbdataout%lalloc ) THEN
+         CALL fatal_error( 'merge_obfbdata: output data not allocated', &
+            &              __LINE__ )
+      ENDIF
+
+      ! Merge various names
+
+      DO jv = 1, fbdatain(1)%nvar
+         fbdataout%cname(jv) = fbdatain(1)%cname(jv)
+         fbdataout%coblong(jv) = fbdatain(1)%coblong(jv)
+         fbdataout%cobunit(jv) = fbdatain(1)%cobunit(jv)
+         IF ( fbdatain(1)%lgrid ) THEN
+            fbdataout%cgrid(jv) = fbdatain(1)%cgrid(jv)
+         ENDIF
+      END DO
+      DO jv = 1, fbdatain(1)%nadd
+         fbdataout%caddname(jv) = fbdatain(1)%caddname(jv)
+      END DO
+      DO jv = 1, fbdatain(1)%nvar
+         DO je = 1, fbdatain(1)%nadd
+            fbdataout%caddlong(je,jv) = fbdatain(1)%caddlong(je,jv)
+            fbdataout%caddunit(je,jv) = fbdatain(1)%caddunit(je,jv)
+         END DO
+      END DO
+      DO jv = 1, fbdatain(1)%next
+         fbdataout%cextname(jv) = fbdatain(1)%cextname(jv)
+         fbdataout%cextlong(jv) = fbdatain(1)%cextlong(jv)
+         fbdataout%cextunit(jv) = fbdatain(1)%cextunit(jv)
+      END DO
+      fbdataout%cdjuldref = fbdatain(1)%cdjuldref
+
+      ! Loop over total views
+
+      DO jo = 1, fbdataout%nobs
+
+         js = iset(iind(jo))
+         ji = inum(iind(jo))
+
+         ! Merge the header data
+
+         fbdataout%cdwmo(jo)  = fbdatain(js)%cdwmo(ji)
+         fbdataout%cdtyp(jo)  = fbdatain(js)%cdtyp(ji)
+         fbdataout%ioqc(jo)   = fbdatain(js)%ioqc(ji)
+         fbdataout%ipqc(jo)   = fbdatain(js)%ipqc(ji)
+         fbdataout%itqc(jo)   = fbdatain(js)%itqc(ji)
+         fbdataout%plam(jo)   = fbdatain(js)%plam(ji)
+         fbdataout%pphi(jo)   = fbdatain(js)%pphi(ji)
+         fbdataout%ptim(jo)   = fbdatain(js)%ptim(ji)
+         fbdataout%kindex(jo) = fbdatain(js)%kindex(ji)
+         DO jq = 1, fbdatain(js)%nqcf
+            fbdataout%ioqcf(jq,jo)  = fbdatain(js)%ioqcf(jq,ji)
+            fbdataout%ipqcf(jq,jo)  = fbdatain(js)%ipqcf(jq,ji)
+            fbdataout%itqcf(jq,jo)  = fbdatain(js)%itqcf(jq,ji)
+         END DO
+         DO jk = 1, fbdatain(js)%nlev
+            fbdataout%pdep(jk,jo)  = fbdatain(js)%pdep(jk,ji)
+            fbdataout%idqc(jk,jo)  = fbdatain(js)%idqc(jk,ji)
+            DO jq = 1, fbdatain(js)%nqcf
+               fbdataout%idqcf(jq,jk,jo) = fbdatain(js)%idqcf(jq,jk,ji)
+            END DO
+         END DO
+
+         ! Merge the variable data
+
+         DO jv = 1, fbdatain(js)%nvar
+            fbdataout%ivqc(jo,jv)  = fbdatain(js)%ivqc(ji,jv)
+            DO jq = 1, fbdatain(js)%nqcf
+               fbdataout%ivqcf(jq,jo,jv) = fbdatain(js)%ivqcf(jq,ji,jv)
+            END DO
+            DO jk = 1, fbdatain(js)%nlev
+               fbdataout%ivlqc(jk,jo,jv)  = fbdatain(js)%ivlqc(jk,ji,jv)
+               fbdataout%pob(jk,jo,jv)    = fbdatain(js)%pob(jk,ji,jv)
+               DO jq = 1, fbdatain(js)%nqcf
+                  fbdataout%ivlqcf(jq,jk,jo,jv) = &
+                     &                     fbdatain(js)%ivlqcf(jq,jk,ji,jv)
+               END DO
+            END DO
+         END DO
+
+         ! Merge grid information
+         
+         IF ( fbdatain(js)%lgrid ) THEN
+            DO jv = 1, fbdatain(js)%nvar
+               fbdataout%cgrid(jv) = fbdatain(js)%cgrid(jv)
+               fbdataout%iproc(jo,jv) = fbdatain(js)%iproc(ji,jv)
+               fbdataout%iobsi(jo,jv) = fbdatain(js)%iobsi(ji,jv)
+               fbdataout%iobsj(jo,jv) = fbdatain(js)%iobsj(ji,jv)
+               DO jk = 1, fbdatain(js)%nlev
+                  fbdataout%iobsk(jk,jo,jv)  = fbdatain(js)%iobsk(jk,ji,jv)
+               END DO
+            END DO
+         ENDIF
+
+         ! Merge additional information
+      
+         DO jv = 1, fbdatain(js)%nvar
+            DO je = 1, fbdatain(js)%nadd
+               DO jk = 1, fbdatain(js)%nlev
+                  fbdataout%padd(jk,jo,je,jv) = fbdatain(js)%padd(jk,ji,je,jv)
+               END DO
+            END DO
+         END DO
+         
+         ! Merge extra information
+         
+         DO je = 1, fbdatain(js)%next
+            DO jk = 1, fbdatain(js)%nlev
+               fbdataout%pext(jk,jo,je) = fbdatain(js)%pext(jk,ji,je)
+            END DO
+         END DO
+
+      END DO
+
+   END SUBROUTINE merge_obfbdata
+
+   SUBROUTINE write_obfbdata( cdfilename, fbdata )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE write_obfbdata  ***
+      !!
+      !! ** Purpose :   Write an obfbdata structure into a netCDF file.
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=*) :: cdfilename ! Output filename
+      TYPE(obfbdata)   :: fbdata     ! obsfbdata structure
+      !! * Local variables
+      CHARACTER(LEN=14), PARAMETER :: cpname = 'write_obfbdata'
+      ! Dimension ids
+      INTEGER :: idfile
+      INTEGER :: idodim
+      INTEGER :: idldim
+      INTEGER :: idvdim
+      INTEGER :: idadim
+      INTEGER :: idedim
+      INTEGER :: idsndim
+      INTEGER :: idsgdim
+      INTEGER :: idswdim
+      INTEGER :: idstdim
+      INTEGER :: idjddim
+      INTEGER :: idqcdim
+      INTEGER :: idvard
+      INTEGER :: idaddd
+      INTEGER :: idextd
+      INTEGER :: idcdwmo
+      INTEGER :: idcdtyp
+      INTEGER :: idplam
+      INTEGER :: idpphi
+      INTEGER :: idpdep
+      INTEGER :: idptim
+      INTEGER :: idptimr
+      INTEGER :: idioqc         
+      INTEGER :: idioqcf         
+      INTEGER :: idipqc
+      INTEGER :: idipqcf
+      INTEGER :: iditqc
+      INTEGER :: iditqcf
+      INTEGER :: ididqc
+      INTEGER :: ididqcf
+      INTEGER :: idkindex
+      INTEGER, DIMENSION(fbdata%nvar) :: &
+         & idpob,    &
+         & idivqc,   &
+         & idivqcf,  &
+         & idivlqc,  &
+         & idivlqcf, &
+         & idiobsi,  &
+         & idiobsj,  &
+         & idiobsk,  &
+         & idcgrid
+      INTEGER, DIMENSION(fbdata%nadd,fbdata%nvar) :: idpadd
+      INTEGER, DIMENSION(fbdata%next) :: idpext
+      INTEGER, DIMENSION(1) :: incdim1
+      INTEGER, DIMENSION(2) :: incdim2
+      INTEGER, DIMENSION(3) :: incdim3
+      INTEGER, DIMENSION(4) :: incdim4
+
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: ioldfill
+      CHARACTER(len=nf90_max_name) :: &
+         & cdtmp
+      CHARACTER(len=16), PARAMETER :: &
+         & cdqcconv = 'q where q =[0,9]'
+      CHARACTER(len=24), PARAMETER :: &
+         & cdqcfconv = 'NEMOVAR flag conventions'
+      CHARACTER(len=ilenlong) :: &
+         & cdltmp
+
+      ! Open output filename
+
+      CALL chkerr( nf90_create( TRIM( cdfilename ), nf90_clobber, idfile ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_set_fill( idfile, nf90_nofill, ioldfill ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_put_att( idfile, nf90_global, 'title', &
+         &                       'NEMO observation operator output' ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_put_att( idfile, nf90_global, 'Convention', &
+         &                       'NEMO unified observation operator output' ),&
+         &         cpname,__LINE__ )
+
+      ! Create the dimensions
+
+      CALL chkerr( nf90_def_dim( idfile, 'N_OBS'  , fbdata%nobs, idodim ),  &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'N_LEVELS', fbdata%nlev, idldim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'N_VARS', fbdata%nvar, idvdim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'N_QCF', fbdata%nqcf, idqcdim ),&
+         &         cpname,__LINE__ )
+      IF ( fbdata%nadd > 0 ) THEN
+         CALL chkerr( nf90_def_dim( idfile, 'N_ENTRIES', fbdata%nadd, idadim ), &
+            &         cpname,__LINE__ )
+      ENDIF
+      IF ( fbdata%next > 0 ) THEN
+         CALL chkerr( nf90_def_dim( idfile, 'N_EXTRA', fbdata%next, idedim ), &
+            &         cpname,__LINE__ )
+      ENDIF
+      CALL chkerr( nf90_def_dim( idfile, 'STRINGNAM', ilenname, idsndim ), &
+         &         cpname,__LINE__ )
+      IF (fbdata%lgrid) THEN
+         CALL chkerr( nf90_def_dim( idfile, 'STRINGGRID', ilengrid, idsgdim ),&
+            &         cpname,__LINE__ )
+      ENDIF
+      CALL chkerr( nf90_def_dim( idfile, 'STRINGWMO', ilenwmo, idswdim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'STRINGTYP', ilentyp, idstdim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'STRINGJULD', ilenjuld, idjddim ), &
+         &         cpname,__LINE__ )
+      
+      ! Define netCDF variables for header information
+      
+      incdim2(1) = idsndim
+      incdim2(2) = idvdim
+
+      CALL chkerr( nf90_def_var( idfile, 'VARIABLES', nf90_char, incdim2, &
+         &                       idvard ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata( idfile, idvard, &
+         &                     'List of variables in feedback files' )
+      
+      IF ( fbdata%nadd > 0 ) THEN
+         incdim2(1) = idsndim
+         incdim2(2) = idadim
+         CALL chkerr( nf90_def_var( idfile, 'ENTRIES', nf90_char, incdim2, &
+            &                       idaddd ), cpname, __LINE__ )
+         CALL putvaratt_obfbdata( idfile, idaddd,  &
+            &                     'List of additional entries for each '// &
+            &                     'variable in feedback files' )
+      ENDIF
+   
+      IF ( fbdata%next > 0 ) THEN
+         incdim2(1) = idsndim
+         incdim2(2) = idedim
+         CALL chkerr( nf90_def_var( idfile, 'EXTRA', nf90_char, incdim2, &
+            &                       idextd ), cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idextd, &
+            &                      'List of extra variables' )
+      ENDIF
+
+      incdim2(1) = idswdim
+      incdim2(2) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'STATION_IDENTIFIER', &
+         &                       nf90_char, incdim2, &
+         &                       idcdwmo ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idcdwmo, &
+         &                      'Station identifier' )
+      incdim2(1) = idstdim
+      incdim2(2) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'STATION_TYPE', &
+         &                       nf90_char, incdim2, &
+         &                       idcdtyp ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idcdtyp, &
+         &                      'Code instrument type' )
+      incdim1(1) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'LONGITUDE', &
+         &                       nf90_double, incdim1, &
+         &                       idplam ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idplam, &
+         &                      'Longitude', cdunits = 'degrees_east', &
+         &                      rfillvalue = fbrmdi )
+      CALL chkerr( nf90_def_var( idfile, 'LATITUDE', &
+         &                       nf90_double, incdim1, &
+         &                       idpphi ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idpphi, &
+         &                      'Latitude', cdunits = 'degrees_north', &
+         &                      rfillvalue = fbrmdi )
+      incdim2(1) = idldim
+      incdim2(2) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'DEPTH', &
+         &                       nf90_double, incdim2, &
+         &                       idpdep ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idpdep, &
+         &                      'Depth', cdunits = 'metre', &
+         &                      rfillvalue = fbrmdi )
+      incdim3(1) = idqcdim
+      incdim3(2) = idldim
+      incdim3(3) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'DEPTH_QC', &
+         &                       nf90_int, incdim2, &
+         &                       ididqc ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, ididqc, &
+         &                      'Quality on depth',  &
+         &                      conventions = cdqcconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'DEPTH_QC_FLAGS', &
+         &                       nf90_int, incdim3, &
+         &                       ididqcf ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, ididqcf, &
+         &                      'Quality flags on depth',  &
+         &                      conventions = cdqcfconv )
+      CALL chkerr( nf90_def_var( idfile, 'JULD', &
+         &                       nf90_double, incdim1, &
+         &                       idptim ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idptim, &
+         &                      'Julian day', &
+         &                      cdunits = 'days since JULD_REFERENCE', &
+         &                      conventions = 'relative julian days with '// &
+         &                                 'decimal part (as parts of day)', &
+         &                      rfillvalue = fbrmdi )
+      incdim1(1) = idjddim
+      CALL chkerr( nf90_def_var( idfile, 'JULD_REFERENCE', &
+         &                       nf90_char, incdim1, &
+         &                       idptimr ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idptimr, &
+         &                      'Date of reference for julian days ', &
+         &                      conventions = 'YYYYMMDDHHMMSS' )
+      incdim1(1) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'OBSERVATION_QC', &
+         &                       nf90_int, incdim1, &
+         &                       idioqc ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idioqc, &
+         &                      'Quality on observation',  &
+         &                      conventions = cdqcconv, &
+         &                      ifillvalue = 0 )
+      incdim2(1) = idqcdim
+      incdim2(2) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'OBSERVATION_QC_FLAGS', &
+         &                       nf90_int, incdim2, &
+         &                       idioqcf ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idioqcf, &
+         &                      'Quality flags on observation',  &
+         &                      conventions = cdqcfconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'POSITION_QC', &
+         &                       nf90_int, incdim1, &
+         &                       idipqc ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idipqc, &
+         &                      'Quality on position (latitude and longitude)',  &
+         &                      conventions = cdqcconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'POSITION_QC_FLAGS', &
+         &                       nf90_int, incdim2, &
+         &                       idipqcf ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idipqcf, &
+         &                      'Quality flags on position',  &
+         &                      conventions = cdqcfconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'JULD_QC', &
+         &                       nf90_int, incdim1, &
+         &                       iditqc ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, iditqc, &
+         &                      'Quality on date and time',  &
+         &                      conventions = cdqcconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'JULD_QC_FLAGS', &
+         &                       nf90_int, incdim2, &
+         &                       iditqcf ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, iditqcf, &
+         &                      'Quality flags on date and time',  &
+         &                      conventions = cdqcfconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'ORIGINAL_FILE_INDEX', &
+         &                       nf90_int, incdim1, &
+         &                       idkindex ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idkindex, &
+         &                      'Index in original data file',  &
+         &                      ifillvalue = fbimdi )
+
+      ! Define netCDF variables for individual variables
+
+      DO jv = 1, fbdata%nvar
+
+         incdim1(1) = idodim
+         incdim2(1) = idldim
+         incdim2(2) = idodim
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_OBS'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_float, &
+            &                       incdim2, idpob(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idpob(jv), &
+            &                      fbdata%coblong(jv),  &
+            &                      cdunits =  fbdata%cobunit(jv), &
+            &                      rfillvalue = fbrmdi )
+
+         IF ( fbdata%nadd > 0 ) THEN
+            DO je = 1, fbdata%nadd
+               WRITE(cdtmp,'(3A)') TRIM(fbdata%cname(jv)),'_',&
+                  &                TRIM(fbdata%caddname(je))
+               CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_float, &
+                  &                       incdim2, idpadd(je,jv) ), &
+                  &         cpname, __LINE__ )
+               CALL putvaratt_obfbdata(  idfile, idpadd(je,jv), &
+                  &                      fbdata%caddlong(je,jv), &
+                  &                      cdunits =  fbdata%caddunit(je,jv), &
+                  &                      rfillvalue = fbrmdi )
+            END DO
+         ENDIF
+
+         cdltmp = fbdata%coblong(jv)
+         IF (( cdltmp(1:1) >= 'A' ).AND.( cdltmp(1:1) <= 'Z' )) &
+            & cdltmp(1:1) = ACHAR(IACHAR(cdltmp(1:1)) + 32)
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_QC'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+            &                       incdim1, idivqc(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idivqc(jv), &
+            &                      'Quality on '//cdltmp,  &
+            &                      conventions = cdqcconv, &
+            &                      ifillvalue = 0 )
+         incdim2(1) = idqcdim
+         incdim2(2) = idodim
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_QC_FLAGS'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+            &                       incdim2, idivqcf(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idivqcf(jv), &
+            &                      'Quality flags on '//cdltmp,  &
+            &                      conventions = cdqcfconv, &
+            &                      ifillvalue = 0 )
+         incdim2(1) = idldim
+         incdim2(2) = idodim
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_LEVEL_QC'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+            &                       incdim2, idivlqc(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idivlqc(jv), &
+            &                      'Quality for each level on '//cdltmp,  &
+            &                      conventions = cdqcconv, &
+            &                      ifillvalue = 0 )
+         incdim3(1) = idqcdim
+         incdim3(2) = idldim
+         incdim3(3) = idodim
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_LEVEL_QC_FLAGS'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+            &                       incdim3, idivlqcf(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idivlqcf(jv), &
+            &                      'Quality flags for each level on '//&
+            &                      cdltmp,  &
+            &                      conventions = cdqcfconv, &
+            &                      ifillvalue = 0 )
+
+         IF (fbdata%lgrid) THEN
+            incdim2(1) = idldim
+            incdim2(2) = idodim
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSI'
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+               &                       incdim1, idiobsi(jv) ), &
+               &         cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idiobsi(jv), &
+               &                      'ORCA grid search I coordinate')
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSJ'
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+               &                       incdim1, idiobsj(jv) ), &
+               &         cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idiobsj(jv), &
+               &                      'ORCA grid search J coordinate')
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSK'
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+               &                       incdim2, idiobsk(jv) ), &
+               &         cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idiobsk(jv), &
+               &                      'ORCA grid search K coordinate')
+            incdim1(1) = idsgdim
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_GRID'
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_char, incdim1, &
+               &                       idcgrid(jv) ), cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idcgrid(jv), &
+               &                      'ORCA grid search grid (T,U,V)')
+         ENDIF
+
+      END DO
+
+      IF ( fbdata%next > 0 ) THEN
+         DO je = 1, fbdata%next
+            incdim2(1) = idldim
+            incdim2(2) = idodim
+            WRITE(cdtmp,'(A)') TRIM(fbdata%cextname(je))
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_float, &
+               &                       incdim2, idpext(je) ), &
+               &         cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idpext(je), &
+               &                      fbdata%cextlong(je),  &
+               &                      cdunits =  fbdata%cextunit(je), &
+               &                      rfillvalue = fbrmdi )
+         END DO
+      ENDIF
+      
+      ! Stop definitions
+
+      CALL chkerr( nf90_enddef( idfile ), cpname, __LINE__ )
+      
+      ! Write the variables
+      
+      CALL chkerr( nf90_put_var( idfile, idvard, fbdata%cname ), &
+         &         cpname, __LINE__ )
+      
+      IF ( fbdata%nadd > 0 ) THEN
+         CALL chkerr( nf90_put_var( idfile, idaddd, fbdata%caddname ), &
+            &         cpname, __LINE__ )
+      ENDIF
+      
+      IF ( fbdata%next > 0 ) THEN
+         CALL chkerr( nf90_put_var( idfile, idextd, fbdata%cextname ), &
+            &         cpname, __LINE__ )
+      ENDIF
+
+      CALL chkerr( nf90_put_var( idfile, idptimr, fbdata%cdjuldref ), &
+         &         cpname, __LINE__ )
+
+      ! Only write the data if observation is available
+      
+      IF ( fbdata%nobs > 0 ) THEN
+
+         CALL chkerr( nf90_put_var( idfile, idcdwmo, fbdata%cdwmo ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idcdtyp, fbdata%cdtyp ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idplam, fbdata%plam ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idpphi, fbdata%pphi ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idpdep, fbdata%pdep ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idptim, fbdata%ptim ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idioqc, fbdata%ioqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idioqcf, fbdata%ioqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idipqc, fbdata%ipqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idipqcf, fbdata%ipqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, iditqc, fbdata%itqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, iditqcf, fbdata%itqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, ididqc, fbdata%idqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, ididqcf, fbdata%idqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idkindex, fbdata%kindex ), &
+            &         cpname, __LINE__ )
+
+         DO jv = 1, fbdata%nvar
+            CALL chkerr( nf90_put_var( idfile, idpob(jv), fbdata%pob(:,:,jv) ), &
+               &         cpname, __LINE__ )
+            IF ( fbdata%nadd > 0 ) THEN
+               DO je = 1, fbdata%nadd
+                  CALL chkerr( nf90_put_var( idfile, idpadd(je,jv), &
+                     &                       fbdata%padd(:,:,je,jv) ), &
+                     &         cpname, __LINE__ )
+               END DO
+            ENDIF
+            CALL chkerr( nf90_put_var( idfile, idivqc(jv), &
+               &                       fbdata%ivqc(:,jv) ),&
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_put_var( idfile, idivqcf(jv), &
+               &                       fbdata%ivqcf(:,:,jv) ),&
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_put_var( idfile, idivlqc(jv), &
+               &                       fbdata%ivlqc(:,:,jv) ),&
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_put_var( idfile, idivlqcf(jv), &
+               &                       fbdata%ivlqcf(:,:,:,jv) ),&
+               &         cpname, __LINE__ )
+            IF (fbdata%lgrid) THEN
+               CALL chkerr( nf90_put_var( idfile, idiobsi(jv), &
+                  &                       fbdata%iobsi(:,jv) ),&
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idiobsj(jv), &
+                  &                       fbdata%iobsj(:,jv) ),&
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idiobsk(jv), &
+                  &                       fbdata%iobsk(:,:,jv) ),&
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idcgrid(jv), &
+                  &                       fbdata%cgrid(jv) ), &
+                  &         cpname, __LINE__ )
+            ENDIF
+         END DO
+
+         IF ( fbdata%next > 0 ) THEN
+            DO je = 1, fbdata%next
+               CALL chkerr( nf90_put_var( idfile, idpext(je), &
+                  &                       fbdata%pext(:,:,je) ), &
+                  &         cpname, __LINE__ )
+            END DO
+         ENDIF
+
+      ENDIF
+
+      ! Close the file
+
+      CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+
+      
+   END SUBROUTINE write_obfbdata
+
+   SUBROUTINE putvaratt_obfbdata( idfile, idvar, cdlongname, cdunits, &
+      &                           conventions, cfillvalue, &
+      &                           ifillvalue, rfillvalue )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE putvaratt_obfbdata  ***
+      !!
+      !! ** Purpose :   Write netcdf attributes for variable
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER :: idfile                    ! File netcdf id.
+      INTEGER :: idvar                     ! Variable netcdf id.
+      CHARACTER(len=*) :: cdlongname       ! Long name for variable
+      CHARACTER(len=*), OPTIONAL :: cdunits       ! Units for variable
+      CHARACTER(len=*), OPTIONAL :: cfillvalue    ! Fill value for character variables
+      INTEGER, OPTIONAL :: ifillvalue             ! Fill value for integer variables
+      REAL(kind=fbsp), OPTIONAL :: rfillvalue     ! Fill value for real variables
+      CHARACTER(len=*), OPTIONAL :: conventions   ! Conventions for variable
+      !! * Local variables
+      CHARACTER(LEN=18), PARAMETER :: &
+         & cpname = 'putvaratt_obfbdata'
+
+      CALL chkerr( nf90_put_att( idfile, idvar, 'long_name', &
+         &                       TRIM(cdlongname) ), &
+         &                       cpname, __LINE__ )
+      
+      IF ( PRESENT(cdunits) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, 'units', &
+            &                       TRIM(cdunits) ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+      IF ( PRESENT(conventions) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, 'Conventions', &
+            &                       TRIM(conventions) ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+      IF ( PRESENT(cfillvalue) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, '_Fillvalue', &
+            &                       TRIM(cfillvalue) ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+      IF ( PRESENT(ifillvalue) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, '_Fillvalue', &
+            &                       ifillvalue ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+      IF ( PRESENT(rfillvalue) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, '_Fillvalue', &
+            &                       rfillvalue ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+   END SUBROUTINE putvaratt_obfbdata
+
+   SUBROUTINE read_obfbdata( cdfilename, fbdata, ldgrid )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE read_obfbdata  ***
+      !!
+      !! ** Purpose :   Read an obfbdata structure from a netCDF file.
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=*) :: cdfilename  ! Input filename
+      TYPE(obfbdata)   :: fbdata      ! obsfbdata structure
+      LOGICAL, OPTIONAL :: ldgrid     ! Allow forcing of grid info
+      !! * Local variables
+      CHARACTER(LEN=14), PARAMETER :: cpname = 'read_obfbdata'
+      INTEGER :: idfile
+      INTEGER :: idodim
+      INTEGER :: idldim
+      INTEGER :: idvdim
+      INTEGER :: idadim
+      INTEGER :: idedim
+      INTEGER :: idgdim
+      INTEGER :: idvard
+      INTEGER :: idaddd
+      INTEGER :: idextd
+      INTEGER :: idcdwmo
+      INTEGER :: idcdtyp
+      INTEGER :: idplam
+      INTEGER :: idpphi
+      INTEGER :: idpdep
+      INTEGER :: idptim
+      INTEGER :: idptimr
+      INTEGER :: idioqc        
+      INTEGER :: idioqcf
+      INTEGER :: idipqc
+      INTEGER :: idipqcf
+      INTEGER :: ididqc
+      INTEGER :: ididqcf
+      INTEGER :: iditqc
+      INTEGER :: iditqcf
+      INTEGER :: idkindex
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & idpob,    &
+         & idivqc,   &
+         & idivqcf,  &
+         & idivlqc,  &
+         & idivlqcf, &
+         & idiobsi,  &
+         & idiobsj,  &
+         & idiobsk,  &
+         & idcgrid,  &
+         & idpext
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+         & idpadd
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: nvar
+      INTEGER :: nobs
+      INTEGER :: nlev
+      INTEGER :: nadd
+      INTEGER :: next
+      LOGICAL :: lgrid
+      CHARACTER(len=NF90_MAX_NAME) :: cdtmp
+
+      ! Check allocation status and deallocate previous allocated structures
+
+      IF ( fbdata%lalloc ) THEN
+         CALL dealloc_obfbdata( fbdata )
+      ENDIF
+
+      ! Open input filename
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, idfile ), &
+         &         cpname, __LINE__ )
+
+      ! Get input dimensions
+
+      CALL chkerr( nf90_inq_dimid( idfile, 'N_OBS'  , idodim ),  &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inquire_dimension( idfile, idodim, len=nobs ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inq_dimid( idfile, 'N_LEVELS', idldim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inquire_dimension( idfile, idldim, len=nlev ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inq_dimid( idfile, 'N_VARS', idvdim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inquire_dimension( idfile, idvdim, len=nvar ), &
+         &         cpname,__LINE__ )
+      IF ( nf90_inq_dimid( idfile, 'N_ENTRIES',  idadim ) == 0 ) THEN
+         CALL chkerr( nf90_inquire_dimension( idfile, idadim, len=nadd ), &
+            &         cpname,__LINE__ )
+      ELSE
+         nadd = 0
+      ENDIF
+      IF ( nf90_inq_dimid( idfile, 'N_EXTRA',  idedim ) == 0 ) THEN
+         CALL chkerr( nf90_inquire_dimension( idfile, idedim, len=next ), &
+            &         cpname,__LINE__ )
+      ELSE
+         next = 0
+      ENDIF
+      !
+      ! Check if this input file  contains grid search informations
+      !
+      lgrid = ( nf90_inq_dimid( idfile, 'STRINGGRID',  idgdim ) == 0 )
+
+      ! Allocate data structure
+
+      IF ( PRESENT(ldgrid) ) THEN
+         CALL alloc_obfbdata( fbdata, nvar, nobs, nlev, nadd, next, &
+            & lgrid.OR.ldgrid )
+      ELSE
+         CALL alloc_obfbdata( fbdata, nvar, nobs, nlev, nadd, next, &
+            & lgrid )
+      ENDIF
+
+      ! Allocate netcdf identifiers
+
+      ALLOCATE( &
+         & idpob(fbdata%nvar),    &
+         & idivqc(fbdata%nvar),   &
+         & idivqcf(fbdata%nvar),  &
+         & idivlqc(fbdata%nvar),  &
+         & idivlqcf(fbdata%nvar), &
+         & idiobsi(fbdata%nvar),  &
+         & idiobsj(fbdata%nvar),  &
+         & idiobsk(fbdata%nvar),  &
+         & idcgrid(fbdata%nvar)   &
+         & )
+      IF ( fbdata%nadd > 0 ) THEN
+         ALLOCATE( &
+            & idpadd(fbdata%nadd,fbdata%nvar) &
+            & )
+      ENDIF
+      IF ( fbdata%next > 0 ) THEN
+         ALLOCATE( &
+            & idpext(fbdata%next) &
+            & )
+      ENDIF
+
+      ! Read variables for header information
+
+      CALL chkerr( nf90_inq_varid( idfile, 'VARIABLES',idvard ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_get_var( idfile, idvard, fbdata%cname ), &
+         &         cpname, __LINE__ )
+      IF ( fbdata%nadd > 0 ) THEN
+         CALL chkerr( nf90_inq_varid( idfile, 'ENTRIES', idaddd ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idaddd, fbdata%caddname ), &
+            &         cpname, __LINE__ )
+      ENDIF
+      IF ( fbdata%next > 0 ) THEN
+         CALL chkerr( nf90_inq_varid( idfile, 'EXTRA', idextd ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idextd, fbdata%cextname ), &
+            &         cpname, __LINE__ )
+      ENDIF
+
+      CALL chkerr( nf90_inq_varid( idfile, 'JULD_REFERENCE', idptimr ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_get_var( idfile, idptimr, fbdata%cdjuldref ), &
+         &         cpname, __LINE__ )
+
+      IF  ( fbdata%nobs > 0 ) THEN
+         
+         CALL chkerr( nf90_inq_varid( idfile, 'STATION_IDENTIFIER', idcdwmo ),&
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idcdwmo, fbdata%cdwmo ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'STATION_TYPE', idcdtyp ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idcdtyp, fbdata%cdtyp), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'LONGITUDE', idplam ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idplam, fbdata%plam ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'LATITUDE', idpphi ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idpphi, fbdata%pphi ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'DEPTH', idpdep ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idpdep, fbdata%pdep ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'JULD', idptim ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idptim, fbdata%ptim ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'OBSERVATION_QC', idioqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idioqc, fbdata%ioqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'OBSERVATION_QC_FLAGS', idioqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idioqcf, fbdata%ioqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'POSITION_QC', idipqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idipqc, fbdata%ipqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'POSITION_QC_FLAGS', idipqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idipqcf, fbdata%ipqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'DEPTH_QC', ididqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, ididqc, fbdata%idqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'DEPTH_QC_FLAGS', ididqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, ididqcf, fbdata%idqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'JULD_QC', iditqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, iditqc, fbdata%itqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'JULD_QC_FLAGS', iditqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, iditqcf, fbdata%itqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'ORIGINAL_FILE_INDEX', idkindex ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idkindex, fbdata%kindex ), &
+            &         cpname, __LINE__ )
+         
+         ! Read netCDF variables for individual variables
+         
+         DO jv = 1, fbdata%nvar
+            
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_OBS'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpob(jv) ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idpob(jv), &
+               &                       fbdata%pob(:,:,jv) ), &
+               &         cpname, __LINE__ )
+            CALL getvaratt_obfbdata( idfile, idpob(jv), &
+               &                     fbdata%coblong(jv), &
+               &                     fbdata%cobunit(jv) )
+            
+            IF ( fbdata%nadd > 0 ) THEN
+               DO je = 1, fbdata%nadd
+                  WRITE(cdtmp,'(3A)') TRIM(fbdata%cname(jv)),'_',&
+                     &                TRIM(fbdata%caddname(je))
+                  CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpadd(je,jv) ), &
+                     &         cpname, __LINE__ )
+                  CALL chkerr( nf90_get_var( idfile, idpadd(je,jv), &
+                     &                       fbdata%padd(:,:,je,jv) ), &
+                     &         cpname, __LINE__ )
+                  CALL getvaratt_obfbdata( idfile, idpadd(je,jv), &
+                     &                     fbdata%caddlong(je,jv), &
+                     &                     fbdata%caddunit(je,jv) )
+               END DO
+            ENDIF
+            
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_QC'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idivqc(jv) ), &
+            &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idivqc(jv), &
+               &                       fbdata%ivqc(:,jv) ), &
+               &         cpname, __LINE__ )
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_QC_FLAGS'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idivqcf(jv) ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idivqcf(jv), &
+               &                       fbdata%ivqcf(:,:,jv) ), &
+               &         cpname, __LINE__ )
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_LEVEL_QC'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idivlqc(jv) ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idivlqc(jv), &
+               &                       fbdata%ivlqc(:,:,jv) ), &
+               &         cpname, __LINE__ )
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_LEVEL_QC_FLAGS'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idivlqcf(jv) ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idivlqcf(jv), &
+               &                       fbdata%ivlqcf(:,:,:,jv) ), &
+               &         cpname, __LINE__ )
+            IF ( lgrid ) THEN
+               WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSI'
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idiobsi(jv) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idiobsi(jv), &
+                  &                       fbdata%iobsi(:,jv) ), &
+                  &         cpname, __LINE__ )
+               WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSJ'
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idiobsj(jv) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idiobsj(jv), &
+                  &                       fbdata%iobsj(:,jv) ), &
+                  &         cpname, __LINE__ )
+               WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSK'
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idiobsk(jv) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idiobsk(jv), &
+                  &                       fbdata%iobsk(:,:,jv) ), &
+                  &         cpname, __LINE__ )
+               WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_GRID'
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idcgrid(jv) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idcgrid(jv), &
+                  &                       fbdata%cgrid(jv) ), &
+                  &         cpname, __LINE__ )
+            ENDIF
+            
+         END DO
+         
+         IF ( fbdata%next > 0 ) THEN
+            DO je = 1, fbdata%next
+               WRITE(cdtmp,'(A)') TRIM(fbdata%cextname(je))
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpext(je) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idpext(je), &
+                  &                       fbdata%pext(:,:,je) ), &
+                  &         cpname, __LINE__ )
+               CALL getvaratt_obfbdata( idfile, idpext(je), &
+                  &                     fbdata%cextlong(je), &
+                  &                     fbdata%cextunit(je) )
+            END DO
+         ENDIF
+
+      ELSE ! if no observations only get attributes
+
+         DO jv = 1, fbdata%nvar            
+
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_OBS'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpob(jv) ), &
+               &         cpname, __LINE__ )
+            CALL getvaratt_obfbdata( idfile, idpob(jv), &
+               &                     fbdata%coblong(jv), &
+               &                     fbdata%cobunit(jv) )
+            
+            IF ( fbdata%nadd > 0 ) THEN
+               DO je = 1, fbdata%nadd
+                  WRITE(cdtmp,'(3A)') TRIM(fbdata%cname(jv)),'_',&
+                     &                TRIM(fbdata%caddname(je))
+                  CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpadd(je,jv) ), &
+                     &         cpname, __LINE__ )
+                  CALL getvaratt_obfbdata( idfile, idpadd(je,jv), &
+                     &                     fbdata%caddlong(je,jv), &
+                     &                     fbdata%caddunit(je,jv) )
+               END DO
+            ENDIF
+            
+         END DO
+         
+         IF ( fbdata%next > 0 ) THEN
+            DO je = 1, fbdata%next
+               WRITE(cdtmp,'(A)') TRIM(fbdata%cextname(je))
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpext(je) ), &
+                  &         cpname, __LINE__ )
+               CALL getvaratt_obfbdata( idfile, idpext(je), &
+                  &                     fbdata%cextlong(je), &
+                  &                     fbdata%cextunit(je) )
+            END DO
+         ENDIF
+
+      ENDIF
+
+      ! Close the file
+
+      CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+
+   END SUBROUTINE read_obfbdata
+
+   SUBROUTINE getvaratt_obfbdata( idfile, idvar, cdlongname, cdunits )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE putvaratt_obfbdata  ***
+      !!
+      !! ** Purpose :   Read netcdf attributes for variable
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER :: idfile      ! File netcdf id.
+      INTEGER :: idvar       ! Variable netcdf id.
+      CHARACTER(len=*) :: cdlongname  ! Long name for variable
+      CHARACTER(len=*) :: cdunits     ! Units for variable
+      !! * Local variables
+      CHARACTER(LEN=18), PARAMETER :: cpname = 'getvaratt_obfbdata'
+
+      CALL chkerr( nf90_get_att( idfile, idvar, 'long_name', &
+         &                       cdlongname ), &
+         &                       cpname, __LINE__ )
+
+      CALL chkerr( nf90_get_att( idfile, idvar, 'units', &
+         &                       cdunits ), &
+         &                       cpname, __LINE__ )
+
+   END SUBROUTINE getvaratt_obfbdata
+
+END MODULE obs_fbm
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_grid.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 2236)
@@ -0,0 +1,1179 @@
+MODULE obs_grid
+   !!======================================================================
+   !!                       ***  MODULE  obs_grid  ***
+   !! Observation diagnostics: Various tools for grid searching etc.
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !!   obs_grid_search   : Find i,j on the ORCA grid from lat,lon
+   !!   obs_level_search  : Find level from depth
+   !!   obs_zlevel_search : Find depth level from observed depth
+   !!   obs_tlevel_search : Find temperature level from observed temp
+   !!   obs_rlevel_search : Find density level from observed density
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind, ONLY : &          ! Precision variables
+      & wp 
+   USE par_oce, ONLY :  &          ! Ocean parameters
+      & jpk,     &
+      & jpni,    &
+      & jpnj,    &
+      & jpnij
+   USE dom_oce                     ! Ocean space and time domain variables
+   USE obs_mpp, ONLY : &           ! MPP support routines for observation diagnostics
+      & obs_mpp_find_obs_proc, &
+      & mpp_global_max,        &
+      & obs_mpp_max_integer
+   USE phycst, ONLY : &            ! Physical constants
+      & rad
+   USE obs_utils, ONLY : &         ! Observation operator utility functions
+      & grt_cir_dis, &
+      & chkerr
+   USE in_out_manager              ! Printing support
+   USE netcdf
+   USE obs_const, ONLY :      &
+      & obfillflt                  ! Fillvalue   
+   
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PUBLIC  obs_grid_setup,      & ! Setup grid searching
+      &    obs_grid_search,     & ! Find i, j on the ORCA grid from lat, lon
+      &    obs_grid_deallocate, & ! Deallocate the look up table
+      &    obs_level_search       ! Find level from depth
+
+   PRIVATE linquad,                    & ! Determine whether a point lies within a cell
+      &    maxdist,                    & ! Find the maximum distance between 2 pts in a cell
+      &    obs_grid_search_bruteforce, & ! Find i, j on the ORCA grid from lat, lon
+      &    obs_grid_search_lookup        ! Find i, j on the ORCA grid from lat, lon quicker
+
+   !!* Module variables
+
+   !! Default values
+   REAL, PUBLIC :: grid_search_res = 0.5    ! Resolution of grid
+   INTEGER, PRIVATE :: gsearch_nlons_def    ! Num of longitudes
+   INTEGER, PRIVATE :: gsearch_nlats_def    ! Num of latitudes
+   REAL(wp), PRIVATE :: gsearch_lonmin_def  ! Min longitude
+   REAL(wp), PRIVATE :: gsearch_latmin_def  ! Min latitude
+   REAL(wp), PRIVATE :: gsearch_dlon_def    ! Lon spacing
+   REAL(wp), PRIVATE :: gsearch_dlat_def    ! Lat spacing
+   !! Variable versions
+   INTEGER, PRIVATE :: nlons     ! Num of longitudes
+   INTEGER, PRIVATE :: nlats     ! Num of latitudes
+   REAL(wp), PRIVATE :: lonmin ! Min longitude
+   REAL(wp), PRIVATE :: latmin ! Min latitude
+   REAL(wp), PRIVATE :: dlon     ! Lon spacing
+   REAL(wp), PRIVATE :: dlat     ! Lat spacing
+   
+   INTEGER, PRIVATE :: maxxdiff, maxydiff ! Max diffs between model points
+   INTEGER, PRIVATE :: limxdiff, limydiff
+   
+   ! Data storage
+   REAL(wp), PRIVATE, DIMENSION(:,:), ALLOCATABLE :: &
+      & lons,  &
+      & lats
+   INTEGER, PRIVATE, DIMENSION(:,:), ALLOCATABLE :: &
+      & ixpos, &
+      & iypos, &
+      & iproc    
+
+   ! Switches
+   LOGICAL, PUBLIC :: ln_grid_search_lookup  ! Use lookup table to speed up grid search
+   LOGICAL, PUBLIC :: ln_grid_global         ! Use global distribution of observations
+   CHARACTER(LEN=44), PUBLIC :: &
+      & grid_search_file    ! file name head for grid search lookup 
+
+CONTAINS
+
+   SUBROUTINE obs_grid_search( kobsin, plam, pphi, kobsi, kobsj, kproc, &
+      &                        cdgrid )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_search ***
+      !!
+      !! ** Purpose : Search local gridpoints to find the grid box containing
+      !!              the observations calls either
+      !!              obs_grid_search_bruteforce - the original brute force search
+      !!                     or
+      !!              obs_grid_search_lookup - uses a lookup table to do a fast 
+      !!search
+      !!History :
+      !!        !  2007-12  (D. Lea) 
+      !!------------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER :: &
+         & kobsin                     ! Size of the observation arrays
+      REAL(KIND=wp), DIMENSION(kobsin), INTENT(IN) :: &
+         & plam, &                  ! Longitude of obsrvations 
+         & pphi                     ! Latitude of observations
+      INTEGER, DIMENSION(kobsin), INTENT(OUT) :: &
+         & kobsi, &                 ! I-index of observations 
+         & kobsj, &                 ! J-index of observations 
+         & kproc                    ! Processor number of observations
+      CHARACTER(LEN=1) :: &
+         & cdgrid                   ! Grid to search
+
+      IF(kobsin > 0) THEN
+
+         IF ( ln_grid_search_lookup .AND. ( cdgrid == 'T' ) ) THEN
+            CALL obs_grid_search_lookup( kobsin, plam, pphi, &
+               &                         kobsi, kobsj, kproc )
+         ELSE
+            IF ( cdgrid == 'T' ) THEN
+               CALL obs_grid_search_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamt, gphit, tmask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSEIF ( cdgrid == 'U' ) THEN
+               CALL obs_grid_search_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamu, gphiu, umask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSEIF ( cdgrid == 'V' ) THEN
+               CALL obs_grid_search_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamv, gphiv, vmask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSEIF ( cdgrid == 'F' ) THEN
+               CALL obs_grid_search_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamf, gphif, fmask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSE
+               CALL ctl_stop( 'Grid not supported' )
+            ENDIF
+         ENDIF
+         
+      ENDIF
+
+   END SUBROUTINE obs_grid_search
+
+#include "obs_grid_search_bruteforce.h90"
+   
+   SUBROUTINE obs_grid_search_lookup( kobs, plam, pphi, kobsi, kobsj, kproc )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_search_lookup ***
+      !!
+      !! ** Purpose : Search local gridpoints to find the grid box containing
+      !!              the observations (much faster then obs_grid_search_bruteforce)
+      !!
+      !! ** Method  : Call to linquad
+      !!
+      !! ** Action  : Return kproc holding the observation and kiobsi,kobsj
+      !!              valid on kproc=nproc processor only.
+      !!   
+      !! History :
+      !!        !  2007-12 (D. Lea) new routine based on obs_grid_search
+      !!! updated with fixes from new version of obs_grid_search_bruteforce
+      !!! speeded up where points are not near a "difficult" region like an edge
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER :: kobs                     ! Size of the observation arrays
+      REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: &
+         & plam, &                  ! Longitude of obsrvations 
+         & pphi                     ! Latitude of observations
+      INTEGER, DIMENSION(kobs), INTENT(OUT) :: &
+         & kobsi, &                 ! I-index of observations 
+         & kobsj, &                 ! J-index of observations 
+         & kproc                    ! Processor number of observations
+  
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(:), ALLOCATABLE :: &
+         & zplam
+      REAL(wp) :: zlammax
+      REAL(wp) :: zlam
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jo
+      INTEGER :: isx
+      INTEGER :: isy
+      INTEGER :: jimin
+      INTEGER :: jimax
+      INTEGER :: jjmin
+      INTEGER :: jjmax
+      INTEGER :: jojimin
+      INTEGER :: jojimax
+      INTEGER :: jojjmin
+      INTEGER :: jojjmax
+      INTEGER :: ipx1
+      INTEGER :: ipy1
+      INTEGER :: ip
+      INTEGER :: jp
+      INTEGER :: ipx
+      INTEGER :: ipy
+      INTEGER :: ipmx
+      INTEGER :: jlon
+      INTEGER :: jlat
+      INTEGER :: joffset
+      INTEGER :: jostride
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zlamg, &
+         & zphig, &
+         & zmskg, &
+         & zphitmax,&
+         & zphitmin,&
+         & zlamtmax,&
+         & zlamtmin
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: &
+         & llinvalidcell
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zlamtm,  &
+         & zphitm
+      LOGICAL :: llfourflag
+      INTEGER :: ifourflagcountt
+      INTEGER :: ifourflagcountf
+      INTEGER, DIMENSION(5) :: ifourflagcountr
+
+      !-----------------------------------------------------------------------
+      ! Define grid for grid search
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         jlon     = jpiglo
+         jlat     = jpjglo
+         joffset  = nproc
+         jostride = jpnij
+      ELSE
+         jlon     = jpi
+         jlat     = jpj
+         joffset  = 0
+         jostride = 1
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Set up data for grid search
+      !-----------------------------------------------------------------------
+      ALLOCATE( &
+         & zlamg(jlon,jlat),             &
+         & zphig(jlon,jlat),             &
+         & zmskg(jlon,jlat),             &
+         & zphitmax(jlon-1,jlat-1),      &
+         & zphitmin(jlon-1,jlat-1),      &
+         & zlamtmax(jlon-1,jlat-1),      &
+         & zlamtmin(jlon-1,jlat-1),      &
+         & llinvalidcell(jlon-1,jlat-1), &
+         & zlamtm(4,jlon-1,jlat-1),      &
+         & zphitm(4,jlon-1,jlat-1)       &
+         & )
+      !-----------------------------------------------------------------------
+      ! Copy data to local arrays
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         zlamg(:,:) = -1.e+10
+         zphig(:,:) = -1.e+10
+         zmskg(:,:) = -1.e+10
+         ! Add various grids here.
+         DO jj = nldj, nlej
+            DO ji = nldi, nlei
+               zlamg(mig(ji),mjg(jj)) = glamt(ji,jj)
+               zphig(mig(ji),mjg(jj)) = gphit(ji,jj)
+               zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL mpp_global_max( zlamg )
+         CALL mpp_global_max( zphig )
+         CALL mpp_global_max( zmskg )
+      ELSE
+         ! Add various grids here.
+         DO jj = 1, jlat
+            DO ji = 1, jlon
+               zlamg(ji,jj) = glamt(ji,jj)
+               zphig(ji,jj) = gphit(ji,jj)
+               zmskg(ji,jj) = tmask(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Copy longitudes
+      !----------------------------------------------------------------------- 
+      ALLOCATE( &
+         & zplam(kobs) &
+         & )
+      DO jo = 1, kobs
+         zplam(jo) = plam(jo)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Set default values for output
+      !-----------------------------------------------------------------------
+      kproc(:) = -1
+      kobsi(:) = -1
+      kobsj(:) = -1
+      !-----------------------------------------------------------------------
+      ! Copy grid positions to temporary arrays and renormalize to 0 to 360.
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlamtm(1,ji,jj) = zlamg(ji  ,jj  )
+            zphitm(1,ji,jj) = zphig(ji  ,jj  )
+            zlamtm(2,ji,jj) = zlamg(ji+1,jj  )
+            zphitm(2,ji,jj) = zphig(ji+1,jj  )
+            zlamtm(3,ji,jj) = zlamg(ji+1,jj+1)
+            zphitm(3,ji,jj) = zphig(ji+1,jj+1)
+            zlamtm(4,ji,jj) = zlamg(ji  ,jj+1)
+            zphitm(4,ji,jj) = zphig(ji  ,jj+1)
+         END DO
+      END DO
+      WHERE ( zlamtm(:,:,:) < 0.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) + 360.0_wp
+      END WHERE
+      WHERE ( zlamtm(:,:,:) > 360.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) - 360.0_wp
+      END WHERE
+      !-----------------------------------------------------------------------
+      ! Handle case of the wraparound; beware, not working with orca180
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlammax = MAXVAL( zlamtm(:,ji,jj) )
+            WHERE (zlammax - zlamtm(:, ji, jj) > 180 ) & 
+               & zlamtm(:,ji,jj) = zlamtm(:,ji,jj) + 360._wp
+            zphitmax(ji,jj) = MAXVAL(zphitm(:,ji,jj))
+            zphitmin(ji,jj) = MINVAL(zphitm(:,ji,jj))
+            zlamtmax(ji,jj) = MAXVAL(zlamtm(:,ji,jj))
+            zlamtmin(ji,jj) = MINVAL(zlamtm(:,ji,jj))
+         END DO
+      END DO
+      !-----------------------------------------------------------------------
+      ! Search for boxes with only land points mark them invalid
+      !-----------------------------------------------------------------------
+      llinvalidcell(:,:) = .FALSE.
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            llinvalidcell(ji,jj) =               &
+               & zmskg(ji  ,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj+1) == 0.0_wp .AND. &
+               & zmskg(ji  ,jj+1) == 0.0_wp
+         END DO
+      END DO
+
+      if(lwp) WRITE(numout,*) 'obs_grid_search_lookup do coordinate search using lookup table'
+
+      !-----------------------------------------------------------------------
+      ! Do coordinate search using lookup table with local searches.
+      ! - For land points kproc is set to number of the processor + 1000000
+      !   and we continue the search.
+      ! - For ocean points kproc is set to the number of the processor 
+      !   and we stop the search.
+      !-----------------------------------------------------------------------
+      ifourflagcountt = 0
+      ifourflagcountf = 0
+      ifourflagcountr(:) = 0
+
+      !------------------------------------------------------------------------
+      ! Master loop for grid search
+      !------------------------------------------------------------------------
+         
+      gpkobs: DO jo = 1+joffset, kobs, jostride
+         ! Normal case
+         !        specify 4 points which surround the lat lon of interest
+         !                          x i,j+1  x i+1, j+1
+         !
+         !
+         !                             * lon,lat
+         !                          x i,j    x i+1,j
+
+         ! bottom corner point
+         ipx1 = INT( ( zplam(jo)  - lonmin ) / dlon + 1.0 ) 
+         ipy1 = INT( ( pphi (jo)  - latmin ) / dlat + 1.0 )  
+         
+         ipx = ipx1 + 1
+         ipy = ipy1 + 1
+
+         ! flag for searching around four points separately
+         ! default to false
+         llfourflag = .FALSE.
+         
+         ! check for point fully outside of region
+         IF ( (ipx1 > nlons) .OR. (ipy1 > nlats) .OR. &
+            & (ipx < 1) .OR. (ipy < 1) ) THEN
+            CYCLE
+         ENDIF
+         ! check wrap around
+         IF ( (ipx > nlons) .OR. (ipy > nlats) .OR. &
+            & (ipx1 < 1) .OR. (ipy1 < 1) ) THEN
+            llfourflag=.TRUE.
+            ifourflagcountr(1) = ifourflagcountr(1) + 1
+         ENDIF
+
+         IF (MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) == -1) CYCLE! cycle if no lookup points found
+         
+         jimin = 0
+         jimax = 0
+         jjmin = 0
+         jjmax = 0
+         
+         IF (.NOT. llfourflag) THEN 
+
+            ! calculate points range
+            ! define a square region encompassing the four corner points
+            ! do I need the -1 points?
+
+            jojimin = MINVAL(ixpos(ipx1:ipx,ipy1:ipy)) - 1
+            jojimax = MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) + 1
+            jojjmin = MINVAL(iypos(ipx1:ipx,ipy1:ipy)) - 1
+            jojjmax = MAXVAL(iypos(ipx1:ipx,ipy1:ipy)) + 1
+
+            jimin = jojimin - 1
+            jimax = jojimax + 1
+            jjmin = jojjmin - 1
+            jjmax = jojjmax + 1
+            
+            IF ( jojimin < 0 .OR. jojjmin < 0) THEN 
+               llfourflag = .TRUE.
+               ifourflagcountr(2) = ifourflagcountr(2) + 1
+            ENDIF
+            IF ( jojimax - jojimin > maxxdiff) THEN
+               llfourflag = .TRUE.
+               ifourflagcountr(3) = ifourflagcountr(3) + 1
+            ENDIF
+            IF ( jojjmax - jojjmin > maxydiff) THEN
+               llfourflag = .TRUE.
+               ifourflagcountr(4) = ifourflagcountr(4) + 1
+            ENDIF
+            
+         ENDIF
+
+         ipmx = 0
+         IF (llfourflag) ipmx = 1
+
+         IF (llfourflag) THEN 
+            ifourflagcountt = ifourflagcountt + 1
+         ELSE
+            ifourflagcountf = ifourflagcountf + 1
+         ENDIF
+
+         gridpointsn : DO ip = 0, ipmx
+            DO jp = 0, ipmx
+               
+               IF ( kproc(jo) /= -1 ) EXIT gridpointsn
+        
+               ipx = ipx1 + ip
+               ipy = ipy1 + jp
+               
+               IF (llfourflag) THEN
+
+                  ! deal with wrap around
+                  IF ( ipx > nlons ) ipx = 1
+                  IF ( ipy > nlats ) ipy = 1
+                  IF ( ipx < 1     ) ipx = nlons
+                  IF ( ipy < 1     ) ipy = nlats
+
+                  ! get i,j 
+                  isx = ixpos(ipx,ipy)
+                  isy = iypos(ipx,ipy)
+                  
+                  ! estimate appropriate search region (use max/min values)
+                  jimin = isx - maxxdiff - 1
+                  jimax = isx + maxxdiff + 1
+                  jjmin = isy - maxydiff - 1
+                  jjmax = isy + maxydiff + 1
+
+               ENDIF
+
+               IF ( jimin < 1      ) jimin = 1
+               IF ( jimax > jlon-1 ) jimax = jlon-1
+               IF ( jjmin < 1      ) jjmin = 1
+               IF ( jjmax > jlat-1 ) jjmax = jlat-1
+               
+               !---------------------------------------------------------------
+               ! Ensure that all observation longtiudes are between 0 and 360 
+               !---------------------------------------------------------------
+
+               IF ( zplam(jo) <   0.0_wp ) zplam(jo) = zplam(jo) + 360.0_wp
+               IF ( zplam(jo) > 360.0_wp ) zplam(jo) = zplam(jo) - 360.0_wp
+      
+               !---------------------------------------------------------------
+               ! Find observations which are on within 1e-6 of a grid point
+               !---------------------------------------------------------------
+
+               gridloop: DO jj = jjmin, jjmax
+                  DO ji = jimin, jimax
+                     IF ( ABS( zphig(ji,jj) - pphi(jo) ) < 1e-6 )  THEN
+                        zlam = zlamg(ji,jj)
+                        IF ( zlam <   0.0_wp ) zlam = zlam + 360.0_wp
+                        IF ( zlam > 360.0_wp ) zlam = zlam - 360.0_wp
+                        IF ( ABS( zlam - zplam(jo) ) < 1e-6 ) THEN
+                           IF ( llinvalidcell(ji,jj) ) THEN
+                              kproc(jo) = nproc + 1000000
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              CYCLE
+                           ELSE
+                              kproc(jo) = nproc
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              EXIT gridloop
+                           ENDIF
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO gridloop
+
+               !---------------------------------------------------------------
+               ! Ensure that all observation longtiudes are between -180/180
+               !---------------------------------------------------------------
+
+               IF ( zplam(jo) > 180 ) zplam(jo) = zplam(jo) - 360.0_wp
+
+               IF ( kproc(jo) == -1 ) THEN
+                  
+                  ! Normal case 
+                  gridpoints : DO jj = jjmin, jjmax
+                     DO ji = jimin, jimax
+
+
+                        IF ( ( zplam(jo) > zlamtmax(ji,jj) ) .OR. &
+                           & ( zplam(jo) < zlamtmin(ji,jj) ) ) CYCLE
+                        
+                        IF ( ABS( pphi(jo) ) < 85 ) THEN
+                           IF ( ( pphi(jo) > zphitmax(ji,jj) ) .OR. &
+                              & ( pphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                        ENDIF
+                        
+                        IF ( linquad( zplam(jo), pphi(jo), &
+                           &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                           IF ( llinvalidcell(ji,jj) ) THEN
+                              kproc(jo) = nproc + 1000000
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              CYCLE
+                           ELSE
+                              kproc(jo) = nproc
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              EXIT gridpoints
+                           ENDIF
+                        ENDIF
+                        
+                     END DO
+                  END DO gridpoints
+               ENDIF
+
+               ! In case of failure retry for obs. longtiude + 360.
+               IF ( kproc(jo) == -1 ) THEN
+                  gridpoints_greenwich : DO jj = jjmin, jjmax
+                     DO ji = jimin, jimax
+                        
+                        IF ( ( zplam(jo)+360.0_wp > zlamtmax(ji,jj) ) .OR. &
+                           & ( zplam(jo)+360.0_wp < zlamtmin(ji,jj) ) ) CYCLE
+
+                        IF ( ABS( pphi(jo) ) < 85 ) THEN
+                           IF ( ( pphi(jo) > zphitmax(ji,jj) ) .OR. &
+                              & ( pphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                        ENDIF
+
+                        IF ( linquad( zplam(jo)+360.0_wp, pphi(jo), &
+                           &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                           IF ( llinvalidcell(ji,jj) ) THEN
+                              kproc(jo) = nproc + 1000000
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              CYCLE
+                           ELSE
+                              kproc(jo) = nproc
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              EXIT gridpoints_greenwich
+                           ENDIF
+                        ENDIF
+                        
+                     END DO
+                  END DO gridpoints_greenwich
+                  
+               ENDIF   ! kproc
+               
+            END DO
+         END DO gridpointsn
+      END DO gpkobs  ! kobs
+
+      !----------------------------------------------------------------------
+      ! Synchronize kproc on all processors
+      !----------------------------------------------------------------------
+      IF ( ln_grid_global ) THEN
+         CALL obs_mpp_max_integer( kproc, kobs )
+         CALL obs_mpp_max_integer( kobsi, kobs )
+         CALL obs_mpp_max_integer( kobsj, kobs )
+      ELSE
+         CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs )
+      ENDIF
+
+      WHERE( kproc(:) >= 1000000 )
+         kproc(:) = kproc(:) - 1000000
+      END WHERE
+
+      DEALLOCATE( &
+         & zlamg,         &
+         & zphig,         &
+         & zmskg,         &
+         & zphitmax,      &
+         & zphitmin,      &
+         & zlamtmax,      &
+         & zlamtmin,      &
+         & llinvalidcell, &
+         & zlamtm,        &
+         & zphitm,        &
+         & zplam          &
+         & )
+      
+   END SUBROUTINE obs_grid_search_lookup
+
+
+   SUBROUTINE obs_grid_setup
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_setup ***
+      !!
+      !! ** Purpose : Setup a lookup table to reduce the searching required
+      !!              for converting lat lons to grid point location
+      !!              produces or reads in a preexisting file for use in 
+      !!              obs_grid_search_lookup_local
+      !!
+      !! ** Method : calls obs_grid_search_bruteforce_local with a array 
+      !!             of lats and lons
+      !!
+      !! History :
+      !!        !  2007-12 (D. Lea) new routine
+      !!----------------------------------------------------------------------
+      
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: &
+         & cpname = 'obs_grid_setup'
+      CHARACTER(LEN=40) :: cfname      
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jo
+      INTEGER :: idfile, idny, idnx, idxpos, idypos
+      INTEGER :: idlat, idlon, fileexist
+      INTEGER, DIMENSION(2) :: incdim
+      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
+      REAL(wp) :: tmpx1, tmpx2, tmpy1, tmpy2
+      REAL(wp) :: meanxdiff, meanydiff
+      REAL(wp) :: meanxdiff1, meanydiff1
+      REAL(wp) :: meanxdiff2, meanydiff2
+      INTEGER :: numx1, numx2, numy1, numy2, df
+      INTEGER :: jimin, jimax, jjmin, jjmax
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & lonsi,     &
+         & latsi
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &  
+         & ixposi,    &
+         & iyposi,    & 
+         & iproci    
+      INTEGER, PARAMETER :: histsize=90
+      INTEGER, DIMENSION(histsize) :: &
+         & histx1, histx2, histy1, histy2
+      REAL, DIMENSION(histsize) :: &
+         & fhistx1, fhistx2, fhisty1, fhisty2
+      REAL(wp) :: histtol
+      
+      IF (ln_grid_search_lookup) THEN
+         
+         WRITE(numout,*) 'Calling obs_grid_setup'
+         
+#ifdef key_datetime_out
+         IF (lwp) THEN
+            CALL DATE_AND_TIME(datestr,timestr)
+            WRITE(numout,*) 'obs_grid_setup begin date_and_time ',datestr,' ',timestr
+         ENDIF
+#endif
+         
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'Grid search resolution : ', grid_search_res
+         
+         gsearch_nlons_def  = NINT( 360.0_wp / grid_search_res ) 
+         gsearch_nlats_def  = NINT( 180.0_wp / grid_search_res )
+         gsearch_lonmin_def = -180.0_wp + 0.5_wp * grid_search_res
+         gsearch_latmin_def =  -90.0_wp + 0.5_wp * grid_search_res
+         gsearch_dlon_def   = grid_search_res
+         gsearch_dlat_def   = grid_search_res
+         
+         IF (lwp) THEN
+            WRITE(numout,*)'Grid search gsearch_nlons_def  = ',gsearch_nlons_def
+            WRITE(numout,*)'Grid search gsearch_nlats_def  = ',gsearch_nlats_def
+            WRITE(numout,*)'Grid search gsearch_lonmin_def = ',gsearch_lonmin_def
+            WRITE(numout,*)'Grid search gsearch_latmin_def = ',gsearch_latmin_def
+            WRITE(numout,*)'Grid search gsearch_dlon_def   = ',gsearch_dlon_def
+            WRITE(numout,*)'Grid search gsearch_dlat_def   = ',gsearch_dlat_def
+         ENDIF
+
+         IF ( ln_grid_global ) THEN
+            WRITE(cfname, FMT="(A,'_',A)") &
+               &          TRIM(grid_search_file), 'global.nc'
+         ELSE
+            WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") &
+               &          TRIM(grid_search_file), nproc, jpni, jpnj
+         ENDIF
+
+         fileexist=nf90_open( TRIM( cfname ), nf90_nowrite, &
+            &                  idfile )
+         
+         IF ( fileexist == nf90_noerr ) THEN
+            
+            ! read data
+            ! initially assume size is as defined (to be fixed)
+            
+            WRITE(numout,*) 'Reading: ',cfname
+            
+            CALL chkerr( nf90_open( TRIM( cfname ), nf90_nowrite, idfile ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'maxxdiff', maxxdiff ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'maxydiff', maxydiff ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'dlon', dlon ), &
+            &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'dlat', dlat ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'lonmin', lonmin ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'latmin', latmin ), &
+               &         cpname, __LINE__ )        
+            
+            CALL chkerr( nf90_inq_dimid(idfile, 'nx'  , idnx), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_inquire_dimension( idfile, idnx, len = nlons ),     &
+               &         cpname, __LINE__ ) 
+            CALL chkerr( nf90_inq_dimid(idfile, 'ny'  , idny), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_inquire_dimension( idfile, idny, len = nlats ),     &
+               &         cpname, __LINE__ ) 
+            
+            ALLOCATE( &
+               & lons(nlons,nlats),  &
+               & lats(nlons,nlats),  &
+               & ixpos(nlons,nlats), &
+               & iypos(nlons,nlats), &
+               & iproc(nlons,nlats)  &
+               & )
+            
+            CALL chkerr( nf90_inq_varid( idfile, 'XPOS', idxpos ), & 
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var  ( idfile, idxpos, ixpos),   &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_inq_varid( idfile, 'YPOS', idypos ), & 
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var  ( idfile, idypos, iypos),   &
+               &         cpname, __LINE__ )
+            
+            CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+            
+            ! setup arrays
+            
+            DO ji = 1, nlons
+               DO jj = 1, nlats
+                  lons(ji,jj) = lonmin + (ji-1) * dlon
+                  lats(ji,jj) = latmin + (jj-1) * dlat
+               END DO
+            END DO
+            
+            ! if we are not reading the file we need to create it
+            ! create new obs grid search lookup file
+            
+         ELSE 
+            
+            ! call obs_grid_search
+            
+            IF (lwp) THEN
+               WRITE(numout,*) 'creating: ',cfname
+               WRITE(numout,*) 'calling obs_grid_search: ',nlons*nlats
+            ENDIF
+
+            ! set parameters from default values
+            nlons  = gsearch_nlons_def
+            nlats  = gsearch_nlats_def
+            lonmin = gsearch_lonmin_def
+            latmin = gsearch_latmin_def
+            dlon   = gsearch_dlon_def
+            dlat   = gsearch_dlat_def
+            
+            ! setup arrays
+            
+            ALLOCATE( &
+               & lonsi(nlons,nlats),   &
+               & latsi(nlons,nlats),   &
+               & ixposi(nlons,nlats),  &
+               & iyposi(nlons,nlats),  &
+               & iproci(nlons,nlats)   &
+               & )
+         
+            DO ji = 1, nlons
+               DO jj = 1, nlats
+                  lonsi(ji,jj) = lonmin + (ji-1) * dlon
+                  latsi(ji,jj) = latmin + (jj-1) * dlat
+               END DO
+            END DO
+            
+            CALL obs_grid_search_bruteforce( jpi, jpj, jpiglo, jpjglo,  &
+               &                             nldi, nlei,nldj,  nlej,    &
+               &                             nproc, jpnij,              &
+               &                             glamt, gphit, tmask,       &
+               &                             nlons*nlats, lonsi, latsi, &
+               &                             ixposi, iyposi, iproci )
+            
+            ! minimise file size by removing regions with no data from xypos file
+            ! should be able to just use xpos (ypos will have the same areas of missing data)
+         
+            jimin=1
+            jimax=nlons
+            jjmin=1
+            jjmax=nlats
+
+            minlon_xpos: DO ji= 1, nlons
+               IF (COUNT(ixposi(ji,:) >= 0) > 0) THEN
+                  jimin=ji
+                  EXIT minlon_xpos
+               ENDIF
+            END DO minlon_xpos
+
+            maxlon_xpos: DO ji= nlons, 1, -1
+               IF (COUNT(ixposi(ji,:) >= 0) > 0) THEN
+                  jimax=ji
+                  EXIT maxlon_xpos
+               ENDIF
+            END DO maxlon_xpos
+
+            minlat_xpos: DO jj= 1, nlats
+               IF (COUNT(ixposi(:,jj) >= 0) > 0) THEN
+                  jjmin=jj
+                  EXIT minlat_xpos
+               ENDIF
+            END DO minlat_xpos
+
+            maxlat_xpos: DO jj= nlats, 1, -1
+               IF (COUNT(ixposi(:,jj) >= 0) > 0) THEN 
+                  jjmax=jj
+                  EXIT maxlat_xpos
+               ENDIF
+            END DO maxlat_xpos
+
+            lonmin = lonsi(jimin,jjmin)
+            latmin = latsi(jimin,jjmin)
+            nlons  = jimax-jimin+1
+            nlats  = jjmax-jjmin+1
+
+            ! construct new arrays
+
+            ALLOCATE( &
+               & lons(nlons,nlats),    &
+               & lats(nlons,nlats),    &
+               & ixpos(nlons,nlats),   &
+               & iypos(nlons,nlats),   &
+               & iproc(nlons,nlats)    &
+               & )
+
+            lons(:,:) = lonsi(jimin:jimax,jjmin:jjmax)
+            lats(:,:) = latsi(jimin:jimax,jjmin:jjmax)
+            ixpos(:,:) = ixposi(jimin:jimax,jjmin:jjmax)
+            iypos(:,:) = iyposi(jimin:jimax,jjmin:jjmax)
+            iproc(:,:) = iproci(jimin:jimax,jjmin:jjmax)
+
+            DEALLOCATE(lonsi,latsi,ixposi,iyposi,iproci)
+
+            ! calculate (estimate) maxxdiff, maxydiff
+            ! this is to help define the search area for obs_grid_search_lookup
+
+            maxxdiff = 1
+            maxydiff = 1
+
+            tmpx1 = 0
+            tmpx2 = 0
+            tmpy1 = 0
+            tmpy2 = 0 
+
+            numx1 = 0
+            numx2 = 0
+            numy1 = 0
+            numy2 = 0
+
+            ! calculate the mean absolute xdiff and ydiff
+            ! also calculate a histogram
+            ! note the reason why looking for xdiff and ydiff in both directions
+            ! is to allow for rotated grids
+
+            DO ji = 1, nlons-1
+               DO jj = 1, nlats-1
+                  IF ( ixpos(ji,jj) > 0 .AND. iypos(ji,jj) > 0 ) THEN
+                     IF ( ixpos(ji+1,jj) > 0 ) THEN
+                        df = ABS( ixpos(ji+1,jj) - ixpos(ji,jj) )
+                        tmpx1 = tmpx1+df
+                        numx1 = numx1+1
+                        IF ( df < histsize ) histx1(df+1) = histx1(df+1) + 1
+                     ENDIF
+                     IF ( ixpos(ji,jj+1) > 0 ) THEN
+                        df = ABS( ixpos(ji,jj+1) - ixpos(ji,jj) )
+                        tmpx2 = tmpx2 + df
+                        numx2 = numx2 + 1
+                        IF ( df < histsize ) histx2(df+1) = histx2(df+1) + 1
+                     ENDIF
+                     IF (iypos(ji+1,jj) > 0) THEN
+                        df = ABS( iypos(ji+1,jj) - iypos(ji,jj) )
+                        tmpy1 = tmpy1 + df
+                        numy1 = numy1 + 1
+                        IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1
+                     ENDIF
+                     IF ( iypos(ji,jj+1) > 0 ) THEN
+                        df = ABS( iypos(ji,jj+1) - iypos(ji,jj) )
+                        tmpy2 = tmpy2 + df
+                        numy2 = numy2 + 1
+                        IF ( df < histsize ) histy2(df+1) = histy2(df+1) + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+
+            IF (lwp) THEN
+               WRITE(numout,*) 'histograms'
+               WRITE(numout,*) '0   1   2   3   4   5   6   7   8   9   10 ...'
+               WRITE(numout,*) 'histx1'
+               WRITE(numout,*) histx1
+               WRITE(numout,*) 'histx2'
+               WRITE(numout,*) histx2
+               WRITE(numout,*) 'histy1'
+               WRITE(numout,*) histy1
+               WRITE(numout,*) 'histy2'
+               WRITE(numout,*) histy2
+            ENDIF
+
+            meanxdiff1 = tmpx1 / numx1
+            meanydiff1 = tmpy1 / numy1
+            meanxdiff2 = tmpx2 / numx2
+            meanydiff2 = tmpy2 / numy2
+
+            meanxdiff = MAXVAL((/ meanxdiff1, meanxdiff2 /))
+            meanydiff = MAXVAL((/ meanydiff1, meanydiff2 /))
+
+            IF (lwp) THEN
+               WRITE(numout,*) tmpx1, tmpx2, tmpy1, tmpy2
+               WRITE(numout,*) numx1, numx2, numy1, numy2
+               WRITE(numout,*) 'meanxdiff: ',meanxdiff, meanxdiff1, meanxdiff2
+               WRITE(numout,*) 'meanydiff: ',meanydiff, meanydiff1, meanydiff2
+            ENDIF
+
+            tmpx1 = 0
+            tmpx2 = 0
+            tmpy1 = 0
+            tmpy2 = 0
+
+            numx1 = 0
+            numx2 = 0
+            numy1 = 0
+            numy2 = 0
+
+            histx1(:) = 0
+            histx2(:) = 0
+            histy1(:) = 0
+            histy2(:) = 0
+
+            limxdiff = meanxdiff * 4! limit the difference to avoid picking up wraparound
+            limydiff = meanydiff * 4
+
+            DO ji = 1, nlons-1
+               DO jj = 1, nlats-1
+                  IF ( ixpos(ji,jj) > 0 .AND. iypos(ji,jj) > 0 ) THEN
+
+                     IF ( ixpos(ji+1,jj) > 0 ) THEN
+                        df = ABS( ixpos(ji+1,jj)-ixpos(ji,jj) )
+                        tmpx1 = df
+                        IF ( df < limxdiff ) numx1 = numx1+1
+                        IF ( df < histsize ) histx1(df+1) = histx1(df+1) + 1
+                     ENDIF
+                     IF ( ixpos(ji,jj+1) > 0 ) THEN
+                        df = ABS( ixpos(ji,jj+1) - ixpos(ji,jj) )
+                        tmpx2 = df
+                        IF ( df < limxdiff ) numx2 = numx2 + 1
+                        IF ( df < histsize ) histx2(df+1) = histx2(df+1) + 1
+                     ENDIF
+                     IF (iypos(ji+1,jj) > 0) THEN
+                        df = ABS( iypos(ji+1,jj) - iypos(ji,jj) )
+                        tmpy1 = df
+                        IF ( df < limxdiff ) numy1 = numy1 + 1
+                        IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1
+                     ENDIF
+                     IF (iypos(ji,jj+1) > 0) THEN
+                        df = ABS( iypos(ji,jj+1) - iypos(ji,jj) )
+                        tmpy2 = df
+                        IF ( df < limxdiff ) numy2 = numy2+1
+                        IF ( df < histsize ) histy2(df+1) = histy2(df+1)+1
+                     ENDIF
+
+                     IF ( maxxdiff < tmpx1 .AND. tmpx1 < limxdiff ) &
+                        & maxxdiff = tmpx1
+                     IF ( maxxdiff < tmpx2 .AND. tmpx2 < limxdiff ) &
+                        & maxxdiff = tmpx2
+                     IF ( maxydiff < tmpy1 .AND. tmpy1 < limydiff ) &
+                        & maxydiff = tmpy1
+                     IF ( maxydiff < tmpy2 .AND. tmpy2 < limydiff ) &
+                        & maxydiff = tmpy2
+
+                  ENDIF
+               END DO
+            END DO
+
+            ! cumulative histograms
+
+            DO ji = 1, histsize - 1
+               histx1(ji+1) = histx1(ji+1) + histx1(ji)
+               histx2(ji+1) = histx2(ji+1) + histx2(ji)
+               histy1(ji+1) = histy1(ji+1) + histy1(ji)
+               histy2(ji+1) = histy2(ji+1) + histy2(ji)
+            END DO
+
+            fhistx1(:) = histx1(:) * 1.0 / numx1
+            fhistx2(:) = histx2(:) * 1.0 / numx2
+            fhisty1(:) = histy1(:) * 1.0 / numy1
+            fhisty2(:) = histy2(:) * 1.0 / numy2
+
+            ! output new histograms
+
+            IF (lwp) THEN
+               WRITE(numout,*) 'cumulative histograms'
+               WRITE(numout,*) '0   1   2   3   4   5   6   7   8   9   10 ...'
+               WRITE(numout,*) 'fhistx1'
+               WRITE(numout,*) fhistx1
+               WRITE(numout,*) 'fhistx2'
+               WRITE(numout,*) fhistx2
+               WRITE(numout,*) 'fhisty1'
+               WRITE(numout,*) fhisty1
+               WRITE(numout,*) 'fhisty2'
+               WRITE(numout,*) fhisty2
+            ENDIF
+
+            ! calculate maxxdiff and maxydiff based on cumulative histograms
+            ! where > 0.999 of points are
+
+            ! maxval just converts 1x1 vector return from maxloc to a scalar 
+
+            histtol = 0.999
+            tmpx1 = MAXVAL( MAXLOC( fhistx1(:), mask = ( fhistx1(:) <= histtol ) ) )
+            tmpx2 = MAXVAL( MAXLOC( fhistx2(:), mask = ( fhistx2(:) <= histtol ) ) )
+            tmpy1 = MAXVAL( MAXLOC( fhisty1(:), mask = ( fhisty1(:) <= histtol ) ) )
+            tmpy2 = MAXVAL( MAXLOC( fhisty2(:), mask = ( fhisty2(:) <= histtol ) ) )
+
+            maxxdiff = MAXVAL( (/ tmpx1, tmpx2 /) ) + 1
+            maxydiff = MAXVAL( (/ tmpy1, tmpy2 /) ) + 1
+
+            ! Write out data
+
+            IF ( ( .NOT. ln_grid_global ) .OR. &
+               & ( ( ln_grid_global ) .AND. ( nproc==0 ) ) ) THEN
+
+               CALL chkerr( nf90_create (TRIM(cfname), nf90_clobber, idfile), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'title',       &
+                  &         'Mapping file from lon/lat to model grid point' ),&
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'maxxdiff',    &
+                  &                       maxxdiff ),                         &
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'maxydiff',    &
+                  &                       maxydiff ),                         &
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'dlon', dlon ),&
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'dlat', dlat ),&
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'lonmin',      &
+                  &                       lonmin ),                           &
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'latmin',      &
+                  &                       latmin ),                           &
+                  &         cpname,__LINE__ ) 
+
+               CALL chkerr( nf90_def_dim(idfile, 'nx'  , nlons, idnx),        &
+                  &         cpname,__LINE__ )
+               CALL chkerr( nf90_def_dim(idfile, 'ny'  , nlats, idny),        &
+                  &         cpname,__LINE__ )
+
+               incdim(1) = idnx
+               incdim(2) = idny
+               
+               CALL chkerr( nf90_def_var( idfile, 'LON', nf90_float, incdim,  &
+                  &                       idlon ),                            &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idlon, 'long_name',         &
+                  &                       'longitude' ),                      &
+                  &         cpname, __LINE__ )
+               
+               CALL chkerr( nf90_def_var( idfile, 'LAT', nf90_float, incdim,  &
+                  &                       idlat ),                            &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idlat, 'long_name',         &
+                  &                       'latitude' ),                       &
+                  &         cpname, __LINE__ )
+
+               CALL chkerr( nf90_def_var( idfile, 'XPOS', nf90_int, incdim,   &
+                  &                       idxpos ),                           &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idxpos, 'long_name',        &
+                  &                       'x position' ),                     &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idxpos, '_FillValue', -1 ), &
+                  &         cpname, __LINE__ )
+
+               CALL chkerr( nf90_def_var( idfile, 'YPOS', nf90_int, incdim,   &
+                  &                       idypos ),                           &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idypos, 'long_name',        &
+                  &                       'y position' ),                     &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idypos, '_FillValue', -1 ), &
+                  &         cpname, __LINE__ )
+
+               CALL chkerr( nf90_enddef( idfile ), cpname, __LINE__ )
+               
+               CALL chkerr( nf90_put_var( idfile, idlon, lons),               &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idlat, lats),               &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idxpos, ixpos),             &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idypos, iypos),             &
+                  &         cpname, __LINE__ )
+               
+               CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+               
+               ! should also output max i, max j spacing for use in 
+               ! obs_grid_search_lookup
+               
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE obs_grid_setup
+   
+   SUBROUTINE obs_grid_deallocate( )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_setup ***
+      !!
+      !! ** Purpose : Deallocate arrays setup by obs_grid_setup
+      !!
+      !! History :
+      !!        !  2007-12 (D. Lea) new routine
+      !!-----------------------------------------------------------------------
+
+      IF (ln_grid_search_lookup) THEN
+         DEALLOCATE( lons, lats, ixpos, iypos, iproc )
+      ENDIF
+      
+   END SUBROUTINE obs_grid_deallocate
+
+#include "obs_level_search.h90"
+
+#include "linquad.h90"
+
+#include "maxdist.h90"
+
+#include "find_obs_proc.h90"
+
+END MODULE obs_grid
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_grid_search_bruteforce.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_grid_search_bruteforce.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_grid_search_bruteforce.h90	(revision 2236)
@@ -0,0 +1,349 @@
+   SUBROUTINE obs_grid_search_bruteforce( kpi, kpj, kpiglo, kpjglo,       &
+      &                                   kldi, klei, kldj, klej,         &
+      &                                   kmyproc, ktotproc,              &
+      &                                   pglam, pgphi, pmask,            &
+      &                                   kobs, plam, pphi, kobsi, kobsj, &
+      &                                   kproc)
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_search_bruteforce ***
+      !!
+      !! ** Purpose : Search gridpoints to find the grid box containing
+      !!              the observations
+      !!
+      !! ** Method  : Call to linquad
+      !!
+      !! ** Action  : Return kproc holding the observation and kiobsi,kobsj
+      !!              valid on kproc=kmyproc processor only.
+      !!   
+      !! History :
+      !!        !  2001-11  (N. Daget, A. Weaver)
+      !!        !  2006-03  (A. Weaver) NEMOVAR migration.
+      !!        !  2006-05  (K. Mogensen) Moved to to separate routine.
+      !!        !  2007-10  (A. Vidard) Bug fix in wrap around checks; cleanup
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kpi                ! Number of local longitudes
+      INTEGER, INTENT(IN) :: kpj                ! Number of local latitudes
+      INTEGER, INTENT(IN) :: kpiglo             ! Number of global longitudes
+      INTEGER, INTENT(IN) :: kpjglo             ! Number of global latitudes
+      INTEGER, INTENT(IN) :: kldi               ! Start of inner domain in i
+      INTEGER, INTENT(IN) :: klei               ! End of inner domain in i
+      INTEGER, INTENT(IN) :: kldj               ! Start of inner domain in j
+      INTEGER, INTENT(IN) :: klej               ! End of inner domain in j
+      INTEGER, INTENT(IN) :: kmyproc            ! Processor number for MPP
+      INTEGER, INTENT(IN) :: ktotproc           ! Total number of processors
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & pglam,   &               ! Grid point longitude
+         & pgphi,   &               ! Grid point latitude
+         & pmask                    ! Grid point mask
+      INTEGER,INTENT(IN) :: kobs                ! Size of the observation arrays
+      REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: &
+         & plam, &                  ! Longitude of obsrvations 
+         & pphi                     ! Latitude of observations
+      INTEGER, DIMENSION(kobs), INTENT(OUT) :: &
+         & kobsi, &                 ! I-index of observations 
+         & kobsj, &                 ! J-index of observations 
+         & kproc                    ! Processor number of observations
+  
+      !! * Local declarations
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zplam, zpphi
+      REAL(wp) :: zlammax
+      REAL(wp) :: zlam
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jo
+      INTEGER :: jlon
+      INTEGER :: jlat
+      INTEGER :: joffset
+      INTEGER :: jostride
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zlamg, &
+         & zphig, &
+         & zmskg, &
+         & zphitmax,&
+         & zphitmin,&
+         & zlamtmax,&
+         & zlamtmin
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: &
+         & llinvalidcell
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zlamtm,  &
+         & zphitm
+
+      !-----------------------------------------------------------------------
+      ! Define grid setup for grid search
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         jlon     = kpiglo
+         jlat     = kpjglo
+         joffset  = kmyproc
+         jostride = ktotproc
+      ELSE
+         jlon     = kpi
+         jlat     = kpj
+         joffset  = 0
+         jostride = 1
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Set up data for grid search
+      !-----------------------------------------------------------------------
+      ALLOCATE( &
+         & zlamg(jlon,jlat),             &
+         & zphig(jlon,jlat),             &
+         & zmskg(jlon,jlat),             &
+         & zphitmax(jlon-1,jlat-1),      &
+         & zphitmin(jlon-1,jlat-1),      &
+         & zlamtmax(jlon-1,jlat-1),      &
+         & zlamtmin(jlon-1,jlat-1),      &
+         & llinvalidcell(jlon-1,jlat-1), &
+         & zlamtm(4,jlon-1,jlat-1),      &
+         & zphitm(4,jlon-1,jlat-1)       &
+         & )
+      !-----------------------------------------------------------------------
+      ! Copy data to local arrays
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         zlamg(:,:) = -1.e+10
+         zphig(:,:) = -1.e+10
+         zmskg(:,:) = -1.e+10
+         DO jj = kldj, klej
+            DO ji = kldi, klei
+               zlamg(mig(ji),mjg(jj)) = pglam(ji,jj)
+               zphig(mig(ji),mjg(jj)) = pgphi(ji,jj)
+               zmskg(mig(ji),mjg(jj)) = pmask(ji,jj)
+            END DO
+         END DO
+         CALL mpp_global_max( zlamg )
+         CALL mpp_global_max( zphig )
+         CALL mpp_global_max( zmskg )
+      ELSE
+         DO jj = 1, jlat
+            DO ji = 1, jlon
+               zlamg(ji,jj) = pglam(ji,jj)
+               zphig(ji,jj) = pgphi(ji,jj)
+               zmskg(ji,jj) = pmask(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Copy longitudes and latitudes
+      !-----------------------------------------------------------------------
+      ALLOCATE( &
+         & zplam(kobs), &
+         & zpphi(kobs)  &
+         & )
+      DO jo = 1, kobs
+         zplam(jo) = plam(jo)
+         zpphi(jo) = pphi(jo)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Set default values for output
+      !-----------------------------------------------------------------------
+      kproc(:) = -1
+      kobsi(:) = -1
+      kobsj(:) = -1
+      !-----------------------------------------------------------------------
+      ! Copy grid positions to temporary arrays and renormalize to 0 to 360.
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlamtm(1,ji,jj) = zlamg(ji  ,jj  )
+            zphitm(1,ji,jj) = zphig(ji  ,jj  )
+            zlamtm(2,ji,jj) = zlamg(ji+1,jj  )
+            zphitm(2,ji,jj) = zphig(ji+1,jj  )
+            zlamtm(3,ji,jj) = zlamg(ji+1,jj+1)
+            zphitm(3,ji,jj) = zphig(ji+1,jj+1)
+            zlamtm(4,ji,jj) = zlamg(ji  ,jj+1)
+            zphitm(4,ji,jj) = zphig(ji  ,jj+1)
+         END DO
+      END DO
+      WHERE ( zlamtm(:,:,:) < 0.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) + 360.0_wp
+      END WHERE
+      WHERE ( zlamtm(:,:,:) > 360.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) - 360.0_wp
+      END WHERE
+      !-----------------------------------------------------------------------
+      ! Handle case of the wraparound; beware, not working with orca180
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlammax = MAXVAL( zlamtm(:,ji,jj) )
+            WHERE (zlammax - zlamtm(:, ji, jj) > 180 ) &
+               & zlamtm(:,ji,jj) = zlamtm(:,ji,jj) + 360._wp
+            zphitmax(ji,jj) = MAXVAL(zphitm(:,ji,jj))
+            zphitmin(ji,jj) = MINVAL(zphitm(:,ji,jj))
+            zlamtmax(ji,jj) = MAXVAL(zlamtm(:,ji,jj))
+            zlamtmin(ji,jj) = MINVAL(zlamtm(:,ji,jj))
+         END DO
+      END DO
+      !-----------------------------------------------------------------------
+      ! Search for boxes with only land points mark them invalid
+      !-----------------------------------------------------------------------
+      llinvalidcell(:,:) = .FALSE.
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            llinvalidcell(ji,jj) =               &
+               & zmskg(ji  ,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj+1) == 0.0_wp .AND. &
+               & zmskg(ji  ,jj+1) == 0.0_wp
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------
+      ! Master loop for grid search
+      !------------------------------------------------------------------------
+
+      DO jo = 1+joffset, kobs, jostride
+
+         !---------------------------------------------------------------------
+         ! Ensure that all observation longtiudes are between 0 and 360
+         !---------------------------------------------------------------------
+
+         IF ( zplam(jo) <   0.0_wp ) zplam(jo) = zplam(jo) + 360.0_wp
+         IF ( zplam(jo) > 360.0_wp ) zplam(jo) = zplam(jo) - 360.0_wp
+
+         !---------------------------------------------------------------------
+         ! Find observations which are on within 1e-6 of a grid point
+         !---------------------------------------------------------------------
+
+         gridloop: DO jj = 1, jlat-1
+            DO ji = 1, jlon-1
+               IF ( ABS( zphig(ji,jj) - zpphi(jo) ) < 1e-6 )  THEN
+                  zlam = zlamg(ji,jj)
+                  IF ( zlam <   0.0_wp ) zlam = zlam + 360.0_wp
+                  IF ( zlam > 360.0_wp ) zlam = zlam - 360.0_wp
+                  IF ( ABS( zlam - zplam(jo) ) < 1e-6 ) THEN
+                     IF ( llinvalidcell(ji,jj) ) THEN
+                        kproc(jo) = kmyproc + 1000000
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        CYCLE
+                     ELSE
+                        kproc(jo) = kmyproc
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        EXIT gridloop
+                     ENDIF
+                  ENDIF
+               ENDIF
+            END DO
+         END DO gridloop
+         
+         !---------------------------------------------------------------------
+         ! Ensure that all observation longtiudes are between -180 and 180
+         !---------------------------------------------------------------------
+
+         IF ( zplam(jo) > 180 ) zplam(jo) = zplam(jo) - 360.0_wp
+
+         !---------------------------------------------------------------------
+         ! Do coordinate search using brute force.
+         ! - For land points kproc is set to number of the processor + 1000000
+         !   and we continue the search.
+         ! - For ocean points kproc is set to the number of the processor 
+         !   and we stop the search.
+         !---------------------------------------------------------------------
+
+         IF ( kproc(jo) == -1 ) THEN
+
+            ! Normal case
+            gridpoints : DO jj = 1, jlat-1
+               DO ji = 1, jlon-1
+                  
+                  IF ( ( zplam(jo) > zlamtmax(ji,jj) ) .OR. &
+                     & ( zplam(jo) < zlamtmin(ji,jj) ) ) CYCLE
+                  
+                  IF ( ABS( zpphi(jo) ) < 85 ) THEN
+                     IF ( ( zpphi(jo) > zphitmax(ji,jj) ) .OR. &
+                        & ( zpphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                  ENDIF
+                  
+                  IF ( linquad( zplam(jo), zpphi(jo), &
+                     &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                     IF ( llinvalidcell(ji,jj) ) THEN
+                        kproc(jo) = kmyproc + 1000000
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        CYCLE
+                     ELSE
+                        kproc(jo) = kmyproc
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        EXIT gridpoints
+                     ENDIF
+                  ENDIF
+                  
+               END DO
+            END DO gridpoints
+
+         ENDIF
+
+         ! In case of failure retry for obs. longtiude + 360.
+         IF ( kproc(jo) == -1 ) THEN
+            gridpoints_greenwich : DO jj = 1, jlat-1
+               DO ji = 1, jlon-1
+
+                  IF ( ( zplam(jo)+360.0_wp > zlamtmax(ji,jj) ) .OR. &
+                     & ( zplam(jo)+360.0_wp < zlamtmin(ji,jj) ) ) CYCLE
+
+                  IF ( ABS( zpphi(jo) ) < 85 ) THEN
+                     IF ( ( zpphi(jo) > zphitmax(ji,jj) ) .OR. &
+                        & ( zpphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                  ENDIF
+
+                  IF ( linquad( zplam(jo)+360.0_wp, zpphi(jo), &
+                     &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                     IF ( llinvalidcell(ji,jj) ) THEN
+                        kproc(jo) = kmyproc + 1000000
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        CYCLE
+                     ELSE
+                        kproc(jo) = kmyproc
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        EXIT gridpoints_greenwich
+                     ENDIF
+                  ENDIF
+
+               END DO
+            END DO gridpoints_greenwich
+
+         ENDIF
+      END DO
+
+      !----------------------------------------------------------------------
+      ! Synchronize kproc on all processors
+      !----------------------------------------------------------------------
+      IF ( ln_grid_global ) THEN
+         CALL obs_mpp_max_integer( kproc, kobs )
+         CALL obs_mpp_max_integer( kobsi, kobs )
+         CALL obs_mpp_max_integer( kobsj, kobs )
+      ELSE
+         CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs )
+      ENDIF
+
+      WHERE( kproc(:) >= 1000000 )
+         kproc(:) = kproc(:) - 1000000
+      END WHERE
+
+      DEALLOCATE( &
+         & zlamg,         &
+         & zphig,         &
+         & zmskg,         &
+         & zphitmax,      &
+         & zphitmin,      &
+         & zlamtmax,      &
+         & zlamtmin,      &
+         & llinvalidcell, &
+         & zlamtm,        &
+         & zphitm,        &
+         & zplam,         &
+         & zpphi          &
+         & )
+
+   END SUBROUTINE obs_grid_search_bruteforce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90	(revision 2236)
@@ -0,0 +1,50 @@
+MODULE obs_inter_h2d
+   !!======================================================================
+   !!                       ***  MODULE obs_inter_h2d   ***
+   !! Observation diagnostics: Perform the horizontal interpolation
+   !!                          from model grid to observation location
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_int_h2d     : Horizontal interpolation to the observation point
+   !!   obs_int_h2d_ds1 : Distance-weighted interpolation                 (n2dint=0)
+   !!   obs_int_h2d_ds2 : Distance-weighted interpolation (small angle)   (n2dint=1)
+   !!   obs_int_h2d_bil : Bilinear interpolation (geographical grid)      (n2dint=2)
+   !!   obs_int_h2d_bir : Bilinear remapping interpolation (general grid) (n2dint=3)
+   !!   obs_int_h2d_pol : Polynomial interpolation                        (n2dint=4)
+   !!   bil_wgt         : Compute weights for bilinear remapping
+   !!   lu_invmat       : Invert a matrix using LU decomposition
+   !!   lu_decomp       : LU decomposition
+   !!   lu_backsb       : LU decomposition - back substitution
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : &  ! Precision variables
+      & wp
+   USE phycst,   ONLY : &  ! Physical constants
+      & rad,  &
+      & rpi
+   USE in_out_manager
+   USE obs_const, ONLY : &
+      & obfillflt		! Fillvalue
+   USE obs_utils           ! Utility functions
+   
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE obs_int_h2d_ds1, & ! Distance-weighted interpolation               
+      &    obs_int_h2d_ds2, & ! Distance-weighted interpolation (small angle) 
+      &    obs_int_h2d_bil, & ! Bilinear interpolation (geographical grid)    
+      &    obs_int_h2d_bir, & ! Bilinear remapping interpolation (general grid)
+      &    obs_int_h2d_pol, & ! Polynomial interpolation                       
+      &    lu_invmat,       & ! Invert a matrix using LU decomposition
+      &    lu_decomp,       & ! LU decomposition
+      &    lu_backsb,       & ! LU decomposition - back substitution
+      &    bil_wgt            ! Compute weights for bilinear remapping
+   PUBLIC obs_int_h2d,      & ! Horizontal interpolation to the observation point
+      &   obs_int_h2d_init    ! Set up weights and vertical mask
+
+CONTAINS
+ 
+#include "obsinter_h2d.h90"
+
+END MODULE obs_inter_h2d
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 2236)
@@ -0,0 +1,372 @@
+MODULE obs_inter_sup
+   !!=====================================================================
+   !!                       ***  MODULE obs_inter_sup  ***
+   !! Observation diagnostics: Support for interpolation
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_int_comm_3d : Get 3D interpolation stencil
+   !!   obs_int_comm_2d : Get 2D interpolation stencil
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind        ! Precision variables
+   USE dom_oce         ! Domain variables
+   USE mpp_map         ! Map of processor points
+   USE lib_mpp         ! MPP stuff
+   USE obs_mpp         ! MPP stuff for observations
+   USE obs_grid        ! Grid tools
+   USE in_out_manager  ! I/O stuff
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   
+   PUBLIC obs_int_comm_3d, & ! Get 3D interpolation stencil
+      &   obs_int_comm_2d    ! Get 2D interpolation stencil
+   
+CONTAINS
+
+   SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+      &                        pval, pgval, kproc )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_3d  ***
+      !!          
+      !! ** Purpose : Get 3D interpolation stencil
+      !!
+      !! ** Method  : Either on-demand communication with 
+      !!              obs_int_comm_3d_global 
+      !!              or local memory with
+      !!              obs_int_comm_3D_local
+      !!              depending on ln_global_grid
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi     ! Number of i horizontal points per stencil 
+      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs      ! Local number of observations
+      INTEGER, INTENT(IN) :: kpk       ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      
+      IF (ln_grid_global) THEN
+         
+         IF (PRESENT(kproc)) THEN
+
+            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, &
+               &                         kgrdj, pval, pgval, kproc=kproc )
+
+         ELSE
+
+            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, &
+               &                         kgrdj, pval, pgval )
+
+         ENDIF
+
+      ELSE
+
+         CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+            &                        pval, pgval )
+
+      ENDIF
+
+   END SUBROUTINE obs_int_comm_3d
+
+   SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kgrdi, kgrdj, pval, pgval, &
+      &                        kproc )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_2d  ***
+      !!          
+      !! ** Purpose : Get 2D interpolation stencil
+      !!
+      !! ** Method  : Call to obs_int_comm_3d
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi        ! Number of i horizontal points per stencil
+      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs          ! Local number of observations
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(jpi,jpj), INTENT(IN) ::&
+         & pval             ! Local 3D array to extra data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(jpi,jpj,1) :: &
+         & zval
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,1,kobs) ::&
+         & zgval 
+
+      ! Set up local "3D" buffer
+
+      zval(:,:,1) = pval(:,:)
+
+      ! Call the 3D version
+
+      IF (PRESENT(kproc)) THEN
+
+         CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, &
+            &                  zgval, kproc=kproc )
+      ELSE
+
+         CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, &
+            &                  zgval )
+
+      ENDIF
+
+      ! Copy "3D" data back to 2D
+
+      pgval(:,:,:) = zgval(:,:,1,:)
+
+   END SUBROUTINE obs_int_comm_2d
+
+   SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+      &                               pval, pgval, kproc )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_3d_global  ***
+      !!          
+      !! ** Purpose : Get 3D interpolation stencil (global version)
+      !!
+      !! ** Method  : On-demand communication where each processor send its
+      !!              list of (i,j) of points to all processors and receive 
+      !!              the corresponding values
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi     ! Number of i horizontal points per stencil 
+      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs      ! Local number of observations
+      INTEGER, INTENT(IN) :: kpk       ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zsend, &
+         & zrecv
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & igrdij_send, &
+         & igrdij_recv
+      INTEGER, DIMENSION(kptsi,kptsj,kobs) :: &
+         & iorder, &
+         & iproc
+      INTEGER :: nplocal(jpnij)
+      INTEGER :: npglobal(jpnij)
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jp
+      INTEGER :: jobs
+      INTEGER :: it
+      INTEGER :: itot
+      INTEGER :: ii
+      INTEGER :: ij
+
+      ! Check valid points
+      
+      IF ( ( MAXVAL(kgrdi) > jpiglo ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. &
+         & ( MAXVAL(kgrdj) > jpjglo ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN
+         
+         CALL ctl_stop( 'Error in obs_int_comm_3d_global', &
+            &           'Point outside global domain' )
+         
+      ENDIF
+
+      ! Count number of points on each processors
+
+      nplocal(:) = 0
+      IF (PRESENT(kproc)) THEN 
+         iproc(:,:,:) = kproc(:,:,:)
+         DO jobs = 1, kobs
+            DO jj = 1, kptsj
+               DO ji = 1, kptsi
+                  nplocal(iproc(ji,jj,jobs)) = nplocal(iproc(ji,jj,jobs)) + 1
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jobs = 1, kobs
+            DO jj = 1, kptsj
+               DO ji = 1, kptsi
+                  iproc(ji,jj,jobs) = mppmap(kgrdi(ji,jj,jobs),&
+                     &                       kgrdj(ji,jj,jobs))
+                  nplocal(iproc(ji,jj,jobs)) = nplocal(iproc(ji,jj,jobs)) + 1
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Send local number of points and receive points on current domain
+
+      CALL mpp_alltoall_int( 1, nplocal, npglobal )
+
+      ! Allocate message parsing workspace
+
+      itot = SUM(npglobal)
+
+      ALLOCATE( &
+         & igrdij_send(kptsi*kptsj*kobs*2), &
+         & igrdij_recv(itot*2),             &
+         & zsend(kpk,itot),                 &
+         & zrecv(kpk,kptsi*kptsj*kobs)      &
+         & )
+
+      ! Pack buffers for list of points
+
+      it = 0
+      DO jp = 1, jpnij 
+         DO jobs = 1, kobs
+            DO jj = 1, kptsj
+               DO ji = 1, kptsi
+                  IF ( iproc(ji,jj,jobs) == jp ) THEN
+                     it = it + 1
+                     iorder(ji,jj,jobs) = it
+                     igrdij_send(2*it-1) = kgrdi(ji,jj,jobs)
+                     igrdij_send(2*it  ) = kgrdj(ji,jj,jobs)
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Send and recieve buffers for list of points
+
+      CALL mpp_alltoallv_int( igrdij_send, kptsi*kptsj*kobs*2, nplocal(:)*2, &
+         &                    igrdij_recv, itot*2, npglobal(:)*2 )
+
+      ! Pack interpolation data to be sent
+
+      DO ji = 1, itot
+         ii = mi1(igrdij_recv(2*ji-1))
+         ij = mj1(igrdij_recv(2*ji))
+         DO jk = 1, kpk
+            zsend(jk,ji) = pval(ii,ij,jk)
+         END DO
+      END DO
+
+      ! Re-adjust sizes
+
+      nplocal(:)  = kpk*nplocal(:)
+      npglobal(:) = kpk*npglobal(:)
+
+
+      ! Send and receive data for interpolation stencil
+
+      CALL mpp_alltoallv_real( zsend, kpk*itot,             npglobal, &
+         &                     zrecv, kpk*kptsi*kptsj*kobs, nplocal )
+
+      ! Copy the received data into output data structure
+      
+      DO jobs = 1, kobs
+         DO jj = 1, kptsj
+            DO ji = 1, kptsi
+               it = iorder(ji,jj,jobs)  
+               DO jk = 1, kpk
+                  pgval(ji,jj,jk,jobs) = zrecv(jk,it)
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Deallocate message parsing workspace
+
+      DEALLOCATE( &
+         & igrdij_send, &
+         & igrdij_recv, &
+         & zsend,       &
+         & zrecv        &
+         & )
+
+   END SUBROUTINE obs_int_comm_3d_global
+   
+   SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+      &                              pval, pgval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_3d_global  ***
+      !!          
+      !! ** Purpose : Get 3D interpolation stencil (global version)
+      !!
+      !! ** Method  : On-demand communication where each processor send its
+      !!              list of (i,j) of points to all processors and receive 
+      !!              the corresponding values
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi        ! Number of i horizontal points per stencil 
+      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs         ! Local number of observations
+      INTEGER, INTENT(IN) :: kpk          ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      INTEGER ::  ji
+      INTEGER ::  jj
+      INTEGER ::  jk
+      INTEGER ::  jobs
+
+      ! Check valid points
+
+      IF ( ( MAXVAL(kgrdi) > jpi ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. &
+         & ( MAXVAL(kgrdj) > jpj ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN
+         
+         CALL ctl_stop( 'Error in obs_int_comm_3d_local', &
+            &           'Point outside local domain' )
+         
+      ENDIF
+
+      ! Copy local data
+
+      DO jobs = 1, kobs
+         DO jj = 1, kptsj
+            DO ji = 1, kptsi
+               DO jk = 1, kpk
+                  pgval(ji,jj,jk,jobs) = &
+                     &            pval(kgrdi(ji,jj,jobs),kgrdj(ji,jj,jobs),jk)
+               END DO
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE obs_int_comm_3d_local
+
+END MODULE obs_inter_sup
+ 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90	(revision 2236)
@@ -0,0 +1,31 @@
+MODULE obs_inter_z1d
+   !!======================================================================
+   !!                       ***  MODULE obs_inter_z1d  ***
+   !! Observation diagnostics: Perform the vertical interpolation
+   !!                          from model grid to observation location
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_int_z1d     : Vertical interpolation to the observation point
+   !!   obs_int_z1d_spl : Compute the vertical 2nd derivative of the
+   !!                     interpolating function for a cubic spline (n1dint=1)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : &  ! Precision variables
+      & wp
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_int_z1d,    &  ! Vertical interpolation to the observation pt.
+      &   obs_int_z1d_spl    ! Compute the vertical 2nd derivative of the
+                             ! interpolating function used with a cubic spline
+
+CONTAINS
+
+#include "obsinter_z1d.h90"
+
+END MODULE obs_inter_z1d
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_level_search.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_level_search.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_level_search.h90	(revision 2236)
@@ -0,0 +1,45 @@
+   SUBROUTINE obs_level_search( kgrd, pgrddep, kobs, pobsdep, kobsk )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_level_search ***
+      !!
+      !! ** Purpose : Search levels to find matching level to observed depth
+      !!
+      !! ** Method  : Straightforward search
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  2001-11  (N. Daget, A. Weaver)
+      !!        !  2006-03  (A. Weaver) NEMOVAR migration.
+      !!        !  2006-05  (K. Mogensen) Moved to to separate routine.
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!        !  2008-10  (K. Mogensen) Remove assumptions on grid.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kgrd     ! Number of gridpoints
+      REAL(KIND=wp), DIMENSION(kgrd), INTENT(INOUT) :: &
+         &   pgrddep  ! Depths of gridpoints
+      INTEGER, INTENT(IN) :: &
+         &   kobs     ! Number of observations
+      REAL(KIND=wp), DIMENSION(kobs), INTENT(INOUT) :: &
+         &   pobsdep  ! Depths of observations
+      INTEGER ,DIMENSION(kobs), INTENT(OUT) :: &
+         &   kobsk    ! Level indices of observations
+  
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jk
+
+      !------------------------------------------------------------------------
+      ! Search levels for each observations to find matching level
+      !------------------------------------------------------------------------
+      DO ji = 1, kobs 
+         kobsk(ji) = 1
+         depk: DO jk = 2, kgrd
+            IF ( pgrddep(jk) >= pobsdep(ji) ) EXIT depk
+         END DO depk
+         kobsk(ji) = jk
+      END DO
+
+   END SUBROUTINE obs_level_search
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_mpp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 2236)
@@ -0,0 +1,566 @@
+#if defined key_mpp_mpi
+#if defined key_sp
+#define mpivar mpi_real
+#else
+#define mpivar mpi_double_precision
+#endif
+#endif
+MODULE obs_mpp
+   !!======================================================================
+   !!                       ***  MODULE obs_mpp  ***
+   !! Observation diagnostics: Various MPP support routines
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !! obs_mpp_bcast_integer : Broadcast an integer array from a processor 
+   !!                         to all processors
+   !! obs_mpp_max_integer   : Find maximum on all processors of each
+   !!                         value in an integer on all processors
+   !! obs_mpp_find_obs_proc : Find processors which should hold the observations
+   !! obs_mpp_sum_integers  : Sum an integer array from all processors
+   !! obs_mpp_sum_integer   : Sum an integer from all processors
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE dom_oce, ONLY : &    ! Ocean space and time domain variables
+      & nproc, &
+      & mig,mjg
+   USE mpp_map, ONLY : &
+      & mppmap
+   USE in_out_manager
+#if defined key_mpp_mpi
+   USE lib_mpp, ONLY : &    ! MPP library
+      & mpi_comm_opa
+#endif
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_mpp_bcast_integer, & ! Broadcast an integer array from a proc to all procs
+      &   obs_mpp_max_integer,   & ! Find maximum across processors in an integer array
+      &   obs_mpp_find_obs_proc, & ! Find processors which should hold the observations
+      &   obs_mpp_sum_integers,  & ! Sum an integer array from all processors
+      &   obs_mpp_sum_integer,   & ! Sum an integer from all processors
+      &   mpp_alltoall_int,      &
+      &   mpp_alltoallv_int,     &
+      &   mpp_alltoallv_real,    &
+      &   mpp_global_max
+
+CONTAINS
+
+   SUBROUTINE obs_mpp_bcast_integer(kvals,kno,kroot)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_bcast_integer ***
+      !!          
+      !! ** Purpose : Send array kvals to all processors
+      !!
+      !! ** Method  : MPI broadcast
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!              MPI_COMM_OPA needs to be replace for OASIS4.!
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kno       ! Number of elements in array
+      INTEGER, INTENT(IN) :: kroot      ! Processor to send data
+      INTEGER, DIMENSION(kno), INTENT(INOUT) :: &
+         & kvals         ! Array to send on kroot, receive for non-kroot
+  
+#if defined key_mpp_mpi
+      !! * Local declarations
+      INTEGER :: ierr
+#     include <mpif.h>
+
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to broadcast data
+      !-----------------------------------------------------------------------
+      CALL mpi_bcast( kvals, kno, mpi_integer, &
+         &            kroot, mpi_comm_opa, ierr )
+#elif defined key_mpp_shmem
+error "Only MPI support for MPP in NEMOVAR"
+#endif
+
+   END SUBROUTINE obs_mpp_bcast_integer
+    
+   SUBROUTINE obs_mpp_max_integer( kvals, kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_bcast_integer ***
+      !!          
+      !! ** Purpose : Find maximum across processors in an integer array.
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!              MPI_COMM_OPA needs to be replace for OASIS4.!
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) ::kno       ! Number of elements in array
+      INTEGER, DIMENSION(kno), INTENT(INOUT) :: &
+         & kvals     ! Array to send on kroot, receive for non-kroot  
+
+#if defined key_mpp_mpi
+      !! * Local declarations
+      INTEGER :: ierr
+      INTEGER, DIMENSION(kno) :: &
+         & ivals
+#     include <mpif.h>
+
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the maximum across processors
+      !-----------------------------------------------------------------------
+      CALL mpi_allreduce( kvals, ivals, kno, mpi_integer, &
+         &                mpi_max, mpi_comm_opa, ierr )
+      kvals(:) = ivals(:)
+#elif defined key_mpp_shmem
+error "Only MPI support for MPP in NEMOVAR"
+#endif
+   END SUBROUTINE obs_mpp_max_integer
+
+   SUBROUTINE obs_mpp_find_obs_proc(kobsp,kobsi,kobsj,kno)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_find_obs_proc ***
+      !!          
+      !! ** Purpose : From the array kobsp containing the results of the grid
+      !!              grid search on each processor the processor return a
+      !!              decision of which processors should hold the observation.
+      !!
+      !! ** Method  : A temporary 2D array holding all the decisions is
+      !!              constructed using mpi_allgather on each processor.
+      !!              If more than one processor has found the observation
+      !!              with the observation in the inner domain gets it
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  06-07  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kno
+      INTEGER, DIMENSION(kno), INTENT(IN) :: &
+         & kobsi, &
+         & kobsj
+      INTEGER, DIMENSION(kno), INTENT(INOUT) :: &
+         & kobsp
+
+#if defined key_mpp_mpi
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: size
+      INTEGER :: ierr
+      INTEGER :: iobsip
+      INTEGER :: iobsjp
+      INTEGER :: num_sus_obs
+      INTEGER, DIMENSION(kno) :: &
+         & iobsig, &
+         & iobsjg
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: &
+         & iobsp, iobsi, iobsj
+
+#     include <mpif.h>
+
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the maximum accross processors
+      !-----------------------------------------------------------------------
+      CALL mpi_comm_size( mpi_comm_opa, size, ierr )
+      !-----------------------------------------------------------------------
+      ! Convert local grids points to global grid points
+      !-----------------------------------------------------------------------
+      DO ji = 1, kno
+         IF ( ( kobsi(ji) >= 1 ) .AND. ( kobsi(ji) <= jpi ) .AND. &
+            & ( kobsj(ji) >= 1 ) .AND. ( kobsj(ji) <= jpj ) ) THEN
+            iobsig(ji) = mig( kobsi(ji) )
+            iobsjg(ji) = mjg( kobsj(ji) )
+         ELSE
+            iobsig(ji) = -1
+            iobsjg(ji) = -1
+         ENDIF
+      END DO
+      !-----------------------------------------------------------------------
+      ! Get the decisions from all processors
+      !-----------------------------------------------------------------------
+      ALLOCATE( iobsp(kno,size) )
+      ALLOCATE( iobsi(kno,size) )
+      ALLOCATE( iobsj(kno,size) )
+      CALL mpi_allgather( kobsp, kno, mpi_integer, &
+         &                iobsp, kno, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+      CALL mpi_allgather( iobsig, kno, mpi_integer, &
+         &                iobsi, kno, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+      CALL mpi_allgather( iobsjg, kno, mpi_integer, &
+         &                iobsj, kno, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+
+      !-----------------------------------------------------------------------
+      ! Find the processor with observations from the lowest processor 
+      ! number among processors holding the observation.
+      !-----------------------------------------------------------------------
+      kobsp(:) = -1
+      num_sus_obs = 0
+      DO ji = 1, kno
+         DO jj = 1, size
+            IF ( ( kobsp(ji) == -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN
+               kobsp(ji) = iobsp(ji,jj)
+               iobsip = iobsi(ji,jj)
+               iobsjp = iobsj(ji,jj)
+            ENDIF
+            IF ( ( kobsp(ji) /= -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN
+               IF ( ( iobsip /= iobsi(ji,jj) ) .OR. &
+                  & ( iobsjp /= iobsj(ji,jj) ) ) THEN
+                  IF ( ( kobsp(ji) < 1000000 ) .AND. &
+                     & ( iobsp(ji,jj) < 1000000 ) ) THEN
+                     num_sus_obs=num_sus_obs+1
+                  ENDIF
+               ENDIF
+               IF ( mppmap(iobsip,iobsjp) /= ( kobsp(ji)+1 ) ) THEN
+                  IF ( ( iobsi(ji,jj) /= -1 ) .AND. &
+                     & ( iobsj(ji,jj) /= -1 ) ) THEN
+                     IF ((mppmap(iobsi(ji,jj),iobsj(ji,jj)) == (iobsp(ji,jj)+1))&
+                        & .OR. ( iobsp(ji,jj) < kobsp(ji) ) ) THEN
+                        kobsp(ji) = iobsp(ji,jj)
+                        iobsip = iobsi(ji,jj)
+                        iobsjp = iobsj(ji,jj)
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      IF (lwp) WRITE(numout,*) 'Number of suspicious observations: ',num_sus_obs
+
+      DEALLOCATE( iobsj )
+      DEALLOCATE( iobsi )
+      DEALLOCATE( iobsp )
+#elif defined key_mpp_shmem
+error "Only MPI support for MPP in NEMOVAR"
+#endif
+
+   END SUBROUTINE obs_mpp_find_obs_proc
+
+   SUBROUTINE obs_mpp_sum_integers( kvalsin, kvalsout, kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_sum_integers ***
+      !!          
+      !! ** Purpose : Sum an integer array.
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  06-07  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kno
+      INTEGER, DIMENSION(kno), INTENT(IN) :: &
+         & kvalsin
+      INTEGER, DIMENSION(kno), INTENT(OUT) :: &
+         & kvalsout
+
+#if defined key_mpp_mpi
+      !! * Local declarations
+      INTEGER :: ierr
+#     include <mpif.h>
+ 
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the sum across processors
+      !-----------------------------------------------------------------------
+      CALL mpi_allreduce( kvalsin, kvalsout, kno, mpi_integer, &
+         &                mpi_sum, mpi_comm_opa, ierr )
+#elif defined key_mpp_shmem
+error "Only MPI support for MPP in NEMOVAR"
+#else
+
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalsout(:) = kvalsin(:)
+#endif
+
+   END SUBROUTINE obs_mpp_sum_integers
+
+   SUBROUTINE obs_mpp_sum_integer( kvalin, kvalout )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_sum_integers ***
+      !!          
+      !! ** Purpose : Sum a single integer
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  06-07  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kvalin
+      INTEGER, INTENT(OUT) :: kvalout
+
+#if defined key_mpp_mpi
+      !! * Local declarations
+      INTEGER :: ierr
+#     include <mpif.h>
+
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the sum across processors
+      !-----------------------------------------------------------------------
+      CALL mpi_allreduce( kvalin, kvalout, 1, mpi_integer, &
+         &                mpi_sum, mpi_comm_opa, ierr )
+#elif defined key_mpp_shmem
+error "Only MPI support for MPP in NEMOVAR"
+#else
+
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalout = kvalin
+#endif
+   END SUBROUTINE obs_mpp_sum_integer
+
+   SUBROUTINE mpp_global_max( pval )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_global_or ***
+      !!          
+      !! ** Purpose : Get the maximum value across processors for a global 
+      !!              real array
+      !!
+      !! ** Method  : MPI allreduce
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  08-01  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), DIMENSION(jpiglo,jpjglo), INTENT(INOUT) :: &
+         & pval
+      !! * Local declarations
+      INTEGER :: ierr
+#if defined key_mpp_mpi
+#include <mpif.h>
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zcp
+
+      ! Copy data for input to MPI
+
+      ALLOCATE( &
+         & zcp(jpiglo,jpjglo) &
+         & )
+      zcp(:,:) = pval(:,:)
+
+      ! Call the MPI library to find the coast lines globally
+
+      CALL mpi_allreduce( zcp, pval, jpiglo*jpjglo, mpivar, &
+         &                mpi_max, mpi_comm_opa, ierr )
+
+      DEALLOCATE( &
+         & zcp &
+         & )
+
+#elif defined key_mpp_shmem
+error "Only MPI support for MPP in NEMOVAR"
+#endif
+      
+   END SUBROUTINE mpp_global_max
+
+   SUBROUTINE mpp_alltoall_int( kno, kvalsin, kvalsout )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_allgatherv ***
+      !!          
+      !! ** Purpose : all to all.
+      !!
+      !! ** Method  : MPI alltoall
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  06-09  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kno
+      INTEGER, DIMENSION(kno*jpnij), INTENT(IN) :: &
+         & kvalsin
+      INTEGER, DIMENSION(kno*jpnij), INTENT(OUT) :: &
+         & kvalsout
+      !! * Local declarations
+      INTEGER :: ierr
+#if defined key_mpp_mpi
+#include <mpif.h>
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to do the all to all operation of the data
+      !-----------------------------------------------------------------------
+      CALL mpi_alltoall( kvalsin,  kno, mpi_integer, &
+         &               kvalsout, kno, mpi_integer, &
+         &               mpi_comm_opa, ierr )
+#elif defined key_mpp_shmem
+error "Only MPI support for MPP in NEMOVAR"
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalsout = kvalsin
+#endif
+      
+   END SUBROUTINE mpp_alltoall_int
+
+   SUBROUTINE mpp_alltoallv_int( kvalsin, knoin, kinv, kvalsout, &
+      &                              knoout, koutv )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_alltoallv_int ***
+      !!          
+      !! ** Purpose : all to all (integer version).
+      !!
+      !! ** Method  : MPI alltoall
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  06-09  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: knoin
+      INTEGER, INTENT(IN) :: knoout
+      INTEGER, DIMENSION(jpnij) :: &
+         & kinv, &
+         & koutv
+      INTEGER, DIMENSION(knoin), INTENT(IN) :: &
+         & kvalsin
+      INTEGER, DIMENSION(knoout), INTENT(OUT) :: &
+         & kvalsout
+      !! * Local declarations
+      INTEGER :: ierr
+      INTEGER :: jproc
+#if defined key_mpp_mpi
+#include <mpif.h>
+      INTEGER, DIMENSION(jpnij) :: &
+         & irdsp, &
+         & isdsp
+      !-----------------------------------------------------------------------
+      ! Compute displacements
+      !-----------------------------------------------------------------------
+      irdsp(1) = 0
+      isdsp(1) = 0
+      DO jproc = 2, jpnij
+         isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1)
+         irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to do the all to all operation of the data
+      !-----------------------------------------------------------------------
+      CALL mpi_alltoallv( kvalsin,  kinv,  isdsp, mpi_integer, &
+         &                kvalsout, koutv, irdsp, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+#elif defined key_mpp_shmem
+error "Only MPI support for MPP in NEMOVAR"
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalsout = kvalsin
+#endif
+      
+   END SUBROUTINE mpp_alltoallv_int
+
+   SUBROUTINE mpp_alltoallv_real( pvalsin, knoin, kinv, pvalsout, &
+      &                               knoout, koutv )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_alltoallv_real ***
+      !!          
+      !! ** Purpose : all to all (integer version).
+      !!
+      !! ** Method  : MPI alltoall
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!
+      !! History :
+      !!        !  06-09  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: knoin
+      INTEGER, INTENT(IN) :: knoout
+      INTEGER, DIMENSION(jpnij) :: &
+         & kinv, &
+         & koutv
+      REAL(KIND=wp), DIMENSION(knoin), INTENT(IN) :: &
+         & pvalsin
+      REAL(KIND=wp), DIMENSION(knoout), INTENT(OUT) :: &
+         & pvalsout
+      !! * Local declarations
+      INTEGER :: ierr
+      INTEGER :: jproc
+#if defined key_mpp_mpi
+#include <mpif.h>
+      INTEGER, DIMENSION(jpnij) :: &
+         & irdsp, &
+         & isdsp
+      !-----------------------------------------------------------------------
+      ! Compute displacements
+      !-----------------------------------------------------------------------
+      irdsp(1) = 0
+      isdsp(1) = 0
+      DO jproc = 2, jpnij
+         isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1)
+         irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to do the all to all operation of the data
+      !-----------------------------------------------------------------------
+      CALL mpi_alltoallv( pvalsin,  kinv,  isdsp, mpivar, &
+         &                pvalsout, koutv, irdsp, mpivar, &
+         &                mpi_comm_opa, ierr )
+#elif defined key_mpp_shmem
+error "Only MPI support for MPP in NEMOVAR"
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      pvalsout = pvalsin
+#endif
+      
+   END SUBROUTINE mpp_alltoallv_real
+
+END MODULE obs_mpp
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_oper.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 2236)
@@ -0,0 +1,1315 @@
+MODULE obs_oper
+   !!======================================================================
+   !!                       ***  MODULE obs_oper  ***
+   !! Observation diagnostics: Observation operators for various observation
+   !!                          types
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_pro_opt :    Compute the model counterpart of temperature and
+   !!                    salinity observations from profiles
+   !!   obs_sla_opt :    Compute the model counterpart of sea level anomaly
+   !!                    observations
+   !!   obs_sst_opt :    Compute the model counterpart of sea surface temperature
+   !!                    observations
+   !!   obs_sss_opt :    Compute the model counterpart of sea surface salinity
+   !!                    observations
+   !!   obs_seaice_opt : Compute the model counterpart of sea ice concentration
+   !!                    observations
+   !!
+   !!   obs_vel_opt :    Compute the model counterpart of zonal and meridional
+   !!                    components of velocity from observations.
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind, ONLY : &         ! Precision variables
+      & wp
+   USE in_out_manager             ! I/O manager
+   USE obs_inter_sup              ! Interpolation support
+   USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the observation pt
+      & obs_int_h2d, &
+      & obs_int_h2d_init
+   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the observation pt
+      & obs_int_z1d,    &
+      & obs_int_z1d_spl
+   USE obs_const,  ONLY :     &
+      & obfillflt		  ! Fillvalue   
+   USE dom_oce,       ONLY : &
+      & glamt, glamu, glamv, &
+      & gphit, gphiu, gphiv
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_pro_opt, &  ! Compute the model counterpart of profile observations
+      &   obs_sla_opt, &  ! Compute the model counterpart of SLA observations
+      &   obs_sst_opt, &  ! Compute the model counterpart of SST observations
+      &   obs_sss_opt, &  ! Compute the model counterpart of SSS observations
+      &   obs_seaice_opt, &
+      &   obs_vel_opt     ! Compute the model counterpart of velocity profile data
+
+   INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types
+
+CONTAINS
+
+   SUBROUTINE obs_pro_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &
+      &                    ptn, psn, pgdept, ptmask, k1dint, k2dint, &
+      &                    kdailyavtypes )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_pro_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of profiles
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    First, a vertical profile of horizontally interpolated model
+      !!    now temperatures is computed at the obs (lon, lat) point.
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!
+      !!    Next, the vertical temperature profile is interpolated to the
+      !!    data depth points. Two vertical interpolation schemes are
+      !!    available:
+      !!        - linear       (k1dint = 0)
+      !!        - Cubic spline (k1dint = 1)
+      !!
+      !!    For the cubic spline the 2nd derivative of the interpolating 
+      !!    polynomial is computed before entering the vertical interpolation 
+      !!    routine.
+      !!
+      !!    For ENACT moored buoy data (e.g., TAO), the model equivalent is
+      !!    a daily mean model temperature field. So, we first compute
+      !!    the mean, then interpolate only at the end of the day.
+      !!
+      !!    Note: the in situ temperature observations must be converted
+      !!    to potential temperature (the model variable) prior to
+      !!    assimilation. 
+      !!??????????????????????????????????????????????????????????????
+      !!    INCLUDE POTENTIAL TEMP -> IN SITU TEMP IN OBS OPERATOR???
+      !!??????????????????????????????????????????????????????????????
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 97-11 (A. Weaver, S. Ricci, N. Daget)
+      !!      ! 06-03 (G. Smith) NEMOVAR migration
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!      ! 07-01 (K. Mogensen) Merge of temperature and salinity
+      !!      ! 07-03 (K. Mogensen) General handling of profiles
+      !!-----------------------------------------------------------------------
+  
+      !! * Modules used
+      USE obs_profiles_def ! Definition of storage space for profile obs.
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc  ! Subset of profile data not failing screening
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+         & ptn,    &    ! Model temperature field
+         & psn,    &    ! Model salinity field
+         & ptmask       ! Land-sea mask
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pgdept       ! Model array of depth levels
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes! Types for daily averages
+      !! * Local declarations
+      INTEGER ::   ji
+      INTEGER ::   jj
+      INTEGER ::   jk
+      INTEGER ::   jobs
+      INTEGER ::   inrc
+      INTEGER ::   ipro
+      INTEGER ::   idayend
+      INTEGER ::   ista
+      INTEGER ::   iend
+      INTEGER ::   iobs
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zdaystp
+      REAL(KIND=wp), DIMENSION(kpk) :: &
+         & zobsmask, &
+         & zobsk,    &
+         & zobs2k
+      REAL(KIND=wp), DIMENSION(2,2,kpk) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zintt, &
+         & zints, &
+         & zinmt, &
+         & zinms
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      ipro = prodatqc%npstp(inrc)
+ 
+      ! Daily average types
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         idailyavtypes(:) = kdailyavtypes(:)
+      ELSE
+         idailyavtypes(:) = -1
+      ENDIF
+
+      ! Initialize daily mean for first timestep
+      idayend = MOD( kt - kit000 + 1, kdaystp )
+
+      ! Added kt == 0 test to catch restart case 
+      IF ( idayend == 1 .OR. kt == 0) THEN
+         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  prodatqc%vdmean(ji,jj,jk,1) = 0.0
+                  prodatqc%vdmean(ji,jj,jk,2) = 0.0
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! Increment the temperature field for computing daily mean
+               prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                  &                        + ptn(ji,jj,jk)
+               ! Increment the salinity field for computing daily mean
+               prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                  &                        + psn(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+   
+      ! Compute the daily mean at the end of day
+      zdaystp = 1.0 / REAL( kdaystp )
+      IF ( idayend == 0 ) THEN
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                     &                        * zdaystp
+                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                  &                           * zdaystp
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Get the data for interpolation
+      ALLOCATE( &
+         & igrdi(2,2,ipro),      &
+         & igrdj(2,2,ipro),      &
+         & zglam(2,2,ipro),      &
+         & zgphi(2,2,ipro),      &
+         & zmask(2,2,kpk,ipro),  &
+         & zintt(2,2,kpk,ipro),  &
+         & zints(2,2,kpk,ipro)   &
+         & )
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+         iobs = jobs - prodatqc%nprofup
+         igrdi(1,1,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj(1,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi(1,2,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj(1,2,iobs) = prodatqc%mj(jobs,1)
+         igrdi(2,1,iobs) = prodatqc%mi(jobs,1)
+         igrdj(2,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi(2,2,iobs) = prodatqc%mi(jobs,1)
+         igrdj(2,2,iobs) = prodatqc%mj(jobs,1)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptmask,zmask )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptn,   zintt )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, psn,   zints )
+
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+
+         ALLOCATE( &
+            & zinmt(2,2,kpk,ipro),  &
+            & zinms(2,2,kpk,ipro)   &
+            & )
+
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, &
+            &                  prodatqc%vdmean(:,:,:,1), zinmt )
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, &
+            &                  prodatqc%vdmean(:,:,:,2), zinms )
+
+      ENDIF
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+
+         iobs = jobs - prodatqc%nprofup
+
+         IF ( kt /= prodatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                    &
+                  &            ' kt      = ', kt,                      &
+                  &            ' mstp    = ', prodatqc%mstp(jobs), &
+                  &            ' ntyp    = ', prodatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )
+         ENDIF
+         
+         zlam = prodatqc%rlam(jobs)
+         zphi = prodatqc%rphi(jobs)
+         
+         ! Horizontal weights and vertical mask
+
+         IF ( ( prodatqc%npvend(jobs,1) > 0 ) .OR. &
+            & ( prodatqc%npvend(jobs,2) > 0 ) ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+               &                   zmask(:,:,:,iobs), zweig, zobsmask )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+	    IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+
+               IF ( idayend == 0 )  THEN
+                  
+                  ! Daily averaged moored buoy (MRB) data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweig, zinmt(:,:,:,iobs), zobsk )
+                  
+                  
+               ELSE
+               
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of profile T BUOY data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+	       
+            ELSE 
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweig, zintt(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !-----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !-----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,1)
+            iend = prodatqc%npvend(jobs,1)
+            CALL obs_int_z1d( kpk,                &
+               & prodatqc%var(1)%mvk(ista:iend),  &
+               & k1dint, iend - ista + 1,         &
+               & prodatqc%var(1)%vdep(ista:iend), &
+               & zobsk, zobs2k,                   &
+               & prodatqc%var(1)%vmod(ista:iend), &
+               & pgdept, zobsmask )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+
+               IF ( idayend == 0 )  THEN
+
+                  ! Daily averaged moored buoy (MRB) data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweig, zinms(:,:,:,iobs), zobsk )
+                  
+               ELSE
+
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of profile S BUOY data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+
+            ELSE
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweig, zints(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,2)
+            iend = prodatqc%npvend(jobs,2)
+            CALL obs_int_z1d( kpk, &
+               & prodatqc%var(2)%mvk(ista:iend),&
+               & k1dint, iend - ista + 1, &
+               & prodatqc%var(2)%vdep(ista:iend),&
+               & zobsk, zobs2k, &
+               & prodatqc%var(2)%vmod(ista:iend),&
+               & pgdept, zobsmask )
+
+         ENDIF
+
+      END DO
+ 
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zintt, &
+         & zints  &
+         & )
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+         DEALLOCATE( &
+            & zinmt,  &
+            & zinms   &
+            & )
+      ENDIF
+
+      prodatqc%nprofup = prodatqc%nprofup + ipro 
+      
+   END SUBROUTINE obs_pro_opt
+
+   SUBROUTINE obs_sla_opt( sladatqc, kt, kpi, kpj, kit000, &
+      &                    psshn, psshmask, k2dint )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_sla_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of sea level anomaly
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    The now model SSH is first computed at the obs (lon, lat) point.
+      !!
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!  
+      !!    The sea level anomaly at the observation points is then computed 
+      !!    by removing a mean dynamic topography (defined at the obs. point).
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 07-03 (A. Weaver)
+      !!-----------------------------------------------------------------------
+  
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: sladatqc     ! Subset of surface data not failing screening
+      INTEGER, INTENT(IN) :: kt      ! Time step
+      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step 
+                                      !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header)
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & psshn,  &    ! Model SSH field
+         & psshmask     ! Land-sea mask
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: isla
+      INTEGER :: iobs
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zext(1), zobsmask(1)
+      REAL(kind=wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zsshl, &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      isla = sladatqc%nsstp(inrc)
+
+      ! Get the data for interpolation
+
+      ALLOCATE( &
+         & igrdi(2,2,isla), &
+         & igrdj(2,2,isla), &
+         & zglam(2,2,isla), &
+         & zgphi(2,2,isla), &
+         & zmask(2,2,isla), &
+         & zsshl(2,2,isla)  &
+         & )
+      
+      DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla
+         iobs = jobs - sladatqc%nsurfup
+         igrdi(1,1,iobs) = sladatqc%mi(jobs)-1
+         igrdj(1,1,iobs) = sladatqc%mj(jobs)-1
+         igrdi(1,2,iobs) = sladatqc%mi(jobs)-1
+         igrdj(1,2,iobs) = sladatqc%mj(jobs)
+         igrdi(2,1,iobs) = sladatqc%mi(jobs)
+         igrdj(2,1,iobs) = sladatqc%mj(jobs)-1
+         igrdi(2,2,iobs) = sladatqc%mi(jobs)
+         igrdj(2,2,iobs) = sladatqc%mj(jobs)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, psshmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, psshn, zsshl )
+
+      ! Loop over observations
+
+      DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla
+
+         iobs = jobs - sladatqc%nsurfup
+
+         IF ( kt /= sladatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                &
+                  &            ' kt      = ', kt,                  &
+                  &            ' mstp    = ', sladatqc%mstp(jobs), &
+                  &            ' ntyp    = ', sladatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_sla_opt', 'Inconsistent time' )
+            
+         ENDIF
+         
+         zlam = sladatqc%rlam(jobs)
+         zphi = sladatqc%rphi(jobs)
+
+         ! Get weights to interpolate the model SSH to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+         
+
+         ! Interpolate the model SSH to the observation point
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zsshl(:,:,iobs),  zext )
+         
+         sladatqc%rext(jobs,1) = zext(1)
+         ! ... Remove the MDT at the observation point
+         sladatqc%rmod(jobs,1) = sladatqc%rext(jobs,1) - sladatqc%rext(jobs,2)
+
+      END DO
+
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zsshl  &
+         & )
+
+      sladatqc%nsurfup = sladatqc%nsurfup + isla
+
+   END SUBROUTINE obs_sla_opt
+
+   SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, &
+      &                    psstn, psstmask, k2dint )
+
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_sst_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of surface temperature
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    The now model SST is first computed at the obs (lon, lat) point.
+      !!
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  07-07  (S. Ricci ) : Original
+      !!      
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & sstdatqc     ! Subset of surface data not failing screening
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & psstn,  &    ! Model SST field
+         & psstmask     ! Land-sea mask
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: isst
+      INTEGER :: iobs
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zext(1), zobsmask(1)
+      REAL(kind=wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zsstl, &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !-----------------------------------------------------------------------
+      ! Local initialization 
+      !-----------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      isst = sstdatqc%nsstp(inrc)
+
+      ! Get the data for interpolation
+      
+      ALLOCATE( &
+         & igrdi(2,2,isst), &
+         & igrdj(2,2,isst), &
+         & zglam(2,2,isst), &
+         & zgphi(2,2,isst), &
+         & zmask(2,2,isst), &
+         & zsstl(2,2,isst)  &
+         & )
+      
+      DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst
+         iobs = jobs - sstdatqc%nsurfup
+         igrdi(1,1,iobs) = sstdatqc%mi(jobs)-1
+         igrdj(1,1,iobs) = sstdatqc%mj(jobs)-1
+         igrdi(1,2,iobs) = sstdatqc%mi(jobs)-1
+         igrdj(1,2,iobs) = sstdatqc%mj(jobs)
+         igrdi(2,1,iobs) = sstdatqc%mi(jobs)
+         igrdj(2,1,iobs) = sstdatqc%mj(jobs)-1
+         igrdi(2,2,iobs) = sstdatqc%mi(jobs)
+         igrdj(2,2,iobs) = sstdatqc%mj(jobs)
+      END DO
+      
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, psstmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, psstn, zsstl )
+      
+      ! Loop over observations
+
+      DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst
+         
+         iobs = jobs - sstdatqc%nsurfup
+         
+         IF ( kt /= sstdatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                &
+                  &            ' kt      = ', kt,                  &
+                  &            ' mstp    = ', sstdatqc%mstp(jobs), &
+                  &            ' ntyp    = ', sstdatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_sst_opt', 'Inconsistent time' )
+            
+         ENDIF
+         
+         zlam = sstdatqc%rlam(jobs)
+         zphi = sstdatqc%rphi(jobs)
+         
+         ! Get weights to interpolate the model SST to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+            
+         ! Interpolate the model SST to the observation point 
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zsstl(:,:,iobs),  zext )
+         
+         sstdatqc%rmod(jobs,1) = zext(1)
+         
+      END DO
+      
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zsstl  &
+         & )
+      
+      sstdatqc%nsurfup = sstdatqc%nsurfup + isst
+
+   END SUBROUTINE obs_sst_opt
+
+   SUBROUTINE obs_sss_opt
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_sss_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of sea surface salinity
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! ??-?? 
+      !!-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+   END SUBROUTINE obs_sss_opt
+
+   SUBROUTINE obs_seaice_opt( seaicedatqc, kt, kpi, kpj, kit000, &
+      &                    pseaicen, pseaicemask, k2dint )
+
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_seaice_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of surface temperature
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    The now model sea ice is first computed at the obs (lon, lat) point.
+      !!
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  07-07  (S. Ricci ) : Original
+      !!      
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc     ! Subset of surface data not failing screening
+      INTEGER, INTENT(IN) :: kt       ! Time step
+      INTEGER, INTENT(IN) :: kpi      ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step 
+                                      !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header)
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & pseaicen,  &    ! Model sea ice field
+         & pseaicemask     ! Land-sea mask
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: iseaice
+      INTEGER :: iobs
+       
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zext(1), zobsmask(1)
+      REAL(kind=wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zseaicel, &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      iseaice = seaicedatqc%nsstp(inrc)
+
+      ! Get the data for interpolation
+      
+      ALLOCATE( &
+         & igrdi(2,2,iseaice), &
+         & igrdj(2,2,iseaice), &
+         & zglam(2,2,iseaice), &
+         & zgphi(2,2,iseaice), &
+         & zmask(2,2,iseaice), &
+         & zseaicel(2,2,iseaice)  &
+         & )
+      
+      DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice
+         iobs = jobs - seaicedatqc%nsurfup
+         igrdi(1,1,iobs) = seaicedatqc%mi(jobs)-1
+         igrdj(1,1,iobs) = seaicedatqc%mj(jobs)-1
+         igrdi(1,2,iobs) = seaicedatqc%mi(jobs)-1
+         igrdj(1,2,iobs) = seaicedatqc%mj(jobs)
+         igrdi(2,1,iobs) = seaicedatqc%mi(jobs)
+         igrdj(2,1,iobs) = seaicedatqc%mj(jobs)-1
+         igrdi(2,2,iobs) = seaicedatqc%mi(jobs)
+         igrdj(2,2,iobs) = seaicedatqc%mj(jobs)
+      END DO
+      
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, pseaicemask, zmask )
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, pseaicen, zseaicel )
+      
+      DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice
+         
+         iobs = jobs - seaicedatqc%nsurfup
+         
+         IF ( kt /= seaicedatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                &
+                  &            ' kt      = ', kt,                  &
+                  &            ' mstp    = ', seaicedatqc%mstp(jobs), &
+                  &            ' ntyp    = ', seaicedatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_seaice_opt', 'Inconsistent time' )
+            
+         ENDIF
+         
+         zlam = seaicedatqc%rlam(jobs)
+         zphi = seaicedatqc%rphi(jobs)
+         
+         ! Get weights to interpolate the model sea ice to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+         
+         ! ... Interpolate the model sea ice to the observation point
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zseaicel(:,:,iobs),  zext )
+         
+         seaicedatqc%rmod(jobs,1) = zext(1)
+         
+      END DO
+      
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi,    &
+         & igrdj,    &
+         & zglam,    &
+         & zgphi,    &
+         & zmask,    &
+         & zseaicel  &
+         & )
+      
+      seaicedatqc%nsurfup = seaicedatqc%nsurfup + iseaice
+
+   END SUBROUTINE obs_seaice_opt
+
+   SUBROUTINE obs_vel_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &
+      &                    pun, pvn, pgdept, pumask, pvmask, k1dint, k2dint, &
+      &                    ld_dailyav )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_vel_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of velocity profile
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate zonal and meridional components of velocity 
+      !!              to each observation point using the model values at the corners of 
+      !!              the surrounding grid box. The model velocity components are on a 
+      !!              staggered C- grid.
+      !!
+      !!    For velocity data from the TAO array, the model equivalent is
+      !!    a daily mean velocity field. So, we first compute
+      !!    the mean, then interpolate only at the end of the day.
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!    ! 07-03 (K. Mogensen)      : Temperature and Salinity profiles
+      !!    ! 08-10 (Maria Valdivieso) : Velocity component (U,V) profiles
+      !!-----------------------------------------------------------------------
+    
+      !! * Modules used
+      USE obs_profiles_def ! Definition of storage space for profile obs.
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: &
+         & prodatqc        ! Subset of profile data not failing screening
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk 
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+         & pun,    &    ! Model zonal component of velocity
+         & pvn,    &    ! Model meridional component of velocity
+         & pumask, &    ! Land-sea mask
+         & pvmask       ! Land-sea mask
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pgdept       ! Model array of depth levels
+      LOGICAL, INTENT(IN) :: ld_dailyav
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: ipro
+      INTEGER :: idayend
+      INTEGER :: ista
+      INTEGER :: iend
+      INTEGER :: iobs
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zdaystp
+      REAL(KIND=wp), DIMENSION(kpk) :: &
+         & zobsmask, &
+         & zobsk,    &
+         & zobs2k
+      REAL(KIND=wp), DIMENSION(2,2,kpk) :: &
+         & zweigu,zweigv
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
+         & zumask, zvmask, &
+         & zintu, &
+         & zintv, &
+         & zinmu, &
+         & zinmv
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zglamu, zglamv, &
+         & zgphiu, zgphiv
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdiu, &
+         & igrdju, &
+         & igrdiv, &
+         & igrdjv
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      ipro = prodatqc%npstp(inrc)
+
+      ! Initialize daily mean for first timestep
+      idayend = MOD( kt - kit000 + 1, kdaystp )
+
+      ! Added kt == 0 test to catch restart case 
+      IF ( idayend == 1 .OR. kt == 0) THEN
+         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt
+         prodatqc%vdmean(:,:,:,1) = 0.0
+         prodatqc%vdmean(:,:,:,2) = 0.0
+      ENDIF
+
+      ! Increment the zonal velocity field for computing daily mean
+      prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) + pun(:,:,:)
+      ! Increment the meridional velocity field for computing daily mean
+      prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) + pvn(:,:,:)
+   
+      ! Compute the daily mean at the end of day
+      zdaystp = 1.0 / REAL( kdaystp )
+      IF ( idayend == 0 ) THEN
+         prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) * zdaystp
+         prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) * zdaystp
+      ENDIF
+
+      ! Get the data for interpolation
+      ALLOCATE( &
+         & igrdiu(2,2,ipro),      &
+         & igrdju(2,2,ipro),      &
+         & igrdiv(2,2,ipro),      &
+         & igrdjv(2,2,ipro),      &
+         & zglamu(2,2,ipro), zglamv(2,2,ipro), &
+         & zgphiu(2,2,ipro), zgphiv(2,2,ipro), &
+         & zumask(2,2,kpk,ipro), zvmask(2,2,kpk,ipro), &
+         & zintu(2,2,kpk,ipro),  &
+         & zintv(2,2,kpk,ipro)   &
+         & )
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+         iobs = jobs - prodatqc%nprofup
+         igrdiu(1,1,iobs) = prodatqc%mi(jobs,1)-1
+         igrdju(1,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdiu(1,2,iobs) = prodatqc%mi(jobs,1)-1
+         igrdju(1,2,iobs) = prodatqc%mj(jobs,1)
+         igrdiu(2,1,iobs) = prodatqc%mi(jobs,1)
+         igrdju(2,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdiu(2,2,iobs) = prodatqc%mi(jobs,1)
+         igrdju(2,2,iobs) = prodatqc%mj(jobs,1)
+         igrdiv(1,1,iobs) = prodatqc%mi(jobs,2)-1
+         igrdjv(1,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdiv(1,2,iobs) = prodatqc%mi(jobs,2)-1
+         igrdjv(1,2,iobs) = prodatqc%mj(jobs,2)
+         igrdiv(2,1,iobs) = prodatqc%mi(jobs,2)
+         igrdjv(2,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdiv(2,2,iobs) = prodatqc%mi(jobs,2)
+         igrdjv(2,2,iobs) = prodatqc%mj(jobs,2)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, glamu, zglamu )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, gphiu, zgphiu )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pumask, zumask )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pun, zintu )
+
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, glamv, zglamv )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, gphiv, zgphiv )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvmask, zvmask )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvn, zintv )
+
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+
+         ALLOCATE( &
+            & zinmu(2,2,kpk,ipro),  &
+            & zinmv(2,2,kpk,ipro)   &
+            & )
+
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, &
+            &                  prodatqc%vdmean(:,:,:,1), zinmu )
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, &
+            &                  prodatqc%vdmean(:,:,:,2), zinmv )
+
+      ENDIF
+
+! loop over observations
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+
+         iobs = jobs - prodatqc%nprofup
+
+         IF ( kt /= prodatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                    &
+                  &            ' kt      = ', kt,                      &
+                  &            ' mstp    = ', prodatqc%mstp(jobs), &
+                  &            ' ntyp    = ', prodatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )
+         ENDIF
+         
+         zlam = prodatqc%rlam(jobs)
+         zphi = prodatqc%rphi(jobs)
+
+         ! Horizontal weights and vertical mask
+
+         IF  ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglamu(:,:,iobs), zgphiu(:,:,iobs), &
+               &                   zumask(:,:,:,iobs), zweigu, zobsmask )
+
+         ENDIF
+
+         
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglamv(:,:,iobs), zgphiv(:,:,iobs), &
+               &                   zvmask(:,:,:,iobs), zweigv, zobsmask )
+
+         ENDIF
+
+
+         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+	    IF ( ld_dailyav ) THEN
+
+               IF ( idayend == 0 )  THEN
+                  
+                  ! Daily averaged data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweigu, zinmu(:,:,:,iobs), zobsk )
+                  
+                  
+               ELSE
+               
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of U profile data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+	       
+            ELSE 
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweigu, zintu(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !-----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !-----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,1)
+            iend = prodatqc%npvend(jobs,1)
+            CALL obs_int_z1d( kpk,                &
+               & prodatqc%var(1)%mvk(ista:iend),  &
+               & k1dint, iend - ista + 1,         &
+               & prodatqc%var(1)%vdep(ista:iend), &
+               & zobsk, zobs2k,                   &
+               & prodatqc%var(1)%vmod(ista:iend), &
+               & pgdept, zobsmask )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+            IF ( ld_dailyav ) THEN
+
+               IF ( idayend == 0 )  THEN
+
+                  ! Daily averaged data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweigv, zinmv(:,:,:,iobs), zobsk )
+                  
+               ELSE
+
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of V profile data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+
+            ELSE
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweigv, zintv(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,2)
+            iend = prodatqc%npvend(jobs,2)
+            CALL obs_int_z1d( kpk, &
+               & prodatqc%var(2)%mvk(ista:iend),&
+               & k1dint, iend - ista + 1, &
+               & prodatqc%var(2)%vdep(ista:iend),&
+               & zobsk, zobs2k, &
+               & prodatqc%var(2)%vmod(ista:iend),&
+               & pgdept, zobsmask )
+
+         ENDIF
+
+      END DO
+ 
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdiu, &
+         & igrdju, &
+         & igrdiv, &
+         & igrdjv, &
+         & zglamu, zglamv, &
+         & zgphiu, zgphiv, &
+         & zumask, zvmask, &
+         & zintu, &
+         & zintv  &
+         & )
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+         DEALLOCATE( &
+            & zinmu,  &
+            & zinmv   &
+            & )
+      ENDIF
+
+      prodatqc%nprofup = prodatqc%nprofup + ipro 
+      
+   END SUBROUTINE obs_vel_opt
+
+END MODULE obs_oper
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_prep.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 2236)
@@ -0,0 +1,1965 @@
+MODULE obs_prep
+   !!=====================================================================
+   !!                       ***  MODULE  obs_prep  ***
+   !! Observation diagnostics: Prepare observation arrays: screening, 
+   !!                          sorting, coordinate search
+   !!=====================================================================
+
+   !!---------------------------------------------------------------------
+   !!   obs_pre_pro  : First level check and screening of T/S profiles
+   !!   obs_pre_sla  : First level check and screening of SLA observations
+   !!   obs_pre_sst  : First level check and screening of SLA observations
+   !!   obs_pre_seaice : First level check and screening of sea ice observations
+   !!   obs_pre_vel  : First level check and screening of velocity obs.
+   !!   obs_scr      : Basic screening of the observations
+   !!   obs_coo_tim  : Compute number of time steps to the observation time
+   !!   obs_sor      : Sort the observation arrays
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp   
+   USE in_out_manager     ! I/O manager
+   USE obs_profiles_def   ! Definitions for storage arrays for profiles
+   USE obs_surf_def       ! Definitions for storage arrays for surface data
+   USE obs_mpp, ONLY : &  ! MPP support routines for observation diagnostics
+      & obs_mpp_sum_integer, &
+      & obs_mpp_sum_integers
+   USE obs_inter_sup      ! Interpolation support
+   USE obs_oper           ! Observation operators
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC &
+      & obs_pre_pro, &    ! First level check and screening of profiles
+      & obs_pre_sla, &    ! First level check and screening of SLA data
+      & obs_pre_sst, &    ! First level check and screening of SLA data
+      & obs_pre_seaice, & ! First level check and screening of sea ice data
+      & obs_pre_vel, &     ! First level check and screening of velocity profiles
+      & calc_month_len     ! Calculate the number of days in the months of a year  
+
+CONTAINS
+
+   SUBROUTINE obs_pre_pro( profdata, prodatqc, ld_t3d, ld_s3d, ld_nea, &
+      &                    kdailyavtypes )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_pro  ***
+      !!
+      !! ** Purpose : First level check and screening of T and S profiles
+      !!
+      !! ** Method  : First level check and screening of T and S profiles
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-01  (K. Mogensen) Merge of obs_pre_t3d and obs_pre_s3d 
+      !!        !  2007-03  (K. Mogensen) General handling of profiles
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & gdept_0, &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc     ! Subset of profile data not failing screening
+      LOGICAL, INTENT(IN) :: ld_t3d         ! Switch for temperature
+      LOGICAL, INTENT(IN) :: ld_s3d         ! Switch for salinity
+      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes! Types for daily averages
+      !! * Local declarations   
+      INTEGER :: iyea0         ! Initial date
+      INTEGER :: imon0         !  - (year, month, day, hour, minute)
+      INTEGER :: iday0   
+      INTEGER :: ihou0
+      INTEGER :: imin0
+      INTEGER :: icycle        ! Current assimilation cycle
+                               ! Counters for observations that
+      INTEGER :: iotdobs       !  - outside time domain
+      INTEGER :: iosdtobs      !  - outside space domain (temperature)
+      INTEGER :: iosdsobs      !  - outside space domain (salinity)
+      INTEGER :: ilantobs      !  - within a model land cell (temperature)
+      INTEGER :: ilansobs      !  - within a model land cell (salinity)
+      INTEGER :: inlatobs      !  - close to land (temperature)
+      INTEGER :: inlasobs      !  - close to land (salinity)
+      INTEGER :: igrdobs       !  - fail the grid search
+                               ! Global counters for observations that
+      INTEGER :: iotdobsmpp    !  - outside time domain
+      INTEGER :: iosdtobsmpp   !  - outside space domain (temperature)
+      INTEGER :: iosdsobsmpp   !  - outside space domain (salinity)
+      INTEGER :: ilantobsmpp   !  - within a model land cell (temperature)
+      INTEGER :: ilansobsmpp   !  - within a model land cell (salinity)
+      INTEGER :: inlatobsmpp   !  - close to land (temperature)
+      INTEGER :: inlasobsmpp   !  - close to land (salinity)
+      INTEGER :: igrdobsmpp    !  - fail the grid search
+      TYPE(obs_prof_valid) ::  llvalid     ! Profile selection 
+      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
+         & llvvalid            ! T,S selection 
+      INTEGER :: jvar          ! Variable loop variable
+      INTEGER :: jobs          ! Obs. loop variable
+      INTEGER :: jstp          ! Time loop variable
+      INTEGER :: inrc          ! Time index variable
+      
+      IF(lwp) WRITE(numout,*)'obs_pre_pro : Preparing the profile observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdtobs = 0
+      iosdsobs = 0
+      ilantobs = 0
+      ilansobs = 0
+      inlatobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for profiles
+      ! -----------------------------------------------------------------------
+
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         CALL obs_coo_tim_prof( icycle, &
+            &                iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &                profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &                profdata%nday,    profdata%nhou, profdata%nmin, &
+            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &                iotdobs, kdailyavtypes = kdailyavtypes        )
+      ELSE
+         CALL obs_coo_tim_prof( icycle, &
+            &                iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &                profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &                profdata%nday,    profdata%nhou, profdata%nmin, &
+            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &                iotdobs )
+      ENDIF
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for profiles failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( profdata%nprof,   profdata%mi, profdata%mj, &
+         &              profdata%nqc,     igrdobs                         )
+
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Reject all observations for profiles with nqc > 10
+      ! -----------------------------------------------------------------------
+
+      CALL obs_pro_rej( profdata )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. This includes points below the model
+      ! bathymetry so this is done for every point in the profile
+      ! -----------------------------------------------------------------------
+
+      ! Temperature
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
+         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(1)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(1)%vdep,                        &
+         &                 glamt,                 gphit,                &
+         &                 gdept_0,               tmask,                &
+         &                 profdata%nqc,          profdata%var(1)%nvqc, &
+         &                 iosdtobs,              ilantobs,             &
+         &                 inlatobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp )
+      CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp )
+      CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp )
+
+      ! Salinity
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
+         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(2)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(2)%vdep,                        &
+         &                 glamt,                 gphit,                &
+         &                 gdept_0,               tmask,                &
+         &                 profdata%nqc,          profdata%var(2)%nvqc, &
+         &                 iosdsobs,              ilansobs,             &
+         &                 inlasobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the profdata data structure to
+      ! the prodatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid%luse(profdata%nprof) )
+      DO jvar = 1,profdata%nvar
+         ALLOCATE( llvvalid(jvar)%luse(profdata%nvprot(jvar)) )
+      END DO
+
+      ! We want all data which has qc flags <= 10
+
+      llvalid%luse(:) = ( profdata%nqc(:)  <= 10 )
+      DO jvar = 1,profdata%nvar
+         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 )
+      END DO
+
+      ! The actual copying
+
+      CALL obs_prof_compress( profdata,     prodatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid, lvvalid=llvvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid%luse )
+      DO jvar = 1,profdata%nvar
+         DEALLOCATE( llvvalid(jvar)%luse )
+      END DO
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_pro :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Profiles outside time domain                = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining profiles that failed grid search  = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining T data outside space domain       = ', &
+            &            iosdtobsmpp
+         WRITE(numout,*) ' Remaining T data at land points             = ', &
+            &            ilantobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining T data near land points (removed) = ',&
+               &            inlatobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining T data near land points (kept)    = ',&
+               &            inlatobsmpp
+         ENDIF
+         WRITE(numout,*) ' T data accepted                             = ', &
+            &            prodatqc%nvprotmpp(1)
+         WRITE(numout,*) ' Remaining S data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining S data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining S data near land points (removed) = ',&
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining S data near land points (kept)    = ',&
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' S data accepted                             = ', &
+            &            prodatqc%nvprotmpp(2)
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,997)
+         WRITE(numout,998)
+      ENDIF
+      
+      DO jobs = 1, prodatqc%nprof
+         inrc = prodatqc%mstp(jobs) + 2 - nit000
+         prodatqc%npstp(inrc)  = prodatqc%npstp(inrc) + 1
+         DO jvar = 1, prodatqc%nvar
+            IF ( prodatqc%npvend(jobs,jvar) > 0 ) THEN
+               prodatqc%nvstp(inrc,jvar) = prodatqc%nvstp(inrc,jvar) + &
+                  &                      ( prodatqc%npvend(jobs,jvar) - &
+                  &                        prodatqc%npvsta(jobs,jvar) + 1 )
+            ENDIF
+         END DO
+      END DO
+      
+      
+      CALL obs_mpp_sum_integers( prodatqc%npstp, prodatqc%npstpmpp, &
+         &                       nitend - nit000 + 2 )
+      DO jvar = 1, prodatqc%nvar
+         CALL obs_mpp_sum_integers( prodatqc%nvstp(:,jvar), &
+            &                       prodatqc%nvstpmpp(:,jvar), &
+            &                       nitend - nit000 + 2 )
+      END DO
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), &
+               &                    prodatqc%nvstpmpp(inrc,1), &
+               &                    prodatqc%nvstpmpp(inrc,2)
+         END DO
+      ENDIF
+
+997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Temperature',5X,'Salinity')
+998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'--------')
+999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
+      
+   END SUBROUTINE obs_pre_pro
+
+   SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_sla  ***
+      !!
+      !! ** Purpose : First level check and screening of SLA observations
+      !!
+      !! ** Method  : First level check and screening of SLA observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-03  (A. Weaver, K. Mogensen) Original
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! Full set of SLA data
+      TYPE(obs_surf), INTENT(INOUT) :: sladatqc   ! Subset of SLA data not failing screening
+      LOGICAL, INTENT(IN) :: ld_sla         ! Switch for SLA data
+      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdsobs     !  - outside space domain
+      INTEGER :: ilansobs     !  - within a model land cell
+      INTEGER :: inlasobs     !  - close to land
+      INTEGER :: igrdobs      !  - fail the grid search
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp     !  - outside time domain
+      INTEGER :: iosdsobsmpp    !  - outside space domain
+      INTEGER :: ilansobsmpp    !  - within a model land cell
+      INTEGER :: inlasobsmpp    !  - close to land
+      INTEGER :: igrdobsmpp     !  - fail the grid search
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
+         & llvalid            ! SLA data selection
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for SLA data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              sladata%nsurf,   sladata%nyea, sladata%nmon, &
+         &              sladata%nday,    sladata%nhou, sladata%nmin, &
+         &              sladata%nqc,     sladata%mstp, iotdobs        )
+
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for SLA data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( sladata%nsurf,   sladata%mi, sladata%mj, &
+         &              sladata%nqc,     igrdobs                         )
+
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( sladata%nsurf,              &
+         &                 jpi,          jpj,          &
+         &                 sladata%mi,   sladata%mj,   & 
+         &                 sladata%rlam, sladata%rphi, &
+         &                 glamt,        gphit,        &
+         &                 tmask(:,:,1), sladata%nqc,  &
+         &                 iosdsobs,     ilansobs,     &
+         &                 inlasobs,     ld_nea        )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the sladata data structure to
+      ! the sladatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(sladata%nsurf) )
+      
+      ! We want all data which has qc flags <= 10
+
+      llvalid(:)  = ( sladata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( sladata,     sladatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid )
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_sla :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' SLA data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining SLA data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining SLA data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining SLA data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining SLA data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining SLA data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' SLA data accepted                             = ', &
+            &            sladatqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,1997)
+         WRITE(numout,1998)
+      ENDIF
+      
+      DO jobs = 1, sladatqc%nsurf
+         inrc = sladatqc%mstp(jobs) + 2 - nit000
+         sladatqc%nsstp(inrc)  = sladatqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( sladatqc%nsstp, sladatqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, sladatqc%nsstpmpp(inrc)
+         END DO
+      ENDIF
+
+1997  FORMAT(10X,'Time step',5X,'Sea level anomaly')
+1998  FORMAT(10X,'---------',5X,'-----------------')
+1999  FORMAT(10X,I9,5X,I17)
+
+   END SUBROUTINE obs_pre_sla
+
+   SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_sst  ***
+      !!
+      !! ** Purpose : First level check and screening of SST observations
+      !!
+      !! ** Method  : First level check and screening of SST observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-03  (S. Ricci) SST data preparation 
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata     ! Full set of SST data
+      TYPE(obs_surf), INTENT(INOUT) :: sstdatqc    ! Subset of SST data not failing screening
+      LOGICAL :: ld_sst             ! Switch for SST data
+      LOGICAL :: ld_nea             ! Switch for rejecting observation near land
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0   
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdsobs     !  - outside space domain
+      INTEGER :: ilansobs     !  - within a model land cell
+      INTEGER :: inlasobs     !  - close to land
+      INTEGER :: igrdobs      !  - fail the grid search
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp   !  - outside time domain
+      INTEGER :: iosdsobsmpp  !  - outside space domain
+      INTEGER :: ilansobsmpp  !  - within a model land cell
+      INTEGER :: inlasobsmpp  !  - close to land
+      INTEGER :: igrdobsmpp   !  - fail the grid search
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
+         & llvalid            ! SST data selection
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for SST data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              sstdata%nsurf,   sstdata%nyea, sstdata%nmon, &
+         &              sstdata%nday,    sstdata%nhou, sstdata%nmin, &
+         &              sstdata%nqc,     sstdata%mstp, iotdobs        )
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      ! -----------------------------------------------------------------------
+      ! Check for SST data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( sstdata%nsurf,   sstdata%mi, sstdata%mj, &
+         &              sstdata%nqc,     igrdobs                         )
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( sstdata%nsurf,              &
+         &                 jpi,          jpj,          &
+         &                 sstdata%mi,   sstdata%mj,   & 
+         &                 sstdata%rlam, sstdata%rphi, &
+         &                 glamt,        gphit,        &
+         &                 tmask(:,:,1), sstdata%nqc,  &
+         &                 iosdsobs,     ilansobs,     &
+         &                 inlasobs,     ld_nea        )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the sstdata data structure to
+      ! the sstdatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(sstdata%nsurf) )
+      
+      ! We want all data which has qc flags <= 0
+
+      llvalid(:)  = ( sstdata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( sstdata,     sstdatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid )
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_sst :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' SST data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining SST data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining SST data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining SST data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining SST data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining SST data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' SST data accepted                             = ', &
+            &            sstdatqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,1997)
+         WRITE(numout,1998)
+      ENDIF
+      
+      DO jobs = 1, sstdatqc%nsurf
+         inrc = sstdatqc%mstp(jobs) + 2 - nit000
+         sstdatqc%nsstp(inrc)  = sstdatqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( sstdatqc%nsstp, sstdatqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc)
+         END DO
+      ENDIF
+
+1997  FORMAT(10X,'Time step',5X,'Sea surface temperature')
+1998  FORMAT(10X,'---------',5X,'-----------------')
+1999  FORMAT(10X,I9,5X,I17)
+      
+   END SUBROUTINE obs_pre_sst
+
+   SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_seaice  ***
+      !!
+      !! ** Purpose : First level check and screening of Sea Ice observations
+      !!
+      !! ** Method  : First level check and screening of Sea Ice observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-11 (D. Lea) based on obs_pre_sst
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedata     ! Full set of Sea Ice data
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc    ! Subset of sea ice data not failing screening
+      LOGICAL :: ld_seaice     ! Switch for sea ice data
+      LOGICAL :: ld_nea        ! Switch for rejecting observation near land
+      !! * Local declarations
+      INTEGER :: iyea0         ! Initial date
+      INTEGER :: imon0         !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdsobs     !  - outside space domain
+      INTEGER :: ilansobs     !  - within a model land cell
+      INTEGER :: inlasobs     !  - close to land
+      INTEGER :: igrdobs      !  - fail the grid search
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp   !  - outside time domain
+      INTEGER :: iosdsobsmpp  !  - outside space domain
+      INTEGER :: ilansobsmpp  !  - within a model land cell
+      INTEGER :: inlasobsmpp  !  - close to land
+      INTEGER :: igrdobsmpp   !  - fail the grid search
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
+         & llvalid            ! data selection
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for sea ice data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              seaicedata%nsurf,   seaicedata%nyea, seaicedata%nmon, &
+         &              seaicedata%nday,    seaicedata%nhou, seaicedata%nmin, &
+         &              seaicedata%nqc,     seaicedata%mstp, iotdobs        )
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      ! -----------------------------------------------------------------------
+      ! Check for sea ice data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( seaicedata%nsurf,   seaicedata%mi, seaicedata%mj, &
+         &              seaicedata%nqc,     igrdobs                         )
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( seaicedata%nsurf,                 &
+         &                 jpi,             jpj,             &
+         &                 seaicedata%mi,   seaicedata%mj,   & 
+         &                 seaicedata%rlam, seaicedata%rphi, &
+         &                 glamt,           gphit,           &
+         &                 tmask(:,:,1),    seaicedata%nqc,  &
+         &                 iosdsobs,        ilansobs,        &
+         &                 inlasobs,        ld_nea           )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the seaicedata data structure to
+      ! the seaicedatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(seaicedata%nsurf) )
+      
+      ! We want all data which has qc flags <= 0
+
+      llvalid(:)  = ( seaicedata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( seaicedata,     seaicedatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid )
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_seaice :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Sea ice data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining sea ice data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining sea ice data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining sea ice data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining sea ice data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining sea ice data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' Sea ice data accepted                             = ', &
+            &            seaicedatqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,1997)
+         WRITE(numout,1998)
+      ENDIF
+      
+      DO jobs = 1, seaicedatqc%nsurf
+         inrc = seaicedatqc%mstp(jobs) + 2 - nit000
+         seaicedatqc%nsstp(inrc)  = seaicedatqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( seaicedatqc%nsstp, seaicedatqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, seaicedatqc%nsstpmpp(inrc)
+         END DO
+      ENDIF
+
+1997  FORMAT(10X,'Time step',5X,'Sea ice data           ')
+1998  FORMAT(10X,'---------',5X,'-----------------')
+1999  FORMAT(10X,I9,5X,I17)
+      
+   END SUBROUTINE obs_pre_seaice
+
+   SUBROUTINE obs_pre_vel( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_taovel  ***
+      !!
+      !! ** Purpose : First level check and screening of U and V profiles
+      !!
+      !! ** Method  : First level check and screening of U and V profiles
+      !!
+      !! History :
+      !!        !  2007-06  (K. Mogensen) original : T and S profile data
+      !!        !  2008-09  (M. Valdivieso) : TAO velocity data
+      !!        !  2009-01  (K. Mogensen) : New feedback strictuer
+      !!
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt, glamu, glamv,    &
+         & gphit, gphiu, gphiv,    &
+         & gdept_0, &
+         & tmask, umask, vmask,  &
+         & nproc
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening
+      LOGICAL, INTENT(IN) :: ld_vel3d      ! Switch for zonal and meridional velocity components
+      LOGICAL, INTENT(IN) :: ld_nea        ! Switch for rejecting observation near land
+      LOGICAL, INTENT(IN) :: ld_dailyav    ! Switch for daily average data
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosduobs     !  - outside space domain (zonal velocity component)
+      INTEGER :: iosdvobs     !  - outside space domain (meridional velocity component)
+      INTEGER :: ilanuobs     !  - within a model land cell (zonal velocity component)
+      INTEGER :: ilanvobs     !  - within a model land cell (meridional velocity component)
+      INTEGER :: inlauobs     !  - close to land (zonal velocity component)
+      INTEGER :: inlavobs     !  - close to land (meridional velocity component)
+      INTEGER :: igrdobs      !  - fail the grid search
+      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa
+      INTEGER :: iuvchkv      !
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp   !  - outside time domain
+      INTEGER :: iosduobsmpp  !  - outside space domain (zonal velocity component)
+      INTEGER :: iosdvobsmpp  !  - outside space domain (meridional velocity component)
+      INTEGER :: ilanuobsmpp  !  - within a model land cell (zonal velocity component)
+      INTEGER :: ilanvobsmpp  !  - within a model land cell (meridional velocity component)
+      INTEGER :: inlauobsmpp  !  - close to land (zonal velocity component)
+      INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component)
+      INTEGER :: igrdobsmpp   !  - fail the grid search
+      INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa
+      INTEGER :: iuvchkvmpp   !
+      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection 
+      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
+         & llvvalid           ! U,V selection 
+      INTEGER :: jvar         ! Variable loop variable
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF(lwp) WRITE(numout,*)'obs_pre_vel: Preparing the velocity profile data'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosduobs = 0
+      iosdvobs = 0
+      ilanuobs = 0
+      ilanvobs = 0
+      inlauobs = 0
+      inlavobs = 0
+      iuvchku  = 0
+      iuvchkv = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for profiles
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim_prof( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              profdata%nprof,   profdata%nyea, profdata%nmon, &
+         &              profdata%nday,    profdata%nhou, profdata%nmin, &
+         &              profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+         &              iotdobs, ld_dailyav = ld_dailyav        )
+	 
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for profiles failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,1), profdata%mj(:,1), &
+         &              profdata%nqc,     igrdobs                         )
+      CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,2), profdata%mj(:,2), &
+         &              profdata%nqc,     igrdobs                         )
+
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Reject all observations for profiles with nqc > 10
+      ! -----------------------------------------------------------------------
+
+      CALL obs_pro_rej( profdata )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. This includes points below the model
+      ! bathymetry so this is done for every point in the profile
+      ! -----------------------------------------------------------------------
+
+      ! Zonal Velocity Component
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
+         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(1)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(1)%vdep,                        &
+         &                 glamu,                 gphiu,                &
+         &                 gdept_0,               umask,                &
+         &                 profdata%nqc,          profdata%var(1)%nvqc, &
+         &                 iosduobs,              ilanuobs,             &
+         &                 inlauobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp )
+      CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp )
+      CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp )
+
+      ! Meridional Velocity Component
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
+         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(2)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(2)%vdep,                        &
+         &                 glamv,                 gphiv,                &
+         &                 gdept_0,               vmask,                &
+         &                 profdata%nqc,          profdata%var(2)%nvqc, &
+         &                 iosdvobs,              ilanvobs,             &
+         &                 inlavobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp )
+      CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp )
+      CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Reject u if v is rejected and vice versa
+      ! -----------------------------------------------------------------------
+
+      CALL obs_uv_rej( profdata, iuvchku, iuvchkv )
+      CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp )
+      CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the profdata data structure to
+      ! the prodatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid%luse(profdata%nprof) )
+      DO jvar = 1,profdata%nvar
+         ALLOCATE( llvvalid(jvar)%luse(profdata%nvprot(jvar)) )
+      END DO
+
+      ! We want all data which has qc flags = 0
+
+      llvalid%luse(:) = ( profdata%nqc(:)  <= 10 )
+      DO jvar = 1,profdata%nvar
+         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 )
+      END DO
+
+      ! The actual copying
+
+      CALL obs_prof_compress( profdata,     prodatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid, lvvalid=llvvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid%luse )
+      DO jvar = 1,profdata%nvar
+         DEALLOCATE( llvvalid(jvar)%luse )
+      END DO
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_vel :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Profiles outside time domain                = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining profiles that failed grid search  = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining U data outside space domain       = ', &
+            &            iosduobsmpp
+         WRITE(numout,*) ' Remaining U data at land points             = ', &
+            &            ilanuobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining U data near land points (removed) = ',&
+               &            inlauobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining U data near land points (kept)    = ',&
+               &            inlauobsmpp
+         ENDIF
+         WRITE(numout,*) ' U observation rejected since V rejected     = ', &
+            &            iuvchku     
+         WRITE(numout,*) ' U data accepted                             = ', &
+            &            prodatqc%nvprotmpp(1)
+         WRITE(numout,*) ' Remaining V data outside space domain       = ', &
+            &            iosdvobsmpp
+         WRITE(numout,*) ' Remaining V data at land points             = ', &
+            &            ilanvobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining V data near land points (removed) = ',&
+               &            inlavobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining V data near land points (kept)    = ',&
+               &            inlavobsmpp
+         ENDIF
+         WRITE(numout,*) ' V observation rejected since U rejected     = ', &
+            &            iuvchkv     
+         WRITE(numout,*) ' V data accepted                             = ', &
+            &            prodatqc%nvprotmpp(2)
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,997)
+         WRITE(numout,998)
+      ENDIF
+      
+      DO jobs = 1, prodatqc%nprof
+         inrc = prodatqc%mstp(jobs) + 2 - nit000
+         prodatqc%npstp(inrc)  = prodatqc%npstp(inrc) + 1
+         DO jvar = 1, prodatqc%nvar
+            IF ( prodatqc%npvend(jobs,jvar) > 0 ) THEN
+               prodatqc%nvstp(inrc,jvar) = prodatqc%nvstp(inrc,jvar) + &
+                  &                      ( prodatqc%npvend(jobs,jvar) - &
+                  &                        prodatqc%npvsta(jobs,jvar) + 1 )
+            ENDIF
+         END DO
+      END DO
+      
+      
+      CALL obs_mpp_sum_integers( prodatqc%npstp, prodatqc%npstpmpp, &
+         &                       nitend - nit000 + 2 )
+      DO jvar = 1, prodatqc%nvar
+         CALL obs_mpp_sum_integers( prodatqc%nvstp(:,jvar), &
+            &                       prodatqc%nvstpmpp(:,jvar), &
+            &                       nitend - nit000 + 2 )
+      END DO
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), &
+               &                    prodatqc%nvstpmpp(inrc,1), &
+               &                    prodatqc%nvstpmpp(inrc,2)
+         END DO
+      ENDIF
+
+997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Zonal Comp.',5X,'Meridional Comp.')
+998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------')
+999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
+
+   END SUBROUTINE obs_pre_vel
+
+   SUBROUTINE obs_coo_tim( kcycle, &
+      &                    kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
+      &                    kobsno,                                        &
+      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
+      &                    kobsqc,  kobsstp, kotdobs                      )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_tim ***
+      !!
+      !! ** Purpose : Compute the number of time steps to the observation time.
+      !!
+      !! ** Method  : For time coordinates ( yea_obs, mon_obs, day_obs, 
+      !!              hou_obs, min_obs ), this routine locates the time step 
+      !!              that is closest to this time.
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  1997-07  (A. Weaver) Original
+      !!        !  2006-08  (A. Weaver) NEMOVAR migration
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!        !  2007-01  (K. Mogensen) Rewritten with loop
+      !!        !  2010-05  (D. Lea) Fix in leap year calculation for NEMO vn3.2
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &  ! Geographical information
+         & rdt
+      USE phycst, ONLY : &   ! Physical constants
+         & rday,  &             
+         & rmmss, &             
+         & rhhmm                        
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kcycle     ! Current cycle
+      INTEGER, INTENT(IN) :: kyea0      ! Initial date coordinates
+      INTEGER, INTENT(IN) :: kmon0
+      INTEGER, INTENT(IN) :: kday0 
+      INTEGER, INTENT(IN) :: khou0
+      INTEGER, INTENT(IN) :: kmin0
+      INTEGER, INTENT(IN) :: kobsno     ! Number of observations
+      INTEGER, INTENT(INOUT) :: kotdobs   ! Number of observations failing time check
+      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: &
+         & kobsyea,  &      ! Observation time coordinates
+         & kobsmon,  &
+         & kobsday,  & 
+         & kobshou,  &
+         & kobsmin
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc           ! Quality control flag
+      INTEGER, DIMENSION(kobsno), INTENT(OUT) :: &
+         & kobsstp          ! Number of time steps up to the 
+                            ! observation time
+
+      !! * Local declarations
+      INTEGER :: jyea
+      INTEGER :: jmon
+      INTEGER :: jday
+      INTEGER :: jobs
+      INTEGER :: iyeastr
+      INTEGER :: iyeaend
+      INTEGER :: imonstr
+      INTEGER :: imonend
+      INTEGER :: idaystr
+      INTEGER :: idayend 
+      INTEGER :: iskip
+      INTEGER :: idaystp
+      REAL(KIND=wp) :: zminstp
+      REAL(KIND=wp) :: zhoustp
+      REAL(KIND=wp) :: zobsstp 
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+ 
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      ! Intialize the number of time steps per day
+      idaystp = NINT( rday / rdt )
+
+      !---------------------------------------------------------------------
+      ! Locate the model time coordinates for interpolation
+      !---------------------------------------------------------------------
+
+      DO jobs = 1, kobsno
+
+         ! Initialize the time step counter
+         kobsstp(jobs) = nit000 - 1
+
+         ! Flag if observation date is less than the initial date
+
+         IF ( ( kobsyea(jobs) < kyea0 )                   &
+            & .OR. ( ( kobsyea(jobs) == kyea0 )           &
+            &        .AND. ( kobsmon(jobs) <  kmon0 ) )   &
+            & .OR. ( ( kobsyea(jobs) == kyea0 )           &
+            &        .AND. ( kobsmon(jobs) == kmon0 )     &
+            &        .AND. ( kobsday(jobs) <  kday0 ) )   &
+            & .OR. ( ( kobsyea(jobs) == kyea0 )           &
+            &        .AND. ( kobsmon(jobs) == kmon0 )     &
+            &        .AND. ( kobsday(jobs) == kday0 )     &
+            &        .AND. ( kobshou(jobs) <  khou0 ) )   &
+            &  .OR. ( ( kobsyea(jobs) == kyea0 )          &
+            &        .AND. ( kobsmon(jobs) == kmon0 )     &
+            &        .AND. ( kobsday(jobs) == kday0 )          &
+            &        .AND. ( kobshou(jobs) == khou0 )          &
+            &        .AND. ( kobsmin(jobs) <= kmin0 ) ) ) THEN
+            kobsstp(jobs) = -1
+            kobsqc(jobs)  = kobsqc(jobs) + 11
+            kotdobs       = kotdobs + 1
+            CYCLE
+         ENDIF
+
+         ! Compute the number of time steps to the observation day
+         iyeastr = kyea0
+         iyeaend = kobsyea(jobs)
+         
+         !---------------------------------------------------------------------
+         ! Year loop
+         !---------------------------------------------------------------------
+         DO jyea = iyeastr, iyeaend
+
+            CALL calc_month_len( jyea, imonth_len )
+            
+            imonstr = 1
+            IF ( jyea == kyea0         ) imonstr = kmon0
+            imonend = 12
+            IF ( jyea == kobsyea(jobs) ) imonend = kobsmon(jobs)
+            
+            ! Month loop
+            DO jmon = imonstr, imonend
+               
+               idaystr = 1
+               IF (       ( jmon == kmon0   ) &
+                  & .AND. ( jyea == kyea0   ) ) idaystr = kday0
+               idayend = imonth_len(jmon)
+               IF (       ( jmon == kobsmon(jobs) ) &
+                  & .AND. ( jyea == kobsyea(jobs) ) ) idayend = kobsday(jobs) - 1
+               
+               ! Day loop
+               DO jday = idaystr, idayend
+                  kobsstp(jobs) = kobsstp(jobs) + idaystp
+               END DO
+               
+            END DO
+
+         END DO
+
+         ! Add in the number of time steps to the observation minute
+         zminstp = rmmss / rdt
+         zhoustp = rhhmm * zminstp
+
+         zobsstp =   REAL( kobsmin(jobs) - kmin0, KIND=wp ) * zminstp &
+            &      + REAL( kobshou(jobs) - khou0, KIND=wp ) * zhoustp
+         kobsstp(jobs) = kobsstp(jobs) + NINT( zobsstp )
+
+         ! Flag if observation step outside the time window
+         IF ( ( kobsstp(jobs) < ( nit000 - 1 ) ) &
+            & .OR.( kobsstp(jobs) > nitend ) ) THEN
+            kobsqc(jobs) = kobsqc(jobs) + 12
+            kotdobs = kotdobs + 1
+            CYCLE
+         ENDIF
+
+      END DO
+
+   END SUBROUTINE obs_coo_tim
+
+   SUBROUTINE calc_month_len( iyear, imonth_len )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_month_len  ***
+      !!          
+      !! ** Purpose : Compute the number of days in a months given a year.
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  10-05  (D. Lea)   New routine based on day_init 
+      !!----------------------------------------------------------------------
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+      INTEGER :: iyear         !: year
+      
+      ! length of the month of the current year (from nleapy, read in namelist)
+      IF ( nleapy < 2 ) THEN 
+         imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+         IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years
+            IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN
+               imonth_len(2) = 29
+            ENDIF
+         ENDIF
+      ELSE
+         imonth_len(:) = nleapy   ! all months with nleapy days per year
+      ENDIF
+
+   END SUBROUTINE
+
+   SUBROUTINE obs_coo_tim_prof( kcycle,                                   &
+      &                    kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
+      &                    kobsno,                                        &
+      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
+      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes, &
+      &                    ld_dailyav )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_tim ***
+      !!
+      !! ** Purpose : Compute the number of time steps to the observation time.
+      !!
+      !! ** Method  : For time coordinates ( yea_obs, mon_obs, day_obs, 
+      !!              hou_obs, min_obs ), this routine locates the time step 
+      !!              that is closest to this time.
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  1997-07  (A. Weaver) Original
+      !!        !  2006-08  (A. Weaver) NEMOVAR migration
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!        !  2007-01  (K. Mogensen) Rewritten with loop
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kcycle      ! Current cycle
+      INTEGER, INTENT(IN) :: kyea0       ! Initial date coordinates
+      INTEGER, INTENT(IN) :: kmon0
+      INTEGER, INTENT(IN) :: kday0
+      INTEGER, INTENT(IN) :: khou0
+      INTEGER, INTENT(IN) :: kmin0
+      INTEGER, INTENT(IN) :: kobsno      ! Number of observations
+      INTEGER, INTENT(INOUT) ::  kotdobs    ! Number of observations failing time check
+      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: &
+         & kobsyea,  &      ! Observation time coordinates
+         & kobsmon,  &
+         & kobsday,  & 
+         & kobshou,  &
+         & kobsmin,  &
+         & ktyp             ! Observation type.
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc           ! Quality control flag
+      INTEGER, DIMENSION(kobsno), INTENT(OUT) :: &
+         & kobsstp          ! Number of time steps up to the 
+                            ! observation time
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes    ! Types for daily averages
+      LOGICAL, OPTIONAL :: ld_dailyav    ! All types are daily averages
+      !! * Local declarations
+      INTEGER :: jobs
+
+      !-----------------------------------------------------------------------
+      ! Call standard obs_coo_tim
+      !-----------------------------------------------------------------------
+
+      CALL obs_coo_tim( kcycle, &
+         &              kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
+         &              kobsno,                                        &
+         &              kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
+         &              kobsqc,  kobsstp, kotdobs                      )
+
+      !------------------------------------------------------------------------
+      ! Always reject daily averaged data (e.g. MRB data (820)) at initial time
+      !------------------------------------------------------------------------
+
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         DO jobs = 1, kobsno
+            
+            IF ( kobsqc(jobs) <= 10 ) THEN
+               
+               IF ( ( kobsstp(jobs) == (nit000 - 1) ).AND.&
+                  & ( ANY (kdailyavtypes(:) == ktyp(jobs)) ) ) THEN
+                  kobsqc(jobs) = kobsqc(jobs) + 14
+                  kotdobs      = kotdobs + 1
+                  CYCLE
+               ENDIF
+               
+            ENDIF
+         END DO
+      ENDIF
+
+      !------------------------------------------------------------------------
+      ! If ld_dailyav is set then all data assumed to be daily averaged
+      !------------------------------------------------------------------------
+      
+      IF ( PRESENT( ld_dailyav) ) THEN
+         IF (ld_dailyav) THEN
+            DO jobs = 1, kobsno
+               
+               IF ( kobsqc(jobs) <= 10 ) THEN
+                  
+                  IF ( kobsstp(jobs) == (nit000 - 1) ) THEN
+                     kobsqc(jobs) = kobsqc(jobs) + 14
+                     kotdobs      = kotdobs + 1
+                     CYCLE
+                  ENDIF
+                  
+               ENDIF
+            END DO
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE obs_coo_tim_prof
+
+   SUBROUTINE obs_coo_grd( kobsno, kobsi, kobsj, kobsqc, kgrdobs )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_grd ***
+      !!
+      !! ** Purpose : Verify that the grid search has not failed
+      !!
+      !! ** Method  : The previously computed i,j indeces are checked  
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-01  (K. Mogensen)  Original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kobsno        ! Number of observations
+      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: &
+         & kobsi, &         ! i,j indeces previously computed
+         & kobsj
+      INTEGER, INTENT(INOUT) ::  kgrdobs   ! Number of observations failing the check
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc           ! Quality control flag
+
+      !! * Local declarations
+      INTEGER :: jobs       ! Loop variable
+
+      ! Flag if the grid search failed
+
+      DO jobs = 1, kobsno
+         IF ( ( kobsi(jobs) <= 0 ) .AND. ( kobsj(jobs) <= 0 ) ) THEN
+            kobsqc(jobs) = kobsqc(jobs) + 18
+            kgrdobs = kgrdobs + 1
+         ENDIF
+      END DO
+      
+   END SUBROUTINE obs_coo_grd
+
+   SUBROUTINE obs_coo_spc_2d( kobsno, kpi,     kpj,              &
+      &                       kobsi,  kobsj,   pobslam, pobsphi, & 
+      &                       plam,   pphi,    pmask,            &
+      &                       kobsqc, kosdobs, klanobs,          &
+      &                       knlaobs,ld_nea                     )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_spc_2d  ***
+      !!
+      !! ** Purpose : Check for points outside the domain and land points
+      !!
+      !! ** Method  : Remove the observations that are outside the model space
+      !!              and time domain or located within model land cells.
+      !!
+      !! ** Action  : 
+      !!   
+      !! History :
+      !!        !  2007-03  (A. Weaver, K. Mogensen)  Original
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kobsno    ! Total number of observations
+      INTEGER, INTENT(IN) :: kpi       ! Number of grid points in (i,j)
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, DIMENSION(kobsno), INTENT(IN) :: &
+         & kobsi, &           ! Observation (i,j) coordinates
+         & kobsj
+      REAL(KIND=wp), DIMENSION(kobsno), INTENT(IN) :: &
+         & pobslam, &         ! Observation (lon,lat) coordinates
+         & pobsphi
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & plam, pphi         ! Model (lon,lat) coordinates
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & pmask              ! Land mask array
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc             ! Observation quality control
+      INTEGER, INTENT(INOUT) :: kosdobs   ! Observations outside space domain
+      INTEGER, INTENT(INOUT) :: klanobs   ! Observations within a model land cell
+      INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land
+      LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: &
+         & zgmsk              ! Grid mask
+      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: &
+         & zglam, &           ! Model longitude at grid points
+         & zgphi              ! Model latitude at grid points
+      INTEGER, DIMENSION(2,2,kobsno) :: &
+         & igrdi, &           ! Grid i,j
+         & igrdj
+      LOGICAL :: lgridobs           ! Is observation on a model grid point.
+      INTEGER :: iig, ijg           ! i,j of observation on model grid point.
+      INTEGER :: jobs, ji, jj
+      
+      ! Get grid point indices
+
+      DO jobs = 1, kobsno
+         
+         ! For invalid points use 2,2
+
+         IF ( kobsqc(jobs) >= 10 ) THEN
+
+            igrdi(1,1,jobs) = 1
+            igrdj(1,1,jobs) = 1
+            igrdi(1,2,jobs) = 1
+            igrdj(1,2,jobs) = 2
+            igrdi(2,1,jobs) = 2
+            igrdj(2,1,jobs) = 1
+            igrdi(2,2,jobs) = 2
+            igrdj(2,2,jobs) = 2
+
+         ELSE
+
+            igrdi(1,1,jobs) = kobsi(jobs)-1
+            igrdj(1,1,jobs) = kobsj(jobs)-1
+            igrdi(1,2,jobs) = kobsi(jobs)-1
+            igrdj(1,2,jobs) = kobsj(jobs)
+            igrdi(2,1,jobs) = kobsi(jobs)
+            igrdj(2,1,jobs) = kobsj(jobs)-1
+            igrdi(2,2,jobs) = kobsi(jobs)
+            igrdj(2,2,jobs) = kobsj(jobs)
+
+         ENDIF
+
+      END DO
+      
+      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi )
+
+      DO jobs = 1, kobsno
+
+         ! Skip bad observations
+         IF ( kobsqc(jobs) >= 10 ) CYCLE
+
+         ! Flag if the observation falls outside the model spatial domain
+         IF (       ( pobslam(jobs) < -180. ) &
+            &  .OR. ( pobslam(jobs) >  180. ) &
+            &  .OR. ( pobsphi(jobs) <  -90. ) &
+            &  .OR. ( pobsphi(jobs) >   90. ) ) THEN
+            kobsqc(jobs) = kobsqc(jobs) + 11
+            kosdobs = kosdobs + 1
+            CYCLE
+         ENDIF
+
+         ! Flag if the observation falls with a model land cell
+         IF ( SUM( zgmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN
+            kobsqc(jobs) = kobsqc(jobs)  + 12
+            klanobs = klanobs + 1
+            CYCLE
+         ENDIF
+
+         ! Check if this observation is on a grid point
+
+         lgridobs = .FALSE.
+         iig = -1
+         ijg = -1
+         DO jj = 1, 2
+            DO ji = 1, 2
+               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) &
+                  & .AND. &
+                  & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) &
+                  & ) THEN
+                  lgridobs = .TRUE.
+                  iig = ji
+                  ijg = jj
+               ENDIF
+            END DO
+         END DO
+  
+         ! For observations on the grid reject them if their are at
+         ! a masked point
+         
+         IF (lgridobs) THEN
+            IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN
+               kobsqc(jobs) = kobsqc(jobs) + 12
+               klanobs = klanobs + 1
+               CYCLE
+            ENDIF
+         ENDIF
+                      
+         ! Flag if the observation falls is close to land
+         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN
+            IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14
+            knlaobs = knlaobs + 1
+            CYCLE
+         ENDIF
+            
+      END DO
+
+   END SUBROUTINE obs_coo_spc_2d
+
+   SUBROUTINE obs_coo_spc_3d( kprofno, kobsno,  kpstart, kpend, &
+      &                       kpi,     kpj,     kpk,            &
+      &                       kobsi,   kobsj,   kobsk,          &
+      &                       pobslam, pobsphi, pobsdep,        &
+      &                       plam,    pphi,    pdep,    pmask, &
+      &                       kpobsqc, kobsqc,  kosdobs,        &
+      &                       klanobs, knlaobs, ld_nea          )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_spc_3d  ***
+      !!
+      !! ** Purpose : Check for points outside the domain and land points
+      !!              Reset depth of observation above highest model level
+      !!              to the value of highest model level
+      !!
+      !! ** Method  : Remove the observations that are outside the model space
+      !!              and time domain or located within model land cells.
+      !!
+      !!              NB. T and S profile observations lying between the ocean
+      !!              surface and the depth of the first model T point are 
+      !!              assigned a depth equal to that of the first model T pt.
+      !!
+      !! ** Action  : 
+      !!   
+      !! History :
+      !!        !  2007-01  (K. Mogensen) Rewrite of parts of obs_scr
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &       ! Geographical information
+         & gdepw_0                        
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kprofno      ! Number of profiles
+      INTEGER, INTENT(IN) :: kobsno       ! Total number of observations
+      INTEGER, INTENT(IN) :: kpi          ! Number of grid points in (i,j,k)
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk    
+      INTEGER, DIMENSION(kprofno), INTENT(IN) :: &
+         & kpstart, &         ! Start of individual profiles
+         & kpend              ! End of individual profiles
+      INTEGER, DIMENSION(kprofno), INTENT(IN) :: &
+         & kobsi, &           ! Observation (i,j) coordinates
+         & kobsj
+      INTEGER, DIMENSION(kobsno), INTENT(IN) :: &
+         & kobsk              ! Observation k coordinate
+      REAL(KIND=wp), DIMENSION(kprofno), INTENT(IN) :: &
+         & pobslam, &         ! Observation (lon,lat) coordinates
+         & pobsphi
+      REAL(KIND=wp), DIMENSION(kobsno), INTENT(INOUT) :: &
+         & pobsdep            ! Observation depths  
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & plam, pphi         ! Model (lon,lat) coordinates
+      REAL(KIND=wp), DIMENSION(kpk), INTENT(IN) :: &
+         & pdep               ! Model depth coordinates
+      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) :: &
+         & pmask              ! Land mask array
+      INTEGER, DIMENSION(kprofno), INTENT(INOUT) :: &
+         & kpobsqc             ! Profile quality control
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc             ! Observation quality control
+      INTEGER, INTENT(INOUT) :: kosdobs     ! Observations outside space domain
+      INTEGER, INTENT(INOUT) :: klanobs     ! Observations within a model land cell
+      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land
+      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: &
+         & zgmsk              ! Grid mask
+      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: &
+         & zglam, &           ! Model longitude at grid points
+         & zgphi              ! Model latitude at grid points
+      INTEGER, DIMENSION(2,2,kprofno) :: &
+         & igrdi, &           ! Grid i,j
+         & igrdj
+      LOGICAL :: lgridobs           ! Is observation on a model grid point.
+      INTEGER :: iig, ijg           ! i,j of observation on model grid point.
+      INTEGER :: jobs, jobsp, jk, ji, jj
+
+      ! Get grid point indices
+      
+      DO jobs = 1, kprofno
+
+         ! For invalid points use 2,2
+
+         IF ( kpobsqc(jobs) >= 10 ) THEN
+            
+            igrdi(1,1,jobs) = 1
+            igrdj(1,1,jobs) = 1
+            igrdi(1,2,jobs) = 1
+            igrdj(1,2,jobs) = 2
+            igrdi(2,1,jobs) = 2
+            igrdj(2,1,jobs) = 1
+            igrdi(2,2,jobs) = 2
+            igrdj(2,2,jobs) = 2
+            
+         ELSE
+            
+            igrdi(1,1,jobs) = kobsi(jobs)-1
+            igrdj(1,1,jobs) = kobsj(jobs)-1
+            igrdi(1,2,jobs) = kobsi(jobs)-1
+            igrdj(1,2,jobs) = kobsj(jobs)
+            igrdi(2,1,jobs) = kobsi(jobs)
+            igrdj(2,1,jobs) = kobsj(jobs)-1
+            igrdi(2,2,jobs) = kobsi(jobs)
+            igrdj(2,2,jobs) = kobsj(jobs)
+            
+         ENDIF
+         
+      END DO
+      
+      CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi )
+
+      DO jobs = 1, kprofno
+
+         ! Skip bad profiles
+         IF ( kpobsqc(jobs) >= 10 ) CYCLE
+
+         ! Check if this observation is on a grid point
+
+         lgridobs = .FALSE.
+         iig = -1
+         ijg = -1
+         DO jj = 1, 2
+            DO ji = 1, 2
+               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) &
+                  & .AND. &
+                  & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) &
+                  & ) THEN
+                  lgridobs = .TRUE.
+                  iig = ji
+                  ijg = jj
+               ENDIF
+            END DO
+         END DO
+
+         ! Reject observations
+
+         DO jobsp = kpstart(jobs), kpend(jobs)
+
+            ! Flag if the observation falls outside the model spatial domain
+            IF (       ( pobslam(jobs) < -180.         )       &
+               &  .OR. ( pobslam(jobs) >  180.         )       &
+               &  .OR. ( pobsphi(jobs) <  -90.         )       &
+               &  .OR. ( pobsphi(jobs) >   90.         )       &
+               &  .OR. ( pobsdep(jobsp) < 0.0          )       &
+               &  .OR. ( pobsdep(jobsp) > gdepw_0(kpk) ) ) THEN
+               kobsqc(jobsp) = kobsqc(jobsp) + 11
+               kosdobs = kosdobs + 1
+               CYCLE
+            ENDIF
+
+            ! Flag if the observation falls with a model land cell
+            IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &
+               &  == 0.0_wp ) THEN
+               kobsqc(jobsp) = kobsqc(jobsp) + 12
+               klanobs = klanobs + 1
+               CYCLE
+            ENDIF
+
+            ! For observations on the grid reject them if their are at
+            ! a masked point
+            
+            IF (lgridobs) THEN
+               IF (zgmsk(iig,ijg,kobsk(jobsp)-1,jobs) == 0.0_wp ) THEN
+                  kobsqc(jobsp) = kobsqc(jobsp) + 12
+                  klanobs = klanobs + 1
+                  CYCLE
+               ENDIF
+            ENDIF
+            
+            ! Flag if the observation falls is close to land
+            IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == &
+               &  0.0_wp) THEN
+               IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14
+               knlaobs = knlaobs + 1
+            ENDIF
+
+            ! Set observation depth equal to that of the first model depth
+            IF ( pobsdep(jobsp) <= pdep(1) ) THEN
+               pobsdep(jobsp) = pdep(1)  
+            ENDIF
+            
+         END DO
+      END DO
+
+   END SUBROUTINE obs_coo_spc_3d
+
+   SUBROUTINE obs_pro_rej( profdata )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pro_rej ***
+      !!
+      !! ** Purpose : Reject all data within a rejected profile
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-10  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Profile data
+      !! * Local declarations
+      INTEGER :: jprof
+      INTEGER :: jvar
+      INTEGER :: jobs
+      
+      ! Loop over profiles
+
+      DO jprof = 1, profdata%nprof
+
+         IF ( profdata%nqc(jprof) > 10 ) THEN
+            
+            DO jvar = 1, profdata%nvar
+
+               DO jobs = profdata%npvsta(jprof,jvar),  &
+                  &      profdata%npvend(jprof,jvar)
+                  
+                  profdata%var(jvar)%nvqc(jobs) = &
+                     & profdata%var(jvar)%nvqc(jobs) + 26
+
+               END DO
+
+            END DO
+
+         ENDIF
+
+      END DO
+
+   END SUBROUTINE obs_pro_rej
+
+   SUBROUTINE obs_uv_rej( profdata, knumu, knumv )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_uv_rej ***
+      !!
+      !! ** Purpose : Reject u if v is rejected and vice versa
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2009-2  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Profile data
+      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected
+      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected
+      !! * Local declarations
+      INTEGER :: jprof
+      INTEGER :: jvar
+      INTEGER :: jobs
+      
+      ! Loop over profiles
+
+      DO jprof = 1, profdata%nprof
+
+         IF ( ( profdata%npvsta(jprof,1) /= profdata%npvsta(jprof,2) ) .OR. &
+            & ( profdata%npvend(jprof,1) /= profdata%npvend(jprof,2) ) ) THEN
+
+            CALL ctl_stop('U,V profiles inconsistent in obs_uv_rej')
+            RETURN
+
+         ENDIF
+
+         DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1)
+            
+            IF ( ( profdata%var(1)%nvqc(jobs) > 10 ) .AND. &
+               & ( profdata%var(2)%nvqc(jobs) <= 10) ) THEN
+               profdata%var(2)%nvqc(jobs) = profdata%var(2)%nvqc(jobs) + 42
+               knumv = knumv + 1
+            ENDIF
+            IF ( ( profdata%var(2)%nvqc(jobs) > 10 ) .AND. &
+               & ( profdata%var(1)%nvqc(jobs) <= 10) ) THEN
+               profdata%var(1)%nvqc(jobs) = profdata%var(1)%nvqc(jobs) + 42
+               knumu = knumu + 1
+            ENDIF
+            
+         END DO
+            
+      END DO
+
+   END SUBROUTINE obs_uv_rej
+
+END MODULE obs_prep
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_prof_io.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_prof_io.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_prof_io.F90	(revision 2236)
@@ -0,0 +1,26 @@
+MODULE obs_prof_io
+   !!======================================================================
+   !!                       ***  MODULE obs_prof_io  ***
+   !! Observation operators : I/O for ENACT and Coriolis files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an ENACT file.
+   !!   read_coriofile    :  Read a obfbdata structure from an Coriolis file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+CONTAINS
+
+#include "obsprof_io.h90"
+
+END MODULE obs_prof_io
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_profiles.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_profiles.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_profiles.F90	(revision 2236)
@@ -0,0 +1,33 @@
+MODULE obs_profiles
+   !!=====================================================================
+   !!                       ***  MODULE  obs_profiles  ***
+   !! Observation diagnostics: Storage space for profile observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   
+   !! * Modules used 
+   USE obs_profiles_def ! Definition of profile data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nprofsets, nprofvars, nprofextr, profdata, prodatqc
+   PUBLIC nvelosets, nvelovars, nveloextr, velodata, veldatqc
+   
+   !! * Shared Module variables
+   INTEGER :: nprofsets                    ! Total number of profile data sets
+   INTEGER :: nprofvars                    ! Total number of variables for profiles
+   INTEGER :: nprofextr                    ! Extra fields for each variable
+   TYPE(obs_prof), POINTER ::  profdata(:) ! Initial profile data
+   TYPE(obs_prof), POINTER ::  prodatqc(:) ! Profile data after quality control
+
+   INTEGER :: nvelosets                     ! Total number of velocity profile data sets
+   INTEGER :: nvelovars                     ! Total number of variables for profiles
+   INTEGER :: nveloextr                     ! Extra fields for each variable
+   TYPE(obs_prof), POINTER ::  velodata(:)  ! Initial velocity profile data
+   TYPE(obs_prof), POINTER ::  veldatqc(:)  ! Velocity profile data after quality control
+END MODULE obs_profiles
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 2236)
@@ -0,0 +1,913 @@
+MODULE obs_profiles_def
+   !!=====================================================================
+   !!                       ***  MODULE  obs_profiles_def  ***
+   !! Observation diagnostics: Storage handling for T,S profiles
+   !!                          arrays and additional flags etc.
+   !!                          This module only defines the data type and
+   !!                          operations on the data type. There is no
+   !!                          actual data in the module.
+   !!===================================================================== 
+
+   !!----------------------------------------------------------------------
+   !!   obs_prof            : F90 type containing the profile information
+   !!   obs_prof_var        : F90 type containing the variable definition
+   !!   obs_prof_valid       : F90 type containing the valid obs. definition
+   !!   obs_prof_alloc      : Allocates profile arrays
+   !!   obs_prof_dealloc    : Deallocates profile arrays
+   !!   obs_prof_compress   : Extract sub-information from a obs_prof type
+   !!                         to a new obs_prof type
+   !!   obs_prof_decompress : Reinsert sub-information from a obs_prof type
+   !!                         into the original obs_prof type
+   !!   obs_prof_staend     : Set npvsta and npvend of a variable within an 
+   !!                         obs_prof_var type
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp         
+   USE in_out_manager     ! I/O manager
+   USE obs_mpp, ONLY : &  ! MPP tools 
+      obs_mpp_sum_integers
+   USE obs_fbm            ! Obs feedback format
+
+   IMPLICIT NONE
+
+   !! * Routine/type accessibility
+   PRIVATE
+
+   PUBLIC &
+      & obs_prof,           &
+      & obs_prof_var,       &
+      & obs_prof_valid,     &
+      & obs_prof_alloc,     &
+      & obs_prof_alloc_var, &
+      & obs_prof_dealloc,   &
+      & obs_prof_compress,  &
+      & obs_prof_decompress,&
+      & obs_prof_staend
+
+   !! * Type definition for valid observations
+
+   TYPE obs_prof_valid
+      
+      LOGICAL, POINTER, DIMENSION(:) :: luse
+
+   END TYPE obs_prof_valid
+
+   !! * Type definition for each variable
+
+   TYPE obs_prof_var
+
+      ! Arrays with size equal to the number of observations
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & mvk,   &       !: k-th grid coord. for interpolating to profile data
+         & nvpidx,&       !: Profile number
+         & nvlidx,&       !: Level number in profile
+         & nvqc,  &       !: Variable QC flags
+         & idqc           !: Depth QC flag
+
+      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
+         & vdep,  &       !: Depth coordinate of profile data
+         & vobs,  &       !: Profile data
+         & vmod           !: Model counterpart of the profile data vector
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
+         & vext           !: Extra variables
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nvind          !: Source indices of temp. data in compressed data
+
+      ! Arrays with size equal to idefnqcf times the number of observations
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & idqcf,  &      !: Depth QC flags
+         & nvqcf          !: Variable QC flags
+
+   END TYPE obs_prof_var
+
+   !! * Type definition for profile observation type
+
+   TYPE obs_prof
+
+      ! Bookkeeping
+
+      INTEGER :: nvar     !: Number of variables
+      INTEGER :: next     !: Number of extra fields
+      INTEGER :: nprof    !: Total number of profiles within window.
+      INTEGER :: nstp     !: Number of time steps
+      INTEGER :: npi      !: Number of 3D grid points
+      INTEGER :: npj
+      INTEGER :: npk
+      INTEGER :: nprofup  !: Observation counter used in obs_oper
+
+      ! Bookkeeping arrays with sizes equal to number of variables
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nvprot,   &    !: Local total number of profile T data
+         & nvprotmpp      !: Global total number of profile T data
+      
+      ! Arrays with size equal to the number of profiles
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & npidx,&        !: Profile number
+         & npfil,&        !: Profile number in file
+         & nyea, &        !: Year of profile
+         & nmon, &        !: Month of profile
+         & nday, &        !: Day of profile
+         & nhou, &        !: Hour of profile
+         & nmin, &        !: Minute of profile
+         & mstp, &        !: Time step nearest to profile
+         & nqc,  &        !: Profile QC
+         & ntyp, &        !: Type of profile product (WMO table 1770)
+         & ipqc, &        !: Position QC
+         & itqc           !: Time QC
+
+      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
+         & rlam, &        !: Longitude coordinate of profile data
+         & rphi           !: Latitude coordinate of profile data
+
+      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
+         & cwmo           !: Profile WMO indentifier
+      
+      ! Arrays with size equal to the number of profiles times
+      ! number of variables
+
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & npvsta, &      !: Start of each variable profile in full arrays
+         & npvend, &      !: End of each variable profile in full arrays
+         & mi,     &      !: i-th grid coord. for interpolating to profile T data
+         & mj,     &      !: j-th grid coord. for interpolating to profile T data
+         & ivqc           !: QC flags for all levels for a variable
+
+      ! Arrays with size equal to idefnqcf
+      ! the number of profiles times number of variables
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & nqcf,  &       !: Observation QC flags
+         & ipqcf, &       !: Position QC flags
+         & itqcf          !: Time QC flags
+
+      ! Arrays with size equal to idefnqcf
+      ! the number of profiles times number of variables
+      INTEGER, POINTER, DIMENSION(:,:,:) :: &
+         & ivqcf
+
+      ! Arrays of variables
+
+      TYPE(obs_prof_var), POINTER, DIMENSION(:) :: var
+
+      ! Arrays with size equal to the number of time steps in the window
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & npstp,    &    !: Total number of profiles
+         & npstpmpp       !: Total number of profiles
+
+      ! Arrays with size equal to the number of time steps in the window times
+      ! number of variables
+
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & nvstp,    &    !: Local total num. of profile data each time step 
+         & nvstpmpp       !: Global total num. of profile data each time step
+      
+      ! Arrays with size equal to the number of grid points times number of
+      ! variables
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:,:,:) :: &
+         & vdmean        !: Daily averaged model field
+
+      ! Arrays used to store source indices when 
+      ! compressing obs_prof derived types
+      
+      ! Array with size nprof
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & npind         !: Source indices of profile data in compressed data
+
+   END TYPE obs_prof
+
+CONTAINS
+   
+   SUBROUTINE obs_prof_alloc( prof,  kvar, kext, kprof,  &
+      &                       ko3dt, kstp, kpi, kpj, kpk )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_alloc  ***
+      !!                      
+      !! ** Purpose : - Allocate data for profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!        !  07-03  (K. Mogensen) Generalized profiles
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prof      ! Profile data to be allocated
+      INTEGER, INTENT(IN) :: kprof  ! Number of profiles
+      INTEGER, INTENT(IN) :: kvar   ! Number of variables
+      INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable
+      INTEGER, INTENT(IN), DIMENSION(kvar) :: &
+         & ko3dt     ! Number of observations per variables
+      INTEGER, INTENT(IN) :: kstp   ! Number of time steps
+      INTEGER, INTENT(IN) :: kpi    ! Number of 3D grid points
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk
+
+      !!* Local variables
+      INTEGER :: jvar
+      INTEGER :: ji
+
+      ! Set bookkeeping variables
+
+      prof%nvar      = kvar
+      prof%next      = kext
+      prof%nprof     = kprof
+
+      prof%nstp      = kstp
+      prof%npi       = kpi
+      prof%npj       = kpj
+      prof%npk       = kpk
+
+      ! Allocate arrays of size number of variables
+
+      ALLOCATE( &
+         & prof%nvprot(kvar),   &
+         & prof%nvprotmpp(kvar) &
+         )
+         
+      DO jvar = 1, kvar
+         prof%nvprot   (jvar) = ko3dt(jvar)
+         prof%nvprotmpp(jvar) = 0
+      END DO
+
+      ! Allocate arrays of size number of profiles
+      ! times number of variables
+      
+      ALLOCATE( &
+         & prof%npvsta(kprof,kvar), &  
+         & prof%npvend(kprof,kvar), &
+         & prof%mi(kprof,kvar),     &
+         & prof%mj(kprof,kvar),     &
+         & prof%ivqc(kprof,kvar)    &
+         )
+
+      ! Allocate arrays of size iqcfdef times number of profiles
+      ! times number of variables
+
+      ALLOCATE( &
+         & prof%ivqcf(idefnqcf,kprof,kvar) &
+         & )
+
+      ! Allocate arrays of size number of profiles
+
+      ALLOCATE( &
+         & prof%npidx(kprof),   &
+         & prof%npfil(kprof),   &
+         & prof%nyea(kprof),    &
+         & prof%nmon(kprof),    &
+         & prof%nday(kprof),    &
+         & prof%nhou(kprof),    &
+         & prof%nmin(kprof),    &
+         & prof%mstp(kprof),    &
+         & prof%nqc(kprof),     &
+         & prof%ipqc(kprof),    &
+         & prof%itqc(kprof),    &
+         & prof%ntyp(kprof),    &
+         & prof%rlam(kprof),    &
+         & prof%rphi(kprof),    &
+         & prof%cwmo(kprof),    &
+         & prof%npind(kprof)    &
+         & )
+
+      ! Allocate arrays of size idefnqcf times number of profiles
+
+      ALLOCATE( &
+         & prof%nqcf(idefnqcf,kprof),  &
+         & prof%ipqcf(idefnqcf,kprof), &
+         & prof%itqcf(idefnqcf,kprof)  &
+         & )
+
+      ! Allocate obs_prof_var type
+      ALLOCATE( &
+         & prof%var(kvar) &
+         & )
+
+      ! For each variables allocate arrays of size number of observations
+
+      DO jvar = 1, kvar
+
+         IF ( ko3dt(jvar) >= 0 ) THEN
+            CALL obs_prof_alloc_var( prof, jvar, kext, ko3dt(jvar) )
+         ENDIF
+         
+      END DO
+
+      ! Allocate arrays of size number of time step size
+
+      ALLOCATE( &
+         & prof%npstp(kstp),   &
+         & prof%npstpmpp(kstp) &
+         & )
+
+      ! Allocate arrays of size number of time step size times 
+      ! number of variables
+      
+      ALLOCATE( &
+         & prof%nvstp(kstp,kvar),   &
+         & prof%nvstpmpp(kstp,kvar) &
+         & )
+
+      ! Allocate arrays of size number of grid points size times
+      ! number of variables
+
+      ALLOCATE( &
+         & prof%vdmean(kpi,kpj,kpk,kvar) &
+         & )
+
+      ! Set defaults for compression indices
+      
+      DO ji = 1, kprof
+         prof%npind(ji) = ji
+      END DO
+
+      DO jvar = 1, kvar
+         DO ji = 1, ko3dt(jvar)
+            prof%var(jvar)%nvind(ji) = ji
+         END DO
+      END DO
+
+      ! Set defaults for number of observations per time step
+
+      prof%npstp(:)      = 0
+      prof%npstpmpp(:)   = 0
+      prof%nvstp(:,:)    = 0
+      prof%nvstpmpp(:,:) = 0
+      
+      ! Set the observation counter used in obs_oper
+
+      prof%nprofup     = 0
+
+   END SUBROUTINE obs_prof_alloc
+
+   SUBROUTINE obs_prof_dealloc( prof )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_dealloc  ***
+      !!                      
+      !! ** Purpose : - Deallocate data for profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: &
+         & prof      ! Profile data to be deallocated
+
+      !!* Local variables
+      INTEGER :: &
+         & jvar
+
+      ! Deallocate arrays of size number of profiles
+      ! times number of variables
+      
+      DEALLOCATE( &
+         & prof%npvsta, &  
+         & prof%npvend  &
+         )
+
+      ! Dellocate arrays of size number of profiles size
+
+      DEALLOCATE( &
+         & prof%mi,      &
+         & prof%mj,      &
+         & prof%ivqc,    &
+         & prof%ivqcf,   &
+         & prof%npidx,   &
+         & prof%npfil,   &
+         & prof%nyea,    &
+         & prof%nmon,    &
+         & prof%nday,    &
+         & prof%nhou,    &
+         & prof%nmin,    &
+         & prof%mstp,    &
+         & prof%nqc,     &
+         & prof%ipqc,    &
+         & prof%itqc,    &
+         & prof%nqcf,    &
+         & prof%ipqcf,   &
+         & prof%itqcf,   &
+         & prof%ntyp,    &
+         & prof%rlam,    &
+         & prof%rphi,    &
+         & prof%cwmo,    &
+         & prof%npind    &
+         & )
+
+      ! For each variables allocate arrays of size number of observations
+
+      DO jvar = 1, prof%nvar
+
+         IF ( prof%nvprot(jvar) >= 0 ) THEN
+
+            CALL obs_prof_dealloc_var( prof, jvar )
+
+         ENDIF
+         
+      END DO
+
+      ! Dellocate obs_prof_var type
+      DEALLOCATE( &
+         & prof%var &
+         & )
+
+      ! Deallocate arrays of size number of time step size
+
+      DEALLOCATE( &
+         & prof%npstp,   &
+         & prof%npstpmpp &
+         & )
+
+      ! Deallocate arrays of size number of time step size times 
+      ! number of variables
+      
+      DEALLOCATE( &
+         & prof%nvstp,   &
+         & prof%nvstpmpp &
+         & )
+
+      ! Deallocate arrays of size number of grid points size times
+      ! number of variables
+
+      DEALLOCATE( &
+         & prof%vdmean &
+         & )
+
+      ! Dellocate arrays of size number of variables
+
+      DEALLOCATE( &
+         & prof%nvprot,  &
+         & prof%nvprotmpp &
+         )
+
+
+   END SUBROUTINE obs_prof_dealloc
+
+
+   SUBROUTINE obs_prof_alloc_var( prof, kvar, kext, kobs )
+
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_alloc_var  ***
+      !!                      
+      !! ** Purpose : - Allocate data for variable data in profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen) Original code
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated
+      INTEGER, INTENT(IN) :: kvar   ! Variable number
+      INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable
+      INTEGER, INTENT(IN) :: kobs   ! Number of observations
+      
+      ALLOCATE( & 
+         & prof%var(kvar)%mvk(kobs),       &
+         & prof%var(kvar)%nvpidx(kobs),    &
+         & prof%var(kvar)%nvlidx(kobs),    &
+         & prof%var(kvar)%nvqc(kobs),      &
+         & prof%var(kvar)%idqc(kobs),      &
+         & prof%var(kvar)%vdep(kobs),      &
+         & prof%var(kvar)%vobs(kobs),      &
+         & prof%var(kvar)%vmod(kobs),      &
+         & prof%var(kvar)%nvind(kobs)      &
+         & )
+      ALLOCATE( & 
+         & prof%var(kvar)%idqcf(idefnqcf,kobs), &
+         & prof%var(kvar)%nvqcf(idefnqcf,kobs)  &
+         & )
+      IF (kext>0) THEN
+         ALLOCATE( & 
+            & prof%var(kvar)%vext(kobs,kext) &
+            & )
+      ENDIF
+
+   END SUBROUTINE obs_prof_alloc_var
+
+   SUBROUTINE obs_prof_dealloc_var( prof, kvar )
+
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_alloc_var  ***
+      !!                      
+      !! ** Purpose : - Allocate data for variable data in profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen) Original code
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated
+      INTEGER, INTENT(IN) :: kvar      ! Variable number
+      
+      DEALLOCATE( & 
+         & prof%var(kvar)%mvk,    &
+         & prof%var(kvar)%nvpidx, &
+         & prof%var(kvar)%nvlidx, &
+         & prof%var(kvar)%nvqc,   &
+         & prof%var(kvar)%idqc,   &
+         & prof%var(kvar)%vdep,   &
+         & prof%var(kvar)%vobs,   &
+         & prof%var(kvar)%vmod,   &
+         & prof%var(kvar)%nvind,  &
+         & prof%var(kvar)%idqcf,  &
+         & prof%var(kvar)%nvqcf   &
+         & )
+      IF (prof%next>0) THEN
+         DEALLOCATE( & 
+            & prof%var(kvar)%vext  &
+            & )
+      ENDIF
+
+   END SUBROUTINE obs_prof_dealloc_var
+
+   SUBROUTINE obs_prof_compress( prof,   newprof, lallocate, &
+      &                          kumout, lvalid,   lvvalid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_compress  ***
+      !!                      
+      !! ** Purpose : - Extract sub-information from a obs_prof type
+      !!                into a new obs_prof type
+      !! 
+      !! ** Method  : - The data is copied from prof to new prof.
+      !!                In the case of lvalid and lvvalid both being
+      !!                present only the selected data will be copied.
+      !!                If lallocate is true the data in the newprof is 
+      !!                allocated either with the same number of elements
+      !!                as prof or with only the subset of elements defined
+      !!                by the optional selection in lvalid and lvvalid
+      !!
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof), INTENT(IN)    :: prof      ! Original profile
+      TYPE(obs_prof), INTENT(INOUT) :: newprof   ! New profile with the copy of the data
+      LOGICAL :: lallocate                ! Allocate newprof data
+      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
+      TYPE(obs_prof_valid), OPTIONAL, INTENT(in) :: &
+         & lvalid        ! Valid profiles
+      TYPE(obs_prof_valid), OPTIONAL, INTENT(in), DIMENSION(prof%nvar) :: &
+         & lvvalid       ! Valid data within the profiles
+      
+      !!* Local variables
+      INTEGER :: inprof
+      INTEGER, DIMENSION(prof%nvar) :: &
+         & invpro
+      INTEGER :: jvar
+      INTEGER :: jext
+      INTEGER :: ji
+      INTEGER :: jj 
+      LOGICAL :: lfirst
+      TYPE(obs_prof_valid) :: &
+         & llvalid
+      TYPE(obs_prof_valid), DIMENSION(prof%nvar) :: &
+         & llvvalid
+      LOGICAL :: lallpresent
+      LOGICAL :: lnonepresent
+
+      ! Check that either all or none of the masks are persent.
+
+      lallpresent  = .FALSE.
+      lnonepresent = .FALSE.
+      IF ( PRESENT(lvalid) .AND. PRESENT(lvvalid) ) THEN
+         lallpresent =  .TRUE.
+      ELSEIF ( ( .NOT. PRESENT(lvalid)  ) .AND. &
+         &     ( .NOT. PRESENT(lvvalid) ) ) THEN
+         lnonepresent = .TRUE.
+      ELSE
+         CALL ctl_stop('Error in obs_prof_compress:', &
+            &          'Either all selection variables should be set', &
+            &          'or no selection variable should be set' )
+      ENDIF
+      
+      ! Count how many elements there should be in the new data structure
+
+      IF ( lallpresent ) THEN
+         inprof = 0
+         invpro(:) = 0
+         DO ji = 1, prof%nprof
+            IF ( lvalid%luse(ji) ) THEN
+               inprof=inprof+1
+               DO jvar = 1, prof%nvar
+                  DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar)
+                     IF ( lvvalid(jvar)%luse(jj) ) &
+                        &           invpro(jvar) = invpro(jvar) +1
+                  END DO
+               END DO
+            ENDIF
+         END DO
+      ELSE
+         inprof    = prof%nprof
+         invpro(:) = prof%nvprot(:)
+      ENDIF
+
+      ! Optionally allocate data in the new data structure
+
+      IF ( lallocate ) THEN
+         CALL obs_prof_alloc( newprof,   prof%nvar, &
+            &                 prof%next,            &
+            &                 inprof,    invpro,    &
+            &                 prof%nstp, prof%npi,  &
+            &                 prof%npj,  prof%npk )
+      ENDIF
+
+      ! Allocate temporary mask array to unify the code for both cases
+
+      ALLOCATE( llvalid%luse(prof%nprof) )
+      DO jvar = 1, prof%nvar
+         ALLOCATE( llvvalid(jvar)%luse(prof%nvprot(jvar)) )
+      END DO
+      IF ( lallpresent ) THEN
+         llvalid%luse(:) = lvalid%luse(:)
+         DO jvar = 1, prof%nvar
+            llvvalid(jvar)%luse(:) = lvvalid(jvar)%luse(:)
+         END DO
+      ELSE
+         llvalid%luse(:) = .TRUE.
+         DO jvar = 1, prof%nvar
+            llvvalid(jvar)%luse(:) = .TRUE.
+         END DO
+      ENDIF
+
+      ! Setup bookkeeping variables
+
+      inprof    = 0
+      invpro(:) = 0
+
+      newprof%npvsta(:,:) =  0
+      newprof%npvend(:,:) = -1
+      
+      ! Loop over source profiles
+
+      DO ji = 1, prof%nprof
+
+         IF ( llvalid%luse(ji) ) THEN
+
+            ! Copy the header information
+
+            inprof = inprof + 1
+
+            newprof%mi(inprof,:)  = prof%mi(ji,:)
+            newprof%mj(inprof,:) = prof%mj(ji,:)
+            newprof%npidx(inprof) = prof%npidx(ji)
+            newprof%npfil(inprof) = prof%npfil(ji)
+            newprof%nyea(inprof)  = prof%nyea(ji)
+            newprof%nmon(inprof)  = prof%nmon(ji)
+            newprof%nday(inprof)  = prof%nday(ji)
+            newprof%nhou(inprof)  = prof%nhou(ji)
+            newprof%nmin(inprof)  = prof%nmin(ji)
+            newprof%mstp(inprof)  = prof%mstp(ji)
+            newprof%nqc(inprof)   = prof%nqc(ji)
+            newprof%ipqc(inprof)  = prof%ipqc(ji)
+            newprof%itqc(inprof)  = prof%itqc(ji)
+            newprof%ivqc(inprof,:)= prof%ivqc(ji,:)
+            newprof%ntyp(inprof)  = prof%ntyp(ji)
+            newprof%rlam(inprof)  = prof%rlam(ji)
+            newprof%rphi(inprof)  = prof%rphi(ji)
+            newprof%cwmo(inprof)  = prof%cwmo(ji)
+            
+            ! QC info
+
+            newprof%nqcf(:,inprof)    = prof%nqcf(:,ji)
+            newprof%ipqcf(:,inprof)   = prof%ipqcf(:,ji)
+            newprof%itqcf(:,inprof)   = prof%itqcf(:,ji)
+            newprof%ivqcf(:,inprof,:) = prof%ivqcf(:,ji,:)
+            
+            ! npind is the index of the original profile
+            
+            newprof%npind(inprof) = ji
+
+            ! Copy the variable information
+
+            DO jvar = 1, prof%nvar
+
+               lfirst = .TRUE.
+               
+               DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar)
+                  
+                  IF ( llvvalid(jvar)%luse(jj) ) THEN
+
+                     invpro(jvar) = invpro(jvar) + 1
+                  
+                     ! Book keeping information
+                                    
+                     IF ( lfirst ) THEN
+                        lfirst = .FALSE.
+                        newprof%npvsta(inprof,jvar) = invpro(jvar)
+                     ENDIF
+                     newprof%npvend(inprof,jvar) = invpro(jvar)
+
+                     ! Variable data
+                     
+                     newprof%var(jvar)%mvk(invpro(jvar))    = &
+                        &                           prof%var(jvar)%mvk(jj)
+                     newprof%var(jvar)%nvpidx(invpro(jvar)) = &
+                        &                           prof%var(jvar)%nvpidx(jj)
+                     newprof%var(jvar)%nvlidx(invpro(jvar)) = &
+                        &                           prof%var(jvar)%nvlidx(jj)
+                     newprof%var(jvar)%nvqc(invpro(jvar))   = &
+                        &                           prof%var(jvar)%nvqc(jj)
+                     newprof%var(jvar)%idqc(invpro(jvar))   = &
+                        &                           prof%var(jvar)%idqc(jj)
+                     newprof%var(jvar)%idqcf(:,invpro(jvar))= &
+                        &                           prof%var(jvar)%idqcf(:,jj)
+                     newprof%var(jvar)%nvqcf(:,invpro(jvar))= &
+                        &                           prof%var(jvar)%nvqcf(:,jj)
+                     newprof%var(jvar)%vdep(invpro(jvar))   = &
+                        &                           prof%var(jvar)%vdep(jj)
+                     newprof%var(jvar)%vobs(invpro(jvar))   = &
+                        &                           prof%var(jvar)%vobs(jj)
+                     newprof%var(jvar)%vmod(invpro(jvar))   = &
+                        &                           prof%var(jvar)%vmod(jj)
+                     DO jext = 1, prof%next
+                        newprof%var(jvar)%vext(invpro(jvar),jext) = &
+                           &                      prof%var(jvar)%vext(jj,jext)
+                     END DO
+                  
+                     ! nvind is the index of the original variable data
+                     
+                     newprof%var(jvar)%nvind(invpro(jvar))  = jj
+                     
+                  ENDIF
+
+               END DO
+
+            END DO
+
+         ENDIF
+
+      END DO
+
+      ! Update MPP counters
+
+      DO jvar = 1, prof%nvar
+         newprof%nvprot(jvar) = invpro(jvar)
+      END DO
+      CALL obs_mpp_sum_integers ( newprof%nvprot, newprof%nvprotmpp,&
+         &                        prof%nvar )
+      
+      ! Set book keeping variables which do not depend on number of obs.
+
+      newprof%nvar     = prof%nvar
+      newprof%next     = prof%next
+      newprof%nstp     = prof%nstp
+      newprof%npi      = prof%npi
+      newprof%npj      = prof%npj
+      newprof%npk      = prof%npk
+ 
+      ! Deallocate temporary data
+
+      DO jvar = 1, prof%nvar
+         DEALLOCATE( llvvalid(jvar)%luse )
+      END DO
+ 
+      DEALLOCATE( llvalid%luse )
+     
+   END SUBROUTINE obs_prof_compress
+
+   SUBROUTINE obs_prof_decompress( prof, oldprof, ldeallocate, kumout )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_decompress  ***
+      !!                      
+      !! ** Purpose : - Copy back information to original profile type
+      !!
+      !! ** Method  : - Reinsert updated information from a previous
+      !!                copied/compressed profile type into the original
+      !!                profile data and optionally deallocate the prof
+      !!                data input
+      !! 
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof),INTENT(INOUT) :: prof      ! Updated profile data
+      TYPE(obs_prof),INTENT(INOUT) :: oldprof   ! Original profile data
+      LOGICAL :: ldeallocate         ! Deallocate the updated data of insertion
+      INTEGER,INTENT(in) :: kumout   ! Output unit
+      
+      !!* Local variables
+      INTEGER :: jvar
+      INTEGER :: jext
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jl
+
+      DO ji = 1, prof%nprof
+
+         ! Copy header information
+         
+         jk = prof%npind(ji)
+      
+         oldprof%mi(jk,:)  = prof%mi(ji,:)
+         oldprof%mj(jk,:)  = prof%mj(ji,:)
+         oldprof%npidx(jk) = prof%npidx(ji)
+         oldprof%npfil(jk) = prof%npfil(ji)
+         oldprof%nyea(jk)  = prof%nyea(ji)
+         oldprof%nmon(jk)  = prof%nmon(ji)
+         oldprof%nday(jk)  = prof%nday(ji)
+         oldprof%nhou(jk)  = prof%nhou(ji)
+         oldprof%nmin(jk)  = prof%nmin(ji)
+         oldprof%mstp(jk)  = prof%mstp(ji)
+         oldprof%nqc(jk)   = prof%nqc(ji)
+         oldprof%ipqc(jk)  = prof%ipqc(ji)
+         oldprof%itqc(jk)  = prof%itqc(ji)
+         oldprof%ivqc(jk,:)= prof%ivqc(ji,:)
+         oldprof%ntyp(jk)  = prof%ntyp(ji)
+         oldprof%rlam(jk)  = prof%rlam(ji)
+         oldprof%rphi(jk)  = prof%rphi(ji)
+         oldprof%cwmo(jk)  = prof%cwmo(ji)
+         
+         ! QC info
+
+         oldprof%nqcf(:,jk)    = prof%nqcf(:,ji)
+         oldprof%ipqcf(:,jk)   = prof%ipqcf(:,ji)
+         oldprof%itqcf(:,jk)   = prof%itqcf(:,ji)
+         oldprof%ivqcf(:,jk,:) = prof%ivqcf(:,ji,:)
+
+         ! Copy the variable information
+
+         DO jvar = 1, prof%nvar
+
+            DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar)
+               
+               jl = prof%var(jvar)%nvind(jj)
+
+               oldprof%var(jvar)%mvk(jl)    = prof%var(jvar)%mvk(jj)
+               oldprof%var(jvar)%nvpidx(jl) = prof%var(jvar)%nvpidx(jj)
+               oldprof%var(jvar)%nvlidx(jl) = prof%var(jvar)%nvlidx(jj)
+               oldprof%var(jvar)%nvqc(jl)   = prof%var(jvar)%nvqc(jj)
+               oldprof%var(jvar)%idqc(jl)   = prof%var(jvar)%idqc(jj)
+               oldprof%var(jvar)%vdep(jl)   = prof%var(jvar)%vdep(jj)
+               oldprof%var(jvar)%vobs(jl)   = prof%var(jvar)%vobs(jj)
+               oldprof%var(jvar)%vmod(jl)   = prof%var(jvar)%vmod(jj)
+               oldprof%var(jvar)%idqcf(:,jl) = prof%var(jvar)%idqcf(:,jj)
+               oldprof%var(jvar)%nvqcf(:,jl) = prof%var(jvar)%nvqcf(:,jj)
+               DO jext = 1, prof%next
+                  oldprof%var(jvar)%vext(jl,jext) = &
+                     &                        prof%var(jvar)%vext(jj,jext)
+               END DO
+               
+            END DO
+
+         END DO
+         
+      END DO
+
+      ! Optionally deallocate the updated profile data
+
+      IF ( ldeallocate ) CALL obs_prof_dealloc( prof )
+      
+   END SUBROUTINE obs_prof_decompress
+
+   SUBROUTINE obs_prof_staend( prof, kvarno )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_decompress  ***
+      !!                      
+      !! ** Purpose : - Set npvsta and npvend of a variable within 
+      !!                an obs_prof_var type
+      !!
+      !! ** Method  : - Find the start and stop of a profile by searching 
+      !!                through the data
+      !! 
+      !! History :
+      !!        !  07-04  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof),INTENT(INOUT) :: prof     ! Profile data
+      INTEGER,INTENT(IN) :: kvarno     ! Variable number
+
+      !!* Local variables
+      INTEGER :: ji
+      INTEGER :: iprofno
+
+      !-----------------------------------------------------------------------
+      ! Compute start and end bookkeeping arrays
+      !-----------------------------------------------------------------------
+
+      prof%npvsta(:,kvarno) = prof%nvprot(kvarno) + 1
+      prof%npvend(:,kvarno) = -1
+      DO ji = 1, prof%nvprot(kvarno)
+         iprofno = prof%var(kvarno)%nvpidx(ji)
+         prof%npvsta(iprofno,kvarno) = &
+            & MIN( ji, prof%npvsta(iprofno,kvarno) )
+         prof%npvend(iprofno,kvarno) = &
+            & MAX( ji, prof%npvend(iprofno,kvarno) )
+      END DO
+
+      DO ji = 1, prof%nprof
+         IF ( prof%npvsta(ji,kvarno) == ( prof%nvprot(kvarno) + 1 ) ) &
+            & prof%npvsta(ji,kvarno) = 0
+      END DO
+
+   END SUBROUTINE obs_prof_staend
+   
+END MODULE obs_profiles_def
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 2236)
@@ -0,0 +1,206 @@
+MODULE obs_read_altbias
+   !!======================================================================
+   !!                       ***  MODULE obs_readaltbias  ***
+   !! Observation diagnostics: Read the bias for SLA data
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_altbias : Driver for reading altimeter bias
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp, &
+      & dp, &
+      & sp
+   USE par_oce, ONLY : &        ! Domain parameters
+      & jpi, &
+      & jpj, &
+      & jpim1
+   USE in_out_manager, ONLY : & ! I/O manager
+      & lwp,    &
+      & numout 
+   USE obs_surf_def             ! Surface observation definitions
+   USE dom_oce, ONLY : &        ! Domain variables
+      & tmask, &
+      & tmask_i, &
+      & e1t,   &
+      & e2t,   &
+      & gphit
+   USE oce, ONLY : &           ! Model variables
+      & sshn
+   USE obs_inter_h2d
+   USE obs_utils               ! Various observation tools
+   USE obs_inter_sup
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_altbias     ! Read the altimeter bias
+
+CONTAINS
+
+   SUBROUTINE obs_rea_altbias( kslano, sladata, k2dint, bias_file )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_altbias ***
+      !!
+      !! ** Purpose : Read from file the bias data 
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!
+      !! History :  
+      !!      ! :  2008-02 (D. Lea) Initial version
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products
+      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
+         & sladata       ! SLA data
+      INTEGER, INTENT(IN) :: k2dint
+      CHARACTER(LEN=128) :: bias_file
+
+      !! * Local declarations
+
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias'
+
+      INTEGER :: jslano       ! Data set loop variable
+      INTEGER :: jobs         ! Obs loop variable
+      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias
+      INTEGER :: jpjaltbias   ! Number of grid point in longitude for the bias
+      INTEGER :: iico         ! Grid point indicies
+      INTEGER :: ijco
+      INTEGER :: i_nx_id      ! Index to read the NetCDF file
+      INTEGER :: i_ny_id      ! 
+      INTEGER :: i_file_id    ! 
+      INTEGER :: i_var_id
+
+      REAL(wp), DIMENSION(jpi,jpj) :: & 
+         & z_altbias           ! Array to store the alt bias values
+      REAL(wp), DIMENSION(1) :: &
+         & zext, &
+         & zobsmask
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zbias, &
+         & zglam, &
+         & zgphi
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+      INTEGER :: numaltbias
+
+      IF(lwp)WRITE(numout,*) 
+      IF(lwp)WRITE(numout,*) ' obs_rea_altbias : '
+      IF(lwp)WRITE(numout,*) ' ------------- '
+      IF(lwp)WRITE(numout,*) '   Read altimeter bias'
+
+      ! Open the file
+
+      z_altbias(:,:)=0.0_wp
+      numaltbias=0
+
+      IF(lwp)WRITE(numout,*) 'Opening ',bias_file
+
+      CALL iom_open( bias_file, numaltbias, ldstop=.FALSE. )
+      
+
+      IF (numaltbias .GT. 0) THEN      
+
+         ! Get the Alt bias data
+         
+         CALL iom_get( numaltbias, jpdom_data, 'altbias', z_altbias(:,:), 1 )
+         
+         ! Close the file
+         
+         CALL iom_close(numaltbias)     
+         
+      ELSE
+
+         IF(lwp)WRITE(numout,*) 'no file found'
+      
+      ENDIF
+
+      ! Intepolate the bias already on the model grid at the observation point
+  
+      DO jslano = 1, kslano
+
+         ALLOCATE( &
+            & igrdi(2,2,sladata(jslano)%nsurf), &
+            & igrdj(2,2,sladata(jslano)%nsurf), &
+            & zglam(2,2,sladata(jslano)%nsurf), &
+            & zgphi(2,2,sladata(jslano)%nsurf), &
+            & zmask(2,2,sladata(jslano)%nsurf), &
+            & zbias(2,2,sladata(jslano)%nsurf)  &
+            & )
+         
+         DO jobs = 1, sladata(jslano)%nsurf
+
+            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
+            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
+
+         END DO
+
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, glamt, zglam )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, gphit, zgphi )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, tmask(:,:,1), zmask )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, z_altbias, zbias )
+
+         DO jobs = 1, sladata(jslano)%nsurf
+
+            zlam = sladata(jslano)%rlam(jobs)
+            zphi = sladata(jslano)%rphi(jobs)
+            iico = sladata(jslano)%mi(jobs)
+            ijco = sladata(jslano)%mj(jobs)
+            
+            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+               &                   zmask(:,:,jobs), zweig, zobsmask )
+            
+            CALL obs_int_h2d( 1, 1,      &
+               &              zweig, zbias(:,:,jobs),  zext )
+
+            ! adjust mdt with bias field
+            sladata(jslano)%rext(jobs,2) = &
+               sladata(jslano)%rext(jobs,2) - zext(1)
+            
+         END DO
+
+         DEALLOCATE( &
+            & igrdi, &
+            & igrdj, &
+            & zglam, &
+            & zgphi, &
+            & zmask, &
+            & zbias  &
+            & )
+         
+      END DO
+
+   END SUBROUTINE obs_rea_altbias
+
+
+ 
+END MODULE obs_read_altbias
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_prof.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 2236)
@@ -0,0 +1,821 @@
+MODULE obs_read_prof
+   !!======================================================================
+   !!                       ***  MODULE obs_read_prof  ***
+   !! Observation diagnostics: Read the T and S profile observations
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_pro_dri : Driver for reading profile obs
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE par_oce                  ! Ocean parameters
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_prep                 ! Prepare observation arrays
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_profiles_def         ! Profile definitions
+   USE obs_conv                 ! Various conversion routines
+   USE obs_types                ! Observation type definitions
+   USE netcdf                   ! NetCDF library
+   USE obs_oper                 ! Observation operators
+   USE obs_prof_io              ! Profile files I/O (non-FB files)
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_pro_dri  ! Read the profile observations 
+
+CONTAINS
+ 
+   SUBROUTINE obs_rea_pro_dri( kformat, &
+      &                        profdata, knumfiles, cfilenames, &
+      &                        kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                        ldt3d, lds3d, ldignmis, ldsatt, ldavtimset, &
+      &                        ldmod, kdailyavtypes )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_pro_dri ***
+      !!
+      !! ** Purpose : Read from file the profile observations
+      !!
+      !! ** Method  : Depending on kformat either ENACT, CORIOLIS or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines
+      !!----------------------------------------------------------------------
+      !! * Modules used
+   
+      !! * Arguments
+      INTEGER ::  kformat    ! Format of input data
+      !                      ! 1: ENACT
+      !                      ! 2: Coriolis
+      TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read
+      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in
+      CHARACTER(LEN=128), INTENT(IN) ::  &
+         & cfilenames(knumfiles)  ! File names to read in
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata
+      INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldt3d       ! Observed variables switches
+      LOGICAL, INTENT(IN) :: lds3d
+      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldsatt      ! Compute salinity at all temperature points
+      LOGICAL, INTENT(IN) :: ldavtimset  ! Correct time for daily averaged data
+      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes
+
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_pro_dri'
+      INTEGER :: jvar
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: ij
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER, DIMENSION(ntyp1770+1) :: &
+         & itypt,    &
+         & ityptmpp, &
+         & ityps,    &
+         & itypsmpp 
+      INTEGER :: it3dtmpp
+      INTEGER :: is3dtmpp
+      INTEGER :: ip3dtmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & iprofidx
+      INTEGER :: itype
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iprof
+      INTEGER :: iproftot
+      INTEGER :: it3dt0
+      INTEGER :: is3dt0
+      INTEGER :: it3dt
+      INTEGER :: is3dt
+      INTEGER :: ip3dt
+      INTEGER, DIMENSION(kvars) :: &
+         & iv3dt
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iprof = 0
+      it3dt0 = 0
+      is3dt0 = 0
+      ip3dt = 0
+
+      ! Daily average types
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         idailyavtypes(:) = kdailyavtypes(:)
+      ELSE
+         idailyavtypes(:) = -1
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      prof_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_pro_dri : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( inpfiles(jj)%nvar < 2 ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'POTM' ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%cname(2)) /= 'PSAL' ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1 ) THEN
+               CALL read_enactfile( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                 numout, lwp, .TRUE. )
+            ELSEIF ( kformat == 2 ) THEN
+               CALL read_coriofile( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                 numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+            
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+
+            IF ( ldavtimset ) THEN
+               DO ji = 1, inpfiles(jj)%nobs
+                  ! 
+                  !  for daily averaged data for example
+                  !  MRB data (itype==820) force the time
+                  !  to be the  end of the day
+                  !
+                  READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+                  IF ( ANY (idailyavtypes == itype ) ) THEN
+                     inpfiles(jj)%ptim(ji) = &
+                     & INT(inpfiles(jj)%ptim(ji)) + 1
+                  ENDIF
+               END DO
+            ENDIF
+            
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ldt3d ) THEN
+                     loop_t_count : DO ij = 1,inpfiles(jj)%nlev
+                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                           & CYCLE
+                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                           it3dt0 = it3dt0 + 1
+                        ENDIF
+                     END DO loop_t_count
+                  ENDIF
+                  IF ( lds3d ) THEN
+                     loop_s_count : DO ij = 1,inpfiles(jj)%nlev
+                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                           & CYCLE
+                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                           is3dt0 = is3dt0 + 1
+                        ENDIF
+                     END DO loop_s_count
+                  ENDIF
+                  loop_p_count : DO ij = 1,inpfiles(jj)%nlev
+                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                        & CYCLE
+                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     ldt3d ) .OR. &
+                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     lds3d ) ) THEN
+                        ip3dt = ip3dt + 1
+                        llvalprof = .TRUE.
+                     ENDIF
+                  END DO loop_p_count
+
+                  IF ( llvalprof ) iprof = iprof + 1
+
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO prof_files
+      
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iproftot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+               & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iproftot = iproftot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iproftot), ifileidx(iproftot), &
+         &      iprofidx(iproftot), zdat(iproftot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+               & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               iprofidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iproftot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      iv3dt(:) = -1
+      IF (ldsatt) THEN
+         iv3dt(1) = ip3dt
+         iv3dt(2) = ip3dt
+      ELSE
+         iv3dt(1) = it3dt0
+         iv3dt(2) = is3dt0
+      ENDIF
+      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
+         &                 kstp, jpi, jpj, jpk )
+      
+      ! * Read obs/positions, QC, all variable and assign to profdata
+
+      profdata%nprof     = 0
+      profdata%nvprot(:) = 0
+
+      iprof = 0
+
+      ip3dt = 0
+      it3dt = 0
+      is3dt = 0
+      itypt   (:) = 0
+      ityptmpp(:) = 0
+      
+      ityps   (:) = 0
+      itypsmpp(:) = 0
+      
+      
+      DO jk = 1, iproftot
+         
+         jj = ifileidx(iindx(jk))
+         ji = iprofidx(iindx(jk))
+
+         IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+         IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+            & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            llvalprof = .FALSE.
+
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+
+            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+               & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE
+
+            loop_prof : DO ij = 1, inpfiles(jj)%nlev
+               
+               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                  & CYCLE
+               
+               IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                  
+                  llvalprof = .TRUE. 
+                  EXIT loop_prof
+                  
+               ENDIF
+               
+               IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                  
+                  llvalprof = .TRUE. 
+                  EXIT loop_prof
+                  
+               ENDIF
+               
+            END DO loop_prof
+            
+            ! Set profile information
+            
+            IF ( llvalprof ) THEN
+               
+               iprof = iprof + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! Profile time coordinates
+               profdata%nyea(iprof) = iyea
+               profdata%nmon(iprof) = imon
+               profdata%nday(iprof) = iday
+               profdata%nhou(iprof) = ihou
+               profdata%nmin(iprof) = imin
+               
+               ! Profile space coordinates
+               profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
+               profdata%rphi(iprof) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               profdata%mi  (iprof,:) = inpfiles(jj)%iobsi(ji,1)
+               profdata%mj  (iprof,:) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Profile WMO number
+               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               profdata%ntyp(iprof) = itype
+               
+               ! QC stuff
+
+               profdata%nqc(iprof)     = inpfiles(jj)%ioqc(ji)
+               profdata%nqcf(:,iprof)  = inpfiles(jj)%ioqcf(:,ji)
+               profdata%ipqc(iprof)    = inpfiles(jj)%ipqc(ji)
+               profdata%ipqcf(:,iprof) = inpfiles(jj)%ipqcf(:,ji)
+               profdata%itqc(iprof)    = inpfiles(jj)%itqc(ji)
+               profdata%itqcf(:,iprof) = inpfiles(jj)%itqcf(:,ji)
+               profdata%ivqc(iprof,:)  = inpfiles(jj)%ivqc(ji,:)
+               profdata%ivqcf(:,iprof,:) = inpfiles(jj)%ivqcf(:,ji,:)
+
+               ! Bookkeeping data to match profiles
+               profdata%npidx(iprof) = iprof
+               profdata%npfil(iprof) = iindx(jk)
+
+               ! Observation QC flag (whole profile)
+               profdata%nqc(iprof)  = 0 !TODO
+
+               loop_p : DO ij = 1, inpfiles(jj)%nlev            
+                  
+                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                     & CYCLE
+
+                  IF (ldsatt) THEN
+
+                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     ldt3d ) .OR. &
+                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     lds3d ) ) THEN
+                        ip3dt = ip3dt + 1
+                     ELSE
+                        CYCLE
+                     ENDIF
+                     
+                  ENDIF
+
+                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                     &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                     &       ldt3d ) .OR. ldsatt ) THEN
+                     
+                     IF (ldsatt) THEN
+
+                        it3dt = ip3dt
+
+                     ELSE
+
+                        it3dt = it3dt + 1
+                        
+                     ENDIF
+
+                     ! Depth of T observation
+                     profdata%var(1)%vdep(it3dt) = &
+                        &                inpfiles(jj)%pdep(ij,ji)
+                     
+                     ! Depth of T observation QC
+                     profdata%var(1)%idqc(it3dt) = &
+                        &                inpfiles(jj)%idqc(ij,ji)
+                     
+                     ! Depth of T observation QC flags
+                     profdata%var(1)%idqcf(:,it3dt) = &
+                        &                inpfiles(jj)%idqcf(:,ij,ji)
+                     
+                     ! Profile index
+                     profdata%var(1)%nvpidx(it3dt) = iprof
+                     
+                     ! Vertical index in original profile
+                     profdata%var(1)%nvlidx(it3dt) = ij
+
+                     ! Profile potential T value
+                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                        profdata%var(1)%vobs(it3dt) = &
+                           &                inpfiles(jj)%pob(ij,ji,1)
+                        IF ( ldmod ) THEN
+                           profdata%var(1)%vmod(it3dt) = &
+                              &                inpfiles(jj)%padd(ij,ji,1,1)
+                        ENDIF
+                        ! Count number of profile T data as function of type
+                        itypt( profdata%ntyp(iprof) + 1 ) = &
+                           & itypt( profdata%ntyp(iprof) + 1 ) + 1
+                     ELSE
+                        profdata%var(1)%vobs(it3dt) = fbrmdi
+                     ENDIF
+
+                     ! Profile T qc
+                     profdata%var(1)%nvqc(it3dt) = &
+                        & inpfiles(jj)%ivlqc(ij,ji,1)
+
+                     ! Profile T qc flags
+                     profdata%var(1)%nvqcf(:,it3dt) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,1)
+
+                     ! Profile insitu T value
+                     profdata%var(1)%vext(it3dt,1) = &
+                        &                inpfiles(jj)%pext(ij,ji,1)
+                     
+                  ENDIF
+                  
+                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                     &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                     &   lds3d ) .OR. ldsatt ) THEN
+                     
+                     IF (ldsatt) THEN
+
+                        is3dt = ip3dt
+
+                     ELSE
+
+                        is3dt = is3dt + 1
+                        
+                     ENDIF
+
+                     ! Depth of S observation
+                     profdata%var(2)%vdep(is3dt) = &
+                        &                inpfiles(jj)%pdep(ij,ji)
+                     
+                     ! Depth of S observation QC
+                     profdata%var(2)%idqc(is3dt) = &
+                        &                inpfiles(jj)%idqc(ij,ji)
+                     
+                     ! Depth of S observation QC flags
+                     profdata%var(2)%idqcf(:,is3dt) = &
+                        &                inpfiles(jj)%idqcf(:,ij,ji)
+                     
+                     ! Profile index
+                     profdata%var(2)%nvpidx(is3dt) = iprof
+                     
+                     ! Vertical index in original profile
+                     profdata%var(2)%nvlidx(is3dt) = ij
+
+                     ! Profile S value
+                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                        profdata%var(2)%vobs(is3dt) = &
+                           &                inpfiles(jj)%pob(ij,ji,2)
+                        IF ( ldmod ) THEN
+                           profdata%var(2)%vmod(is3dt) = &
+                              &                inpfiles(jj)%padd(ij,ji,1,2)
+                        ENDIF
+                        ! Count number of profile S data as function of type
+                        ityps( profdata%ntyp(iprof) + 1 ) = &
+                           & ityps( profdata%ntyp(iprof) + 1 ) + 1
+                     ELSE
+                        profdata%var(2)%vobs(is3dt) = fbrmdi
+                     ENDIF
+                     
+                     ! Profile S qc
+                     profdata%var(2)%nvqc(is3dt) = &
+                        & inpfiles(jj)%ivlqc(ij,ji,2)
+
+                     ! Profile S qc flags
+                     profdata%var(2)%nvqcf(:,is3dt) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,2)
+
+                  ENDIF
+            
+               END DO loop_p
+
+            ENDIF
+
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer ( it3dt0, it3dtmpp )
+      CALL obs_mpp_sum_integer ( is3dt0, is3dtmpp )
+      CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp )
+      
+      CALL obs_mpp_sum_integers( itypt, ityptmpp, ntyp1770 + 1 )
+      CALL obs_mpp_sum_integers( ityps, itypsmpp, ntyp1770 + 1 )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile data'
+         WRITE(numout,'(1X,A)') '------------'
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile T data'
+         WRITE(numout,'(1X,A)') '--------------'
+         DO ji = 0, ntyp1770
+            IF ( ityptmpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
+                  & cwmonam1770(ji)(1:52),' = ', &
+                  & ityptmpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A55,I8)') &
+            & 'Total profile T data                                 = ',&
+            & it3dtmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile S data'
+         WRITE(numout,'(1X,A)') '--------------'
+         DO ji = 0, ntyp1770
+            IF ( itypsmpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
+                  & cwmonam1770(ji)(1:52),' = ', &
+                  & itypsmpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A55,I8)') &
+            & 'Total profile S data                                 = ',&
+            & is3dtmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,*) 
+      ENDIF
+      
+      IF (ldsatt) THEN
+         profdata%nvprot(1)    = ip3dt
+         profdata%nvprot(2)    = ip3dt
+         profdata%nvprotmpp(1) = ip3dtmpp
+         profdata%nvprotmpp(2) = ip3dtmpp
+      ELSE
+         profdata%nvprot(1)    = it3dt
+         profdata%nvprot(2)    = is3dt
+         profdata%nvprotmpp(1) = it3dtmpp
+         profdata%nvprotmpp(2) = is3dtmpp
+      ENDIF
+      profdata%nprof        = iprof
+
+      !-----------------------------------------------------------------------
+      ! Model level search
+      !-----------------------------------------------------------------------
+      IF ( ldt3d ) THEN
+         CALL obs_level_search( jpk, gdept_0, &
+            & profdata%nvprot(1), profdata%var(1)%vdep, &
+            & profdata%var(1)%mvk )
+      ENDIF
+      IF ( lds3d ) THEN
+         CALL obs_level_search( jpk, gdept_0, &
+            & profdata%nvprot(2), profdata%var(2)%vdep, &
+            & profdata%var(2)%mvk )
+      ENDIF
+      
+      !-----------------------------------------------------------------------
+      ! Set model equivalent to 99999
+      !-----------------------------------------------------------------------
+      IF ( .NOT. ldmod ) THEN
+         DO jvar = 1, kvars
+            profdata%var(jvar)%vmod(:) = fbrmdi
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iprofidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_pro_dri
+
+END MODULE obs_read_prof
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_seaice.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_seaice.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_seaice.F90	(revision 2236)
@@ -0,0 +1,450 @@
+MODULE obs_read_seaice
+   !!======================================================================
+   !!                       ***  MODULE obs_read_seaice  ***
+   !! Observation diagnostics: Read the along track SEAICE data from
+   !!                          GHRSST or any SEAICE data from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_seaice : Driver for reading seaice data from the GHRSST/feedback
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_seaice_io            ! I/O for seaice files
+   USE iom                      ! I/O of fields for Reynolds data
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_seaice      ! Read the seaice observations from the point data
+
+   
+CONTAINS
+
+   SUBROUTINE obs_rea_seaice( kformat, &
+      &                    seaicedata, knumfiles, cfilenames, &
+      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                    ldignmis, ldmod )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_seaice ***
+      !!
+      !! ** Purpose : Read from file the seaice data
+      !!
+      !! ** Method  : Depending on kformat either AVISO or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: kformat   ! Format of input data 
+      !                    ! 0: Feedback
+      !                    ! 1: GHRSST
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & seaicedata     ! seaice data to be read
+      INTEGER, INTENT(IN) :: knumfiles   ! Number of corio format files to read in
+      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars    ! Number of variables in seaicedata
+      INTEGER, INTENT(IN) :: kextr    ! Number of extra fields for each var in seaicedata
+      INTEGER, INTENT(IN) :: kstp     ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+         
+      !! * Local declarations
+      CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_seaice'
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER :: iobsmpp
+      INTEGER, PARAMETER :: iseaicemaxtype = 1024
+      INTEGER, DIMENSION(0:iseaicemaxtype) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & iseaiceidx
+      INTEGER :: itype
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iobs = 0
+ 
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      seaice_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_seaice : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.&
+                  &               ( inpfiles(jj)%next < 2 ) ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1) THEN
+               CALL read_seaice( TRIM( cfilenames(jj) ), inpfiles(jj), &
+               &                 numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO seaice_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      iseaiceidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               iseaiceidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      CALL obs_surf_alloc( seaicedata, iobs, kvars, kextr, kstp )
+      
+      ! * Read obs/positions, QC, all variable and assign to seaicedata
+ 
+      iobs = 0
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+      
+      DO jk = 1, iobstot
+         
+         jj = ifileidx(iindx(jk))
+         ji = iseaiceidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            ! Set observation information
+            
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! seaice time coordinates
+               seaicedata%nyea(iobs) = iyea
+               seaicedata%nmon(iobs) = imon
+               seaicedata%nday(iobs) = iday
+               seaicedata%nhou(iobs) = ihou
+               seaicedata%nmin(iobs) = imin
+               
+               ! seaice space coordinates
+               seaicedata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               seaicedata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               seaicedata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               seaicedata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               seaicedata%ntyp(iobs) = itype
+               IF ( itype < iseaicemaxtype + 1 ) THEN
+                  ityp(itype+1) = ityp(itype+1) + 1
+               ELSE
+                  IF(lwp)WRITE(numout,*)'WARNING:Increase iseaicemaxtype in ',&
+                     &                  cpname
+               ENDIF
+
+               ! Bookkeeping data to match observations
+               seaicedata%nsidx(iobs) = iobs
+               seaicedata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               seaicedata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               seaicedata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  seaicedata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+               ELSE
+                  seaicedata%rmod(iobs,1) = fbrmdi
+               ENDIF
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')'Seaice data types'
+         WRITE(numout,'(1X,A)')'-----------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
+         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iseaiceidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_seaice
+
+END MODULE obs_read_seaice
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_sla.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_sla.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_sla.F90	(revision 2236)
@@ -0,0 +1,533 @@
+MODULE obs_read_sla
+   !!======================================================================
+   !!                       ***  MODULE obs_read_sla  ***
+   !! Observation diagnostics: Read the along track SLA data from
+   !!                          the AVISO/CLS database or any SLA data 
+   !!                          from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_sla : Driver for reading SLA data from the AVISO/CLS/feedback
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_sla_io               ! I/O for sla files
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_sla  ! Read the SLA observations from the AVISO/SLA database
+
+CONTAINS
+
+   SUBROUTINE obs_rea_sla( kformat, &
+      &                    sladata, knumfiles, cfilenames, &
+      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                    ldignmis, ldmod, ldobstd )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_sla ***
+      !!
+      !! ** Purpose : Read from file the SLA data
+      !!
+      !! ** Method  : Depending on kformat either AVISO or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: kformat    ! Format of input data
+      !                     ! 0: Feedback
+      !                     ! 1: AVISO
+      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! SLA data to be read
+      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in
+      CHARACTER(LEN=128), INTENT(IN) ::  &
+         & cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars     ! Number of variables in sladata
+      INTEGER, INTENT(IN) :: kextr     ! Number of extra fields for each var in sladata
+      INTEGER, INTENT(IN) :: kstp      ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
+      LOGICAL, INTENT(INOUT), optional :: &
+         & ldobstd        ! Read observation standard deviation from fb. file
+      REAL(KIND=dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS
+         
+      !! * Local declarations
+      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sla'
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER :: iobsmpp
+      INTEGER, DIMENSION(imaxmissions+1) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & islaidx
+      INTEGER :: itype 
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      LOGICAL :: llobstd
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER, DIMENSION(knumfiles) :: &
+         & iobspos, &
+         & iobcpos
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iobs = 0
+      IF ( PRESENT(ldobstd) ) THEN
+         IF (.NOT.ldmod) THEN
+            llobstd = .false.
+         ELSE
+            llobstd = ldobstd
+         ENDIF
+      ELSE
+         llobstd = .FALSE.
+      ENDIF
+ 
+      !-----------------------------------------------------------------------
+      ! Check that the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Check that the prescribed obs err is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( llobstd .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Observation error can only be read from feedback files' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      sla_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_sla : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( inpfiles(jj)%nvar < 1 ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'SLA' ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF 
+               IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.&
+                  &               ( inpfiles(jj)%next == 0 ) ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1) THEN
+               CALL read_avisofile( TRIM( cfilenames(jj) ), inpfiles(jj), &
+               &                    numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+      
+      END DO sla_files
+
+      IF (llobstd) THEN
+         
+         DO jj = 1, inobf
+            iobspos(jj) = -1
+            iobcpos(jj) = -1
+            DO ji = 1,inpfiles(jj)%nadd
+               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OSTD' ) THEN
+                  iobspos(jj)=ji
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OCNT' ) THEN
+                  iobcpos(jj)=ji
+               ENDIF
+            END DO
+         END DO
+         llobstd = ( ( MINVAL(iobspos) > 0 ) .AND. ( MINVAL(iobcpos) > 0 ) )
+         IF (llobstd) THEN
+            IF (lwp) WRITE(numout,*)'SLA superobs information present.'
+         ELSE
+            IF (lwp) WRITE(numout,*)'SLA superobs information not present.'
+         ENDIF
+
+      ENDIF
+      
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      islaidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               islaidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      CALL obs_surf_alloc( sladata, iobs, kvars, kextr, kstp )
+      
+      ! * Read obs/positions, QC, all variable and assign to sladata
+ 
+      iobs = 0
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+      
+      DO jk = 1, iobstot
+         
+         jj = ifileidx(iindx(jk))
+         ji = islaidx(iindx(jk))
+
+         IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+         IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            ! Set observation information
+            
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! SLA time coordinates
+               sladata%nyea(iobs) = iyea
+               sladata%nmon(iobs) = imon
+               sladata%nday(iobs) = iday
+               sladata%nhou(iobs) = ihou
+               sladata%nmin(iobs) = imin
+               
+               ! SLA space coordinates
+               sladata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               sladata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               sladata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               sladata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               sladata%ntyp(iobs) = itype
+               ityp(itype+1) = ityp(itype+1) + 1
+
+               ! Identifier
+               sladata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji)
+
+               ! Bookkeeping data to match observations
+               sladata%nsidx(iobs) = iobs
+               sladata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               sladata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               sladata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  sladata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+                  sladata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1)
+                  sladata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1)
+                  IF (llobstd) THEN
+                     sladata%rext(iobs,3) = &
+                        & inpfiles(jj)%padd(1,ji,iobspos(jj),1)
+                     sladata%rext(iobs,4) = &
+                        & inpfiles(jj)%padd(1,ji,iobcpos(jj),1)
+                  ENDIF
+               ELSE
+                  sladata%rmod(iobs,1) = fbrmdi
+                  sladata%rext(iobs,:) = fbrmdi
+               ENDIF
+
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      CALL obs_mpp_sum_integers( ityp, itypmpp, imaxmissions + 1 )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')'Altimeter satellites'
+         WRITE(numout,'(1X,A)')'--------------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A38,A2,I10)')calttyp(jj-1),'= ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
+         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, islaidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+      !-----------------------------------------------------------------------
+      ! Reset ldobstd if the data is present
+      !-----------------------------------------------------------------------
+      IF ( PRESENT(ldobstd) ) THEN
+         ldobstd = llobstd
+      ENDIF
+
+   END SUBROUTINE obs_rea_sla
+
+END MODULE obs_read_sla
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_sst.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_sst.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_sst.F90	(revision 2236)
@@ -0,0 +1,756 @@
+MODULE obs_read_sst
+   !!======================================================================
+   !!                       ***  MODULE obs_read_sst  ***
+   !! Observation diagnostics: Read the SST data from the GHRSST database 
+   !!                          or any SST data from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_sst : Driver for reading SST data from the GHRSST/feedback
+   !!   obs_rea_sst_rey : Driver for reading SST data from Reynolds
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_sst_io               ! I/O for sst files
+   USE iom                      ! I/O of fields for Reynolds data
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_sst      ! Read the SST observations from the point data
+   PUBLIC obs_rea_sst_rey  ! Read the gridded Reynolds SST 
+   
+CONTAINS
+
+   SUBROUTINE obs_rea_sst( kformat, &
+      &                    sstdata, knumfiles, cfilenames, &
+      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                    ldignmis, ldmod )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_sst ***
+      !!
+      !! ** Purpose : Read from file the SST data
+      !!
+      !! ** Method  : Depending on kformat either AVISO or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: kformat   ! Format of input data
+      !                    ! 0: Feedback
+      !                    ! 1: GHRSST
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata   ! SST data to be read
+      INTEGER, INTENT(IN) :: knumfiles    ! Number of corio format files to read in
+      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in sstdata
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
+         
+      !! * Local declarations
+      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sst'
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: irefdate
+      INTEGER :: iobsmpp
+      INTEGER, PARAMETER :: isstmaxtype = 1024
+      INTEGER, DIMENSION(0:isstmaxtype) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & isstidx
+      INTEGER :: itype
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iobs = 0
+ 
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      sst_files : DO jj = 1, inobf
+
+         CALL init_obfbdata( inpfiles(jj) )
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_sst : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1) THEN
+               CALL read_ghrsst( TRIM( cfilenames(jj) ), inpfiles(jj), &
+               &                 numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO sst_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      isstidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               isstidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      CALL obs_surf_alloc( sstdata, iobs, kvars, kextr, kstp )
+      
+      ! * Read obs/positions, QC, all variable and assign to sstdata
+ 
+      iobs = 0
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+      
+      DO jk = 1, iobstot
+         
+         jj = ifileidx(iindx(jk))
+         ji = isstidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            ! Set observation information
+            
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! SST time coordinates
+               sstdata%nyea(iobs) = iyea
+               sstdata%nmon(iobs) = imon
+               sstdata%nday(iobs) = iday
+               sstdata%nhou(iobs) = ihou
+               sstdata%nmin(iobs) = imin
+               
+               ! SST space coordinates
+               sstdata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               sstdata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               sstdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               sstdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               sstdata%ntyp(iobs) = itype
+               IF ( itype < isstmaxtype + 1 ) THEN
+                  ityp(itype+1) = ityp(itype+1) + 1
+               ELSE
+                  IF(lwp)WRITE(numout,*)'WARNING:Increase isstmaxtype in ',&
+                     &                  cpname
+               ENDIF
+
+               ! Bookkeeping data to match observations
+               sstdata%nsidx(iobs) = iobs
+               sstdata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               sstdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               sstdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  sstdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+               ELSE
+                  sstdata%rmod(iobs,1) = fbrmdi
+               ENDIF
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')'SST data types'
+         WRITE(numout,'(1X,A)')'--------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
+         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, isstidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         IF ( inpfiles(jj)%lalloc ) THEN
+            CALL dealloc_obfbdata( inpfiles(jj) )
+         ENDIF
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_sst
+
+   SUBROUTINE obs_rea_sst_rey( sstname, cdsstfmt, sstdata, kvars, kextra, &
+      &                        kstp, ddobsini, ddobsend )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_sst ***
+      !!
+      !! ** Purpose : Read from file the pseudo SST data from Reynolds
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE par_oce          ! Ocean parameters
+   
+      !! * Arguments
+      CHARACTER(len=128), INTENT(IN) :: sstname   ! Generic file name
+      CHARACTER(len=12), INTENT(IN) :: cdsstfmt   ! Format of SST files (yearly/monthly)
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata    ! SST data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata structures
+      INTEGER, INTENT(IN) :: kextra     ! Number of extra variables in sstdata structures
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      
+      INTEGER :: iyear
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihour
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER :: ihhmmss
+      INTEGER :: iyear1
+      INTEGER :: iyear2
+      INTEGER :: imon1
+      INTEGER :: imon2
+      INTEGER :: iyearf
+      INTEGER :: imonf
+      REAL(KIND=wp) :: pjulini
+      REAL(KIND=wp) :: pjulend
+      REAL(KIND=wp) :: pjulb
+      REAL(KIND=wp) :: pjule
+      REAL(KIND=wp) :: pjul
+      INTEGER :: inumsst
+      INTEGER :: itotrec
+      INTEGER :: inumobs
+      INTEGER :: irec
+      INTEGER :: ifld
+      INTEGER :: inum
+      INTEGER :: ji, jj
+      CHARACTER(len=128) :: clname
+      CHARACTER(len=4) :: cdyear
+      CHARACTER(len=2) :: cdmon
+      REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) :: zsstin
+
+      IF (lwp) WRITE(numout,*)'In obs_rea_sst_rey',sstname
+
+      !-----------------------------------------------------------------------
+      ! Convert observation window to julian dates.
+      !-----------------------------------------------------------------------
+      iyear1 = NINT( ddobsini / 10000 )
+      imon1 = NINT( ( ddobsini - iyear1 * 10000 ) / 100 )
+      iday = MOD( NINT( ddobsini ), 100 )
+      ihhmmss = ( ddobsini - NINT( ddobsini ) ) * 1000000
+      ihour = ihhmmss / 10000
+      imin = ( ihhmmss - ihour * 100 ) / 100
+      isec = MOD( ihhmmss, 100 )
+      CALL greg2jul ( isec, imin, ihour, iday, imon1, iyear1, pjulini )
+      IF (lwp) WRITE(numout,*)'dateini',ddobsini,iyear1,imon1,iday,ihour, &
+         & imin,isec,pjulini
+
+      iyear2 = NINT( ddobsini / 10000 )
+      imon2 = NINT( ( ddobsend - iyear2 * 10000 ) / 100 )
+      iday = MOD( NINT( ddobsend ), 100 )
+      ihhmmss = ( ddobsend - NINT( ddobsend ) ) * 1000000
+      ihour = ihhmmss / 10000
+      imin = ( ihhmmss - ihour * 100 ) / 100
+      isec = MOD( ihhmmss, 100 )
+      CALL greg2jul ( isec, imin, ihour, iday, imon2, iyear2, pjulend )
+      IF (lwp) WRITE(numout,*)'dateend',ddobsend,iyear2,imon2,iday,ihour, &
+         & imin,isec,pjulend
+
+      itotrec = NINT( pjulend - pjulini ) 
+      ALLOCATE( &
+         & zsstin( jpi, jpj, itotrec) &
+         & )
+      
+      pjul = pjulini + 1
+      
+      iyearf = -1 
+      imonf = -1
+
+      IF ( TRIM(cdsstfmt) == 'yearly' ) THEN
+
+         DO
+         
+            CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
+               &           pjul, 19500101 )
+            !
+            IF ( iyear /= iyearf ) THEN
+               
+               CALL greg2jul ( 0, 0, 0, 1, 1, iyear, pjulb )
+               
+               IF ( iyearf /= -1 ) THEN
+                  
+                  CALL iom_close ( inumsst )      
+                  
+               ENDIF
+               
+               clname = sstname
+               jj = INDEX( clname, 'YYYY' )
+               
+               IF ( jj == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                  &           'Error processing filename ' // TRIM(sstname) )
+                  
+               ENDIF
+               
+               WRITE(cdyear,'(I4.4)') iyear
+               clname(jj:jj+3) = cdyear
+               IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
+                  & TRIM(clname)
+               
+               inumsst = 0
+               
+               CALL iom_open ( clname, inumsst )
+               
+               IF ( inumsst == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                     &           'Error reading ' // TRIM(clname) )
+                  
+               ENDIF
+               
+               iyearf = iyear
+               
+            ENDIF
+            
+            irec = pjul - pjulb + 1
+            ifld = pjul - pjulini
+            
+            CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
+            
+            pjul = pjul + 1
+            
+            IF ( pjul > pjulend ) EXIT
+         
+         END DO
+
+      ELSEIF ( TRIM(cdsstfmt) == 'monthly' ) THEN
+
+         DO
+         
+            CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
+               &           pjul, 19500101 )
+            !
+            IF ( iyear /= iyearf .OR. imon /= imonf ) THEN
+               
+               CALL greg2jul ( 0, 0, 0, 1, imon, iyear, pjulb )
+               
+               IF ( iyearf /= -1 .AND. imonf /= -1 ) THEN
+                  
+                  CALL iom_close ( inumsst )      
+                  
+               ENDIF
+               
+               clname = sstname
+
+               jj = INDEX( clname, 'YYYY' )
+
+               IF ( jj == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                  &           'Error processing filename ' // TRIM(sstname) )
+                  
+               ENDIF
+               
+               WRITE(cdyear,'(I4.4)') iyear
+               clname(jj:jj+3) = cdyear
+
+               jj = INDEX( clname, 'MM' )
+               
+               IF ( jj == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                  &           'Error processing filename ' // TRIM(sstname) )
+                  
+               ENDIF
+               
+               WRITE(cdmon,'(I2.2)') imon
+               clname(jj:jj+1) = cdmon
+
+
+               IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
+                  & TRIM(clname)
+               
+               inumsst = 0
+               
+               CALL iom_open ( clname, inumsst )
+               
+               IF ( inumsst == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                     &           'Error reading ' // TRIM(clname) )
+                  
+               ENDIF
+               
+               iyearf = iyear
+               imonf = iyear
+               
+            ENDIF
+            
+            irec = pjul - pjulb + 1
+            ifld = pjul - pjulini
+            
+            CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
+            
+            pjul = pjul + 1
+            
+            IF ( pjul > pjulend ) EXIT
+         
+         END DO
+
+      ELSE
+         
+         CALL ctl_stop('Unknown REYNOLDS sst input data file format')
+
+      ENDIF
+
+      CALL iom_close ( inumsst )      
+
+      inumobs = 0
+      DO jj = nldj, nlej
+         DO ji = nldi, nlei
+            IF ( tmask(ji,jj,1) == 1.0_wp ) inumobs = inumobs + 1
+         END DO
+      END DO
+      inumobs = inumobs * itotrec
+
+      ! Allocate obs_surf data structure for time sorted data
+         
+      CALL obs_surf_alloc( sstdata, inumobs, kvars, kextra, kstp )
+
+      pjul = pjulini + 1
+
+      inumobs = 0
+
+      DO
+
+         CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
+            &           pjul, 19500101 )
+
+         ifld = pjul - pjulini
+
+         DO jj = nldj, nlej
+            DO ji = nldi, nlei
+
+               IF ( tmask(ji,jj,1) == 1.0_wp ) THEN
+
+                  inumobs = inumobs + 1
+                  
+                  ! Integer values
+                  IF (ln_grid_global) THEN
+                     sstdata%mi(inumobs)     = MAX(mig(ji),2)
+                     sstdata%mj(inumobs)     = MAX(mjg(jj),2)
+                  ELSE
+                     sstdata%mi(inumobs)     = MAX(ji,2)
+                     sstdata%mj(inumobs)     = MAX(jj,2)
+                  ENDIF
+                  sstdata%nsidx(inumobs)  = 0
+                  sstdata%nsfil(inumobs)  = 0
+                  sstdata%nyea(inumobs)   = iyear
+                  sstdata%nmon(inumobs)   = imon
+                  sstdata%nday(inumobs)   = iday
+                  sstdata%nhou(inumobs)   = ihour
+                  sstdata%nmin(inumobs)   = imin
+                  sstdata%mstp(inumobs)   = 0
+                  sstdata%nqc(inumobs)    = 0
+                  sstdata%ntyp(inumobs)   = 0
+         
+                  ! Real values
+                  sstdata%rlam(inumobs)   = glamt(ji,jj)
+                  sstdata%rphi(inumobs)   = gphit(ji,jj)
+                  sstdata%robs(inumobs,1) = zsstin(ji,jj,ifld)
+                  sstdata%rmod(inumobs,1) = fbrmdi
+                  sstdata%rext(inumobs,:) = fbrmdi
+
+               ENDIF
+
+            END DO
+         END DO
+
+         pjul = pjul + 1
+
+         IF ( pjul > pjulend ) EXIT
+
+      END DO
+
+   END SUBROUTINE obs_rea_sst_rey
+
+END MODULE obs_read_sst
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_vel.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_vel.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_read_vel.F90	(revision 2236)
@@ -0,0 +1,639 @@
+MODULE obs_read_vel
+   !!======================================================================
+   !!                       ***  MODULE obs_read_vel  ***
+   !! Observation diagnostics: Read the velocity profile observations
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_vel_dri : Driver for reading profile obs
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE par_oce                  ! Ocean parameters
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_prep                 ! Prepare observation arrays
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_profiles_def         ! Profile definitions
+   USE obs_conv                 ! Various conversion routines
+   USE obs_types                ! Observation type definitions
+   USE netcdf                   ! NetCDF library
+   USE obs_oper                 ! Observation operators
+   USE obs_vel_io               ! Velocity profile files I/O (non-FB files)
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_vel_dri  ! Read the profile observations 
+
+CONTAINS
+ 
+   SUBROUTINE obs_rea_vel_dri( kformat, &
+      &                        profdata, knumfiles, cfilenames, &
+      &                        kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                        ldignmis, ldavtimset, ldmod )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_pro_dri ***
+      !!
+      !! ** Purpose : Read from file the profile observations
+      !!
+      !! ** Method  : Depending on kformat either ENACT, CORIOLIS or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) : New merged version of old routines
+      !!----------------------------------------------------------------------
+      !! * Modules used
+   
+      !! * Arguments
+      INTEGER :: kformat   ! Format of input data
+      !                    ! 1: ENACT
+      !                    ! 2: Coriolis
+      TYPE(obs_prof), INTENT(OUT) :: profdata    ! Profile data to be read
+      INTEGER, INTENT(IN) :: knumfiles           ! Number of files to read in
+      CHARACTER(LEN=128), INTENT(IN) ::  cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars       ! Number of variables in profdata
+      INTEGER, INTENT(IN) :: kextr       ! Number of extra fields for each var in profdata
+      INTEGER, INTENT(IN) :: kstp        !  Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldavtimset  ! Set time to be equal to the end of the day
+      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_vel_dri'
+      INTEGER :: jvar
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: ij
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER, DIMENSION(ntyp1770+1) :: &
+         & itypuv,    &
+         & itypuvmpp 
+      INTEGER :: iuv3dtmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsiu,   &
+         & iobsju,   &
+         & iprocu,   &
+         & iobsiv,   &
+         & iobsjv,   &
+         & iprocv,   &
+         & iindx,    &
+         & ifileidx, &
+         & iprofidx
+      INTEGER :: itype
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: &
+         & llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iprof
+      INTEGER :: iproftot
+      INTEGER :: iuv3dt
+      INTEGER, DIMENSION(kvars) :: iv3dt
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iprof = 0
+      iuv3dt = 0
+
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+
+      ALLOCATE( inpfiles(inobf) )
+
+      prof_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_vel_dri : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1 ) THEN
+               CALL read_taondbc( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &               numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+            
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+
+            IF ( ldavtimset ) THEN
+               DO ji = 1, inpfiles(jj)%nobs
+                  ! 
+                  !  for daily averaged data force the time
+                  !  to be the  end of the day
+                  !
+                  inpfiles(jj)%ptim(ji) = &
+                     & INT(inpfiles(jj)%ptim(ji)) + 1
+               END DO
+            ENDIF
+            
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsiu(inowin) )
+            ALLOCATE( iobsju(inowin) )
+            ALLOCATE( iprocu(inowin) )
+            ALLOCATE( iobsiv(inowin) )
+            ALLOCATE( iobsjv(inowin) )
+            ALLOCATE( iprocv(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsiu, iobsju, iprocu, &
+               & 'U' )
+            CALL obs_grid_search( inowin, zlam, zphi, iobsiv, iobsjv, iprocv, &
+               & 'V' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iprocu(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsiu(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsju(inowin)
+                  inpfiles(jj)%iproc(ji,2) = iprocv(inowin)
+                  inpfiles(jj)%iobsi(ji,2) = iobsiv(inowin)
+                  inpfiles(jj)%iobsj(ji,2) = iobsjv(inowin)
+                  IF ( inpfiles(jj)%iproc(ji,1) /= &
+                     & inpfiles(jj)%iproc(ji,2) ) THEN
+                     CALL ctl_stop( 'Error in obs_read_vel:', &
+                        & 'U and V observation on different processors')
+                  ENDIF
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsiu, iobsju, iprocu,  &
+               & iobsiv, iobsjv, iprocv )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /=  nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( ( nproc == 0 ) .AND. &
+                     & ( inpfiles(jj)%iproc(ji,1) <=  nproc ) ) .OR. &
+                     & ( inpfiles(jj)%iproc(ji,1) ==  nproc ) ) THEN
+                     loop_uv_count : DO ij = 1,inpfiles(jj)%nlev
+                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                           & CYCLE
+                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                           iuv3dt = iuv3dt + 1
+                           llvalprof = .TRUE.
+                        ENDIF
+                     END DO loop_uv_count
+                  ENDIF
+                  IF ( llvalprof ) iprof = iprof + 1
+               ENDIF
+            END DO
+
+         ENDIF
+         
+      END DO prof_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iproftot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iproftot = iproftot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iproftot), ifileidx(iproftot), &
+         &      iprofidx(iproftot), zdat(iproftot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               iprofidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iproftot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      iv3dt(:) = -1
+      iv3dt(1:2) = iuv3dt
+      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
+         &                 kstp, jpi, jpj, jpk )
+      
+      ! * Read obs/positions, QC, all variable and assign to profdata
+
+      profdata%nprof     = 0
+      profdata%nvprot(:) = 0
+
+      iprof = 0
+
+      iuv3dt = 0
+      itypuv   (:) = 0
+      itypuvmpp(:) = 0
+      
+      DO jk = 1, iproftot
+         
+         jj = ifileidx(iindx(jk))
+         ji = iprofidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            llvalprof = .FALSE.
+
+            loop_prof : DO ij = 1, inpfiles(jj)%nlev
+               
+               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                  & CYCLE
+               
+               IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+
+                  llvalprof = .TRUE.
+                  EXIT loop_prof
+
+               ENDIF
+
+            END DO loop_prof
+            
+            ! Set profile information
+            
+            IF ( llvalprof ) THEN
+               
+               iprof = iprof + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! Profile time coordinates
+               profdata%nyea(iprof) = iyea
+               profdata%nmon(iprof) = imon
+               profdata%nday(iprof) = iday
+               profdata%nhou(iprof) = ihou
+               profdata%nmin(iprof) = imin
+               
+               ! Profile space coordinates
+               profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
+               profdata%rphi(iprof) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1)
+               profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1)
+               profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2)
+               profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2)
+               
+               ! Profile WMO number
+               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               profdata%ntyp(iprof) = itype
+               
+               ! QC stuff
+
+               profdata%nqc(iprof)     = inpfiles(jj)%ioqc(ji)
+               profdata%nqcf(:,iprof)  = inpfiles(jj)%ioqcf(:,ji)
+               profdata%ipqc(iprof)    = inpfiles(jj)%ipqc(ji)
+               profdata%ipqcf(:,iprof) = inpfiles(jj)%ipqcf(:,ji)
+               profdata%itqc(iprof)    = inpfiles(jj)%itqc(ji)
+               profdata%itqcf(:,iprof) = inpfiles(jj)%itqcf(:,ji)
+               profdata%ivqc(iprof,:)  = inpfiles(jj)%ivqc(ji,:)
+               profdata%ivqcf(:,iprof,:) = inpfiles(jj)%ivqcf(:,ji,:)
+
+               ! Bookkeeping data to match profiles
+               profdata%npidx(iprof) = iprof
+               profdata%npfil(iprof) = iindx(jk)
+
+               ! Observation QC flag (whole profile)
+               profdata%nqc(iprof)  = 0 !TODO
+
+               loop_uv : DO ij = 1, inpfiles(jj)%nlev            
+                   
+                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                     & CYCLE
+
+                  IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                     & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                     & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                     iuv3dt = iuv3dt + 1
+                  ELSE
+                     CYCLE
+                  ENDIF
+
+                  ! Depth of U observation
+                  profdata%var(1)%vdep(iuv3dt) = &
+                     &                inpfiles(jj)%pdep(ij,ji)
+                  
+                  ! Depth of U observation QC
+                  profdata%var(1)%idqc(iuv3dt) = &
+                     &                inpfiles(jj)%idqc(ij,ji)
+                  
+                  ! Depth of U observation QC flags
+                  profdata%var(1)%idqcf(:,iuv3dt) = &
+                     &                inpfiles(jj)%idqcf(:,ij,ji)
+                  
+                  ! Profile index
+                  profdata%var(1)%nvpidx(iuv3dt) = iprof
+                  
+                  ! Vertical index in original profile
+                  profdata%var(1)%nvlidx(iuv3dt) = ij
+
+                  ! Profile U value
+
+                  profdata%var(1)%vobs(iuv3dt) = &
+                     &                inpfiles(jj)%pob(ij,ji,1)
+                  IF ( ldmod ) THEN
+                     profdata%var(1)%vmod(iuv3dt) = &
+                        &                inpfiles(jj)%padd(ij,ji,1,1)
+                  ENDIF
+                  
+                  ! Profile U qc
+                  profdata%var(1)%nvqc(iuv3dt) = &
+                     & inpfiles(jj)%ivlqc(ij,ji,1)
+                  
+                  ! Profile U qc flags
+                  profdata%var(1)%nvqcf(:,iuv3dt) = &
+                     & inpfiles(jj)%ivlqcf(:,ij,ji,1)
+                  
+                  
+                  ! Depth of V observation
+                  profdata%var(2)%vdep(iuv3dt) = &
+                     &                inpfiles(jj)%pdep(ij,ji)
+                  
+                  ! Depth of V observation QC
+                  profdata%var(2)%idqc(iuv3dt) = &
+                     &                inpfiles(jj)%idqc(ij,ji)
+                  
+                  ! Depth of V observation QC flags
+                  profdata%var(2)%idqcf(:,iuv3dt) = &
+                     &                inpfiles(jj)%idqcf(:,ij,ji)
+                  
+                  ! Profile index
+                  profdata%var(2)%nvpidx(iuv3dt) = iprof
+                  
+                  ! Vertical index in original profile
+                  profdata%var(2)%nvlidx(iuv3dt) = ij
+                  
+                  ! Profile V value
+                  profdata%var(2)%vobs(iuv3dt) = &
+                     &                inpfiles(jj)%pob(ij,ji,2)
+                  IF ( ldmod ) THEN
+                     profdata%var(2)%vmod(iuv3dt) = &
+                        &                inpfiles(jj)%padd(ij,ji,1,2)
+                  ENDIF
+                     
+                  ! Profile V qc
+                  profdata%var(2)%nvqc(iuv3dt) = &
+                     & inpfiles(jj)%ivlqc(ij,ji,2)
+                  
+                  ! Profile V qc flags
+                  profdata%var(2)%nvqcf(:,iuv3dt) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,2)
+                  
+                  ! Observation type
+                  itypuv( profdata%ntyp(iprof) + 1 ) = &
+                     & itypuv( profdata%ntyp(iprof) + 1 ) + 1
+
+
+               END DO loop_uv
+
+            ENDIF
+
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer ( iuv3dt, iuv3dtmpp )
+      
+      CALL obs_mpp_sum_integers( itypuv, itypuvmpp, ntyp1770 + 1 )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile U,V velocity data'
+         WRITE(numout,'(1X,A)') '-------------------------'
+         WRITE(numout,*) 
+         DO ji = 0, ntyp1770
+            IF ( itypuvmpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,A3,I8)') ctypshort(ji), ' = ', &
+                  & itypuvmpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') '--------------'
+         WRITE(numout,'(1X,A6,I8)') &
+            & 'Total profile UV data                                 = ',&
+            & iuv3dtmpp
+         WRITE(numout,'(1X,A)') '--------------'
+      ENDIF
+      
+      profdata%nvprot(1)    = iuv3dt
+      profdata%nvprot(2)    = iuv3dt
+      profdata%nvprotmpp(1) = iuv3dtmpp
+      profdata%nvprotmpp(2) = iuv3dtmpp
+      profdata%nprof        = iprof
+
+      !-----------------------------------------------------------------------
+      ! Model level search
+      !-----------------------------------------------------------------------
+      CALL obs_level_search( jpk, gdept_0, &
+         & profdata%nvprot(1), profdata%var(1)%vdep, &
+         & profdata%var(1)%mvk )
+      CALL obs_level_search( jpk, gdept_0, &
+         & profdata%nvprot(2), profdata%var(2)%vdep, &
+         & profdata%var(2)%mvk )
+      
+      !-----------------------------------------------------------------------
+      ! Set model equivalent to 99999
+      !-----------------------------------------------------------------------
+      IF ( .NOT. ldmod ) THEN
+         DO jvar = 1, kvars
+            profdata%var(jvar)%vmod(:) = fbrmdi
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iprofidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_vel_dri
+   
+END MODULE obs_read_vel
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_readmdt.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 2236)
@@ -0,0 +1,339 @@
+MODULE obs_readmdt
+   !!======================================================================
+   !!                       ***  MODULE obs_readmdt  ***
+   !! Observation diagnostics: Read the MDT for SLA data (skeleton for now)
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_mdt : Driver for reading MDT
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp, &
+      & dp, &
+      & sp
+   USE par_oce, ONLY : &        ! Domain parameters
+      & jpi, &
+      & jpj, &
+      & jpim1
+   USE in_out_manager, ONLY : & ! I/O manager
+      & lwp,    &
+      & numout 
+   USE obs_surf_def             ! Surface observation definitions
+   USE dom_oce, ONLY : &        ! Domain variables
+      & tmask, &
+      & tmask_i, &
+      & e1t,   &
+      & e2t,   &
+      & gphit, &
+      & glamt
+   USE obs_const, ONLY : &
+      & obfillflt              ! Fillvalue
+   USE oce, ONLY : &           ! Model variables
+      & sshn
+   USE obs_inter_sup           ! Interpolation support routines
+   USE obs_inter_h2d           ! 2D interpolation
+   USE obs_utils               ! Various observation tools
+   USE lib_mpp, only: &        ! MPP routines
+      & lk_mpp, &
+      & mpp_sum
+   USE iom_nf90   
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   INTEGER, PUBLIC :: nmsshc = 1        ! MDT correction scheme
+   REAL(wp), PUBLIC :: mdtcorr = 1.61   ! User specified MDT correction
+   REAL(wp), PUBLIC :: mdtcutoff = 65.0  ! MDT cutoff for computed correction
+   PUBLIC obs_rea_mdt     ! Read the MDT
+   PUBLIC obs_offset_mdt  ! Remove the offset between the model MDT and the 
+                          ! used one
+
+CONTAINS
+
+   SUBROUTINE obs_rea_mdt( kslano, sladata, k2dint )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_mdt ***
+      !!
+      !! ** Purpose : Read from file the MDT data (skeleton)
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!
+      !! History :  
+      !!      ! :  2007-03 (K. Mogensen) Initial skeleton version
+      !!      ! :  2007-04 (E. Remy) migration and improvement from OPAVAR
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kslano          ! Number of SLA Products
+      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
+         & sladata       ! SLA data
+      INTEGER, INTENT(IN) :: k2dint
+
+      !! * Local declarations
+
+      CHARACTER(LEN=12), PARAMETER :: &
+         & cpname = 'obs_rea_mdt'
+      CHARACTER(LEN=20), PARAMETER :: &
+         & mdtname = 'slaReferenceLevel.nc'
+
+      INTEGER :: jslano      ! Data set loop variable
+      INTEGER :: jobs        ! Obs loop variable
+      INTEGER :: jpimdt      ! Number of grid point in latitude for the MDT
+      INTEGER :: jpjmdt      ! Number of grid point in longitude for the MDT
+      INTEGER :: iico        ! Grid point indicies
+      INTEGER :: ijco 
+      INTEGER :: i_nx_id     ! Index to read the NetCDF file
+      INTEGER :: i_ny_id     ! 
+      INTEGER :: i_file_id   ! 
+      INTEGER :: i_var_id
+      INTEGER :: i_stat
+
+      REAL(wp), DIMENSION(jpi,jpj) :: & 
+         & z_mdt,       &  ! Array to store the MDT values
+         & mdtmask         ! Array to store the mask for the MDT
+      REAL(wp), DIMENSION(1) :: &
+         & zext, &
+         & zobsmask
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zmdtl, &
+         & zglam, &
+         & zgphi
+         
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      REAL(wp) :: zfill
+      REAL(sp) :: zinfill
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+      INTEGER :: nummdt
+
+      IF(lwp)WRITE(numout,*) 
+      IF(lwp)WRITE(numout,*) ' obs_rea_mdt : '
+      IF(lwp)WRITE(numout,*) ' ------------- '
+      IF(lwp)WRITE(numout,*) '   Read MDT for referencing altimeter', &
+         &                   '   anomalies'
+
+      ! Open the file
+      
+      CALL iom_open( mdtname, nummdt )
+      
+      ! Get the MDT data
+
+      CALL iom_get( nummdt, jpdom_data, 'sossheig', z_mdt(:,:), 1 )
+
+      ! Close the file
+
+      CALL iom_close(nummdt)     
+      
+      ! Read in the fill value
+      zinfill = 0.0
+      i_stat = nf90_open( mdtname, nf90_nowrite, nummdt )
+      i_stat = nf90_inq_varid( nummdt, 'sossheig', i_var_id )
+      i_stat = nf90_get_att( nummdt, i_var_id, "_FillValue",zinfill)
+      zfill = zinfill
+      i_stat = nf90_close( nummdt )
+
+! setup mask based on tmask and MDT mask
+! set mask to 0 where the MDT is set to fillvalue
+
+      WHERE(z_mdt(:,:) /= zfill)
+         mdtmask(:,:)=tmask(:,:,1)
+      ELSEWHERE
+         mdtmask(:,:)=0
+      END WHERE
+
+      ! Remove the offset between the MDT used with the sla and the model MDT
+
+      IF ( nmsshc == 1 .OR. nmsshc == 2 ) CALL obs_offset_mdt( z_mdt, zfill )
+
+      ! Intepolate the MDT already on the model grid at the observation point
+  
+      DO jslano = 1, kslano
+
+         ALLOCATE( &
+            & igrdi(2,2,sladata(jslano)%nsurf), &
+            & igrdj(2,2,sladata(jslano)%nsurf), &
+            & zglam(2,2,sladata(jslano)%nsurf), &
+            & zgphi(2,2,sladata(jslano)%nsurf), &
+            & zmask(2,2,sladata(jslano)%nsurf), &
+            & zmdtl(2,2,sladata(jslano)%nsurf)  &
+            & )
+         
+         DO jobs = 1, sladata(jslano)%nsurf
+
+            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
+            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
+
+         END DO
+
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, glamt, zglam )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, gphit, zgphi )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, mdtmask, zmask )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, z_mdt, zmdtl )
+
+         DO jobs = 1, sladata(jslano)%nsurf
+            
+            zlam = sladata(jslano)%rlam(jobs)
+            zphi = sladata(jslano)%rphi(jobs)
+
+            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+               &                   zmask(:,:,jobs), zweig, zobsmask )
+            
+            CALL obs_int_h2d( 1, 1,      &
+                   &              zweig, zmdtl(:,:,jobs),  zext )
+ 
+            sladata(jslano)%rext(jobs,2) = zext(1)
+
+! mark any masked data with a QC flag
+            IF ( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11
+
+         END DO
+         
+         DEALLOCATE( &
+            & igrdi, &
+            & igrdj, &
+            & zglam, &
+            & zgphi, &
+            & zmask, &
+            & zmdtl  &
+            & )
+
+      END DO
+
+   END SUBROUTINE obs_rea_mdt
+
+   SUBROUTINE obs_offset_mdt( mdt, zfill )
+
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_offset_mdt ***
+      !!
+      !! ** Purpose : Compute a correction term for the MDT on the model grid
+      !!             !!!!! IF it is on the model grid
+      !!
+      !! ** Method  : Compute the mean difference between the model and the 
+      !!              used MDT and remove the offset. 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!
+      !! History :  
+      !!      ! :  2007-04 (E. Remy) migration from OPAVAR
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: &
+         & mdt           ! MDT used on the model grid
+      REAL(wp), INTENT(IN) :: zfill 
+
+      !! * Local declarations 
+      REAL(wp) :: zdxdy
+      REAL(wp) :: zarea
+      REAL(wp) :: zeta1
+      REAL(wp) :: zeta2
+      REAL(wp) :: zcorr_mdt  
+      REAL(wp) :: zcorr_bcketa
+      REAL(wp) :: zcorr
+      REAL(wp), DIMENSION(jpi,jpj) :: zpromsk
+      INTEGER :: jj
+      INTEGER :: ji
+      CHARACTER(LEN=14), PARAMETER :: &
+         & cpname = 'obs_offset_mdt'
+   
+      !  Initialize the local mask, for domain projection 
+      !  Also exclude mdt points which are set to missing data
+
+      DO ji = 1, jpi
+        DO jj = 1, jpj
+           zpromsk(ji,jj) = tmask_i(ji,jj)
+           IF (    ( gphit(ji,jj) .GT.  mdtcutoff ) &
+              &.OR.( gphit(ji,jj) .LT. -mdtcutoff ) &
+              &.OR.( mdt(ji,jj) .EQ. zfill ) ) &
+              &        zpromsk(ji,jj) = 0.0
+        END DO
+      END DO 
+
+      ! Compute MSSH mean over [0,360] x [-mdtcutoff,mdtcutoff]
+
+      zarea = 0.0
+      zeta1 = 0.0
+      zeta2 = 0.0
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+          zdxdy = e1t(ji,jj) * e2t(ji,jj) * zpromsk(ji,jj)
+          zarea = zarea + zdxdy
+          zeta1 = zeta1 + mdt(ji,jj) * zdxdy
+          zeta2 = zeta2 + sshn (ji,jj) * zdxdy
+        END DO      
+      END DO
+
+      IF( lk_mpp) CALL mpp_sum( zeta1 )
+      IF( lk_mpp) CALL mpp_sum( zeta2 )
+      IF( lk_mpp) CALL mpp_sum( zarea )
+      
+      zcorr_mdt = zeta1 / zarea
+      zcorr_bcketa  = zeta2 / zarea
+
+      !  Define correction term
+
+      zcorr = zcorr_mdt - zcorr_bcketa
+
+      !  Correct spatial mean of the MSSH
+
+      IF ( nmsshc == 1 ) mdt(:,:) = mdt(:,:) - zcorr  
+
+      ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT
+
+      IF ( nmsshc == 2 ) mdt(:,:) = mdt(:,:) - mdtcorr
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' obs_readmdt : mdtcutoff     = ', mdtcutoff
+         WRITE(numout,*) ' -----------   zcorr_mdt     = ', zcorr_mdt
+         WRITE(numout,*) '               zcorr_bcketa  = ', zcorr_bcketa
+         WRITE(numout,*) '               zcorr         = ', zcorr
+         WRITE(numout,*) '               nmsshc        = ', nmsshc
+         WRITE(numout,*) 
+      ENDIF
+
+      IF ( nmsshc == 0 ) WRITE(numout,*) &
+         &                 '           MSSH correction is not applied'
+      IF ( nmsshc == 1 ) WRITE(numout,*) &
+         &                 '           MSSH correction is applied'
+      IF ( nmsshc == 2 ) WRITE(numout,*) &
+         &                 '           User defined MSSH correction' 
+
+
+   END SUBROUTINE obs_offset_mdt
+ 
+END MODULE obs_readmdt
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 2236)
@@ -0,0 +1,225 @@
+MODULE obs_rot_vel
+   !!======================================================================
+   !!                       ***  MODULE obs_rot_vel  ***
+   !! Observation diagnostics: Read the velocity profile observations
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rotvel : Rotate velocity data into N-S,E-W directorions
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE par_oce                  ! Ocean parameters
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_grid                 ! Grid search
+   USE obs_utils                ! For error handling
+   USE obs_profiles_def         ! Profile definitions
+   USE obs_inter_h2d            ! Horizontal interpolation
+   USE obs_inter_sup            ! MPP support routines for interpolation
+   USE geo2ocean                ! Rotation of vectors
+   USE obs_fbm                  ! Feedback definitions
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rotvel            ! Rotate the observations
+
+CONTAINS
+
+   SUBROUTINE obs_rotvel( profdata, k2dint, pu, pv )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_pro_dri ***
+      !!
+      !! ** Purpose : Rotate velocity data into N-S,E-W directorions
+      !!
+      !! ** Method  : Interpolation of geo2ocean coefficients on U,V grid
+      !!              to observation point followed by a similar computations
+      !!              as in geo2ocean.
+      !!
+      !! ** Action  : Review if there is a better way to do this.
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2009-02 (K. Mogensen) : New routine
+      !!----------------------------------------------------------------------
+      !! * Modules used
+   
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata    ! Profile data to be read
+      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation methed
+      REAL(wp), DIMENSION(*) :: &
+         & pu, &
+         & pv
+      !! * Local declarations
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+         & zsingu, &
+         & zcosgu, &
+         & zsingv, &
+         & zcosgv
+      REAL(wp), DIMENSION(2,2,1) :: zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmasku, &
+         & zmaskv, &
+         & zcoslu, &
+         & zsinlu, &
+         & zcoslv, &
+         & zsinlv, &
+         & zglamu, &
+         & zgphiu, &
+         & zglamv, &
+         & zgphiv
+      REAL(wp), DIMENSION(1) :: &
+         & zsinu, &
+         & zcosu, &
+         & zsinv, &
+         & zcosv
+      REAL(wp) :: zsin
+      REAL(wp) :: zcos
+      REAL(wp), DIMENSION(1) :: zobsmask
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdiu, &
+         & igrdju, &
+         & igrdiv, &
+         & igrdjv
+      INTEGER :: ji
+      INTEGER :: jk
+
+      !-----------------------------------------------------------------------
+      ! Allocate data for message parsing and interpolation
+      !-----------------------------------------------------------------------
+
+      ALLOCATE( &
+         & igrdiu(2,2,profdata%nprof), &
+         & igrdju(2,2,profdata%nprof), &
+         & zglamu(2,2,profdata%nprof), &
+         & zgphiu(2,2,profdata%nprof), &
+         & zmasku(2,2,profdata%nprof), &
+         & zcoslu(2,2,profdata%nprof), &
+         & zsinlu(2,2,profdata%nprof), &
+         & igrdiv(2,2,profdata%nprof), &
+         & igrdjv(2,2,profdata%nprof), &
+         & zglamv(2,2,profdata%nprof), &
+         & zgphiv(2,2,profdata%nprof), &
+         & zmaskv(2,2,profdata%nprof), &
+         & zcoslv(2,2,profdata%nprof), &
+         & zsinlv(2,2,profdata%nprof)  &
+         & )
+
+      !-----------------------------------------------------------------------
+      ! Receive the angles on the U and V grids.
+      !-----------------------------------------------------------------------
+
+      CALL obs_rot( zsingu, zcosgu, zsingv, zcosgv )
+
+      DO ji = 1, profdata%nprof
+         igrdiu(1,1,ji) = profdata%mi(ji,1)-1
+         igrdju(1,1,ji) = profdata%mj(ji,1)-1
+         igrdiu(1,2,ji) = profdata%mi(ji,1)-1
+         igrdju(1,2,ji) = profdata%mj(ji,1)
+         igrdiu(2,1,ji) = profdata%mi(ji,1)
+         igrdju(2,1,ji) = profdata%mj(ji,1)-1
+         igrdiu(2,2,ji) = profdata%mi(ji,1)
+         igrdju(2,2,ji) = profdata%mj(ji,1)
+         igrdiv(1,1,ji) = profdata%mi(ji,2)-1
+         igrdjv(1,1,ji) = profdata%mj(ji,2)-1
+         igrdiv(1,2,ji) = profdata%mi(ji,2)-1
+         igrdjv(1,2,ji) = profdata%mj(ji,2)
+         igrdiv(2,1,ji) = profdata%mi(ji,2)
+         igrdjv(2,1,ji) = profdata%mj(ji,2)-1
+         igrdiv(2,2,ji) = profdata%mi(ji,2)
+         igrdjv(2,2,ji) = profdata%mj(ji,2)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  glamu, zglamu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  gphiu, zgphiu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  umask(:,:,1), zmasku )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  zsingu, zsinlu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  zcosgu, zcoslu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  glamv, zglamv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  gphiv, zgphiv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  vmask(:,:,1), zmaskv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  zsingv, zsinlv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  zcosgv, zcoslv )
+
+      DO ji = 1, profdata%nprof
+            
+         CALL obs_int_h2d_init( 1, 1, k2dint, &
+            &                   profdata%rlam(ji), profdata%rphi(ji), &
+            &                   zglamu(:,:,ji), zgphiu(:,:,ji), &
+            &                   zmasku(:,:,ji), zweig, zobsmask )
+         
+         CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji),  zsinu )
+
+         CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji),  zcosu )
+
+         CALL obs_int_h2d_init( 1, 1, k2dint, &
+            &                   profdata%rlam(ji), profdata%rphi(ji), &
+            &                   zglamv(:,:,ji), zgphiv(:,:,ji), &
+            &                   zmaskv(:,:,ji), zweig, zobsmask )
+         
+         CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji),  zsinv )
+
+         CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji),  zcosv )
+
+         ! Assume that the angle at observation point is the 
+         ! mean of u and v cosines/sines
+
+         zcos = 0.5_wp * ( zcosu(1) + zcosv(1) )
+         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) )
+         
+         IF ( ( profdata%npvsta(ji,1) /= profdata%npvsta(ji,2) ) .OR. &
+            & ( profdata%npvend(ji,1) /= profdata%npvend(ji,2) ) ) THEN
+            CALL fatal_error( 'Different number of U and V observations '// &
+               'in a profile in obs_rotvel', __LINE__ )
+         ENDIF
+
+         DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1)
+            IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. &
+               & ( profdata%var(1)%vmod(jk) /= fbrmdi ) ) THEN
+               pu(jk) = profdata%var(1)%vmod(jk) * zcos - &
+                  &     profdata%var(2)%vmod(jk) * zsin 
+               pv(jk) = profdata%var(2)%vmod(jk) * zcos + &
+                  &     profdata%var(1)%vmod(jk) * zsin
+            ELSE
+               pu(jk) = fbrmdi
+               pv(jk) = fbrmdi
+            ENDIF
+         END DO
+
+      END DO
+      
+      DEALLOCATE( &
+         & igrdiu, &
+         & igrdju, &
+         & zglamu, &
+         & zgphiu, &
+         & zmasku, &
+         & zcoslu, &
+         & zsinlu, &
+         & igrdiv, &
+         & igrdjv, &
+         & zglamv, &
+         & zgphiv, &
+         & zmaskv, &
+         & zcoslv, &
+         & zsinlv  &
+         & )
+
+   END SUBROUTINE obs_rotvel
+
+END MODULE obs_rot_vel
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_seaice.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_seaice.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_seaice.F90	(revision 2236)
@@ -0,0 +1,29 @@
+MODULE obs_seaice
+   !!=====================================================================
+   !!                       ***  MODULE  obs_seaice  ***
+   !! Observation diagnostics: Storage space for sea ice observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   
+   !! * Modules used 
+   USE obs_surf_def ! Definition of sea ice data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nseaicevars, nseaiceextr, nseaicesets, seaicedata, seaicedatqc
+
+   !! * Shared Module variables
+   INTEGER :: nseaicevars                               ! Number of seaicedata variables
+   INTEGER :: nseaiceextr                               ! Number of seaicedata extra 
+                                                     ! variables
+   INTEGER :: nseaicesets                               ! Number of seaicedata sets
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedata  ! Initial sea ice data
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedatqc ! Sea ice data after quality control
+
+END MODULE obs_seaice
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_seaice_io.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_seaice_io.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_seaice_io.F90	(revision 2236)
@@ -0,0 +1,24 @@
+MODULE obs_seaice_io
+   !!======================================================================
+   !!                       ***  MODULE obs_seaice_io  ***
+   !! Observation operators : I/O for GHRSEAICE files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_seaicefile    :  Read a obfbdata structure from an GHRSEAICE file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+CONTAINS
+
+#include "obsseaice_io.h90"
+
+END MODULE obs_seaice_io
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sla.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sla.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sla.F90	(revision 2236)
@@ -0,0 +1,28 @@
+MODULE obs_sla
+   !!=====================================================================
+   !!                       ***  MODULE  obs_sla  ***
+   !! Observation diagnostics: Storage space for SLA observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   
+   !! * Modules used 
+   USE obs_surf_def ! Definition of SLA data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nslavars, nslaextr, nslasets, sladata, sladatqc
+
+   !! * Shared Module variables
+   INTEGER :: nslavars                               ! Number of sladata variables
+   INTEGER :: nslaextr                               ! Number of sladata extra 
+                                                     ! variables
+   INTEGER :: nslasets                               ! Number of sladata sets                                               
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sladata  ! Initial SLA data
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sladatqc ! SLA data after quality control
+
+END MODULE obs_sla
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sla_io.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sla_io.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sla_io.F90	(revision 2236)
@@ -0,0 +1,24 @@
+MODULE obs_sla_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_io  ***
+   !! Observation operators : I/O for AVISO SLA files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an AVISO SLA file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   use obs_sla_types
+   USE netcdf
+
+   IMPLICIT NONE
+
+CONTAINS
+
+#include "obssla_io.h90"
+
+END MODULE obs_sla_io
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sla_types.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sla_types.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sla_types.F90	(revision 2236)
@@ -0,0 +1,15 @@
+MODULE obs_sla_types
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_type  ***
+   !! Observation operators : Satellite identifiers for SLA data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   IMPLICIT NONE
+
+#include "obssla_types.h90"
+
+END MODULE obs_sla_types
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sort.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sort.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sort.F90	(revision 2236)
@@ -0,0 +1,141 @@
+MODULE obs_sort
+   !!=====================================================================
+   !!                       ***  MODULE obs_sort  ***
+   !! Observation diagnostics: Various tools for sorting etc.
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   sort_dp_indx : Get indicies for ascending order for a double prec. array
+   !!   index_sort   : Get indicies for ascending order for a double prec. array
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & dp
+  
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE index_sort    ! Get indicies for ascending order for a double prec. array
+   
+   PUBLIC sort_dp_indx   ! Get indicies for ascending order for a double prec. array
+  
+CONTAINS
+
+   SUBROUTINE sort_dp_indx( kvals, pvals, kindx )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE sort_dp_indx  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for a double precision array
+      !!
+      !! ** Method  : Call index_sort routine
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kvals     ! Number of elements to be sorted
+      REAL(KIND=dp), DIMENSION(kvals), INTENT(IN) :: &
+         & pvals            ! Array to be sorted
+      INTEGER, DIMENSION(kvals), INTENT(OUT) ::  &
+         & kindx            ! Indices for ordering of array
+
+      !! * Local declarations
+
+      !-----------------------------------------------------------------------
+      ! Call qsort routine
+      !-----------------------------------------------------------------------
+      IF (kvals>=1) THEN
+
+         CALL index_sort( pvals, kindx, kvals )
+
+      ENDIF
+
+   END SUBROUTINE sort_dp_indx
+
+   SUBROUTINE index_sort( pval, kindx, kvals )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for a double precision array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kvals         ! Number of values
+      REAL(KIND=dp), DIMENSION(kvals), INTENT(IN) :: &
+         & pval                            ! Array to be sorted
+      INTEGER, DIMENSION(kvals), INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jt
+      INTEGER :: jn
+      INTEGER :: jparent
+      INTEGER :: jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+      
+      ji = kvals/2 + 1
+      jn = kvals
+
+      main_loop : DO
+
+         IF ( ji > 1 ) THEN
+            ji = ji-1
+            jt = kindx(ji)
+         ELSE
+            jt = kindx(jn)
+            kindx(jn) = kindx(1)
+            jn = jn-1
+            IF ( jn <= 1 ) THEN
+               kindx(1) = jt
+               EXIT main_loop
+            ENDIF
+         ENDIF
+
+         jparent = ji
+         jchild =  2 * ji
+
+         inner_loop : DO
+
+            IF ( jchild > jn ) EXIT inner_loop
+            IF ( jchild < jn ) THEN
+               IF ( pval(kindx(jchild)) < pval(kindx(jchild+1)) ) THEN
+                 jchild = jchild+1
+               ENDIF
+            ENDIF
+            IF  ( pval(jt) < pval(kindx(jchild))) THEN
+               kindx(jparent) = kindx(jchild)
+               jparent = jchild
+               jchild  = jchild*2
+            ELSE 
+               jchild = jn + 1 
+            ENDIF
+
+         END DO inner_loop
+
+         kindx(jparent) = jt
+
+      END DO main_loop
+      
+   END SUBROUTINE index_sort
+
+END MODULE obs_sort
+ 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sst.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sst.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sst.F90	(revision 2236)
@@ -0,0 +1,29 @@
+MODULE obs_sst
+   !!=====================================================================
+   !!                       ***  MODULE  obs_sst  ***
+   !! Observation diagnostics: Storage space for SST observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   
+   !! * Modules used 
+   USE obs_surf_def ! Definition of SST data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nsstvars, nsstextr, nsstsets, sstdata, sstdatqc
+
+   !! * Shared Module variables
+   INTEGER :: nsstvars                               ! Number of sstdata variables
+   INTEGER :: nsstextr                               ! Number of sstdata extra 
+                                                     ! variables
+   INTEGER :: nsstsets                               ! Number of sstdata sets
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdata  ! Initial SST data
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdatqc ! SST data after quality control
+
+END MODULE obs_sst
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sst_io.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sst_io.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_sst_io.F90	(revision 2236)
@@ -0,0 +1,24 @@
+MODULE obs_sst_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sst_io  ***
+   !! Observation operators : I/O for GHRSST files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_sstfile    :  Read a obfbdata structure from an GHRSST file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+CONTAINS
+
+#include "obssst_io.h90"
+
+END MODULE obs_sst_io
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_surf_def.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 2236)
@@ -0,0 +1,455 @@
+MODULE obs_surf_def
+   !!=====================================================================
+   !!                       ***  MODULE  obs_surf_def  ***
+   !! Observation diagnostics: Storage handling for surface observation
+   !!                          arrays and additional flags etc.
+   !!                          This module only defines the data type and
+   !!                          operations on the data type. There is no
+   !!                          actual data in the module.
+   !!===================================================================== 
+
+   !!----------------------------------------------------------------------
+   !!   obs_surf            : F90 type containing the surface information
+   !!   obs_surf_alloc      : Allocates surface data arrays
+   !!   obs_surf_dealloc    : Deallocates surface data arrays
+   !!   obs_surf_compress   : Extract sub-information from a obs_surf type
+   !!                         to a new obs_surf type
+   !!   obs_surf_decompress : Reinsert sub-information from a obs_surf type
+   !!                         into the original obs_surf type
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp         
+   USE obs_mpp, ONLY : &  ! MPP tools 
+      obs_mpp_sum_integer
+
+   IMPLICIT NONE
+
+   !! * Routine/type accessibility
+   PRIVATE
+
+   PUBLIC &
+      & obs_surf,           &
+      & obs_surf_alloc,     &
+      & obs_surf_dealloc,   &
+      & obs_surf_compress,  &
+      & obs_surf_decompress
+
+   !! * Type definition for surface observation type
+
+   TYPE obs_surf
+
+      ! Bookkeeping
+
+      INTEGER :: nsurf      !: Local number of surface data within window
+      INTEGER :: nsurfmpp   !: Global number of surface data within window
+      INTEGER :: nvar       !: Number of variables at observation points
+      INTEGER :: nextra     !: Number of extra fields at observation points
+      INTEGER :: nstp       !: Number of time steps
+      INTEGER :: nsurfup    !: Observation counter used in obs_oper
+
+      ! Arrays with size equal to the number of surface observations
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & mi,   &        !: i-th grid coord. for interpolating to surface observation
+         & mj,   &        !: j-th grid coord. for interpolating to surface observation
+         & nsidx,&        !: Surface observation number
+         & nsfil,&        !: Surface observation number in file
+         & nyea, &        !: Year of surface observation
+         & nmon, &        !: Month of surface observation 
+         & nday, &        !: Day of surface observation
+         & nhou, &        !: Hour of surface observation
+         & nmin, &        !: Minute of surface observation
+         & mstp, &        !: Time step nearest to surface observation
+         & nqc,  &        !: Surface observation qc flag
+         & ntyp           !: Type of surface observation product
+
+      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
+         & cwmo           !: WMO indentifier
+         
+      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
+         & rlam, &        !: Longitude coordinate of surface observation
+         & rphi           !: Latitude coordinate of surface observation
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
+         & robs, &        !: Surface observation 
+         & rmod           !: Model counterpart of the surface observation vector
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
+         & rext           !: Extra fields interpolated to observation points
+
+      ! Arrays with size equal to the number of time steps in the window
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nsstp,     &   !: Local number of surface observations per time step
+         & nsstpmpp       !: Global number of surface observations per time step
+
+      ! Arrays used to store source indices when 
+      ! compressing obs_surf derived types
+      
+      ! Array with size nsurf
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nsind          !: Source indices of surface data in compressed data
+
+   END TYPE obs_surf
+
+CONTAINS
+   
+   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_alloc  ***
+      !!                      
+      !! ** Purpose : - Allocate data for surface data arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) ::  surf      ! Surface data to be allocated
+      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations
+      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables
+      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points
+      INTEGER, INTENT(IN) :: kstp    ! Number of time steps
+
+      !!* Local variables
+      INTEGER :: ji
+
+      ! Set bookkeeping variables
+
+      surf%nsurf    = ksurf
+      surf%nsurfmpp = 0
+      surf%nextra   = kextra
+      surf%nvar     = kvar
+      surf%nstp     = kstp
+      
+      ! Allocate arrays of number of surface data size
+
+      ALLOCATE( &
+         & surf%mi(ksurf),      &
+         & surf%mj(ksurf),      &
+         & surf%nsidx(ksurf),   &
+         & surf%nsfil(ksurf),   &
+         & surf%nyea(ksurf),    &
+         & surf%nmon(ksurf),    &
+         & surf%nday(ksurf),    &
+         & surf%nhou(ksurf),    &
+         & surf%nmin(ksurf),    &
+         & surf%mstp(ksurf),    &
+         & surf%nqc(ksurf),     &
+         & surf%ntyp(ksurf),    &
+         & surf%cwmo(ksurf),    &
+         & surf%rlam(ksurf),    &
+         & surf%rphi(ksurf),    &
+         & surf%nsind(ksurf)    &
+         & )
+
+
+      ! Allocate arrays of number of surface data size * number of variables
+
+      ALLOCATE( & 
+         & surf%robs(ksurf,kvar), &
+         & surf%rmod(ksurf,kvar)  &
+         & )   
+
+      ! Allocate arrays of number of extra fields at observation points
+
+      ALLOCATE( & 
+         & surf%rext(ksurf,kextra) &
+         & )
+
+      ! Allocate arrays of number of time step size
+
+      ALLOCATE( &
+         & surf%nsstp(kstp),     &
+         & surf%nsstpmpp(kstp)   &
+         & )
+
+      ! Set defaults for compression indices
+      
+      DO ji = 1, ksurf
+         surf%nsind(ji) = ji
+      END DO
+      
+      ! Set defaults for number of observations per time step
+
+      surf%nsstp(:)     = 0
+      surf%nsstpmpp(:)  = 0
+
+      ! Set the observation counter used in obs_oper
+
+      surf%nsurfup     = 0
+              
+   END SUBROUTINE obs_surf_alloc
+
+   SUBROUTINE obs_surf_dealloc( surf )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_dealloc  ***
+      !!                      
+      !! ** Purpose : - Deallocate data for surface data arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & surf      ! Surface data to be allocated
+
+      !!* Local variables
+
+      ! Deallocate arrays of number of surface data size
+
+      DEALLOCATE( &
+         & surf%mi,      &
+         & surf%mj,      &
+         & surf%nsidx,   &
+         & surf%nsfil,   &
+         & surf%nyea,    &
+         & surf%nmon,    &
+         & surf%nday,    &
+         & surf%nhou,    &
+         & surf%nmin,    &
+         & surf%mstp,    &
+         & surf%nqc,     &
+         & surf%ntyp,    &
+         & surf%cwmo,    &
+         & surf%rlam,    &
+         & surf%rphi,    &
+         & surf%nsind    &
+         & )
+
+      ! Allocate arrays of number of surface data size * number of variables
+
+      DEALLOCATE( & 
+         & surf%robs,    &
+         & surf%rmod     &
+         & )
+
+      ! Deallocate arrays of number of extra fields at observation points
+
+      DEALLOCATE( & 
+         & surf%rext &
+         & )
+
+      ! Deallocate arrays of number of time step size
+
+      DEALLOCATE( &
+         & surf%nsstp,     &
+         & surf%nsstpmpp   &
+         & )
+
+   END SUBROUTINE obs_surf_dealloc
+
+   SUBROUTINE obs_surf_compress( surf, newsurf, lallocate, kumout, lvalid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_compress  ***
+      !!                      
+      !! ** Purpose : - Extract sub-information from a obs_surf type
+      !!                into a new obs_surf type
+      !! 
+      !! ** Method  : - The data is copied from surf to new surf.
+      !!                In the case of lvalid being present only the 
+      !!                selected data will be copied.
+      !!                If lallocate is true the data in the newsurf is 
+      !!                allocated either with the same number of elements
+      !!                as surf or with only the subset of elements defined
+      !!                by the optional selection.
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf), INTENT(IN)    :: surf      ! Original surface data
+      TYPE(obs_surf), INTENT(INOUT) :: newsurf   ! New surface data with a subset of the original data
+      LOGICAL :: lallocate     ! Allocate newsurf data
+      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
+      LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: &
+         & lvalid         ! Valid of surface observations
+      
+      !!* Local variables
+      INTEGER :: insurf
+      INTEGER :: ji
+      INTEGER :: jk
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid
+
+      ! Count how many elements there should be in the new data structure
+
+      IF ( PRESENT(lvalid) ) THEN
+         insurf = 0
+         DO ji = 1, surf%nsurf
+            IF ( lvalid(ji) ) THEN
+               insurf = insurf + 1
+            ENDIF
+         END DO
+      ELSE
+         insurf = surf%nsurf
+      ENDIF
+
+      ! Optionally allocate data in the new data structure
+
+      IF ( lallocate ) THEN
+         CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, &
+            & surf%nextra, surf%nstp )
+      ENDIF
+
+      ! Allocate temporary valid array to unify the code for both cases
+
+      ALLOCATE( llvalid(surf%nsurf) )
+      IF ( PRESENT(lvalid) ) THEN
+         llvalid(:)  = lvalid(:)
+      ELSE
+         llvalid(:)  = .TRUE.
+      ENDIF
+
+      ! Setup bookkeeping variables
+
+      insurf = 0
+
+      ! Loop over source surface data
+
+      DO ji = 1, surf%nsurf
+
+         IF ( llvalid(ji) ) THEN
+
+            ! Copy the header information
+
+            insurf = insurf + 1
+
+            newsurf%mi(insurf)    = surf%mi(ji)
+            newsurf%mj(insurf)    = surf%mj(ji)
+            newsurf%nsidx(insurf) = surf%nsidx(ji)
+            newsurf%nsfil(insurf) = surf%nsfil(ji)
+            newsurf%nyea(insurf)  = surf%nyea(ji)
+            newsurf%nmon(insurf)  = surf%nmon(ji)
+            newsurf%nday(insurf)  = surf%nday(ji)
+            newsurf%nhou(insurf)  = surf%nhou(ji)
+            newsurf%nmin(insurf)  = surf%nmin(ji)
+            newsurf%mstp(insurf)  = surf%mstp(ji)
+            newsurf%nqc(insurf)   = surf%nqc(ji)
+            newsurf%ntyp(insurf)  = surf%ntyp(ji)
+            newsurf%cwmo(insurf)  = surf%cwmo(ji)
+            newsurf%rlam(insurf)  = surf%rlam(ji)
+            newsurf%rphi(insurf)  = surf%rphi(ji)
+
+            DO jk = 1, surf%nvar
+
+               newsurf%robs(insurf,jk)  = surf%robs(ji,jk)
+               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk)
+               
+            END DO
+
+            DO jk = 1, surf%nextra
+
+               newsurf%rext(insurf,jk) = surf%rext(ji,jk)
+
+            END DO
+            
+            ! nsind is the index of the original surface data
+            
+            newsurf%nsind(insurf) = ji
+
+         ENDIF
+
+      END DO
+
+      ! Update MPP counters
+
+      newsurf%nsurf = insurf
+      CALL obs_mpp_sum_integer ( newsurf%nsurf, newsurf%nsurfmpp )
+
+      ! Set book keeping variables which do not depend on number of obs.
+
+      newsurf%nstp  = surf%nstp
+ 
+      ! Deallocate temporary data
+
+      DEALLOCATE( llvalid )
+     
+   END SUBROUTINE obs_surf_compress
+
+   SUBROUTINE obs_surf_decompress( surf, oldsurf, ldeallocate, kumout )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_decompress  ***
+      !!                      
+      !! ** Purpose : - Copy back information to original surface data type
+      !!
+      !! ** Method  : - Reinsert updated information from a previous
+      !!                copied/compressed surface data type into the original
+      !!                surface data and optionally deallocate the surface
+      !!                data input
+      !! 
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf),INTENT(INOUT) :: surf       ! Updated surface data
+      TYPE(obs_surf),INTENT(INOUT) :: oldsurf    ! Original surface data
+      LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
+      INTEGER,INTENT(in) :: kumout      ! Output unit
+      
+      !!* Local variables
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+
+      ! Copy data from surf to old surf
+
+      DO ji = 1, surf%nsurf
+
+         jj=surf%nsind(ji)
+
+         oldsurf%mi(jj)    = surf%mi(ji)
+         oldsurf%mj(jj)    = surf%mj(ji)
+         oldsurf%nsidx(jj) = surf%nsidx(ji)
+         oldsurf%nsfil(jj) = surf%nsfil(ji)
+         oldsurf%nyea(jj)  = surf%nyea(ji)
+         oldsurf%nmon(jj)  = surf%nmon(ji)
+         oldsurf%nday(jj)  = surf%nday(ji)
+         oldsurf%nhou(jj)  = surf%nhou(ji)
+         oldsurf%nmin(jj)  = surf%nmin(ji)
+         oldsurf%mstp(jj)  = surf%mstp(ji)
+         oldsurf%nqc(jj)   = surf%nqc(ji)
+         oldsurf%ntyp(jj)  = surf%ntyp(ji)
+         oldsurf%cwmo(jj)  = surf%cwmo(ji)
+         oldsurf%rlam(jj)  = surf%rlam(ji)
+         oldsurf%rphi(jj)  = surf%rphi(ji)
+
+      END DO
+
+      DO jk = 1, surf%nvar
+
+         DO ji = 1, surf%nsurf
+            
+            jj=surf%nsind(ji)
+
+            oldsurf%robs(jj,jk)  = surf%robs(ji,jk)
+            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk)
+
+         END DO
+
+      END DO
+
+      DO jk = 1, surf%nextra
+
+         DO ji = 1, surf%nsurf
+            
+            jj=surf%nsind(ji)
+
+            oldsurf%rext(jj,jk)  = surf%rext(ji,jk)
+
+         END DO
+
+      END DO
+
+      ! Optionally deallocate the updated surface data
+
+      IF ( ldeallocate ) CALL obs_surf_dealloc( surf )
+      
+   END SUBROUTINE obs_surf_decompress
+   
+END MODULE obs_surf_def
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_types.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 2236)
@@ -0,0 +1,261 @@
+MODULE obs_types
+   !!=====================================================================
+   !!                       ***  MODULE  obs_types  ***
+   !! Observation diagnostics: Observation type integer to character 
+   !!                          translation
+   !!=====================================================================
+
+   !!---------------------------------------------------------------------
+   !! 
+   !!   The NetCDF variable CWMO_INST_TYP_COR is used to identify the 
+   !!   different instrument types for coriolis data.
+   !!
+   !!    WMO  NEMOVAR  TYPE                   DESCRIPTION
+   !!    ---  -------  ----   --------------------------------------------
+   !!    800     0     MBT    (1941-) mechanical bathythermograph data
+   !!    401     1     XBT    (1967-) expendable bathythermograph data
+   !!    830     2     CTD    (1967-) high resolution CTD data
+   !!    820     3     MRB    (1990-) moored buoy data
+   !!    831     4     PFL    (1994-) profiling float data
+   !!    995     5     DRB    (1998-) drifting buoy data
+   !!    997     6     APB    (1997-) autonomous pinniped bathythermograph
+   !!    996     7     UOR    (1992-) undulating oceanographic recorder
+   !!    741     8     OSD    (1800-) low resolution (bottle) CTD data
+  !!
+   !! History :
+   !!        !  06-03  (K. Mogensen) Original code
+   !!        !  06-10  (A. Weaver) Cleanup
+   !!---------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE 
+
+   !! * Shared Module variables
+
+   INTEGER, PUBLIC, PARAMETER :: ntyp1770 = 1023
+   CHARACTER(LEN=4), PUBLIC, DIMENSION(0:ntyp1770) :: cwmotyp1770
+   CHARACTER(LEN=80), PUBLIC, DIMENSION(0:ntyp1770) :: cwmonam1770
+   CHARACTER(LEN=3), PUBLIC, DIMENSION(0:ntyp1770) :: ctypshort
+
+   INTEGER, PUBLIC, PARAMETER :: ntypalt = 8
+   CHARACTER(LEN=40), PUBLIC, DIMENSION(0:ntypalt) :: calttyp
+
+   PUBLIC obs_typ_init
+   PUBLIC obs_wmo_init
+   PUBLIC obs_alt_typ_init
+
+CONTAINS 
+   
+   SUBROUTINE obs_typ_init
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_wmo_init ***
+      !!
+      !! ** Purpose : Initialize code tables
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2007-06 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * Arguments
+
+      !! * Local declarations
+
+      CALL obs_wmo_init
+
+      CALL obs_alt_typ_init
+
+   END SUBROUTINE obs_typ_init
+
+   SUBROUTINE obs_wmo_init
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_wmo_init ***
+      !!
+      !! ** Purpose : Initialize WMO code 1770 code tables
+      !!
+      !! ** Method  : Direct initialisation of variables
+      !!
+      !! ** Action  : 
+      !!
+      !! References : WORLD  METEOROLOGICAL  ORGANIZATION
+      !!              Manual on Codes
+      !!              International Codes
+      !!              VOLUME I.1 (Annex II to WMO Technical Regulations)
+      !!              Part A -- Alphanumeric Codes
+      !!              1995 edition
+      !!              WMO-No. 306 
+      !!              Secretariat of the World Meteorological Organization 
+      !!              Geneva, Switzerland
+      !!
+      !! History :  
+      !!      ! :  2007-04 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * Arguments
+
+      !! * Local declarations
+      INTEGER :: ji
+
+      DO ji = 0, ntyp1770
+
+         cwmonam1770(ji) = 'Not defined'
+         ctypshort(ji) = 'XBT'
+
+         IF ( ji < 1000 ) THEN
+            WRITE(cwmotyp1770(ji),'(1X,I3.3)') ji
+         ELSE
+            WRITE(cwmotyp1770(ji),'(I4.4)') ji
+         ENDIF
+
+      END DO
+
+      cwmonam1770(   1) = 'Sippican T-4'
+      cwmonam1770(   2) = 'Sippican T-4'
+      cwmonam1770(  11) = 'Sippican T-5'
+      cwmonam1770(  21) = 'Sippican Fast Deep'
+      cwmonam1770(  31) = 'Sippican T-6'
+      cwmonam1770(  32) = 'Sippican T-6'
+      cwmonam1770(  41) = 'Sippican T-7'
+      cwmonam1770(  42) = 'Sippican T-7'
+      cwmonam1770(  51) = 'Sippican Deep Blue'
+      cwmonam1770(  52) = 'Sippican Deep Blue'
+      cwmonam1770(  61) = 'Sippican T-10'
+      cwmonam1770(  71) = 'Sippican T-11'
+      cwmonam1770( 201) = 'TSK T-4'
+      cwmonam1770( 202) = 'TSK T-4'
+      cwmonam1770( 211) = 'TSK T-6'
+      cwmonam1770( 212) = 'TSK T-6'
+      cwmonam1770( 221) = 'TSK T-7'
+      cwmonam1770( 222) = 'TSK T-7'
+      cwmonam1770( 231) = 'TSK T-5'
+      cwmonam1770( 241) = 'TSK T-10'
+      cwmonam1770( 251) = 'TSK Deep Blue'
+      cwmonam1770( 252) = 'TSK Deep Blue'
+      cwmonam1770( 261) = 'TSK AXBT '
+      cwmonam1770( 401) = 'Sparton XBT-1'
+      cwmonam1770( 411) = 'Sparton XBT-3'
+      cwmonam1770( 421) = 'Sparton XBT-4'
+      cwmonam1770( 431) = 'Sparton XBT-5'
+      cwmonam1770( 441) = 'Sparton XBT-5DB'
+      cwmonam1770( 451) = 'Sparton XBT-6'
+      cwmonam1770( 461) = 'Sparton XBT-7'
+      cwmonam1770( 462) = 'Sparton XBT-7'
+      cwmonam1770( 471) = 'Sparton XBT-7DB'
+      cwmonam1770( 481) = 'Sparton XBT-10'
+      cwmonam1770( 491) = 'Sparton XBT-20'
+      cwmonam1770( 501) = 'Sparton XBT-20DB'
+      cwmonam1770( 510) = 'Sparton 536 AXBT'
+      cwmonam1770( 700) = 'Sippican XCTD standard'
+      cwmonam1770( 710) = 'Sippican XCTD deep'
+      cwmonam1770( 720) = 'Sippican AXCTD'
+      cwmonam1770( 730) = 'Sippican SXCTD'
+      cwmonam1770( 741) = 'TSK XCTD'
+      cwmonam1770( 742) = 'TSK XCTD-2 '
+      cwmonam1770( 743) = 'TSK XCTD-2F '
+      cwmonam1770( 751) = 'TSK AXCTD '
+      cwmonam1770( 800) = 'Mechanical BT'
+      cwmonam1770( 810) = 'Hydrocast'
+      cwmonam1770( 820) = 'Thermistor Chain'
+      cwmonam1770( 825) = 'Temperature (sonic) and pressure probes'
+      cwmonam1770( 830) = 'CTD'
+      cwmonam1770( 831) = 'CTD-P-ALACE float'
+      cwmonam1770( 840) = 'PROVOR, No conductivity sensor '
+      cwmonam1770( 841) = 'PROVOR, Seabird conductivity sensor '
+      cwmonam1770( 842) = 'PROVOR, FSI conductivity sensor '
+      cwmonam1770( 845) = 'Web Research, No conductivity sensor '
+      cwmonam1770( 846) = 'Web Research, Seabird conductivity sensor '
+      cwmonam1770( 847) = 'Web Research. FSI conductivity sensor'
+      cwmonam1770( 850) = 'SOLO, No conductivity sensor '
+      cwmonam1770( 851) = 'SOLO, Seabird conductivity sensor '
+      cwmonam1770( 852) = 'SOLO, FSI conductivity sensor'
+      cwmonam1770( 855) = 'Profiling float, NINJA, no conductivity sensor'
+      cwmonam1770( 856) = 'Profiling float, NINJA, SBE conductivity sensor'
+      cwmonam1770( 857) = 'Profiling float, NINJA, FSI conductivity sensor'
+      cwmonam1770( 858) = 'Profiling float, NINJA, TSK conductivity sensor'
+      cwmonam1770( 900) = 'Sippican T-12 XBT'
+      cwmonam1770(1023) = 'Missing value'
+
+      DO ji = 853, 854
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      DO ji = 859, 899
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      DO ji = 901, 999
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      DO ji = 1000, 1022
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      ctypshort(800) = 'MBT'
+      ctypshort(401) = 'XBT'
+      ctypshort(830) = 'CTD'
+      ctypshort(820) = 'MRB'
+      ctypshort(831) = 'PFL'
+      ctypshort(995) = 'DRB'
+      ctypshort(997) = 'APB'
+      ctypshort(996) = 'UOR'
+      ctypshort(700:799) = 'OSD'
+
+   END SUBROUTINE obs_wmo_init
+
+   SUBROUTINE obs_alt_typ_init
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_alt_typ_init ***
+      !!
+      !! ** Purpose : Initialize CLS altimeter code tables
+      !!
+      !! ** Method  : Direct initialisation of variables
+      !!
+      !! ** Action  : 
+      !!
+      !! References : CLS
+      !1              SSALTO/DUACS User Handbook
+      !!              (M)SLA and (M)ADT Near-Real Time and
+      !!              Delayed time products
+      !!              CLS-DOS-NT-06-034
+      !!              2006
+      !!              CLS
+      !!              8-10 Rue Hermes
+      !!              Parc Technologique du Canal
+      !!              31526 Ramonville St-Agne
+      !!              France
+      !!
+      !! History :  
+      !!      ! :  2007-06 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * Arguments
+
+      !! * Local declarations
+
+      calttyp(0) = 'Unknown'
+      calttyp(1) = 'ERS-1'
+      calttyp(2) = 'ERS-2'
+      calttyp(3) = 'Topex/Poseidon'
+      calttyp(4) = 'Topex/Poseidon on its new orbit'
+      calttyp(5) = 'GFO'
+      calttyp(6) = 'Jason-1'
+      calttyp(7) = 'Envisat'
+      calttyp(8) = 'Jason-2'
+
+   END SUBROUTINE obs_alt_typ_init
+
+END MODULE obs_types
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_utils.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_utils.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_utils.F90	(revision 2236)
@@ -0,0 +1,206 @@
+MODULE obs_utils
+   !!======================================================================
+   !!                       ***  MODULE obs_utils   ***
+   !! Observation diagnostics: Utility functions
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   grt_cir_dis     : Great circle distance 
+   !!   grt_cir_dis_saa : Great circle distance (small angle)
+   !!   chkerr          : Error-message managment for NetCDF files
+   !!   chkdim          : Error-message managment for NetCDF files
+   !!   fatal_error     : Fatal error handling
+   !!   ddatetoymdhms   : Convert YYYYMMDD.hhmmss to components
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce, ONLY : &        ! Precision variables
+      & wp, &
+      & dp, &
+      & i8  
+   USE in_out_manager           ! I/O manager
+  
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC grt_cir_dis,     &  ! Great circle distance 
+      &   grt_cir_dis_saa, &  ! Great circle distance (small angle)
+      &   str_c_to_for,    &  ! Remove non-printable chars from string
+      &   chkerr,          &  ! Error-message managment for NetCDF files
+      &   chkdim,          &  ! Check if dimensions are correct for a variable
+      &   fatal_error,     &  ! Fatal error handling
+      &   warning,         &  ! Warning handling
+      &   ddatetoymdhms       ! Convert YYYYMMDD.hhmmss to components
+         
+CONTAINS
+ 
+#include "grt_cir_dis.h90"
+
+#include "grt_cir_dis_saa.h90"
+
+#include "str_c_to_for.h90"
+
+   SUBROUTINE chkerr( kstatus, cd_name, klineno )
+      !!----------------------------------------------------------------------
+      !!   
+      !!                    *** ROUTINE chkerr ***
+      !! 
+      !! ** Purpose : Error-message managment for NetCDF files.
+      !! 
+      !! ** Method  : 
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      ! 02-12  (N. Daget)  hdlerr
+      !!      ! 06-04  (A. Vidard) f90/nemovar migration, change name
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE netcdf             ! NetCDF library
+      USE dom_oce, ONLY : &  ! Ocean space and time domain variables
+         & nproc
+
+      !! * Arguments
+      INTEGER :: kstatus
+      INTEGER :: klineno
+      CHARACTER(LEN=*) :: cd_name
+      
+      !! * Local declarations
+      CHARACTER(len=200) :: clineno
+
+      ! Main computation
+      IF ( kstatus /= nf90_noerr ) THEN
+         WRITE(clineno,'(A,I8)')' at line number ', klineno
+         CALL ctl_stop( ' chkerr', ' Netcdf Error in ' // TRIM( cd_name ), &
+            &           clineno, nf90_strerror( kstatus ) )
+      ENDIF
+
+   END SUBROUTINE chkerr
+
+   SUBROUTINE chkdim( kfileid, kvarid, kndim, kdim, cd_name, klineno )
+      !!----------------------------------------------------------------------
+      !!   
+      !!                    *** ROUTINE chkerr ***
+      !! 
+      !! ** Purpose : Error-message managment for NetCDF files.
+      !! 
+      !! ** Method  : 
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      ! 07-03  (K. Mogenen + E. Remy) Initial version
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE netcdf             ! NetCDF library
+      USE dom_oce, ONLY : &  ! Ocean space and time domain variables
+         & nproc
+
+      !! * Arguments
+      INTEGER :: kfileid       ! NetCDF file id   
+      INTEGER :: kvarid        ! NetCDF variable id   
+      INTEGER :: kndim         ! Expected number of dimensions
+      INTEGER, DIMENSION(kndim) :: kdim      ! Expected dimensions
+      CHARACTER(LEN=*) :: cd_name            ! Calling routine name
+      INTEGER ::  klineno      ! Calling line number
+
+      !! * Local declarations
+      INTEGER :: indim
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
+         & idim,ilendim
+      INTEGER :: ji
+      LOGICAL :: llerr
+      CHARACTER(len=200) :: clineno
+
+      CALL chkerr( nf90_inquire_variable( kfileid, kvarid, ndims=indim ), &
+         &         cd_name, klineno )
+
+      ALLOCATE(idim(indim),ilendim(indim))
+
+      CALL chkerr( nf90_inquire_variable( kfileid, kvarid, dimids=idim ), &
+         &         cd_name, klineno )
+
+      DO ji = 1, indim
+         CALL chkerr( nf90_inquire_dimension( kfileid, idim(ji), &
+            &                                 len=ilendim(ji) ), &
+            &         cd_name, klineno )
+      END DO
+      
+      IF ( indim /= kndim ) THEN
+         WRITE(clineno,'(A,I8)')' at line number ', klineno
+         CALL ctl_stop( ' chkdim',  &
+            &           ' Netcdf no dim error in ' // TRIM( cd_name ), &
+            &           clineno )
+      ENDIF
+
+      DO ji = 1, indim
+         IF ( ilendim(ji) /= kdim(ji) ) THEN
+            WRITE(clineno,'(A,I8)')' at line number ', klineno
+            CALL ctl_stop( ' chkdim',  &
+               &           ' Netcdf dim len error in ' // TRIM( cd_name ), &
+               &           clineno )
+         ENDIF
+      END DO
+         
+      DEALLOCATE(idim,ilendim)
+
+   END SUBROUTINE chkdim
+   
+  SUBROUTINE fatal_error( cd_name, klineno )
+      !!----------------------------------------------------------------------
+      !!
+      !!                    *** ROUTINE fatal_error ***
+      !!
+      !! ** Purpose : Fatal error handling
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: klineno
+      CHARACTER(LEN=*) :: cd_name
+      !! * Local declarations
+      CHARACTER(len=200) :: clineno
+
+      WRITE(clineno,'(A,I8)')' at line number ', klineno
+      CALL ctl_stop( ' fatal_error', ' Error in ' // TRIM( cd_name ), &
+         &           clineno)
+      
+   END SUBROUTINE fatal_error
+
+   SUBROUTINE warning( cd_name, klineno )
+      !!----------------------------------------------------------------------
+      !!
+      !!                    *** ROUTINE warning ***
+      !!
+      !! ** Purpose : Warning handling
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: klineno
+      CHARACTER(LEN=*) :: cd_name
+      !! * Local declarations
+      CHARACTER(len=200) :: clineno
+
+      WRITE(clineno,'(A,I8)')' at line number ', klineno
+      CALL ctl_warn( ' warning', ' Potential problem in ' // TRIM( cd_name ), &
+         &           clineno)
+      
+   END SUBROUTINE warning
+
+#include "ddatetoymdhms.h90"
+
+END MODULE obs_utils
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_vel_io.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_vel_io.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_vel_io.F90	(revision 2236)
@@ -0,0 +1,26 @@
+MODULE obs_vel_io
+   !!======================================================================
+   !!                       ***  MODULE obs_vel_io  ***
+   !! Observation operators : I/O for TAO velocity data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version based on obs_read_taovel
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_taofile    :  Read a obfbdata structure from an TAO velocity file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE in_out_manager
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+CONTAINS
+
+#include "obsvel_io.h90"
+
+END MODULE obs_vel_io
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_write.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 2236)
@@ -0,0 +1,908 @@
+MODULE obs_write
+   !!======================================================================
+   !!                       ***  MODULE obs_write   ***
+   !! Observation diagnosticss: Write observation related diagnostics
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   cdf_wri_p3d   : Write profile observation diagnostics in NetCDF format
+   !!   obs_wri_sla   : Write SLA observation related diagnostics
+   !!   obs_wri_sst   : Write SST observation related diagnostics
+   !!   obs_wri_seaice: Write seaice observation related diagnostics
+   !!   cdf_wri_vel   : Write velocity observation diagnostics in NetCDF format
+   !!----------------------------------------------------------------------
+
+   !! * Modules used
+   USE par_kind, ONLY : &   ! Precision variables
+      & wp
+   USE in_out_manager       ! I/O manager
+   USE dom_oce              ! Ocean space and time domain variables
+   USE obs_types            ! Observation type integer to character translation
+   USE julian, ONLY : &         ! Julian date routines
+      & greg2jul
+   USE obs_utils, ONLY : &  ! Observation operator utility functions
+      & chkerr
+   USE obs_profiles_def     ! Type definitions for profiles
+   USE obs_surf_def         ! Type defintions for surface observations
+   USE obs_fbm              ! Observation feedback I/O
+   USE obs_grid             ! Grid tools
+   USE obs_conv             ! Conversion between units
+   USE obs_const
+   USE obs_sla_types
+   USE obs_rot_vel          ! Rotation of velocities
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC obs_wri_p3d, &    ! Write profile observation related diagnostics
+      &   obs_wri_sla, &    ! Write SLA observation related diagnostics
+      &   obs_wri_sst, &    ! Write SST observation related diagnostics
+      &   obs_wri_sss, &    ! Write SSS observation related diagnostics
+      &   obs_wri_seaice, & ! Write seaice observation related diagnostics
+      &   obs_wri_vel, &    ! Write velocity observation related diagnostics
+      &   obswriinfo
+   
+   TYPE obswriinfo
+      INTEGER :: inum
+      INTEGER, POINTER, DIMENSION(:) :: ipoint
+      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: cdname
+      CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: cdlong
+      CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: cdunit
+   END TYPE obswriinfo
+
+CONTAINS
+
+   SUBROUTINE obs_wri_p3d( cprefix, profdata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_p3d  ***
+      !!
+      !! ** Purpose : Write temperature and salinity (profile) observation 
+      !!              related diagnostics
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-04  (A. Vidard) Reformatted
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!      ! 07-01  (K. Mogensen) Use profile data types
+      !!      ! 07-03  (K. Mogensen) General handling of profiles
+      !!      ! 09-01  (K. Mogensen) New feedback format
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix        ! Prefix for output files
+      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data
+      TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info
+      
+      !! * Local declarations
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname
+      INTEGER :: ilevel
+      INTEGER :: jvar
+      INTEGER :: jo
+      INTEGER :: jk
+      INTEGER :: ik
+      INTEGER :: ja
+      INTEGER :: je
+      REAL(wp) :: zpres
+      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 )
+
+      ! Find maximum level
+      ilevel = 0
+      DO jvar = 1, 2
+         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) )
+      END DO
+      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, &
+         &                 1 + nadd, 1 + next, .TRUE. )
+
+      fbdata%cname(1)      = 'POTM'
+      fbdata%cname(2)      = 'PSAL'
+      fbdata%coblong(1)    = 'Potential temperature'
+      fbdata%coblong(2)    = 'Practical salinity'
+      fbdata%cobunit(1)    = 'Degrees centigrade'
+      fbdata%cobunit(2)    = 'PSU'
+      fbdata%cextname(1)   = 'TEMP'
+      fbdata%cextlong(1)   = 'Insitu temperature'
+      fbdata%cextunit(1)   = 'Degrees centigrade'
+      DO je = 1, next
+         fbdata%cextname(1+je) = pext%cdname(je)
+         fbdata%cextlong(1+je) = pext%cdlong(je,1)
+         fbdata%cextunit(1+je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated potential temperature'
+      fbdata%caddlong(1,2) = 'Model interpolated practical salinity'
+      fbdata%caddunit(1,1) = 'Degrees centigrade'
+      fbdata%caddunit(1,2) = 'PSU'
+      fbdata%cgrid(:)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(1+ja) = padd%cdname(ja)
+         DO jvar = 1, 2
+            fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar)
+            fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar)
+         END DO
+      END DO
+         
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_p3d :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing profile feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, profdata%nprof
+         fbdata%plam(jo)      = profdata%rlam(jo)
+         fbdata%pphi(jo)      = profdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:)
+         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:)
+         IF ( profdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo)
+            fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = profdata%nqc(jo)
+            fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo)
+         ENDIF
+         fbdata%ipqc(jo)      = profdata%ipqc(jo)
+         fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo)
+         fbdata%itqc(jo)      = profdata%itqc(jo)
+         fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo)
+         fbdata%cdwmo(jo)     = profdata%cwmo(jo)
+         fbdata%kindex(jo)    = profdata%npfil(jo)
+         DO jvar = 1, profdata%nvar
+            IF (ln_grid_global) THEN
+               fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
+               fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
+            ELSE
+               fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
+               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
+            ENDIF
+         END DO
+         CALL greg2jul( 0, &
+            &           profdata%nmin(jo), &
+            &           profdata%nhou(jo), &
+            &           profdata%nday(jo), &
+            &           profdata%nmon(jo), &
+            &           profdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         ! Reform the profiles arrays for output
+         DO jvar = 1, 2
+            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar)
+               ik = profdata%var(jvar)%nvlidx(jk)
+               fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk)
+               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk)
+               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk)
+               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk)
+               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk)
+               IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN
+                  fbdata%ivlqc(ik,jo,jvar) = 4
+                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk)
+                  fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10
+               ELSE
+                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk)
+                  fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk)
+               ENDIF
+               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
+               DO ja = 1, nadd
+                  fbdata%padd(ik,jo,1+ja,jvar) = &
+                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
+               END DO
+               DO je = 1, next
+                  fbdata%pext(ik,jo,1+je) = &
+                     & profdata%var(jvar)%vext(jk,pext%ipoint(je))
+               END DO
+               IF ( jvar == 1 ) THEN
+                  fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1)
+               ENDIF 
+            END DO
+         END DO
+      END DO
+
+      ! Convert insitu temperature to potential temperature using the model
+      ! salinity if no potential temperature
+      DO jo = 1, fbdata%nobs
+         IF ( fbdata%pphi(jo) < 9999.0 ) THEN
+            DO jk = 1, fbdata%nlev
+               IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. &
+                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
+                  & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. &
+                  & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN
+                  zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), &
+                     &              REAL(fbdata%pphi(jo),wp) )
+                  fbdata%pob(jk,jo,1) = potemp( &
+                     &                     REAL(fbdata%padd(jk,jo,1,2), wp),  &
+                     &                     REAL(fbdata%pext(jk,jo,1), wp), &
+                     &                     zpres, 0.0_wp )
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+      
+      CALL dealloc_obfbdata( fbdata )
+     
+   END SUBROUTINE obs_wri_p3d
+
+   SUBROUTINE obs_wri_sla( cprefix, sladata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_sla  ***
+      !!
+      !! ** Purpose : Write SLA observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-03  (K. Mogensen) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix          ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: sladata         ! Full set of SLAa
+      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_sla'
+      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, sladata%nsurf, 1, &
+         &                 2 + nadd, 1 + next, .TRUE. )
+
+      fbdata%cname(1)      = 'SLA'
+      fbdata%coblong(1)    = 'Sea level anomaly'
+      fbdata%cobunit(1)    = 'Metres'
+      fbdata%cextname(1)   = 'MDT'
+      fbdata%cextlong(1)   = 'Mean dynamic topography'
+      fbdata%cextunit(1)   = 'Metres'
+      DO je = 1, next
+         fbdata%cextname(1+je) = pext%cdname(je)
+         fbdata%cextlong(1+je) = pext%cdlong(je,1)
+         fbdata%cextunit(1+je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT'
+      fbdata%caddunit(1,1) = 'Metres' 
+      fbdata%caddname(2)   = 'SSH'
+      fbdata%caddlong(2,1) = 'Model Sea surface height'
+      fbdata%caddunit(2,1) = 'Metres'
+      fbdata%cgrid(1)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(2+ja) = padd%cdname(ja)
+         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(2+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_sla :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing SLA feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, sladata%nsurf
+         fbdata%plam(jo)      = sladata%rlam(jo)
+         fbdata%pphi(jo)      = sladata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') sladata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( sladata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = sladata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = sladata%nqc(jo)
+            fbdata%ioqcf(:,jo) = 0
+         ENDIF
+         fbdata%ipqc(jo)      = 0
+         fbdata%ipqcf(:,jo)   = 0
+         fbdata%itqc(jo)      = 0
+         fbdata%itqcf(:,jo)   = 0
+         fbdata%cdwmo(jo)     = sladata%cwmo(jo)
+         fbdata%kindex(jo)    = sladata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = sladata%mi(jo)
+            fbdata%iobsj(jo,1) = sladata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(sladata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(sladata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           sladata%nmin(jo), &
+            &           sladata%nhou(jo), &
+            &           sladata%nday(jo), &
+            &           sladata%nmon(jo), &
+            &           sladata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = sladata%rmod(jo,1)
+         fbdata%padd(1,jo,2,1) = sladata%rext(jo,1)
+         fbdata%pob(1,jo,1)    = sladata%robs(jo,1) 
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( sladata%nqc(jo) > 10 ) THEN
+            fbdata%ivqc(jo,1)       = 4
+            fbdata%ivlqc(1,jo,1)    = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10
+         ELSE
+            fbdata%ivqc(jo,1)       = sladata%nqc(jo)
+            fbdata%ivlqc(1,jo,1)    = sladata%nqc(jo)
+            fbdata%ivlqcf(:,1,jo,1) = 0
+         ENDIF
+         fbdata%iobsk(1,jo,1)  = 0
+         fbdata%pext(1,jo,1) = sladata%rext(jo,2)
+         DO ja = 1, nadd
+            fbdata%padd(1,jo,2+ja,1) = &
+               & sladata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,1+je) = &
+               & sladata%rext(jo,pext%ipoint(je))
+         END DO
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_sla
+
+   SUBROUTINE obs_wri_sst( cprefix, sstdata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_sst  ***
+      !!
+      !! ** Purpose : Write SST observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-07  (S. Ricci) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata      ! Full set of SST
+      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_sst'
+      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, sstdata%nsurf, 1, &
+         &                 1 + nadd, next, .TRUE. )
+
+      fbdata%cname(1)      = 'SST'
+      fbdata%coblong(1)    = 'Sea surface temperature'
+      fbdata%cobunit(1)    = 'Degree centigrade'
+      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 SST'
+      fbdata%caddunit(1,1) = 'Degree centigrade'
+      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_sst :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing SST feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, sstdata%nsurf
+         fbdata%plam(jo)      = sstdata%rlam(jo)
+         fbdata%pphi(jo)      = sstdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') sstdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( sstdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = sstdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = MAX(sstdata%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)    = sstdata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = sstdata%mi(jo)
+            fbdata%iobsj(jo,1) = sstdata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(sstdata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(sstdata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           sstdata%nmin(jo), &
+            &           sstdata%nhou(jo), &
+            &           sstdata%nday(jo), &
+            &           sstdata%nmon(jo), &
+            &           sstdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = sstdata%rmod(jo,1)
+         fbdata%pob(1,jo,1)    = sstdata%robs(jo,1)
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( sstdata%nqc(jo) > 10 ) THEN
+            fbdata%ivqc(jo,1)       = 4
+            fbdata%ivlqc(1,jo,1)    = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10
+         ELSE
+            fbdata%ivqc(jo,1)       = MAX(sstdata%nqc(jo),1)
+            fbdata%ivlqc(1,jo,1)    = MAX(sstdata%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) = &
+               & sstdata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,je) = &
+               & sstdata%rext(jo,pext%ipoint(je))
+         END DO
+
+      END DO
+
+      ! Write the obfbdata structure
+
+      CALL write_obfbdata( cfname, fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_sst
+
+   SUBROUTINE obs_wri_sss
+   END SUBROUTINE obs_wri_sss
+
+   SUBROUTINE obs_wri_seaice( cprefix, seaicedata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_seaice  ***
+      !!
+      !! ** Purpose : Write sea ice observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-07  (S. Ricci) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedata   ! Full set of sea ice
+      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_seaice'
+      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, seaicedata%nsurf, 1, 1, 0, .TRUE. )
+
+      fbdata%cname(1)      = 'SEAICE'
+      fbdata%coblong(1)    = 'Sea ice'
+      fbdata%cobunit(1)    = 'Fraction'
+      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 ICE'
+      fbdata%caddunit(1,1) = 'Fraction'
+      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_seaice :'
+         WRITE(numout,*)'~~~~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing SEAICE feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, seaicedata%nsurf
+         fbdata%plam(jo)      = seaicedata%rlam(jo)
+         fbdata%pphi(jo)      = seaicedata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') seaicedata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( seaicedata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = seaicedata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = MAX(seaicedata%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)    = seaicedata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = seaicedata%mi(jo)
+            fbdata%iobsj(jo,1) = seaicedata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(seaicedata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(seaicedata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           seaicedata%nmin(jo), &
+            &           seaicedata%nhou(jo), &
+            &           seaicedata%nday(jo), &
+            &           seaicedata%nmon(jo), &
+            &           seaicedata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = seaicedata%rmod(jo,1)
+         fbdata%pob(1,jo,1)    = seaicedata%robs(jo,1)
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( seaicedata%nqc(jo) > 10 ) THEN
+            fbdata%ivlqc(1,jo,1) = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = seaicedata%nqc(jo) - 10
+         ELSE
+            fbdata%ivlqc(1,jo,1) = MAX(seaicedata%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) = &
+               & seaicedata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,je) = &
+               & seaicedata%rext(jo,pext%ipoint(je))
+         END DO
+
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_seaice
+
+   SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_p3d  ***
+      !!
+      !! ** Purpose : Write current (profile) observation 
+      !!              related diagnostics
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 09-01  (K. Mogensen) New feedback format routine
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data
+      INTEGER, INTENT(IN) :: k2dint                 ! Horizontal interpolation method
+      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
+
+      !! * Local declarations
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname
+      INTEGER :: ilevel
+      INTEGER :: jvar
+      INTEGER :: jk
+      INTEGER :: ik
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+      REAL(wp) :: zpres
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zu, &
+         & zv
+
+      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 )
+
+      ! Find maximum level
+      ilevel = 0
+      DO jvar = 1, 2
+         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) )
+      END DO
+      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. )
+
+      fbdata%cname(1)      = 'UVEL'
+      fbdata%cname(2)      = 'VVEL'
+      fbdata%coblong(1)    = 'Zonal velocity'
+      fbdata%coblong(2)    = 'Meridional velocity'
+      fbdata%cobunit(1)    = 'm/s'
+      fbdata%cobunit(2)    = 'm/s'
+      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 zonal velocity'
+      fbdata%caddlong(1,2) = 'Model interpolated meridional velocity'
+      fbdata%caddunit(1,1) = 'm/s'
+      fbdata%caddunit(1,2) = 'm/s'
+      fbdata%caddname(2)   = 'HxG'
+      fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)'
+      fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)'
+      fbdata%caddunit(2,1) = 'm/s'
+      fbdata%caddunit(2,2) = 'm/s' 
+      fbdata%cgrid(1)      = 'U' 
+      fbdata%cgrid(2)      = 'V'
+      DO ja = 1, nadd
+         fbdata%caddname(2+ja) = padd%cdname(ja)
+         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(2+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_vel :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing velocuty feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ALLOCATE( &
+         & zu(profdata%nvprot(1)), &
+         & zv(profdata%nvprot(2))  &
+         & )
+      CALL obs_rotvel( profdata, k2dint, zu, zv )
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, profdata%nprof
+         fbdata%plam(jo)      = profdata%rlam(jo)
+         fbdata%pphi(jo)      = profdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:)
+         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:)
+         IF ( profdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo)
+            fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = profdata%nqc(jo)
+            fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo)
+         ENDIF
+         fbdata%ipqc(jo)      = profdata%ipqc(jo)
+         fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo)
+         fbdata%itqc(jo)      = profdata%itqc(jo)
+         fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo)
+         fbdata%cdwmo(jo)     = profdata%cwmo(jo)
+         fbdata%kindex(jo)    = profdata%npfil(jo)
+         DO jvar = 1, profdata%nvar
+            IF (ln_grid_global) THEN
+               fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
+               fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
+            ELSE
+               fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
+               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
+            ENDIF
+         END DO
+         CALL greg2jul( 0, &
+            &           profdata%nmin(jo), &
+            &           profdata%nhou(jo), &
+            &           profdata%nday(jo), &
+            &           profdata%nmon(jo), &
+            &           profdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         ! Reform the profiles arrays for output
+         DO jvar = 1, 2
+            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar)
+               ik = profdata%var(jvar)%nvlidx(jk)
+               IF ( jvar == 1 ) THEN
+                  fbdata%padd(ik,jo,1,jvar) = zu(jk)
+               ELSE
+                  fbdata%padd(ik,jo,1,jvar) = zv(jk)
+               ENDIF
+               fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vmod(jk)
+               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk)
+               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk)
+               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk)
+               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk)
+               IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN
+                  fbdata%ivlqc(ik,jo,jvar) = 4
+                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk)
+                  fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10
+               ELSE
+                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk)
+                  fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk)
+               ENDIF
+               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
+               DO ja = 1, nadd
+                  fbdata%padd(ik,jo,2+ja,jvar) = &
+                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
+               END DO
+               DO je = 1, next
+                  fbdata%pext(ik,jo,je) = &
+                     & profdata%var(jvar)%vext(jk,pext%ipoint(je))
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+      
+      CALL dealloc_obfbdata( fbdata )
+     
+      DEALLOCATE( &
+         & zu, &
+         & zv  &
+         & )
+
+   END SUBROUTINE obs_wri_vel
+
+END MODULE obs_write
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsinter_h2d.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsinter_h2d.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsinter_h2d.h90	(revision 2236)
@@ -0,0 +1,1357 @@
+   !!----------------------------------------------------------------------
+   !!    This software is governed by the CeCILL licence (Version 2)
+   !!    (See NEMOVAR_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   SUBROUTINE obs_int_h2d_init( kpk,   kpk2,  k2dint, plam,  pphi, &
+      &                         pglam, pgphi, pmask,  pweig, pobsmask, &
+      &                         iminpoints )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d  ***
+      !!
+      !! ** Purpose : Computes weights for horizontal interpolation to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Horizontal interpolation to the observation point using
+      !!              model values at the corners of the surrounding grid 
+      !!              points.
+      !!
+      !!    Interpolation Schemes : 
+      !!
+      !!    1) k2dint = 0: Distance-weighted interpolation scheme 1
+      !!
+      !!       The interpolation weights are computed as a weighted 
+      !!       sum of the distance between the model grid points (A)
+      !!       and the observation point (B). Distance (s) is computed 
+      !!       using the great-circle distance formula: 
+      !!
+      !!       s(AB) = arcos(   sin( phiA ) x sin( phiB )
+      !!                      + cos( phiA ) x cos( phiB ) 
+      !!                                    x cos( lamB - lamA ) )
+      !!
+      !!    2) k2dint = 1: Distance-weighted interpolation scheme 2
+      !!
+      !!       As k2dint = 0 but with distance (ds) computed using 
+      !!       a small-angle approximation to the great-circle formula:
+      !!
+      !!       ds(AB) = sqrt(   ( phiB - phiA )^{2} 
+      !!                    + ( ( lamB - lamA ) * cos( phiB ) )^{2} )
+      !!
+      !!    3) k2dint = 2: Bilinear interpolation on a geographical grid
+      !!
+      !!       The interpolation is split into two 1D interpolations in
+      !!       the longitude and latitude directions, respectively.
+      !!
+      !!    4) k2dint = 3: General bilinear remapping interpolation
+      !!
+      !!       An iterative scheme that involves first mapping a 
+      !!       quadrilateral cell into a cell with coordinates 
+      !!       (0,0), (1,0), (0,1) and (1,1).
+      !!
+      !!    5) k2dint = 4: Polynomial interpolation
+      !!
+      !!       The interpolation weights are computed by fitting a 
+      !!       polynomial function of the form 
+      !!              
+      !!       P(i) = a1(i) + a2(i) * phi + a3(i) * plam 
+      !!                                  + a4(i) * phi * plam
+      !!    
+      !!       through the model values at the four surrounding grid points.
+      !!
+      !! ** Action  :
+      !!                   
+      !! References : Jones, P.: A users guide for SCRIP: A Spherical 
+      !!                        Coordinate Remapping and Interpolation Package.
+      !!                        Version 1.4. Los Alomos. 
+      !!                    
+      !!       http://www.acl.lanl.gov/climate/software/SCRIP/SCRIPmain.html
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-03 (A. Vidard) NEMOVAR migration
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!        ! 07-08 (K. Mogensen) Split in two routines for easier adj.
+      !!-----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk,   &             ! Parameter values for automatic arrays
+         & kpk2,  &        
+         & k2dint               ! Interpolation scheme options
+                                ! = 0 distance-weighted (great circle)
+                                ! = 1 distance-weighted (small angle)
+                                ! = 2 bilinear (geographical grid)
+                                ! = 3 bilinear (quadrilateral grid)
+                                ! = 4 polynomial (quadrilateral grid)
+      REAL(KIND=wp), INTENT(INOUT) :: &
+         & plam, &
+         & pphi                 ! Geographical (lat,lon) coordinates of
+                                ! observation
+      REAL(KIND=wp), DIMENSION(2,2), INTENT(IN) :: &
+         & pglam, &             ! Model variable lat
+         & pgphi                ! Model variable lon
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask                ! Model variable mask
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(OUT) ::  &
+         & pweig                ! Weights for interpolation
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) ::  &
+         & pobsmask             ! Vertical mask for observations
+      INTEGER, INTENT(IN), OPTIONAL :: &
+         & iminpoints           ! Reject point which is not surrounded
+                                ! by at least iminpoints sea points
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      INTEGER :: &
+         & ikmax, &
+         & iamb1, &
+         & iamb2
+      REAL(KIND=wp) :: &
+         & zphimm,  &
+         & zphimp,  &
+         & zphipm,  &
+         & zphipp,  &
+         & zlammm,  &
+         & zlammp,  &
+         & zlampm,  &
+         & zlampp,  &
+         & zphimin, &
+         & zphimax, &
+         & zlammin, &
+         & zlammax
+      REAL(KIND=wp), DIMENSION(kpk2) :: &
+         & z2dmm,  &
+         & z2dmp,  &
+         & z2dpm,  &
+         & z2dpp,  &
+         & z2dmmt, &
+         & z2dmpt, &
+         & z2dpmt, &
+         & z2dppt, &
+         & zsum
+      LOGICAL :: &
+         & ll_ds1, &
+         & ll_skip, &
+         & ll_fail
+       
+      !------------------------------------------------------------------------
+      ! Constants for the 360 degrees ambiguity
+      !------------------------------------------------------------------------
+      iamb1 = 10   ! dlam < iamb1 * dphi
+      iamb2 = 3    ! Special treatment if iamb2 * lam < max(lam) 
+       
+      !------------------------------------------------------------------------
+      ! Initialize number of levels
+      !------------------------------------------------------------------------
+      IF ( kpk2 == 1 ) THEN
+         ikmax = 1
+      ELSEIF ( kpk2 == kpk) THEN
+         ikmax = kpk-1
+      ENDIF
+      !------------------------------------------------------------------------
+      ! Initialize the cell corners
+      !------------------------------------------------------------------------
+      zphimm = pgphi(1,1)
+      zphimp = pgphi(1,2)
+      zphipm = pgphi(2,1)
+      zphipp = pgphi(2,2)
+      zlammm = pglam(1,1)
+      zlammp = pglam(1,2)
+      zlampm = pglam(2,1)
+      zlampp = pglam(2,2)
+       
+      !------------------------------------------------------------------------
+      ! Treat the 360 degrees ambiguity
+      !------------------------------------------------------------------------
+      DO WHILE ( ( zlammm < 0.0_wp ).OR.( zlammm > 360.0_wp )  &
+         &   .OR.( zlampm < 0.0_wp ).OR.( zlampm > 360.0_wp )  &
+         &   .OR.( zlampp < 0.0_wp ).OR.( zlampp > 360.0_wp )  &
+         &   .OR.( zlammp < 0.0_wp ).OR.( zlammp > 360.0_wp ) )
+       
+         IF ( zlammm < 0.0_wp   ) zlammm = zlammm + 360.0_wp
+         IF ( zlammm > 360.0_wp ) zlammm = zlammm - 360.0_wp
+         IF ( zlammp < 0.0_wp   ) zlammp = zlammp + 360.0_wp
+         IF ( zlammp > 360.0_wp ) zlammp = zlammp - 360.0_wp
+         IF ( zlampm < 0.0_wp   ) zlampm = zlampm + 360.0_wp
+         IF ( zlampm > 360.0_wp ) zlampm = zlampm - 360.0_wp
+         IF ( zlampp < 0.0_wp   ) zlampp = zlampp + 360.0_wp
+         IF ( zlampp > 360.0_wp ) zlampp = zlampp - 360.0_wp
+       
+      END DO
+
+      DO WHILE ( ( plam < 0.0_wp ) .OR. ( plam > 360.0_wp ) )
+         IF ( plam < 0.0_wp   ) plam = plam + 360.0_wp
+         IF ( plam > 360.0_wp ) plam = plam - 360.0_wp
+      END DO
+
+      !------------------------------------------------------------------------
+      ! Special case for observation on grid points
+      !------------------------------------------------------------------------
+      ll_skip = .FALSE.
+      IF ( ( ABS( zphimm - pphi ) < 1.0e-6_wp ) .AND. &
+         & ( ABS( zlammm - plam ) < 1.0e-6_wp ) ) THEN
+         z2dmm(:) = 1.0_wp
+         z2dpm(:) = 0.0_wp
+         z2dmp(:) = 0.0_wp
+         z2dpp(:) = 0.0_wp
+         ll_skip = .TRUE.
+      ENDIF
+      IF ( ( ABS( zphipm - pphi ) < 1.0e-6_wp ) .AND. &
+         & ( ABS( zlampm - plam ) < 1.0e-6_wp ) ) THEN
+         z2dmm(:) = 0.0_wp
+         z2dpm(:) = 1.0_wp
+         z2dmp(:) = 0.0_wp
+         z2dpp(:) = 0.0_wp
+         ll_skip = .TRUE.
+      ENDIF
+      IF ( ( ABS( zphimp - pphi ) < 1.0e-6_wp ) .AND. &
+         & ( ABS( zlammp - plam ) < 1.0e-6_wp ) ) THEN
+         z2dmm(:) = 0.0_wp
+         z2dpm(:) = 0.0_wp
+         z2dmp(:) = 1.0_wp
+         z2dpp(:) = 0.0_wp
+         ll_skip = .TRUE.
+      ENDIF
+      IF ( ( ABS( zphipp - pphi ) < 1.0e-6_wp ) .AND. &
+         & ( ABS( zlampp - plam ) < 1.0e-6_wp ) ) THEN
+         z2dmm(:) = 0.0_wp
+         z2dpm(:) = 0.0_wp
+         z2dmp(:) = 0.0_wp
+         z2dpp(:) = 1.0_wp
+         ll_skip = .TRUE.
+      ENDIF
+
+      IF ( .NOT.ll_skip ) THEN
+
+         zphimin = MIN( zphimm, zphipm, zphipp, zphimp )
+         zphimax = MAX( zphimm, zphipm, zphipp, zphimp )
+         zlammin = MIN( zlammm, zlampm, zlampp, zlammp )
+         zlammax = MAX( zlammm, zlampm, zlampp, zlammp )
+
+         IF ( ( ( zlammax - zlammin ) / ( zphimax - zphimin ) ) > iamb1 ) THEN
+            IF ( iamb2 * zlammm < zlammax ) zlammm = zlammm + 360.0_wp
+            IF ( iamb2 * zlammp < zlammax ) zlammp = zlammp + 360.0_wp
+            IF ( iamb2 * zlampm < zlammax ) zlampm = zlampm + 360.0_wp
+            IF ( iamb2 * zlampp < zlammax ) zlampp = zlampp + 360.0_wp
+         ENDIF
+
+         zlammin = MIN( zlammm, zlampm, zlampp, zlammp )
+         IF ( zlammm > ( zlammin + 180.0_wp ) ) zlammm = zlammm - 360.0_wp
+         IF ( zlammp > ( zlammin + 180.0_wp ) ) zlammp = zlammp - 360.0_wp
+         IF ( zlampm > ( zlammin + 180.0_wp ) ) zlampm = zlampm - 360.0_wp
+         IF ( zlampp > ( zlammin + 180.0_wp ) ) zlampp = zlampp - 360.0_wp
+         
+         IF ( plam < zlammin ) plam = plam + 360.0_wp
+	   z2dmm = 0.0_wp
+	   z2dmp = 0.0_wp
+	   z2dpm = 0.0_wp
+	   z2dpp = 0.0_wp
+         SELECT CASE (k2dint)
+            
+         CASE(0)
+            CALL obs_int_h2d_ds1( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                  zphimm, zlammm, zphimp, zlammp,     & 
+               &                  zphipm, zlampm, zphipp, zlampp,     &
+               &                  z2dmm, z2dmp, z2dpm, z2dpp )
+         CASE(1)
+            CALL obs_int_h2d_ds2( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                  zphimm, zlammm, zphimp, zlammp,     &
+               &                  zphipm, zlampm, zphipp, zlampp,     &
+               &                  z2dmm, z2dmp, z2dpm, z2dpp )
+         CASE(2)
+            CALL obs_int_h2d_bil( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                                          zlammp,     &
+               &                  zphipm,         zphipp, zlampp,     &
+               &                  z2dmm, z2dmp, z2dpm, z2dpp )
+         CASE(3)
+            CALL obs_int_h2d_bir( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                  zphimm, zlammm, zphimp, zlammp,     &
+               &                  zphipm, zlampm, zphipp, zlampp,     &
+               &                  z2dmm, z2dmp, z2dpm, z2dpp, ll_fail )
+            IF (ll_fail) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*)'Bilinear weight computation failed'
+                  WRITE(numout,*)'Switching to great circle distance'
+                  WRITE(numout,*)
+               ENDIF
+               CALL obs_int_h2d_ds1( kpk2, ikmax,                        &
+                  &                  pphi, plam, pmask,                  &
+                  &                  zphimm, zlammm, zphimp, zlammp,     & 
+                  &                  zphipm, zlampm, zphipp, zlampp,     &
+                  &                  z2dmm, z2dmp, z2dpm, z2dpp )
+            ENDIF
+         CASE(4)  
+            CALL obs_int_h2d_pol( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                  zphimm, zlammm, zphimp, zlammp,     &
+               &                  zphipm, zlampm, zphipp, zlampp,     & 
+               &                  z2dmm, z2dmp, z2dpm, z2dpp )
+         END SELECT
+
+      ENDIF
+      !------------------------------------------------------------------------
+      ! Compute weights for interpolation to the observation point
+      !------------------------------------------------------------------------
+      pobsmask(:) = 0.0_wp
+      pweig(:,:,:) = 0.0_wp
+      ! ll_ds1 is used for failed interpolations
+      ll_ds1 = .FALSE.
+      DO jk = 1, ikmax
+         IF (PRESENT(iminpoints)) THEN
+            IF (NINT(SUM(pmask(:,:,jk)))<iminpoints) CYCLE
+         ENDIF
+         zsum(jk) = z2dmm(jk) + z2dmp(jk) + z2dpm(jk) + z2dpp(jk) 
+         IF ( zsum(jk) /= 0.0_wp ) THEN
+            pweig(1,1,jk) = z2dmm(jk) 
+            pweig(1,2,jk) = z2dmp(jk)
+            pweig(2,1,jk) = z2dpm(jk)
+            pweig(2,2,jk) = z2dpp(jk)
+            ! Set the vertical mask
+            IF ( ( ( z2dmm(jk) > 0.0_wp ) .AND.       &
+               &   ( pmask(1,1,jk) == 1.0_wp ) ) .OR. &
+               & ( ( z2dmp(jk) > 0.0_wp ) .AND.       &
+               &   ( pmask(1,2,jk) == 1.0_wp ) ) .OR. &
+               & ( ( z2dpm(jk) > 0.0_wp ) .AND.       &
+               &   ( pmask(2,1,jk) == 1.0_wp ) ) .OR. &
+               & ( ( z2dpp(jk) > 0.0_wp ) .AND.       &
+               &   ( pmask(2,2,jk) == 1.0_wp ) ) ) pobsmask(jk)=1.0_wp
+         ELSE
+            ! If the interpolation has failed due to the point
+            ! being on the intersect of two land points retry with
+            ! k2dint = 0
+            IF ( ( pmask(1,1,jk) /= 0.0_wp ).OR. &
+               & ( pmask(1,2,jk) /= 0.0_wp ).OR. &
+               & ( pmask(2,1,jk) /= 0.0_wp ).OR. &
+               & ( pmask(2,2,jk) /= 0.0_wp ) ) THEN
+               ! If ll_ds1 is false compute k2dint = 0 weights
+               IF ( .NOT.ll_ds1 ) THEN
+                  CALL obs_int_h2d_ds1( kpk2, ikmax,                        &
+                     &                  pphi, plam, pmask,                  &
+                     &                  zphimm, zlammm, zphimp, zlammp,     & 
+                     &                  zphipm, zlampm, zphipp, zlampp,     &
+                     &                  z2dmmt, z2dmpt, z2dpmt, z2dppt ) 
+                  ll_ds1 = .TRUE.
+               ENDIF
+               zsum(jk) = z2dmmt(jk) + z2dmpt(jk) + z2dpmt(jk) + z2dppt(jk) 
+               IF ( zsum(jk) /= 0.0_wp ) THEN
+                  pweig(1,1,jk) = z2dmmt(jk) 
+                  pweig(1,2,jk) = z2dmpt(jk)
+                  pweig(2,1,jk) = z2dpmt(jk)
+                  pweig(2,2,jk) = z2dppt(jk)
+                  ! Set the vertical mask
+                  IF ( ( ( z2dmmt(jk) > 0.0_wp ) .AND.      &
+                     &   ( pmask(1,1,jk) == 1.0_wp ) ) .OR. &
+                     & ( ( z2dmpt(jk) > 0.0_wp ) .AND.      &
+                     &   ( pmask(1,2,jk) == 1.0_wp ) ) .OR. &
+                     & ( ( z2dpmt(jk) > 0.0_wp) .AND.      &
+                     &   ( pmask(2,1,jk) == 1.0_wp ) ) .OR. &
+                     & ( ( z2dppt(jk) > 0.0_wp ) .AND.      &
+                     &   ( pmask(2,2,jk) == 1.0_wp ) ) )    &
+                     & pobsmask(jk)=1.0_wp
+               ENDIF
+            ENDIF
+         ENDIF
+      END DO
+  
+   END SUBROUTINE obs_int_h2d_init
+
+   SUBROUTINE obs_int_h2d( kpk, kpk2, &
+      &                    pweig, pmod, pobsk )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d  ***
+      !!
+      !! ** Purpose : Horizontal interpolation to the observation point.
+      !!
+      !! ** Method  : Horizontal interpolation to the observation point using
+      !!              model values at the corners of the surrounding grid 
+      !!              points.
+      !!
+      !! ** Action  :
+      !!                   
+      !! References : 
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-03 (A. Vidard) NEMOVAR migration
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!        ! 07-08 (K. Mogensen) Split in two routines for easier adj.
+      !!-----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk,   &             ! Parameter values for automatic arrays
+         & kpk2
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pweig                ! Interpolation weights
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmod                 ! Model variable to interpolate
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) ::  &
+         & pobsk                ! Model profile interpolated to obs (i,j) pt
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      INTEGER :: &
+         & ikmax
+      REAL(KIND=wp) :: &
+         & zsum
+      !------------------------------------------------------------------------
+      ! Initialize number of levels
+      !------------------------------------------------------------------------
+      IF ( kpk2 == 1 ) THEN
+         ikmax = 1
+      ELSEIF ( kpk2 == kpk) THEN
+         ikmax = kpk-1
+      ENDIF
+      !------------------------------------------------------------------------
+      ! Interpolate to the observation point
+      !------------------------------------------------------------------------
+      pobsk(:) = obfillflt
+      DO jk = 1, ikmax
+         zsum = pweig(1,1,jk) + pweig(1,2,jk) + pweig(2,1,jk) +  pweig(2,2,jk) 
+         IF ( zsum /= 0.0_wp ) THEN
+            pobsk(jk) = (  pweig(1,1,jk) * pmod(1,1,jk)         &
+               &         + pweig(1,2,jk) * pmod(1,2,jk)         &
+               &         + pweig(2,1,jk) * pmod(2,1,jk)         &
+               &         + pweig(2,2,jk) * pmod(2,2,jk)         &
+               &                                             ) / zsum
+         ENDIF
+      END DO
+
+   END SUBROUTINE obs_int_h2d
+  
+   SUBROUTINE obs_int_h2d_ds1( kpk2, kmax,                        &
+      &                        pphi, plam, pmask,                 &
+      &                        pphimm, plammm, pphimp, plammp,    & 
+      &                        pphipm, plampm, pphipp, plampp,    &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_ds1  ***
+      !!
+      !! ** Purpose : Distance-weighted interpolation scheme (k2dint = 0)
+      !!
+      !! ** Method  : The interpolation weights are computed as a weighted 
+      !!              sum of the distance between the model grid points (A) 
+      !!              and the observation point (B). 
+      !!
+      !!    Distance (s) is computed using the great-circle distance formula:
+      !!
+      !!    s(AB) = arcos(   sin( phiA ) x sin( phiB )
+      !!                   + cos( phiA ) x cos( phiB ) x cos( lamB - lamA )
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk2, &             ! Parameter values for automatic arrays
+         & kmax
+      REAL(KIND=wp), INTENT(IN) :: &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, & 
+         & plammm, &
+         & plammp, &
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask               ! Model variable mask 
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm, &            ! Interpolation weights
+         & p2dmp, &
+         & p2dpm, &
+         & p2dpp
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zphi2,   &
+         & zlam2,   &
+         & zcola,   &
+         & za2,     &
+         & zb2,     &
+         & zc2,     &
+         & zphimm2, &
+         & zphimp2, &
+         & zphipm2, &
+         & zphipp2, &
+         & zlammm2, &
+         & zlammp2, &
+         & zlampm2, &
+         & zlampp2, &
+         & za1mm,   &
+         & za1mp,   &
+         & za1pm,   &
+         & za1pp,   &
+         & zcomm,   &
+         & zcomp,   &
+         & zcopm,   &
+         & zcopp,   &
+         & zb1mm,   &
+         & zb1mp,   &
+         & zb1pm,   &
+         & zb1pp,   &
+         & zc1mm,   &
+         & zc1mp,   &
+         & zc1pm,   &
+         & zc1pp,   &
+         & zsopmpp, &
+         & zsommmp, &
+         & zsomm,   &
+         & zsomp,   &
+         & zsopm,   &
+         & zsopp
+       
+      !------------------------------------------------------------------------
+      ! Distance-weighted interpolation using the great circle formula
+      !------------------------------------------------------------------------
+      zphi2 = pphi * rad
+      zlam2 = plam * rad
+      zcola = COS( zphi2 )
+      za2   = SIN( zphi2 )
+      zb2   = zcola * COS( zlam2 )
+      zc2   = zcola * SIN( zlam2 )
+       
+      zphimm2 = pphimm * rad
+      zphimp2 = pphimp * rad
+      zphipm2 = pphipm * rad
+      zphipp2 = pphipp * rad
+       
+      zlammm2 = plammm * rad
+      zlammp2 = plammp * rad
+      zlampm2 = plampm * rad
+      zlampp2 = plampp * rad
+       
+      za1mm = SIN( zphimm2 )
+      za1mp = SIN( zphimp2 )
+      za1pm = SIN( zphipm2 )
+      za1pp = SIN( zphipp2 )
+       
+      zcomm = COS( zphimm2 )
+      zcomp = COS( zphimp2 )
+      zcopm = COS( zphipm2 )
+      zcopp = COS( zphipp2 )
+       
+      zb1mm = zcomm * COS( zlammm2 )
+      zb1mp = zcomp * COS( zlammp2 )
+      zb1pm = zcopm * COS( zlampm2 )
+      zb1pp = zcopp * COS( zlampp2 )
+       
+      zc1mm = zcomm * SIN( zlammm2 )
+      zc1mp = zcomp * SIN( zlammp2 )
+      zc1pm = zcopm * SIN( zlampm2 )
+      zc1pp = zcopp * SIN( zlampp2 )
+       
+      ! Function for arcsin(sqrt(1-x^2) version of great-circle formula
+      zsomm = grt_cir_dis( za1mm, za2, zb1mm, zb2, zc1mm, zc2 )
+      zsomp = grt_cir_dis( za1mp, za2, zb1mp, zb2, zc1mp, zc2 )
+      zsopm = grt_cir_dis( za1pm, za2, zb1pm, zb2, zc1pm, zc2 )
+      zsopp = grt_cir_dis( za1pp, za2, zb1pp, zb2, zc1pp, zc2 )
+       
+      zsopmpp = zsopm * zsopp
+      zsommmp = zsomm * zsomp
+      DO jk = 1, kmax
+         p2dmm(jk) = zsomp * zsopmpp * pmask(1,1,jk)
+         p2dmp(jk) = zsomm * zsopmpp * pmask(1,2,jk) 
+         p2dpm(jk) = zsopp * zsommmp * pmask(2,1,jk)
+         p2dpp(jk) = zsopm * zsommmp * pmask(2,2,jk)
+      END DO
+       
+   END SUBROUTINE obs_int_h2d_ds1
+  
+   SUBROUTINE obs_int_h2d_ds2( kpk2, kmax,                        &
+      &                        pphi, plam, pmask,                 &
+      &                        pphimm, plammm, pphimp, plammp,    &
+      &                        pphipm, plampm, pphipp, plampp,    &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp ) 
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_ds2  ***
+      !!
+      !! ** Purpose : Distance-weighted interpolation scheme (k2dint = 1)
+      !!
+      !! ** Method  : As k2dint = 0 but with distance (ds) computed using a 
+      !!              small-angle approximation to the great-circle distance 
+      !!              formula:
+      !!
+      !!    ds(AB) = sqrt(   ( phiB - phiA )^{2}
+      !!                   + ( ( lamB - lamA ) * cos( phiB ) )^{2} )
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !!-----------------------------------------------------------------------
+      !! * Modules used
+      !!----------------------------------------------------------------------- 
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk2, &             ! Parameter values for automatic arrays
+         & kmax
+      REAL(KIND=wp), INTENT(IN) ::        &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, & 
+         & plammm, &
+         & plammp, &
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask               ! Model variable mask 
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm, &            ! Interpolation weights
+         & p2dmp, &
+         & p2dpm, &
+         & p2dpp
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zcosp,   &
+         & zdlmm,   &
+         & zdlmp,   &
+         & zdlpm,   &
+         & zdlpp,   &
+         & zdpmm,   &
+         & zdpmp,   &
+         & zdppm,   &
+         & zdppp,   &
+         & zsomm,   &
+         & zsomp,   &
+         & zsopm,   &
+         & zsopp,   &
+         & zsopmpp, &
+         & zsommmp
+       
+      !------------------------------------------------------------------------
+      ! Distance-weighted interpolation with a small angle approximation
+      !------------------------------------------------------------------------
+      zcosp = COS( pphi * rad )
+       
+      zdlmm = plammm - plam
+      zdlmp = plammp - plam
+      zdlpm = plampm - plam
+      zdlpp = plampp - plam
+       
+      zdpmm = pphimm - pphi
+      zdpmp = pphimp - pphi
+      zdppm = pphipm - pphi
+      zdppp = pphipp - pphi
+       
+      zsomm = grt_cir_dis_saa( zdlmm, zdpmm, zcosp )
+      zsomp = grt_cir_dis_saa( zdlmp, zdpmp, zcosp )
+      zsopm = grt_cir_dis_saa( zdlpm, zdppm, zcosp )
+      zsopp = grt_cir_dis_saa( zdlpp, zdppp, zcosp )
+       
+      zsopmpp = zsopm * zsopp
+      zsommmp = zsomm * zsomp
+       
+      DO jk = 1, kmax
+         p2dmm(jk) = zsomp * zsopmpp * pmask(1,1,jk)
+         p2dmp(jk) = zsomm * zsopmpp * pmask(1,2,jk)
+         p2dpm(jk) = zsopp * zsommmp * pmask(2,1,jk)
+         p2dpp(jk) = zsopm * zsommmp * pmask(2,2,jk)
+      END DO
+       
+   END SUBROUTINE obs_int_h2d_ds2
+  
+   SUBROUTINE obs_int_h2d_bil( kpk2, kmax,                        &
+      &                        pphi, plam, pmask,                 &
+      &                        plammp, pphipm, pphipp, plampp,    &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp)
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_bil  ***
+      !!
+      !! ** Purpose : Bilinear interpolation on a geographical grid (k2dint = 2)
+      !!
+      !! ** Method  : The interpolation is split into two 1D interpolations in 
+      !!              the longitude and latitude directions, respectively.
+      !!
+      !!    An iterative scheme that involves first mapping a quadrilateral
+      !!    cell into a cell with coordinates (0,0), (1,0), (0,1) and (1,1).
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk2, &             ! Parameter values for automatic arrays
+         & kmax
+      REAL(KIND=wp), INTENT(IN) :: &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphipm, &           ! Geographical location of surrounding
+         & pphipp, &           ! model grid points
+         & plammp, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN)  :: &
+         & pmask               ! Model variable mask
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm, &            ! Interpolation weights
+         & p2dmp, &
+         & p2dpm, &
+         & p2dpp
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zdlmp, &
+         & zdppm, &
+         & zdlpp, &
+         & zdppp
+       
+      !----------------------------------------------------------------------
+      ! Bilinear interpolation for geographical grid
+      !----------------------------------------------------------------------
+      zdlmp = ABS(plam   - plammp) 
+      zdppm = ABS(pphi   - pphipm)
+      zdlpp = ABS(plampp - plam)
+      zdppp = ABS(pphipp - pphi)
+       
+      DO jk = 1, kmax
+         p2dmm(jk) = zdlpp * zdppp * pmask(1,1,jk)
+         p2dmp(jk) = zdlpp * zdppm * pmask(1,2,jk)
+         p2dpm(jk) = zdlmp * zdppp * pmask(2,1,jk)
+         p2dpp(jk) = zdlmp * zdppm * pmask(2,2,jk)
+      END DO
+       
+   END SUBROUTINE obs_int_h2d_bil
+  
+   SUBROUTINE obs_int_h2d_bir( kpk2, kmax,                        &
+      &                        pphi, plam, pmask,                 &
+      &                        pphimm, plammm, pphimp, plammp,    &
+      &                        pphipm, plampm, pphipp, plampp,    &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp, ldfail )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_bir  ***
+      !!
+      !! ** Purpose : General bilinear remapping interpolation (k2dint = 3)
+      !!
+      !! ** Method  : An iterative scheme that involves first mapping a 
+      !!              quadrilateral cell into a cell with coordinates 
+      !!              (0,0), (1,0), (0,1) and (1,1).
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk2, &             ! Parameter values for automatic arrays
+         & kmax
+      REAL(KIND=wp), INTENT(IN) ::        &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, & 
+         & plammm, &
+         & plammp, &
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask               ! Model variable mask 
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm, &            ! Interpolation weights
+         & p2dmp, &
+         & p2dpm, &
+         & p2dpp
+      LOGICAL, INTENT(OUT) :: &
+         & ldfail
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zbiwmm, &
+         & zbiwmp, &
+         & zbiwpm, &
+         & zbiwpp
+  
+      !----------------------------------------------------------------------
+      ! Bilinear remapping interpolation for general quadrilateral grid
+      !----------------------------------------------------------------------
+      CALL bil_wgt( pphimm, pphimp, pphipm, pphipp,  &
+         &          plammm, plammp, plampm, plampp,  &
+         &          zbiwmm, zbiwmp, zbiwpm, zbiwpp,  &
+         &          pphi  , plam,   ldfail           )
+
+      IF ( .NOT.ldfail ) THEN
+         DO jk = 1, kmax
+            p2dmm(jk) = zbiwmm * pmask(1,1,jk)
+            p2dmp(jk) = zbiwmp * pmask(1,2,jk)
+            p2dpm(jk) = zbiwpm * pmask(2,1,jk)
+            p2dpp(jk) = zbiwpp * pmask(2,2,jk)
+         END DO
+      ENDIF
+
+   END SUBROUTINE obs_int_h2d_bir
+
+   SUBROUTINE obs_int_h2d_pol( kpk2, kmax,                         &
+      &                        pphi, plam, pmask,                  &
+      &                        pphimm, plammm, pphimp, plammp,     &
+      &                        pphipm, plampm, pphipp, plampp,     &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_pol  ***
+      !!
+      !! ** Purpose : Polynomial interpolation (k2dint = 4)
+      !!
+      !! ** Method  : The interpolation weights are computed by fitting a 
+      !!              polynomial function of the form
+      !!
+      !!    P(i) = a1(i) + a2(i) * phi + a3(i) * plam + a4(i) * phi * plam
+      !!
+      !!    through the model values at four surrounding grid pts (i=1,4).
+      !!    As k2dint = 0 but with distance (ds) computed using a small-
+      !!    angle approximation to the great-circle distance formula:
+      !!
+      !!    ds(AB) = sqrt(   ( phiB - phiA )^{2}
+      !!                   + ( ( lamB - lamA ) * cos( phiB ) )^{2} )
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &  
+         & kpk2,   &           ! Parameter values for automatic arrays 
+         & kmax
+      REAL(KIND=wp), INTENT(IN) :: &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, &
+         & plammm, &
+         & plammp, &
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask               ! Model variable mask
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm,  &           ! Interpolation weights
+         & p2dmp,  &
+         & p2dpm,  &
+         & p2dpp
+  
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zplp
+      REAL(KIND=wp), DIMENSION(4,4) :: &
+         & zmat,  &
+         & zmati
+       
+      !------------------------------------------------------------------------
+      ! Polynomial interpolation
+      !------------------------------------------------------------------------       
+      zmat(1,1) = 1.0_wp
+      zmat(1,2) = 1.0_wp
+      zmat(1,3) = 1.0_wp
+      zmat(1,4) = 1.0_wp
+      zmat(2,1) = plammm
+      zmat(2,2) = plammp
+      zmat(2,3) = plampm
+      zmat(2,4) = plampp
+      zmat(3,1) = pphimm
+      zmat(3,2) = pphimp
+      zmat(3,3) = pphipm
+      zmat(3,4) = pphipp
+      zmat(4,1) = plammm * pphimm
+      zmat(4,2) = plammp * pphimp
+      zmat(4,3) = plampm * pphipm
+      zmat(4,4) = plampp * pphipp
+       
+      CALL lu_invmat( zmat, 4, zmati )
+       
+      zplp = plam * pphi            
+      DO jk = 1, kmax
+         p2dmm(jk) = ABS(   zmati(1,1)        + zmati(1,2) * plam    &
+            &             + zmati(1,3) * pphi + zmati(1,4) * zplp )  &
+            &      * pmask(1,1,jk) 
+         p2dmp(jk) = ABS(   zmati(2,1)        + zmati(2,2) * plam    &
+            &             + zmati(2,3) * pphi + zmati(2,4) * zplp )  &
+            &      * pmask(1,2,jk)
+         p2dpm(jk) = ABS(   zmati(3,1)        + zmati(3,2) * plam    &
+            &             + zmati(3,3) * pphi + zmati(3,4) * zplp )  &
+            &      * pmask(2,1,jk)
+         p2dpp(jk) = ABS(   zmati(4,1)        + zmati(4,2) * plam    &
+            &             + zmati(4,3) * pphi + zmati(4,4) * zplp )  &
+            &      * pmask(2,2,jk)
+      END DO
+  
+   END SUBROUTINE obs_int_h2d_pol
+
+   SUBROUTINE bil_wgt( pphimm, pphimp, pphipm, pphipp,   &
+      &               plammm, plammp, plampm, plampp,   &
+      &               pbiwmm, pbiwmp, pbiwpm, pbiwpp,   &
+      &               pphi  , plam,   ldfail            )
+      !!-------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE bil_wgt  ***
+      !!
+      !! ** Purpose : Compute the weights for a bilinear remapping 
+      !!              interpolation scheme.
+      !!
+      !! ** Method  : This scheme is appropriate for bilinear interpolation 
+      !!              on a general quadrilateral grid.    
+      !!              This scheme is also used in OASIS.
+      !!
+      !!              This routine is a derivative of the SCRIP software.
+      !!              Copyright 1997, 1998 the Regents of the University 
+      !!              of California. See SCRIP_Copyright.txt.
+      !!     
+      !! ** Action  :
+      !!
+      !! References : Jones, P.: A user's guide for SCRIP: A Spherical 
+      !!                Coordinate Remapping and Interpolation Package. 
+      !!                Version 1.4. Los Alamos. 
+      !!                  
+      !!         http://www.acl.lanl.gov/climate/software/SCRIP/SCRIPmain.html
+      !!
+      !! History
+      !!      ! 97-11 (A. Weaver, N. Daget)
+      !!      ! 06-03 (A. Vidard)
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+ 
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, &
+         & plammm, &
+         & plammp, & 
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), INTENT(OUT) :: &
+         & pbiwmm, &           ! Interpolation weights
+         & pbiwmp, &
+         & pbiwpm, &
+         & pbiwpp
+      LOGICAL, INTENT(out) :: &
+         & ldfail
+
+      !! * Local declarations
+      INTEGER :: &
+         & jiter
+      INTEGER :: &
+         & itermax
+      REAL(KIND=wp) :: &
+         & zphi,    &           ! Geographical location of observation
+         & zlam,    &
+         & zphimm,  &           ! Geographical location of surrounding
+         & zphimp,  &           ! model grid points
+         & zphipm,  &
+         & zphipp,  &
+         & zlammm,  &
+         & zlammp,  & 
+         & zlampm,  &
+         & zlampp,  &
+         & zdth1,   &
+         & zdth2,   &
+         & zdth3,   &
+         & zdthp,   &
+         & zdph1,   &
+         & zdph2,   &
+         & zdph3,   &
+         & zdphp,   &
+         & zmat1,   &
+         & zmat2,   &
+         & zmat3,   &
+         & zmat4,   &
+         & zdeli,   &
+         & zdelj,   &
+         & ziguess, &
+         & zjguess, &
+         & zeps,    &
+         & zdeterm, &
+         & z2pi,    &
+         & zhpi
+      
+      ! Initialization
+
+      ! Conversion to radians
+
+      zphi   = pphi   * rad
+      zlam   = plam   * rad
+      zphimm = pphimm * rad
+      zphimp = pphimp * rad
+      zphipm = pphipm * rad
+      zphipp = pphipp * rad
+      zlammm = plammm * rad
+      zlammp = plammp * rad
+      zlampm = plampm * rad
+      zlampp = plampp * rad
+
+      ldfail = .FALSE.
+
+      zdth1 = zphipm - zphimm
+      zdth2 = zphimp - zphimm
+      zdth3 = zphipp - zphipm - zdth2
+       
+      zdph1 = zlampm - zlammm
+      zdph2 = zlammp - zlammm
+      zdph3 = zlampp - zlampm
+       
+      z2pi = 2.0_wp * rpi
+       
+      IF ( zdph1 >  3.0_wp * rpi ) zdph1 = zdph1 - z2pi
+      IF ( zdph2 >  3.0_wp * rpi ) zdph2 = zdph2 - z2pi
+      IF ( zdph3 >  3.0_wp * rpi ) zdph3 = zdph3 - z2pi
+      IF ( zdph1 < -3.0_wp * rpi ) zdph1 = zdph1 + z2pi
+      IF ( zdph2 < -3.0_wp * rpi ) zdph2 = zdph2 + z2pi
+      IF ( zdph3 < -3.0_wp * rpi ) zdph3 = zdph3 + z2pi
+       
+      zdph3 = zdph3 - zdph2
+       
+      ziguess = 0.5_wp
+      zjguess = 0.5_wp
+       
+      itermax = 100
+
+#if defined key_sp
+      zeps = 1.0e-6_wp
+#else
+      zeps = 1.0e-10_wp      
+#endif
+  
+      !------------------------------------------------------------------------
+      ! Iterate to determine (i,j) in new coordinate system
+      !------------------------------------------------------------------------
+      jiter_loop: DO jiter = 1, itermax
+         
+         zdthp = zphi - zphimm - zdth1 * ziguess - zdth2 * zjguess &
+            &  - zdth3 * ziguess * zjguess
+         zdphp = zlam - zlammm
+         
+         zhpi = 0.5_wp * rpi
+         IF ( zdphp >  3.0_wp * zhpi ) zdphp = zdphp - z2pi
+         IF ( zdphp < -3.0_wp * zhpi ) zdphp = zdphp + z2pi
+         
+         zdphp = zdphp - zdph1 * ziguess - zdph2 * zjguess &
+            &  - zdph3 * ziguess * zjguess
+         
+         zmat1 = zdth1 + zdth3 * zjguess
+         zmat2 = zdth2 + zdth3 * ziguess
+         zmat3 = zdph1 + zdph3 * zjguess
+         zmat4 = zdph2 + zdph3 * ziguess
+         
+         ! Matrix determinant
+         zdeterm = zmat1 * zmat4 - zmat2 * zmat3
+         
+         zdeli = ( zdthp * zmat4 - zmat2 * zdphp) / zdeterm
+         zdelj = ( zmat1 * zdphp - zdthp * zmat3) / zdeterm
+         
+         IF ( ABS( zdeli ) < zeps .AND. ABS( zdelj ) < zeps ) EXIT jiter_loop
+         
+         ziguess = ziguess + zdeli
+         zjguess = zjguess + zdelj
+
+         ! DJL prevent ziguess and zjguess from going outside the range
+         ! 0 to 1
+         ! prevents interpolated value going wrong
+         ! for example sea ice concentration gt 1
+         
+         IF ( ziguess < 0 ) ziguess = 0.0_wp
+         IF ( zjguess < 0 ) zjguess = 0.0_wp
+         IF ( ziguess > 1 ) ziguess = 1.0_wp
+         IF ( zjguess > 1 ) zjguess = 1.0_wp
+         
+      END DO jiter_loop
+       
+      IF ( jiter <= itermax ) THEN
+           
+         ! Successfully found i,j, now compute the weights
+
+         pbiwmm = ( 1.0_wp - ziguess ) * ( 1.0_wp - zjguess )
+         pbiwmp = ( 1.0_wp - ziguess ) *            zjguess
+         pbiwpm =            ziguess   * ( 1.0_wp - zjguess )
+         pbiwpp =            ziguess   *            zjguess
+         
+      ELSEIF ( jiter > itermax ) THEN
+            
+         IF(lwp) THEN
+            
+            WRITE(numout,*)'Obs lat/lon  : ',pphi, plam
+            WRITE(numout,*)'Grid lats    : ',pphimm, pphimp, pphipm, pphipp
+            WRITE(numout,*)'Grid lons    : ',plammm, plammp, plampm, plampp
+            WRITE(numout,*)'Current i,j  : ',ziguess, zjguess
+            WRITE(numout,*)'Weights      : ',pbiwmm, pbiwmp, pbiwpm, pbiwpp
+            WRITE(numout,*)'jiter        = ',jiter
+            WRITE(numout,*)'zeps         = ',zeps
+            WRITE(numout,*)'zdeli, zdelj = ',zdeli, zdelj
+            WRITE(numout,*)' Iterations for i,j exceed max iteration count!'
+            WRITE(numout,*)
+            
+            ldfail = .TRUE.
+
+         ENDIF
+         
+      ENDIF
+    
+   END SUBROUTINE bil_wgt
+
+   SUBROUTINE lu_invmat( pmatin, kdim, pmatou )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE lu_invmat  ***
+      !!
+      !! ** Purpose : Invert a matrix using LU decomposition.
+      !!
+      !! ** Method  : 
+      !! 
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History
+      !!      ! 02-11 (A. Weaver, N. Daget)
+      !!      ! 06-03 (A. Vidard)
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!      ! 06-11 (NEMOVAR task force) Fix declaration of zd.
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kdim             ! Array dimension
+      REAL(KIND=wp), DIMENSION(kdim,kdim), INTENT(IN) :: &
+         & pmatin 
+      REAL(KIND=wp), DIMENSION(kdim,kdim), INTENT(OUT) :: &
+         & pmatou 
+  
+      !! * Local declarations
+      INTEGER :: &
+         & ji, &
+         & jj
+      INTEGER, DIMENSION(kdim) :: &
+         & indx
+      REAL(KIND=wp), DIMENSION(kdim,kdim) :: &
+         & zmat
+      REAL(KIND=wp) :: &
+         & zd
+
+      ! Invert the matrix       
+      DO jj = 1, kdim
+         DO ji = 1, kdim
+            pmatou(ji,jj) = 0.0_wp
+            zmat(ji,jj) = pmatin(ji,jj)
+         END DO
+         pmatou(jj,jj) = 1.0_wp
+      END DO
+      CALL lu_decomp( zmat, kdim, kdim, indx, zd )
+      DO jj = 1, kdim
+         CALL lu_backsb( zmat, kdim, kdim, indx, pmatou(1,jj) )
+      END DO
+      
+   END SUBROUTINE lu_invmat
+
+   SUBROUTINE lu_decomp( pmatin, kdim1, kdim2, kindex, pflt )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE lu_decomp  ***
+      !!
+      !! ** Purpose : Compute the LU decomposition of a matrix
+      !!
+      !! ** Method  : 
+      !! 
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History
+      !!      ! 02-11 (A. Weaver, N. Daget)
+      !!      ! 06-03 (A. Vidard)
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+       
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kdim1, &   ! Array dimensions
+         & kdim2
+      INTEGER, DIMENSION(kdim1), INTENT(OUT) :: &
+         & kindex
+      REAL(KIND=wp), INTENT(OUT) :: &
+         & pflt
+      REAL(KIND=wp), DIMENSION(kdim2,kdim2), INTENT(INOUT) :: &
+         & pmatin 
+  
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpmax = 100
+      REAL(KIND=wp), PARAMETER :: &
+         & pptiny = 1.0e-20_wp
+      REAL(KIND=wp), DIMENSION(jpmax) :: &
+         & zvv
+      INTEGER :: &
+         & ji, &
+         & jj, &
+         & jk
+      INTEGER :: &
+         & imax
+      REAL(KIND=wp) :: &
+         & zsum,  &
+         & zdum,  &
+         & zaamax
+       
+      ! Main computation
+      pflt = 1.0_wp
+      DO ji = 1, kdim1
+         zaamax = 0.0_wp
+         DO jj = 1, kdim1
+            IF ( ABS( pmatin(ji,jj) ) > zaamax ) zaamax = ABS( pmatin(ji,jj) )
+         END DO
+         IF ( zaamax == 0.0_wp ) THEN
+            CALL ctl_stop( 'singular matrix' )
+         ENDIF 
+         zvv(ji) = 1.0_wp / zaamax
+      END DO
+      DO jj = 1, kdim1
+         DO ji = 1, jj-1
+            zsum = pmatin(ji,jj)
+            DO jk = 1, ji-1
+	       zsum = zsum - pmatin(ji,jk) * pmatin(jk,jj)
+	    END DO
+            pmatin(ji,jj) = zsum
+         END DO
+         zaamax = 0.0_wp
+         DO ji = jj, kdim1
+            zsum = pmatin(ji,jj)
+            DO jk = 1, jj-1
+               zsum = zsum - pmatin(ji,jk) * pmatin(jk,jj)
+            END DO
+            pmatin(ji,jj) = zsum
+            zdum = zvv(ji) * ABS( zsum )
+            IF ( zdum >= zaamax ) THEN
+               imax = ji
+               zaamax = zdum
+            ENDIF
+	 END DO
+         IF ( jj /= imax ) THEN
+            DO jk = 1, kdim1
+               zdum = pmatin(imax,jk)
+               pmatin(imax,jk) = pmatin(jj,jk)
+               pmatin(jj,jk) = zdum
+	    END DO
+            pflt = -pflt
+            zvv(imax) = zvv(jj)
+         ENDIF
+         kindex(jj) = imax
+         IF ( pmatin(jj,jj) == 0.0_wp ) pmatin(jj,jj) = pptiny
+         IF ( jj /= kdim1 ) THEN
+            zdum = 1.0_wp / pmatin(jj,jj)
+            DO ji = jj+1, kdim1
+               pmatin(ji,jj) = pmatin(ji,jj) * zdum
+	    END DO
+         ENDIF
+      END DO
+     
+   END SUBROUTINE lu_decomp
+     
+   SUBROUTINE lu_backsb( pmat, kdim1, kdim2, kindex, pvect )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE lu_backsb  ***
+      !!
+      !! ** Purpose : Back substitution
+      !!
+      !! ** Method  : 
+      !! 
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History
+      !!      ! 02-11 (A. Weaver, N. Daget)
+      !!      ! 06-03 (A. Vidard)
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+      
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kdim1, &     ! Array dimensions
+         & kdim2
+      INTEGER, DIMENSION(kdim1), INTENT(IN) :: &
+         & kindex
+      REAL(KIND=wp), DIMENSION(kdim1), INTENT(INOUT) :: &
+         & pvect
+      REAL(KIND=wp), DIMENSION(kdim2,kdim2), INTENT(IN) :: &
+         & pmat
+  
+      !! * Local declarations
+      INTEGER :: &
+         & ji,  &
+         & jii, &
+         & jj,  &
+         & jll
+      REAL(KIND=wp) :: &
+         & zsum
+
+      ! Main computation
+      jii = 0
+      DO ji = 1, kdim1
+         jll = kindex(ji)
+         zsum = pvect(jll)
+         pvect(jll) = pvect(ji)
+         IF ( jii /= 0 ) THEN
+            DO jj = jii, ji-1
+               zsum = zsum - pmat(ji,jj) * pvect(jj)
+            END DO
+         ELSEIF ( zsum /= 0.0_wp ) THEN
+            jii = ji
+         ENDIF
+         pvect(ji) = zsum
+      END DO
+      DO ji = kdim1, 1, -1
+         zsum = pvect(ji)
+         DO jj = ji+1, kdim1
+            zsum = zsum - pmat(ji,jj) * pvect(jj)
+         END DO
+         pvect(ji) = zsum / pmat(ji,ji)
+      END DO
+     
+   END SUBROUTINE lu_backsb
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsinter_z1d.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsinter_z1d.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsinter_z1d.h90	(revision 2236)
@@ -0,0 +1,185 @@
+   SUBROUTINE obs_int_z1d( kpk, kkco, k1dint, kdep, &
+      &                    pobsdep, pobsk, pobs2k,  &
+      &                    pobs, pdep, pobsmask )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE obs_int_z1d ***
+      !!
+      !! ** Purpose : Vertical interpolation to the observation point.
+      !!  
+      !! ** Method  : If k1dint = 0 then use linear interpolation.
+      !!              If k1dint = 1 then use cubic spline interpolation.
+      !! 
+      !! ** Action  :
+      !!
+      !! References :
+      !!
+      !! History
+      !!      ! 97-11 (A. Weaver, S. Ricci, N. Daget)
+      !!      ! 06-03 (G. Smith) Conversion to F90 for use with NEMOVAR
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!      ! 07-01 (K. Mogensen) Use profile rather than single level
+      !!---------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kpk        ! Number of vertical levels
+      INTEGER, INTENT(IN) :: k1dint     ! 0 = linear; 1 = cubic spline interpolation 
+      INTEGER, INTENT(IN) :: kdep       ! Number of levels in profile
+      INTEGER, INTENT(IN), DIMENSION(kdep) :: &
+         & kkco                 ! Array indicies for interpolation
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kdep) :: &
+         & pobsdep              ! Depth of the observation
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pobsk,  &            ! Model profile at a given (lon,lat)
+         & pobs2k, &            ! 2nd derivative of the interpolating function
+         & pdep,   &            ! Model depth array
+         & pobsmask             ! Vertical mask
+      REAL(KIND=wp), INTENT(OUT), DIMENSION(kdep) :: &
+         & pobs                 ! Model equivalent at observation point
+  
+      !! * Local declarations
+      REAL(KIND=wp) :: z1dm       ! Distance above and below obs to model grid points
+      REAL(KIND=wp) :: z1dp         
+      REAL(KIND=wp) :: zsum       ! Dummy variables for computation
+      REAL(KIND=wp) :: zsum2
+      INTEGER :: jdep             ! Observation depths loop variable
+    
+      !------------------------------------------------------------------------
+      ! Loop over all observation depths
+      !------------------------------------------------------------------------
+
+      DO jdep = 1, kdep
+
+         !---------------------------------------------------------------------
+         ! Initialization
+         !---------------------------------------------------------------------
+         z1dm = ( pdep(kkco(jdep)) - pobsdep(jdep)      )
+         z1dp = ( pobsdep(jdep)    - pdep(kkco(jdep)-1) )
+         IF ( pobsmask(kkco(jdep)) == 0.0_wp ) z1dp = 0.0_wp
+
+         zsum = z1dm + z1dp
+         
+         IF ( k1dint == 0 ) THEN
+
+            !-----------------------------------------------------------------
+            !  Linear interpolation
+            !-----------------------------------------------------------------
+            pobs(jdep) = (   z1dm * pobsk(kkco(jdep)-1) &
+               &           + z1dp * pobsk(kkco(jdep)  ) ) / zsum
+
+         ELSEIF ( k1dint == 1 ) THEN
+
+            !-----------------------------------------------------------------
+            ! Cubic spline interpolation
+            !-----------------------------------------------------------------
+            zsum2 = zsum * zsum
+            pobs(jdep)  = (  z1dm                             * pobsk (kkco(jdep)-1) &
+               &           + z1dp                             * pobsk (kkco(jdep)  ) &
+               &           + ( z1dm * ( z1dm * z1dm - zsum2 ) * pobs2k(kkco(jdep)-1) &
+               &           +   z1dp * ( z1dp * z1dp - zsum2 ) * pobs2k(kkco(jdep)  ) &
+               &             ) / 6.0_wp                                              &
+               &          ) / zsum
+
+         ENDIF
+      END DO
+
+   END SUBROUTINE obs_int_z1d
+
+   SUBROUTINE obs_int_z1d_spl( kpk, pobsk, pobs2k, &
+      &                        pdep, pobsmask )
+      !!--------------------------------------------------------------------
+      !!
+      !!                  *** ROUTINE obs_int_z1d_spl ***
+      !!
+      !! ** Purpose : Compute the local vector of vertical second-derivatives 
+      !!              of the interpolating function used with a cubic spline.
+      !!  
+      !! ** Method  : 
+      !! 
+      !!    Top and bottom boundary conditions on the 2nd derivative are
+      !!    set to zero.
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History
+      !!      ! 01-11 (A. Weaver, S. Ricci, N. Daget)
+      !!      ! 06-03 (G. Smith) Conversion to F90 for use with NEMOVAR
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+     
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kpk               ! Number of vertical levels
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pobsk, &          ! Model profile at a given (lon,lat)
+         & pdep,  &          ! Model depth array
+         & pobsmask          ! Vertical mask
+      REAL(KIND=wp), INTENT(OUT), DIMENSION(kpk) :: &
+         & pobs2k            ! 2nd derivative of the interpolating function
+  
+      !! * Local declarations
+      INTEGER :: jk
+      REAL(KIND=wp) :: za
+      REAL(KIND=wp) :: zb
+      REAL(KIND=wp) :: zc
+      REAL(KIND=wp) :: zpa
+      REAL(KIND=wp) :: zkm
+      REAL(KIND=wp) :: zkp
+      REAL(KIND=wp) :: zk
+      REAL(KIND=wp), DIMENSION(kpk-1) :: &
+         & zs, &
+         & zp, &
+         & zu, &
+         & zv
+
+      !-----------------------------------------------------------------------
+      ! Matrix initialisation
+      !-----------------------------------------------------------------------
+      zs(1) =  0.0_wp
+      zp(1) =  0.0_wp
+      zv(1) = -0.5_wp
+      DO jk = 2, kpk-1
+         zs(jk) =  ( pdep(jk  ) - pdep(jk-1) ) &
+            &    / ( pdep(jk+1) - pdep(jk-1) )
+         zp(jk) = zs(jk) * zv(jk-1) + 2.0_wp
+         zv(jk) = ( zs(jk) - 1.0_wp ) / zp(jk)
+      END DO
+ 
+      !-----------------------------------------------------------------------
+      ! Solution of the tridiagonal system
+      !-----------------------------------------------------------------------
+ 
+      ! Top boundary condition
+      zu(1) = 0.0_wp
+ 
+      DO jk = 2, kpk-1
+         za = pdep(jk+1) - pdep(jk-1)
+         zb = pdep(jk+1) - pdep(jk  )
+         zc = pdep(jk  ) - pdep(jk-1)
+ 
+         zpa = 6.0_wp / ( zp(jk) * za )
+         zkm = zpa / zc
+         zkp = zpa / zb
+         zk  = - ( zkm + zkp )
+  
+         zu(jk) =  pobsk(jk+1) * zkp  &
+            &    + pobsk(jk  ) * zk   &
+            &    + pobsk(jk-1) * zkm  &
+            &    + zu(jk-1) * ( -zs(jk) / zp(jk) )
+      END DO
+ 
+      !-----------------------------------------------------------------------
+      ! Second derivative
+      !-----------------------------------------------------------------------
+      pobs2k(kpk) = 0.0_wp
+ 
+      ! Bottom boundary condition
+      DO jk = kpk-1, 1, -1
+         pobs2k(jk) = zv(jk) * pobs2k(jk+1) + zu(jk)
+         IF ( pobsmask(jk+1) == 0.0_wp ) pobs2k(jk) = 0.0_wp
+      END DO
+ 
+  END SUBROUTINE obs_int_z1d_spl
+
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsprof_io.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsprof_io.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsprof_io.h90	(revision 2236)
@@ -0,0 +1,829 @@
+
+   SUBROUTINE read_enactfile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the profile ENACT observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                      ! Number of levels
+      INTEGER :: i_file_id
+      INTEGER :: i_obs_id
+      INTEGER :: i_lev_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_pl_num_id
+      INTEGER :: i_reference_date_time_id
+      INTEGER :: i_format_version_id
+      INTEGER :: i_juld_id
+      INTEGER :: i_data_type_id
+      INTEGER :: i_wmo_inst_type_id
+      INTEGER :: i_qc_var_id
+      INTEGER :: i_dc_ref_id
+      INTEGER :: i_qc_flag_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth 
+      CHARACTER(LEN=40) :: cl_fld_var_tp
+      CHARACTER(LEN=40) :: cl_fld_var_s
+      CHARACTER(LEN=40) :: cl_fld_var_ti
+      CHARACTER(LEN=40) :: cl_fld_var_juld_qc
+      CHARACTER(LEN=40) :: cl_fld_var_pos_qc
+      CHARACTER(LEN=40) :: cl_fld_var_depth_qc 
+      CHARACTER(LEN=40) :: cl_fld_var_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_qc_s
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s
+      CHARACTER(LEN=40) :: cl_fld_reference_date_time
+      CHARACTER(LEN=40) :: cl_fld_juld
+      CHARACTER(LEN=40) :: cl_fld_data_type
+      CHARACTER(LEN=40) :: cl_fld_pl_num
+      CHARACTER(LEN=40) :: cl_fld_format_version
+      CHARACTER(LEN=40) :: cl_fld_wmo_inst_type
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_levels
+
+      CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile'
+      CHARACTER(LEN=16)            :: cl_data_type = ''
+      CHARACTER(LEN=4 )            :: cl_format_version = ''
+      INTEGER, DIMENSION(1) :: istart1, icount1
+      INTEGER, DIMENSION(2) :: istart2, icount2
+      CHARACTER(len=imaxlev) :: clqc
+      CHARACTER(len=1) :: cqc
+      INTEGER :: ji, jk
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      cl_fld_lam                 = 'LONGITUDE'
+      cl_fld_phi                 = 'LATITUDE'
+      cl_fld_depth               = 'DEPH_CORRECTED'
+      cl_fld_reference_date_time = 'REFERENCE_DATE_TIME'
+      cl_fld_juld                = 'JULD'
+      cl_fld_data_type           = 'DATA_TYPE'
+      cl_fld_format_version      = 'FORMAT_VERSION'
+      cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+      cl_fld_pl_num              = 'PLATFORM_NUMBER'
+
+      cl_fld_var_qc_t            = 'POTM_CORRECTED_QC'
+      cl_fld_var_prof_qc_t       = 'PROFILE_POTM_QC'
+      cl_fld_var_tp              = 'POTM_CORRECTED'
+      cl_fld_var_qc_s            = 'PSAL_CORRECTED_QC'
+      cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+      cl_fld_var_s               = 'PSAL_CORRECTED'
+      cl_fld_var_depth_qc        = 'DEPH_CORRECTED_QC'
+      cl_fld_var_juld_qc         = 'JULD_QC'
+      cl_fld_var_pos_qc          = 'POSITION_QC'
+      cl_fld_var_ti              = 'TEMP'
+      cl_fld_qc_flags_profiles   = 'QC_FLAGS_PROFILES'
+      cl_fld_qc_flags_levels     = 'QC_FLAGS_LEVELS'
+
+      icount1(1) = 1 
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_data_type,      &
+         &         i_data_type_id ),      cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_data_type_id,        &
+         &         cl_data_type ),        cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_format_version, &
+         &         i_format_version_id ), cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_format_version_id,   &
+         &         cl_format_version ),   cl_name, __LINE__ )
+      
+      CALL str_c_to_for( cl_data_type )
+      CALL str_c_to_for( cl_format_version )
+      
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_enactfile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Data type           = ', &
+         &                TRIM( ADJUSTL( cl_data_type ) )
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ',  &
+         &                TRIM( ADJUSTL( cl_format_version ) )
+      
+      IF ( ( ( INDEX( cl_data_type,"ENACT v1.0" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.4" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.5" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENSEMBLES EN3 v1" ) == 1 )      ) &
+         &   .AND.                                              &
+         &   ( INDEX( cl_format_version,"2.0"   ) == 1 ) ) THEN
+         IF(ldwp)WRITE(kunit,*)'               Valid input file'
+      ELSE
+         CALL fatal_error( 'Invalid input file', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_PROF', i_obs_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_LEVELS', i_lev_id ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+
+      !---------------------------------------------------------------------
+      ! Read the QC atributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )        
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )
+      DO ji = 1, iobs
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      ! No depth QC in files
+      DO ji = 1, iobs
+         DO jk = 1, ilev
+            inpfile%idqc(jk,ji)  = 1
+            inpfile%idqcf(:,jk,ji) = 0
+         END DO
+      END DO
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                    & 
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+!!      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ),                       &
+!!         &         cl_name, __LINE__ ) 
+!!      !DO ji = 1,iobs
+!!         istart1(1) = ji
+!!         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+!!            &                         start = istart1, count = icount1),                              &
+!!            &         cl_name, __LINE__ )
+!!         inpfile%itqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+!!         inpfile%itqcf(:,ji) = 0
+!!      END DO
+      ! Since the flags are not set in the ENACT files we reset them to 0
+      inpfile%itqc(:)    = 1      
+      inpfile%itqcf(:,:) = 0
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+         inpfile%ipqcf(:,ji) = 0
+      END DO
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc1(iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc1 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            inpfile%ioqcf(1,ji)   = iqc1(ji)
+            inpfile%ivqcf(1,ji,:) = iqc1(ji)
+            inpfile%ioqcf(2,ji)   = 0
+            inpfile%ivqcf(2,ji,:) = 0
+         END DO
+         DEALLOCATE( &
+            & iqc1 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC profile flags in file'
+         inpfile%ioqcf(:,:)   = 0
+         inpfile%ivqcf(:,:,:) = 0
+      ENDIF
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_levels, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc2(ilev,iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc2 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            DO jk = 1,ilev
+               inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji)
+               inpfile%ivlqcf(2,jk,ji,:) = 0
+            END DO
+         END DO
+         DEALLOCATE( &
+            & iqc2 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC level flags in file'
+         inpfile%ivlqcf(:,:,:,:) = 0
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                             &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_reference_date_time, i_reference_date_time_id ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_reference_date_time_id, inpfile%cdjuldref ),          &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_tp, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,1) ),                         &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                         &
+         &         cl_name, __LINE__ )
+ 
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_ti, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+
+   END SUBROUTINE read_enactfile
+
+   SUBROUTINE read_coriofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_coriofile **
+      !!
+      !! ** Purpose : Read from file the profile CORIO observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output enactfile structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      INTEGER  :: &
+         & iobs, &
+         & ilev
+      !! * Local declarations
+      INTEGER :: &
+         & i_file_id,                &
+         & i_obs_id,                 &
+         & i_lev_id,                 &
+         & i_phi_id,                 & 
+         & i_lam_id,                 &
+         & i_depth_id,               &
+         & i_pres_id,                &
+         & i_var_id,                 &
+         & i_pl_num_id,              &
+         & i_format_version_id,      &
+         & i_juld_id,                &
+         & i_data_type_id,           &
+         & i_wmo_inst_type_id,       &
+         & i_qc_var_id,              &
+         & i_dc_ref_id
+      CHARACTER(LEN=40) :: & 
+         & cl_fld_lam,                 &
+         & cl_fld_phi,                 &
+         & cl_fld_depth,               & 
+         & cl_fld_depth_qc,            & 
+         & cl_fld_pres,                & 
+         & cl_fld_pres_qc,             & 
+         & cl_fld_var_t,               &
+         & cl_fld_var_s,               &
+         & cl_fld_var_ti,              &
+         & cl_fld_var_pos_qc,          &
+         & cl_fld_var_qc_t,            &
+         & cl_fld_var_qc_s,            &
+         & cl_fld_var_prof_qc_t,       &
+         & cl_fld_var_prof_qc_s,       &
+         & cl_fld_dc_ref,              &
+         & cl_fld_juld,                &
+         & cl_fld_pl_num,              &
+         & cl_fld_wmo_inst_type
+      CHARACTER(LEN=14), PARAMETER :: &
+         & cl_name = 'read_coriofile'
+      CHARACTER(LEN=4 )            :: &
+         & cl_format_version = ''
+      INTEGER, DIMENSION(1) :: &
+         & istart1, icount1
+      INTEGER, DIMENSION(2) :: &
+         & istart2, icount2
+      CHARACTER(len=imaxlev) :: &
+         & clqc
+      CHARACTER(len=1) :: &
+         & cqc
+      CHARACTER(len=256) :: &
+         & cdjulref
+      INTEGER :: &
+         & ji, jk
+      INTEGER :: &
+         & iformat
+      LOGICAL :: & 
+         & lsal
+      REAL(fbdp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zpres
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+         & ipresqc
+      CHARACTER(len=256) :: &
+         & cerr
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      icount1(1) = 1 
+      lsal = .TRUE.
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Check format and set variables accordingly
+      !-----------------------------------------------------------------------
+
+      IF ( ( nf90_inq_dimid( i_file_id, 'N_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'N_LEVELS', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 1
+      ELSEIF ( ( nf90_inq_dimid( i_file_id, 'mN_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'mN_ZLEV', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 2
+      ELSE
+         WRITE(cerr,'(2A)')'Invalid data format in ',cl_name
+         CALL fatal_error( cerr, __LINE__ )
+      ENDIF
+      IF ( iformat == 1 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'DEPH_QC'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'PRES_QC'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+         cl_fld_dc_ref              = 'DC_REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'TEMP_QC'
+         cl_fld_var_prof_qc_t       = 'PROFILE_TEMP_QC'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'PSAL_QC'
+         cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'POSITION_QC'
+      ELSEIF ( iformat==2 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'QC_DEPH'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'QC_PRES'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'INST_TYPE'
+         cl_fld_dc_ref              = 'REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'QC_TEMP'
+         cl_fld_var_prof_qc_t       = 'Q_PROFILE_TEMP'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'QC_PSAL'
+         cl_fld_var_prof_qc_s       = 'Q_PROFILE_PSAL'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'Q_POSITION'
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_coriofile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ', iformat
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+      ALLOCATE( &
+         & zpres(ilev,iobs),  &
+         & ipresqc(ilev,iobs) &
+         & )
+      !---------------------------------------------------------------------
+      ! Get julian data reference (iformat==2)
+      !---------------------------------------------------------------------
+
+      IF (iformat==2) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, nf90_global, &
+            &                        "Reference_date_time", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(7:10)//cdjulref(4:5)// &
+            & cdjulref(1:2)//cdjulref(12:13)//cdjulref(15:16)//cdjulref(18:19)
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                                &
+         &         cl_name, __LINE__ )
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%ivlqc(:,:,2) = 4
+         inpfile%pob(:,:,2) = fbrmdi
+         lsal = .FALSE.
+      ENDIF
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      IF (lsal) THEN
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                 & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1,iobs
+            istart1(1) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                 &
+               &                         start = istart1, count = icount1),                           &
+               &         cl_name, __LINE__ )
+            inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+         END DO
+      ELSE
+         inpfile%ivqc(:,2) = 4
+      ENDIF
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1, iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)  = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      IF (iformat==1) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, i_juld_id, &
+            &                        "units", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(12:15)//cdjulref(17:18)// &
+            & cdjulref(20:21)//cdjulref(23:24)//cdjulref(26:27)//&
+            & cdjulref(29:30)
+      ENDIF
+      
+      IF ( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                          &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth_qc, i_qc_var_id ),                      & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%pdep(:,:) = fbrmdi
+         inpfile%idqc(:,:) = 4
+      ENDIF
+
+      IF ( nf90_inq_varid( i_file_id, cl_fld_pres, i_pres_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_pres_id, zpres ),                                  &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pres_qc, i_qc_var_id ),                       & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         zpres(:,:) = fbrmdi
+         ipresqc(:,:) = 4
+      ENDIF
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_t, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      IF (lsal) THEN      
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                            &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                      &
+            &         cl_name, __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+         
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Coriolis data conversion from insitu to potential temperature
+      !---------------------------------------------------------------------
+      !---------------------------------------------------------------------
+      !  Convert pressure to depth if depth not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( inpfile%pdep(jk,ji) >= 9999.0 ) THEN
+                  IF ( zpres(jk,ji) < 9999.0 ) THEN
+                     inpfile%pdep(jk,ji) = &
+                        & p_to_dep( REAL(zpres(jk,ji),wp), REAL(inpfile%pphi(ji),wp) )
+                     inpfile%idqc(jk,ji) = ipresqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert depth to pressure if pressure not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( zpres(jk,ji) >= 9999.0 ) THEN
+                  IF ( inpfile%pdep(jk,ji) < 9999.0 ) THEN
+                     zpres(jk,ji) = dep_to_p( REAL(inpfile%pdep(jk,ji),wp), &
+                        &                            REAL(inpfile%pphi(ji),wp) )
+                     ipresqc(jk,ji) = inpfile%idqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert insitu temperature to potential temperature if
+      !  salinity, insitu temperature and pressure are present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         DO jk = 1, inpfile%nlev
+            IF (( inpfile%pob(jk,ji,2) < 9999.0 ) .AND. &
+               &( inpfile%pext(jk,ji,1) < 9999.0 ) .AND. &
+               &( zpres(jk,ji) < 9999.0 ) ) THEN
+               inpfile%pob(jk,ji,1) = potemp( REAL(inpfile%pob(jk,ji,2), wp),  &
+                  &                           REAL(inpfile%pext(jk,ji,1), wp), &
+                  &                           REAL(zpres(jk,ji),wp),  &
+                  &                           0.0_wp )
+            ELSE
+               inpfile%pob(jk,ji,1) = fbrmdi
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      !  Initialize flags since they are not in the CORIOLIS input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+   END SUBROUTINE read_coriofile
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsseaice_io.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsseaice_io.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsseaice_io.h90	(revision 2236)
@@ -0,0 +1,264 @@
+   SUBROUTINE read_seaice( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_seaice **
+      !!
+      !! ** Purpose : Read from file the SEAICE observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice'
+      INTEGER :: i_file_id    ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data       ! Number of data per parameter in current file
+      INTEGER :: i_time       ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of seaice measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_seaice         ! Seaice data     
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen          ! Length of netCDF attributes
+      INTEGER :: itype          ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca      ! Scale factor
+      REAL(KIND=wp) :: zoff      ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset  ! Offset for time conversion
+      REAL(KIND=wp) :: zfill     ! Fill value in netcdf file
+      CHARACTER (len=33) ::creftime     ! Reference time of file
+      INTEGER :: i_refyear       ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_seaice        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SeaIce_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get seaice data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_ice_concentration', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_seaice), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_seaice(:,:) /=  zfill)
+         z_seaice(:,:) = (zsca * z_seaice(:,:)) + zoff
+      ELSEWHERE
+         z_seaice(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get seaice obs type
+      
+      i_type(:,:)=1
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SEAICE'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'seaice','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_seaice(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_seaice(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+   END SUBROUTINE read_seaice
+
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obssla_io.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obssla_io.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obssla_io.h90	(revision 2236)
@@ -0,0 +1,372 @@
+   SUBROUTINE read_avisofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_avisofile **
+      !!
+      !! ** Purpose : Read from file the AVISO SLA observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : http://www.aviso.oceanobs.com
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile'
+      INTEGER :: i_file_id     ! netcdf IDS
+      INTEGER :: i_tracks_id
+      INTEGER :: i_cycles_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen         ! Length of netCDF attributes
+      INTEGER :: itype         ! Typeof netCDF attributes
+      REAL(fbdp) :: zsca       ! Scale factor
+      REAL(fbdp) :: zfill      ! Fill value
+      CHARACTER(len=3) ::  cmission      ! Mission global attribute
+      INTEGER :: itracks       ! Maximum number of passes in file
+      INTEGER :: icycles       ! Maximum number of cycles for each pass
+      INTEGER :: idata         ! Number of data per parameter in current file
+      REAL(fbdp) :: zdeltat    ! Time gap getween two measurements in seconds
+      INTEGER, DIMENSION(:), POINTER :: & 
+         & iptracks,     &  ! List of passes contained in current file
+         & ipnbpoints,   &  ! Number of points per pass
+         & ipdataindexes    ! Index of data in theoretical profile
+      INTEGER, DIMENSION(:,:), POINTER :: & 
+         & ipcycles         ! List of cycles per pass
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zphi,   &        ! Latitudes
+         & zlam             ! Longitudes
+      REAL(fbdp), DIMENSION(:,:), POINTER :: &
+         & zbegindates      ! Date of point with index 0
+      REAL(fbdp) :: zbeginmiss    ! Missing data for dates
+      REAL(fbsp), DIMENSION(:,:), POINTER :: &
+         & zsla             ! SLA data
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zjuld            ! Julian date
+      LOGICAL, DIMENSION(:), POINTER :: &
+         & llskip           ! Skip observation
+      CHARACTER(len=14) :: cdjuldref    ! Julian data reference
+      INTEGER :: imission   ! Mission number converted from Mission global 
+                            ! netCDF atttribute.
+      CHARACTER(len=255) :: ctmp
+      INTEGER :: iobs
+      INTEGER :: jl
+      INTEGER :: jm
+      INTEGER :: jj
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jobs
+      INTEGER :: jcycle
+
+      ! Open the file
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, i_file_id ), &
+         &         cpname, __LINE__ )
+
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Tracks', i_tracks_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_tracks_id, &
+         &                                 len = itracks ),  &
+         &         cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Cycles', i_cycles_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_cycles_id, &
+         &                                 len = icycles ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Data', i_data_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_data_id, &
+         &                                 len = idata ),  &
+         &         cpname, __LINE__ )
+
+      ! Allocate memory for input data
+
+      ALLOCATE( &
+         & iptracks     ( itracks          ), &  
+         & ipnbpoints   ( itracks          ), &  
+         & ipcycles     ( icycles, itracks ), &
+         & zphi         ( idata            ), &   
+         & zlam         ( idata            ), &  
+         & zbegindates  ( icycles, itracks ), &
+         & ipdataindexes( idata            ), & 
+         & zsla         ( icycles, idata   ), &
+         & zjuld        ( idata*icycles    ), &
+         & llskip       ( idata*icycles    )  &
+         & )
+
+      ! Get time gap getween two measurements in seconds
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DeltaT', i_var_id ), & 
+         &         cpname, __LINE__ )
+      CALL chkdim( i_file_id, i_var_id, 0, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zdeltat), &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zdeltat = zsca * zdeltat
+         
+      ! Get List of passes contained in current file      
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Tracks', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, iptracks), &
+         &         cpname, __LINE__ )
+      
+      ! Get Number of points per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'NbPoints', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipnbpoints),&
+         &         cpname, __LINE__ )
+      
+      ! Get list of cycles per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Cycles', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipcycles),   &
+         &         cpname, __LINE__ )
+
+      ! Get longitudes
+
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Longitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zlam),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                         == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zlam(:) = zsca * zlam(:)
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Latitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zphi),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zphi(:) = zsca * zphi(:)
+      
+      ! Get date of point with index 0
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'BeginDates', i_var_id ), & 
+         &        cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zbegindates), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, &
+         &                                 'units', len = iilen,  &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 255 )) THEN
+         CALL fatal_error('Error decoding BeginDates unit', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, 'units', &
+         &                       ctmp ), cpname, __LINE__ )
+      jl=1
+      DO jm = 1, LEN(TRIM(ctmp))
+         IF ((ctmp(jm:jm)>='0').AND.(ctmp(jm:jm)<='9')) THEN
+            cdjuldref(jl:jl) = ctmp(jm:jm)
+            jl=jl+1
+         ENDIF
+         IF (jl>14) EXIT
+      END DO
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF ( itype /= NF90_DOUBLE ) THEN
+         CALL fatal_error('Error decoding BeginDates missing data', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', &
+         &                       zbeginmiss ), cpname, __LINE__ )
+
+      ! Get indices of data in theoretical profile
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DataIndexes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipdataindexes),   &
+         &       cpname, __LINE__ )
+      
+      ! Get SLA data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SLA', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = idata
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zsla),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                        == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       'scale_factor',zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     '_FillValue',zfill), cpname,  __LINE__ )
+      ENDIF
+      WHERE(zsla(:,:) /=  zfill)
+         zsla(:,:) = zsca * zsla(:,:)
+      ELSEWHERE
+         zsla(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get the global Mission netCDF attribute
+      
+      cmission='   '
+      CALL chkerr( nf90_inquire_attribute( i_file_id, nf90_global, &
+         &                                 'Mission', len = iilen,  &
+         &                                 xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 3 )) THEN
+         CALL fatal_error('Error decoding Mission global attribute', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, nf90_global, 'Mission', &
+         &                       cmission ), cpname, __LINE__ )
+      
+      ! Convert it to an integer
+      imission = 0
+      DO jm = 1, imaxmissions
+         IF (cmission==cmissions(jm)) THEN
+            imission = jm
+            EXIT
+         ENDIF
+      END DO
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Compute Julian dates for all observations
+      
+      jm = 0
+      jl = 0
+      DO jj = 1, itracks
+         DO ji = 1, ipnbpoints(jj)
+            jl = jl + 1
+            DO jk = 1, icycles
+               jm = jm + 1
+               IF (zbegindates(jk,jj)==zbeginmiss) THEN
+                  llskip(jm) = .TRUE.
+                  zjuld(jm)  = fbrmdi
+               ELSE
+                  llskip(jm) = .FALSE.
+                  zjuld(jm)  = zbegindates(jk,jj) + &
+                     &         (ipdataindexes(jl) * zdeltat / 86400._wp )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Get rid of missing data
+
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE.
+         END DO
+      END DO
+      
+      ! Allocate obfbdata
+
+      iobs = COUNT( .NOT.llskip(:) )
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SLA'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = cdjuldref
+      iobs = 0
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (llskip(jm)) CYCLE
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A3,A5)') cmissions(imission), '     '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') imission
+            ! Real values
+            inpfile%plam(iobs)         = zlam(jobs)
+            inpfile%pphi(iobs)         = zphi(jobs)
+            inpfile%pob(1,iobs,1)      = zsla(jcycle,jobs)
+            inpfile%ptim(iobs)         = zjuld(jm)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            inpfile%ioqc(iobs)      = 1
+            inpfile%ivqc(iobs,1)    = 1
+            inpfile%ivlqc(1,iobs,1) = 1
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+
+      ! Deallocate memory for input data
+
+      DEALLOCATE( &
+         & iptracks,      &
+         & ipnbpoints,    &
+         & ipcycles,      &
+         & zphi,          &
+         & zlam,          &  
+         & zbegindates,   &
+         & ipdataindexes, &
+         & zsla,          &
+         & zjuld,         &
+         & llskip         &
+         & )
+
+   END SUBROUTINE read_avisofile
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obssla_types.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obssla_types.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obssla_types.h90	(revision 2236)
@@ -0,0 +1,3 @@
+   INTEGER, PARAMETER :: imaxmissions=8
+   CHARACTER(len=3) :: cmissions(0:imaxmissions) = &
+      & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ', 'J2 ' /)
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obssst_io.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obssst_io.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obssst_io.h90	(revision 2236)
@@ -0,0 +1,280 @@
+   SUBROUTINE read_ghrsst( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_ghrsst **
+      !!
+      !! ** Purpose : Read from file the GHRSST observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ghrsst'
+      INTEGER :: i_file_id        ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data           ! Number of data per parameter in current file
+      INTEGER :: i_time           ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of SST measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_sst            ! SST data     
+      INTEGER, PARAMETER :: imaxdim = 2      ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims         ! Dimensions in file
+      INTEGER :: iilen            ! Length of netCDF attributes
+      INTEGER :: itype            ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca           ! Scale factor
+      REAL(KIND=wp) :: zoff           ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset       ! Offset for time conversion
+      REAL(KIND=wp) :: zfill          ! Fill value in netcdf file
+      CHARACTER (len=33) :: creftime  ! Reference time of file
+      INTEGER :: i_refyear            ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_sst        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sst_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get SST data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_surface_temperature', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_sst), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_sst(:,:) /=  zfill)
+         z_sst(:,:) = (zsca * z_sst(:,:)) + zoff
+      ELSEWHERE
+         z_sst(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get SST obs type
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'data_source', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_type),   &
+         &       cpname, __LINE__ )
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SST'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'ghrsst','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_sst(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_sst(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+      DEALLOCATE( &
+         & i_reftime, &
+         & i_dtime,   &
+         & i_qc,      &
+         & i_type,    &
+         & z_phi,     &
+         & z_lam,     &
+         & z_sst      &
+         & )
+
+   END SUBROUTINE read_ghrsst
+
+
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsvel_io.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsvel_io.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/obsvel_io.h90	(revision 2236)
@@ -0,0 +1,354 @@
+   SUBROUTINE read_taondbc( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the TAO data fro NDBC.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! ** Reference : http://tao.noaa.gov/tao/data_deliv/deliv_ndbc.shtml
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original version.
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                ! Number of levels
+      INTEGER :: ilat                ! Number of latitudes
+      INTEGER :: ilon                ! Number of longtudes
+      INTEGER :: itim                ! Number of obs. times
+      INTEGER :: i_file_id
+      INTEGER :: i_dimid_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_time_id
+      INTEGER :: i_time2_id
+      INTEGER :: i_qc_var_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth
+      CHARACTER(LEN=40) :: cl_fld_var_u
+      CHARACTER(LEN=40) :: cl_fld_var_v
+      CHARACTER(LEN=40) :: cl_fld_var_qc_uv1
+      CHARACTER(LEN=40) :: cl_fld_var_qc_uv2
+      CHARACTER(LEN=40) :: cl_fld_time
+      CHARACTER(LEN=40) :: cl_fld_time2
+      INTEGER :: ja
+      INTEGER :: jo
+      INTEGER :: jk
+      INTEGER :: jt
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: &
+         & zv,     &
+         & zu,     &
+         & zuv1qc, &
+         & zuv2qc
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: &
+         & zdep, &
+         & zlat, &
+         & zlon, &
+         & zjuld
+      REAL(wp) :: zl
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
+         & itime, &
+         & itime2
+      CHARACTER(LEN=50) :: cdjulref
+      CHARACTER(LEN=12), PARAMETER :: cl_name = 'read_taondbc'
+      CHARACTER(len=1) :: cns, cew
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+      cl_fld_lam                 = 'lon'
+      cl_fld_phi                 = 'lat'
+      cl_fld_depth               = 'depth'
+      cl_fld_time                = 'time'
+      cl_fld_time2               = 'time2'
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+      IF(ldwp) WRITE(kunit,*)
+      IF(ldwp) WRITE(kunit,*) ' read_taondbc :' 
+      IF(ldwp) WRITE(kunit,*) ' ~~~~~~~~~~~~'
+      
+      !---------------------------------------------------------------------
+      ! Read the number of observations and of levels to allocate array
+      !---------------------------------------------------------------------
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'time', i_dimid_id ),        &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = itim ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'depth', i_dimid_id ),       &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilev ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lat', i_dimid_id ),           &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilat ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lon', i_dimid_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilon ),    &
+         &         cl_name, __LINE__ ) 
+
+      iobs = itim * ilat * ilon
+      IF(ldwp)WRITE(kunit,*) '         No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '         No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 0, ldgrid )
+      inpfile%cname(1) = 'UVEL'
+      inpfile%cname(2) = 'VVEL'
+      inpfile%coblong(1) = 'Zonal current'
+      inpfile%coblong(2) = 'Meridional current'
+      inpfile%cobunit(1) = 'Meters per second'
+      inpfile%cobunit(2) = 'Meters per second'
+
+      ALLOCATE( &
+         & zu(ilon,ilat,ilev,itim),     &
+         & zv(ilon,ilat,ilev,itim),     &
+         & zdep(ilev),                  &
+         & zuv1qc(ilon,ilat,ilev,itim), &
+         & zuv2qc(ilon,ilat,ilev,itim), &
+         & itime(itim),                 &
+         & itime2(itim),                &
+         & zlat(ilat),                  &
+         & zlon(ilon),                  &
+         & zjuld(itim)                  &
+         & )
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time, i_time_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_time_id, itime ),                                     &
+         &         cl_name, __LINE__ )
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time2, i_time2_id ),                             &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_time2_id, itime2 ),                                   &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, zdep ),                                     &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, zlat ),                                       &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, zlon ),                                       &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      ! ADCP format assumed
+      cl_fld_var_u = 'u_1205'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_u = 'U_320'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
+            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zu ),                                         &
+         &         cl_name, __LINE__ )
+      
+      ! ADCP format assumed
+      cl_fld_var_v = 'v_1206'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_v = 'V_321'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
+            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zv ),                                         &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+      
+      ! ADCP format assumed
+      cl_fld_var_qc_uv1 = 'QU_5205'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_qc_uv1 = 'QCS_5300'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+            ! Try again with high freq. current meter format
+            cl_fld_var_qc_uv1 = 'QCU_5320'
+            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+            ENDIF
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv1qc),                                   &
+         &         cl_name, __LINE__ )
+
+      ! ADCP format assumed
+      cl_fld_var_qc_uv2 = 'QV_5206'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_qc_uv2 = 'QCD_5310'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+            ! Try again with high freq. current meter format
+            cl_fld_var_qc_uv2 = 'QCV_5321'
+            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+            ENDIF
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv2qc),                                   &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Convert to to 19500101 based Julian date
+      !---------------------------------------------------------------------
+      DO jt = 1, itim
+         zjuld(jt) = REAL(itime(jt),wp) + REAL(itime2(jt),wp)/86400000.0_wp &
+            &           - 2433283.0_wp
+      END DO
+      inpfile%cdjuldref = '19500101000000'
+
+      !---------------------------------------------------------------------
+      ! Copy info to obfbdata structure
+      !---------------------------------------------------------------------
+
+      iobs = 0
+      DO jt = 1, itim
+         DO ja = 1, ilat
+            DO jo = 1, ilon
+               iobs = iobs + 1
+               zl = zlon(jo)
+               IF ( zl > 180.0_wp ) zl = zl - 360.0_wp
+               IF ( zl < 0 ) THEN
+                  cew = 'w'
+               ELSE
+                  cew = 'e'
+               ENDIF
+               IF ( zlat(jo) < 0 ) THEN
+                  cns = 's'
+               ELSE
+                  cns = 'n'
+               ENDIF
+               WRITE(inpfile%cdwmo(iobs),'(A1,I2.2,A1,I3.3)') &
+                  & cns, ABS(NINT(zlat(ja))), cew, ABS(NINT(zl))
+               DO jk = 1, ilev
+                  inpfile%pob(jk,iobs,1)     = zu(jo,ja,jk,jt)
+                  inpfile%pob(jk,iobs,2)     = zv(jo,ja,jk,jt)
+                  inpfile%pdep(jk,iobs)      = zdep(jk)
+                  inpfile%ivlqc(jk,iobs,1:2) = INT( MAX( zuv1qc(jo,ja,jk,jt), zuv2qc(jo,ja,jk,jt) ) )
+               END DO
+               inpfile%plam(iobs) = zlon(jo)
+               inpfile%pphi(iobs) = zlat(ja)
+               inpfile%ptim(iobs) = zjuld(jt)
+            END DO
+         END DO
+      END DO
+
+      ! No position, time, depth and variable QC in input files
+      DO jo = 1, iobs
+         inpfile%ipqc(jo) = 1
+         inpfile%itqc(jo) = 1
+         inpfile%ivqc(jo,1:2) = 1
+         DO jk = 1, ilev
+            inpfile%idqc(jk,jo) = 1
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Set the platform information
+      !---------------------------------------------------------------------
+      inpfile%cdtyp(:)=' 820'
+
+      !---------------------------------------------------------------------
+      ! Set QC flags for missing data and rescale to m/s
+      !---------------------------------------------------------------------
+
+      DO jo = 1, iobs
+         DO jk = 1, ilev
+            IF ( ( ABS(inpfile%pob(jk,jo,1)) > 10000.0_wp ) .OR. &
+               & ( ABS(inpfile%pob(jk,jo,2)) > 10000.0_wp ) ) THEN
+               inpfile%ivlqc(jk,jo,:) = 4
+               inpfile%pob(jk,jo,1) = fbrmdi
+               inpfile%pob(jk,jo,2) = fbrmdi
+            ELSE
+               inpfile%pob(jk,jo,1) = 0.01 * inpfile%pob(jk,jo,1)
+               inpfile%pob(jk,jo,2) = 0.01 * inpfile%pob(jk,jo,2)
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+
+      DO jo = 1, inpfile%nobs
+         inpfile%kindex(jo) = jo
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Initialize flags since they are not in the TAO input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+      !---------------------------------------------------------------------
+      ! Deallocate data
+      !---------------------------------------------------------------------
+      DEALLOCATE( &
+         & zu,     &
+         & zv,     &
+         & zdep,   &
+         & zuv1qc, &
+         & zuv2qc, &
+         & itime,  &
+         & itime2, &
+         & zlat,   &
+         & zlon,   &
+         & zjuld   &
+         & )
+
+   END SUBROUTINE read_taondbc
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/str_c_to_for.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/str_c_to_for.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/OBS/str_c_to_for.h90	(revision 2236)
@@ -0,0 +1,33 @@
+   SUBROUTINE str_c_to_for( cd_str )
+      !!---------------------------------------------------------------------
+      !!   
+      !!                     *** ROUTINE str_c_to_for ***
+      !! 
+      !! ** Purpose : Loop over a string and replace all non-printable
+      !!              ASCII characters with spaces assuming English 
+      !!              characters only
+      !!
+      !! ** Method  : Loop over a string and replace all non-printable
+      !!              ASCII characters with spaces assuming English 
+      !!              characters only
+      !!
+      !! ** Action  : 
+      !! 
+      !! History :  
+      !!        ! : 06-05 (K. Mogensen) Original
+      !!        ! : 06-05 (A. Vidard) Cleaning up
+      !!        ! : 06-10 (A. Weaver) More cleaning
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(INOUT) :: cd_str
+
+      !! * Local declarations
+      INTEGER :: &
+         & ji
+
+      DO ji = 1, LEN( cd_str )
+         IF (     ( IACHAR( cd_str(ji:ji) ) > 128 ) &
+            & .OR.( IACHAR( cd_str(ji:ji) ) < 32  ) ) cd_str(ji:ji) = ' '
+      END DO
+
+   END SUBROUTINE str_c_to_for
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/albedo.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/albedo.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/albedo.F90	(revision 2236)
@@ -47,5 +47,5 @@
    !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 2236)
@@ -66,5 +66,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Header$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/cpl_oasis4.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/cpl_oasis4.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/cpl_oasis4.F90	(revision 2236)
@@ -120,5 +120,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/fldread.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/fldread.F90	(revision 2236)
@@ -15,4 +15,5 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
+   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar
    USE phycst          ! ???
    USE in_out_manager  ! I/O manager
@@ -29,5 +30,5 @@
       LOGICAL              ::   ln_tint     ! time interpolation or not (T/F)
       LOGICAL              ::   ln_clim     ! climatology or not (T/F)
-      CHARACTER(len = 7)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly'
+      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly'
       CHARACTER(len = 34)  ::   wname       ! generic name of a NetCDF weights file to be used, blank if not
       CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation
@@ -43,5 +44,5 @@
       LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F)
       LOGICAL                         ::   ln_clim      ! climatology or not (T/F)
-      CHARACTER(len = 7)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly'
+      CHARACTER(len = 8)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly'
       INTEGER                         ::   num          ! iom id of the jpfld files to be read
       INTEGER                         ::   nswap_sec    ! swapping time in second since Jan. 1st 00h of nit000 year
@@ -78,6 +79,6 @@
       INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpj     ! array of source integers
       REAL(wp), DIMENSION(:,:,:), POINTER     ::   data_wgt     ! array of weights on model grid
-      REAL(wp), DIMENSION(:,:), POINTER       ::   fly_dta      ! array of values on input grid
-      REAL(wp), DIMENSION(:,:), POINTER       ::   col2         ! temporary array for reading in columns
+      REAL(wp), DIMENSION(:,:,:), POINTER       ::   fly_dta      ! array of values on input grid
+      REAL(wp), DIMENSION(:,:,:), POINTER       ::   col2         ! temporary array for reading in columns
    END TYPE WGT
 
@@ -93,5 +94,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -159,9 +160,13 @@
 
                ! last record to be read in the current file
-               IF( sd(jf)%nfreqh == -1 ) THEN                  ;   ireclast = 12
+               IF( sd(jf)%nfreqh == -1 ) THEN
+                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 1
+                  ELSE                                         ;   ireclast = 12
+                  ENDIF
                ELSE                             
-                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 
-                  ELSEIF( sd(jf)%cltype == 'daily'     ) THEN  ;   ireclast = 24                      / sd(jf)%nfreqh
-                  ELSE                                         ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh 
+                  IF(     sd(jf)%cltype      == 'monthly' ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 
+                  ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN  ;   ireclast = 24.* 7                  / sd(jf)%nfreqh
+                  ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN  ;   ireclast = 24                      / sd(jf)%nfreqh
+                  ELSE                                            ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh 
                   ENDIF
                ENDIF
@@ -207,13 +212,25 @@
             IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN
                CALL wgt_list( sd(jf), kw )
-               DO jk = 1, ipk
-                  CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,jk,2), sd(jf)%nrec_a(1) )
-               END DO
+               ipk = SIZE(sd(jf)%fnow,3)
+               IF( sd(jf)%ln_tint ) THEN
+                  CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) )
+               ELSE
+                  CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fnow(:,:,:)   , sd(jf)%nrec_a(1) )
+               ENDIF
             ELSE
-               IF( ipk == 1 ) THEN 
-                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) )
-               ELSE
-                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) )
-               ENDIF
+               SELECT CASE( SIZE(sd(jf)%fnow,3) )
+               CASE(1)   
+                  IF( sd(jf)%ln_tint ) THEN
+                     CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) )
+                  ELSE
+                     CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,1)  , sd(jf)%nrec_a(1) )
+                  ENDIF 
+               CASE(jpk)
+                  IF( sd(jf)%ln_tint ) THEN
+                     CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) )
+                  ELSE
+                     CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,:)  , sd(jf)%nrec_a(1) )
+                  ENDIF 
+               END SELECT
             ENDIF
             sd(jf)%rotn(2) = .FALSE.
@@ -249,5 +266,28 @@
                 IF( kf > 0 ) THEN
                    !! fields jf,kf are two components which need to be rotated together
-                   DO nf = 1,2
+                   IF( sd(jf)%ln_tint )THEN
+                      DO nf = 1,2
+                         !! check each time level of this pair
+                         IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN
+                            utmp(:,:) = 0.0
+                            vtmp(:,:) = 0.0
+                            !
+                            ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 )
+                            DO jk = 1,ipk
+                               CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) )
+                               CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) )
+                               sd(jf)%fdta(:,:,jk,nf) = utmp(:,:)
+                               sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:)
+                            ENDDO
+                            !
+                            sd(jf)%rotn(nf) = .TRUE.
+                            sd(kf)%rotn(nf) = .TRUE.
+                            IF( lwp .AND. kt == nit000 ) &
+                                      WRITE(numout,*) 'fld_read: vector pair (',  &
+                                                      TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), &
+                                                      ') rotated on to model grid'
+                         ENDIF
+                      END DO
+                   ELSE 
                       !! check each time level of this pair
                       IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN
@@ -255,10 +295,11 @@
                          vtmp(:,:) = 0.0
                          !
-                         DO jk = 1, SIZE( sd(kf)%fdta, 3 )
-                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) )
-                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) )
-                            sd(jf)%fdta(:,:,jk,nf) = utmp(:,:)
-                            sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:)
-                         END DO
+                         ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 )
+                         DO jk = 1,ipk
+                            CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->i', utmp(:,:) )
+                            CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->j', vtmp(:,:) )
+                            sd(jf)%fnow(:,:,jk) = utmp(:,:)
+                            sd(kf)%fnow(:,:,jk) = vtmp(:,:)
+                         ENDDO
                          !
                          sd(jf)%rotn(nf) = .TRUE.
@@ -269,5 +310,5 @@
                                                    ') rotated on to model grid'
                       ENDIF
-                   END DO
+                   ENDIF
                 ENDIF
              ENDIF
@@ -301,6 +342,4 @@
                ENDIF
 !CDIR COLLAPSE
-               sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2)   ! piecewise constant field
- 
             ENDIF
             !
@@ -326,22 +365,27 @@
       TYPE(FLD), INTENT(inout) ::   sdjf        ! input field related variables
       !!
-      LOGICAL :: llprevyr       ! are we reading previous year  file?
-      LOGICAL :: llprevmth      ! are we reading previous month file?
-      LOGICAL :: llprevday      ! are we reading previous day   file?
-      LOGICAL :: llprev         ! llprevyr .OR. llprevmth .OR. llprevday
-      INTEGER :: idvar          ! variable id 
-      INTEGER :: inrec          ! number of record existing for this variable
+      LOGICAL :: llprevyr              ! are we reading previous year  file?
+      LOGICAL :: llprevmth             ! are we reading previous month file?
+      LOGICAL :: llprevweek            ! are we reading previous week file?
+      LOGICAL :: llprevday             ! are we reading previous day   file?
+      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevday
+      INTEGER :: idvar                 ! variable id 
+      INTEGER :: inrec                 ! number of record existing for this variable
       INTEGER :: kwgt
-      INTEGER :: jk             ! vertical loop variable
-      INTEGER :: ipk            ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER :: jk             !vertical loop variable
+      INTEGER :: ipk            !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
+      INTEGER :: isec_week             ! number of seconds since start of the weekly file
       CHARACTER(LEN=1000) ::   clfmt   ! write format
       !!---------------------------------------------------------------------
-
+      
       ! some default definitions...
       sdjf%num = 0   ! default definition for non-opened file
       IF( sdjf%ln_clim )   sdjf%clname = TRIM( sdjf%clrootname )   ! file name defaut definition, never change in this case
-      llprevyr  = .FALSE.
-      llprevmth = .FALSE.
-      llprevday = .FALSE.
+      llprevyr   = .FALSE.
+      llprevmth  = .FALSE.
+      llprevweek = .FALSE.
+      llprevday  = .FALSE.
+      isec_week  = 0
             
       ! define record informations
@@ -365,4 +409,7 @@
                   llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file?
                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
+               ELSE IF ( sdjf%cltype(1:4) == 'week' ) THEN !weekly file
+                  isec_week = 86400 * 7
+                  sdjf%nrec_b(1) = 24. / sdjf%nfreqh * 7                                   ! last record of previous weekly file
                ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file
                   sdjf%nrec_b(1) = 24 / sdjf%nfreqh                                        ! last record of previous day
@@ -376,10 +423,23 @@
             ENDIF
          ENDIF
-         llprev = llprevyr .OR. llprevmth .OR. llprevday
+         llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
 
          CALL fld_clopn( sdjf, nyear  - COUNT((/llprevyr /))                                              ,               &
             &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               &
             &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev )
-         
+
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN
+            isec_week  = ksec_week( sdjf%cltype(6:8) )
+            if(lwp)write(numout,*)'cbr test2 isec_week = ',isec_week
+            llprevmth  = ( isec_week .GT. nsec_month )
+            llprevyr   = llprevmth  .AND. nmonth==1
+         ENDIF
+         !
+         iyear  = nyear  - COUNT((/llprevyr /))
+         imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /))
+         iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - INT( isec_week )/86400
+         !
+         CALL fld_clopn( sdjf , iyear , imonth , iday , .NOT. llprev )
+
          ! if previous year/month/day file does not exist, we switch to the current year/month/day
          IF( llprev .AND. sdjf%num <= 0 ) THEN
@@ -399,16 +459,27 @@
 
          ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read
-         ipk = SIZE( sdjf%fdta, 3 )
          IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
             CALL wgt_list( sdjf, kwgt )
-            DO jk = 1, ipk
-               CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,jk,2), sdjf%nrec_b(1) )
-            END DO
+            ipk = SIZE(sdjf%fnow,3)
+            IF( sdjf%ln_tint ) THEN
+               CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
+            ELSE
+               CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fnow(:,:,:)  , sdjf%nrec_a(1) )
+            ENDIF
          ELSE
-            IF( ipk == 1 ) THEN
-               CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) )
-            ELSE
-               CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) )
-            ENDIF
+            SELECT CASE( SIZE(sdjf%fnow,3) )
+            CASE(1)
+               IF( sdjf%ln_tint ) THEN
+                  CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) )
+               ELSE
+                  CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1)  , sdjf%nrec_b(1) )
+               ENDIF
+            CASE(jpk)
+               IF( sdjf%ln_tint ) THEN
+                  CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) )
+               ELSE
+                  CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:)  , sdjf%nrec_b(1) )
+               ENDIF
+            END SELECT
          ENDIF
          sdjf%rotn(2) = .FALSE.
@@ -422,7 +493,27 @@
 
       IF( sdjf%num <= 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened
+      ! make sure current year/month/day file is opened
+      IF( sdjf%num == 0 ) THEN
+         isec_week   = 0
+         llprevyr    = .FALSE.
+         llprevmth   = .FALSE.
+         llprevweek  = .FALSE.
+         !
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN
+            isec_week  = ksec_week( sdjf%cltype(6:8) )
+            llprevmth  = ( isec_week .GT. nsec_month )
+            llprevyr   = llprevmth  .AND. nmonth==1
+         ENDIF
+         !
+         iyear  = nyear  - COUNT((/llprevyr /))
+         imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /))
+         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week/86400
+         !
+         CALL fld_clopn( sdjf, iyear, imonth, iday )
+      ENDIF 
 
       sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read 
-      
+     
+
    END SUBROUTINE fld_init
 
@@ -442,4 +533,5 @@
       REAL(wp) ::   ztmp        ! temporary variable
       INTEGER  ::   ifreq_sec   ! frequency mean (in seconds)
+      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file
       !!----------------------------------------------------------------------
       !
@@ -458,4 +550,5 @@
             !       forcing record :  nmonth 
             !                            
+            ztmp  = 0.e0
             ztmp  = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5
          ELSE
@@ -468,15 +561,31 @@
          ENDIF
 
-         sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time
-         irec = irec - 1                                                ! move back to previous record
-         sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time
+         IF( sdjf%cltype == 'monthly' ) THEN
+
+            sdjf%nrec_b(:) = (/ 0, nmonth_half(irec - 1 ) + nsec1jan000 /)
+            sdjf%nrec_a(:) = (/ 1, nmonth_half(irec     ) + nsec1jan000 /)
+
+            IF( ztmp  == 1. ) THEN
+              sdjf%nrec_b(1) = 1
+              sdjf%nrec_a(1) = 2
+            ENDIF
+
+         ELSE
+
+            sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time
+            irec = irec - 1                                                ! move back to previous record
+            sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time
+
+         ENDIF
          !
       ELSE                              ! higher frequency mean (in hours)
          !
          ifreq_sec = sdjf%nfreqh * 3600   ! frequency mean (in seconds)
+         IF( sdjf%cltype(1:4) == 'week'    ) isec_week = ksec_week( sdjf%cltype(6:8)) !since the first day of the current week
          ! number of second since the beginning of the file
-         IF(     sdjf%cltype == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)   ! since 00h on the 1st day of the current month
-         ELSEIF( sdjf%cltype == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)   ! since 00h of the current day
-         ELSE                                      ;   ztmp = REAL(nsec_year ,wp)   ! since 00h on Jan 1 of the current year
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month ,wp)  ! since 00h on the 1st day of the current month
+         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week  ,wp)  ! since the first day of the current week
+         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day   ,wp)  ! since 00h of the current day
+         ELSE                                           ;   ztmp = REAL(nsec_year  ,wp)  ! since 00h on Jan 1 of the current year
          ENDIF
          IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record
@@ -514,7 +623,9 @@
          ! after record index and second since Jan. 1st 00h of nit000 year
          sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /)
-         IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month
+         IF( sdjf%cltype == 'monthly' )       &   ! add the number of seconds between 00h Jan 1 and the end of previous month
             sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1
-         IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day
+         IF( sdjf%cltype(1:4) == 'week'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous week 
+            sdjf%nrec_a(2) = sdjf%nrec_a(2) + ( nsec_year - isec_week )
+         IF( sdjf%cltype == 'daily'   )       &   ! add the number of seconds between 00h Jan 1 and the end of previous day
             sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 )
 
@@ -522,7 +633,9 @@
          irec = irec - 1.                           ! move back to previous record
          sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /)
-         IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month
+         IF( sdjf%cltype == 'monthly' )       &   ! add the number of seconds between 00h Jan 1 and the end of previous month
             sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1
-         IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day
+         IF( sdjf%cltype(1:4) == 'week'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous week
+            sdjf%nrec_b(2) = sdjf%nrec_b(2) + ( nsec_year - isec_week )
+         IF( sdjf%cltype == 'daily'   )       &   ! add the number of seconds between 00h Jan 1 and the end of previous day
             sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 )
 
@@ -545,15 +658,27 @@
       !! ** Method  :   
       !!----------------------------------------------------------------------
-      TYPE(FLD), INTENT(inout)           ::   sdjf     ! input field related variables
-      INTEGER  , INTENT(in   )           ::   kyear    ! year value
-      INTEGER  , INTENT(in   )           ::   kmonth   ! month value
-      INTEGER  , INTENT(in   )           ::   kday     ! day value
-      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      TYPE(FLD), INTENT(inout)           ::   sdjf                      ! input field related variables
+      INTEGER  , INTENT(in   )           ::   kyear                     ! year value
+      INTEGER  , INTENT(in   )           ::   kmonth                    ! month value
+      INTEGER  , INTENT(in   )           ::   kday                      ! day value
+      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop                    ! stop if open to read a non-existing file (default = .TRUE.)
+      INTEGER                            ::   iyear, imonth, iday       ! firt day of the current week in yyyy mm dd
+      REAL(wp)                           ::   zsec, zjul                !temp variable
 
       IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
       ! build the new filename if not climatological data
-      IF( .NOT. sdjf%ln_clim ) THEN   ;   WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
-         IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month
-         IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day
+      sdjf%clname=TRIM(sdjf%clrootname)
+      !
+      IF(  sdjf%cltype(1:4) == 'week' .AND. nn_leapy==0 )CALL ctl_stop( 'fld_clopn: weekly file and nn_leapy=0 are not compatible' )
+      !
+      IF( .NOT. sdjf%ln_clim ) THEN   
+         WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
+         IF( sdjf%cltype /= 'yearly'        )   & 
+            &     WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth   ! add month
+         IF( sdjf%cltype == 'daily'  .OR. sdjf%cltype(1:4) == 'week' ) &
+            &     WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday     ! add day
+      ELSE
+         ! build the new filename if climatological data
+         IF( sdjf%cltype == 'monthly' )   WRITE(sdjf%clname, '(a,"_m" ,i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month
       ELSE
          ! build the new filename if climatological data
@@ -610,4 +735,5 @@
                &                          ' pairing    : '    , TRIM( sdf(jf)%vcomp      ),   &
                &                          ' data type: '      ,       sdf(jf)%cltype
+            call flush(numout)
          END DO
       ENDIF
@@ -707,4 +833,5 @@
       INTEGER                                 ::   inum          ! temporary logical unit
       INTEGER                                 ::   id            ! temporary variable id
+      INTEGER                                 ::   ipk           ! temporary vertical dimension
       CHARACTER (len=5)                       ::   aname
       INTEGER , DIMENSION(3)                  ::   ddims
@@ -869,6 +996,7 @@
          ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration. 
          ! a more robust solution will be given in next release
-         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) )
-         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) )
+         ipk =  SIZE(sd%fnow,3)
+         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) )
+         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) )
 
          nxt_wgt = nxt_wgt + 1
@@ -880,5 +1008,5 @@
    END SUBROUTINE fld_weight
 
-   SUBROUTINE fld_interp(num, clvar, kw, dta, nrec)
+   SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec)
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_interp  ***
@@ -892,8 +1020,9 @@
       CHARACTER(LEN=*), INTENT(in)                        ::   clvar               ! variable name
       INTEGER,          INTENT(in)                        ::   kw                  ! weights number
-      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj) ::   dta                 ! output field on model grid
+      INTEGER,          INTENT(in)                        ::   kk                  ! vertical dimension of kk
+      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj,kk) ::   dta              ! output field on model grid
       INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice)
       !! 
-      INTEGER, DIMENSION(2)                               ::   rec1,recn           ! temporary arrays for start and length
+      INTEGER, DIMENSION(3)                               ::   rec1,recn           ! temporary arrays for start and length
       INTEGER                                             ::  jk, jn, jm           ! loop counters
       INTEGER                                             ::  ni, nj               ! lengths
@@ -918,6 +1047,8 @@
       rec1(1) = MAX( jpimin-1, 1 )
       rec1(2) = MAX( jpjmin-1, 1 )
+      rec1(3) = 1
       recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 )
       recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 )
+      recn(3) = kk
 
       !! where we need to read it to
@@ -927,16 +1058,21 @@
       jpj2 = jpj1 + recn(2) - 1
 
-      ref_wgts(kw)%fly_dta(:,:) = 0.0
-      CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn)
+      ref_wgts(kw)%fly_dta(:,:,:) = 0.0
+      SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) )
+      CASE(1)
+           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn)
+      CASE(jpk)  
+           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
+      END SELECT 
 
       !! first four weights common to both bilinear and bicubic
       !! note that we have to offset by 1 into fly_dta array because of halo
-      dta(:,:) = 0.0
+      dta(:,:,:) = 0.0
       DO jk = 1,4
-        DO jn = 1, jpj
-          DO jm = 1,jpi
+        DO jn = 1, nlcj
+          DO jm = 1,nlci
             ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
             nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-            dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1)
+            dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,jk)
           END DO
         END DO
@@ -947,14 +1083,14 @@
         !! fix up halo points that we couldnt read from file
         IF( jpi1 == 2 ) THEN
-           ref_wgts(kw)%fly_dta(jpi1-1,:) = ref_wgts(kw)%fly_dta(jpi1,:)
+           ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:)
         ENDIF
         IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
-           ref_wgts(kw)%fly_dta(jpi2+1,:) = ref_wgts(kw)%fly_dta(jpi2,:)
+           ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:)
         ENDIF
         IF( jpj1 == 2 ) THEN
-           ref_wgts(kw)%fly_dta(:,jpj1-1) = ref_wgts(kw)%fly_dta(:,jpj1)
+           ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:)
         ENDIF
         IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN
-           ref_wgts(kw)%fly_dta(:,jpj2+1) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1)
+           ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:)
         ENDIF
 
@@ -969,11 +1105,21 @@
            IF( jpi1 == 2 ) THEN
               rec1(1) = ref_wgts(kw)%ddims(1) - 1
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn)
-              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2)
+              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) )
+              CASE(1)
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn)
+              CASE(jpk)         
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn)
+              END SELECT      
+              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2,:)
            ENDIF
            IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
               rec1(1) = 1
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn)
-              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2)
+              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) )
+              CASE(1)
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn)
+              CASE(jpk)
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn)
+              END SELECT
+              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2,:)
            ENDIF
         ENDIF
@@ -981,10 +1127,10 @@
         ! gradient in the i direction
         DO jk = 1,4
-          DO jn = 1, jpj
-            DO jm = 1,jpi
+          DO jn = 1, nlcj
+            DO jm = 1,nlci
               ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
               nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         &
-                               (ref_wgts(kw)%fly_dta(ni+2,nj+1) - ref_wgts(kw)%fly_dta(ni,nj+1))
+              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         &
+                               (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:))
             END DO
           END DO
@@ -993,10 +1139,10 @@
         ! gradient in the j direction
         DO jk = 1,4
-          DO jn = 1, jpj
-            DO jm = 1,jpi
+          DO jn = 1, nlcj
+            DO jm = 1,nlci
               ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
               nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         &
-                               (ref_wgts(kw)%fly_dta(ni+1,nj+2) - ref_wgts(kw)%fly_dta(ni+1,nj))
+              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         &
+                               (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:))
             END DO
           END DO
@@ -1009,7 +1155,7 @@
               ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
               nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( &
-                               (ref_wgts(kw)%fly_dta(ni+2,nj+2) - ref_wgts(kw)%fly_dta(ni  ,nj+2)) -   &
-                               (ref_wgts(kw)%fly_dta(ni+2,nj  ) - ref_wgts(kw)%fly_dta(ni  ,nj  )))
+              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( &
+                               (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni  ,nj+2,:)) -   &
+                               (ref_wgts(kw)%fly_dta(ni+2,nj  ,:) - ref_wgts(kw)%fly_dta(ni  ,nj  ,:)))
             END DO
           END DO
@@ -1019,4 +1165,33 @@
 
    END SUBROUTINE fld_interp
-  
+
+   FUNCTION ksec_week( cdday )
+      !!---------------------------------------------------------------------
+      !!                    ***  FUNCTION kshift_week *** 
+      !!
+      !! ** Purpose :  
+      !!
+      !! ** Method  :
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)   ::   cdday   !3 first letters of the first day of the weekly file
+      !!
+      INTEGER                        ::   ksec_week  ! output variable
+      INTEGER                        ::   ijul       !temp variable
+      INTEGER                        ::   ishift     !temp variable
+      CHARACTER(len=3),DIMENSION(7)  ::   cl_week 
+      !!----------------------------------------------------------------------
+      cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/)
+      DO ijul=1,7
+         IF(  cl_week(ijul)==TRIM(cdday) ) EXIT
+      ENDDO
+      IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): ',TRIM(cdday) )
+      !
+      ishift = ( ijul  ) * 86400
+      ! 
+      ksec_week = nsec_week + ishift
+      ksec_week = MOD( ksec_week , 86400*7 )
+      if(lwp)write(numout,*)'cbr ijul ksec_week ',ijul,ksec_week
+      ! 
+   END FUNCTION ksec_week
+
 END MODULE fldread
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/geo2ocean.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 2236)
@@ -27,4 +27,6 @@
                                              ! they are only a useless overlay of rot_rep
 
+   PUBLIC   obs_rot
+
    REAL(wp), DIMENSION(jpi,jpj) ::   &
       gsint, gcost,   &  ! cos/sin between model grid lines and NP direction at T point
@@ -40,5 +42,5 @@
    !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -522,4 +524,42 @@
    END SUBROUTINE repere
 
+
+   SUBROUTINE obs_rot ( psinu, pcosu, psinv, pcosv )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE obs_rot  ***
+      !!
+      !! ** Purpose :   Copy gsinu, gcosu, gsinv and gsinv
+      !!                to input data for rotations of
+      !!                current at observation points
+      !!
+      !! History :
+      !!   9.2  !  09-02  (K. Mogensen)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   &
+         & psinu, pcosu, psinv, pcosv! copy of data
+
+      !!----------------------------------------------------------------------
+
+      ! Initialization of gsin* and gcos* at first call
+      ! -----------------------------------------------
+
+      IF( lmust_init ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~   coordinate transformation'
+
+         CALL angle       ! initialization of the transformation
+         lmust_init = .FALSE.
+
+      ENDIF
+
+      psinu(:,:) = gsinu(:,:)
+      pcosu(:,:) = gcosu(:,:)
+      psinv(:,:) = gsinv(:,:)
+      pcosv(:,:) = gcosv(:,:)
+
+   END SUBROUTINE obs_rot
+
+
   !!======================================================================
 END MODULE geo2ocean
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/oasis4_date.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/oasis4_date.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/oasis4_date.F90	(revision 2236)
@@ -12,5 +12,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 !##################### WARNING coupled mode ###############################
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbc_ice.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 2236)
@@ -63,5 +63,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 2236)
@@ -83,5 +83,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE sbc_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcana.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 2236)
@@ -41,5 +41,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 2236)
@@ -83,5 +83,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -160,11 +160,8 @@
             CALL ctl_stop( 'sbc_blk_clio: unable to allocate sf structure' )   ;   RETURN
          ENDIF
-
          DO ifpr= 1, jpfld
-            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1  ) )
-            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
-         END DO
-
-
+            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
+            IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
+         END DO
          ! fill sf with slf_i and control print
          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_clio', 'flux formulation for ocean surface boundary condition', 'namsbc_clio' )
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 2236)
@@ -74,5 +74,5 @@
    !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -169,6 +169,6 @@
          ENDIF
          DO ifpr= 1, jfld
-            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1  ) )
-            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
+            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
+            IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
          END DO
          !                                         ! fill sf with slf_i and control print
@@ -269,5 +269,4 @@
 !CDIR COLLAPSE
       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
-                      
       ! ----------------------------------------------------------------------------- !
       !     II    Turbulent FLUXES                                                    !
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 2236)
@@ -166,5 +166,5 @@
    !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 2236)
@@ -42,5 +42,5 @@
    !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -115,6 +115,6 @@
          ENDIF
          DO ji= 1, jpfld
-            ALLOCATE( sf(ji)%fnow(jpi,jpj,1  ) )
-            ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
+            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
+            IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
          END DO
          !                                         ! fill sf with slf_i and control print
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 2236)
@@ -43,5 +43,5 @@
    !!  OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -66,5 +66,5 @@
       INTEGER  ::   inum                  ! temporary logical unit
       INTEGER  ::   ikty, iyear           ! 
-      REAL(wp) ::   z_fwf, z_fwf_nsrf       ! temporary scalars
+      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp       ! temporary scalars
       REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread
       REAL(wp), DIMENSION(jpi,jpj) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread
@@ -161,5 +161,7 @@
             ! fwf global mean 
             z_fwf = glob_sum( e1e2_i(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area
-            !
+            IF( lk_mpp )   CALL  mpp_sum( z_fwf )
+            IF( lk_mpp )   CALL  mpp_sum( zsurf_neg )
+            IF( lk_mpp )   CALL  mpp_sum( zsurf_pos )
             
             IF( z_fwf < 0.e0 ) THEN
@@ -174,6 +176,9 @@
 
             ! fwf global mean over <0 or >0 erp area
-            z_fwf_nsrf = SUM( e1e2_i(:,:) * z_fwf ) / ( zsurf_tospread + rsmall )
+            zsum_fwf = SUM( e1e2_i(:,:) * z_fwf )
+            IF( lk_mpp )   CALL  mpp_sum( zsum_fwf )
+            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )
             ! weight to respect erp field 2D structure 
+!!gm  Strange          
             z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) + rsmall )
             ! final correction term to apply
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 2236)
@@ -32,5 +32,5 @@
    !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -81,6 +81,6 @@
             CALL ctl_stop( 'sbc_ice_if: unable to allocate sf_ice structure' )   ;   RETURN
          ENDIF
-         ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1  ) )
-         ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )
+         ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) )
+         IF( sn_ice%ln_tint ) ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )
 
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 2236)
@@ -19,5 +19,4 @@
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
-   USE c1d             ! 1d configuration
    USE dom_oce         ! ocean space and time domain
    USE lib_mpp
@@ -65,5 +64,5 @@
    !! NEMO/LIM 3.0 , UCL-LOCEAN-IPSL  (2008)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -196,5 +195,6 @@
          IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print
          !
-         IF( .NOT. lk_c1d ) THEN                     ! Ice dynamics & transport (not in 1D case)
+#if ! defined key_c1d
+         ! Ice dynamics & transport (not in 1D case)
                           CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics )
                           CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion )
@@ -203,5 +203,5 @@
          IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx,-1, ' - ice dyn & trp - ' )   ! control print
                           CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting)
-         ENDIF
+#endif
          !
          !                                           ! Ice thermodynamics 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 2236)
@@ -8,4 +8,5 @@
    !! History :  1.0   !  06-2006  (G. Madec)  from icestp_2.F90
    !!            3.0   !  08-2008  (S. Masson, E. .... ) coupled interface
+   !!            3.3   !  05-2009  (G.Garric) addition of the lim2_evp case
    !!----------------------------------------------------------------------
 #if defined key_lim2
@@ -17,5 +18,4 @@
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
-   USE c1d             ! 1d configuration
    USE dom_oce         ! ocean space and time domain
    USE lib_mpp
@@ -53,6 +53,4 @@
    PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
    
-   CHARACTER(len=1) ::   cl_grid = 'B'     ! type of grid used in ice dynamics
-
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -61,5 +59,5 @@
    !! NEMO/SBC  3.0 , LOCEAN-IPSL (2008) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -172,11 +170,13 @@
          !  Ice model step  !
          ! ---------------- !
+         numit = numit + nn_fsbc                                             ! Ice model time step
 
                                         CALL lim_rst_opn_2  ( kt )      ! Open Ice restart file
-         IF( .NOT. lk_c1d ) THEN                                        ! Ice dynamics & transport (not in 1D case)
+#if ! defined key_c1d
+            ! Ice dynamics & transport (not in 1D case)
                                         CALL lim_dyn_2      ( kt )           ! Ice dynamics    ( rheology/dynamics )
                                         CALL lim_trp_2      ( kt )           ! Ice transport   ( Advection/diffusion )
             IF( ln_limdmp )             CALL lim_dmp_2      ( kt )           ! Ice damping 
-         ENDIF
+#endif
 #if defined key_coupled
          IF( ksbc == 5    )             CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ),        &
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 2236)
@@ -8,4 +8,5 @@
    !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
    !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
+   !!            3.3   !  09-2010  (D. Storkey) add ice boundary conditions (BDY)
    !!----------------------------------------------------------------------
 
@@ -34,4 +35,6 @@
    USE sbcfwb           ! surface boundary condition: freshwater budget
    USE closea           ! closed sea
+   USE bdy_par         ! unstructured open boundary data variables
+   USE bdyice          ! unstructured open boundary data  (bdy_ice routine)
 
    USE prtctl           ! Print control                    (prt_ctl routine)
@@ -53,5 +56,5 @@
    !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -238,4 +241,5 @@
          !                                                      
       CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )             ! LIM 2.0 ice model
+                           IF( lk_bdy ) CALL bdy_ice( kt )
          !                                                     
       CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc, nn_ico_cpl)  ! LIM 3.0 ice model
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 2236)
@@ -25,44 +25,43 @@
    PRIVATE
 
-   PUBLIC sbc_rnf          ! routine call in step module
-
-   !                                                     !!* namsbc_rnf namelist *
+   PUBLIC sbc_rnf          ! routine call in sbcmod module
+   PUBLIC sbc_rnf_div      ! routine called in sshwzv module
+
+   !                                                      !!* namsbc_rnf namelist *
    CHARACTER(len=100), PUBLIC ::   cn_dir       = './'    !: Root directory for location of ssr files
+   LOGICAL           , PUBLIC ::   ln_rnf_depth = .false. !: depth       river runoffs attribute specified in a file
+   LOGICAL           , PUBLIC ::   ln_rnf_temp  = .false. !: temperature river runoffs attribute specified in a file 
+   LOGICAL           , PUBLIC ::   ln_rnf_sal   = .false. !: salinity    river runoffs attribute specified in a file 
    LOGICAL           , PUBLIC ::   ln_rnf_emp   = .false. !: runoffs into a file to be read or already into precipitation
    TYPE(FLD_N)       , PUBLIC ::   sn_rnf                 !: information about the runoff file to be read
    TYPE(FLD_N)       , PUBLIC ::   sn_cnf                 !: information about the runoff mouth file to be read
-   TYPE(FLD_N)                ::   sn_sal_rnf             !: information about the salinities of runoff file to be read  
-   TYPE(FLD_N)                ::   sn_tmp_rnf             !: information about the temperatures of runoff file to be read  
+   TYPE(FLD_N)                ::   sn_s_rnf               !: information about the salinities of runoff file to be read  
+   TYPE(FLD_N)                ::   sn_t_rnf               !: information about the temperatures of runoff file to be read  
    TYPE(FLD_N)                ::   sn_dep_rnf             !: information about the depth which river inflow affects
    LOGICAL           , PUBLIC ::   ln_rnf_mouth = .false. !: specific treatment in mouths vicinity
    REAL(wp)          , PUBLIC ::   rn_hrnf      = 0.e0    !: runoffs, depth over which enhanced vertical mixing is used
    REAL(wp)          , PUBLIC ::   rn_avt_rnf   = 0.e0    !: runoffs, value of the additional vertical mixing coef. [m2/s]
-   LOGICAL           , PUBLIC ::   ln_rnf_att   = .false. !: river runoffs attributes (temp, sal & depth) are specified in a file 
    REAL(wp)          , PUBLIC ::   rn_rfact     = 1.e0    !: multiplicative factor for runoff
 
-   INTEGER , PUBLIC                     ::   nkrnf = 0   !: number of levels over which Kz is increased at river mouths
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rnfmsk      !: river mouth mask (hori.)
-   REAL(wp), PUBLIC, DIMENSION(jpk)     ::   rnfmsk_z    !: river mouth mask (vert.)
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf        !: structure of input river runoff (file information, fields read)
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal_rnf    !: structure of input river runoff salinity (file information, fields read)  
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem_rnf    !: structure of input river runoff temperature (file information, fields read)  
+   INTEGER , PUBLIC                     ::   nkrnf = 0    !: number of levels over which Kz is increased at river mouths
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rnfmsk       !: river mouth mask (hori.)
+   REAL(wp), PUBLIC, DIMENSION(jpk)     ::   rnfmsk_z     !: river mouth mask (vert.)
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf       !: structure of input river runoff (file information, fields read)
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     !: structure of input river runoff salinity (file information, fields read)  
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     !: structure of input river runoff temperature (file information, fields read)  
  
-   REAL,    PUBLIC, DIMENSION(jpi,jpj) ::  rnf_dep         !: depth of runoff in m  
-   INTEGER, PUBLIC, DIMENSION(jpi,jpj) ::  rnf_mod_dep     !: depth of runoff in model levels  
-   REAL,    PUBLIC, DIMENSION(jpi,jpj) ::  rnf_sal         !: salinity of river runoff  
-   REAL,    PUBLIC, DIMENSION(jpi,jpj) ::  rnf_tmp         !: temperature of river runoff  
-  
-   INTEGER  ::  ji, jj ,jk    ! dummy loop indices  
-   INTEGER  ::  inum          ! temporary logical unit  
-  
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   h_rnf        !: depth of runoff in m
+   INTEGER,  PUBLIC, DIMENSION(jpi,jpj) ::   nk_rnf       !: depth of runoff in model levels
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) ::  tsc_rnf  !: temperature & salinity content of river runoffs   [K.m/s & PSU.m/s]
+
    !! * Substitutions  
 #  include "domzgr_substitute.h90"  
-
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -84,7 +83,8 @@
       !!
       INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   z1_rau0  ! local scalar
       !!----------------------------------------------------------------------
       !                                   
-      IF( kt == nit000 )  CALL sbc_rnf_init     ! Read namelist and allocate structures 
+      IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures
 
       !                                                   !-------------------!
@@ -92,10 +92,7 @@
          !                                                !-------------------!
          !
-         CALL fld_read( kt, nn_fsbc, sf_rnf )   ! Read Runoffs data and provides it
-         !                                      ! at the current time-step
-         IF ( ln_rnf_att ) THEN  
-            CALL fld_read ( kt, nn_fsbc, sf_sal_rnf )  
-            CALL fld_read ( kt, nn_fsbc, sf_tem_rnf )  
-         ENDIF  
+                             CALL fld_read ( kt, nn_fsbc, sf_rnf )      ! Read Runoffs data and provide it at kt 
+         IF( ln_rnf_temp )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
+         IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
 
          ! Runoff reduction only associated to the ORCA2_LIM configuration
@@ -113,12 +110,27 @@
          IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
             rnf(:,:)  = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )  
-            IF ( ln_rnf_att ) THEN  
-               rnf_sal(:,:) = ( sf_sal_rnf(1)%fnow(:,:,1) )  
-               rnf_tmp(:,:) = ( sf_tem_rnf(1)%fnow(:,:,1) )  
-            ELSE  
-               rnf_sal(:,:) = 0  
-               rnf_tmp(:,:) = -999  
+            !
+            z1_rau0 = 1.e0 / rau0
+            !                                                              ! set temperature & salinity content of runoffs
+            IF( ln_rnf_temp )   THEN                                       ! use runoffs temperature data
+               tsc_rnf(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * z1_rau0
+               WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999 )                      ! if missing data value use SST as runoffs temperature  
+                   tsc_rnf(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * z1_rau0
+               ENDWHERE
+            ELSE                                                           ! use SST as runoffs temperature
+               tsc_rnf(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * z1_rau0
             ENDIF  
-            CALL iom_put( "runoffs", rnf )         ! runoffs
+            !                                                              ! use runoffs salinity data 
+            IF( ln_rnf_sal ) tsc_rnf(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * z1_rau0
+            !                                                              ! else use S=0 for runoffs (done one for all in the init)
+            !
+            IF( ln_rnf_temp .OR. ln_rnf_sal ) THEN                         ! runoffs as outflow: use ocean SST and SSS
+               WHERE( rnf(:,:) < 0.e0 )                                    ! example baltic model when flow is out of domain 
+                  tsc_rnf(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * z1_rau0
+                  tsc_rnf(:,:,jp_sal) = sss_m(:,:) * rnf(:,:) * z1_rau0
+               ENDWHERE
+            ENDIF
+
+            CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
          ENDIF
          !
@@ -127,4 +139,52 @@
    END SUBROUTINE sbc_rnf
 
+   SUBROUTINE sbc_rnf_div( phdivn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_rnf  ***
+      !!       
+      !! ** Purpose :   update the horizontal divergence with the runoff inflow
+      !!
+      !! ** Method  :   
+      !!                CAUTION : rnf is positive (inflow) decreasing the 
+      !!                          divergence and expressed in m/s
+      !!
+      !! ** Action  :   phdivn   decreased by the runoff inflow
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phdivn   ! horizontal divergence
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   z1_rau0   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      z1_rau0 = 1.e0 / rau0
+      IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==!
+         IF( lk_vvl ) THEN             ! variable volume case 
+            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
+               DO ji = 1, jpi
+                  h_rnf(ji,jj) = 0.e0 
+                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
+                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box 
+                  END DO 
+                  !                          ! apply the runoff input flow
+                  DO jk = 1, nk_rnf(ji,jj)
+                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - rnf(ji,jj) * z1_rau0 / h_rnf(ji,jj)
+                  END DO
+               END DO
+            END DO
+         ELSE                          ! constant volume case : just apply the runoff input flow
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  DO jk = 1, nk_rnf(ji,jj)
+                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - rnf(ji,jj) * z1_rau0 / h_rnf(ji,jj)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+      ELSE                       !==   runoff put only at the surface   ==!
+         phdivn(:,:,1) = phdivn(:,:,1) - rnf(:,:) * z1_rau0 / fse3t(:,:,1)
+      ENDIF
+      !
+   END SUBROUTINE sbc_rnf_div
+
 
    SUBROUTINE sbc_rnf_init
@@ -138,9 +198,11 @@
       !! ** Action  : - read parameters
       !!----------------------------------------------------------------------
-      INTEGER  ::   ierror   ! temporary integer
       CHARACTER(len=32) ::   rn_dep_file   ! runoff file name  
+      INTEGER           ::   inum        ! temporary integers
+      INTEGER           ::   ierror   ! temporary integer
       !! 
-      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, sn_rnf, sn_cnf, sn_sal_rnf, sn_tmp_rnf, sn_dep_rnf,   &  
-         &                 ln_rnf_mouth, ln_rnf_att, rn_hrnf, rn_avt_rnf, rn_rfact  
+      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_temp, ln_rnf_sal,   &
+         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf   , sn_dep_rnf,   &  
+         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf , rn_rfact  
       !!----------------------------------------------------------------------
 
@@ -154,6 +216,6 @@
       sn_cnf = FLD_N( 'runoffs',     0     , 'sorunoff' ,  .FALSE.   , .true. ,   'yearly'  , ''       , ''         )
 
-      sn_sal_rnf = FLD_N( 'runoffs',  24.  , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
-      sn_tmp_rnf = FLD_N( 'runoffs',  24.  , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
+      sn_s_rnf = FLD_N( 'runoffs',  24.  , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
+      sn_t_rnf = FLD_N( 'runoffs',  24.  , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
       sn_dep_rnf = FLD_N( 'runoffs',   0.  , 'rodepth'  ,  .FALSE.   , .true. ,   'yearly'  , ''    , ''  )  
       !
@@ -178,61 +240,68 @@
       !                                   ! ==================
       !
-      IF( ln_rnf_emp ) THEN                     ! runoffs directly provided in the precipitations
+      IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==!
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations'
-         IF ( ln_rnf_att ) THEN
-           CALL ctl_warn( 'runoffs already included in precipitations & so runoff attributes will not be used' ) 
-           ln_rnf_att = .FALSE.
-         ENDIF
-         !
-      ELSE                                      ! runoffs read in a file : set sf_rnf structure 
-         !
-         ! Allocate sf_rnf structure and (if required) sf_sal_rnf and sf_tem_rnf structures
-         ALLOCATE( sf_rnf(1), STAT=ierror )
+         IF( ln_rnf_depth .OR. ln_rnf_temp .OR. ln_rnf_sal ) THEN
+           CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 
+           ln_rnf_depth = .FALSE.   ;   ln_rnf_temp = .FALSE.   ;   ln_rnf_sal = .FALSE.
+         ENDIF
+         !
+      ELSE                                      !==  runoffs read in a file : set sf_rnf structure  ==!
+         !
+         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow)
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs inflow read in a file'
          IF( ierror > 0 ) THEN
             CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN
          ENDIF
-         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) )
-         ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
-
-         IF( ln_rnf_att ) THEN
-            ALLOCATE( sf_sal_rnf(1), STAT=ierror )
+         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   )
+         IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
+         !                                          ! fill sf_rnf with the namelist (sn_rnf) and control print
+         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
+         !
+         IF( ln_rnf_temp ) THEN                     ! Create (if required) sf_t_rnf structure
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file'
+            ALLOCATE( sf_t_rnf(1), STAT=ierror  )
             IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'sbc_sal_rnf: unable to allocate sf_sal_rnf structure' )   ;   RETURN
+               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN
             ENDIF
-            ALLOCATE( sf_sal_rnf(1)%fnow(jpi,jpj,1) )
-            ALLOCATE( sf_sal_rnf(1)%fdta(jpi,jpj,1,2) )
-
-            ALLOCATE( sf_tem_rnf(1), STAT=ierror )
+            ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   )
+            IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )  
+         ENDIF
+         !
+         IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file'
+            ALLOCATE( sf_s_rnf(1), STAT=ierror  )
             IF( ierror > 0 ) THEN
-                CALL ctl_stop( 'sbc_tmp_rnf: unable to allocate sf_tem_rnf structure' )   ;   RETURN
+               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN
             ENDIF
-            ALLOCATE( sf_tem_rnf(1)%fnow(jpi,jpj,1) )
-            ALLOCATE( sf_tem_rnf(1)%fdta(jpi,jpj,1,2) )
-         ENDIF
-         ! fill sf_rnf with sn_rnf and control print
-         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
+            ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   )
+            IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )  
+         ENDIF
+
  
-         IF ( ln_rnf_att ) THEN  
-            CALL fld_fill (sf_sal_rnf, (/ sn_sal_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )  
-            CALL fld_fill (sf_tem_rnf, (/ sn_tmp_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )  
-  
+         IF ( ln_rnf_depth ) THEN                     ! depth of runoffs set from a file 
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
             rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )  
             CALL iom_open ( rn_dep_file, inum )                           ! open file  
-            CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, rnf_dep )    ! read the river mouth array  
+            CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )    ! read the river mouth array  
             CALL iom_close( inum )                                      ! close file  
   
-            rnf_mod_dep(:,:) = 0.  
-            DO jj = 1, jpj  
-              DO ji = 1, jpi  
-                IF ( rnf_dep(ji,jj) > 0.e0 ) THEN  
-                  jk = 2  
-                  DO WHILE ( jk /= jpkm1 .AND. fsdept(ji,jj,jk) < rnf_dep(ji,jj) ) ;  jk = jk + 1 ;   ENDDO  
-                  rnf_mod_dep(ji,jj) = jk  
-                ELSE IF ( rnf_dep(ji,jj) == -1. ) THEN  
-                  rnf_mod_dep(ji,jj) = 1.  
-                ELSE IF ( rnf_dep(ji,jj) == -999 ) THEN  
-                  rnf_mod_dep(ji,jj) = jpkm1  
-                ELSE IF ( rnf_dep(ji,jj) /= 0. ) THEN  
+            nk_rnf(:,:)=0                              ! set the number of level over which river runoffs are applied
+            DO jj=1,jpj  
+              DO ji=1,jpi  
+                IF ( h_rnf(ji,jj) > 0.e0 ) THEN  
+                  jk=2  
+                  DO WHILE ( jk/=(mbathy(ji,jj)-1) .AND. fsdept(ji,jj,jk) < h_rnf(ji,jj) );  jk=jk+1;   ENDDO  
+                  nk_rnf(ji,jj)=jk  
+                ELSE IF ( h_rnf(ji,jj) == -1   ) THEN   ;  nk_rnf(ji,jj)=1  
+                ELSE IF ( h_rnf(ji,jj) == -999 ) THEN   ;  nk_rnf(ji,jj)=mbathy(ji,jj)-1
+                ELSE IF ( h_rnf(ji,jj) /= 0 ) THEN  
                   CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )  
                   WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj)  
@@ -240,11 +309,20 @@
               ENDDO  
             ENDDO  
-         ELSE  
-            rnf_mod_dep(:,:) = 1.  
+            DO jj=1,jpj                               ! set the associated depth 
+              DO ji=1,jpi 
+                h_rnf(ji,jj)=0.e0
+                DO jk=1,nk_rnf(ji,jj)                        
+                   h_rnf(ji,jj)=h_rnf(ji,jj)+fse3t(ji,jj,jk)  
+                ENDDO
+              ENDDO
+            ENDDO
+         ELSE                                       ! runoffs applied at the surface 
+            nk_rnf(:,:)=1  
+            h_rnf(:,:)=fse3t(:,:,1)
          ENDIF  
       ! 
       ENDIF
-      !
-
+
+      tsc_rnf(:,:,:) = 0.e0                 ! runoffs temperature & salinty contents initilisation
       !                                   ! ========================
       !                                   !   River mouth vicinity
@@ -256,8 +334,8 @@
          !                                      !    - mixed upstream-centered (ln_traadv_cen2=T)
          !
-         !                                          ! Number of level over which Kz increase
-         IF ( ln_rnf_att )  &  
-              &  CALL ctl_warn( 'increased mixing turned on but effects may already be spread through depth by ln_rnf_att' ) 
-         nkrnf = 0
+         IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
+            &                                              'be spread through depth by ln_rnf_depth'               ) 
+         !
+         nkrnf = 0                                  ! Number of level over which Kz increase
          IF( rn_hrnf > 0.e0 ) THEN
             nkrnf = 2
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 2236)
@@ -29,5 +29,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 2236)
@@ -48,5 +48,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -115,9 +115,9 @@
                CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN
             ENDIF
-            ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1  ) )
-            ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) )
+            ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) )
             !
             ! fill sf_sst with sn_sst and control print
             CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )
+            IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) )
          ENDIF
          !
@@ -128,9 +128,9 @@
                CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' )   ;   RETURN
             ENDIF
-            ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1  ) )
-            ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) )
+            ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1) )
             !
             ! fill sf_sss with sn_sss and control print
             CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' )
+            IF( sf_sss(1)%ln_tint )ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) )
          ENDIF
          !
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/sol_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/sol_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/sol_oce.F90	(revision 2236)
@@ -52,5 +52,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 END MODULE sol_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solmat.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solmat.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solmat.F90	(revision 2236)
@@ -15,4 +15,5 @@
    !!             3.2  ! 2009-06  (S. Masson)  distributed restart using iom
    !!              -   ! 2009-07  (R. Benshila)  suppression of rigid-lid option
+   !!             3.3  ! 2010-09  (D. Storkey) update for BDY module.
    !!----------------------------------------------------------------------
 
@@ -26,4 +27,5 @@
    USE phycst          ! physical constants
    USE obc_oce         ! ocean open boundary conditions
+   USE bdy_oce         ! unstructured open boundary conditions
    USE lbclnk          ! lateral boudary conditions
    USE lib_mpp         ! distributed memory computing
@@ -38,5 +40,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
@@ -80,5 +82,5 @@
       ENDIF
 
-#if defined key_dynspg_flt 
+#if defined key_dynspg_flt && ! defined key_bdy
 #   if ! defined key_obc
 
@@ -158,4 +160,38 @@
     ENDIF
 #   endif
+
+#  elif defined key_dynspg_flt && defined key_bdy 
+
+      !   defined gcdmat in the case of unstructured open boundaries
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            zcoef = z2dt * z2dt * grav * bmask(ji,jj)
+
+            !  south coefficient
+            zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)
+            zcoefs = zcoefs * bdyvmask(ji,jj-1)
+            gcp(ji,jj,1) = zcoefs
+
+            !  west coefficient
+            zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)
+            zcoefw = zcoefw * bdyumask(ji-1,jj)
+            gcp(ji,jj,2) = zcoefw
+
+            !  east coefficient
+            zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)
+            zcoefe = zcoefe * bdyumask(ji,jj)
+            gcp(ji,jj,3) = zcoefe
+
+            !  north coefficient
+            zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)
+            zcoefn = zcoefn * bdyvmask(ji,jj)
+            gcp(ji,jj,4) = zcoefn
+
+            ! diagonal coefficient
+            gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) &
+                            - zcoefs -zcoefw -zcoefe -zcoefn
+         END DO
+      END DO
+
 #endif
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solpcg.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 2236)
@@ -26,5 +26,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solsor.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solsor.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solsor.F90	(revision 2236)
@@ -32,5 +32,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solver.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solver.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SOL/solver.F90	(revision 2236)
@@ -33,5 +33,5 @@
    !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 2236)
@@ -64,5 +64,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv.F90	(revision 2236)
@@ -51,5 +51,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -83,10 +83,10 @@
       zwn(:,:,jpk) = 0.e0                                                     ! no transport trough the bottom
       !
-      IF( lk_traldf_eiv )   CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )      ! add the eiv transport (if necessary)
+      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &
+         &                  CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )      ! add the eiv transport (if necessary)
       !
       CALL iom_put( "uoce_eff", zun )                                         ! output effective transport      
       CALL iom_put( "voce_eff", zvn )
       CALL iom_put( "woce_eff", zwn )
-
 
       SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
@@ -97,4 +97,5 @@
       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS 
       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST 
+
       !
       CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 2236)
@@ -48,5 +48,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 2236)
@@ -41,5 +41,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 2236)
@@ -40,5 +40,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 2236)
@@ -38,5 +38,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 2236)
@@ -41,5 +41,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id:  $
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 2236)
@@ -47,5 +47,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 2236)
@@ -36,5 +36,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 2236)
@@ -44,5 +44,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 2236)
@@ -74,5 +74,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 2236)
@@ -51,4 +51,6 @@
    LOGICAL, PUBLIC            ::   lk_tradmp = .TRUE.     !: internal damping flag
 #endif
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   strdmp   !: damping salinity trend (psu/s)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ttrdmp   !: damping temperature trend (Centigrade/s)
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   resto    !: restoring coeff. on T and S (s-1)
    
@@ -67,5 +69,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -92,4 +94,5 @@
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !!
+      REAL(wp) ::   zta, zsa       ! temporary scalars
       INTEGER ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::  zta, zsa
@@ -112,4 +115,7 @@
                   tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
                   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  ! save the salinity trend (used in asmtrj)
+                  strdmp(ji,jj,jk) = zsa
+                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
@@ -123,7 +129,13 @@
                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )
-                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
-                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  ELSE
+                     zta = 0.e0
+                     zsa = 0.e0   
                   ENDIF
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  ! save the salinity trend (used in asmtrj)
+                  strdmp(ji,jj,jk) = zsa
+                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
@@ -137,7 +149,14 @@
                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )
-                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
-                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  ELSE
+                     zta = 0.e0
+                     zsa = 0.e0   
                   ENDIF
+                  ! add the trends to the general tracer trends
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  ! save the salinity trend (used in asmtrj)
+                  strdmp(ji,jj,jk) = zsa
+                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
@@ -208,4 +227,6 @@
          &   CALL ctl_stop( 'no temperature and/or salinity data define key_dtatem and key_dtasal' )
 
+      strdmp(:,:,:) = 0.e0       ! internal damping salinity trend (used in asmtrj)
+      ttrdmp(:,:,:) = 0.e0
       !                          ! Damping coefficients initialization
       IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto )
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf.F90	(revision 2236)
@@ -21,4 +21,5 @@
    USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine)
    USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
+   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
    USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
    USE trdmod_oce      ! ocean space and time domain
@@ -46,5 +47,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -70,5 +71,10 @@
       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
       CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian
-      CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )  ! rotated laplacian 
+      CASE ( 1 )    
+         IF ( ln_traldf_grif ) THEN
+            CALL tra_ldf_iso_grif    ( kt )           ! Griffies quarter-cell formulation
+         ELSE
+            CALL tra_ldf_iso   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )  ! rotated laplacian
+         ENDIF
       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian
       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRA',             tsb, tsa, jpts        )  ! s-coord. horizontal bilap.
@@ -78,5 +84,9 @@
          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_iso   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )  
+         IF ( ln_traldf_grif ) THEN
+            CALL tra_ldf_iso_grif    ( kt )
+         ELSE
+            CALL tra_ldf_iso   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )  
+         ENDIF
          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
@@ -144,4 +154,5 @@
          WRITE(numout,*) '      horizontal (geopotential)   ln_traldf_hor   = ', ln_traldf_hor
          WRITE(numout,*) '      iso-neutral                 ln_traldf_iso   = ', ln_traldf_iso
+         WRITE(numout,*) '      iso-neutral (Griffies)      ln_traldf_grif  = ', ln_traldf_grif
       ENDIF
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 2236)
@@ -45,5 +45,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 2236)
@@ -0,0 +1,202 @@
+MODULE traldf_iso_grif
+   !!==============================================================================
+   !!                   ***  MODULE  traldf_iso_grif  ***
+   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History :   9.0  !  06-10  (C. Harris)
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'               slope of the lateral diffusive direction
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso_grif  : update the tracer trend with the horizontal 
+   !!                       component of a iso-neutral laplacian operator
+   !!                       and with the vertical part of
+   !!                       the isopycnal or geopotential s-coord. operator 
+   !!                       vector optimization, use k-j-i loops.
+   !!----------------------------------------------------------------------
+
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE trdmod          ! ocean active tracers trends 
+   USE trdmod_oce      ! ocean variables trends
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE ldfslp          ! iso-neutral slopes
+   USE diaptr          ! poleward transport diagnostics
+   USE prtctl          ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC tra_ldf_iso_grif   ! routine called by traldf.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_ldf_iso_grif( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_iso_grif  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend for a laplacian tensor (except the dz[ dz[.] ] term) and 
+      !!      add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends 
+      !!      is provided by a 2nd order operator rotated along neutral or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time)
+      !!
+      !!      1st part :  masked horizontal derivative of T & S ( di[ t ] )
+      !!      ========    with partial cell update if ln_zps=T.
+      !!
+      !!      2nd part :  horizontal fluxes of the lateral mixing operator
+      !!      ========    
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !!      3rd part: vertical trends of the lateral mixing operator
+      !!      ========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !! ** Action :
+      !!         Update (ta,sa) arrays with the before rotated diffusion trend
+      !!            (except the dk[ dk[.] ] term)
+      !!
+      !!----------------------------------------------------------------------
+      USE oce           , zftv => ua   ! use ua as workspace
+      USE oce           , zfsv => va   ! use va as workspace
+      !!
+      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, ip, jp, kp    ! dummy loop indices
+      INTEGER  ::   iku, ikv                  ! temporary integer
+      REAL(wp) ::   zatempu, zdx, zta         ! temporary scalars
+      REAL(wp) ::   zatempv, zdy, zsa         !    "         "
+      REAL(wp) ::   zslopec, zdsloper, zepsln !    "         "
+      REAL(wp) ::   zsxe, za_sxe, zfact       !    "         "
+      REAL(wp) ::   zbtr                      !    "         "
+      REAL(wp), DIMENSION(2) ::   zdelta   ! 1D workspace
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zftu   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zfsu   !    "           "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, zdkt     ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdis, zdjs, zdks     !  "      "
+
+
+
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+      ENDIF
+
+      IF ( .NOT. lk_traldf_eiv ) THEN
+        fsaeiu(:,:,:)=0.0
+        fsaeiv(:,:,:)=0.0
+        fsaeiw(:,:,:)=0.0
+      ENDIF
+
+      DO jk=1,jpkm1
+      DO jj=1,jpjm1
+      DO ji=1,fs_jpim1
+               ftu(ji,jj,jk)=ftud(ji,jj,jk)+ftu(ji,jj,jk)*(fsahtu(ji,jj,jk)-fsaeiu(ji,jj,jk))
+               fsu(ji,jj,jk)=fsud(ji,jj,jk)+fsu(ji,jj,jk)*(fsahtu(ji,jj,jk)-fsaeiu(ji,jj,jk))
+               ftv(ji,jj,jk)=ftvd(ji,jj,jk)+ftv(ji,jj,jk)*(fsahtv(ji,jj,jk)-fsaeiv(ji,jj,jk))
+               fsv(ji,jj,jk)=fsvd(ji,jj,jk)+fsv(ji,jj,jk)*(fsahtv(ji,jj,jk)-fsaeiv(ji,jj,jk))
+      END DO
+      END DO
+      END DO
+
+      DO jk = 1, jpkm1
+
+         ! II.4 Second derivative (divergence) and add to the general trend
+         ! ----------------------------------------------------------------
+         DO jj = 2 , jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+               zta = zbtr * ( ftu(ji,jj,jk) - ftu(ji-1,jj,jk) + ftv(ji,jj,jk) - ftv(ji,jj-1,jk)  )
+               zsa = zbtr * ( fsu(ji,jj,jk) - fsu(ji-1,jj,jk) + fsv(ji,jj,jk) - fsv(ji,jj-1,jk)  )
+               ta (ji,jj,jk) = ta (ji,jj,jk) + zta
+               sa (ji,jj,jk) = sa (ji,jj,jk) + zsa
+            END DO
+         END DO
+         !                                          ! ===============
+      END DO                                        !   End of slab  
+      !                                             ! ===============
+
+      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   ! Poleward diffusive heat and salt transports
+         pht_ldf(:) = ptr_vj( zftv(:,:,:) )
+         pst_ldf(:) = ptr_vj( zfsv(:,:,:) )
+      ENDIF
+
+      !!----------------------------------------------------------------------
+      !!   III - vertical trend of T & S (extra diagonal terms only)
+      !!----------------------------------------------------------------------
+
+      ! I.5 Divergence of vertical fluxes added to the general tracer trend
+      ! -------------------------------------------------------------------
+
+      DO jk=1,jpk
+      DO jj=2,jpjm1
+      DO ji=fs_2,fs_jpim1
+               tfw(ji,jj,jk)=tfw(ji,jj,jk)*(fsahtw(ji,jj,jk)+fsaeiw(ji,jj,jk))
+               sfw(ji,jj,jk)=sfw(ji,jj,jk)*(fsahtw(ji,jj,jk)+fsaeiw(ji,jj,jk))
+      END DO
+      END DO
+      END DO
+
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+               zta  = (  tfw(ji,jj,jk) - tfw(ji,jj,jk+1)  ) * zbtr
+               zsa  = (  sfw(ji,jj,jk) - sfw(ji,jj,jk+1)  ) * zbtr
+               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+            END DO
+         END DO
+      END DO
+      !
+      DO jk=1,jpk
+      DO jj=2,jpjm1
+      DO ji=fs_2,fs_jpim1
+       psix_eiv(ji,jj,jk) = psix_eiv(ji,jj,jk)*fsaeiu(ji,jj,jk)
+       psiy_eiv(ji,jj,jk) = psiy_eiv(ji,jj,jk)*fsaeiv(ji,jj,jk)
+      END DO
+      END DO
+      END DO
+
+   END SUBROUTINE tra_ldf_iso_grif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO rotation of the diffusive tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_ldf_iso_grif( kt )               ! Empty routine
+      WRITE(*,*) 'tra_ldf_iso_grif: You should not have seen this print! error?', kt
+   END SUBROUTINE tra_ldf_iso_grif
+#endif
+
+   !!==============================================================================
+END MODULE traldf_iso_grif
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 2236)
@@ -33,5 +33,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 2236)
@@ -42,6 +42,9 @@
    USE traqsr          ! penetrative solar radiation (needed for nksr)
    USE traswp          ! swap array
+   USE obc_oce 
+#if defined key_agrif
    USE agrif_opa_update
    USE agrif_opa_interp
+#endif
 
    IMPLICIT NONE
@@ -60,5 +63,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 2236)
@@ -59,5 +59,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -380,5 +380,5 @@
                ENDIF
                ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
-               ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
+               IF( sn_chl%ln_tint )ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
                !                                        ! fill sf_chl with sn_chl and control print
                CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 2236)
@@ -27,4 +27,5 @@
    USE sbcmod          ! ln_rnf  
    USE iom
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
 
    IMPLICIT NONE
@@ -39,5 +40,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -107,7 +108,4 @@
       !!
       INTEGER  ::   ji, jj, jk           ! dummy loop indices  
-      REAL(wp) ::   zta, zsa, zrnf       ! local scalars, adjustment to temperature and salinity  
-      REAL(wp) ::   zsrau, zse3t, zdep   ! local scalars, 1/density, 1/height of box, 1/height of effected water column  
-      REAL(wp) ::   zdheat, zdsalt       ! total change of temperature and salinity  
       REAL(wp) ::   zfact, z1_e3t        ! 
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
@@ -179,27 +177,5 @@
          END DO
       ENDIF
-                                                   ! Concentration dilution effect on (t,s) due to  
-                                                   ! river runoff without T, S and depth attributes
-      IF( ln_rnf ) THEN 
-         !
-         IF( lk_vvl ) THEN                            ! Variable Volume case 
-            !                                         ! cooling/heating effect of runoff & No salinity concent./dilut. effect
-            DO jj = 2, jpj
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  sbc_hc_n(ji,jj) = sbc_hc_n(ji,jj) + zsrau * rnf(ji,jj) * tsn(ji,jj,1,jp_tem)
-               END DO
-            END DO
-         ELSE                                         ! Constant Volume case
-            !                                         ! concent./dilut. effect only
-            DO jj = 2, jpj 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  sbc_sc_n(ji,jj) = sbc_sc_n(ji,jj) - zsrau * rnf(ji,jj) * tsn(ji,jj,1,jp_sal)
-               END DO
-            END DO
-         ENDIF
-         !  
-      ENDIF
-      !                                          Add to the general trend
-      !                                          ************************
+      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff  
       DO jj = 2, jpj
          DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -219,62 +195,21 @@
          CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_sc_n )
       ENDIF
-
-      IF( ln_rnf .AND. ln_rnf_att ) THEN        ! Concentration / dilution effect on (t,s) due to river runoff  
-        !
-        DO jj = 1, jpj  
-           DO ji = 1, jpi  
-              zdep  = 1. / rnf_dep(ji,jj)  
-              zse3t = 1. / fse3t(ji,jj,1)  
-              rnf_dep(ji,jj) = 0.e0
-              DO jk = 1, rnf_mod_dep(ji,jj)                          ! recalculates rnf_dep to be the depth  
-                rnf_dep(ji,jj) = rnf_dep(ji,jj) + fse3t(ji,jj,jk)    ! in metres to the bottom of the relevant grid box  
-              END DO
-              IF( rnf_tmp(ji,jj) == -999 )   rnf_tmp(ji,jj) = tsn(ji,jj,1,jp_tem)   ! if not specified set runoff temp to be sst  
-  
-              IF( rnf(ji,jj) > 0.e0 ) THEN  
-                !
-                zrnf = rnf(ji,jj) * zsrau * zdep
-                IF( lk_vvl ) THEN  
-                  ! indirect flux, concentration or dilution effect : force a dilution effect in all levels 
-                  zdheat = 0.e0  
-                  zdsalt = 0.e0  
-                  DO jk = 1, rnf_mod_dep(ji,jj)  
-                    zta = -tsn(ji,jj,jk,jp_tem) * zrnf  
-                    zsa = -tsn(ji,jj,jk,jp_sal) * zrnf  
-                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta        ! add the trend to the general tracer trend
-                    tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
-                    zdheat = zdheat + zta * fse3t(ji,jj,jk)  
-                    zdsalt = zdsalt + zsa * fse3t(ji,jj,jk)  
-                  END DO  
-                  ! negate this total change in heat and salt content from top level    !!gm I don't understand this
-                  tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) - zdheat * zse3t
-                  tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) - zdsalt * zse3t
-    
-                  DO jk = 1, rnf_mod_dep(ji,jj)  
-                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + rnf_tmp(ji,jj) * zrnf
-                    tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + rnf_sal(ji,jj) * zrnf
-                  END DO  
-                ELSE  
-                  DO jk = 1, rnf_mod_dep(ji,jj)  
-                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( rnf_tmp(ji,jj) - tsn(ji,jj,jk,jp_tem) ) * zrnf
-                    tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + ( rnf_sal(ji,jj) - tsn(ji,jj,jk,jp_sal) ) * zrnf
-                  END DO  
-                ENDIF  
-  
-              ELSEIF( rnf(ji,jj) < 0.e0 ) THEN   ! for use in baltic when flow is out of domain, want no change in temp and sal  
-  
-                IF( lk_vvl ) THEN  
-                  ! calculate automatic adjustment to sal and temp due to dilution/concentraion effect   
-                  zrnf = rnf(ji,jj) * zsrau * zse3t
-                  tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + tsn(ji,jj,1,jp_tem) * zrnf 
-                  tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + tsn(ji,jj,1,jp_sal) * zrnf
-                ENDIF  
-  
-              ENDIF  
-  
-           END DO  
-        END DO  
-        !
+      !                             !==  Runoffs  ==!
+      ! Effect on (t,s) due to river runoff (dilution effect automatically applied via vertical tracer advection) 
+      IF( ln_rnf ) THEN  
+         DO jj = 2, jpj 
+            DO ji = fs_2, fs_jpim1
+               zdep = 1. / h_rnf(ji,jj)  
+               IF ( rnf(ji,jj) .ne. 0.0 ) THEN
+                  DO jk = 1, nk_rnf(ji,jj)
+                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + tsc_rnf(ji,jj,jp_tem) * zdep
+                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + tsc_rnf(ji,jj,jp_sal) * zdep
+                  ENDDO
+               ENDIF
+            ENDDO  
+         ENDDO  
       ENDIF  
+!!gm  It should be useless
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )    ;    CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
 
       IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 2236)
@@ -49,5 +49,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -121,4 +121,5 @@
       USE zdftke_old
       USE zdftke
+      USE zdfgls
       USE zdfkpp
       !!----------------------------------------------------------------------
@@ -130,7 +131,7 @@
 
       ! Force implicit schemes
-      IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfkpp )   nzdf = 1      ! TKE or KPP physics
-      IF( ln_traldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics
-      IF( ln_traldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+      IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1      ! TKE, GLS or KPP physics
+      IF( ln_traldf_iso                                              )   nzdf = 1      ! iso-neutral lateral physics
+      IF( ln_traldf_hor .AND. ln_sco                                 )   nzdf = 1      ! horizontal lateral physics in s-coordinate
       IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
             &                         ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 2236)
@@ -43,5 +43,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 2236)
@@ -46,5 +46,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -141,6 +141,15 @@
          IF( cdtype == 'TRA' .AND. jn == jp_tem )  THEN 
 #if defined key_ldfslp
+            IF( ln_traldf_grif ) THEN
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zavi = fsahtw(ji,jj,jk) * wslp2(ji,jj,jk)         ! vertical mixing coef. due to lateral mixing
+                        zwt(ji,jj,jk) = avt(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature)
+                     END DO
+                  END DO
+               END DO
             ! update and save of avt (and avs if double diffusive mixing)
-            IF( l_traldf_rot ) THEN
+            ELSE IF( l_traldf_rot ) THEN
                DO jk = 2, jpkm1
                   DO jj = 2, jpjm1
@@ -172,12 +181,4 @@
                END DO
             END DO
-            ! Surface boudary conditions
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                 ze3ta = ( 1. - znvvl ) +  znvvl * fse3t_a(ji,jj,1)    ! after scale factor at T-point
-                 zwi(ji,jj,1) = 0.e0
-                 zwd(ji,jj,1) = ze3ta - zws(ji,jj,1)
-               END DO
-            END DO
             ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
             DO jj = 2, jpjm1
@@ -196,6 +197,14 @@
          ELSE IF( ( cdtype == 'TRA' .AND. jn == jp_sal ) .OR. ( cdtype == 'TRC' .AND. jn == 1 ) ) THEN
 #if defined key_ldfslp
-            ! update and save of avt (and avs if double diffusive mixing)
-            IF( l_traldf_rot ) THEN
+            IF( ln_traldf_grif ) THEN
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zavi = fsahtw(ji,jj,jk) * wslp2(ji,jj,jk)         ! vertical mixing coef. due to lateral mixing
+                        zwt(ji,jj,jk) = fsavs(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature)
+                     END DO
+                  END DO
+               END DO
+            ELSE IF( l_traldf_rot ) THEN
                DO jk = 2, jpkm1
                   DO jj = 2, jpjm1
@@ -273,8 +282,6 @@
             END DO
          END DO
-         
-         ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
-         ! Save the masked temperature after in ta
-         ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done it will not be done in tranxt)
+
+         ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdicp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdicp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdicp.F90	(revision 2236)
@@ -45,5 +45,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdicp_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdicp_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdicp_oce.F90	(revision 2236)
@@ -86,5 +86,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE trdicp_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmld_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmld_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmld_oce.F90	(revision 2236)
@@ -85,5 +85,5 @@
    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE trdmld_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmld_rst.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmld_rst.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmld_rst.F90	(revision 2236)
@@ -25,5 +25,5 @@
    !! OPA 9.0 , LOCEAN-IPSL (2006) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!---------------------------------------------------------------------------------
   
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmod.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmod.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmod.F90	(revision 2236)
@@ -39,5 +39,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmod_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmod_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdmod_oce.F90	(revision 2236)
@@ -75,5 +75,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE trdmod_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdvor.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 2236)
@@ -66,5 +66,5 @@
    !!   OPA 9.0 , LOCEAN-IPSL (2005) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
   
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdvor_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdvor_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/TRD/trdvor_oce.F90	(revision 2236)
@@ -36,5 +36,5 @@
    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE trdvor_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 2236)
@@ -41,5 +41,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE zdf_oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 2236)
@@ -30,4 +30,8 @@
    
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bfrua , bfrva   !: Bottom friction coefficients set in zdfbfr
+#if defined key_zdfgls
+   REAL(wp), PUBLIC                     ::   rn_hbro =  0.003_wp  ! Bottom roughness (m)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   wbotu, wbotv    !  Bottom stresses
+#endif
 
    !                                    !!* Namelist nambfr: bottom friction namelist *
@@ -46,5 +50,5 @@
    !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 2236)
@@ -42,5 +42,5 @@
    !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfevd.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 2236)
@@ -33,5 +33,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 2236)
@@ -0,0 +1,1342 @@
+MODULE zdfgls
+   !!======================================================================
+   !!                       ***  MODULE  zdfgls  ***
+   !! Ocean physics:  vertical mixing coefficient computed from the gls 
+   !!                 turbulent closure parameterization
+   !!======================================================================
+   !! History :   3.0  !  2009-09  (G. Reffray) : Original code
+   !!----------------------------------------------------------------------
+#if defined key_zdfgls   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_zdfgls'                 Generic Length Scale vertical physics
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   zdf_gls      : update momentum and tracer Kz from a gls scheme
+   !!   zdf_gls_init : initialization, namelist read, and parameters control
+   !!   gls_rst      : read/write gls restart in ocean restart file
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers 
+   USE dom_oce        ! ocean space and time domain
+   USE domvvl         ! ocean space and time domain : variable volume layer
+   USE zdf_oce        ! ocean vertical physics
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE phycst         ! physical constants
+   USE zdfmxl         ! mixed layer
+   USE restart        ! only for lrst_oce
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE zdfbfr, ONLY : rn_hbro, wbotu, wbotv ! bottom roughness and bottom stresses
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_gls    ! routine called in step module
+   PUBLIC   gls_rst    ! routine called in step module
+
+   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdfgls = .TRUE.  !: TKE vertical mixing flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   en                  !: now turbulent kinetic energy
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   mxln                !: now mixing length
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   zwall              !: wall function
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ustars2            !: Squared surface velocity scale at T-points
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ustarb2            !: Squared bottom  velocity scale at T-points
+
+   !                                         !!! ** Namelist  namzdf_gls  **
+   LOGICAL  ::   ln_crban   = .FALSE.         ! =T use Craig and Banner scheme
+   LOGICAL  ::   ln_length_lim = .FALSE.      ! use limit on the dissipation rate understable stratification (Galperin et al., 1988)
+   LOGICAL  ::   ln_sigpsi = .FALSE.          ! Activate Burchard (2003) modification for k-eps closure AND wave breaking mixing
+   REAL(wp) ::   rn_epsmin  = 1.e-12_wp       ! minimum value of dissipation (m2/s3)
+   REAL(wp) ::   rn_emin    = 1.e-6_wp        ! minimum value of TKE (m2/s2)
+   INTEGER  ::   nn_tkebc_surf = 0            ! TKE surface boundary condition (=0/1)
+   INTEGER  ::   nn_tkebc_bot  = 0            ! TKE bottom boundary condition (=0/1)
+   INTEGER  ::   nn_psibc_surf = 0            ! PSI surface boundary condition (=0/1)
+   INTEGER  ::   nn_psibc_bot  = 0            ! PSI bottom boundary condition (=0/1)
+   INTEGER  ::   nn_stab_func  = 0            ! stability functions G88, KC or Canuto (=0/1/2)
+   INTEGER  ::   nn_clos    = 0               ! closure 0/1/2/3 MY82/k-eps/k-w/gen
+   REAL(wp) ::   clim_galp  = 0.53_wp         ! Holt 2008 value for k-eps: 0.267
+   REAL(wp) ::   hsro       = 0.003_wp        ! Minimum surface roughness
+   REAL(wp) ::   rn_charn   = 2.e+5_wp        ! Charnock constant for surface breaking waves mixing : 1400. (standard) or 2.e5 (Stacey value)
+   REAL(wp) ::   rn_crban   = 100._wp         ! Craig and Banner constant for surface breaking waves mixing
+   REAL(wp) ::   rn_cm_sf   = 0.73_wp         ! Shear free turbulence parameters
+   REAL(wp) ::   rn_a_sf    = -2.0_wp         ! Must be negative -2 < rn_a_sf < -1 
+   REAL(wp) ::   rn_l_sf    =  0.2_wp         ! 0 <rn_l_sf<vkarmn    
+   REAL(wp) ::   rn_ghmin   = -0.28
+   REAL(wp) ::   rn_gh0     = 0.0329
+   REAL(wp) ::   rn_ghcri   = 0.03
+   REAL(wp) ::   rn_a1      =  0.92_wp
+   REAL(wp) ::   rn_a2      =  0.74_wp
+   REAL(wp) ::   rn_b1      = 16.60_wp
+   REAL(wp) ::   rn_b2      = 10.10_wp         
+   REAL(wp) ::   rn_e1      =  1.80_wp         
+   REAL(wp) ::   rn_e2      =  1.33_wp         
+   REAL(wp) ::   rn_l1      =  0.107_wp
+   REAL(wp) ::   rn_l2      =  0.0032_wp
+   REAL(wp) ::   rn_l3      =  0.0864_wp
+   REAL(wp) ::   rn_l4      =  0.12_wp
+   REAL(wp) ::   rn_l5      = 11.9_wp
+   REAL(wp) ::   rn_l6      =  0.4_wp
+   REAL(wp) ::   rn_l7      =  0.0_wp
+   REAL(wp) ::   rn_l8      =  0.48_wp
+   REAL(wp) ::   rn_m1      =  0.127_wp
+   REAL(wp) ::   rn_m2      =  0.00336_wp
+   REAL(wp) ::   rn_m3      =  0.0906_wp
+   REAL(wp) ::   rn_m4      =  0.101_wp
+   REAL(wp) ::   rn_m5      = 11.2_wp
+   REAL(wp) ::   rn_m6      =  0.4_wp
+   REAL(wp) ::   rn_m7      =  0.0_wp
+   REAL(wp) ::   rn_m8      =  0.318_wp
+   REAL(wp) ::   rn_c02
+   REAL(wp) ::   rn_c02r
+   REAL(wp) ::   rn_c03
+   REAL(wp) ::   rn_c04
+   REAL(wp) ::   rn_c03_sqrt2_galp
+   REAL(wp) ::   rn_sbc_mb
+   REAL(wp) ::   rn_sbc_std
+   REAL(wp) ::   rn_sbc_tke1
+   REAL(wp) ::   rn_sbc_tke2
+   REAL(wp) ::   rn_sbc_tke3
+   REAL(wp) ::   rn_sbc_psi1
+   REAL(wp) ::   rn_sbc_psi2
+   REAL(wp) ::   rn_sbc_psi3
+   REAL(wp) ::   rn_sbc_zs
+   REAL(wp) ::   zfact_tke, zfact_psi
+   REAL(wp) ::   rn_c0, rn_c2, rn_c3, rn_f6, rn_cff, rn_c_diff
+   REAL(wp) ::   rn_s0, rn_s1, rn_s2, rn_s4, rn_s5, rn_s6
+   REAL(wp) ::   rn_d0, rn_d1, rn_d2, rn_d3, rn_d4, rn_d5
+   REAL(wp) ::   rn_sc_tke, rn_sc_psi, rn_psi1, rn_psi2, rn_psi3, rn_sc_psi0
+   REAL(wp) ::   rn_psi3m, rn_psi3p, zpp, zmm, znn, epslim
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! $Id: zdfgls.F90 1201 2008-09-24 13:24:21Z rblod $
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zdf_gls( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_gls  ***
+      !!
+      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
+      !!      coefficients using a 2.5 turbulent closure scheme.
+      !!----------------------------------------------------------------------
+      USE oce,     z_elem_a  =>   ua   ! use ua as workspace
+      USE oce,     z_elem_b  =>   va   ! use va as workspace
+      USE oce,     z_elem_c  =>   ta   ! use ta as workspace
+      USE oce,     psi       =>   sa   ! use sa as workspace
+      !
+      INTEGER, INTENT(in) ::   kt ! ocean time step
+      INTEGER  ::   ji, jj, jk, ibot, ibotm1, dir  ! dummy loop arguments
+      !
+      REAL(wp) ::   zesh2, zsigpsi                 ! temporary scalars
+      REAL(wp) ::   ztx2, zty2, zup, zdown, zcof   !    -         
+      REAL(wp) ::   zratio, zrn2, zflxb, sh        !    -         -
+      REAL(wp) ::   prod, buoy, diss, zdiss, sm    !    -         -
+      REAL(wp) ::   gh, gm, shr, dif, zsqen, zav   !    -         -
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zdep   !
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zflxs  ! Turbulence fluxed induced by internal waves 
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zhsro  ! Surface roughness (surface waves)
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eb     ! tke at time before
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   mxlb   ! mixing length at time before
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   shear  ! vertical shear
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eps    ! dissipation rate
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwall_psi ! Wall function for psi schmidt number in the wb case 
+                                                      ! (if ln_sigpsi.AND.ln_crban)
+      !!--------------------------------------------------------------------
+
+      IF( kt == nit000  ) CALL zdf_gls_init        ! Initialization (first time-step only)
+
+      !!--------------------------------------------------------------------
+      ! Preliminary computing
+
+      ustars2 = 0. ; ustarb2 = 0. ; psi  = 0. ; zwall_psi = 0.
+
+      ! Compute wind stress at T-points
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+        DO ji = fs_2, fs_jpim1   ! vector opt.
+          ! 
+          ! wind stress
+          ! squared surface velocity scale
+          ztx2 = 2. * (utau(ji-1,jj  )*umask(ji-1,jj,1) + utau(ji,jj)*umask(ji,jj,1)) / &
+            &                  MAX(1., umask(ji-1,jj,1) +             umask(ji,jj,1))
+          zty2 = 2. * (vtau(ji  ,jj-1)*vmask(ji,jj-1,1) + vtau(ji,jj)*vmask(ji,jj,1)) / &
+            &                  MAX(1., vmask(ji,jj-1,1) +             vmask(ji,jj,1))
+          ustars2(ji,jj) = rn_sbc_tke2 * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)
+          !
+          ! bottom friction 
+          ztx2 = 2. * (wbotu(ji-1,jj  )*umask(ji-1,jj,1) + wbotu(ji,jj)*umask(ji,jj,1)) / &
+            &                   MAX(1., umask(ji-1,jj,1) +              umask(ji,jj,1))
+          zty2 = 2. * (wbotv(ji  ,jj-1)*vmask(ji,jj-1,1) + wbotv(ji,jj)*vmask(ji,jj,1)) / &
+            &                   MAX(1., vmask(ji,jj-1,1) +              vmask(ji,jj,1))
+          ustarb2(ji,jj) = 0.5 * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)
+        ENDDO
+      ENDDO  
+
+      ! In case of breaking surface waves mixing,
+      ! Compute surface roughness length according to Charnock formula:
+      IF (ln_crban) THEN
+        zhsro(:,:) = MAX(rn_sbc_zs * ustars2(:,:), hsro)
+      ELSE
+        zhsro(:,:) = hsro
+      ENDIF
+
+      ! Compute shear and dissipation rate
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
+                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   &
+                  &                            / (  fse3uw_n(ji,jj,jk)               &
+                  &                            *    fse3uw_b(ji,jj,jk) )
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   &
+                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   &
+                  &                            / (  fse3vw_n(ji,jj,jk)               &
+                  &                            *    fse3vw_b(ji,jj,jk) )
+               eps(ji,jj,jk)  = rn_c03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk)
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      ! Lateral boundary conditions (avmu,avmv) (sign unchanged)
+      CALL lbc_lnk( avmu, 'U', 1. )   ;    CALL lbc_lnk( avmv, 'V', 1. )
+
+      ! Save tke at before time step
+      eb  (:,:,:) = en  (:,:,:)
+      mxlb(:,:,:) = mxln(:,:,:)
+
+      IF ( nn_clos .EQ. 0 ) THEN ! Mellor-Yamada
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zup   = mxln(ji,jj,jk) * fsdepw(ji,jj,mbathy(ji,jj))
+                  zdown = vkarmn * fsdepw(ji,jj,jk) * (-fsdepw(ji,jj,jk)+fsdepw(ji,jj,mbathy(ji,jj)))
+                  zwall (ji,jj,jk) = ( 1. + rn_e2 * ( zup / MAX( zdown, rsmall ) )**2. ) * tmask(ji,jj,jk)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+
+      !!---------------------------------!!
+      !!   Equation to prognostic k      !!
+      !!---------------------------------!!
+      !
+      ! Now Turbulent kinetic energy (output in en)
+      ! -------------------------------
+      ! Resolution of a tridiagonal linear system by a "methode de chasse"
+      ! computation from level 2 to jpkm1  (e(1) computed after and e(jpk)=0 ).
+      ! The surface boundary condition are set after
+      ! The bottom boundary condition are also set after. In standard e(bottom)=0.
+      ! z_elem_b : diagonal z_elem_c : upper diagonal z_elem_a : lower diagonal
+      ! Warning : after this step, en : right hand side of the matrix
+
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !
+               ! shear prod. at w-point weightened by mask
+               shear(ji,jj,jk) =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1.e0 , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &             + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1.e0 , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )
+               !
+               ! stratif. destruction
+               buoy = - avt(ji,jj,jk) * rn2(ji,jj,jk)
+               !
+               ! shear prod. - stratif. destruction
+               diss = eps(ji,jj,jk)
+               !
+               dir = 0.5 + sign(0.5,shear(ji,jj,jk)+buoy)   ! dir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+               !
+               zesh2 = dir*(shear(ji,jj,jk)+buoy)+(1-dir)*shear(ji,jj,jk)          ! production term
+               zdiss = dir*(diss/en(ji,jj,jk))   +(1-dir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term
+               !
+               ! Compute a wall function from 1. to rn_sc_psi*zwall/rn_sc_psi0
+               ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style)
+               ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries.
+               ! Otherwise, this should be rn_sc_psi/rn_sc_psi0
+               IF (ln_sigpsi) THEN
+                 zsigpsi = MIN(1., zesh2/eps(ji,jj,jk)) ! 0. <= zsigpsi <= 1.
+                 zwall_psi(ji,jj,jk) = rn_sc_psi / (zsigpsi * rn_sc_psi + (1.-zsigpsi) * rn_sc_psi0 / MAX(zwall(ji,jj,jk),1.))
+               ELSE
+                 zwall_psi(ji,jj,jk) = 1.
+               ENDIF
+               !
+               ! building the matrix
+               zcof = zfact_tke * tmask(ji,jj,jk)
+               !
+               ! lower diagonal
+               z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &
+                  &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+               !
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+               !
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1. - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                    + rdt * zdiss * tmask(ji,jj,jk) 
+               !
+               ! right hand side in en
+               en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      z_elem_b(:,:,jpk) = 1.
+      !
+      ! Set surface condition on zwall_psi (1 at the bottom)
+      IF (ln_sigpsi) THEN
+        DO jj = 2, jpjm1
+          DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwall_psi(ji,jj,1) = rn_sc_psi/rn_sc_psi0
+          END DO
+        END DO
+      ENDIF
+
+      ! Surface boundary condition on tke
+      ! ---------------------------------
+      !
+      SELECT CASE ( nn_tkebc_surf )
+      !
+      CASE ( 0 )             ! Dirichlet case
+      !
+      IF (ln_crban) THEN     ! Wave induced mixing case
+      !                      ! en(1) = q2(1) = 0.5 * (15.8 * Ccb)^(2/3) * u*^2
+      !                      ! balance between the production and the dissipation terms including the wave effect
+      !
+      en(:,:,1) = MAX( rn_sbc_tke1 * ustars2(:,:), rn_emin )
+      z_elem_a(:,:,1) = en(:,:,1)
+      z_elem_c(:,:,1) = 0.
+      z_elem_b(:,:,1) = 1.
+      ! 
+      ! one level below
+      en(:,:,2) = MAX( rn_sbc_tke1 * ustars2(:,:) * ( (zhsro(:,:)+fsdepw(:,:,2))/zhsro(:,:) )**rn_a_sf, rn_emin )
+      z_elem_a(:,:,2) = 0.
+      z_elem_c(:,:,2) = 0.
+      z_elem_b(:,:,2) = 1.
+      !
+      ELSE                   ! No wave induced mixing case
+      !                      ! en(1) = u*^2/C0^2  &  l(1)  = K*zs
+      !                      ! balance between the production and the dissipation terms
+      !
+      en(:,:,1) = MAX( rn_c02r * ustars2(:,:), rn_emin )
+      z_elem_a(:,:,1) = en(:,:,1) 
+      z_elem_c(:,:,1) = 0.
+      z_elem_b(:,:,1) = 1.
+      !
+      ! one level below
+      en(:,:,2) = MAX( rn_c02r * ustars2(:,:), rn_emin )
+      z_elem_a(:,:,2) = 0.
+      z_elem_c(:,:,2) = 0.
+      z_elem_b(:,:,2) = 1.
+      !
+      ENDIF
+      !
+      CASE ( 1 )             ! Neumann boundary condition on d(e)/dz
+      !
+      IF (ln_crban) THEN ! Shear free case: d(e)/dz= Fw
+      !
+      ! Dirichlet conditions at k=1 (Cosmetic)
+      en(:,:,1) = MAX( rn_sbc_tke1 * ustars2(:,:), rn_emin )
+      z_elem_a(:,:,1) = en(:,:,1)
+      z_elem_c(:,:,1) = 0.
+      z_elem_b(:,:,1) = 1.
+      ! at k=2, set de/dz=Fw
+      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+      z_elem_a(:,:,2) = 0.           
+      zflxs(:,:) = rn_sbc_tke3 * ustars2(:,:)**1.5 * ((zhsro(:,:)+fsdept(:,:,1))/zhsro(:,:) )**(1.5*rn_a_sf)
+      en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2)
+      !
+      ELSE                   ! No wave induced mixing case: d(e)/dz=0.
+      !
+      ! Dirichlet conditions at k=1 (Cosmetic)
+      en(:,:,1) = MAX( rn_c02r * ustars2(:,:), rn_emin )
+      z_elem_a(:,:,1) = en(:,:,1)
+      z_elem_c(:,:,1) = 0.
+      z_elem_b(:,:,1) = 1.
+      ! at k=2 set de/dz=0.:
+      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+      z_elem_a(:,:,2) = 0.
+      !
+      ENDIF
+      !
+      END SELECT
+
+      ! Bottom boundary condition on tke
+      ! --------------------------------
+      !
+      SELECT CASE ( nn_tkebc_bot )
+      !
+      CASE ( 0 )             ! Dirichlet 
+      !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin
+      !                      ! Balance between the production and the dissipation terms
+      !                      
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ibot   = mbathy(ji,jj)
+            ibotm1 = ibot-1
+            !
+            ! Bottom level Dirichlet condition:
+            z_elem_a(ji,jj,ibot  ) = 0.
+            z_elem_c(ji,jj,ibot  ) = 0.
+            z_elem_b(ji,jj,ibot  ) = 1.
+            en(ji,jj,ibot  ) = MAX( rn_c02r * ustarb2(ji,jj), rn_emin )
+            !
+            ! Just above last level, Dirichlet condition again
+            z_elem_a(ji,jj,ibotm1) = 0.
+            z_elem_c(ji,jj,ibotm1) = 0.
+            z_elem_b(ji,jj,ibotm1) = 1.
+            en(ji,jj,ibotm1) = MAX( rn_c02r * ustarb2(ji,jj), rn_emin ) 
+         END DO
+      END DO
+      !
+      CASE ( 1 )             ! Neumman boundary condition
+      !                      
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ibot   = mbathy(ji,jj)
+            ibotm1 = ibot-1
+            !
+            ! Bottom level Dirichlet condition:
+            z_elem_a(ji,jj,ibot) = 0.
+            z_elem_c(ji,jj,ibot) = 0.
+            z_elem_b(ji,jj,ibot) = 1.
+            en(ji,jj,ibot) = MAX( rn_c02r * ustarb2(ji,jj), rn_emin )
+            !
+            ! Just above last level: Neumann condition
+            z_elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1) ! Remove z_elem_c from z_elem_b
+            z_elem_c(ji,jj,ibotm1) = 0.
+         END DO
+      END DO
+      !
+      END SELECT
+
+      ! Matrix inversion (en prescribed at surface and the bottom)
+      ! ----------------------------------------------------------
+      !
+      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_a(ji,jj,jk) = en(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = jpk-1, 2, -1                         ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               en(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * en(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      ! set the minimum value of tke 
+      en(:,:,:) = MAX( en(:,:,:), rn_emin )
+      
+      !!----------------------------------------!!
+      !!   Solve prognostic equation for psi    !!
+      !!----------------------------------------!!
+
+      ! Set psi to previous time step value
+      !
+      SELECT CASE ( nn_clos )
+      !
+      CASE( 0 )               ! k-kl  (Mellor-Yamada)
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               psi(ji,jj,jk)  = en(ji,jj,jk) * mxln(ji,jj,jk)
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      CASE( 1 )               ! k-eps
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               psi(ji,jj,jk)  = eps(ji,jj,jk)
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      CASE( 2 )               ! k-w
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               psi(ji,jj,jk)  = SQRT(en(ji,jj,jk)) / (rn_c0 * mxln(ji,jj,jk))
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      CASE( 3 )               ! gen
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               psi(ji,jj,jk)  = rn_c02 * en(ji,jj,jk) * mxln(ji,jj,jk)**znn 
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      END SELECT
+      !
+      ! Now gls (output in psi)
+      ! -------------------------------
+      ! Resolution of a tridiagonal linear system by a "methode de chasse"
+      ! computation from level 2 to jpkm1  (e(1) already computed and e(jpk)=0 ).
+      ! z_elem_b : diagonal z_elem_c : upper diagonal z_elem_a : lower diagonal
+      ! Warning : after this step, en : right hand side of the matrix
+
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !
+               ! psi / k
+               zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 
+               !
+               ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 dir = 1 (stable) otherwise dir = 0 (unstable)
+               dir = 0.5 + sign(0.5,rn2(ji,jj,jk))
+               !
+               rn_psi3 = dir*rn_psi3m+(1-dir)*rn_psi3p
+               !
+               ! shear prod. - stratif. destruction
+               prod = rn_psi1 * zratio * shear(ji,jj,jk)
+               !
+               ! stratif. destruction
+               buoy = rn_psi3 * zratio * (- avt(ji,jj,jk) * rn2(ji,jj,jk))
+               !
+               ! shear prod. - stratif. destruction
+               diss = rn_psi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk)
+               !
+               dir = 0.5 + sign(0.5,prod+buoy)   ! dir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+               !
+               zesh2 = dir*(prod+buoy)          +(1-dir)*prod                      ! production term
+               zdiss = dir*(diss/psi(ji,jj,jk)) +(1-dir)*(diss-buoy)/psi(ji,jj,jk) ! dissipation term
+               !                                                        
+               ! building the matrix
+               zcof = zfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk)
+               ! lower diagonal
+               z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &
+                  &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1. - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                    + rdt * zdiss * tmask(ji,jj,jk)
+               !
+               ! right hand side in psi
+               psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      z_elem_b(:,:,jpk) = 1.
+
+      ! Surface boundary condition on psi
+      ! ---------------------------------
+      !
+      SELECT CASE ( nn_psibc_surf )
+      !
+      CASE ( 0 )             ! Dirichlet boundary conditions
+      !
+      IF (ln_crban) THEN     ! Wave induced mixing case
+      !                      ! en(1) = q2(1) = 0.5 * (15.8 * Ccb)^(2/3) * u*^2
+      !                      ! balance between the production and the dissipation terms including the wave effect
+      !
+      zdep(:,:) = rn_l_sf * zhsro(:,:)
+      psi (:,:,1) = rn_c0**zpp * en(:,:,1)**zmm * zdep(:,:)**znn * tmask(:,:,1)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0.
+      z_elem_b(:,:,1) = 1.
+      !
+      ! one level below
+      zdep(:,:) = ( (zhsro(:,:) + fsdepw(:,:,2))**(zmm*rn_a_sf+znn) )  &
+        &                       / zhsro(:,:)**(zmm*rn_a_sf)
+      psi (:,:,2) = rn_sbc_psi1 * ustars2(:,:)**zmm * zdep(:,:) * tmask(:,:,1)
+      z_elem_a(:,:,2) = 0.
+      z_elem_c(:,:,2) = 0.
+      z_elem_b(:,:,2) = 1.
+      ! 
+      ELSE                   ! No wave induced mixing case
+      !                      ! en(1) = u*^2/C0^2  &  l(1)  = K*zs
+      !                      ! balance between the production and the dissipation terms
+      !
+      zdep(:,:) = vkarmn * zhsro(:,:)
+      psi (:,:,1) = rn_c0**zpp * en(:,:,1)**zmm * zdep(:,:)**znn * tmask(:,:,1)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0.
+      z_elem_b(:,:,1) = 1.
+      !
+      ! one level below
+      zdep(:,:) = vkarmn * ( zhsro(:,:) + fsdepw(:,:,2) )
+      psi (:,:,2) = rn_c0**zpp * en(:,:,1)**zmm * zdep(:,:)**znn * tmask(:,:,1)
+      z_elem_a(:,:,2) = 0.
+      z_elem_c(:,:,2) = 0.
+      z_elem_b(:,:,2) = 1.
+      !
+      ENDIF
+      !
+      CASE ( 1 )             ! Neumann boundary condition on d(psi)/dz
+      !
+      IF (ln_crban) THEN     ! Wave induced mixing case
+      !
+      zdep(:,:) = rn_l_sf * zhsro(:,:)
+      psi (:,:,1) = rn_c0**zpp * en(:,:,1)**zmm * zdep(:,:)**znn * tmask(:,:,1)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0.
+      z_elem_b(:,:,1) = 1.
+      !
+      ! Neumann condition at k=2
+      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+      z_elem_a(:,:,2) = 0.
+      !
+      ! Set psi vertical flux at the surface:
+      zdep(:,:) = (zhsro(:,:) + fsdept(:,:,1))**(zmm*rn_a_sf+znn-1.) / zhsro(:,:)**(zmm*rn_a_sf)
+      zflxs(:,:) = rn_sbc_psi3 * ( zwall_psi(:,:,1)*avm(:,:,1) + zwall_psi(:,:,2)*avm(:,:,2) ) & 
+                 & * en(:,:,1)**zmm * zdep         
+      psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
+      !
+      ELSE                   ! No wave induced mixing
+      !
+      zdep(:,:) = vkarmn * zhsro(:,:)
+      psi (:,:,1) = rn_c0**zpp * en(:,:,1)**zmm * zdep(:,:)**znn * tmask(:,:,1)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0.
+      z_elem_b(:,:,1) = 1.
+      !
+      ! Neumann condition at k=2
+      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+      z_elem_a(ji,jj,2) = 0.
+      !
+      ! Set psi vertical flux at the surface:
+      zdep(:,:) = zhsro(:,:) + fsdept(:,:,1)
+      zflxs(:,:) = rn_sbc_psi2 * ( avm(:,:,1) + avm(:,:,2) ) * en(:,:,1)**zmm * zdep**(znn-1.)
+      psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
+      !     
+      ENDIF
+      !
+      END SELECT
+
+      ! Bottom boundary condition on psi
+      ! --------------------------------
+      !
+      SELECT CASE ( nn_psibc_bot )
+      !
+      !
+      CASE ( 0 )             ! Dirichlet 
+      !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_hbro
+      !                      ! Balance between the production and the dissipation terms
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ibot = mbathy(ji,jj)
+            ibotm1 = ibot-1
+            zdep(ji,jj) = vkarmn * rn_hbro
+            psi (ji,jj,ibot) = rn_c0**zpp * en(ji,jj,ibot)**zmm * zdep(ji,jj)**znn
+            z_elem_a(ji,jj,ibot) = 0.
+            z_elem_c(ji,jj,ibot) = 0.
+            z_elem_b(ji,jj,ibot) = 1.
+            !
+            ! Just above last level, Dirichlet condition again (GOTM like)
+            zdep(ji,jj) = vkarmn * (rn_hbro + fse3t(ji,jj,ibotm1))
+            psi (ji,jj,ibotm1) = rn_c0**zpp * en(ji,jj,ibot  )**zmm * zdep(ji,jj)**znn
+            z_elem_a(ji,jj,ibotm1) = 0.
+            z_elem_c(ji,jj,ibotm1) = 0.
+            z_elem_b(ji,jj,ibotm1) = 1.
+         END DO
+      END DO
+      !
+      !
+      CASE ( 1 )             ! Neumman boundary condition
+      !                      
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ibot   = mbathy(ji,jj)
+            ibotm1 = ibot-1
+            !
+            ! Bottom level Dirichlet condition:
+            zdep(ji,jj) = vkarmn * rn_hbro
+            psi (ji,jj,ibot) = rn_c0**zpp * en(ji,jj,ibot)**zmm * zdep(ji,jj)**znn
+            !
+            z_elem_a(ji,jj,ibot) = 0.
+            z_elem_c(ji,jj,ibot) = 0.
+            z_elem_b(ji,jj,ibot) = 1.
+            !
+            ! Just above last level: Neumann condition with flux injection
+            z_elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1) ! Remove z_elem_c from z_elem_b
+            z_elem_c(ji,jj,ibotm1) = 0.
+            !
+            ! Set psi vertical flux at the bottom:
+            zdep(ji,jj) = rn_hbro + 0.5*fse3t(ji,jj,ibotm1)
+            zflxb = rn_sbc_psi2 * ( avm(ji,jj,ibot) + avm(ji,jj,ibotm1) ) * &
+              & (0.5*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**zmm * zdep(ji,jj)**(znn-1.)
+            psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / fse3w(ji,jj,ibotm1)
+         END DO
+      END DO
+      !
+      END SELECT
+
+      ! Matrix inversion
+      ! ----------------
+      !
+      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_a(ji,jj,jk) = psi(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = jpk-1, 2, -1                         ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               psi(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * psi(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Set dissipation
+      !----------------
+
+      SELECT CASE ( nn_clos )
+      !
+      CASE( 0 )               ! k-kl  (Mellor-Yamada)
+      !
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+              eps(ji,jj,jk) = rn_c03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / psi(ji,jj,jk)
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      CASE( 1 )               ! k-eps
+      !
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               eps(ji,jj,jk)  = psi(ji,jj,jk)
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      CASE( 2 )               ! k-w
+      !
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+              eps(ji,jj,jk) = rn_c04 * en(ji,jj,jk) * psi(ji,jj,jk) 
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      CASE( 3 )               ! gen
+      !
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+              eps(ji,jj,jk) = rn_c0**(3.+zpp/znn) * en(ji,jj,jk)**(1.5+zmm/znn) * psi(ji,jj,jk)**(-1./znn)
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      END SELECT
+
+      ! Limit dissipation rate under stable stratification
+      ! --------------------------------------------------
+      DO jk = 1, jpkm1 ! Note that this set boundary conditions on mxln at the same time
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               ! limitation
+               eps(ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
+               mxln(ji,jj,jk)  = rn_c03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / eps(ji,jj,jk)
+               ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
+               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+               mxln(ji,jj,jk) = MIN( clim_galp*SQRT( 2.*en(ji,jj,jk)/zrn2 ), mxln(ji,jj,jk) )
+            END DO
+         END DO
+      END DO 
+
+      !
+      ! Stability function and vertical viscosity and diffusivity
+      ! ---------------------------------------------------------
+      !
+      SELECT CASE ( nn_stab_func )
+      !
+      CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! zcof =  l²/q²
+               zcof = mxlb(ji,jj,jk)**2. / ( 2.*eb(ji,jj,jk) )
+               ! Gh = -N²l²/q²
+               gh = - rn2(ji,jj,jk) * zcof
+!               gh = MIN(gh, gh-(gh-rn_ghcri)**2./(gh + rn_gh0 - 2.0*rn_ghcri))
+               gh = MIN( gh, rn_gh0   )
+               gh = MAX( gh, rn_ghmin )
+               ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin)
+               sh = rn_a2*( 1.-6.*rn_a1/rn_b1 ) / ( 1.-3.*rn_a2*gh*(6.*rn_a1+rn_b2*( 1.-rn_c3 ) ) )
+               sm = ( rn_b1**(-1./3.) + ( 18*rn_a1*rn_a1 + 9.*rn_a1*rn_a2*(1.-rn_c2) )*sh*gh ) / (1.-9.*rn_a1*rn_a2*gh)
+               !
+               ! Store stability function in avmu and avmv
+               avmu(ji,jj,jk) = rn_c_diff * sh * tmask(ji,jj,jk)
+               avmv(ji,jj,jk) = rn_c_diff * sm * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      CASE ( 2, 3 )               ! Canuto stability functions
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! zcof =  l²/q²
+               zcof = mxlb(ji,jj,jk)**2. / ( 2.*eb(ji,jj,jk) )
+               ! Gh = -N²l²/q²
+               gh = - rn2(ji,jj,jk) * zcof
+!               gh = MIN(gh, gh-(gh-rn_ghcri)**2./(gh + rn_gh0 - 2.0*rn_ghcri))
+               gh = MIN( gh, rn_gh0   )
+               gh = MAX( gh, rn_ghmin )
+               gh = gh*rn_f6
+               ! Gm =  M²l²/q² Shear number
+               shr = shear(ji,jj,jk)/MAX(avm(ji,jj,jk), rsmall)
+               gm = shr * zcof
+               gm = MAX(gm, 1.e-10)
+               gm = gm*rn_f6
+               gm = MIN ( (rn_d0 - rn_d1*gh + rn_d3*gh**2.)/(rn_d2-rn_d4*gh) , gm )
+               ! Stability functions from Canuto
+               rn_cff = rn_d0 - rn_d1*gh +rn_d2*gm + rn_d3*gh**2. - rn_d4*gh*gm + rn_d5*gm**2.
+               sm = (rn_s0 - rn_s1*gh + rn_s2*gm) / rn_cff
+               sh = (rn_s4 - rn_s5*gh + rn_s6*gm) / rn_cff
+               !
+               ! Store stability function in avmu and avmv
+               avmu(ji,jj,jk) = rn_c_diff * sh * tmask(ji,jj,jk)
+               avmv(ji,jj,jk) = rn_c_diff * sm * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      END SELECT
+
+      ! Boundary conditions on stability functions for momentum (Neumann):
+      ! Lines below are useless if GOTM style Dirichlet conditions are used
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            avmv(ji,jj,1) = rn_cm_sf / SQRT(2.)
+         END DO
+      END DO
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ibot=mbathy(ji,jj)
+            ibotm1=ibot-1
+            avmv(ji,jj,ibot) = rn_c0 / SQRT(2.)
+         END DO
+      END DO
+
+      ! Compute diffusivities/viscosities
+      ! The computation below could be restrained to jk=2 to jpkm1 if GOTM style Dirichlet conditions are used
+      DO jk = 1, jpk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zsqen           = SQRT(2.*en(ji,jj,jk)) * mxln(ji,jj,jk)
+               zav             = zsqen * avmu(ji,jj,jk)
+               avt(ji,jj,jk)   = MAX(zav,avtb(jk))*tmask(ji,jj,jk) ! apply mask for zdfmxl routine
+               zav             = zsqen * avmv(ji,jj,jk)
+               avm(ji,jj,jk)   = MAX(zav,avmb(jk)) ! Note that avm is not masked at the surface and the bottom
+            END DO
+         END DO
+      END DO
+
+      !
+      ! Lateral boundary conditions (sign unchanged)
+      !
+      avt(:,:,1)  = 0.
+      CALL lbc_lnk( avm, 'W', 1. )   ;   CALL lbc_lnk( avt, 'W', 1. )
+
+      DO jk = 2, jpkm1            !* vertical eddy viscosity at u- and v-points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = ( avm  (ji,jj,jk)*tmask(ji,jj,jk) + avm (ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) * umask(ji,jj,jk)   &
+               &     / MAX( 1.,   tmask(ji,jj,jk) + tmask(ji+1,jj  ,jk) )
+               avmv(ji,jj,jk) = ( avm  (ji,jj,jk)*tmask(ji,jj,jk) + avm (ji  ,jj+1,jk)*tmask(ji  ,jj+1,jk) ) * vmask(ji,jj,jk)   &
+               &     / MAX( 1.,   tmask(ji,jj,jk) + tmask(ji  ,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+
+      avmu(:,:,1) = 0.
+      avmv(:,:,1) = 0.
+
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! Lateral boundary conditions
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab3d_1=en  , clinfo1=' gls  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk)
+         CALL prt_ctl( tab3d_1=avmu, clinfo1=' gls  - u: ', mask1=umask,                   &
+            &          tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk )
+      ENDIF
+      !
+   END SUBROUTINE zdf_gls
+
+   SUBROUTINE zdf_gls_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_gls_init  ***
+      !!                     
+      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
+      !!      viscosity when using a gls turbulent closure scheme
+      !!
+      !! ** Method  :   Read the namzdf_gls namelist and check the parameters
+      !!      called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namlist namzdf_gls
+      !!
+      !! ** Action  :   Increase by 1 the nstop flag is setting problem encounter
+      !!
+      !!----------------------------------------------------------------------
+      USE dynzdf_exp
+      USE trazdf_exp
+      !
+# if defined key_vectopt_memory
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+# else
+      INTEGER ::           jk   ! dummy loop indices
+# endif
+      REAL(wp)::   zcr
+      !!
+      NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, &
+         &            clim_galp, ln_crban, ln_sigpsi,    &
+         &            rn_crban, rn_charn,                &
+         &            nn_tkebc_surf, nn_tkebc_bot,       &
+         &            nn_psibc_surf, nn_psibc_bot,       &
+         &            nn_stab_func, nn_clos
+      !!----------------------------------------------------------
+
+      ! Read Namelist namzdf_gls
+      ! ------------------------
+      REWIND ( numnam )
+      READ   ( numnam, namzdf_gls )
+
+      ! Parameter control and print
+      ! ---------------------------
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_gls_init : gls turbulent closure scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namzdf_gls : set gls mixing parameters'
+         WRITE(numout,*) '             minimum value of en                       rn_emin  = ', rn_emin
+         WRITE(numout,*) '             minimum value of eps                    rn_epsmin  = ', rn_epsmin
+         WRITE(numout,*) '             Surface roughness (m)                         hsro = ', hsro
+         WRITE(numout,*) '             Bottom roughness (m)                        rn_hbro = ', rn_hbro
+         WRITE(numout,*) '             Limit dissipation rate under stable stratification ln_length_lim = ',ln_length_lim
+         WRITE(numout,*) '             Galperin length scale limitation coef (Standard: 0.53, Holt: 0.26) clim_galp = ', clim_galp
+         WRITE(numout,*) '             TKE Surface boundary condition       nn_tkebc_surf = ', nn_tkebc_surf
+         WRITE(numout,*) '             TKE Bottom boundary condition        nn_tkebc_bot  = ', nn_tkebc_bot
+         WRITE(numout,*) '             PSI Surface boundary condition       nn_psibc_surf = ', nn_psibc_surf
+         WRITE(numout,*) '             PSI Bottom boundary condition        nn_psibc_bot  = ', nn_psibc_bot
+         WRITE(numout,*) '             Craig and Banner scheme                  ln_crban  = ', ln_crban
+         WRITE(numout,*) '             Modify psi Schmidt number (wb case)     ln_sigpsi  = ', ln_sigpsi
+         WRITE(numout,*) '             Craig and Banner coef.                   rn_crban  = ', rn_crban
+         WRITE(numout,*) '             Charnock coef.                           rn_charn  = ', rn_charn
+         WRITE(numout,*) '             Stability functions                   nn_stab_func = ',nn_stab_func
+         WRITE(numout,*) '             Closure                                 nn_clos    = ',nn_clos
+         WRITE(numout,*)
+      ENDIF
+
+      ! Check of some namelist values
+      IF( nn_tkebc_surf < 0 .OR. nn_tkebc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_surf is 0 or 1' )
+      IF( nn_psibc_surf < 0 .OR. nn_psibc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_psibc_surf is 0 or 1' )
+      IF( nn_tkebc_bot < 0 .OR. nn_tkebc_bot > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_bot is 0 or 1' )
+      IF( nn_psibc_bot < 0 .OR. nn_psibc_bot > 1 ) CALL ctl_stop( 'bad flag: nn_psibc_bot is 0 or 1' )
+      IF( nn_stab_func < 0 .OR. nn_stab_func > 3) CALL ctl_stop( 'bad flag: nn_stab_func is 0, 1, 2 and 3' )
+      IF( nn_clos < 0 .OR. nn_clos > 3) CALL ctl_stop( 'bad flag: nn_clos is 0, 1, 2 or 3' )
+
+      ! Initialisation of the parameters for the choosen closure
+      ! --------------------------------------------------------
+      !
+      SELECT CASE ( nn_clos )
+      !
+      CASE( 0 )               ! k-kl  (Mellor-Yamada)
+      !
+      IF(lwp) WRITE(numout,*) 'The choosen closure is k-kl closed to the classical Mellor-Yamada'
+      zpp       = 0.
+      zmm       = 1.
+      znn       = 1.
+      rn_sc_tke = 1.96
+      rn_sc_psi = 1.96
+      rn_psi1 = 0.9
+      rn_psi3p = 1.
+      rn_psi2  = 0.5
+      !
+         SELECT CASE ( nn_stab_func )
+         !
+         CASE( 0, 1 )               ! G88 or KC stability functions
+            rn_psi3m = 2.53
+         CASE( 2 )                  ! Canuto A stability functions
+            rn_psi3m = 2.38
+         CASE( 3 )                  ! Canuto B stability functions
+            rn_psi3m = 2.38         ! caution : constant not identified 
+         END SELECT
+      !
+      CASE( 1 )               ! k-eps
+      !
+      IF(lwp) WRITE(numout,*) 'The choosen closure is k-eps'
+      zpp       = 3.
+      zmm       = 1.5
+      znn       = -1.
+      rn_sc_tke = 1.
+      rn_sc_psi = 1.3  ! Schmidt number for psi
+      rn_psi1 = 1.44
+      rn_psi3p = 1.
+      rn_psi2  = 1.92
+      !
+        SELECT CASE ( nn_stab_func )
+        ! 
+        CASE( 0, 1 )               ! G88 or KC stability functions
+           rn_psi3m = -0.52
+        CASE( 2 )                  ! Canuto A stability functions
+           rn_psi3m = -0.629 
+        CASE( 3 )                  ! Canuto B stability functions
+           rn_psi3m = -0.566
+        END SELECT
+      !
+      CASE( 2 )               ! k-omega
+      !
+      IF(lwp) WRITE(numout,*) 'The choosen closure is k-omega'
+      zpp       = -1.
+      zmm       = 0.5
+      znn       = -1.
+      rn_sc_tke = 2.
+      rn_sc_psi = 2.
+      rn_psi1 = 0.555
+      rn_psi3p = 1.
+      rn_psi2  = 0.833
+      !
+        SELECT CASE ( nn_stab_func )
+        !
+        CASE( 0, 1 )               ! G88 or KC stability functions
+           rn_psi3m = -0.58
+        CASE( 2 )                  ! Canuto A stability functions
+           rn_psi3m = -0.64
+        CASE( 3 )                  ! Canuto B stability functions
+           rn_psi3m = -0.64        ! caution : constant not identified
+        END SELECT
+      !
+      CASE( 3 )               ! gen
+      !
+      IF(lwp) WRITE(numout,*) 'The choosen closure is generic'
+      zpp       = 2.
+      zmm       = 1.
+      znn       = -0.67
+      rn_sc_tke = 0.8
+      rn_sc_psi = 1.07
+      rn_psi1 = 1.
+      rn_psi3p = 1.
+      rn_psi2  = 1.22
+      !
+        SELECT CASE ( nn_stab_func )
+        !
+        CASE( 0, 1 )               ! G88 or KC stability functions
+           rn_psi3m = 0.1
+        CASE( 2 )                  ! Canuto A stability functions
+           rn_psi3m = 0.05
+        CASE( 3 )                  ! Canuto B stability functions
+           rn_psi3m = 0.05         ! caution : constant not identified
+        END SELECT
+      !
+      END SELECT
+
+      ! Initialisation of the parameters of the stability functions
+      ! -----------------------------------------------------------
+      !
+      SELECT CASE ( nn_stab_func )
+      !
+      CASE ( 0 )             ! Galperin stability functions
+      !
+      IF(lwp) WRITE(numout,*) 'Stability functions from Galperin'
+      rn_c2 = 0.
+      rn_c3 = 0.
+      rn_c_diff = 1.
+      rn_c0     = 0.5544
+      rn_cm_sf = 0.9884
+      rn_ghmin = -0.28
+      rn_gh0   = 0.0233
+      rn_ghcri = 0.02
+      !
+      CASE ( 1 )             ! Kantha-Clayson stability functions
+      !
+      IF(lwp) WRITE(numout,*) 'Stability functions from Kantha-Clayson'
+      rn_c2 = 0.7
+      rn_c3 = 0.2
+      rn_c_diff = 1.
+      rn_c0     = 0.5544
+      rn_cm_sf = 0.9884
+      rn_ghmin = -0.28
+      rn_gh0   = 0.0233
+      rn_ghcri = 0.02
+      !
+      CASE ( 2 )             ! Canuto A stability functions
+      !
+      IF(lwp) WRITE(numout,*) 'Stability functions from Canuto A'
+      rn_s0 = 1.5*rn_l1*rn_l5**2.
+      rn_s1 = -rn_l4*(rn_l6+rn_l7) + 2.*rn_l4*rn_l5*(rn_l1-(1./3.)*rn_l2-rn_l3)+1.5*rn_l1*rn_l5*rn_l8
+      rn_s2 = -(3./8.)*rn_l1*(rn_l6**2.-rn_l7**2.)
+      rn_s4 = 2.*rn_l5
+      rn_s5 = 2.*rn_l4
+      rn_s6 = (2./3.)*rn_l5*(3.*rn_l3**2.-rn_l2**2.)-0.5*rn_l5*rn_l1*(3.*rn_l3-rn_l2)+0.75*rn_l1*(rn_l6-rn_l7)
+      rn_d0 = 3*rn_l5**2.
+      rn_d1 = rn_l5*(7.*rn_l4+3.*rn_l8)
+      rn_d2 = rn_l5**2.*(3.*rn_l3**2.-rn_l2**2.)-0.75*(rn_l6**2.-rn_l7**2.)
+      rn_d3 = rn_l4*(4.*rn_l4+3.*rn_l8)
+      rn_d4 = rn_l4*(rn_l2*rn_l6-3.*rn_l3*rn_l7-rn_l5*(rn_l2**2.-rn_l3**2.))+rn_l5*rn_l8*(3.*rn_l3**2.-rn_l2**2.)
+      rn_d5 = 0.25*(rn_l2**2.-3.*rn_l3**2.)*(rn_l6**2.-rn_l7**2.)
+      rn_c0 = 0.5268
+      rn_f6 = 8. / (rn_c0**6.)
+      rn_c_diff = SQRT(2.)/(rn_c0**3.)
+      rn_cm_sf = 0.7310
+      rn_ghmin = -0.28
+      rn_gh0   = 0.0329
+      rn_ghcri = 0.03
+      !
+      CASE ( 3 )             ! Canuto B stability functions
+      !
+      IF(lwp) WRITE(numout,*) 'Stability functions from Canuto B'
+      rn_s0 = 1.5*rn_m1*rn_m5**2.
+      rn_s1 = -rn_m4*(rn_m6+rn_m7) + 2.*rn_m4*rn_m5*(rn_m1-(1./3.)*rn_m2-rn_m3)+1.5*rn_m1*rn_m5*rn_m8
+      rn_s2 = -(3./8.)*rn_m1*(rn_m6**2.-rn_m7**2.)
+      rn_s4 = 2.*rn_m5
+      rn_s5 = 2.*rn_m4
+      rn_s6 = (2./3.)*rn_m5*(3.*rn_m3**2.-rn_m2**2.)-0.5*rn_m5*rn_m1*(3.*rn_m3-rn_m2)+0.75*rn_m1*(rn_m6-rn_m7)
+      rn_d0 = 3*rn_m5**2.
+      rn_d1 = rn_m5*(7.*rn_m4+3.*rn_m8)
+      rn_d2 = rn_m5**2.*(3.*rn_m3**2.-rn_m2**2.)-0.75*(rn_m6**2.-rn_m7**2.)
+      rn_d3 = rn_m4*(4.*rn_m4+3.*rn_m8)
+      rn_d4 = rn_m4*(rn_m2*rn_m6-3.*rn_m3*rn_m7-rn_m5*(rn_m2**2.-rn_m3**2.))+rn_m5*rn_m8*(3.*rn_m3**2.-rn_m2**2.)
+      rn_d5 = 0.25*(rn_m2**2.-3.*rn_m3**2.)*(rn_m6**2.-rn_m7**2.)
+      rn_c0 = 0.5268  !!       rn_c0 = 0.5540 (Warner ...) to verify !
+      rn_f6 = 8. / (rn_c0**6.)
+      rn_c_diff = SQRT(2.)/(rn_c0**3.)
+      rn_cm_sf = 0.7470
+      rn_ghmin = -0.28
+      rn_gh0   = 0.0444
+      rn_ghcri = 0.0414
+      !
+      END SELECT
+    
+      ! Set Schmidt number for psi diffusion
+      ! In the wave breaking case
+      ! See equation 13 of Carniel et al, Ocean modelling, 30, 225-239, 2009
+      ! or equation (17) of Burchard, JPO, 31, 3133-3145, 2001
+      IF ((ln_sigpsi).AND.(ln_crban)) THEN
+         zcr = SQRT(1.5*rn_sc_tke) * rn_cm_sf /vkarmn
+         rn_sc_psi0 = vkarmn**2/(rn_psi2*rn_cm_sf**2) *              & 
+        &             (  znn**2 - 4./3.*zcr*znn*zmm - 1./3.*zcr*znn  &
+        &              + 2./9.*zmm*zcr**2 + 4./9.*zcr**2*zmm**2)                                 
+      ELSE
+         rn_sc_psi0 = rn_sc_psi
+      ENDIF
+ 
+      ! Shear free turbulence parameters:
+      !
+      rn_a_sf  = -4.*znn*SQRT(rn_sc_tke) / ( (1.+4.*zmm)*SQRT(rn_sc_tke) &
+               &                              - SQRT(rn_sc_tke + 24.*rn_sc_psi0*rn_psi2 ) )
+      rn_l_sf  = rn_c0 * SQRT(rn_c0/rn_cm_sf) * SQRT( ( (1. + 4.*zmm + 8.*zmm**2)*rn_sc_tke       &
+               &                                          + 12. * rn_sc_psi0*rn_psi2 - (1. + 4.*zmm) &
+               &                                          *SQRT(rn_sc_tke*(rn_sc_tke                &
+               &                                                + 24.*rn_sc_psi0*rn_psi2)) )         &
+               &                                          /(12.*znn**2.) &
+               &                                       )
+
+      ! Control print
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'Limit values'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) 'Parameter  m = ',zmm
+         WRITE(numout,*) 'Parameter  n = ',znn
+         WRITE(numout,*) 'Parameter  p = ',zpp
+         WRITE(numout,*) 'rn_psi1   = ',rn_psi1
+         WRITE(numout,*) 'rn_psi2   = ',rn_psi2
+         WRITE(numout,*) 'rn_psi3m  = ',rn_psi3m
+         WRITE(numout,*) 'rn_psi3p  = ',rn_psi3p
+         WRITE(numout,*) 'rn_sc_tke = ',rn_sc_tke
+         WRITE(numout,*) 'rn_sc_psi = ',rn_sc_psi
+         WRITE(numout,*) 'rn_sc_psi0 = ',rn_sc_psi0
+         WRITE(numout,*) 'rn_c0     = ',rn_c0
+         WRITE(numout,*)
+         WRITE(numout,*) 'Shear free turbulence parameters:'
+         WRITE(numout,*) 'rn_cm_sf  = ',rn_cm_sf
+         WRITE(numout,*) 'rn_a_sf   = ',rn_a_sf
+         WRITE(numout,*) 'rn_l_sf   = ',rn_l_sf
+         WRITE(numout,*)
+      ENDIF
+
+      ! Constants initialization
+      rn_c02r = 1. / rn_c0**2.
+      rn_c02  = rn_c0**2._wp
+      rn_c03  = rn_c0**3._wp
+      rn_c04  = rn_c0**4._wp
+      rn_c03_sqrt2_galp = rn_c03 / SQRT(2._wp) / clim_galp
+      rn_sbc_mb   = 0.5 * (15.8*rn_crban)**(2./3.) ! Surf. bound. cond. from Mellor and Blumberg
+      rn_sbc_std  = 3.75                           ! Surf. bound. cond. standard (prod=diss)
+      rn_sbc_tke1 = (-rn_sc_tke*rn_crban/(rn_cm_sf*rn_a_sf*rn_l_sf))**(2./3.) ! k_eps = 53.  Dirichlet + Wave breaking 
+      rn_sbc_tke2 = 0.5 / rau0
+      rn_sbc_tke3 = rdt * rn_crban                                                         ! Neumann + Wave breaking
+      rn_sbc_zs   = rn_charn/grav                                                          ! Charnock formula
+      rn_sbc_psi1 = rn_c0**zpp * rn_sbc_tke1**zmm * rn_l_sf**znn                           ! Dirichlet + Wave breaking
+      rn_sbc_psi2 = -0.5 * rdt * rn_c0**zpp * znn * vkarmn**znn / rn_sc_psi                   ! Neumann + NO Wave breaking 
+      rn_sbc_psi3 = -0.5 * rdt * rn_c0**zpp * rn_l_sf**znn / rn_sc_psi  * (znn + zmm*rn_a_sf) ! Neumann + Wave breaking
+      zfact_tke = -0.5 / rn_sc_tke * rdt               ! Cst used for the Diffusion term of tke
+      zfact_psi = -0.5 / rn_sc_psi * rdt               ! Cst used for the Diffusion term of tke
+
+      ! Wall proximity function
+      zwall (:,:,:) = 1._wp * tmask(:,:,:)
+
+      !                               !* set vertical eddy coef. to the background value
+      DO jk = 1, jpk
+         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
+         avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+      END DO
+      !                               !* read or initialize all required files 
+      CALL gls_rst( nit000, 'READ' )
+      !
+   END SUBROUTINE zdf_gls_init
+
+   SUBROUTINE gls_rst( kt, cdrw )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE ts_rst  ***
+     !!                     
+     !! ** Purpose :   Read or write TKE file (en) in restart file
+     !!
+     !! ** Method  :   use of IOM library
+     !!                if the restart does not contain TKE, en is either 
+     !!                set to rn_emin or recomputed (nn_igls/=0)
+     !!----------------------------------------------------------------------
+     INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+     CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+     !
+     INTEGER ::   jit, jk   ! dummy loop indices
+     INTEGER ::   id1, id2, id3, id4, id5, id6, id7, id8
+     INTEGER ::   ji, jj, ikbu, ikbv, ikbum1, ikbvm1
+     REAL(wp)::   cbx, cby
+     !!----------------------------------------------------------------------
+     !
+     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
+        !                                   ! ---------------
+        IF( ln_rstart ) THEN                   !* Read the restart file
+           id1 = iom_varid( numror, 'en'   , ldstop = .FALSE. )
+           id2 = iom_varid( numror, 'avt'  , ldstop = .FALSE. )
+           id3 = iom_varid( numror, 'avm'  , ldstop = .FALSE. )
+           id4 = iom_varid( numror, 'avmu' , ldstop = .FALSE. )
+           id5 = iom_varid( numror, 'avmv' , ldstop = .FALSE. )
+           id6 = iom_varid( numror, 'mxln' , ldstop = .FALSE. )
+           id7 = iom_varid( numror, 'wbotu', ldstop = .FALSE. )
+           id8 = iom_varid( numror, 'wbotv', ldstop = .FALSE. )
+           !
+           IF( MIN( id1, id2, id3, id4, id5, id6, id7, id8 ) > 0 ) THEN        ! all required arrays exist
+              CALL iom_get( numror, jpdom_autoglo, 'en'    , en     )
+              CALL iom_get( numror, jpdom_autoglo, 'avt'   , avt    )
+              CALL iom_get( numror, jpdom_autoglo, 'avm'   , avm    )
+              CALL iom_get( numror, jpdom_autoglo, 'avmu'  , avmu   )
+              CALL iom_get( numror, jpdom_autoglo, 'avmv'  , avmv   )
+              CALL iom_get( numror, jpdom_autoglo, 'mxln'  , mxln   )
+              CALL iom_get( numror, jpdom_autoglo, 'wbotu' , wbotu  )
+              CALL iom_get( numror, jpdom_autoglo, 'wbotv' , wbotv  )
+           ELSE                        
+              IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop'
+              IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated' 
+              en  (:,:,:) = rn_emin
+              mxln(:,:,:) = 0.001        
+              ! Initialize bottom stresses
+              DO jj = 2, jpjm1
+                DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
+                  ikbum1 = MAX( ikbu-1, 1 )
+                  ikbv   = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
+                  ikbvm1 = MAX( ikbv-1, 1 )
+                  cbx = avmu(ji,jj,ikbu) / fse3uw(ji,jj,ikbu)
+                  cby = avmv(ji,jj,ikbv) / fse3vw(ji,jj,ikbv)
+                  wbotu(ji,jj) = -cbx * un(ji,jj,ikbum1)*umask(ji,jj,1)
+                  wbotv(ji,jj) = -cby * vn(ji,jj,ikbvm1)*vmask(ji,jj,1)
+                END DO
+              END DO
+              DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_gls( jit )   ;   END DO
+           ENDIF
+        ELSE                                   !* Start from rest
+           IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values'
+           IF(lwp) WRITE(numout,*) ' ===>>>> : The bottom stresses are estimated'
+           en  (:,:,:) = rn_emin
+           mxln(:,:,:) = 0.001       
+           ! Initialize bottom stresses
+           DO jj = 2, jpjm1
+             DO ji = fs_2, fs_jpim1   ! vector opt.
+               ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
+               ikbum1 = MAX( ikbu-1, 1 )
+               ikbv   = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
+               ikbvm1 = MAX( ikbv-1, 1 )
+               cbx = avmu(ji,jj,ikbu) / fse3uw(ji,jj,ikbu)
+               cby = avmv(ji,jj,ikbv) / fse3vw(ji,jj,ikbv)
+               wbotu(ji,jj) = -cbx * un(ji,jj,ikbum1)*umask(ji,jj,1)
+               wbotv(ji,jj) = -cby * vn(ji,jj,ikbvm1)*vmask(ji,jj,1)
+             END DO
+           END DO
+        ENDIF
+        !
+     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+        !                                   ! -------------------
+        IF(lwp) WRITE(numout,*) '---- gls-rst ----'
+        CALL iom_rstput( kt, nitrst, numrow, 'en'   , en    )
+        CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt   )
+        CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm   )
+        CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu  )
+        CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv  )
+        CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln  )
+        !
+     ENDIF
+     !
+   END SUBROUTINE gls_rst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        NO TKE scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfgls = .FALSE.   !: TKE flag
+CONTAINS
+   SUBROUTINE zdf_gls( kt )          ! Empty routine
+      WRITE(*,*) 'zdf_gls: You should not have seen this print! error?', kt
+   END SUBROUTINE zdf_gls
+#endif
+
+   !!======================================================================
+END MODULE zdfgls
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 2236)
@@ -20,4 +20,5 @@
    USE zdftke_old      ! TKE vertical mixing  (old scheme)
    USE zdftke          ! TKE vertical mixing
+   USE zdfgls          ! GLS vertical mixing
    USE zdfkpp          ! KPP vertical mixing          
    USE zdfddm          ! double diffusion mixing      
@@ -39,5 +40,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
    
@@ -106,4 +107,8 @@
          ioptio = ioptio+1
       ENDIF
+      IF( lk_zdfgls ) THEN
+         IF(lwp) WRITE(numout,*) '      GLS dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
       IF( lk_zdfkpp ) THEN
          IF(lwp) WRITE(numout,*) '      KPP dependent eddy coefficients'
@@ -128,4 +133,7 @@
          IF(lwp) WRITE(numout,*) '      use the 1.5 turbulent closure'
       ENDIF
+      IF( lk_zdfgls ) THEN
+         IF(lwp) WRITE(numout,*) '      use the GLS closure scheme'
+      ENDIF
       IF( lk_zdfkpp ) THEN
          IF(lwp) WRITE(numout,*) '      use the KPP closure scheme'
@@ -136,6 +144,6 @@
       ENDIF
       IF ( ioptio > 1 .AND. .NOT. lk_esopa )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
-      IF( ioptio == 0 .AND. .NOT.( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfkpp ) ) &
-         CALL ctl_stop( ' except for TKE sor KPP physics, a convection scheme is', &
+      IF( ioptio == 0 .AND. .NOT.( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) ) &
+         CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is', &
          &              ' required: ln_zdfevd or ln_zdfnpc logicals' )
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfkpp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 2236)
@@ -148,5 +148,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 2236)
@@ -31,5 +31,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfric.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 2236)
@@ -46,5 +46,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 2236)
@@ -89,5 +89,5 @@
 
    REAL(wp), DIMENSION(jpi,jpj)     ::   htau      ! depth of tke penetration (nn_htau)
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   en        ! now turbulent kinetic energy   [m2/s2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   en        ! now turbulent kinetic energy   [m2/s2]
    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dissl     ! now mixing lenght of dissipation
 
@@ -98,5 +98,5 @@
    !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 
    !! $Id: $
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftke_old.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftke_old.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftke_old.F90	(revision 2236)
@@ -94,5 +94,5 @@
    !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 2236)
@@ -51,5 +51,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id: $
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/agrif_opa_interp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/agrif_opa_interp.F90	(revision 2230)
+++ 	(revision )
@@ -1,15 +1,0 @@
-MODULE agrif_opa_interp
-   !!======================================================================
-   !!                       ***  MODULE agrif_opa_interp  ***
-   !!  Dummy module
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   Dummy module                                     NO agrif use
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-END MODULE agrif_opa_interp
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/agrif_opa_sponge.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/agrif_opa_sponge.F90	(revision 2230)
+++ 	(revision )
@@ -1,15 +1,0 @@
-MODULE agrif_opa_sponge
-   !!======================================================================
-   !!                       ***  MODULE agrif_opa_sponge  ***
-   !!  Dummy module
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   Dummy module                                     NO agrif use
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-END MODULE agrif_opa_sponge
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/agrif_opa_update.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/agrif_opa_update.F90	(revision 2230)
+++ 	(revision )
@@ -1,15 +1,0 @@
-MODULE agrif_opa_update
-   !!======================================================================
-   !!                       ***  MODULE agrif_opa_update  ***
-   !!  Dummy module
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   Dummy module                                     NO agrif use
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-END MODULE agrif_opa_update
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/greg2jul.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/greg2jul.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/greg2jul.h90	(revision 2236)
@@ -0,0 +1,89 @@
+   SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian, &
+      &                 krefdate )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE greg2jul  ***
+      !!
+      !! ** Purpose : Produce the time relative to the current date and time.
+      !!
+      !! ** Method  : The units are days, so hours and minutes transform to
+      !!              fractions of a day. 
+      !!
+      !!              Reference date : 19500101
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-04  (A. Vidard) Reformatted
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & ksec,   &
+         & kmin,   &
+         & khour,  & 
+         & kday,   &
+         & kmonth, & 
+         & kyear
+      REAL(KIND=dp), INTENT(OUT) :: &
+         & pjulian
+      INTEGER, INTENT(IN), OPTIONAL :: &
+         & krefdate
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 15 + 31 * ( 10 + 12 * 1582 ), &     ! Gregorian calendar introduction date
+         & jporef = 2433283,                      &     ! Julian reference date: 19500101
+         & jparef = 2415021,                      &     ! Julian reference date: 19000101
+         & jpgref = 2299161                             ! Julian reference date start of Gregorian calender
+      INTEGER :: &
+         & ija,     &
+         & ijy,     &
+         & ijm,     &
+         & ijultmp, &
+         & ijyear,  &
+         & iref
+      CHARACTER(len=200) :: &
+         & cerr
+
+      IF ( PRESENT( krefdate ) ) THEN
+         SELECT CASE ( krefdate )
+
+         CASE( 0 ) 
+            iref = jpgref
+
+         CASE( 19500101 )
+            iref = jporef
+
+         CASE( 19000101 )
+            iref = jparef
+
+         CASE DEFAULT
+            WRITE(cerr,'(A,I8.8)')'greg2jul: Unknown krefdate:', krefdate
+            CALL ctl_stop( cerr )
+
+         END SELECT
+
+      ELSE
+         iref = jporef 
+      ENDIF
+
+      ! Main computation
+      ijyear = kyear
+      IF ( ijyear < 0 ) ijyear = ijyear + 1
+      IF ( kmonth > 2 ) THEN
+	 ijy = ijyear
+	 ijm = kmonth + 1
+      ELSE
+	 ijy = ijyear  - 1
+	 ijm = kmonth + 13
+      ENDIF
+      ijultmp = INT( 365.25 * ijy ) + INT( 30.6001 * ijm ) + kday + 1720995
+      IF ( kday + 31 * ( kmonth + 12 * ijyear ) >= jpgreg ) THEN
+	 ija = INT( 0.01 * ijy )
+	 ijultmp = ijultmp + 2 - ija + INT( 0.25 * ija )
+      ENDIF
+      pjulian = ( ijultmp - iref ) + ( ( 60 * khour + kmin ) * 60 + ksec ) / 86400.
+
+   END SUBROUTINE greg2jul
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/istate.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/istate.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/istate.F90	(revision 2236)
@@ -35,5 +35,4 @@
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O library
-   USE c1d             ! re-initialization of u-v mask for the 1D configuration
    USE zpshde          ! partial step: hor. derivative (zps_hde routine)
    USE eosbn2          ! equation of state            (eos bn2 routine)
@@ -56,5 +55,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -128,6 +127,8 @@
          CALL tra_swap                     ! swap 3D arrays (tb,sb,tn,sn)  in a 4D array
          CALL eos( tsb, rhd, rhop )        ! before potential and in situ densities
-         IF( ln_zps .AND. .NOT. lk_c1d )   CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  & ! zps: before hor. gradient
-            &                                                          rhd, gru , grv  )   ! of t,s,rd at ocean bottom
+#if ! defined key_c1d
+         IF( ln_zps )   CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  & ! zps: before hor. gradient
+            &                                       rhd, gru , grv  )   ! of t,s,rd at ocean bottom
+#endif
          !   
          ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/jul2greg.h90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/jul2greg.h90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/jul2greg.h90	(revision 2236)
@@ -0,0 +1,114 @@
+   RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
+      &                           prelday, krefdate )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE jul2greg  ***
+      !!
+      !! ** Purpose : Take the relative time in days and re-express in terms of
+      !!              seconds, minutes, hours, days, month, year.
+      !!
+      !! ** Method  : Reference date : 19500101
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-05  (A. Vidard) Reformatted and refdate      
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT(IN), OPTIONAL :: &
+         & krefdate
+      INTEGER, INTENT(OUT) :: &
+         & ksec,   &
+         & kminut, &
+         & khour,  &
+         & kday,   &
+         & kmonth, &
+         & kyear
+      REAL(KIND=dp), INTENT(IN) :: &
+         & prelday
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 2299161, &
+         & jporef = 2433283, &
+         & jparef = 2415021
+      INTEGER :: &
+         & ijulian, &
+         & ij1,     &
+         & ija,     &
+         & ijb,     &
+         & ijc,     &
+         & ijd,     &
+         & ije,     &
+         & isec,    &
+         & imin,    &
+         & ihou,    &
+         & iday,    &
+         & imon,    &
+         & iyea,    &
+         & iref
+      REAL(KIND=wp) :: &
+         & zday, &
+         & zref
+      CHARACTER(len=200) :: &
+         & cerr
+
+      ! Main computation
+      IF ( PRESENT( krefdate ) ) THEN
+
+         SELECT CASE ( krefdate )
+
+         CASE( 0 ) 
+            iref = jpgreg
+
+         CASE( 19500101 )
+            iref = jporef
+
+         CASE( 19000101 )
+            iref = jparef
+
+         CASE DEFAULT
+            WRITE(cerr,'(A,I8.8)')'jul2greg: Unknown krefdate:', krefdate
+            CALL ctl_stop( cerr )
+
+         END SELECT
+
+      ELSE
+         iref = jporef 
+      ENDIF
+
+      zday = prelday
+      ksec = NINT( 86400. * MOD( zday, 1. ) )
+
+      IF ( ksec < 0. ) ksec = 86400. + ksec
+
+      khour  = ksec / 3600
+      kminut = ( ksec - 3600 * khour ) / 60
+      ksec   = MOD( ksec , 60 )
+
+      ijulian = iref + INT( zday )
+      IF ( zday < 0. ) ijulian = ijulian - 1
+
+      ! If input date after 10/15/1582 :
+      IF ( ijulian >= jpgreg ) THEN
+	 ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 )
+	 ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) )
+      ELSE
+	 ija = ijulian
+      ENDIF
+
+      ijb = ija + 1524
+      ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 )
+      ijd = 365 * ijc + INT( 0.25 * ijc )
+      ije = INT( ( ijb - ijd ) / 30.6001 )
+      kday = ijb - ijd - INT( 30.6001 * ije )
+      kmonth = ije - 1
+      IF ( kmonth > 12 ) kmonth = kmonth - 12
+      kyear = ijc - 4715
+      IF ( kmonth > 2 ) kyear = kyear - 1
+      IF ( kyear <= 0 ) kyear = kyear - 1
+
+   END SUBROUTINE jul2greg
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/julian.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/julian.F90	(revision 2236)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/julian.F90	(revision 2236)
@@ -0,0 +1,30 @@
+MODULE julian
+   !!======================================================================
+   !!                       ***  MODULE julian   ***
+   !! Ocean          : Julian data utilities
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   jul2greg        : Convert relative time to date
+   !!   greg2jul        : Convert date to relative time
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp, &
+      & dp  
+   USE in_out_manager           ! I/O manager
+  
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC jul2greg,        &  ! Convert relative time to date
+      &   greg2jul            ! Convert date to relative time 
+  
+CONTAINS
+ 
+#include "jul2greg.h90"
+
+#include "greg2jul.h90"
+   
+END MODULE julian
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/lib_cray.f90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/lib_cray.f90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/lib_cray.f90	(revision 2236)
@@ -10,5 +10,5 @@
 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
 !!----------------------------------------------------------------------
-     SUBROUTINE wheneq ( i, x, j, t, ind, nn )
+SUBROUTINE wheneq ( i, x, j, t, ind, nn )
         IMPLICIT NONE
 
@@ -28,3 +28,3 @@
         END DO 
 
-     END SUBROUTINE wheneq
+END SUBROUTINE wheneq
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/lib_mpp.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/lib_mpp.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/lib_mpp.F90	(revision 2236)
@@ -71,7 +71,5 @@
    PUBLIC   mpprecv, mppsend, mppscatter, mppgather
    PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl
-#if defined key_oasis3 || defined key_oasis4
    PUBLIC   mppsize, mpprank
-#endif
 
 # if defined key_mpp_rep1
@@ -176,5 +174,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/oce.F90	(revision 2236)
@@ -48,5 +48,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!======================================================================
 END MODULE oce
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/opa.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/opa.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/opa.F90	(revision 2236)
@@ -25,5 +25,6 @@
    !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
    !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
-   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
+   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 
@@ -47,4 +48,10 @@
    USE zdfini
    USE phycst          ! physical constant                  (par_cst routine)
+   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine)
+   USE asminc          ! assimilation increments       (asm_inc_init routine)
+   USE asmtrj          ! writing out state trajectory
+   USE sshwzv          ! vertical velocity used in asm
+   USE diaptr          ! poleward transports           (dia_ptr_init routine)
+   USE diaobs          ! Observation diagnostics       (dia_obs_init routine)
    USE step            ! OPA time-stepping                  (stp     routine)
 #if defined key_oasis3
@@ -53,6 +60,8 @@
    USE cpl_oasis4      ! OASIS4 coupling (not working)
 #endif
+#if defined key_c1d
    USE c1d             ! 1D configuration
    USE step_c1d        ! Time stepping loop for the 1D configuration
+#endif
 #if defined key_top
    USE trcini          ! passive tracer initialisation
@@ -74,5 +83,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -114,10 +123,23 @@
       !                            !-----------------------!
       istp = nit000
-      IF( lk_c1d ) THEN                 !==  1D configuration  ==!
+#if defined key_c1d
          DO WHILE ( istp <= nitend .AND. nstop == 0 )
             CALL stp_c1d( istp )
             istp = istp + 1
          END DO
-      ELSE                              !==  3D ocean with  ==!
+#else
+          IF( lk_asminc ) THEN
+             IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 )    ! Output background fields
+             IF( ln_trjwri ) CALL asm_trj_wri( nit000 - 1 )    ! Output trajectory fields
+             IF( ln_asmdin ) THEN                        ! Direct initialization
+                IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 )    ! Tracers
+                IF( ln_dyninc ) THEN 
+                   CALL dyn_asm_inc( nit000 - 1 )    ! Dynamics
+                   IF ( ln_asmdin ) CALL ssh_wzv ( nit000 - 1 )      ! update vertical velocity 
+                ENDIF
+                IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 )    ! SSH
+             ENDIF
+          ENDIF
+        
          DO WHILE ( istp <= nitend .AND. nstop == 0 )
 #if defined key_agrif
@@ -129,5 +151,7 @@
             IF( lk_mpp )   CALL mpp_max( nstop )
          END DO
-      ENDIF
+#endif
+
+      IF( lk_diaobs ) CALL dia_obs_wri
        
       !                            !------------------------!
@@ -184,5 +208,7 @@
 #else
 # if defined key_oasis3 || defined key_oasis4
-      CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
+      IF( Agrif_Root() ) THEN
+         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
+      ENDIF
       narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt)
 # else
@@ -222,4 +248,11 @@
       ELSE                            ;   CALL mpp_init2     ! eliminate land processors
       ENDIF
+!!gm c1d case can be moved in dom_init routine
+#if defined key_c1d
+         CALL cor_c1d                            ! Coriolis defined at T-point
+         umask(:,:,:) = tmask(:,:,:)             ! U, V and T-points are the same
+         vmask(:,:,:) = tmask(:,:,:)             ! 
+#endif
+!!gm c1d end
 
       !                                      ! General initialization
@@ -282,4 +315,11 @@
                             CALL dia_hsb_init   ! heat content, salt content and volume budgets
                             CALL trd_mod_init   ! Mixed-layer/Vorticity/Integral constraints trends
+      IF( lk_diaobs    ) THEN
+         CALL dia_obs_init                  ! Initialize observational data
+         CALL dia_obs( nit000 - 1 )         ! Observation operator for restart
+      ENDIF      
+      IF( lk_asminc    )    CALL asm_inc_init     ! Initialize assimilation increments
+      IF(lwp) WRITE(numout,*)'Euler time step switch is ', neuler
+
       !
    END SUBROUTINE opa_init
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/par_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/par_oce.F90	(revision 2236)
@@ -18,7 +18,21 @@
    !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
 #if ! defined key_mpp_dyndist 
-   INTEGER, PUBLIC, PARAMETER ::   jpni   = 1   !: number of processors following i 
-   INTEGER, PUBLIC, PARAMETER ::   jpnj   = 1   !: number of processors following j
-   INTEGER, PUBLIC, PARAMETER ::   jpnij  = 1   !: nb of local domain = nb of processors ( <= jpni x jpnj )
+   INTEGER, PUBLIC, PARAMETER ::    &  !:
+# if ! defined key_nproci
+      jpni   = 1,                   &  !: number of processors following i
+      jpnj   = 1,                   &  !: number of processors following j
+      jpnij  = 1                       !: nb of local domain = nb of processors 
+      !                                !  ( <= jpni x jpnj )
+# else
+      jpni   = key_nproci,          &  !: number of processors following i
+      jpnj   = key_nprocj,          &  !: number of processors following j
+#  if ! defined key_nprocij
+      jpnij  = key_nproci * key_nprocj !: nb of local domain = nb of processors 
+      !                                !  ( <= jpni x jpnj )
+#  else
+      jpnij  = key_nprocij             !: nb of local domain = nb of processors 
+      !                                !  ( <= jpni x jpnj )
+#  endif
+# endif
 #else
    INTEGER, PUBLIC            ::   jpni         !: number of processors following i 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/step.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/step.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/step.F90	(revision 2236)
@@ -21,5 +21,6 @@
    !!            3.2  !  2009-02  (G. Madec, R. Benshila)  reintroduicing z*-coordinate
    !!             -   !  2009-06  (S. Masson, G. Madec)  TKE restart compatible with key_cpl
-   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
+   !!            3.3  !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!----------------------------------------------------------------------
 
@@ -32,4 +33,13 @@
 #endif
 
+   USE asminc          ! assimilation increments    (tra_asm_inc, dyn_asm_inc routines)
+   USE stpctl          ! time stepping control            (stp_ctl routine)
+   USE restart         ! ocean restart                    (rst_wri routine)
+   USE prtctl          ! Print control                    (prt_ctl routine)
+
+#if defined key_agrif
+   USE agrif_opa_sponge ! Momemtum and tracers sponges
+#endif
+
    IMPLICIT NONE
    PRIVATE
@@ -43,5 +53,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
@@ -112,4 +122,5 @@
       IF( lk_zdftke_old )   CALL zdf_tke_old( kstp )  ! TKE closure scheme for Kz (old scheme)
       IF( lk_zdftke     )   CALL zdf_tke    ( kstp )  ! TKE closure scheme for Kz
+      IF( lk_zdfgls     )   CALL zdf_gls    ( kstp )  ! GLS closure scheme for Kz
       IF( lk_zdfkpp     )   CALL zdf_kpp    ( kstp )  ! KPP closure scheme for Kz
       IF( lk_zdfcst     )   THEN                      ! Constant Kz (reset avt, avm[uv] to the background value)
@@ -131,4 +142,6 @@
                                                       ! write tke information in the restart file
       IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
+                                                      ! write gls information in the restart file
+      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' )
       !
       !  LATERAL  PHYSICS 
@@ -138,5 +151,10 @@
          IF( ln_zps )    CALL zps_hde( kstp, jpts, tsb, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
             &                                      rhd, gru , grv  )      ! of t, s, rd at the last ocean level
+         IF ( .NOT. ln_traldf_grif ) THEN
                          CALL ldf_slp( kstp, rhd, rn2b )        ! before slope of the lateral mixing
+         ELSE
+                         CALL ldf_slp_grif( kstp )
+                         IF ( ln_dynldf_bilap .OR. ln_dynldf_iso ) CALL ldf_slp( kstp, rhd, rn2b )
+      ENDIF
       ENDIF
 #if defined key_traldf_c2d
@@ -152,4 +170,5 @@
       IF( lk_diahdy  )   CALL dia_hdy( kstp )         ! dynamical heigh diagnostics
       IF( lk_diafwb  )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
+      IF( lk_diaobs  )   CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics
       IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics
       IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag
@@ -168,4 +187,6 @@
                              tsa(:,:,:,:) = 0.e0               ! set tracer trends to zero
 
+      IF(  ln_asmiau .AND. &
+         & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment
                              CALL tra_sbc    ( kstp )       ! surface boundary condition
       IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr
@@ -206,4 +227,6 @@
                                va(:,:,:) = 0.e0
 
+      IF(  ln_asmiau .AND. &
+         & ln_dyninc     )     CALL dyn_asm_inc( kstp )       ! apply dynamics assimilation increment
                                CALL dyn_adv( kstp )         ! advection (vector or flux form)
                                CALL dyn_vor( kstp )         ! vorticity term including Coriolis
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/stpctl.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/stpctl.F90	(revision 2236)
@@ -29,5 +29,5 @@
    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/trc_oce.F90
===================================================================
--- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/trc_oce.F90	(revision 2230)
+++ branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/trc_oce.F90	(revision 2236)
@@ -40,5 +40,5 @@
    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt) 
    !!----------------------------------------------------------------------
 
