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 @ 1146

Last change on this file since 1146 was 1146, checked in by rblod, 16 years ago

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