MODULE trcrad !!====================================================================== !! *** MODULE trcrad *** !! Ocean passive tracers: correction of negative concentrations !!====================================================================== !! History : - ! 01-01 (O. Aumont & E. Kestenare) Original code !! 1.0 ! 04-03 (C. Ethe) free form F90 !!---------------------------------------------------------------------- #if defined key_top !!---------------------------------------------------------------------- !! 'key_top' TOP models !!---------------------------------------------------------------------- !! trc_rad : correction of negative concentrations !!---------------------------------------------------------------------- USE oce_trc ! ocean dynamics and tracers variables USE trp_trc ! ocean passive tracers variables USE trdmld_trc USE trdmld_trc_oce USE lib_mpp USE prtctl_trc ! Print control for debbuging IMPLICIT NONE PRIVATE PUBLIC trc_rad ! routine called by trcstp.F90 !! * Substitutions # include "top_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE trc_rad( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE trc_rad *** !! !! ** Purpose : "crappy" routine to correct artificial negative !! concentrations due to isopycnal scheme !! !! ** Method : - PISCES or LOBSTER: Set negative concentrations to zero !! while computing the corresponding tracer content that !! is added to the tracers. Then, adjust the tracer !! concentration using a multiplicative factor so that !! the total tracer concentration is preserved. !! - CFC: simply set to zero the negative CFC concentration !! (the total CFC content is not strictly preserved) !!---------------------------------------------------------------------- INTEGER, INTENT( in ) :: kt ! ocean time-step index CHARACTER (len=22) :: charout !!---------------------------------------------------------------------- IF( kt == nittrc000 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' IF(lwp) WRITE(numout,*) '~~~~~~~ ' ENDIF IF( lk_cfc ) CALL trc_rad_sms( kt, trb, trn, jp_cfc0 , jp_cfc1 ) ! CFC model IF( lk_c14b ) CALL trc_rad_sms( kt, trb, trn, jp_c14b0, jp_c14b1 ) ! bomb C14 IF( lk_lobster ) CALL trc_rad_sms( kt, trb, trn, jp_lob0 , jp_lob1, cpreserv='Y' ) ! LOBSTER model IF( lk_pisces ) CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' ) ! PISCES model IF( lk_my_trc ) CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1 ) ! MY_TRC model ! IF(ln_ctl) THEN ! print mean trends (used for debugging) WRITE(charout, FMT="('rad')") CALL prt_ctl_trc_info( charout ) CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) ENDIF ! END SUBROUTINE trc_rad SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) !!----------------------------------------------------------------------------- !! *** ROUTINE trc_rad_sms *** !! !! ** Purpose : "crappy" routine to correct artificial negative !! concentrations due to isopycnal scheme !! !! ** Method : 2 cases : !! - Set negative concentrations to zero while computing !! the corresponding tracer content that is added to the !! tracers. Then, adjust the tracer concentration using !! a multiplicative factor so that the total tracer !! concentration is preserved. !! - simply set to zero the negative CFC concentration !! (the total content of concentration is not strictly preserved) !!-------------------------------------------------------------------------------- !! Arguments INTEGER, INTENT( in ) :: kt ! ocean time-step index INTEGER , INTENT( in ) :: & jp_sms0, & !: First index of the passive tracer model jp_sms1 !: Last index of the passive tracer model REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT( inout ) :: & ptrb, ptrn !: before and now traceur concentration CHARACTER( len = 1) , INTENT(in), OPTIONAL :: & cpreserv !: flag to preserve content or not ! Local declarations INTEGER :: ji, jj, jk, jn ! dummy loop indices REAL(wp) :: zvolk, ztrcorb, ztrmasb ! temporary scalars REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrtrdb ! workspace arrays REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrtrdn ! workspace arrays REAL(wp) :: zs2rdt LOGICAL :: lldebug = .FALSE. !!---------------------------------------------------------------------- IF( l_trdtrc ) THEN ! ALLOCATE( ztrtrdb(jpi,jpj,jpk) ) ALLOCATE( ztrtrdn(jpi,jpj,jpk) ) ! ENDIF IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved DO jn = jp_sms0, jp_sms1 ! ! =========== ztrcorb = 0.e0 ; ztrmasb = 0.e0 ztrcorn = 0.e0 ; ztrmasn = 0.e0 IF( l_trdtrc ) THEN ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation ENDIF DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1, jpi zvolk = cvol(ji,jj,jk) # if defined key_off_degrad zvolk = zvolk * facvol(ji,jj,jk) # endif ztrcorb = ztrcorb + MIN( 0., ptrb(ji,jj,jk,jn) ) * zvolk ztrcorn = ztrcorn + MIN( 0., ptrn(ji,jj,jk,jn) ) * zvolk ptrb(ji,jj,jk,jn) = MAX( 0., ptrb(ji,jj,jk,jn) ) ptrn(ji,jj,jk,jn) = MAX( 0., ptrn(ji,jj,jk,jn) ) ztrmasb = ztrmasb + ptrb(ji,jj,jk,jn) * zvolk ztrmasn = ztrmasn + ptrn(ji,jj,jk,jn) * zvolk END DO END DO END DO IF( lk_mpp ) THEN CALL mpp_sum( ztrcorb ) ! sum over the global domain CALL mpp_sum( ztrcorn ) ! sum over the global domain CALL mpp_sum( ztrmasb ) ! sum over the global domain CALL mpp_sum( ztrmasn ) ! sum over the global domain ENDIF IF( ztrcorb /= 0 ) THEN zcoef = 1. + ztrcorb / ztrmasb DO jk = 1, jpkm1 ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) END DO ENDIF IF( ztrcorn /= 0 ) THEN zcoef = 1. + ztrcorn / ztrmasn DO jk = 1, jpkm1 ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) END DO ENDIF ! IF( l_trdtrc ) THEN ! zs2rdt = 1. / ( 2. * rdt ) ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdb, jn, jptrc_trd_radb, kt ) ! Asselin-like trend handling IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdn, jn, jptrc_trd_radn, kt ) ! standard trend handling ! ENDIF END DO ! ! ELSE ! total CFC content is not strictly preserved DO jn = jp_sms0, jp_sms1 IF( l_trdtrc ) THEN ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation ENDIF DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1, jpi ptrn(ji,jj,jk,jn) = MAX( 0. , ptrn(ji,jj,jk,jn) ) ptrb(ji,jj,jk,jn) = MAX( 0. , ptrb(ji,jj,jk,jn) ) END DO END DO END DO IF( l_trdtrc ) THEN ! zs2rdt = 1. / ( 2. * rdt * FLOAT(ndttrc) ) ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdb, jn, jptrc_trd_radb, kt ) ! Asselin-like trend handling IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdn, jn, jptrc_trd_radn, kt ) ! standard trend handling ! ENDIF ! ENDDO ENDIF IF( l_trdtrc ) DEALLOCATE( ztrtrdb, ztrtrdn ) END SUBROUTINE trc_rad_sms #else !!---------------------------------------------------------------------- !! Dummy module : NO TOP model !!---------------------------------------------------------------------- CONTAINS SUBROUTINE trc_rad( kt ) ! Empty routine INTEGER, INTENT(in) :: kt WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt END SUBROUTINE trc_rad #endif !!====================================================================== END MODULE trcrad