MODULE trcbbc !!====================================================================== !! *** MODULE trcbbc *** !! Ocean passive tracers: bottom boundary condition !!====================================================================== !! History : 8.1 ! 99-10 (G. Madec) original code !! 8.5 ! 02-08 (G. Madec) free form + modules !! ! 02-11 (A. Bozec) trc_bbc_init !! 9.0 ! 04-03 (C. Ethe) adpated for passive tracers !! ! 07-02 (C. Deltel) Diagnose ML trends for passive tracers !!---------------------------------------------------------------------- #if defined key_top && defined key_trcbbc !!---------------------------------------------------------------------- !! 'key_trcbbc' geothermal heat flux !!---------------------------------------------------------------------- !! trc_bbc : update the tracer trend at ocean bottom !! trc_bbc_init : initialization of geothermal heat flux trend !!---------------------------------------------------------------------- USE oce_trc ! ocean dynamics and active tracers variables USE trc ! ocean passive tracers variables USE prtctl_trc ! Print control for debbuging USE trdmld_trc USE trdmld_trc_oce IMPLICIT NONE PRIVATE PUBLIC trc_bbc ! routine called by trcstp.F90 !! >>>>>>>>>>>>>>>>>>>>>>>>> MOVE TO NAMELIST >>>>>>>>>>>>>>>>>>>>>>>>>> LOGICAL, PUBLIC, PARAMETER :: lk_trcbbc = .TRUE. !: bbc flag INTEGER :: ngeo_trc_flux = 1 !!! ** bbc namelist (nambbc) ** ! ! Geothermal flux (0:no flux, 1:constant flux, ! ! 2:read in file ) REAL(wp) :: ngeo_trc_flux_const = 86.4e-3 !!! ** bbc namlist ** ! ! Constant value of geothermal heat flux INTEGER, DIMENSION(jpi,jpj) :: nbotlevt ! ocean bottom level index at T-pt REAL(wp), DIMENSION(jpi,jpj) :: qgh_trd ! geothermal heating trend !! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< !! * Substitutions # include "top_substitute.h90" !!---------------------------------------------------------------------- !! TOP 1.0 , LOCEAN-IPSL (2005) !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcbbc.F90,v 1.11 2006/09/12 11:10:13 opalod Exp $ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE trc_bbc( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE trc_bbc *** !! !! ** Purpose : Compute the bottom boundary contition on passive tracer !! associated with geothermal heating and add it to the general !! trend of tracers equations. !! !! ** Method : The geothermal heat flux set to its constant value of !! 86.4 mW/m2 (Stein and Stein 1992, Huang 1999). !! The temperature trend associated to this heat flux through the !! ocean bottom can be computed once and is added to the temperature !! trend juste above the bottom at each time step: !! tra = tra + Qsf / (rau0 rcp e3T) for k= mbathy -1 !! Where Qsf is the geothermal heat flux. !! !! ** Action : - update the temperature trends tra with the trend of !! the ocean bottom boundary condition !! !! References : !! Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129. !!---------------------------------------------------------------------- INTEGER, INTENT( in ) :: kt ! ocean time-step index #if defined key_vectopt_loop INTEGER :: ji, jn ! dummy loop indices #else INTEGER :: ji, jj, jn ! dummy loop indices #endif REAL(wp) :: ztra ! temporary scalar CHARACTER (len=22) :: charout REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrtrd ! trends !!---------------------------------------------------------------------- ! 0. Initialization ! ----------------- IF( kt == nittrc000 ) CALL trc_bbc_init IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) ! 1. Add the geothermal heat flux trend on temperature ! ---------------------------------------------------- SELECT CASE ( ngeo_trc_flux ) CASE ( 1:2 ) ! geothermal heat flux ! ! =========== DO jn = 1, jptra ! tracer loop ! ! =========== IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends #if defined key_vectopt_loop DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) tra(ji,1,nbotlevt(ji,1),jn) = tra(ji,1,nbotlevt(ji,1),jn) + qgh_trd(ji,1) END DO #else DO jj = 2, jpjm1 DO ji = 2, jpim1 tra(ji,jj,nbotlevt(ji,jj),jn) = tra(ji,jj,nbotlevt(ji,jj),jn) + qgh_trd(ji,jj) END DO END DO #endif IF( l_trdtrc ) THEN ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_bbc, kt) END IF ! ! =========== END DO ! tracer loop ! ! =========== IF( l_trdtrc ) DEALLOCATE( ztrtrd ) IF( ln_ctl ) THEN ! print mean trends (used for debugging) WRITE(charout, FMT="('bbc')") CALL prt_ctl_trc_info(charout) CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') ENDIF END SELECT END SUBROUTINE trc_bbc SUBROUTINE trc_bbc_init !!---------------------------------------------------------------------- !! *** ROUTINE trc_bbc_init *** !! !! ** Purpose : Compute once for all the trend associated with geo- !! thermal heating that will be applied at each time step at the !! bottom ocean level !! !! ** Method : Read the namtopbbc namelist and check the parameters. !! called at the first time step (nittrc000) !! !! ** Input : - Namlist namtopbbc !! - NetCDF file : passivetrc_geothermal_heating.nc !! ( if necessary ) !! !! ** Action : - compute the heat geothermal trend qgh_trd !! - compute the bottom ocean level nbotlevt !!---------------------------------------------------------------------- USE iom CHARACTER (len=32) :: clname INTEGER :: ji, jj ! dummy loop indices INTEGER :: inum ! temporary logical unit NAMELIST/namtopbbc/ngeo_trc_flux, ngeo_trc_flux_const !!---------------------------------------------------------------------- ! Read Namelist nambbc : bottom momentum boundary condition REWIND ( numnat ) READ ( numnat, namtopbbc ) ! Control print IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'trc_bbc : Passive tracers Bottom Boundary Condition (bbc)' IF(lwp) WRITE(numout,*) '~~~~~~~ Geothermal heatflux' IF(lwp) WRITE(numout,*) ' Namelist namtrcbbc : set bbc parameters' IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' Geothermal flux ngeo_trc_flux = ', ngeo_trc_flux IF(lwp) WRITE(numout,*) ' Constant geothermal flux ngeo_trc_flux_const = ', ngeo_trc_flux_const IF(lwp) WRITE(numout,*) ! level of the ocean bottom at T-point DO jj = 1, jpj DO ji = 1, jpi nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 ) END DO END DO ! initialization of geothermal heat flux SELECT CASE ( ngeo_trc_flux ) CASE ( 0 ) ! no geothermal heat flux IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' *** no geothermal heat flux' CASE ( 1 ) ! constant flux IF(lwp) WRITE(numout,*) ' *** constant heat flux = ', ngeo_trc_flux_const qgh_trd(:,:) = ngeo_trc_flux_const CASE ( 2 ) ! variable geothermal heat flux ! read the geothermal fluxes in mW/m2 CALL iom_open ( 'geothermal_heating_trc.nc', inum ) CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd ) CALL iom_close (inum) qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2 CASE DEFAULT WRITE(ctmp1,*) ' bad flag value for ngeo_flux = ', ngeo_flux CALL ctl_stop( ctmp1 ) END SELECT ! geothermal heat flux trend SELECT CASE ( ngeo_trc_flux ) CASE ( 1:2 ) ! geothermal heat flux #if defined key_vectopt_loop DO ji = 1, jpij ! vector opt. (forced unrolling) qgh_trd(ji,1) = ro0cpr * qgh_trd(ji,1) / fse3t(ji,1,nbotlevt(ji,1) ) END DO #else DO jj = 1, jpj DO ji = 1, jpi qgh_trd(ji,jj) = ro0cpr * qgh_trd(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj)) END DO END DO #endif END SELECT END SUBROUTINE trc_bbc_init #else !!---------------------------------------------------------------------- !! Default option Empty module !!---------------------------------------------------------------------- LOGICAL, PUBLIC, PARAMETER :: lk_trcbbc = .FALSE. !: bbc flag CONTAINS SUBROUTINE trc_bbc( kt ) ! Empty routine INTEGER, INTENT(in) :: kt WRITE(*,*) 'trc_bbc: You should not have seen this print! error?', kt END SUBROUTINE trc_bbc #endif !!====================================================================== END MODULE trcbbc