  MODULE tidesaveobcrotated

#ifdef key_tide_saverotatedobc 

   !!======================================================================
   !!                   ***  MODULE comscrip   ***
   !! 
   !!======================================================================
   !! * Modules used
   USE parameters, ONLY : imin,imax,jmin,jmax,imin_child,imax_child,jmin_child,jmax_child, &
                          lchain,rsh,rlg,riosh,valmanq
   USE comvars2d,  ONLY : lon2d,lat2d,lon2du,lon2dv,lat2du,lat2dv

   IMPLICIT NONE

   PRIVATE

   !! * Accessibility
   PUBLIC tide_saveobcrotated          ! routine called by tide_saveobc

   !! * Shared or public module variables
   CHARACTER(len=lchain),PUBLIC                  :: file_fine
   REAL(kind=rsh),DIMENSION(imin_child:imax_child,jmin_child:jmax_child),PUBLIC :: hx_child,hy_child,h0_child
   REAL(kind=rlg),DIMENSION(imin_child:imax_child,jmin_child:jmax_child),PUBLIC :: lon2d_child,lat2d_child,lon2du_child, &
                                                                                   lon2dv_child,lat2du_child,lat2dv_child
   INTEGER,DIMENSION(imin_child:imax_child),PUBLIC :: jh_child,jb_child
   INTEGER,DIMENSION(jmin_child:jmax_child),PUBLIC :: ig_child,id_child

   !! * Privatec module variables
   LOGICAL,DIMENSION(:,:),ALLOCATABLE        :: maskdst,masksrc
   REAL(kind=rlg),DIMENSION(:,:),ALLOCATABLE :: matrix,matrix_u,matrix_v
   REAL(kind=rlg),DIMENSION(:,:),ALLOCATABLE :: tabvar2d,tabinterp2d
   INTEGER,DIMENSION(:),ALLOCATABLE          :: src_add,dst_add,src_add_u,dst_add_u,src_add_v,dst_add_v
   INTEGER                                   :: nxfin,nyfin

  CONTAINS

   !!======================================================================

  SUBROUTINE alloc_scripvar

   !&E---------------------------------------------------------------------
   !&E                 ***  ROUTINE alloc_scripvar  ***
   !&E---------------------------------------------------------------------
   !! * Modules used

   !! * Arguments

   !! * Local declarations

   !!----------------------------------------------------------------------
   !! * Executable part

   ALLOCATE(masksrc(imin:imax,jmin:jmax))              ! source : mother grid
   ALLOCATE(tabvar2d(imin:imax,jmin:jmax))
   ALLOCATE(maskdst(imin_child:imax_child,jmin_child:jmax_child))          ! destination : child grid
   ALLOCATE(tabinterp2d(imin_child:imax_child,jmin_child:jmax_child))
   masksrc(:,:)=.TRUE.
   maskdst(:,:)=.TRUE.
   tabvar2d(:,:)=0.0_rlg

  END SUBROUTINE alloc_scripvar

   !!======================================================================

  SUBROUTINE tide_saveobcrotated(xe2,u,v,obc_numr)

   !&E---------------------------------------------------------------------
   !&E                 ***  ROUTINE tide_saveobcrotated  ***
   !&E
   !&E ** Purpose : write a file containing 2D open boundary fields 
   !&E
   !&E ** Description : interpolate fields on a rotated child grid
   !&E                  The spatial interpolation is bicubic (SCRIP routine)
   !&E
   !&E ** Called by : tide_saveobc
   !&E
   !&E ** External calls : 
   !&E
   !&E ** Used ij-arrays : 
   !&E
   !&E ** Modified variables :
   !&E
   !&E ** Reference :
   !&E
   !&E ** History :
   !&E       !  2010-09  (M. Caillaud) Original code
   !&E       !  2011-01 (R. Ramel Alyotech) Ionc library in fortran 90/95, netcdf4 and MPI
   !&E
   !&E---------------------------------------------------------------------
   !! * Modules used
