New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
trcldf.F90 in NEMO/trunk/src/TOP/TRP – NEMO

source: NEMO/trunk/src/TOP/TRP/trcldf.F90 @ 10372

Last change on this file since 10372 was 10068, checked in by nicolasmartin, 6 years ago

First part of modifications to have a common default header : fix typos and SVN keywords properties

  • Property svn:keywords set to Id
File size: 10.0 KB
RevLine 
[2030]1MODULE trcldf
2   !!======================================================================
3   !!                       ***  MODULE  trcldf  ***
[3294]4   !! Ocean Passive tracers : lateral diffusive trends
[2030]5   !!=====================================================================
[5836]6   !! History :  1.0  ! 2005-11  (G. Madec)  Original code
7   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
8   !!            3.7  ! 2014-03  (G. Madec)  LDF simplification
[2030]9   !!----------------------------------------------------------------------
10#if defined key_top
11   !!----------------------------------------------------------------------
12   !!   'key_top'                                                TOP models
13   !!----------------------------------------------------------------------
[6140]14   !!   trc_ldf       : update the tracer trend with the lateral diffusion
15   !!   trc_ldf_ini   : initialization, namelist read, and parameters control
[2030]16   !!----------------------------------------------------------------------
[6140]17   USE trc            ! ocean passive tracers variables
18   USE oce_trc        ! ocean dynamics and active tracers
[9019]19   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
20   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
[6140]21   USE traldf_lap_blp ! lateral diffusion: lap/bilaplacian iso-level      operator  (tra_ldf_lap/_blp   routine)
22   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine)
23   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_     triad routine)
24   USE trd_oce        ! trends: ocean variables
25   USE trdtra         ! trends manager: tracers
[5836]26   !
[6140]27   USE prtctl_trc     ! Print control
[2030]28
29   IMPLICIT NONE
30   PRIVATE
31
[5836]32   PUBLIC   trc_ldf   
33   PUBLIC   trc_ldf_ini   
34   !
[9490]35   !                                      !!: ** lateral mixing namelist (nam_trcldf) **
[9526]36   LOGICAL , PUBLIC ::   ln_trcldf_OFF     !: No operator (no explicit lateral diffusion)
[9490]37   LOGICAL , PUBLIC ::   ln_trcldf_tra     !: use active tracer operator
38   REAL(wp), PUBLIC ::      rn_ldf_multi      !: multiplier of T-S eddy diffusivity to obtain the passive tracer one
39   REAL(wp), PUBLIC ::      rn_fact_lap       !: enhanced Equatorial zonal diffusivity coefficent
[5836]40   !
[9490]41   INTEGER  ::   nldf_trc = 0   ! type of lateral diffusion used defined from ln_traldf_... (namlist logicals)
42   REAL(wp) ::   rldf           ! multiplier between active and passive tracers eddy diffusivity   [-]
[6140]43   
[2030]44   !! * Substitutions
45#  include "vectopt_loop_substitute.h90"
46   !!----------------------------------------------------------------------
[10067]47   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[3294]48   !! $Id$
[10068]49   !! Software governed by the CeCILL license (see ./LICENSE)
[2030]50   !!----------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE trc_ldf( kt )
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE tra_ldf  ***
[3294]56      !!
[2030]57      !! ** Purpose :   compute the lateral ocean tracer physics.
58      !!
59      !!----------------------------------------------------------------------
60      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
[6140]61      !
[6403]62      INTEGER            :: ji, jj, jk, jn
63      REAL(wp)           :: zdep
[2030]64      CHARACTER (len=22) :: charout
[9125]65      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zahu, zahv
[3294]66      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
[2030]67      !!----------------------------------------------------------------------
[3294]68      !
[9526]69      IF( ln_trcldf_OFF )   RETURN        ! not lateral diffusion applied on passive tracers
[9490]70      !
[9124]71      IF( ln_timing )   CALL timing_start('trc_ldf')
[3294]72      !
73      IF( l_trdtrc )  THEN
[9125]74         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )
[7753]75         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
[2030]76      ENDIF
[6403]77      !                                  !* set the lateral diffusivity coef. for passive tracer     
[7753]78      zahu(:,:,:) = rldf * ahtu(:,:,:) 
79      zahv(:,:,:) = rldf * ahtv(:,:,:)
[6403]80      !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain
81      DO jk= 1, jpk
82         DO jj = 1, jpj
83            DO ji = 1, jpi
84               IF( gdept_n(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN
85                  zdep = MAX( gdept_n(ji,jj,jk) - 1000., 0. ) / 1000.
86                  zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) )
87               ENDIF
88            END DO
89         END DO
90      END DO
91      !
[9490]92      SELECT CASE ( nldf_trc )                 !* compute lateral mixing trend and add it to the general trend
[5836]93      !
94      CASE ( np_lap   )                               ! iso-level laplacian
[9490]95         CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,    1     )
[5836]96      CASE ( np_lap_i )                               ! laplacian : standard iso-neutral operator (Madec)
[9490]97         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,    1     )
[5836]98      CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies)
[9490]99         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,    1     )
[5836]100      CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral)
[9490]101         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf_trc )
[2030]102      END SELECT
103      !
[6140]104      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics
[2030]105        DO jn = 1, jptra
[7753]106           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
[4990]107           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )
[2030]108        END DO
[9125]109        DEALLOCATE( ztrtrd )
[2030]110      ENDIF
[6140]111      !               
112      IF( ln_ctl ) THEN                        ! print mean trends (used for debugging)
113         WRITE(charout, FMT="('ldf ')")
114         CALL prt_ctl_trc_info(charout)
115         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
[2030]116      ENDIF
117      !
[9124]118      IF( ln_timing )   CALL timing_stop('trc_ldf')
[3294]119      !
[2030]120   END SUBROUTINE trc_ldf
121
122
[5836]123   SUBROUTINE trc_ldf_ini
[2030]124      !!----------------------------------------------------------------------
125      !!                  ***  ROUTINE ldf_ctl  ***
[3294]126      !!
[5836]127      !! ** Purpose :   Define the operator for the lateral diffusion
[2030]128      !!
[9526]129      !! ** Method  : - ln_trcldf_tra=T : use nldf_tra set in ldftra module
[9490]130      !!              to defined the passive tracer lateral diffusive operator
[9526]131      !!              - ln_trcldf_OFF=T : no explicit diffusion used
[2030]132      !!----------------------------------------------------------------------
[9490]133      INTEGER ::   ios, ioptio   ! local integers
[6140]134      !!
[9526]135      NAMELIST/namtrc_ldf/ ln_trcldf_OFF , ln_trcldf_tra,   &   ! operator & direction
[9490]136         &                 rn_ldf_multi  , rn_fact_lap          ! coefficient
[2030]137      !!----------------------------------------------------------------------
[6140]138      !
[9490]139      IF(lwp) THEN
140         WRITE(numout,*)
141         WRITE(numout,*) 'trc_ldf_ini : lateral passive tracer diffusive operator'
142         WRITE(numout,*) '~~~~~~~~~~~'
143      ENDIF
144      !
[6140]145      REWIND( numnat_ref )             !  namtrc_ldf in reference namelist
[5836]146      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903)
[6140]147903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp )
148      !
149      REWIND( numnat_cfg )             !  namtrc_ldf in configuration namelist
[5836]150      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 )
[9169]151904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp )
[5836]152      IF(lwm) WRITE ( numont, namtrc_ldf )
[6140]153      !
154      IF(lwp) THEN                     ! Namelist print
[5836]155         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
[9526]156         WRITE(numout,*) '      no explicit diffusion                 ln_trcldf_OFF   = ', ln_trcldf_OFF
[9490]157         WRITE(numout,*) '      use active tracer operator            ln_trcldf_tra   = ', ln_trcldf_tra
158         WRITE(numout,*) '      diffusivity coefficient :'
[9526]159         WRITE(numout,*) '         multiplier of TRA coef. for TRC       rn_ldf_multi = ', rn_ldf_multi
160         WRITE(numout,*) '         enhanced zonal Eq. laplacian coef.    rn_fact_lap  = ', rn_fact_lap
[6403]161
[5836]162      ENDIF
163      !     
164      !                                ! control the namelist parameters
[9490]165      nldf_trc = np_ERROR
166      ioptio   = 0
[9526]167      IF( ln_trcldf_OFF  ) THEN   ;   nldf_trc = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF
[9490]168      IF( ln_trcldf_tra  ) THEN   ;   nldf_trc = nldf_tra    ;   ioptio = ioptio + 1   ;   ENDIF
169      IF( ioptio /=  1   )   CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options (NONE/tra)' )
[5836]170     
[9490]171      !                                ! multiplier : passive/active tracers ration
172      IF( ln_traldf_lap ) THEN               ! laplacian operator
173         rldf = rn_ldf_multi                       ! simple multiplier
174      ELSEIF( ln_traldf_blp ) THEN           ! bilaplacian operator:
175         rldf = SQRT( ABS( rn_ldf_multi )  )       ! the coef. used is the SQRT of the bilaplacian coef.
[2030]176      ENDIF
[5836]177      !
[2030]178      IF(lwp) THEN
179         WRITE(numout,*)
[9490]180         SELECT CASE( nldf_trc )
[9019]181         CASE( np_no_ldf )   ;   WRITE(numout,*) '      ===>>   NO lateral diffusion'
182         CASE( np_lap    )   ;   WRITE(numout,*) '      ===>>   laplacian iso-level operator'
183         CASE( np_lap_i  )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (standard)'
184         CASE( np_lap_it )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (triad)'
185         CASE( np_blp    )   ;   WRITE(numout,*) '      ===>>   bilaplacian iso-level operator'
186         CASE( np_blp_i  )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (standard)'
187         CASE( np_blp_it )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (triad)'
[6140]188         END SELECT
[2030]189      ENDIF
190      !
[5836]191   END SUBROUTINE trc_ldf_ini
[9019]192
[2030]193#endif
194   !!======================================================================
195END MODULE trcldf
Note: See TracBrowser for help on using the repository browser.