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

Last change on this file since 888 was 888, checked in by ctlod, 16 years ago

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