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.
dynadv_ubs_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/DYN – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/DYN/dynadv_ubs_tam.F90 @ 3627

Last change on this file since 3627 was 3627, checked in by rblod, 11 years ago

Correct long lines in TAM 4.3 see ticket #1010
  • Property svn:executable set to *
File size: 19.6 KB
Line 
1MODULE dynadv_ubs_tam
2#if defined key_tam
3   !!======================================================================
4   !!                       ***  MODULE  dynadv_ubs_tam  ***
5   !! Ocean dynamics: Update the momentum trend with the flux form advection
6   !!                 trend using a 3rd order upstream biased scheme
7   !!======================================================================
8   !! History of the direct module :
9   !!            2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code
10   !!            3.2  ! 2009-07  (R. Benshila)  Suppression of rigid-lid option
11   !! History of the T&A module :
12   !!            3.2  ! 2011-02  (A. Vidard)  Original
13   !!            3.4  ! 2012-0è  (P.-A. Bouttier)  Phasing with 3.4
14   !!----------------------------------------------------------------------
15
16   !!----------------------------------------------------------------------
17   !!   dyn_adv_ubs   : flux form momentum advection using    (ln_dynadv=T)
18   !!                   an 3rd order Upstream Biased Scheme or Quick scheme
19   !!                   combined with 2nd or 4th order finite differences
20   !!----------------------------------------------------------------------
21   USE oce_tam        ! ocean dynamics and tracers
22   USE oce            ! ocean dynamics and tracers
23   USE dom_oce        ! ocean space and time domain
24   USE in_out_manager ! I/O manager
25   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
26   USE prtctl         ! Print control
27   USE lib_mpp        ! MPP library
28   USE wrk_nemo        ! Memory Allocation
29   USE timing          ! Timing
30
31   IMPLICIT NONE
32   PRIVATE
33
34   REAL(wp), PARAMETER :: gamma1 = 1._wp/3._wp  ! =1/4 quick      ; =1/3  3rd order UBS
35   REAL(wp), PARAMETER :: gamma2 = 0._wp  ! =0   2nd order  ; =1/8  4th order centred
36
37   PUBLIC   dyn_adv_ubs_tan   ! routine called by step.F90
38
39   !! * Substitutions
40#  include "domzgr_substitute.h90"
41#  include "vectopt_loop_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
44   !! $Id$
45   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
46   !!----------------------------------------------------------------------
47
48CONTAINS
49
50   SUBROUTINE dyn_adv_ubs_tan( kt )
51      !!----------------------------------------------------------------------
52      !!                  ***  ROUTINE dyn_adv_ubs_tan  ***
53      !!
54      !! ** Purpose :   Compute the now momentum advection trend in flux form
55      !!              and the general trend of the momentum equation.
56      !!
57      !! ** Method  :   The scheme is the one implemeted in ROMS. It depends
58      !!      on two parameter gamma1 and gamma2. The former control the
59      !!      upstream baised part of the scheme and the later the centred
60      !!      part:     gamma1 = 0    pure centered  (no diffusive part)
61      !!                       = 1/4  Quick scheme
62      !!                       = 1/3  3rd order Upstream biased scheme
63      !!                gamma2 = 0    2nd order finite differencing
64      !!                       = 1/8  4th order finite differencing
65      !!      For stability reasons, the first term of the fluxes which cor-
66      !!      responds to a second order centered scheme is evaluated using
67      !!      the now velocity (centered in time) while the second term which
68      !!      is the diffusive part of the scheme, is evaluated using the
69      !!      before velocity (forward in time).
70      !!      Default value (hard coded in the begining of the module) are
71      !!      gamma1=1/4 and gamma2=1/8.
72      !!
73      !! ** Action : - (ua,va) updated with the 3D advective momentum trends
74      !!
75      !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling.
76      !!----------------------------------------------------------------------
77      INTEGER, INTENT(in) ::   kt     ! ocean time-step index
78      !!
79      INTEGER  ::   ji, jj, jk            ! dummy loop indices
80      REAL(wp) ::   zbu, zbv    ! temporary scalars
81      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! temporary scalars
82      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zfu, zfv     ! temporary workspace
83      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zfu_t, zfu_f     ! temporary workspace
84      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zfv_t, zfv_f     !    "           "
85      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zfw, zfu_uw, zfv_vw
86      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zlu_uu, zlu_uv   ! temporary workspace
87      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zlv_vv, zlv_vu   ! temporary workspace
88      REAL(wp) ::   zuitl, zvjtl, zfujtl, zfvitl, zl_utl, zl_vtl   ! temporary scalars
89      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zfutl, zfvtl     ! temporary workspace
90      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zfu_ttl, zfu_ftl     ! temporary workspace
91      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zfv_ttl, zfv_ftl     !    "           "
92      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zfwtl, zfu_uwtl, zfv_vwtl
93      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zlu_uutl, zlu_uvtl   ! temporary workspace
94      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zlv_vvtl, zlv_vutl   ! temporary workspace
95      !!----------------------------------------------------------------------
96      !
97      IF( nn_timing == 1 )  CALL timing_start('dyn_adv_ubs_tan')
98      !
99      CALL wrk_alloc( jpi, jpj, jpk,       zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
100      CALL wrk_alloc( jpi, jpj, jpk, jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu                               )
101      CALL wrk_alloc( jpi, jpj, jpk,       zfu_ttl , zfv_ttl , zfu_ftl , zfv_ftl, zfu_uwtl, zfv_vwtl, zfutl, zfvtl, zfwtl )
102      CALL wrk_alloc( jpi, jpj, jpk, jpts, zlu_uutl, zlv_vvtl, zlu_uvtl, zlv_vutl                                         )
103      !
104      IF( kt == nit000) THEN
105      !
106         IF(lwp) WRITE(numout,*)
107         IF(lwp) WRITE(numout,*) 'dyn_adv_ubs_tan : UBS flux form momentum advection'
108         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
109      ENDIF
110      zfu_t(:,:,:) = 0.e0
111      zfv_t(:,:,:) = 0.e0
112      zfu_f(:,:,:) = 0.e0
113      zfv_f(:,:,:) = 0.e0
114      !
115      zlu_uu(:,:,:,:) = 0.e0
116      zlv_vv(:,:,:,:) = 0.e0
117      zlu_uv(:,:,:,:) = 0.e0
118      zlv_vu(:,:,:,:) = 0.e0
119
120      zfu_ttl(:,:,:) = 0.e0
121      zfv_ttl(:,:,:) = 0.e0
122      zfu_ftl(:,:,:) = 0.e0
123      zfv_ftl(:,:,:) = 0.e0
124      !
125      zlu_uutl(:,:,:,:) = 0.e0
126      zlv_vvtl(:,:,:,:) = 0.e0
127      zlu_uvtl(:,:,:,:) = 0.e0
128      zlv_vutl(:,:,:,:) = 0.e0
129
130      !                                      ! =========================== !
131      DO jk = 1, jpkm1                       !  Laplacian of the velocity  !
132         !                                   ! =========================== !
133         !                                         ! horizontal volume fluxes
134         zfu(  :,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
135         zfv(  :,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
136         zfutl(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un_tl(:,:,jk)
137         zfvtl(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn_tl(:,:,jk)
138         !
139         DO jj = 2, jpjm1                          ! laplacian
140            DO ji = fs_2, fs_jpim1   ! vector opt.
141               zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj,jk)-2.*ub (ji,jj,jk)+ub (ji-1,jj,jk) ) * umask(ji,jj,jk)
142               zlv_vv(ji,jj,jk,1) = ( vb (ji,jj+1,jk)-2.*vb (ji,jj,jk)+vb (ji,jj-1,jk) ) * vmask(ji,jj,jk)
143               zlu_uv(ji,jj,jk,1) = ( ub (ji,jj+1,jk)-2.*ub (ji,jj,jk)+ub (ji,jj-1,jk) ) * umask(ji,jj,jk)
144               zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj,jk)-2.*vb (ji,jj,jk)+vb (ji-1,jj,jk) ) * vmask(ji,jj,jk)
145
146               zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj,jk)-2.*zfu(ji,jj,jk)+zfu(ji-1,jj,jk) ) * umask(ji,jj,jk)
147               zlv_vv(ji,jj,jk,2) = ( zfv(ji,jj+1,jk)-2.*zfv(ji,jj,jk)+zfv(ji,jj-1,jk) ) * vmask(ji,jj,jk)
148               zlu_uv(ji,jj,jk,2) = ( zfu(ji,jj+1,jk)-2.*zfu(ji,jj,jk)+zfu(ji,jj-1,jk) ) * umask(ji,jj,jk)
149               zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj,jk)-2.*zfv(ji,jj,jk)+zfv(ji-1,jj,jk) ) * vmask(ji,jj,jk)
150
151               zlu_uutl(ji,jj,jk,1) = ( ub_tl (ji+1,jj,jk)-2.*ub_tl (ji,jj,jk)+ub_tl (ji-1,jj,jk) ) * umask(ji,jj,jk)
152               zlv_vvtl(ji,jj,jk,1) = ( vb_tl (ji,jj+1,jk)-2.*vb_tl (ji,jj,jk)+vb_tl (ji,jj-1,jk) ) * vmask(ji,jj,jk)
153               zlu_uvtl(ji,jj,jk,1) = ( ub_tl (ji,jj+1,jk)-2.*ub_tl (ji,jj,jk)+ub_tl (ji,jj-1,jk) ) * umask(ji,jj,jk)
154               zlv_vutl(ji,jj,jk,1) = ( vb_tl (ji+1,jj,jk)-2.*vb_tl (ji,jj,jk)+vb_tl (ji-1,jj,jk) ) * vmask(ji,jj,jk)
155
156               zlu_uutl(ji,jj,jk,2) = ( zfutl(ji+1,jj,jk)-2.*zfutl(ji,jj,jk)+zfutl(ji-1,jj,jk) ) * umask(ji,jj,jk)
157               zlv_vvtl(ji,jj,jk,2) = ( zfvtl(ji,jj+1,jk)-2.*zfvtl(ji,jj,jk)+zfvtl(ji,jj-1,jk) ) * vmask(ji,jj,jk)
158               zlu_uvtl(ji,jj,jk,2) = ( zfutl(ji,jj+1,jk)-2.*zfutl(ji,jj,jk)+zfutl(ji,jj-1,jk) ) * umask(ji,jj,jk)
159               zlv_vutl(ji,jj,jk,2) = ( zfvtl(ji+1,jj,jk)-2.*zfvtl(ji,jj,jk)+zfvtl(ji-1,jj,jk) ) * vmask(ji,jj,jk)
160            END DO
161         END DO
162      END DO
163!!!gm BUG !!!  just below this should be +1 in all the communications
164      !CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.)
165      !CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.)
166      !CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.)
167      !CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.)
168!!gm corrected:
169      CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', 1. )   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', 1. )
170      CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', 1. )   ;   CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', 1. )
171      CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', 1. )   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', 1. )
172      CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', 1. )   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', 1. )
173!!gm end
174!!gm BUG !!!  just below this should be +1 in all the communications
175      !CALL lbc_lnk( zlu_uutl(:,:,:,1), 'U', -1.)   ;   CALL lbc_lnk( zlu_uvtl(:,:,:,1), 'U', -1.)
176      !CALL lbc_lnk( zlu_uutl(:,:,:,2), 'U', -1.)   ;   CALL lbc_lnk( zlu_uvtl(:,:,:,2), 'U', -1.)
177      !CALL lbc_lnk( zlv_vvtl(:,:,:,1), 'V', -1.)   ;   CALL lbc_lnk( zlv_vutl(:,:,:,1), 'V', -1.)
178      !CALL lbc_lnk( zlv_vvtl(:,:,:,2), 'V', -1.)   ;   CALL lbc_lnk( zlv_vutl(:,:,:,2), 'V', -1.)
179!!gm corrected:
180      CALL lbc_lnk( zlu_uutl(:,:,:,1), 'U', 1. )   ;   CALL lbc_lnk( zlu_uvtl(:,:,:,1), 'U', 1. )
181      CALL lbc_lnk( zlu_uutl(:,:,:,2), 'U', 1. )   ;   CALL lbc_lnk( zlu_uvtl(:,:,:,2), 'U', 1. )
182      CALL lbc_lnk( zlv_vvtl(:,:,:,1), 'V', 1. )   ;   CALL lbc_lnk( zlv_vutl(:,:,:,1), 'V', 1. )
183      CALL lbc_lnk( zlv_vvtl(:,:,:,2), 'V', 1. )   ;   CALL lbc_lnk( zlv_vutl(:,:,:,2), 'V', 1. )
184!!gm end
185
186      !                                      ! ====================== !
187      !                                      !  Horizontal advection  !
188      DO jk = 1, jpkm1                       ! ====================== !
189         !                                         ! horizontal volume fluxes
190         zfu(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
191         zfv(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
192         zfutl(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un_tl(:,:,jk)
193         zfvtl(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn_tl(:,:,jk)
194         !
195         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point
196            DO ji = 1, fs_jpim1   ! vector opt.
197               zui = ( un(ji,jj,jk) + un(ji+1,jj  ,jk) )
198               zvj = ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
199               zuitl = ( un_tl(ji,jj,jk) + un_tl(ji+1,jj  ,jk) )
200               zvjtl = ( vn_tl(ji,jj,jk) + vn_tl(ji  ,jj+1,jk) )
201               !
202               IF (zui > 0) THEN
203                  zl_u = zlu_uu(ji  ,jj,jk,1)
204                  zl_utl = zlu_uutl(ji  ,jj,jk,1)
205               ELSE
206                  zl_u = zlu_uu(ji+1,jj,jk,1)
207                  zl_utl = zlu_uutl(ji+1,jj,jk,1)
208               ENDIF
209               IF (zvj > 0) THEN
210                  zl_v = zlv_vv(ji,jj  ,jk,1)
211                  zl_vtl = zlv_vvtl(ji,jj  ,jk,1)
212               ELSE
213                  zl_v = zlv_vv(ji,jj+1,jk,1)
214                  zl_vtl = zlv_vvtl(ji,jj+1,jk,1)
215               ENDIF
216               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk)                               &
217                  &                    - gamma2 * ( zlu_uu(ji,jj,jk,2) + zlu_uu(ji+1,jj  ,jk,2) )  )   &
218                  &                * ( zui - gamma1 * zl_u)
219               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk)                               &
220                  &                    - gamma2 * ( zlv_vv(ji,jj,jk,2) + zlv_vv(ji  ,jj+1,jk,2) )  )   &
221                  &                * ( zvj - gamma1 * zl_v)
222               !
223               zfu_ttl(ji+1,jj  ,jk) = ( zfutl(ji,jj,jk) + zfutl(ji+1,jj  ,jk)                               &
224                  &                    - gamma2 * ( zlu_uutl(ji,jj,jk,2) + zlu_uutl(ji+1,jj  ,jk,2) )  )   &
225                  &                * ( zui - gamma1 * zl_u) + ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk)                               &
226                  &                    - gamma2 * ( zlu_uu(ji,jj,jk,2) + zlu_uu(ji+1,jj  ,jk,2) )  )   &
227                  &                * ( zuitl - gamma1 * zl_utl)
228               zfv_ttl(ji  ,jj+1,jk) = ( zfvtl(ji,jj,jk) + zfvtl(ji  ,jj+1,jk)                               &
229                  &                    - gamma2 * ( zlv_vvtl(ji,jj,jk,2) + zlv_vvtl(ji  ,jj+1,jk,2) )  )   &
230                  &                * ( zvj - gamma1 * zl_v) + ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk)                               &
231                  &                    - gamma2 * ( zlv_vv(ji,jj,jk,2) + zlv_vv(ji  ,jj+1,jk,2) )  )   &
232                  &                * ( zvjtl - gamma1 * zl_vtl)
233               !
234               zfuj = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) )
235               zfvi = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) )
236               !
237               zfujtl = ( zfutl(ji,jj,jk) + zfutl(ji  ,jj+1,jk) )
238               zfvitl = ( zfvtl(ji,jj,jk) + zfvtl(ji+1,jj  ,jk) )
239               IF (zfuj > 0) THEN
240                  zl_v = zlv_vu( ji  ,jj  ,jk,1)
241                  zl_vtl = zlv_vutl( ji  ,jj  ,jk,1)
242               ELSE
243                  zl_v = zlv_vu( ji+1,jj,jk,1)
244                  zl_vtl = zlv_vutl( ji+1,jj,jk,1)
245               ENDIF
246               IF (zfvi > 0) THEN
247                  zl_u = zlu_uv( ji,jj  ,jk,1)
248                  zl_utl = zlu_uvtl( ji,jj  ,jk,1)
249               ELSE
250                  zl_u = zlu_uv( ji,jj+1,jk,1)
251                  zl_utl = zlu_uvtl( ji,jj+1,jk,1)
252               ENDIF
253               !
254               zfv_ftl(ji  ,jj  ,jk) = ( zfvitl - gamma2 * ( zlv_vutl(ji,jj,jk,2) + zlv_vutl(ji+1,jj  ,jk,2) )  )   &
255                  &                * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) - gamma1 * zl_u )                            &
256                  &                + ( zfvi - gamma2 * ( zlv_vu(ji,jj,jk,2) + zlv_vu(ji+1,jj  ,jk,2) )  )           &
257                  &                * ( un_tl(ji,jj,jk) + un_tl(ji  ,jj+1,jk) - gamma1 * zl_utl )
258               zfu_ftl(ji  ,jj  ,jk) = ( zfujtl - gamma2 * ( zlu_uvtl(ji,jj,jk,2) + zlu_uvtl(ji  ,jj+1,jk,2) )  )   &
259                  &                * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) - gamma1 * zl_v )                            &
260                  &                + ( zfuj - gamma2 * ( zlu_uv(ji,jj,jk,2) + zlu_uv(ji  ,jj+1,jk,2) )  )           &
261                  &                * ( vn_tl(ji,jj,jk) + vn_tl(ji+1,jj  ,jk) - gamma1 * zl_vtl )
262            END DO
263         END DO
264         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes
265            DO ji = fs_2, fs_jpim1   ! vector opt.
266               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
267               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
268               !
269               ua_tl(ji,jj,jk) = ua_tl(ji,jj,jk) - (  zfu_ttl(ji+1,jj  ,jk) - zfu_ttl(ji  ,jj  ,jk)    &
270                  &                           + zfv_ftl(ji  ,jj  ,jk) - zfv_ftl(ji  ,jj-1,jk)  ) / zbu
271               va_tl(ji,jj,jk) = va_tl(ji,jj,jk) - (  zfu_ftl(ji  ,jj  ,jk) - zfu_ftl(ji-1,jj  ,jk)    &
272                  &                           + zfv_ttl(ji  ,jj+1,jk) - zfv_ttl(ji  ,jj  ,jk)  ) / zbv
273            END DO
274         END DO
275      END DO
276      !                                      ! ==================== !
277      !                                      !  Vertical advection  !
278      DO jk = 1, jpkm1                       ! ==================== !
279         !                                         ! Vertical volume fluxes 
280         zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk)
281         zfwtl(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn_tl(:,:,jk)
282         !
283         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes
284            zfu_uwtl(:,:,jpk) = 0.e0                      ! Bottom  value : flux set to zero
285            zfv_vwtl(:,:,jpk) = 0.e0
286            !                                           ! Surface value :
287            IF( lk_vvl ) THEN                                ! variable volume : flux set to zero
288               zfu_uwtl(:,:, 1 ) = 0.e0
289               zfv_vwtl(:,:, 1 ) = 0.e0
290            ELSE                                             ! constant volume : advection through the surface
291               DO jj = 2, jpjm1
292                  DO ji = fs_2, fs_jpim1
293                     zfu_uwtl(ji,jj, 1 ) = 2.e0 * ( zfwtl(ji,jj,1) + zfwtl(ji+1,jj  ,1) ) * un(ji,jj,1)   &
294                                     &   + 2.e0 * ( zfw(ji,jj,1) + zfw(ji+1,jj  ,1) ) * un_tl(ji,jj,1)
295                     zfv_vwtl(ji,jj, 1 ) = 2.e0 * ( zfwtl(ji,jj,1) + zfwtl(ji  ,jj+1,1) ) * vn(ji,jj,1)   &
296                                     &   + 2.e0 * ( zfw(ji,jj,1) + zfw(ji  ,jj+1,1) ) * vn_tl(ji,jj,1)
297                  END DO
298               END DO
299            ENDIF
300         ELSE                                      ! interior fluxes
301            DO jj = 2, jpjm1
302               DO ji = fs_2, fs_jpim1   ! vector opt.
303                  zfu_uwtl(ji,jj,jk) = ( zfwtl(ji,jj,jk)+ zfwtl(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )   &
304                                     &   + ( zfw(ji,jj,jk)+ zfw(ji+1,jj  ,jk) ) * ( un_tl(ji,jj,jk) + un_tl(ji,jj,jk-1) )
305                  zfv_vwtl(ji,jj,jk) = ( zfwtl(ji,jj,jk)+ zfwtl(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )   &
306                                     &   + ( zfw(ji,jj,jk)+ zfw(ji  ,jj+1,jk) ) * ( vn_tl(ji,jj,jk) + vn_tl(ji,jj,jk-1) )
307               END DO
308            END DO
309         ENDIF
310      END DO
311      DO jk = 1, jpkm1                             ! divergence of vertical momentum flux divergence
312         DO jj = 2, jpjm1
313            DO ji = fs_2, fs_jpim1   ! vector opt.
314               ua_tl(ji,jj,jk) =  ua_tl(ji,jj,jk) - ( zfu_uwtl(ji,jj,jk) - zfu_uwtl(ji,jj,jk+1) )    &
315                  &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
316               va_tl(ji,jj,jk) =  va_tl(ji,jj,jk) - ( zfv_vwtl(ji,jj,jk) - zfv_vwtl(ji,jj,jk+1) )    &
317                  &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
318            END DO
319         END DO
320      END DO
321      !
322      CALL wrk_dealloc( jpi, jpj, jpk,       zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
323      CALL wrk_dealloc( jpi, jpj, jpk, jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu                               )
324      CALL wrk_dealloc( jpi, jpj, jpk,       zfu_ttl , zfv_ttl , zfu_ftl , zfv_ftl, zfu_uwtl, zfv_vwtl, zfutl, zfvtl, zfwtl )
325      CALL wrk_dealloc( jpi, jpj, jpk, jpts, zlu_uutl, zlv_vvtl, zlu_uvtl, zlv_vutl                               )
326      !
327      IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_ubs_tan')
328      !
329   END SUBROUTINE dyn_adv_ubs_tan
330#endif
331   !!==============================================================================
332END MODULE dynadv_ubs_tam
Note: See TracBrowser for help on using the repository browser.