MODULE trcsbc !!============================================================================== !! *** MODULE trcsbc *** !! Ocean passive tracers: surface boundary condition !!====================================================================== !! History : 8.2 ! 1998-10 (G. Madec, G. Roullet, M. Imbard) Original code !! 8.2 ! 2001-02 (D. Ludicone) sea ice and free surface !! 8.5 ! 2002-06 (G. Madec) F90: Free form and module !! 9.0 ! 2004-03 (C. Ethe) adapted for passive tracers !! ! 2006-08 (C. Deltel) Diagnose ML trends for passive tracers !!============================================================================== #if defined key_top !!---------------------------------------------------------------------- !! 'key_top' TOP models !!---------------------------------------------------------------------- !! trc_sbc : update the tracer trend at ocean surface !!---------------------------------------------------------------------- USE oce_trc ! ocean dynamics and active tracers variables USE trc ! ocean passive tracers variables USE prtctl_trc ! Print control for debbuging USE trdmod_oce USE trdtra ! MV 2013 USE sbc_oce ! Required to get access to fmmflx USE dom_oce ! Required to get access to r2dtra ! END MV 2013 IMPLICIT NONE PRIVATE PUBLIC trc_sbc ! routine called by step.F90 !! * Substitutions # include "top_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/TOP 3.3 , NEMO Consortium (2010) !! $Id$ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE trc_sbc ( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE trc_sbc *** !! !! ** Purpose : Compute the tracer surface boundary condition trend of !! (concentration/dilution effect) and add it to the general !! trend of tracer equations. !! !! ** Method : !! * concentration/dilution effect: !! The surface freshwater flux modify the ocean volume !! and thus the concentration of a tracer as : !! tra = tra + emp * trn / e3t for k=1 !! where emp, the surface freshwater budget (evaporation minus !! precipitation ) given in kg/m2/s is divided !! by 1035 kg/m3 (density of ocean water) to obtain m/s. !! !! ** Action : - Update the 1st level of tra with the trend associated !! with the tracer surface boundary condition !! !!---------------------------------------------------------------------- ! INTEGER, INTENT( in ) :: kt ! ocean time-step index ! INTEGER :: ji, jj, jn ! dummy loop indices REAL(wp) :: zsrau, zse3t ! temporary scalars CHARACTER (len=22) :: charout REAL(wp), POINTER, DIMENSION(:,: ) :: zsfx REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd ! MV 2013 REAL(wp) :: zswitch , & ! virtual salt flux or vvl zftra , & zcd , & zdtra , & ztfx , & ztra , & zeuler ! euler or leapfrog ! END MV 2013 !!--------------------------------------------------------------------- ! IF( nn_timing == 1 ) CALL timing_start('trc_sbc') ! ! Allocate temporary workspace CALL wrk_alloc( jpi, jpj, zsfx ) IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) ! MV 2013 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect ! (2) embedded sea-ice : salt and volume fluxes and pressure END SELECT ! END MV 2013 IF( kt == nittrc000 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' IF(lwp) WRITE(numout,*) '~~~~~~~ ' ENDIF ! Coupling online : river runoff is added to the horizontal divergence (hdivn) in the subroutine sbc_rnf_div ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice ! Coupling offline : runoff are in emp which contains E-P-R ! IF( .NOT. lk_offline .AND. lk_vvl ) THEN ! online coupling with vvl zsfx(:,:) = 0._wp ELSE ! online coupling free surface or offline with free surface zsfx(:,:) = emp(:,:) ENDIF ! 0. initialization zsrau = 1. / rau0 IF ( neuler .EQ. 0 ) THEN zeuler = 0.0 ELSE zeuler = 1.0 ENDIF i_code = 1 DO jn = 1, jptra ! IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends ! ! add the trend to the general tracer trend ! MV 2013 sea ice tracers ! OLD LOOP IF ( i_code == 0 ) THEN DO jj = 2, jpj DO ji = fs_2, fs_jpim1 ! vector opt. zse3t = 1. / fse3t(ji,jj,1) tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t END DO END DO ! NEW LOOP ELSE ! i_code DO jj = 2, jpj DO ji = fs_2, fs_jpim1 ! vector opt. zse3t = 1. / fse3t(ji,jj,1) ! tracer flux at the ice/ocean interface (tracer/m2/s) zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice zcd = trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting, ! only used in the levitating sea ice case ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux ztfx = zftra + zswitch * zcd ! net tracer flux (+C/D if no ice/ocean mass exchange) ! tracer change (left member: euler; right member:leapfrog) ztra = ( 1. - zeuler ) * trn(ji,jj,1,jn) + zeuler * trb(ji,jj,1,jn) ! MAX is there to avoid integral ocean uptake in the case of freezing (for iron) zdtra = MAX ( - ztra / r2dtra(1) , zsrau * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) * zse3t ) ! tracer tendency ! r2dtra is time step tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zdtra ! new line ! IF ( ztfx .NE. 0.0 ) THEN ! WRITE(numout,*) ji, jj, jn ! WRITE(numout,*) ' trc_o : ', trc_o(ji,jj,jn) ! WRITE(numout,*) ' trc_i : ', trc_i(ji,jj,jn) ! WRITE(numout,*) ' fmmflx : ', fmmflx(ji,jj) ! WRITE(numout,*) ' zswitch: ', zswitch ! WRITE(numout,*) ' zcd : ', zcd ! WRITE(numout,*) ' zftra : ', zftra ! WRITE(numout,*) ' ztfx : ', ztfx ! WRITE(numout,*) ' zsrau : ', zsrau ! WRITE(numout,*) ' zsfx : ', zsfx(ji,jj) ! WRITE(numout,*) ' zse3t : ', zse3t ! WRITE(numout,*) ' ztra : ', ztra ! WRITE(numout,*) ' zdtra : ', zdtra ! WRITE(numout,*) ' Old tendency : ', zsfx(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t ! ENDIF END DO END DO ENDIF ! i_code ! END MV 2013 IF( l_trdtrc ) THEN ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) CALL trd_tra( kt, 'TRC', jn, jptra_trd_nsr, ztrtrd ) END IF ! ! =========== END DO ! tracer loop ! ! =========== IF( ln_ctl ) THEN WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_trc_info(charout) CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) ENDIF CALL wrk_dealloc( jpi, jpj, zsfx ) IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) ! IF( nn_timing == 1 ) CALL timing_stop('trc_sbc') ! END SUBROUTINE trc_sbc #else !!---------------------------------------------------------------------- !! Dummy module : NO passive tracer !!---------------------------------------------------------------------- CONTAINS SUBROUTINE trc_sbc (kt) ! Empty routine INTEGER, INTENT(in) :: kt WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt END SUBROUTINE trc_sbc #endif !!====================================================================== END MODULE trcsbc