MODULE trasbc !!============================================================================== !! *** MODULE trasbc *** !! Ocean active tracers: surface boundary condition !!============================================================================== !! History : 8.2 ! 98-10 (G. Madec, G. Roullet, M. Imbard) Original code !! 8.2 ! 01-02 (D. Ludicone) sea ice and free surface !! 8.5 ! 02-06 (G. Madec) F90: Free form and module !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! tra_sbc : update the tracer trend at ocean surface !!---------------------------------------------------------------------- USE oce ! ocean dynamics and active tracers USE sbc_oce ! surface boundary condition: ocean USE dom_oce ! ocean space domain variables USE phycst ! physical constant USE traqsr ! solar radiation penetration USE trdmod ! ocean trends USE trdmod_oce ! ocean variables trends USE in_out_manager ! I/O manager USE prtctl ! Print control USE sbcrnf ! River runoff USE sbcmod ! ln_rnf IMPLICIT NONE PRIVATE PUBLIC tra_sbc ! routine called by step.F90 !! * Substitutions # include "domzgr_substitute.h90" # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE tra_sbc ( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE tra_sbc *** !! !! ** Purpose : Compute the tracer surface boundary condition trend of !! (flux through the interface, concentration/dilution effect) !! and add it to the general trend of tracer equations. !! !! ** Method : !! Following Roullet and Madec (2000), the air-sea flux can be divided !! into three effects: (1) Fext, external forcing; !! (2) Fwi, concentration/dilution effect due to water exchanged !! at the surface by evaporation, precipitations and runoff (E-P-R); !! (3) Fwe, tracer carried with the water that is exchanged. !! !! Fext, flux through the air-sea interface for temperature and salt: !! - temperature : heat flux q (w/m2). If penetrative solar !! radiation q is only the non solar part of the heat flux, the !! solar part is added in traqsr.F routine. !! ta = ta + q /(rau0 rcp e3t) for k=1 !! - salinity : no salt flux !! !! The formulation for Fwb and Fwi vary according to the free !! surface formulation (linear or variable volume). !! * Linear free surface !! The surface freshwater flux modifies the ocean volume !! and thus the concentration of a tracer and the temperature. !! First order of the effect of surface freshwater exchange !! for salinity, it can be neglected on temperature (especially !! as the temperature of precipitations and runoffs is usually !! unknown). !! - temperature : we assume that the temperature of both !! precipitations and runoffs is equal to the SST, thus there !! is no additional flux since in this case, the concentration !! dilution effect is balanced by the net heat flux associated !! to the freshwater exchange (Fwe+Fwi=0): !! (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST !! - salinity : evaporation, precipitation and runoff !! water has a zero salinity (Fwe=0), thus only Fwi remains: !! sa = sa + emp * sn / e3t for k=1 !! where emp, the surface freshwater budget (evaporation minus !! precipitation minus runoff) given in kg/m2/s is divided !! by 1035 kg/m3 (density of ocena water) to obtain m/s. !! Note: even though Fwe does not appear explicitly for !! temperature in this routine, the heat carried by the water !! exchanged through the surface is part of the total heat flux !! forcing and must be taken into account in the global heat !! balance). !! * nonlinear free surface (variable volume, lk_vvl) !! contrary to the linear free surface case, Fwi is properly !! taken into account by using the true layer thicknesses to !! calculate tracer content and advection. There is no need to !! deal with it in this routine. !! - temperature: Fwe=SST (P-E+R) is added to Fext. !! - salinity: Fwe = 0, there is no surface flux of salt. !! !! ** Action : - Update the 1st level of (ta,sa) with the trend associated !! with the tracer surface boundary condition !! - save the trend it in ttrd ('key_trdtra') !!---------------------------------------------------------------------- USE oce, ONLY : ztrdt => ua ! use ua as 3D workspace USE oce, ONLY : ztrds => va ! use va as 3D workspace !! INTEGER, INTENT(in) :: kt ! ocean time-step index !! INTEGER :: ji, jj, jk ! dummy loop indices REAL(wp) :: zta, zsa ! temporary scalars, adjustment to temperature and salinity REAL(wp) :: azta, azsa ! temporary scalars, calculations of automatic change to temp & sal due to vvl (done elsewhere) REAL(wp) :: zsrau, zse3t, zdep ! temporary scalars, 1/density, 1/height of box, 1/height of effected water column REAL(wp) :: dheat, dsalt ! total change of temperature and salinity REAL(wp) :: tot_sal1, tot_tmp1 !!---------------------------------------------------------------------- IF( kt == nit000 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition' IF(lwp) WRITE(numout,*) '~~~~~~~ ' ENDIF zsrau = 1. / rau0 ! initialization #if defined key_zco zse3t = 1. / e3t_0(1) #endif IF( l_trdtra ) THEN ! Save ta and sa trends ztrdt(:,:,:) = ta(:,:,:) ztrds(:,:,:) = sa(:,:,:) ENDIF IF( .NOT.ln_traqsr ) qsr(:,:) = 0.e0 ! no solar radiation penetration ! Concentration dillution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff DO jj = 2, jpj DO ji = fs_2, fs_jpim1 ! vector opt. #if ! defined key_zco zse3t = 1. / fse3t(ji,jj,1) #endif IF( lk_vvl) THEN zta = ro0cpr * qns(ji,jj) * zse3t & ! temperature : heat flux & - emp(ji,jj) * zsrau * tn(ji,jj,1) * zse3t ! & cooling/heating effet of EMP flux zsa = 0.e0 ! No salinity concent./dilut. effect ELSE zta = ro0cpr * qns(ji,jj) * zse3t ! temperature : heat flux zsa = emps(ji,jj) * zsrau * sn(ji,jj,1) * zse3t ! salinity : concent./dilut. effect ENDIF ta(ji,jj,1) = ta(ji,jj,1) + zta ! add the trend to the general tracer trend sa(ji,jj,1) = sa(ji,jj,1) + zsa END DO END DO IF ( ln_rnf ) THEN ! Concentration / dilution effect on (t,s) due to river runoff DO jj=1,jpj DO ji=1,jpi rnf_dep(ji,jj)=0 DO jk=1,rnf_mod_dep(ji,jj) ! recalculates rnf_dep to be the depth rnf_dep(ji,jj)=rnf_dep(ji,jj)+fse3t(ji,jj,jk) ! in metres to the bottom of the relevant grid box ENDDO zdep = 1. / rnf_dep(ji,jj) zse3t= 1. / fse3t(ji,jj,1) IF ( rnf_tmp(ji,jj) == -999 ) rnf_tmp(ji,jj)=tn(ji,jj,1) ! if not specified set runoff temp to be sst IF ( rnf(ji,jj) .gt. 0.0 ) THEN IF( lk_vvl) THEN !!!indirect flux, concentration or dilution effect !!!force a dilution effect in all levels; dheat=0.0 dsalt=0.0 DO jk=1, rnf_mod_dep(ji,jj) zta = -tn(ji,jj,jk) * rnf(ji,jj) * zsrau * zdep zsa = -sn(ji,jj,jk) * rnf(ji,jj) * zsrau * zdep ta(ji,jj,jk)=ta(ji,jj,jk)+zta sa(ji,jj,jk)=sa(ji,jj,jk)+zsa dheat=dheat+zta*fse3t(ji,jj,jk) dsalt=dsalt+zsa*fse3t(ji,jj,jk) ENDDO !!!negate this total change in heat and salt content from top level zta=-dheat*zse3t zsa=-dsalt*zse3t ta(ji,jj,1)=ta(ji,jj,1)+zta sa(ji,jj,1)=sa(ji,jj,1)+zsa !!!direct flux zta = rnf_tmp(ji,jj) * rnf(ji,jj) * zsrau * zdep zsa = rnf_sal(ji,jj) * rnf(ji,jj) * zsrau * zdep DO jk=1, rnf_mod_dep(ji,jj) ta(ji,jj,jk) = ta(ji,jj,jk) + zta sa(ji,jj,jk) = sa(ji,jj,jk) + zsa ENDDO ELSE DO jk=1, rnf_mod_dep(ji,jj) zta = ( rnf_tmp(ji,jj)-tn(ji,jj,jk) ) * rnf(ji,jj) * zsrau * zdep zsa = ( rnf_sal(ji,jj)-sn(ji,jj,jk) ) * rnf(ji,jj) * zsrau * zdep ta(ji,jj,jk) = ta(ji,jj,jk) + zta sa(ji,jj,jk) = sa(ji,jj,jk) + zsa ENDDO ENDIF ELSEIF (rnf(ji,jj) .lt. 0.) THEN !! for use in baltic when flow is out of domain, want no change in temp and sal IF( lk_vvl) THEN !calculate automatic adjustment to sal and temp due to dilution/concentraion effect azta = -tn(ji,jj,1) * rnf(ji,jj) * zsrau * zse3t azsa = -sn(ji,jj,1) * rnf(ji,jj) * zsrau * zse3t !!!negate this change in sal and temp ta(ji,jj,1)=ta(ji,jj,1)-azta sa(ji,jj,1)=sa(ji,jj,1)-azsa ENDIF ENDIF ENDDO ENDDO ENDIF IF( l_trdtra ) THEN ! save the sbc trends for diagnostic ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) CALL trd_mod(ztrdt, ztrds, jptra_trd_nsr, 'TRA', kt) ENDIF ! IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' sbc - Ta: ', mask1=tmask, & & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) ! END SUBROUTINE tra_sbc !!====================================================================== END MODULE trasbc