!   USE parameters
   USE comvars2d,     ONLY : fileclsv,obcrk_nameconf,suffix,nbouc,h0fond,t
   USE bicubic_interp,ONLY : get_remap_bicub,make_bicubic_remap
   USE comvars3d,     ONLY : sig
#ifdef key_MPI_2D
   USE toolmpi,       ONLY : MASTER,correct_rsh
#endif

   !! * Arguments
   INTEGER,                                      INTENT(in) :: obc_numr
   REAL(kind=rsh),DIMENSION(imin:imax,jmin:jmax),INTENT(in) :: xe2,u,v

   !! * Local declarations
   INTEGER                                          :: i,j,k
   REAL(kind=rsh),DIMENSION(imin:imax,jmin:jmax)    :: x
   REAL(kind=rsh),DIMENSION(imin_child:imax_child,jmin_child:jmax_child):: x_child,u_child,v_child
!   REAL(kind=rsh),DIMENSION(imin_child:imax_child,jmin_child:jmax_child):: temp_tab

   CHARACTER(len=lchain) :: fileclsvr
   INTEGER                                      :: obc_ind23
   REAL(kind=riosh),DIMENSION(jmin_child:jmax_child)      :: xe_w,xe_e,v_w,v_e
   REAL(kind=riosh),DIMENSION(1:2,jmin_child:jmax_child)  :: u_w,u_e
   REAL(kind=riosh),DIMENSION(imin_child:imax_child)      :: xe_n,xe_s,u_n,u_s
   REAL(kind=riosh),DIMENSION(imin_child:imax_child,1:2)  :: v_n,v_s

   !!----------------------------------------------------------------------
   !! * Executable part

   ! create and open fileclsv_nameconf
   ! ---------------------------------
   obc_ind23=100*obc_numr+23        ! index for writing in fileclsv_nameconf
   ! add nameconf and suffix to fileclsv
   fileclsvr=TRIM(fileclsv)//TRIM(obcrk_nameconf(obc_numr))//'.'//TRIM(suffix)
   IF (nbouc == 1) OPEN(obc_ind23,file = fileclsvr,form='unformatted')

   ! extrapolation of the ssh over land 
   ! because ssh = valmanq there
   ! ----------------------------------
   x(:,:)=xe2(:,:)
   DO k=1,3                ! must be adaptated
     CALL extrap2d(x,lon2D,lat2D)
   END DO

   ! estimate of the weights for the spatial interpolation
   ! -----------------------------------------------------
   IF (nbouc ==1) THEN
     CALL alloc_scripvar
     nxfin=imax_child+1
     nyfin=jmax_child+1

     !WHERE (x == valmanq) masksrc=.false.
     WHERE (h0_child==-valmanq) maskdst=.FALSE.
     CALL get_remap_bicub(lat2D,lat2D_child,lon2D,lon2D_child,masksrc,maskdst,matrix,src_add,dst_add)
     CALL get_remap_bicub(lat2DU,lat2DU_child,lon2DU,lon2DU_child,masksrc,maskdst,matrix_u,src_add_u,dst_add_u)
     CALL get_remap_bicub(lat2DV,lat2DV_child,lon2DV,lon2DV_child,masksrc,maskdst,matrix_v,src_add_v,dst_add_v)
   ENDIF

   ! spatial interpolation at each haf time step
   ! -------------------------------------------

   ! ssh
   tabvar2d(:,:)=x(:,:)
   CALL make_bicubic_remap(tabvar2d,masksrc,tabinterp2d(imin_child:imax_child,jmin_child:jmax_child), &
                                            nxfin,nyfin,matrix,src_add,dst_add)
   x_child(:,:)=tabinterp2d(:,:) 
   WHERE (h0_child(:,:) == -valmanq) x_child(:,:)=valmanq
   ! zonal barotropic velocity
   tabvar2d(:,:)=u(:,:)
   CALL make_bicubic_remap(tabvar2d,masksrc,tabinterp2d(imin_child:imax_child,jmin_child:jmax_child), &
                                            nxfin,nyfin,matrix_u,src_add_u,dst_add_u)
   u_child(:,:)=tabinterp2d(:,:) 
   WHERE (hx_child(:,:) == -valmanq-h0fond) u_child(:,:)=0.0_rsh
   ! zonal barotropic velocity
   tabvar2d(:,:)=v(:,:)
   CALL make_bicubic_remap(tabvar2d,masksrc,tabinterp2d(imin_child:imax_child,jmin_child:jmax_child), &
                                            nxfin,nyfin,matrix_v,src_add_v,dst_add_v)
   v_child(:,:)=tabinterp2d(:,:) 
   WHERE (hy_child(:,:) == -valmanq-h0fond) v_child(:,:)=0.0_rsh

   !IF (nbouc==1) THEN
   !     CALL ionc4_createfile(file_fine,lon2d,lat2d,       &
   !     &                 imin_child,imax_child,1,jmin_child,jmax_child,1, &
   !     &                 1,kmax,1,kmax,0)
   !     CALL ionc4_createvar(file_fine,'xe','m','xe',0,0,dims='xyt')
   !     CALL ionc4_vatt_fill(file_fine,'xe',valmanq)
   !     CALL ionc4_createvar(file_fine,'u','m/s','u',0,0,dims='xyt')
   !     CALL ionc4_vatt_fill(file_fine,'u',0.0)
   !     CALL ionc4_createvar(file_fine,'v','m/s','v',0,0,dims='xyt')
   !     CALL ionc4_vatt_fill(file_fine,'v',0.0)
   !     CALL ionc4_createvar(file_fine,'H0','m','profondeur',0.0_riosh,0.0_riosh,dims='xy')
   !     temp_tab(:,:)=h0_child(:,:)
   !     CALL ionc4_write_xy(file_fine,'H0',temp_tab,imin_child,imax_child,jmin_child,jmax_child)
   !ENDIF
   !     CALL ionc4_write_time(file_fine,0,t)
   !     temp_tab=x_child
   !     CALL ionc4_write_xyt(file_fine,'xe',temp_tab,imin_child,imax_child,jmin_child,jmax_child,0)
   !     temp_tab=u_child
   !     CALL ionc4_write_xyt(file_fine,'u',temp_tab,imin_child,imax_child,jmin_child,jmax_child,0)
   !     temp_tab=v_child
   !     CALL ionc4_write_xyt(file_fine,'v',temp_tab,imin_child,imax_child,jmin_child,jmax_child,0)

   ! SAVE SSH ON BOUNDARIES
   xe_n(imin_child:imax_child)=(/(x_child(i,jh_child(i)),i=imin_child,imax_child)/)
   xe_s(imin_child:imax_child)=(/(x_child(i,jb_child(i)),i=imin_child,imax_child)/)
   xe_w(jmin_child:jmax_child)=(/(x_child(ig_child(j),j),j=jmin_child,jmax_child)/)
   xe_e(jmin_child:jmax_child)=(/(x_child(id_child(j),j),j=jmin_child,jmax_child)/)

   ! SAVE U ON BOUNDARIES
   u_n(imin_child:imax_child)=(/(u_child(i,jh_child(i)),i=imin_child,imax_child)/)
   u_s(imin_child:imax_child)=(/(u_child(i,jb_child(i)),i=imin_child,imax_child)/)
   u_w(1,jmin_child:jmax_child)=(/(u_child(ig_child(j)-1,j),j=jmin_child,jmax_child)/)
   u_w(2,jmin_child:jmax_child)=(/(u_child(ig_child(j),j),j=jmin_child,jmax_child)/)
   u_e(1,jmin_child:jmax_child)=(/(u_child(id_child(j)-1,j),j=jmin_child,jmax_child)/)
   u_e(2,jmin_child:jmax_child)=(/(u_child(id_child(j),j),j=jmin_child,jmax_child)/)

   ! SAVE V ON BOUNDARIES
   v_w(jmin_child:jmax_child)=(/(v_child(ig_child(j),j),j=jmin_child,jmax_child)/)
   v_e(jmin_child:jmax_child)=(/(v_child(id_child(j),j),j=jmin_child,jmax_child)/)
   v_n(imin_child:imax_child,1)=(/(v_child(i,jh_child(i)-1),i=imin_child,imax_child)/)
   v_n(imin_child:imax_child,2)=(/(v_child(i,jh_child(i)),i=imin_child,imax_child)/)
   v_s(imin_child:imax_child,1)=(/(v_child(i,jb_child(i)-1),i=imin_child,imax_child)/)
   v_s(imin_child:imax_child,2)=(/(v_child(i,jb_child(i)),i=imin_child,imax_child)/)


   WRITE(obc_ind23)t,(xe_n(i),xe_s(i),u_n(i),v_n(i,1),v_n(i,2),u_s(i),v_s(i,1),v_s(i,2),i=imin_child,imax_child)
   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=jmin_child,jmax_child)

  END SUBROUTINE tide_saveobcrotated

   !!======================================================================

  SUBROUTINE extrap2d( val_ogcm, lon_ogcm, lat_ogcm )

   !&E---------------------------------------------------------------------
   !&E                 ***  ROUTINE extrap2d ***
   !&E
   !&E ** Purpose : Spatial extrapolation of coarse data
   !&E
   !&E ** Description :
   !&E
   !&E ** CALLed by : extract_ic or extract_obc
   !&E
   !&E ** External CALLs :
   !&E
   !&E ** Reference :
   !&E
   !&E ** History :
   !&E       !  2007-11  (B. Levier) Original code : application a champs Mercator
   !&E       !  2008-02  (V Garnier) application a chanp mars ou climato
   !&E
   !&E---------------------------------------------------------------------
   !! * Modules USEd
   USE parameters, ONLY :rsh,rlg,imin,imax,jmin,jmax,valmanq

   !! * Arguments
   REAL(KIND=rsh), DIMENSION(imin:imax,jmin:jmax), INTENT(inout)  :: val_ogcm
   REAL(KIND=rlg), DIMENSION(imin:imax,jmin:jmax), INTENT(in)     :: lon_ogcm
   REAL(KIND=rlg), DIMENSION(imin:imax,jmin:jmax), INTENT(in)     :: lat_ogcm

   !! * Local variables
   INTEGER                                             :: i, j
   REAL(KIND=rsh)                                      :: val_2
   REAL(KIND=rsh), DIMENSION(imin:imax,jmin:jmax)  :: val_ogcm_2

   !!----------------------------------------------------------------------
   !! * Executable part
   !print*,'extrap2D'
   val_ogcm_2(:,:) = val_ogcm(:,:)

   DO j = jmin + 1, jmax - 1
     DO i = imin + 1, imax - 1
       IF ( val_ogcm(i,j) == valmanq ) THEN
         CALL eightpoints( val_2, val_ogcm, lon_ogcm, lat_ogcm, i, j )
         val_ogcm_2(i,j) = val_2
       ENDIF
     END DO
   END DO

   val_ogcm(:,:) = val_ogcm_2(:,:)

  END SUBROUTINE extrap2d

   !!======================================================================

  SUBROUTINE eightpoints( val_2, val_ogcm, lon_ogcm, lat_ogcm, ic, jc )

   !&E---------------------------------------------------------------------
   !&E                 ***  ROUTINE eightpoints ***
   !&E
   !&E ** Purpose : weighted average
   !&E
   !&E ** Description :
   !&E
   !&E ** CALLed by : extrap2d or extrap3d
   !&E
   !&E ** External CALLs :
   !&E
   !&E ** Reference :
   !&E
   !&E ** History :
   !&E       !  2007-11  (B. Levier) Original code : application a champs Mercator
   !&E       !  2008-02  (V Garnier) application a chanp mars ou climato
   !&E
   !&E---------------------------------------------------------------------
   !! * Modules USEd
   USE parameters, ONLY :rsh,rlg,imin,imax,jmin,jmax,kmax,valmanq

   !! * Arguments
   INTEGER       , INTENT(in)             :: ic, jc
   REAL(KIND=rsh), DIMENSION(imin:imax,jmin:jmax), INTENT(in)  :: val_ogcm
   REAL(KIND=rlg), DIMENSION(imin:imax,jmin:jmax), INTENT(in)  :: lon_ogcm
   REAL(KIND=rlg), DIMENSION(imin:imax,jmin:jmax), INTENT(in)  :: lat_ogcm
   REAL(KIND=rsh),                                     INTENT(out) :: val_2

   !! * Local variables
   INTEGER                                :: ii, jj
   REAL(KIND=rsh)                         :: val_1, dn1, div_1, &
         lon_a, lon_b, lat_a, lat_b

   !!----------------------------------------------------------------------
   !! * Executable part

   lon_b = lon_ogcm(ic,jc)
   lat_b = lat_ogcm(ic,jc)

   val_1 = 0.0_rsh
   div_1  = 0.0_rsh
   DO jj = jc-1, jc+1
     DO ii = ic-1, ic+1
       IF ( val_ogcm(ii,jj) /= valmanq ) THEN

         lon_a = lon_ogcm(ii,jj)
         lat_a = lat_ogcm(ii,jj)
         CALL dist (lat_a, lon_a, lat_b, lon_b, dn1)
         val_1 = val_1 + val_ogcm(ii,jj) * dn1
         div_1 = div_1 + dn1
       ENDIF
     END DO
   END DO
   IF ( val_1 /= 0.0_rsh .AND. div_1 /= 0.0_rsh ) THEN
     val_2 = val_1 / div_1
   ELSE
     val_2 = valmanq 
   ENDIF

  END SUBROUTINE eightpoints

   !!======================================================================

  SUBROUTINE dist (a,b,c,d,xxd)

   !&E---------------------------------------------------------------------
   !&E                 ***  ROUTINE dist  ***
   !&E
   !&E ** Purpose : calcul de la distance entre deux points definis
   !&E              par leur coorDOnnees geographiques.
   !&E
   !&E ** Description :
   !&E
   !&E ** CALLed by : interpxy
   !&E
   !&E ** External CALLs :
   !&E
   !&E ** Reference :
   !&E
   !&E ** History :
   !&E       !           (P. Garreau ?)  Original code
   !&E       !  2007-02  (V Garnier) fortran 90, dans module
   !&E
   !&E---------------------------------------------------------------------
   USE parameters 

   !! * Arguments
   REAL(KIND=rsh), INTENT( in ) ::   a,b,c,d
   REAL(KIND=rsh), INTENT( out ) ::  xxd

   !! * Local declarations
   REAL(KIND=rsh) :: q,delw,xxe,xxn!,pi

   !!----------------------------------------------------------------------
   !! * Executable part

   !pi=2.0_rsh*dasin(1.0_rlg)
   q=COS((a+c)*pi/360.0_rsh)
   delw=d-b
   IF (delw-180.0_rsh > 0.0_rsh) delw=delw-360.0_rsh
   IF (delw-180.0_rsh < 0.0_rsh .AND. delw+180.0_rsh < 0.0_rsh) delw=delw+360.0_rsh

   xxe=q*delw*60.0_rsh
   xxn=(c-a)*60.0_rsh
   xxd=SQRT(xxe**2+xxn**2)*1852.0_rsh

  END SUBROUTINE dist

#else

  CONTAINS

   !!======================================================================

  SUBROUTINE tide_saveobcrotated
    WRITE(*,*) 'tide_saveobcrotated : You should not have seen this print! error?'
    return
  END SUBROUTINE tide_saveobcrotated
#endif

  END MODULE tidesaveobcrotated
