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_ubs.F90 in branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA – NEMO

source: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traadv_ubs.F90 @ 8568

Last change on this file since 8568 was 8568, checked in by gm, 7 years ago

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