SUBROUTINE surface_coupler

!------------------------------------------------------------------------------!
! Actual revisions:
! -----------------
! 
!
! Former revisions:
! ------------------
! $Id: surface_coupler.f90 102 2007-07-27 09:09:17Z raasch $
!
! Initial revision
!
! Description:
! ------------
! Data exchange at the interface between coupled models
!------------------------------------------------------------------------------!

    USE arrays_3d
    USE control_parameters
    USE cpulog
    USE grid_variables
    USE indices
    USE interfaces
    USE pegrid

    IMPLICIT NONE

    INTEGER ::  k

    REAL    ::  simulated_time_remote

#if defined( __parallel )  &&  defined( __mpi2 )

    CALL cpu_log( log_point(39), 'surface_coupler', 'start' )

!
!-- First exchange the current simulated time between the models,
!-- currently just for testing
    CALL MPI_SEND( simulated_time, 1, MPI_REAL, myid, 11, comm_inter, ierr )
    CALL MPI_RECV( simulated_time_remote, 1, MPI_REAL, myid, 11, &
                   comm_inter, status, ierr )
    WRITE ( 9, * )  simulated_time, ' remote: ', simulated_time_remote
    CALL local_flush( 9 )

!
!-- Exchange the interface data
    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN

!
!--    Send heat flux at bottom surface to the ocean model
       WRITE ( 9, * )  '*** send shf to ocean'
       CALL local_flush( 9 )
       CALL MPI_SEND( shf(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
                      comm_inter, ierr )
       WRITE ( 9, * )  '    ready'
       CALL local_flush( 9 )

!
!--    Receive temperature at the bottom surface from the ocean model
       WRITE ( 9, * )  '*** receive pt from ocean'
       CALL local_flush( 9 )
       CALL MPI_RECV( pt(0,nys-1,nxl-1), 1, type_xy, myid, 13, comm_inter, &
                      status, ierr )
       WRITE ( 9, * )  '    ready'
       CALL local_flush( 9 )

!
!--    Send the momentum flux (u) at bottom surface to the ocean model
       WRITE ( 9, * )  '*** send usws to ocean'
       CALL local_flush( 9 )
       CALL MPI_SEND( usws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 14, &
                      comm_inter, ierr )
       WRITE ( 9, * )  '    ready'
       CALL local_flush( 9 )

!
!--    Send the momentum flux (v) at bottom surface to the ocean model
       WRITE ( 9, * )  '*** send vsws to ocean'
       CALL local_flush( 9 )
       CALL MPI_SEND( vsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
                      comm_inter, ierr )
       WRITE ( 9, * )  '    ready'
       CALL local_flush( 9 )

    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN

!
!--    Receive heat flux at the sea surface (top) from the atmosphere model
       WRITE ( 9, * )  '*** receive tswst from atmosphere'
       CALL local_flush( 9 )
       CALL MPI_RECV( tswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
                      comm_inter, status, ierr )
       WRITE ( 9, * )  '    ready'
       CALL local_flush( 9 )

!
!--    Adjust the kinematic heat flux with respect to ocean density
!--    (constants are the specific heat capacities for air and water)
       tswst = tswst / rho_surface * 1005.0 / 4218.0

!
!--    Send sea surface temperature to the atmosphere model
       WRITE ( 9, * )  '*** send pt to atmosphere'
       CALL local_flush( 9 )
       CALL MPI_SEND( pt(nzt,nys-1,nxl-1), 1, type_xy, myid, 13, comm_inter, &
                      ierr )
       WRITE ( 9, * )  '    ready'
       CALL local_flush( 9 )

!
!--    Receive momentum flux (u) at the sea surface (top) from the atmosphere
!--    model
       WRITE ( 9, * )  '*** receive uswst from atmosphere'
       CALL local_flush( 9 )
       CALL MPI_RECV( uswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 14, &
                      comm_inter, status, ierr )
       WRITE ( 9, * )  '    ready'
       CALL local_flush( 9 )

!
!--    Receive momentum flux (v) at the sea surface (top) from the atmosphere
!--    model
       WRITE ( 9, * )  '*** receive vswst from atmosphere'
       CALL local_flush( 9 )
       CALL MPI_RECV( vswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
                      comm_inter, status, ierr )
       WRITE ( 9, * )  '    ready'
       CALL local_flush( 9 )

!
!--    Adjust the momentum fluxes with respect to ocean density
       uswst = uswst / rho_surface
       vswst = vswst / rho_surface

    ENDIF

    CALL cpu_log( log_point(39), 'surface_coupler', 'stop' )

#endif

 END SUBROUTINE surface_coupler