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.
trazdf_exp.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90 @ 9294

Last change on this file since 9294 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

  • Property svn:keywords set to Id
File size: 7.7 KB
RevLine 
[3]1MODULE trazdf_exp
2   !!==============================================================================
3   !!                    ***  MODULE  trazdf_exp  ***
[2528]4   !! Ocean  tracers:  vertical component of the tracer mixing trend using
5   !!                  a split-explicit time-stepping
[3]6   !!==============================================================================
[1110]7   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
8   !!            7.0  !  1991-11  (G. Madec)
9   !!                 !  1992-06  (M. Imbard)  correction on tracer trend loops
10   !!                 !  1996-01  (G. Madec)  statement function for e3
11   !!                 !  1997-05  (G. Madec)  vertical component of isopycnal
12   !!                 !  1997-07  (G. Madec)  geopotential diffusion in s-coord
13   !!                 !  2000-08  (G. Madec)  double diffusive mixing
14   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
15   !!             -   !  2004-08  (C. Talandier) New trends organisation
16   !!             -   !  2005-11  (G. Madec)  New organisation
17   !!            3.0  !  2008-04  (G. Madec)  leap-frog time stepping done in trazdf
[2528]18   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
[3]19   !!----------------------------------------------------------------------
[1110]20
[3]21   !!----------------------------------------------------------------------
[6140]22   !!   tra_zdf_exp   : compute the tracer the vertical diffusion trend using a
23   !!                   split-explicit time stepping and provide the after tracer
[1110]24   !!----------------------------------------------------------------------
[6140]25   USE oce            ! ocean dynamics and active tracers
26   USE dom_oce        ! ocean space and time domain
27   USE domvvl         ! variable volume levels
28   USE zdf_oce        ! ocean vertical physics
29   USE zdfddm         ! ocean vertical physics: double diffusion
30   USE trc_oce        ! share passive tracers/Ocean variables
31   !
32   USE in_out_manager ! I/O manager
33   USE lib_mpp        ! MPP library
34   USE wrk_nemo       ! Memory Allocation
35   USE timing         ! Timing
[3]36
37   IMPLICIT NONE
38   PRIVATE
39
[1110]40   PUBLIC   tra_zdf_exp   ! routine called by step.F90
[3]41
42   !! * Substitutions
43#  include "zdfddm_substitute.h90"
[1110]44#  include "vectopt_loop_substitute.h90"
[3]45   !!----------------------------------------------------------------------
[2528]46   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
47   !! $Id$
[2715]48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]49   !!----------------------------------------------------------------------
50CONTAINS
51
[6140]52   SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, ksts,   &
53      &                                        ptb , pta , kjpt )
[3]54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE tra_zdf_exp  ***
56      !!                   
[1110]57      !! ** Purpose :   Compute the after tracer fields due to the vertical
58      !!      tracer mixing alone, and then due to the whole tracer trend.
[3]59      !!
[1110]60      !! ** Method  : - The after tracer fields due to the vertical diffusion
61      !!      of tracers alone is given by:
[6140]62      !!                ztb = ptb + p2dt difft
[2528]63      !!      where difft = dz( avt dz(ptb) ) = 1/e3t dk+1( avt/e3w dk(ptb) )
64      !!           (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt)
[1110]65      !!      difft is evaluated with an Euler split-explit scheme using a
66      !!      no flux boundary condition at both surface and bottomi boundaries.
67      !!      (N.B. bottom condition is applied through the masked field avt).
68      !!              - the after tracer fields due to the whole trend is
[6140]69      !!      obtained in leap-frog environment applied on thickness weighted tracer by :
70      !!          pta = [ ptb*e3tb + e3tn*( ztb - ptb + p2dt pta ) ] / e3tn
[3]71      !!
[2528]72      !! ** Action : - after tracer fields pta
[1110]73      !!---------------------------------------------------------------------
[6140]74      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
75      INTEGER                              , INTENT(in   ) ::   kit000   ! first time step index
76      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
77      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
78      INTEGER                              , INTENT(in   ) ::   ksts     ! number of sub-time step
79      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
80      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
81      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! in: tracer trend ; out: after tracer field
[2715]82      !
[6140]83      INTEGER  ::  ji, jj, jk, jn, jl   ! dummy loop indices
84      REAL(wp) ::  z1_ksts, ze3tr       ! local scalars
85      REAL(wp) ::  ztra, ze3tb    !   -      -
86      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztb, zwf
[3]87      !!---------------------------------------------------------------------
[3294]88      !
89      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_exp')
90      !
[6140]91      CALL wrk_alloc( jpi,jpj,jpk,   ztb, zwf ) 
[3294]92      !
93      IF( kt == kit000 )  THEN
[457]94         IF(lwp) WRITE(numout,*)
[2528]95         IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype
[457]96         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
97      ENDIF
[3]98
[1110]99      ! Initializations
100      ! ---------------
[6140]101      z1_ksts = 1._wp / REAL( ksts, wp )
102      zwf(:,:, 1 ) = 0._wp    ! no flux at the surface and at bottom level
103      zwf(:,:,jpk) = 0._wp
[1110]104      !
105      !
[6140]106      DO jn = 1, kjpt         !==  loop over tracers  ==!
[2528]107         !
[6140]108         ztb(:,:,:) = ptb(:,:,:,jn)    ! initial before value for tracer
109         !
110         DO jl = 1, ksts         !==  Split-explicit loop  ==!
111            !             
112            DO jk = 2, jpk             ! 1st vertical derivative (w-flux)
[2528]113               DO jj = 2, jpjm1 
114                  DO ji = fs_2, fs_jpim1   ! vector opt.
115                     IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
[6140]116                        zwf(ji,jj,jk) =   avt(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
[2528]117                     ELSE                                           ! salinity or pass. tracer : use of avs
[6140]118                        zwf(ji,jj,jk) = fsavs(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
[2528]119                     END IF
120                  END DO
[1110]121               END DO
122            END DO
[2528]123            !
[6140]124            DO jk = 1, jpkm1           ! 2nd vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
[2528]125               DO jj = 2, jpjm1 
126                  DO ji = fs_2, fs_jpim1   ! vector opt.
[6140]127                     ztb(ji,jj,jk) = ztb(ji,jj,jk) + p2dt * ( zwf(ji,jj,jk) - zwf(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
[2528]128                  END DO
[1110]129               END DO
[3]130            END DO
[2528]131            !
[6140]132         END DO                  ! end sub-time stepping
[3]133
[6140]134         DO jk = 1, jpkm1        !==  After tracer due to all trends
135            DO jj = 2, jpjm1 
136               DO ji = fs_2, fs_jpim1   ! vector opt.
137                  ze3tb = e3t_b(ji,jj,jk) / e3t_n(ji,jj,jk)
138                  ztra  = ( ztb(ji,jj,jk) - ptb(ji,jj,jk,jn) ) + p2dt * pta(ji,jj,jk,jn)  ! total trend * 2dt
139                  pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)    ! after tracer
[3]140               END DO
[1110]141            END DO
[6140]142         END DO
[2528]143         !
[6140]144      END DO                     ! end of tracer loop
[1110]145      !
[6140]146      CALL wrk_dealloc( jpi,jpj,jpk,   ztb, zwf ) 
[2715]147      !
[3294]148      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_exp')
149      !
[3]150   END SUBROUTINE tra_zdf_exp
151
152   !!==============================================================================
153END MODULE trazdf_exp
Note: See TracBrowser for help on using the repository browser.