SUBROUTINE surface_coupler !------------------------------------------------------------------------------! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ------------------ ! $Id: surface_coupler.f90 392 2009-09-24 10:39:14Z suehring $ ! ! 291 2009-04-16 12:07:26Z raasch ! Coupling with independent precursor runs. ! Output of messages replaced by message handling routine. ! ! 206 2008-10-13 14:59:11Z raasch ! Implementation of a MPI-1 Coupling: replaced myid with target_id, ! deleted __mpi2 directives ! ! 109 2007-08-28 15:26:47Z letzel ! 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 :: i, j, k REAL :: time_since_reference_point_rem #if defined( __parallel ) CALL cpu_log( log_point(39), 'surface_coupler', 'start' ) ! !-- In case of model termination initiated by the remote model !-- (terminate_coupled_remote > 0), initiate termination of the local model. !-- The rest of the coupler must then be skipped because it would cause an MPI !-- intercomminucation hang. !-- If necessary, the coupler will be called at the beginning of the next !-- restart run. CALL MPI_SENDRECV( terminate_coupled, 1, MPI_INTEGER, target_id, & 0, & terminate_coupled_remote, 1, MPI_INTEGER, target_id, & 0, comm_inter, status, ierr ) IF ( terminate_coupled_remote > 0 ) THEN WRITE( message_string, * ) 'remote model "', & TRIM( coupling_mode_remote ), & '" terminated', & '&with terminate_coupled_remote = ', & terminate_coupled_remote, & '&local model "', TRIM( coupling_mode ), & '" has', & '&terminate_coupled = ', & terminate_coupled CALL message( 'surface_coupler', 'PA0310', 1, 2, 0, 6, 0 ) RETURN ENDIF ! !-- Exchange the current simulated time between the models, !-- currently just for testing CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, target_id, 11, & comm_inter, ierr ) CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL, target_id, 11, & comm_inter, status, ierr ) WRITE ( 9, * ) 'simulated time: ', simulated_time WRITE ( 9, * ) 'time since start of coupling: ', & time_since_reference_point, ' remote: ', & time_since_reference_point_rem 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, target_id, 12, & comm_inter, ierr ) ! !-- Send humidity flux at bottom surface to the ocean model IF ( humidity ) THEN WRITE ( 9, * ) '*** send qsws to ocean' CALL local_flush( 9 ) CALL MPI_SEND( qsws(nys-1,nxl-1), ngp_xy, MPI_REAL, target_id, 13, & comm_inter, ierr ) ENDIF ! !-- 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, target_id, 14, & comm_inter, status, ierr ) ! !-- 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, target_id, 15, & comm_inter, ierr ) ! !-- 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, target_id, 16, & comm_inter, ierr ) 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, target_id, 12, & comm_inter, status, ierr ) ! !-- Receive humidity flux from the atmosphere model (bottom) !-- and add it to the heat flux at the sea surface (top)... IF ( humidity_remote ) THEN WRITE ( 9, * ) '*** receive qswst_remote from atmosphere' CALL local_flush( 9 ) CALL MPI_RECV( qswst_remote(nys-1,nxl-1), ngp_xy, MPI_REAL, & target_id, 13, comm_inter, status, ierr ) !here tswst is still the sum of atmospheric bottom heat fluxes tswst = tswst + qswst_remote * 2.2626108e6 / 1005.0 !*latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol !/(rho_atm(=1.0)*c_p) ! !-- ...and convert it to a salinity flux at the sea surface (top) !-- following Steinhorn (1991), JPO 21, pp. 1681-1683: !-- S'w' = -S * evaporation / ( rho_water * ( 1 - S ) ) saswst = -1.0 * sa(nzt,:,:) * qswst_remote / & ( rho(nzt,:,:) * ( 1.0 - sa(nzt,:,:) ) ) ENDIF ! !-- Adjust the kinematic heat flux with respect to ocean density !-- (constants are the specific heat capacities for air and water) !now tswst is the ocean top heat flux tswst = tswst / rho(nzt,:,:) * 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, target_id, 14, & comm_inter, ierr ) ! !-- 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, target_id, 15, & comm_inter, status, ierr ) ! !-- 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, target_id, 16, & comm_inter, status, ierr ) ! !-- Adjust the momentum fluxes with respect to ocean density uswst = uswst / rho(nzt,:,:) vswst = vswst / rho(nzt,:,:) ENDIF CALL cpu_log( log_point(39), 'surface_coupler', 'stop' ) #endif END SUBROUTINE surface_coupler