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

source: trunk/NEMO/OPA_SRC/TRA/traadv_cen2.F90 @ 1528

Last change on this file since 1528 was 1528, checked in by rblod, 15 years ago

Suppress rigid-lid option, see ticket #486
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 24.1 KB
Line 
1MODULE traadv_cen2
2   !!======================================================================
3   !!                     ***  MODULE  traadv_cen2  ***
4   !! Ocean active tracers:  horizontal & vertical advective trend
5   !!======================================================================
6   !! History :   8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad=traadv
7   !!             8.5  !  02-06  (G. Madec)  F90: Free form and module
8   !!             9.0  !  04-08  (C. Talandier) New trends organization
9   !!             " "  !  05-11  (V. Garnier) Surface pressure gradient organization
10   !!             " "  !  06-04  (R. Benshila, G. Madec) Step reorganization
11   !!             " "  !  06-07  (G. madec)  add ups_orca_set routine
12   !!----------------------------------------------------------------------
13
14   !!----------------------------------------------------------------------
15   !!   tra_adv_cen2 : update the tracer trend with the horizontal and
16   !!                  vertical advection trends using a seconder order
17   !!   ups_orca_set : allow mixed upstream/centered scheme in specific
18   !!                  area (set for orca 2 and 4 only)
19   !!----------------------------------------------------------------------
20   USE oce             ! ocean dynamics and active tracers
21   USE dom_oce         ! ocean space and time domain
22   USE sbc_oce         ! surface boundary condition: ocean
23   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
24   USE trdmod_oce      ! ocean variables trends
25   USE eosbn2          ! equation of state
26   USE trdmod          ! ocean active tracers trends
27   USE closea          ! closed sea
28   USE trabbl          ! advective term in the BBL
29   USE sbcmod          ! surface Boundary Condition
30   USE sbcrnf          ! river runoffs
31   USE in_out_manager  ! I/O manager
32   USE lib_mpp
33   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
34   USE diaptr          ! poleward transport diagnostics
35   USE prtctl          ! Print control
36   USE zdf_oce         ! ocean vertical physics
37
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC   tra_adv_cen2    ! routine called by step.F90
42   PUBLIC   ups_orca_set    ! routine used by traadv_cen2_jki.F90
43
44   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   upsmsk    !: mixed upstream/centered scheme near some straits
45   !                                                   !  and in closed seas (orca 2 and 4 configurations)
46
47   REAL(wp), DIMENSION(jpi,jpj) ::   btr2   ! inverse of T-point surface [1/(e1t*e2t)]
48
49   !! * Substitutions
50#  include "domzgr_substitute.h90"
51#  include "vectopt_loop_substitute.h90"
52   !!----------------------------------------------------------------------
53   !!   OPA 9.0 , LOCEAN-IPSL (2006)
54   !! $Id$
55   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
56   !!----------------------------------------------------------------------
57
58CONTAINS
59
60   SUBROUTINE tra_adv_cen2( kt, pun, pvn, pwn )
61      !!----------------------------------------------------------------------
62      !!                  ***  ROUTINE tra_adv_cen2  ***
63      !!                 
64      !! ** Purpose :   Compute the now trend due to the advection of tracers
65      !!      and add it to the general trend of passive tracer equations.
66      !!
67      !! ** Method  :   The advection is evaluated by a second order centered
68      !!      scheme using now fields (leap-frog scheme). In specific areas
69      !!      (vicinity of major river mouths, some straits, or where tn is
70      !!      approaching the freezing point) it is mixed with an upstream
71      !!      scheme for stability reasons.
72      !!         Part 0 : compute the upstream / centered flag
73      !!                  (3D array, zind, defined at T-point (0<zind<1))
74      !!         Part I : horizontal advection
75      !!       * centered flux:
76      !!               zcenu = e2u*e3u  un  mi(tn)
77      !!               zcenv = e1v*e3v  vn  mj(tn)
78      !!       * upstream flux:
79      !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0]
80      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0]
81      !!       * mixed upstream / centered horizontal advection scheme
82      !!               zcofi = max(zind(i+1), zind(i))
83      !!               zcofj = max(zind(j+1), zind(j))
84      !!               zwx = zcofi * zupsu + (1-zcofi) * zcenu
85      !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv
86      !!       * horizontal advective trend (divergence of the fluxes)
87      !!               zta = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
88      !!       * Add this trend now to the general trend of tracer (ta,sa):
89      !!              (ta,sa) = (ta,sa) + ( zta , zsa )
90      !!       * trend diagnostic ('key_trdtra' defined): the trend is
91      !!      saved for diagnostics. The trends saved is expressed as
92      !!      Uh.gradh(T), i.e.
93      !!                     save trend = zta + tn divn
94      !!         In addition, the advective trend in the two horizontal direc-
95      !!      tion is also re-computed as Uh gradh(T). Indeed hadt+tn divn is
96      !!      equal to (in s-coordinates, and similarly in z-coord.):
97      !!         zta+tn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u  un  di[tn] )
98      !!                                      +mj-1( e1v*e3v  vn  mj[tn] )  }
99      !!         NB:in z-coordinate - full step (ln_zco=T) e3u=e3v=e3t, so
100      !!      they vanish from the expression of the flux and divergence.
101      !!
102      !!         Part II : vertical advection
103      !!      For temperature (idem for salinity) the advective trend is com-
104      !!      puted as follows :
105      !!            zta = 1/e3t dk+1[ zwz ]
106      !!      where the vertical advective flux, zwz, is given by :
107      !!            zwz = zcofk * zupst + (1-zcofk) * zcent
108      !!      with
109      !!        zupsv = upstream flux = wn * (tb(k) or tb(k-1) ) [wn>0 or <0]
110      !!        zcenu = centered flux = wn * mk(tn)
111      !!         The surface boundary condition is :
112      !!      variable volume (lk_vvl = T) : zero advective flux
113      !!      lin. free-surf  (lk_vvl = F) : wn(:,:,1) * tn(:,:,1)
114      !!         Add this trend now to the general trend of tracer (ta,sa):
115      !!            (ta,sa) = (ta,sa) + ( zta , zsa )
116      !!         Trend diagnostic ('key_trdtra' defined): the trend is
117      !!      saved for diagnostics. The trends saved is expressed as :
118      !!             save trend =  w.gradz(T) = zta - tn divn.
119      !!
120      !! ** Action :  - update (ta,sa) with the now advective tracer trends
121      !!              - save trends in (ztrdt,ztrds) ('key_trdtra')
122      !!----------------------------------------------------------------------
123      USE oce, ONLY :   zwx => ua   ! use ua as workspace
124      USE oce, ONLY :   zwy => va   ! use va as workspace
125      !!
126      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index
127      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component
128      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component
129      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component
130      !!
131      INTEGER  ::   ji, jj, jk                           ! dummy loop indices
132      REAL(wp) ::   zta, zsa, zbtr, zhw, ze3tr,       &  ! temporary scalars
133         &          zfp_ui, zfp_vj, zfp_w , zfui  ,   &  !    "         "
134         &          zfm_ui, zfm_vj, zfm_w , zfvj  ,   &  !    "         "
135         &          zcofi , zcofj , zcofk ,           &  !    "         "
136         &          zupsut, zupsus, zcenut, zcenus,   &  !    "         "
137         &          zupsvt, zupsvs, zcenvt, zcenvs,   &  !    "         "
138         &          zupst , zupss , zcent , zcens ,   &  !    "         "
139         &          z_hdivn_x, z_hdivn_y, z_hdivn 
140      REAL(wp) ::   zice                                 !    -         -
141      REAL(wp), DIMENSION(jpi,jpj)     ::   ztfreez            ! 2D workspace
142      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace
143      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww, ztrds         !  "      "
144      !!----------------------------------------------------------------------
145
146      IF( kt == nit000 ) THEN
147         IF(lwp) WRITE(numout,*)
148         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme'
149         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case'
150         IF(lwp) WRITE(numout,*)
151         !
152         upsmsk(:,:) = 0.e0                              ! not upstream by default
153         !
154         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits
155         !                                               ! and in closed seas (orca2 and orca4 only)
156         !   
157         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )        ! inverse of T-point surface
158            IF ( jp_cfg == 2 ) THEN
159            !   Increase the background in the surface layers
160               avmb(1) = 10.  * avmb(1)      ;      avtb(1) = 10.  * avtb(1)
161               avmb(2) = 10.  * avmb(2)      ;      avtb(2) = 10.  * avtb(2)
162               avmb(3) =  5.  * avmb(3)      ;      avtb(3) =  5.  * avtb(3)
163               avmb(4) =  2.5 * avmb(4)      ;      avtb(4) =  2.5 * avtb(4)
164            ENDIF
165      ENDIF
166
167      ! Upstream / centered scheme indicator
168      ! ------------------------------------
169!!gm  not strickly exact : the freezing point should be computed at each ocean levels...
170!!gm  not a big deal since cen2 is no more used in global ice-ocean simulations
171      ztfreez(:,:) = tfreez( sn(:,:,1) )
172      DO jk = 1, jpk
173         DO jj = 1, jpj
174            DO ji = 1, jpi
175               !                                        ! below ice covered area (if tn < "freezing"+0.1 )
176               IF( tn(ji,jj,jk) <= ztfreez(ji,jj) + 0.1 ) THEN   ;   zice = 1.e0
177               ELSE                                              ;   zice = 0.e0
178               ENDIF
179               zind(ji,jj,jk) = MAX (   &
180                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
181                  upsmsk(ji,jj)               ,      &  ! some of some straits
182                  zice                               &  ! below ice covered area (if tn < "freezing"+0.1 )
183                  &                  ) * tmask(ji,jj,jk)
184            END DO
185         END DO
186      END DO
187
188      ! I. Horizontal advective fluxes
189      ! ------------------------------
190      !  Second order centered tracer flux at u and v-points
191      ! -----------------------------------------------------
192      !                                                ! ===============
193      DO jk = 1, jpkm1                                 ! Horizontal slab
194         !                                             ! ===============
195         DO jj = 1, jpjm1
196            DO ji = 1, fs_jpim1   ! vector opt.
197               ! upstream indicator
198               zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
199               zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
200               ! volume fluxes * 1/2
201#if defined key_zco
202               zfui = 0.5 * e2u(ji,jj) * pun(ji,jj,jk)
203               zfvj = 0.5 * e1v(ji,jj) * pvn(ji,jj,jk)
204#else
205               zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
206               zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
207#endif
208               ! upstream scheme
209               zfp_ui = zfui + ABS( zfui )
210               zfp_vj = zfvj + ABS( zfvj )
211               zfm_ui = zfui - ABS( zfui )
212               zfm_vj = zfvj - ABS( zfvj )
213               zupsut = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk)
214               zupsvt = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk)
215               zupsus = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk)
216               zupsvs = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk)
217               ! centered scheme
218               zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) )
219               zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) )
220               zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) )
221               zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) )
222               ! mixed centered / upstream scheme
223               zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut
224               zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt
225               zww(ji,jj,jk) = zcofi * zupsus + (1.-zcofi) * zcenus
226               zwz(ji,jj,jk) = zcofj * zupsvs + (1.-zcofj) * zcenvs
227            END DO
228         END DO
229
230         !  Tracer flux divergence at t-point added to the general trend
231         ! --------------------------------------------------------------
232         DO jj = 2, jpjm1
233            DO ji = fs_2, fs_jpim1   ! vector opt.
234#if defined key_zco
235               zbtr = btr2(ji,jj)
236#else
237               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
238#endif
239               ! horizontal advective trends
240               zta = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
241                  &            + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
242               zsa = - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj  ,jk)   &
243                  &            + zwz(ji,jj,jk) - zwz(ji  ,jj-1,jk)  )
244               ! add it to the general tracer trends
245               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
246               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
247            END DO
248         END DO
249         !                                             ! ===============
250      END DO                                           !   End of slab
251      !                                                ! ===============
252
253      !  Save the horizontal advective trends for diagnostic
254      ! -----------------------------------------------------
255      IF( l_trdtra ) THEN
256         ! T/S ZONAL advection trends
257         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
258         !
259         DO jk = 1, jpkm1
260            DO jj = 2, jpjm1
261               DO ji = fs_2, fs_jpim1   ! vector opt.
262                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
263                  !   N.B. This computation is not valid along OBCs (if any)
264#if defined key_zco
265                  zbtr      = btr2(ji,jj) 
266                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              &
267                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
268#else
269                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
270                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
271                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
272#endif
273                  ztrdt(ji,jj,jk) = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x
274                  ztrds(ji,jj,jk) = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x
275               END DO
276            END DO
277         END DO
278         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
279         !
280         ! T/S MERIDIONAL advection trends
281         DO jk = 1, jpkm1
282            DO jj = 2, jpjm1
283               DO ji = fs_2, fs_jpim1   ! vector opt.
284                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
285                  !   N.B. This computation is not valid along OBCs (if any)
286#if defined key_zco
287                  zbtr      = btr2(ji,jj) 
288                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              &
289                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
290#else
291                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
292                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
293                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
294#endif
295                  ztrdt(ji,jj,jk) = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y         
296                  ztrds(ji,jj,jk) = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y
297               END DO
298            END DO
299         END DO
300         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
301         !
302         ! Save the horizontal up-to-date ta/sa trends
303         ztrdt(:,:,:) = ta(:,:,:) 
304         ztrds(:,:,:) = sa(:,:,:)
305      ENDIF
306
307      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 had  - Ta: ', mask1=tmask, &
308         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' )
309
310      ! "zonal" mean advective heat and salt transport
311      ! ----------------------------------------------
312
313      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
314         IF( lk_zco ) THEN
315            DO jk = 1, jpkm1
316               DO jj = 2, jpjm1
317                  DO ji = fs_2, fs_jpim1   ! vector opt.
318                    zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)
319                    zwz(ji,jj,jk) = zwz(ji,jj,jk) * fse3v(ji,jj,jk)
320                  END DO
321               END DO
322            END DO
323         ENDIF
324         pht_adv(:) = ptr_vj( zwy(:,:,:) )
325         pst_adv(:) = ptr_vj( zwz(:,:,:) )
326      ENDIF
327
328      ! II. Vertical advection
329      ! ----------------------
330
331      ! Bottom value : flux set to zero
332      zwx(:,:,jpk) = 0.e0     ;    zwy(:,:,jpk) = 0.e0
333
334      ! Surface value
335      IF( lk_vvl ) THEN
336         ! variable volume: flux set to zero
337         zwx(:,:, 1 ) = 0.e0    ;    zwy(:,:, 1 ) = 0.e0
338      ELSE
339         ! free surface-constant volume
340         zwx(:,:, 1 ) = pwn(:,:,1) * tn(:,:,1)
341         zwy(:,:, 1 ) = pwn(:,:,1) * sn(:,:,1)
342      ENDIF
343
344      ! 1. Vertical advective fluxes
345      ! ----------------------------
346      ! Second order centered tracer flux at w-point
347      DO jk = 2, jpk
348         DO jj = 2, jpjm1
349            DO ji = fs_2, fs_jpim1   ! vector opt.
350               ! upstream indicator
351               zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) )
352               ! velocity * 1/2
353               zhw = 0.5 * pwn(ji,jj,jk)
354               ! upstream scheme
355               zfp_w = zhw + ABS( zhw )
356               zfm_w = zhw - ABS( zhw )
357               zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1)
358               zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1)
359               ! centered scheme
360               zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) )
361               zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) )
362               ! mixed centered / upstream scheme
363               zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent
364               zwy(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens
365            END DO
366         END DO
367      END DO
368
369      ! 2. Tracer flux divergence at t-point added to the general trend
370      ! -------------------------
371      DO jk = 1, jpkm1
372         DO jj = 2, jpjm1
373            DO ji = fs_2, fs_jpim1   ! vector opt.
374               ze3tr = 1. / fse3t(ji,jj,jk)
375               ! vertical advective trends
376               zta = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
377               zsa = - ze3tr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) )
378               ! add it to the general tracer trends
379               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
380               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
381            END DO
382         END DO
383      END DO
384
385      ! 3. Save the vertical advective trends for diagnostic
386      ! ----------------------------------------------------
387      IF( l_trdtra )   THEN
388         ! Recompute the vertical advection zta & zsa trends computed
389         ! at the step 2. above in making the difference between the new
390         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract
391         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends
392
393         DO jk = 1, jpkm1
394            DO jj = 2, jpjm1
395               DO ji = fs_2, fs_jpim1   ! vector opt.
396#if defined key_zco
397                  zbtr      = btr2(ji,jj) 
398                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
399                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
400#else
401                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
402                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
403                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
404#endif
405                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
406                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn 
407                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
408               END DO
409            END DO
410         END DO
411         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
412      ENDIF
413
414      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 zad  - Ta: ', mask1=tmask, &
415         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' )
416      !
417   END SUBROUTINE tra_adv_cen2
418   
419   
420   SUBROUTINE ups_orca_set
421      !!----------------------------------------------------------------------
422      !!                  ***  ROUTINE ups_orca_set  ***
423      !!       
424      !! ** Purpose :   add a portion of upstream scheme in area where the
425      !!                centered scheme generates too strong overshoot
426      !!
427      !! ** Method  :   orca (R4 and R2) confiiguration setting. Set upsmsk
428      !!                array to nozero value in some straith.
429      !!
430      !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca
431      !!----------------------------------------------------------------------
432      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers
433      !!----------------------------------------------------------------------
434     
435      ! mixed upstream/centered scheme near river mouths
436      ! ------------------------------------------------
437      SELECT CASE ( jp_cfg )
438      !                                        ! =======================
439      CASE ( 4 )                               !  ORCA_R4 configuration
440         !                                     ! =======================
441         !                                          ! Gibraltar Strait
442         ii0 =  70   ;   ii1 =  71
443         ij0 =  52   ;   ij1 =  53   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
444         !
445         !                                     ! =======================
446      CASE ( 2 )                               !  ORCA_R2 configuration
447         !                                     ! =======================
448         !                                          ! Gibraltar Strait
449         ij0 = 102   ;   ij1 = 102
450         ii0 = 138   ;   ii1 = 138   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20
451         ii0 = 139   ;   ii1 = 139   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
452         ii0 = 140   ;   ii1 = 140   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
453         ij0 = 101   ;   ij1 = 102
454         ii0 = 141   ;   ii1 = 141   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
455         !                                          ! Bab el Mandeb Strait
456         ij0 =  87   ;   ij1 =  88
457         ii0 = 164   ;   ii1 = 164   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10
458         ij0 =  88   ;   ij1 =  88
459         ii0 = 163   ;   ii1 = 163   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
460         ii0 = 162   ;   ii1 = 162   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
461         ii0 = 160   ;   ii1 = 161   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
462         ij0 =  89   ;   ij1 =  89
463         ii0 = 158   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
464         ij0 =  90   ;   ij1 =  90
465         ii0 = 160   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
466         !                                          ! Sound Strait
467         ij0 = 116   ;   ij1 = 116
468         ii0 = 144   ;   ii1 = 144   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
469         ii0 = 145   ;   ii1 = 147   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
470         ii0 = 148   ;   ii1 = 148   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
471         !
472      END SELECT 
473     
474      ! mixed upstream/centered scheme over closed seas
475      ! -----------------------------------------------
476      CALL clo_ups( upsmsk(:,:) )
477      !
478   END SUBROUTINE ups_orca_set
479
480   !!======================================================================
481END MODULE traadv_cen2
Note: See TracBrowser for help on using the repository browser.