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 branches/dev_001_GM/NEMO/TOP_SRC/TRP – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/TRP/trcldf_lap.F90 @ 772

Last change on this file since 772 was 772, checked in by gm, 16 years ago

dev_001_GM - change the name of cpp key to key_top, key_lobster, key_pisces, key_kriest and the corresponding lk_

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