!****************************************************************
!
      subroutine tide_saveobcew(xe2,u,v,obc_numr)
!
!****************************************************************
!
!     objet    : ecriture d un fichier de conditions aux limites
!                en niveau, vitesse pour le rang suivant
!
!     appelant         : main
!                      :
!     appeles          :
!     canal d ecriture : 23
!     canal de lecture :
!     cle cpp          : key_tide_saverotatedobc
!                      :
!     variables in     : x, u, v, obcnumr
!                      :
!     variables out    :
!                      :
!     variables inout  :
!
! Commentaire V. Garnier
! Attention, les inde doivent etre definis a chaque pas de temps
!                                          et a partir de u et v
! Ne jamais tester a partir de hx et hy : imaginons une digue decouvrante,
! en ce point xe=-h0 et sera tres different de xe=(xe(j+1)+xe(j-1))/2
!&E       !  2008-08 (P. Karleskind) simultaneous saving of obc for different child grids
!&E       !  2010-05 (F. Vandermeirch) Saving of two rows or columns for velocity variables
!***********************************************************
!
USE parameters
use comvars2d
use comsubstance
use comvars3d
implicit none
!
integer                                      :: j,jj,j1,j2
integer                                      :: obc_numr,ie,iw,js,jn,obc_ind23
integer,dimension(jmin:jmax)                 :: inde
real(kind=riosh),dimension(jmin:jmax)        :: xe_w,xe_e,v_w,v_e
real(kind=riosh),dimension(1:2,jmin:jmax) :: u_w,u_e
real(kind=rsh),dimension(imin:imax,jmin:jmax):: xe2,x,u,v
!
!************************************************************
!     Executable statements
!************************************************************
!
      where(h0_g(:,:)/=-valmanq) x(:,:)=xe2(:,:)
      where(h0_g(:,:)==-valmanq) x(:,:)=mslshift
!
      xe_w(:) = rg_valmanq_io
      xe_e(:) = rg_valmanq_io
      u_w(:,:) = 0.0_riosh
      u_e(:,:) = 0.0_riosh
      v_w(:) = 0.0_riosh
      v_e(:) = 0.0_riosh
      inde(:) = 0
!
! save indexes of obc for each child grid
      ie=obcrk_ie(obc_numr)
      iw=obcrk_iw(obc_numr)
      js=obcrk_js(obc_numr)
      jn=obcrk_jn(obc_numr)

      do j=js,jn
       if( v(iw,j-1)==0.0_rsh .and. v(iw,j)==0.0_rsh .and. u(iw,j)==0.0_rsh ) then
        inde(j)=0
       else
        inde(j)=1
       endif
      enddo
!
      do j=js,jn
       if(inde(j) == 0)then
        if(inde(j-1) == 0)then
         if(inde(j+1) == 0)then
          xe_w(j)=xe_w(j-1)
          u_w(1,j)=0.0_riosh
          v_w(j)=0.0_riosh
         else
          if(inde(j+2) == 0)then
           xe_w(j)=x(iw,j+1)
           v_w(j)=0.0_riosh
           u_w(1,j)=(u(iw,j+1)+u(iw-1,j+1))*0.5_riosh
          else
           xe_w(j)=2.0_riosh*x(iw,j+1)-x(iw,j+2)
           v_w(j)=-0.5_riosh*v(iw,j+1)
           u_w(1,j)=u(iw,j+1)+u(iw-1,j+1)-0.5_riosh*(u(iw,j+2)+u(iw-1,j+2))
          endif
         endif
        else
         if(inde(j+1) == 0)then
          if(inde(j-2) == 0)then
           xe_w(j)=x(iw,j-1)
           v_w(j)=0.0_riosh
           u_w(1,j)=(u(iw,j-1)+u(iw-1,j-1))*0.5_riosh
          else
           xe_w(j)=2.0_riosh*x(iw,j-1)-x(iw,j-2)
           v_w(j)=-0.5_riosh*v(iw,j-2)
           u_w(1,j)=u(iw,j-1)+u(iw-1,j-1)-0.5_riosh*(u(iw,j-2)+u(iw-1,j-2))
          endif
         else
          xe_w(j)=0.5_riosh*(x(iw,j+1)+x(iw,j-1))
          v_w(j)=-0.25_riosh*(v(iw,j-1)+v(iw,j+1))
          u_w(1,j)=0.25_riosh*(u(iw,j-1)+u(iw-1,j-1)+u(iw,j+1)+u(iw-1,j+1))
         endif
        endif
       else
        xe_w(j)=x(iw,j)
        v_w(j)=v(iw,j)
        u_w(1,j)=u(iw-1,j)
        u_w(2,j)=u(iw,j)
       endif
      enddo
!
      inde(:) = 0
!
      do j=js,jn
       if( v(ie,j-1)==0.0_rsh .and. v(ie,j)==0.0_rsh .and. u(ie-1,j)==0.0_rsh ) then
        inde(j)=0
       else
        inde(j)=1
       endif
      enddo
