SUBROUTINE surface_coupler !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ------------------ ! $Id: surface_coupler.f90 226 2009-02-02 07:39:34Z letzel $ ! ! 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 :: simulated_time_remote #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 IF ( myid == 0 ) THEN PRINT*, '+++ surface_coupler:' PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & '" terminated' PRINT*, ' with terminate_coupled_remote = ', & terminate_coupled_remote PRINT*, ' local model "', TRIM( coupling_mode ), & '" has' PRINT*, ' terminate_coupled = ', & terminate_coupled ENDIF CALL local_stop RETURN ENDIF ! !-- Exchange the current simulated time between the models, !-- currently just for testing CALL MPI_SEND( simulated_time, 1, MPI_REAL, target_id, 11, & comm_inter, ierr ) CALL MPI_RECV( simulated_time_remote, 1, MPI_REAL, target_id, 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, 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