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

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

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