!
      do j=js,jn
       if(inde(j) == 0)then
        if(inde(j-1) == 0)then
         if(inde(j+1) == 0)then
           xe_e(j)=xe_e(j-1)
           u_e(2,j)=0.0_riosh
           v_e(j)=0.0_riosh
         else
           if(inde(j+2) == 0)then
             xe_e(j)=x(ie,j+1)
             v_e(j)=0.0_riosh
             u_e(2,j)=(u(ie,j+1)+u(ie-1,j+1))*0.5_riosh
           else
             xe_e(j)=2.0_riosh*x(ie,j+1)-x(ie,j+2)
             v_e(j)=-0.5_riosh*v(ie,j+1)
             u_e(2,j)=u(ie,j+1)+u(ie-1,j+1)-0.5_riosh*(u(ie,j+2)+u(ie-1,j+2))
           endif
         endif
        else
         if(inde(j+1) == 0)then
          if(inde(j-2) == 0)then
           xe_e(j)=x(ie,j-1)
           v_e(j)=0.0_riosh
           u_e(2,j)=(u(ie,j-1)+u(ie-1,j-1))*0.5_riosh
          else
! j-2 et j-1 au lieu de j et j-1 ?
           xe_e(j)=2.0_riosh*x(ie,j-1)-x(ie,j)
           v_e(j)=-0.5_riosh*v(ie,j-2)
           u_e(2,j)=u(ie,j-1)+u(ie-1,j-1)-0.5_riosh*(u(ie,j-2)+u(ie-1,j-2))
          endif
         else
          xe_e(j)=0.5_riosh*(x(ie,j+1)+x(ie,j-1))
          v_e(j)=-0.25_riosh*(v(ie,j-1)+v(ie,j+1))
          u_e(2,j)=0.25_riosh*(u(ie,j-1)+u(ie-1,j-1)+u(ie,j+1)+u(ie-1,j+1))
         endif
        endif
       else
        xe_e(j)=x(ie,j)
        v_e(j)=v(ie,j)
        u_e(2,j)=u(ie,j)
        u_e(1,j)=u(ie-1,j)
       endif
      enddo
!
! open boundary value set to valmanq if larger than 25 meter height
!
      do j=js,jn
       xe_w(j)=min(xe_w(j),rg_valmanq_io)
       if(xe_w(j) > 25.0_riosh) xe_w(j)=rg_valmanq_io
       xe_e(j)=min(xe_e(j),rg_valmanq_io)
       if(xe_e(j) > 25.0_riosh) xe_e(j)=rg_valmanq_io
      end do
!
! management of corners
!
      j=js
      do while(xe_w(j)==rg_valmanq_io .and. j<=jn)
       j=j+1
      end do
      if(j/=js.and.j/=jn) then
       do jj=js,j-1
        xe_w(jj)=xe_w(j)          ! southest values set to the first defined south value
       end do
      end if
!
      if(j/=jn) then
      j=jn
      do while(xe_w(j)==rg_valmanq_io .and. j>=js)
       j=j-1
      end do
      if(j/=js.and.j/=jn) then
       do jj=jn,j+1,-1
        xe_w(jj)=xe_w(j)          ! northest values set to first defined northern value
       end do
      else
       goto 96 
      end if
!
      do j=js+1,jn-1
      if(xe_w(j)==rg_valmanq_io) then
        j1=j+1
        do while(xe_w(j1)/=rg_valmanq_io)
         j1=j1+1
        end do
        j2=j-1
        do while(xe_w(j2)/=rg_valmanq_io)
         j2=j2-1
        end do
        xe_w(j)=(real(j1-j,riosh)*xe_w(j2)+real(j-j2,riosh)*xe_w(j1))/real(j1-j2,riosh)  ! linear interpolation from two not consecutive defined values
       end if
      end do
      end if
 96   continue
!
      j=js
      do while(xe_e(j)==rg_valmanq_io .and. j<=jn)
       j=j+1
      end do
      if(j/=js.and.j/=jn) then
       do jj=js,j-1
        xe_e(jj)=xe_e(j)          ! southest values set to the first defined south value
       end do
      end if
!
      if(j/=jn) then
      j=jn
      do while(xe_e(j)==rg_valmanq_io .and. j>=js)
       j=j-1
      end do
      if(j/=js.and.j/=jn) then
       do jj=jn,j+1,-1
        xe_e(jj)=xe_e(j)          ! northest values set to first defined northern value
       end do
      else
       goto 98
      end if
!
      do j=js+1,jn-1
      if(xe_e(j)==rg_valmanq_io) then
        j1=j+1
        do while(xe_e(j1)/=rg_valmanq_io)
         j1=j1+1
        end do
        j2=j-1
        do while(xe_e(j2)/=rg_valmanq_io)
         j2=j2-1
        end do
        xe_e(j)=(real(j1-j,riosh)*xe_e(j2)+real(j-j2,riosh)*xe_e(j1))/real(j1-j2,riosh)  ! linear interpolation from two not consecutive defined values
       end if
      end do
      end if
   98 continue
!
      obc_ind23=obc_numr*100+23 ! index for writing in file fileclsvr
      write(obc_ind23)(xe_w(j),xe_e(j),u_w(1,j),u_w(2,j),v_w(j),u_e(1,j),u_e(2,j),v_e(j),j=js,jn)
!
  200 format(e15.8,200(1x,e10.4))
!
end subroutine tide_saveobcew

