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

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

No runoff case for centered scheme, see ticket #132
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 23.2 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 trdmod          ! ocean active tracers trends
26   USE closea          ! closed sea
27   USE trabbl          ! advective term in the BBL
28   USE ocfzpt          !
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), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace
140      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww, ztrds         !  "      "
141      !!----------------------------------------------------------------------
142
143      IF( kt == nit000 ) THEN
144         IF(lwp) WRITE(numout,*)
145         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme'
146         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case'
147         IF(lwp) WRITE(numout,*)
148         !
149         upsmsk(:,:) = 0.e0                              ! not upstream by default
150         IF( .NOT. ln_rnf ) THEN                         ! no runoff
151            rnfmsk(:,:) = 0.e0 ; rnfmsk_z(:) = 0.e0
152         ENDIF
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      ENDIF
159
160      ! Upstream / centered scheme indicator
161      ! ------------------------------------
162      DO jk = 1, jpk
163         DO jj = 1, jpj
164            DO ji = 1, jpi
165               zind(ji,jj,jk) = MAX (   &
166                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
167                  upsmsk(ji,jj)                      &  ! some of some straits
168#if defined key_lim3 || defined key_lim2
169                  !                                     ! below ice covered area (if tn < "freezing"+0.1 )
170                  , MAX(  0., SIGN( 1., fzptn(ji,jj) + 0.1 - tn(ji,jj,jk) )  ) * tmask(ji,jj,jk)   &
171#endif
172                  &                  )
173            END DO
174         END DO
175      END DO
176
177      ! I. Horizontal advective fluxes
178      ! ------------------------------
179      !  Second order centered tracer flux at u and v-points
180      ! -----------------------------------------------------
181      !                                                ! ===============
182      DO jk = 1, jpkm1                                 ! Horizontal slab
183         !                                             ! ===============
184         DO jj = 1, jpjm1
185            DO ji = 1, fs_jpim1   ! vector opt.
186               ! upstream indicator
187               zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
188               zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
189               ! volume fluxes * 1/2
190#if defined key_zco
191               zfui = 0.5 * e2u(ji,jj) * pun(ji,jj,jk)
192               zfvj = 0.5 * e1v(ji,jj) * pvn(ji,jj,jk)
193#else
194               zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
195               zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
196#endif
197               ! upstream scheme
198               zfp_ui = zfui + ABS( zfui )
199               zfp_vj = zfvj + ABS( zfvj )
200               zfm_ui = zfui - ABS( zfui )
201               zfm_vj = zfvj - ABS( zfvj )
202               zupsut = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk)
203               zupsvt = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk)
204               zupsus = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk)
205               zupsvs = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk)
206               ! centered scheme
207               zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) )
208               zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) )
209               zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) )
210               zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) )
211               ! mixed centered / upstream scheme
212               zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut
213               zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt
214               zww(ji,jj,jk) = zcofi * zupsus + (1.-zcofi) * zcenus
215               zwz(ji,jj,jk) = zcofj * zupsvs + (1.-zcofj) * zcenvs
216            END DO
217         END DO
218
219         !  Tracer flux divergence at t-point added to the general trend
220         ! --------------------------------------------------------------
221         DO jj = 2, jpjm1
222            DO ji = fs_2, fs_jpim1   ! vector opt.
223#if defined key_zco
224               zbtr = btr2(ji,jj)
225#else
226               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
227#endif
228               ! horizontal advective trends
229               zta = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
230                  &            + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
231               zsa = - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj  ,jk)   &
232                  &            + zwz(ji,jj,jk) - zwz(ji  ,jj-1,jk)  )
233               ! add it to the general tracer trends
234               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
235               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
236            END DO
237         END DO
238         !                                             ! ===============
239      END DO                                           !   End of slab
240      !                                                ! ===============
241
242      !  Save the horizontal advective trends for diagnostic
243      ! -----------------------------------------------------
244      IF( l_trdtra ) THEN
245         ! T/S ZONAL advection trends
246         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
247         !
248         DO jk = 1, jpkm1
249            DO jj = 2, jpjm1
250               DO ji = fs_2, fs_jpim1   ! vector opt.
251                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
252                  !   N.B. This computation is not valid along OBCs (if any)
253#if defined key_zco
254                  zbtr      = btr2(ji,jj) 
255                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              &
256                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
257#else
258                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
259                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
260                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
261#endif
262                  ztrdt(ji,jj,jk) = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x
263                  ztrds(ji,jj,jk) = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x
264               END DO
265            END DO
266         END DO
267         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
268         !
269         ! T/S MERIDIONAL advection trends
270         DO jk = 1, jpkm1
271            DO jj = 2, jpjm1
272               DO ji = fs_2, fs_jpim1   ! vector opt.
273                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
274                  !   N.B. This computation is not valid along OBCs (if any)
275#if defined key_zco
276                  zbtr      = btr2(ji,jj) 
277                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              &
278                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
279#else
280                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
281                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
282                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
283#endif
284                  ztrdt(ji,jj,jk) = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y         
285                  ztrds(ji,jj,jk) = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y
286               END DO
287            END DO
288         END DO
289         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
290         !
291         ! Save the horizontal up-to-date ta/sa trends
292         ztrdt(:,:,:) = ta(:,:,:) 
293         ztrds(:,:,:) = sa(:,:,:)
294      ENDIF
295
296      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 had  - Ta: ', mask1=tmask, &
297         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' )
298
299      ! "zonal" mean advective heat and salt transport
300      ! ----------------------------------------------
301
302      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
303         IF( lk_zco ) THEN
304            DO jk = 1, jpkm1
305               DO jj = 2, jpjm1
306                  DO ji = fs_2, fs_jpim1   ! vector opt.
307                    zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)
308                    zwz(ji,jj,jk) = zwz(ji,jj,jk) * fse3v(ji,jj,jk)
309                  END DO
310               END DO
311            END DO
312         ENDIF
313         pht_adv(:) = ptr_vj( zwy(:,:,:) )
314         pst_adv(:) = ptr_vj( zwz(:,:,:) )
315      ENDIF
316
317      ! II. Vertical advection
318      ! ----------------------
319
320      ! Bottom value : flux set to zero
321      zwx(:,:,jpk) = 0.e0     ;    zwy(:,:,jpk) = 0.e0
322
323      ! Surface value
324      IF( lk_dynspg_rl .OR. lk_vvl ) THEN
325         ! rigid lid or variable volume: flux set to zero
326         zwx(:,:, 1 ) = 0.e0    ;    zwy(:,:, 1 ) = 0.e0
327      ELSE
328         ! free surface
329         zwx(:,:, 1 ) = pwn(:,:,1) * tn(:,:,1)
330         zwy(:,:, 1 ) = pwn(:,:,1) * sn(:,:,1)
331      ENDIF
332
333      ! 1. Vertical advective fluxes
334      ! ----------------------------
335      ! Second order centered tracer flux at w-point
336      DO jk = 2, jpk
337         DO jj = 2, jpjm1
338            DO ji = fs_2, fs_jpim1   ! vector opt.
339               ! upstream indicator
340               zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) )
341               ! velocity * 1/2
342               zhw = 0.5 * pwn(ji,jj,jk)
343               ! upstream scheme
344               zfp_w = zhw + ABS( zhw )
345               zfm_w = zhw - ABS( zhw )
346               zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1)
347               zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1)
348               ! centered scheme
349               zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) )
350               zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) )
351               ! mixed centered / upstream scheme
352               zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent
353               zwy(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens
354            END DO
355         END DO
356      END DO
357
358      ! 2. Tracer flux divergence at t-point added to the general trend
359      ! -------------------------
360      DO jk = 1, jpkm1
361         DO jj = 2, jpjm1
362            DO ji = fs_2, fs_jpim1   ! vector opt.
363               ze3tr = 1. / fse3t(ji,jj,jk)
364               ! vertical advective trends
365               zta = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
366               zsa = - ze3tr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) )
367               ! add it to the general tracer trends
368               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
369               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
370            END DO
371         END DO
372      END DO
373
374      ! 3. Save the vertical advective trends for diagnostic
375      ! ----------------------------------------------------
376      IF( l_trdtra )   THEN
377         ! Recompute the vertical advection zta & zsa trends computed
378         ! at the step 2. above in making the difference between the new
379         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract
380         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends
381
382         DO jk = 1, jpkm1
383            DO jj = 2, jpjm1
384               DO ji = fs_2, fs_jpim1   ! vector opt.
385#if defined key_zco
386                  zbtr      = btr2(ji,jj) 
387                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
388                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
389#else
390                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
391                  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)
392                  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)
393#endif
394                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
395                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn 
396                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
397               END DO
398            END DO
399         END DO
400         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
401      ENDIF
402
403      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 zad  - Ta: ', mask1=tmask, &
404         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' )
405      !
406   END SUBROUTINE tra_adv_cen2
407   
408   
409   SUBROUTINE ups_orca_set
410      !!----------------------------------------------------------------------
411      !!                  ***  ROUTINE ups_orca_set  ***
412      !!       
413      !! ** Purpose :   add a portion of upstream scheme in area where the
414      !!                centered scheme generates too strong overshoot
415      !!
416      !! ** Method  :   orca (R4 and R2) confiiguration setting. Set upsmsk
417      !!                array to nozero value in some straith.
418      !!
419      !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca
420      !!----------------------------------------------------------------------
421      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers
422      !!----------------------------------------------------------------------
423     
424      ! mixed upstream/centered scheme near river mouths
425      ! ------------------------------------------------
426      SELECT CASE ( jp_cfg )
427      !                                        ! =======================
428      CASE ( 4 )                               !  ORCA_R4 configuration
429         !                                     ! =======================
430         !                                          ! Gibraltar Strait
431         ii0 =  70   ;   ii1 =  71
432         ij0 =  52   ;   ij1 =  53   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
433         !
434         !                                     ! =======================
435      CASE ( 2 )                               !  ORCA_R2 configuration
436         !                                     ! =======================
437         !                                          ! Gibraltar Strait
438         ij0 = 102   ;   ij1 = 102
439         ii0 = 138   ;   ii1 = 138   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20
440         ii0 = 139   ;   ii1 = 139   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
441         ii0 = 140   ;   ii1 = 140   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
442         ij0 = 101   ;   ij1 = 102
443         ii0 = 141   ;   ii1 = 141   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
444         !                                          ! Bab el Mandeb Strait
445         ij0 =  87   ;   ij1 =  88
446         ii0 = 164   ;   ii1 = 164   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10
447         ij0 =  88   ;   ij1 =  88
448         ii0 = 163   ;   ii1 = 163   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
449         ii0 = 162   ;   ii1 = 162   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
450         ii0 = 160   ;   ii1 = 161   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
451         ij0 =  89   ;   ij1 =  89
452         ii0 = 158   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
453         ij0 =  90   ;   ij1 =  90
454         ii0 = 160   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
455         !                                          ! Sound Strait
456         ij0 = 116   ;   ij1 = 116
457         ii0 = 144   ;   ii1 = 144   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
458         ii0 = 145   ;   ii1 = 147   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
459         ii0 = 148   ;   ii1 = 148   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
460         !
461      END SELECT 
462     
463      ! mixed upstream/centered scheme over closed seas
464      ! -----------------------------------------------
465      CALL clo_ups( upsmsk(:,:) )
466      !
467   END SUBROUTINE ups_orca_set
468
469   !!======================================================================
470END MODULE traadv_cen2
Note: See TracBrowser for help on using the repository browser.