source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 5 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge —reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

  • Property svn:keywords set to Id
File size: 20.2 KB
Line 
1MODULE traadv_ubs
2   !!==============================================================================
3   !!                       ***  MODULE  traadv_ubs  ***
4   !! Ocean active tracers:  horizontal & vertical advective trend
5   !!==============================================================================
6   !! History :  1.0  !  2006-08  (L. Debreu, R. Benshila)  Original code
7   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   tra_adv_ubs : update the tracer trend with the horizontal
12   !!                 advection trends using a third order biaised scheme 
13   !!----------------------------------------------------------------------
14   USE oce            ! ocean dynamics and active tracers
15   USE dom_oce        ! ocean space and time domain
16   USE trc_oce        ! share passive tracers/Ocean variables
17   USE trd_oce        ! trends: ocean variables
18   USE traadv_fct      ! acces to routine interp_4th_cpt
19   USE trdtra         ! trends manager: tracers
20   USE diaptr         ! poleward transport diagnostics
21   !
22   USE lib_mpp        ! I/O library
23   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
24   USE in_out_manager ! I/O manager
25   USE wrk_nemo       ! Memory Allocation
26   USE timing         ! Timing
27   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   tra_adv_ubs   ! routine called by traadv module
33
34   LOGICAL :: l_trd  ! flag to compute trends or not
35
36   !! * Substitutions
37#  include "vectopt_loop_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
40   !! $Id$
41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
42   !!----------------------------------------------------------------------
43CONTAINS
44
45   SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pun, pvn, pwn,          &
46      &                                                ptb, ptn, pta, kjpt, kn_ubs_v )
47      !!----------------------------------------------------------------------
48      !!                  ***  ROUTINE tra_adv_ubs  ***
49      !!                 
50      !! ** Purpose :   Compute the now trend due to the advection of tracers
51      !!      and add it to the general trend of passive tracer equations.
52      !!
53      !! ** Method  :   The 3rd order Upstream Biased Scheme (UBS) is based on an
54      !!      upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005)
55      !!      It is only used in the horizontal direction.
56      !!      For example the i-component of the advective fluxes are given by :
57      !!                !  e2u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0
58      !!          ztu = !  or
59      !!                !  e2u e3u un ( mi(Tn) - zltu(i+1) )   if un(i) < 0
60      !!      where zltu is the second derivative of the before temperature field:
61      !!          zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ]
62      !!        This results in a dissipatively dominant (i.e. hyper-diffusive)
63      !!      truncation error. The overall performance of the advection scheme
64      !!      is similar to that reported in (Farrow and Stevens, 1995).
65      !!        For stability reasons, the first term of the fluxes which corresponds
66      !!      to a second order centered scheme is evaluated using the now velocity
67      !!      (centered in time) while the second term which is the diffusive part
68      !!      of the scheme, is evaluated using the before velocity (forward in time).
69      !!      Note that UBS is not positive. Do not use it on passive tracers.
70      !!                On the vertical, the advection is evaluated using a FCT scheme,
71      !!      as the UBS have been found to be too diffusive.
72      !!                kn_ubs_v argument controles whether the FCT is based on
73      !!      a 2nd order centrered scheme (kn_ubs_v=2) or on a 4th order compact
74      !!      scheme (kn_ubs_v=4).
75      !!
76      !! ** Action : - update pta  with the now advective tracer trends
77      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
78      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
79      !!
80      !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404.
81      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741.
82      !!----------------------------------------------------------------------
83      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
84      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
85      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
86      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
87      INTEGER                              , INTENT(in   ) ::   kn_ubs_v        ! number of tracers
88      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
89      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean transport components
90      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
91      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend
92      !
93      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
94      REAL(wp) ::   ztra, zbtr, zcoef                       ! local scalars
95      REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      -
96      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      -
97      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zltu, zltv, zti, ztw
98      !!----------------------------------------------------------------------
99      !
100      IF( nn_timing == 1 )  CALL timing_start('tra_adv_ubs')
101      !
102      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
103      !
104      IF( kt == kit000 )  THEN
105         IF(lwp) WRITE(numout,*)
106         IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme on ', cdtype
107         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
108      ENDIF
109      !
110      l_trd = .FALSE.
111      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
112      !
113      ztw (:,:, 1 ) = 0._wp      ! surface & bottom value : set to zero for all tracers
114      zltu(:,:,jpk) = 0._wp   ;   zltv(:,:,jpk) = 0._wp
115      ztw (:,:,jpk) = 0._wp   ;   zti (:,:,jpk) = 0._wp
116      !
117      !                                                          ! ===========
118      DO jn = 1, kjpt                                            ! tracer loop
119         !                                                       ! ===========
120         !                                             
121         DO jk = 1, jpkm1        !==  horizontal laplacian of before tracer ==!
122            DO jj = 1, jpjm1              ! First derivative (masked gradient)
123               DO ji = 1, fs_jpim1   ! vector opt.
124                  zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
125                  zeev = e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
126                  ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
127                  ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
128               END DO
129            END DO
130            DO jj = 2, jpjm1              ! Second derivative (divergence)
131               DO ji = fs_2, fs_jpim1   ! vector opt.
132                  zcoef = 1._wp / ( 6._wp * e3t_n(ji,jj,jk) )
133                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
134                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
135               END DO
136            END DO
137            !                                   
138         END DO         
139         CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
140         !   
141         DO jk = 1, jpkm1        !==  Horizontal advective fluxes  ==!     (UBS)
142            DO jj = 1, jpjm1
143               DO ji = 1, fs_jpim1   ! vector opt.
144                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )      ! upstream transport (x2)
145                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
146                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
147                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
148                  !                                                  ! 2nd order centered advective fluxes (x2)
149                  zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
150                  zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
151                  !                                                  ! UBS advective fluxes
152                  ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) )
153                  ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) )
154               END DO
155            END DO
156         END DO         
157         !
158         zltu(:,:,:) = pta(:,:,:,jn)      ! store the initial trends before its update
159         !
160         DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==!
161            DO jj = 2, jpjm1
162               DO ji = fs_2, fs_jpim1   ! vector opt.
163                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                        &
164                     &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    &
165                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
166               END DO
167            END DO
168            !                                             
169         END DO
170         !
171         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case
172         !                                            ! and/or in trend diagnostic (l_trd=T)
173         !               
174         IF( l_trd ) THEN                  ! trend diagnostics
175             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pun, ptn(:,:,:,jn) )
176             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) )
177         END IF
178         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
179         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
180            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( ztv(:,:,:) )
181            IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) )
182         ENDIF
183         !
184         !                       !== vertical advective trend  ==!
185         !
186         SELECT CASE( kn_ubs_v )       ! select the vertical advection scheme
187         !
188         CASE(  2  )                   ! 2nd order FCT
189            !         
190            IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag.
191            !
192            !                          !*  upstream advection with initial mass fluxes & intermediate update  ==!
193            DO jk = 2, jpkm1                 ! Interior value (w-masked)
194               DO jj = 1, jpj
195                  DO ji = 1, jpi
196                     zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
197                     zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
198                     ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  ) * wmask(ji,jj,jk)
199                  END DO
200               END DO
201            END DO
202            IF( ln_linssh ) THEN             ! top ocean value (only in linear free surface as ztw has been w-masked)
203               IF( ln_isfcav ) THEN                ! top of the ice-shelf cavities and at the ocean surface
204                  DO jj = 1, jpj
205                     DO ji = 1, jpi
206                        ztw(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface
207                     END DO
208                  END DO   
209               ELSE                                ! no cavities: only at the ocean surface
210                  ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
211               ENDIF
212            ENDIF
213            !
214            DO jk = 1, jpkm1           !* trend and after field with monotonic scheme
215               DO jj = 2, jpjm1
216                  DO ji = fs_2, fs_jpim1   ! vector opt.
217                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
218                     pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak 
219                     zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
220                  END DO
221               END DO
222            END DO
223            CALL lbc_lnk( zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
224            !
225            !                          !*  anti-diffusive flux : high order minus low order
226            DO jk = 2, jpkm1        ! Interior value  (w-masked)
227               DO jj = 1, jpj
228                  DO ji = 1, jpi
229                     ztw(ji,jj,jk) = (   0.5_wp * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   &
230                        &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
231                  END DO
232               END DO
233            END DO
234            !                                            ! top ocean value: high order == upstream  ==>>  zwz=0
235            IF( ln_linssh )   ztw(:,:, 1 ) = 0._wp       ! only ocean surface as interior zwz values have been w-masked
236            !
237            CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm
238            !
239         CASE(  4  )                               ! 4th order COMPACT
240            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point
241            DO jk = 2, jpkm1
242               DO jj = 2, jpjm1
243                  DO ji = fs_2, fs_jpim1
244                     ztw(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
245                  END DO
246               END DO
247            END DO
248            IF( ln_linssh )   ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work
249            !
250         END SELECT
251         !
252         DO jk = 1, jpkm1        !  final trend with corrected fluxes
253            DO jj = 2, jpjm1 
254               DO ji = fs_2, fs_jpim1   ! vector opt.   
255                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
256               END DO
257            END DO
258         END DO
259         !
260         IF( l_trd )  THEN       ! vertical advective trend diagnostics
261            DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
262               DO jj = 2, jpjm1
263                  DO ji = fs_2, fs_jpim1   ! vector opt.
264                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk)                          &
265                        &           + ptn(ji,jj,jk,jn) * (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  )   &
266                        &                              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
267                  END DO
268               END DO
269            END DO
270            CALL trd_tra( kt, cdtype, jn, jptra_zad, zltv )
271         ENDIF
272         !
273      END DO
274      !
275      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
276      !
277      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_ubs')
278      !
279   END SUBROUTINE tra_adv_ubs
280
281
282   SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt )
283      !!---------------------------------------------------------------------
284      !!                    ***  ROUTINE nonosc_z  ***
285      !!     
286      !! **  Purpose :   compute monotonic tracer fluxes from the upstream
287      !!       scheme and the before field by a nonoscillatory algorithm
288      !!
289      !! **  Method  :   ... ???
290      !!       warning : pbef and paft must be masked, but the boundaries
291      !!       conditions on the fluxes are not necessary zalezak (1979)
292      !!       drange (1995) multi-dimensional forward-in-time and upstream-
293      !!       in-space based differencing for fluid
294      !!----------------------------------------------------------------------
295      REAL(wp), INTENT(in   )                          ::   p2dt   ! tracer time-step
296      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
297      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field
298      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction
299      !
300      INTEGER  ::   ji, jj, jk   ! dummy loop indices
301      INTEGER  ::   ikm1         ! local integer
302      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars
303      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo
304      !!----------------------------------------------------------------------
305      !
306      IF( nn_timing == 1 )  CALL timing_start('nonosc_z')
307      !
308      CALL wrk_alloc( jpi,jpj,jpk,   zbetup, zbetdo )
309      !
310      zbig  = 1.e+40_wp
311      zrtrn = 1.e-15_wp
312      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
313      !
314      ! Search local extrema
315      ! --------------------
316      !                    ! large negative value (-zbig) inside land
317      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
318      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
319      !
320      DO jk = 1, jpkm1     ! search maximum in neighbourhood
321         ikm1 = MAX(jk-1,1)
322         DO jj = 2, jpjm1
323            DO ji = fs_2, fs_jpim1   ! vector opt.
324               zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
325                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
326                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
327            END DO
328         END DO
329      END DO
330      !                    ! large positive value (+zbig) inside land
331      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
332      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
333      !
334      DO jk = 1, jpkm1     ! search minimum in neighbourhood
335         ikm1 = MAX(jk-1,1)
336         DO jj = 2, jpjm1
337            DO ji = fs_2, fs_jpim1   ! vector opt.
338               zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
339                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
340                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
341            END DO
342         END DO
343      END DO
344      !                    ! restore masked values to zero
345      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
346      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
347      !
348      ! Positive and negative part of fluxes and beta terms
349      ! ---------------------------------------------------
350      DO jk = 1, jpkm1
351         DO jj = 2, jpjm1
352            DO ji = fs_2, fs_jpim1   ! vector opt.
353               ! positive & negative part of the flux
354               zpos = MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
355               zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
356               ! up & down beta terms
357               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt
358               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt
359               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
360            END DO
361         END DO
362      END DO
363      !
364      ! monotonic flux in the k direction, i.e. pcc
365      ! -------------------------------------------
366      DO jk = 2, jpkm1
367         DO jj = 2, jpjm1
368            DO ji = fs_2, fs_jpim1   ! vector opt.
369               za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
370               zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
371               zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pcc(ji,jj,jk) ) )
372               pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
373            END DO
374         END DO
375      END DO
376      !
377      CALL wrk_dealloc( jpi,jpj,jpk,   zbetup, zbetdo )
378      !
379      IF( nn_timing == 1 )  CALL timing_stop('nonosc_z')
380      !
381   END SUBROUTINE nonosc_z
382
383   !!======================================================================
384END MODULE traadv_ubs
Note: See TracBrowser for help on using the repository browser.