












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 ! Precision variables
      

   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

   !!----------------------------------------------------------------------
   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
   !! $Id: obs_inter_z1d.F90 10068 2018-08-28 14:09:04Z nicolasmartin $
   !! Software governed by the CeCILL license (see ./LICENSE)
   !!----------------------------------------------------------------------

CONTAINS

!!----------------------------------------------------------------------
   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
   !! $Id: obsinter_z1d.h90 13226 2020-07-02 14:24:31Z orioltp $
   !! Software governed by the CeCILL license (see ./LICENSE)
   !!----------------------------------------------------------------------

   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=dp), INTENT(IN), DIMENSION(kdep) ::  pobsdep


      REAL(KIND=dp), INTENT(IN), DIMENSION(kpk) ::  pobsk, pobs2k, pdep, pobsmask





      REAL(KIND=dp), INTENT(OUT), DIMENSION(kdep) ::  pobs


  
      !! * Local declarations
      REAL(KIND=dp) :: z1dm       ! Distance above and below obs to model grid points
      REAL(KIND=dp) :: z1dp         
      REAL(KIND=dp) :: zsum       ! Dummy variables for computation
      REAL(KIND=dp) :: 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 kkco(jdep) is masked then set pobs(jdep) to the lowest value located above bathymetry
         IF ( pobsmask(kkco(jdep)) == 0.0_wp ) THEN
            pobs(jdep) = pobsk(kkco(jdep)-1)
         ELSE
            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
         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=dp), INTENT(IN), DIMENSION(kpk) ::  pobsk, pdep, pobsmask




      REAL(KIND=dp), INTENT(OUT), DIMENSION(kpk) ::  pobs2k


  
      !! * Local declarations
      INTEGER :: jk
      REAL(KIND=dp) :: za
      REAL(KIND=dp) :: zb
      REAL(KIND=dp) :: zc
      REAL(KIND=dp) :: zpa
      REAL(KIND=dp) :: zkm
      REAL(KIND=dp) :: zkp
      REAL(KIND=dp) :: zk
      REAL(KIND=dp), 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

END MODULE obs_inter_z1d
