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_lap.F90 in trunk/NEMO/TOP_SRC/TRP – NEMO

source: trunk/NEMO/TOP_SRC/TRP/trcldf_lap.F90 @ 941

Last change on this file since 941 was 941, checked in by cetlod, 16 years ago

phasing the passive tracer transport module to the new version of NEMO, see ticket 143

  • Property svn:executable set to *
File size: 7.3 KB
Line 
1MODULE trcldf_lap
2   !!==============================================================================
3   !!                       ***  MODULE  trcldf_lap  ***
4   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend
5   !!==============================================================================
6#if defined key_top
7   !!----------------------------------------------------------------------
8   !!   'key_top'                                                TOP models
9   !!----------------------------------------------------------------------
10   !!   trc_ldf_lap  : update the tracer trend with the horizontal diffusion
11   !!                 using a iso-level harmonic (laplacien) operator.
12   !!----------------------------------------------------------------------
13   USE oce_trc             ! ocean dynamics and active tracers variables
14   USE trc                 ! ocean passive tracers variables
15   USE prtctl_trc          ! Print control for debbuging
16
17   IMPLICIT NONE
18   PRIVATE
19
20   !! * Routine accessibility
21   PUBLIC trc_ldf_lap  ! routine called by step.F90
22
23   !! * Substitutions
24#  include "top_substitute.h90"
25   !!----------------------------------------------------------------------
26   !!   TOP 1.0 , LOCEAN-IPSL (2005)
27   !! $Header$
28   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
29   !!----------------------------------------------------------------------
30   
31CONTAINS
32
33   SUBROUTINE trc_ldf_lap( kt )
34      !!----------------------------------------------------------------------
35      !!                  ***  ROUTINE trc_ldf_lap  ***
36      !!                   
37      !! ** Purpose :   Compute the before horizontal tracer diffusive
38      !!      trend and add it to the general trend of tracer equation.
39      !!
40      !! ** Method  :   Second order diffusive operator evaluated using before
41      !!      fields (forward time scheme). The horizontal diffusive trends of
42      !!      the passive tracer is given by:
43      !!       * s-coordinate, the vertical scale
44      !!      factors e3. are inside the derivatives:
45      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(trb) ]
46      !!                                   + dj-1[ aht e1v*e3v/e2v dj(trb) ] }
47      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
48      !!          difft = 1/(e1t*e2t) {  di-1[ aht e2u/e1u di(trb) ]
49      !!                               + dj-1[ aht e1v/e2v dj(trb) ] }
50      !!      Add this trend to the general tracer trend tra :
51      !!          tra = tra + difft
52      !!
53      !! ** Action  : - Update tra arrays with the before iso-level
54      !!                harmonic mixing trend.
55      !!              - Save the trends in trtrd ('key_trc_diatrd')
56      !!
57      !! History :
58      !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code
59      !!        !  91-11  (G. Madec)
60      !!        !  95-02  (M. Levy)    passive tracers
61      !!        !  95-11  (G. Madec)  suppress volumetric scale factors
62      !!        !  96-01  (G. Madec)  statement function for e3
63      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
64      !!   9.0  !  04-03  (C. Ethe)   passive tracer
65      !!----------------------------------------------------------------------
66      USE oce_trc          , ztu => ua,  &  ! use ua as workspace
67         &                   ztv => va      ! use va as workspace
68
69      !! * Arguments
70      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
71     
72      !! * Local save
73      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   &
74         ze1ur, ze2vr, zbtr2              ! scale factor coefficients
75     
76      !! * Local declarations
77      INTEGER ::   ji, jj, jk,jn         ! dummy loop indices
78      REAL(wp) ::   &
79         zabe1, zabe2, zbtr              ! temporary scalars
80
81      REAL(wp) ::   &
82         ztra, ztrax, ztray              ! workspace
83      CHARACTER (len=22) :: charout
84      !!----------------------------------------------------------------------
85     
86      IF( kt == nittrc000 ) THEN
87         IF(lwp) WRITE(numout,*)
88         IF(lwp) WRITE(numout,*) 'trc_ldf_lap : iso-level laplacian diffusion'
89         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
90         ze1ur(:,:) = e2u(:,:) / e1u(:,:)
91         ze2vr(:,:) = e1v(:,:) / e2v(:,:)
92         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
93      ENDIF
94 
95      DO jn = 1, jptra
96         
97         !                                                  ! =============
98         DO jk = 1, jpkm1                                   ! Vertical slab
99            !                                               ! =============
100            ! 1. First derivative (gradient)
101            ! -------------------
102            DO jj = 1, jpjm1
103               DO ji = 1, fs_jpim1   ! vector opt.
104                  IF ( ln_sco ) THEN
105                     zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk)
106                     zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk)
107                  ELSE
108                     zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj)
109                     zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj)
110                  ENDIF
111                  ztu(ji,jj,jk) = zabe1 * ( trb(ji+1,jj  ,jk,jn) - trb(ji,jj,jk,jn) )
112                  ztv(ji,jj,jk) = zabe2 * ( trb(ji  ,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
113               END DO
114            END DO
115
116
117            ! 2. Second derivative (divergence)
118            ! --------------------
119            DO jj = 2, jpjm1
120               DO ji = fs_2, fs_jpim1   ! vector opt.
121                  IF ( ln_sco ) THEN
122                     zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
123                  ELSE
124                     zbtr = zbtr2(ji,jj)
125                  ENDIF
126                  ! horizontal diffusive trends
127                  ztrax = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) )
128                  ztray = zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )
129
130                  ! add it to the general tracer trends
131                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztrax + ztray
132
133#if defined key_trc_diatrd
134                  ! save the horizontal diffusive trends
135                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),4) = ztrax
136                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),5) = ztray
137#endif
138               END DO
139            END DO
140            !                                               ! =============
141         END DO                                             !  End of slab 
142         !                                                  ! =============
143
144      END DO
145
146     IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
147         WRITE(charout, FMT="('ldf - lap')")
148         CALL prt_ctl_trc_info(charout)
149         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
150      ENDIF
151
152   END SUBROUTINE trc_ldf_lap
153
154#else
155   !!----------------------------------------------------------------------
156   !!   Default option                                         Empty module
157   !!----------------------------------------------------------------------
158CONTAINS
159   SUBROUTINE trc_ldf_lap( kt ) 
160      INTEGER, INTENT(in) :: kt
161      WRITE(*,*) 'trc_ldf_lap: You should not have seen this print! error?', kt
162   END SUBROUTINE trc_ldf_lap
163#endif
164
165   !!==============================================================================
166END MODULE trcldf_lap
Note: See TracBrowser for help on using the repository browser.