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.
Changeset 786 – NEMO

Changeset 786


Ignore:
Timestamp:
2008-01-10T18:11:23+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - merge TRC-TRA on OPA only, trabbl & zpshde not done and trdmld not OK - compilation OK

Location:
branches/dev_001_GM/NEMO/OPA_SRC/TRA
Files:
2 deleted
22 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traadv.F90

    r719 r786  
    1414   USE dom_oce         ! ocean space and time domain 
    1515   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine) 
    16    USE traadv_cen2_jki ! 2nd order centered scheme (tra_adv_cen2   routine) 
    1716   USE traadv_tvd      ! TVD      scheme           (tra_adv_tvd    routine) 
    1817   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine) 
    … …  
    2423   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    2524   USE in_out_manager  ! I/O manager 
    26    USE prtctl          ! Print control 
     25!  USE prtctl          ! Print control 
    2726 
    2827   IMPLICIT NONE 
    … …  
    8887 
    8988      SELECT CASE ( nadv )                           ! compute advection trend and add it to general trend 
    90       CASE ( 0 )   ;   CALL tra_adv_cen2    ( kt, zun, zvn, zwn )    ! 2nd order centered scheme k-j-i loops 
    91       CASE ( 1 )   ;   CALL tra_adv_cen2_jki( kt, zun, zvn, zwn )    ! 2nd order centered scheme 
    92       CASE ( 2 )   ;   CALL tra_adv_tvd     ( kt, zun, zvn, zwn )    ! TVD      scheme 
    93       CASE ( 3 )   ;   CALL tra_adv_muscl   ( kt, zun, zvn, zwn )    ! MUSCL    scheme 
    94       CASE ( 4 )   ;   CALL tra_adv_muscl2  ( kt, zun, zvn, zwn )    ! MUSCL2   scheme 
    95       CASE ( 5 )   ;   CALL tra_adv_ubs     ( kt, zun, zvn, zwn )    ! UBS      scheme 
    96       CASE ( 6 )   ;   CALL tra_adv_qck     ( kt, zun, zvn, zwn )    ! QUICKEST scheme 
     89      CASE ( 0 )   ;   CALL tra_adv_cen2    ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! 2nd order centered 
     90                       CALL tra_adv_cen2    ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! 2nd order centered 
     91!     CASE ( 1 )   ;   CALL tra_adv_cen2_jki( kt, zun, zvn, zwn )    ! 2nd order centered scheme 
     92      CASE ( 2 )   ;   CALL tra_adv_tvd     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! TVD      scheme 
     93                       CALL tra_adv_tvd     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! TVD      scheme 
     94      CASE ( 3 )   ;   CALL tra_adv_muscl   ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb    , ta )    ! MUSCL    scheme 
     95                       CALL tra_adv_muscl   ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb    , sa )    ! MUSCL    scheme 
     96      CASE ( 4 )   ;   CALL tra_adv_muscl2  ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! MUSCL2   scheme 
     97                       CALL tra_adv_muscl2  ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! MUSCL2   scheme 
     98      CASE ( 5 )   ;   CALL tra_adv_ubs     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! UBS      scheme 
     99                       CALL tra_adv_ubs     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! UBS      scheme 
     100      CASE ( 6 )   ;   CALL tra_adv_qck     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! QUICKEST scheme 
     101                       CALL tra_adv_qck     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! QUICKEST scheme 
    97102      ! 
    98103      CASE (-1 )                                                     ! esopa: test all possibility with control print 
    99                        CALL tra_adv_cen2    ( kt, zun, zvn, zwn ) 
    100                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv0 - Ta: ', mask1=tmask,               & 
    101             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    102                        CALL tra_adv_cen2_jki( kt, zun, zvn, zwn ) 
    103                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv1 - Ta: ', mask1=tmask,               & 
    104             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    105                        CALL tra_adv_tvd     ( kt, zun, zvn, zwn ) 
    106                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv2 - Ta: ', mask1=tmask,               & 
    107             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    108                        CALL tra_adv_muscl   ( kt, zun, zvn, zwn ) 
    109                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv3 - Ta: ', mask1=tmask,               & 
    110             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    111                        CALL tra_adv_muscl2  ( kt, zun, zvn, zwn ) 
    112                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv4 - Ta: ', mask1=tmask,               & 
    113             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    114                        CALL tra_adv_ubs     ( kt, zun, zvn, zwn ) 
    115                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv5 - Ta: ', mask1=tmask,               & 
    116             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    117                        CALL tra_adv_qck     ( kt, zun, zvn, zwn ) 
    118                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv6 - Ta: ', mask1=tmask,               & 
    119             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     104                       CALL tra_adv_cen2    ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! 2nd order centered 
     105                       CALL tra_adv_cen2    ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! 2nd order centered 
     106                       CALL tra_adv_tvd     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! TVD      scheme 
     107                       CALL tra_adv_tvd     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! TVD      scheme 
     108                       CALL tra_adv_muscl   ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb    , ta )    ! MUSCL    scheme 
     109                       CALL tra_adv_muscl   ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb    , sa )    ! MUSCL    scheme 
     110                       CALL tra_adv_muscl2  ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! MUSCL2   scheme 
     111                       CALL tra_adv_muscl2  ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! MUSCL2   scheme 
     112                       CALL tra_adv_ubs     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! UBS      scheme 
     113                       CALL tra_adv_ubs     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! UBS      scheme 
     114                       CALL tra_adv_qck     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! QUICKEST scheme 
     115                       CALL tra_adv_qck     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! QUICKEST scheme 
    120116      END SELECT 
    121       !                                              ! print mean trends (used for debugging) 
    122       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' adv  - Ta: ', mask1=tmask,               & 
    123          &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    124117      ! 
    125118   END SUBROUTINE tra_adv 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r719 r786  
    66   !! History :  8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad = traadv  
    77   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    8    !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    9    !!            " "  !  06-04  (R. Benshila, G. Madec) Step reorganization 
    10    !!---------------------------------------------------------------------- 
    11  
    12    !!---------------------------------------------------------------------- 
    13    !!   tra_adv_cen2 : update the tracer trend with the horizontal and 
    14    !!                  vertical advection trends using a seconder order 
    15    !!                  centered scheme. (k-j-i loops) 
    16    !!---------------------------------------------------------------------- 
    17    USE oce             ! ocean dynamics and active tracers 
     8   !!   NEMO     1.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
     9   !!             -   !  05-11  (V. Garnier) Surface pressure gradient organization 
     10   !!             -   !  06-04  (R. Benshila, G. Madec) Step reorganization 
     11   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
     12   !!---------------------------------------------------------------------- 
     13 
     14   !!---------------------------------------------------------------------- 
     15   !!   tra_adv_cen2 : update the tracer trend with the horizontal and vertical 
     16   !!                  advection trends using a 2nd order centered scheme 
     17   !!---------------------------------------------------------------------- 
     18   USE oce, ONLY: tn   ! now ocean temperature 
    1819   USE dom_oce         ! ocean space and time domain 
    1920   USE trdmod          ! ocean active tracers trends  
    2021   USE trdmod_oce      ! ocean variables trends 
    2122   USE flxrnf          ! 
    22    USE trabbl          ! advective term in the BBL 
    2323   USE ocfzpt          ! 
    2424   USE lib_mpp 
    … …  
    4040#  include "vectopt_loop_substitute.h90" 
    4141   !!---------------------------------------------------------------------- 
    42    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    43    !! $Header$  
     42   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     43   !! $Id:$  
    4444   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
    … …  
    4747CONTAINS 
    4848 
    49    SUBROUTINE tra_adv_cen2( kt, pun, pvn, pwn ) 
     49   SUBROUTINE tra_adv_cen2( kt, cdtype, ktra, pun, pvn, pwn,   & 
     50      &                                       ptb, ptn, pta ) 
    5051      !!---------------------------------------------------------------------- 
    5152      !!                  ***  ROUTINE tra_adv_cen2  *** 
    5253      !!                  
    53       !! ** Purpose :   Compute the now trend due to the advection of tracers 
    54       !!      and add it to the general trend of passive tracer equations. 
     54      !! ** Purpose :   Compute the now trend due to the advection of a tracer 
     55      !!      and add it to the corresponding general trend of tracer equations. 
    5556      !! 
    5657      !! ** Method  :   The advection is evaluated by a second order centered 
    … …  
    6364      !!         Part I : horizontal advection 
    6465      !!       * centered flux: 
    65       !!               zcenu = e2u*e3u  un  mi(tn) 
    66       !!               zcenv = e1v*e3v  vn  mj(tn) 
     66      !!               zcenu = e2u*e3u  un  mi(ptn) 
     67      !!               zcenv = e1v*e3v  vn  mj(ptn) 
    6768      !!       * upstream flux: 
    68       !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0] 
     69      !!               zupsu = e2u*e3u  un  (ptb(i) or ptb(i-1) ) [un>0 or <0] 
    6970      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0] 
    7071      !!       * mixed upstream / centered horizontal advection scheme 
    … …  
    7576      !!       * horizontal advective trend (divergence of the fluxes) 
    7677      !!               zta = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] } 
    77       !!       * Add this trend now to the general trend of tracer (ta,sa): 
    78       !!              (ta,sa) = (ta,sa) + ( zta , zsa ) 
    79       !!       * trend diagnostic ('key_trdtra' defined): the trend is 
     78      !!       * Add this trend now to the general trend of tracer (pta): 
     79      !!               pta = pta + zta  
     80      !!       * trend diagnostic (lk_trdtra=T): the trend is 
    8081      !!      saved for diagnostics. The trends saved is expressed as 
    8182      !!      Uh.gradh(T), i.e. 
    82       !!                     save trend = zta + tn divn 
     83      !!                     save trend = zta + ptn divn 
    8384      !!         In addition, the advective trend in the two horizontal direc- 
    84       !!      tion is also re-computed as Uh gradh(T). Indeed hadt+tn divn is 
     85      !!      tion is also re-computed as Uh gradh(T). Indeed hadt+ptn divn is 
    8586      !!      equal to (in s-coordinates, and similarly in z-coord.): 
    86       !!         zta+tn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u  un  di[tn] ) 
    87       !!                                      +mj-1( e1v*e3v  vn  mj[tn] )  } 
     87      !!         zta+ptn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u  un  di[ptn] ) 
     88      !!                                       +mj-1( e1v*e3v  vn  mj[ptn] )  } 
    8889      !!         NB:in z-coordinate - full step (ln_zco=T) e3u=e3v=e3t, so 
    8990      !!      they vanish from the expression of the flux and divergence. 
    9091      !! 
    9192      !!         Part II : vertical advection 
    92       !!      For temperature (idem for salinity) the advective trend is com- 
    93       !!      puted as follows : 
    94       !!            zta = 1/e3t dk+1[ zwz ] 
    95       !!      where the vertical advective flux, zwz, is given by : 
    96       !!            zwz = zcofk * zupst + (1-zcofk) * zcent 
     93      !!      the advective trend is computed as follows : 
     94      !!            zta = 1/e3t dk+1[ zwx ] 
     95      !!      where the vertical advective flux, zwx, is given by : 
     96      !!            zwx = zcofk * zupst + (1-zcofk) * zcent 
    9797      !!      with 
    9898      !!        zupsv = upstream flux = wn * (tb(k) or tb(k-1) ) [wn>0 or <0] 
    99       !!        zcenu = centered flux = wn * mk(tn) 
     99      !!        zcenu = centered flux = wn * mk(ptn) 
    100100      !!         The surface boundary condition is : 
    101101      !!      rigid-lid (lk_dynspg_frd = T) : zero advective flux 
    102       !!      free-surf (lk_dynspg_fsc = T) : wn(:,:,1) * tn(:,:,1) 
     102      !!      free-surf (lk_dynspg_fsc = T) : wn(:,:,1) * ptn(:,:,1) 
    103103      !!         Add this trend now to the general trend of tracer (ta,sa): 
    104104      !!            (ta,sa) = (ta,sa) + ( zta , zsa ) 
    105105      !!         Trend diagnostic ('key_trdtra' defined): the trend is 
    106106      !!      saved for diagnostics. The trends saved is expressed as : 
    107       !!             save trend =  w.gradz(T) = zta - tn divn. 
     107      !!             save trend =  w.gradz(T) = zta - ptn divn. 
    108108      !! 
    109109      !! ** Action :  - update (ta,sa) with the now advective tracer trends 
    110       !!              - save trends in (ztrdt,ztrds) ('key_trdtra') 
     110      !!              - trend diagnostics (lk_trdtra=T) 
    111111      !!---------------------------------------------------------------------- 
    112       USE oce, ONLY :   zwx => ua   ! use ua as workspace 
    113       USE oce, ONLY :   zwy => va   ! use va as workspace 
    114       !! 
    115       INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
    116       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component 
    117       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component 
    118       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component 
    119       !! 
    120       INTEGER  ::   ji, jj, jk                           ! dummy loop indices 
    121       REAL(wp) ::                           & 
    122          zbtr, zta, zsa, zfui, zfvj,        &  ! temporary scalars 
    123          zhw, ze3tr, zcofi, zcofj,          &  !    "         " 
    124          zupsut, zupsvt, zupsus, zupsvs,    &  !    "         " 
    125          zfp_ui, zfp_vj, zfm_ui, zfm_vj,    &  !    "         " 
    126          zcofk, zupst, zupss, zcent,        &  !    "         " 
    127          zcens, zfp_w, zfm_w,               &  !    "         " 
    128          zcenut, zcenvt, zcenus, zcenvs,    &  !    "         " 
    129          z_hdivn_x, z_hdivn_y, z_hdivn 
    130       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace  
    131       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww, ztrds         !  "      " 
     112      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     113      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     114      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     115      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     116      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb, ptn        ! before and now tracer fields 
     117      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
     118      !! 
     119      INTEGER  ::   ji, jj, jk                                    ! dummy loop indices 
     120      REAL(wp) ::   zbtr, zta, zhw, ze3tr                         ! temporary scalars 
     121      REAL(wp) ::   zcofi, zfui, zcenut, zupsut, zfp_ui, zfm_ui   !    "         " 
     122      REAL(wp) ::   zcofj, zfvj, zcenvt, zupsvt, zfp_vj, zfm_vj   !    "         " 
     123      REAL(wp) ::   zcofk,       zcent , zupst , zfp_w , zfm_w    !    "         " 
     124      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy, zind   ! 3D workspace  
    132125      !!---------------------------------------------------------------------- 
    133126 
    … …  
    135128         IF(lwp) WRITE(numout,*) 
    136129         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme' 
    137          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case' 
    138          IF(lwp) WRITE(numout,*) 
     130         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    139131         !  
    140132         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    … …  
    158150      END DO 
    159151 
    160  
    161       !  Horizontal advective fluxes 
    162       ! ----------------------------- 
     152      ! I. Horizontal advection 
     153      ! ----------------------- 
     154 
    163155      !                                                ! =============== 
    164156      DO jk = 1, jpkm1                                 ! Horizontal slab 
    165157         !                                             ! =============== 
    166          DO jj = 1, jpjm1 
     158         ! 
     159         DO jj = 1, jpjm1                              !  Horizontal advective fluxes 
    167160            DO ji = 1, fs_jpim1   ! vector opt. 
    168161               ! upstream indicator 
    … …  
    182175               zfm_ui = zfui - ABS( zfui ) 
    183176               zfm_vj = zfvj - ABS( zfvj ) 
    184                zupsut = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk) 
    185                zupsvt = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk) 
    186                zupsus = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk) 
    187                zupsvs = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk) 
     177               zupsut = zfp_ui * ptb(ji,jj,jk) + zfm_ui * ptb(ji+1,jj  ,jk) 
     178               zupsvt = zfp_vj * ptb(ji,jj,jk) + zfm_vj * ptb(ji  ,jj+1,jk) 
    188179               ! centered scheme 
    189                zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) ) 
    190                zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) ) 
    191                zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) ) 
    192                zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) ) 
     180               zcenut = zfui * ( ptn(ji,jj,jk) + ptn(ji+1,jj  ,jk) ) 
     181               zcenvt = zfvj * ( ptn(ji,jj,jk) + ptn(ji  ,jj+1,jk) ) 
    193182               ! mixed centered / upstream scheme 
    194183               zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut 
    195184               zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt 
    196                zww(ji,jj,jk) = zcofi * zupsus + (1.-zcofi) * zcenus 
    197                zwz(ji,jj,jk) = zcofj * zupsvs + (1.-zcofj) * zcenvs 
    198             END DO 
    199          END DO 
    200  
    201          !  Tracer flux divergence at t-point added to the general trend 
    202          ! -------------------------------------------------------------- 
    203          DO jj = 2, jpjm1 
     185            END DO 
     186         END DO 
     187 
     188         DO jj = 2, jpjm1                              !  horizontal tracer flux divergence added to the general trend 
    204189            DO ji = fs_2, fs_jpim1   ! vector opt. 
    205190#if defined key_zco 
    … …  
    211196               zta = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   & 
    212197                  &            + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  ) 
    213                zsa = - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj  ,jk)   & 
    214                   &            + zwz(ji,jj,jk) - zwz(ji  ,jj-1,jk)  ) 
    215198               ! add it to the general tracer trends 
    216                ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    217                sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
     199               pta(ji,jj,jk) = pta(ji,jj,jk) + zta 
    218200            END DO 
    219201         END DO 
    … …  
    225207      ! ----------------------------------------------------- 
    226208      IF( l_trdtra ) THEN 
    227          ! T/S ZONAL advection trends 
    228          ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
    229          ! 
    230          DO jk = 1, jpkm1 
    231             DO jj = 2, jpjm1 
    232                DO ji = fs_2, fs_jpim1   ! vector opt. 
    233                   !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
    234                   !   N.B. This computation is not valid along OBCs (if any) 
    235 #if defined key_zco 
    236                   zbtr      = btr2(ji,jj)  
    237                   z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              & 
    238                      &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr 
    239 #else 
    240                   zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk) 
    241                   z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
    242                      &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
    243 #endif 
    244                   ztrdt(ji,jj,jk) = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x 
    245                   ztrds(ji,jj,jk) = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x 
    246                END DO 
    247             END DO 
    248          END DO 
    249          CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt) 
    250          ! 
    251          ! T/S MERIDIONAL advection trends 
    252          DO jk = 1, jpkm1 
    253             DO jj = 2, jpjm1 
    254                DO ji = fs_2, fs_jpim1   ! vector opt. 
    255                   !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
    256                   !   N.B. This computation is not valid along OBCs (if any) 
    257 #if defined key_zco 
    258                   zbtr      = btr2(ji,jj)  
    259                   z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              & 
    260                      &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr 
    261 #else 
    262                   zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk) 
    263                   z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
    264                      &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
    265 #endif 
    266                   ztrdt(ji,jj,jk) = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y           
    267                   ztrds(ji,jj,jk) = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y 
    268                END DO 
    269             END DO 
    270          END DO 
    271          CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt) 
    272          ! 
    273          ! Save the horizontal up-to-date ta/sa trends 
    274          ztrdt(:,:,:) = ta(:,:,:)  
    275          ztrds(:,:,:) = sa(:,:,:) 
    276       ENDIF 
    277  
    278       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 had  - Ta: ', mask1=tmask, & 
    279          &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    280  
    281       ! 4. "zonal" mean advective heat and salt transport  
    282       ! ------------------------------------------------- 
    283  
    284       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     209         CALL trd_tra_adv( kt, ktra, jpt_trd_xad, cdtype, zwx, pun, ptn ) 
     210         CALL trd_tra_adv( kt, ktra, jpt_trd_yad, cdtype, zwy, pvn, ptn ) 
     211      ENDIF 
     212 
     213      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' cen2 - had: ', mask1=tmask, clinfo3=cdtype ) 
     214 
     215 
     216      ! "Poleward" heat and salt transport  
     217      ! ---------------------------------- 
     218      IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    285219         IF( lk_zco ) THEN 
    286220            DO jk = 1, jpkm1 
    … …  
    288222                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    289223                    zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk) 
    290                     zwz(ji,jj,jk) = zwz(ji,jj,jk) * fse3v(ji,jj,jk) 
    291224                  END DO 
    292225               END DO 
    293226            END DO 
    294227         ENDIF 
    295          pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
    296          pst_adv(:) = ptr_vj( zwz(:,:,:) ) 
    297       ENDIF 
     228         IF( ktra == jp_tem)   pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
     229         IF( ktra == jp_sal)   pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
     230      ENDIF 
     231 
    298232 
    299233      ! II. Vertical advection 
    300234      ! ---------------------- 
    301235 
    302       ! Bottom value : flux set to zero 
    303       zwx(:,:,jpk) = 0.e0     ;    zwy(:,:,jpk) = 0.e0 
    304  
    305       ! Surface value 
    306       IF( lk_dynspg_rl .OR. lk_vvl ) THEN 
    307          ! rigid lid or variable volume: flux set to zero 
    308          zwx(:,:, 1 ) = 0.e0    ;    zwy(:,:, 1 ) = 0.e0 
    309       ELSE 
    310          ! free surface 
    311          zwx(:,:, 1 ) = pwn(:,:,1) * tn(:,:,1) 
    312          zwy(:,:, 1 ) = pwn(:,:,1) * sn(:,:,1) 
    313       ENDIF 
    314  
    315       ! 1. Vertical advective fluxes 
    316       ! ---------------------------- 
    317       ! Second order centered tracer flux at w-point 
    318       DO jk = 2, jpk 
     236      IF( lk_dynspg_rl .OR. lk_vvl ) THEN         ! rigid lid or non-linear free surface 
     237         zwx(:,:, 1 ) = 0.e0                           ! Surface value : zero flux 
     238         zwx(:,:,jpk) = 0.e0                           ! Bottom  value : flux set to zero 
     239      ELSE                                        ! linear free surface 
     240         zwx(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1)        ! Surface :  : advection through z=0 
     241         zwx(:,:,jpk) = 0.e0                           ! Bottom  : flux set to zero 
     242      ENDIF 
     243 
     244      DO jk = 2, jpk                                   ! Vertical advective fluxes (at w-point) 
    319245         DO jj = 2, jpjm1 
    320246            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    326252               zfp_w = zhw + ABS( zhw ) 
    327253               zfm_w = zhw - ABS( zhw ) 
    328                zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1) 
    329                zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1) 
     254               zupst = zfp_w * ptb(ji,jj,jk) + zfm_w * ptb(ji,jj,jk-1) 
    330255               ! centered scheme 
    331                zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) 
    332                zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) 
     256               zcent = zhw * ( ptn(ji,jj,jk) + ptn(ji,jj,jk-1) ) 
    333257               ! mixed centered / upstream scheme 
    334258               zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent 
    335                zwy(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens 
    336259            END DO 
    337260         END DO 
    338261      END DO 
    339262 
    340       ! 2. Tracer flux divergence at t-point added to the general trend 
    341       ! ------------------------- 
    342       DO jk = 1, jpkm1 
     263      DO jk = 1, jpkm1                                 ! Tracer flux divergence at t-point added to the general trend 
    343264         DO jj = 2, jpjm1 
    344265            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    346267               ! vertical advective trends 
    347268               zta = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 
    348                zsa = - ze3tr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) 
    349269               ! add it to the general tracer trends 
    350                ta(ji,jj,jk) =  ta(ji,jj,jk) + zta 
    351                sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa 
     270               pta(ji,jj,jk) =  pta(ji,jj,jk) + zta 
    352271            END DO 
    353272         END DO 
    … …  
    356275      ! 3. Save the vertical advective trends for diagnostic 
    357276      ! ---------------------------------------------------- 
    358       IF( l_trdtra )   THEN 
    359          ! Recompute the vertical advection zta & zsa trends computed  
    360          ! at the step 2. above in making the difference between the new  
    361          ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract 
    362          ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends 
    363  
    364          DO jk = 1, jpkm1 
    365             DO jj = 2, jpjm1 
    366                DO ji = fs_2, fs_jpim1   ! vector opt. 
    367 #if defined key_zco 
    368                   zbtr      = btr2(ji,jj)  
    369                   z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
    370                   z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
    371 #else 
    372                   zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk) 
    373                   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) 
    374                   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) 
    375 #endif 
    376                   z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
    377                   ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn  
    378                   ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn 
    379                END DO 
    380             END DO 
    381          END DO 
    382          CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt) 
    383       ENDIF 
    384  
    385       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 zad  - Ta: ', mask1=tmask, & 
    386          &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     277      IF( l_trdtra )   CALL trd_tra_adv( kt, ktra, jpt_trd_zad, cdtype, zwx, pwn, ptn ) 
     278 
     279      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' cen2 - zad : ', mask1=tmask, clinfo3=cdtype ) 
    387280      ! 
    388281   END SUBROUTINE tra_adv_cen2 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r719 r786  
    66   !! History :       !  06-00  (A.Estublier)  for passive tracers 
    77   !!                 !  01-08  (E.Durand, G.Madec)  adapted for T & S 
    8    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     8   !!   NEMO     1.0  !  02-06  (G. Madec)  F90: Free form and module 
     9   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
    910   !!---------------------------------------------------------------------- 
    1011 
    … …  
    1314   !!                   and vertical advection trends using MUSCL scheme 
    1415   !!---------------------------------------------------------------------- 
    15    USE oce             ! ocean dynamics and active tracers 
    1616   USE dom_oce         ! ocean space and time domain 
    1717   USE trdmod          ! ocean active tracers trends  
    … …  
    3434#  include "vectopt_loop_substitute.h90" 
    3535   !!---------------------------------------------------------------------- 
    36    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    37    !! $Header$  
     36   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     37   !! $Id:$  
    3838   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 
    … …  
    4141CONTAINS 
    4242 
    43    SUBROUTINE tra_adv_muscl( kt, pun, pvn, pwn ) 
     43   SUBROUTINE tra_adv_muscl( kt, cdtype, ktra, pun, pvn, pwn,   & 
     44      &                                        ptb     , pta ) 
    4445      !!---------------------------------------------------------------------- 
    4546      !!                    ***  ROUTINE tra_adv_muscl  *** 
    … …  
    5152      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries 
    5253      !! 
    53       !! ** Action  : - update (ta,sa) with the now advective tracer trends 
     54      !! ** Action  : - update (pta,sa) with the now advective tracer trends 
    5455      !!              - save trends in (ztrdt,ztrds) ('key_trdtra') 
    5556      !! 
    … …  
    5758      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    5859      !!---------------------------------------------------------------------- 
    59       USE oce, ONLY :   ztrdt => ua   ! use ua as workspace 
    60       USE oce, ONLY :   ztrds => va   ! use va as workspace 
    61       !! 
    62       INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
    63       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component 
    64       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component 
    65       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component 
    66       !! 
    67       INTEGER ::   ji, jj, jk   ! dummy loop indices 
    68       REAL(wp) ::   & 
    69          zu, zv, zw, zeu, zev,           &   
    70          zew, zbtr, zstep,               & 
    71          z0u, z0v, z0w,                  & 
    72          zzt1, zzt2, zalpha,             & 
    73          zzs1, zzs2, z2,                 & 
    74          zta, zsa,                       & 
    75         z_hdivn_x, z_hdivn_y, z_hdivn 
    76       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zt1, zt2, ztp1, ztp2   ! 3D workspace 
    77       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zs1, zs2, zsp1, zsp2   !  "      " 
     60      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     61      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     62      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     63      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     64      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb             ! before tracer fields 
     65      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
     66      !! 
     67      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     68      REAL(wp) ::   zu, zv, zw, zeu, zev   
     69      REAL(wp) ::   zew, zbtr, z2, zstep  
     70      REAL(wp) ::   z0u, z0v, z0w  
     71      REAL(wp) ::   zzwx, zzwy, zalpha  
     72      REAL(wp) ::   zta 
     73      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zwx, zwy, zslpx, zslpy   ! 3D workspace 
    7874      !!---------------------------------------------------------------------- 
    7975 
    … …  
    9591         DO jj = 1, jpjm1       
    9692            DO ji = 1, fs_jpim1   ! vector opt. 
    97                zt1(ji,jj,jk) = umask(ji,jj,jk) * ( tb(ji+1,jj,jk) - tb(ji,jj,jk) ) 
    98                zs1(ji,jj,jk) = umask(ji,jj,jk) * ( sb(ji+1,jj,jk) - sb(ji,jj,jk) ) 
    99                zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( tb(ji,jj+1,jk) - tb(ji,jj,jk) ) 
    100                zs2(ji,jj,jk) = vmask(ji,jj,jk) * ( sb(ji,jj+1,jk) - sb(ji,jj,jk) ) 
     93               zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk) - ptb(ji,jj,jk) ) 
     94               zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk) - ptb(ji,jj,jk) ) 
    10195            END DO 
    10296         END DO 
    10397      END DO 
    10498      ! bottom values 
    105       zt1(:,:,jpk) = 0.e0    ;    zt2(:,:,jpk) = 0.e0 
    106       zs1(:,:,jpk) = 0.e0    ;    zs2(:,:,jpk) = 0.e0 
    107  
    108       ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign) 
    109       CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. ) 
    110       CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. ) 
     99      zwx(:,:,jpk) = 0.e0    ;    zwy(:,:,jpk) = 0.e0 
     100 
     101      ! lateral boundary conditions on zwx, zwy   (changed sign) 
     102      CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. ) 
    111103 
    112104      ! Slopes 
    … …  
    115107         DO jj = 2, jpj 
    116108            DO ji = fs_2, jpi   ! vector opt. 
    117                ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   & 
    118                   &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) ) 
    119                zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji-1,jj  ,jk) )   & 
    120                   &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji-1,jj  ,jk) ) ) 
    121                ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   & 
    122                   &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) ) 
    123                zsp2(ji,jj,jk) =                    ( zs2(ji,jj,jk) + zs2(ji  ,jj-1,jk) )   & 
    124                   &           * ( 0.25 + SIGN( 0.25, zs2(ji,jj,jk) * zs2(ji  ,jj-1,jk) ) ) 
     109               zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
     110                  &           * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
     111               zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   & 
     112                  &           * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) ) 
    125113            END DO 
    126114         END DO 
    127115      END DO 
    128116      ! bottom values 
    129       ztp1(:,:,jpk) = 0.e0    ;    ztp2(:,:,jpk) = 0.e0 
    130       zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0 
     117      zslpx(:,:,jpk) = 0.e0    ;    zslpy(:,:,jpk) = 0.e0 
    131118 
    132119      ! Slopes limitation 
    … …  
    134121         DO jj = 2, jpj 
    135122            DO ji = fs_2, jpi   ! vector opt. 
    136                ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   & 
    137                   &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   & 
    138                   &                  2.*ABS( zt1 (ji-1,jj,jk) ),   & 
    139                   &                  2.*ABS( zt1 (ji  ,jj,jk) ) ) 
    140                zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   & 
    141                   &           * MIN(    ABS( zsp1(ji  ,jj,jk) ),   & 
    142                   &                  2.*ABS( zs1 (ji-1,jj,jk) ),   & 
    143                   &                  2.*ABS( zs1 (ji  ,jj,jk) ) ) 
    144                ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   & 
    145                   &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   & 
    146                   &                  2.*ABS( zt2 (ji,jj-1,jk) ),   & 
    147                   &                  2.*ABS( zt2 (ji,jj  ,jk) ) ) 
    148                zsp2(ji,jj,jk) = SIGN( 1., zsp2(ji,jj,jk) )   & 
    149                   &           * MIN(    ABS( zsp2(ji,jj  ,jk) ),   & 
    150                   &                  2.*ABS( zs2 (ji,jj-1,jk) ),   & 
    151                   &                  2.*ABS( zs2 (ji,jj  ,jk) ) ) 
     123               zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) )   & 
     124                  &            * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
     125                  &                   2.*ABS( zwx (ji-1,jj,jk) ),   & 
     126                  &                   2.*ABS( zwx (ji  ,jj,jk) ) ) 
     127               zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) )   & 
     128                  &            * MIN(    ABS( zslpy(ji,jj  ,jk) ),   & 
     129                  &                   2.*ABS( zwy (ji,jj-1,jk) ),   & 
     130                  &                   2.*ABS( zwy (ji,jj  ,jk) ) ) 
    152131            END DO 
    153132         END DO 
    … …  
    172151               zalpha = 0.5 - z0u 
    173152               zu  = z0u - 0.5 * pun(ji,jj,jk) * zstep / e1u(ji,jj) 
    174                zzt1 = tb(ji+1,jj,jk) + zu*ztp1(ji+1,jj,jk) 
    175                zzt2 = tb(ji  ,jj,jk) + zu*ztp1(ji  ,jj,jk) 
    176                zzs1 = sb(ji+1,jj,jk) + zu*zsp1(ji+1,jj,jk) 
    177                zzs2 = sb(ji  ,jj,jk) + zu*zsp1(ji  ,jj,jk) 
    178                zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 ) 
    179                zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 ) 
     153               zzwx = ptb(ji+1,jj,jk) + zu * zslpx(ji+1,jj,jk) 
     154               zzwy = ptb(ji  ,jj,jk) + zu * zslpx(ji  ,jj,jk) 
     155               zwx(ji,jj,jk) = zeu * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    180156               ! 
    181157               z0v = SIGN( 0.5, pvn(ji,jj,jk) )             
    182158               zalpha = 0.5 - z0v 
    183159               zv  = z0v - 0.5 * pvn(ji,jj,jk) * zstep / e2v(ji,jj) 
    184                zzt1 = tb(ji,jj+1,jk) + zv*ztp2(ji,jj+1,jk) 
    185                zzt2 = tb(ji,jj  ,jk) + zv*ztp2(ji,jj  ,jk) 
    186                zzs1 = sb(ji,jj+1,jk) + zv*zsp2(ji,jj+1,jk) 
    187                zzs2 = sb(ji,jj  ,jk) + zv*zsp2(ji,jj  ,jk) 
    188                zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 ) 
    189                zs2(ji,jj,jk) = zev * ( zalpha * zzs1 + (1.-zalpha) * zzs2 ) 
    190             END DO 
    191          END DO 
    192       END DO 
    193  
    194       ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign) 
    195       CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. )  
    196       CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. ) 
     160               zzwx = ptb(ji,jj+1,jk) + zv * zslpy(ji,jj+1,jk) 
     161               zzwy = ptb(ji,jj  ,jk) + zv * zslpy(ji,jj  ,jk) 
     162               zwy(ji,jj,jk) = zev * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
     163            END DO 
     164         END DO 
     165      END DO 
     166 
     167!!gm bug?   there is too many lbc: this have to be checked 
     168      ! lateral boundary conditions on zwx, zwy   (changed sign) 
     169      CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. ) 
    197170 
    198171      ! Tracer flux divergence at t-point added to the general trend 
    … …  
    201174            DO ji = fs_2, fs_jpim1   ! vector opt. 
    202175#if defined key_zco 
    203                zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) ) 
     176               zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
    204177#else 
    205                zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
     178               zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    206179#endif 
    207180               ! horizontal advective trends 
    208                zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   & 
    209                   &           + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) ) 
    210                zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk  )   & 
    211                   &           + zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk  ) )  
     181               zta = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     182                  &           + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )  
    212183               ! add it to the general tracer trends 
    213                ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    214                sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
     184               pta(ji,jj,jk) = pta(ji,jj,jk) + zta 
    215185            END DO 
    216186        END DO 
    217187      END DO         
    218188 
    219       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl had  - Ta: ', mask1=tmask ,  & 
    220          &                       tab3d_2=sa, clinfo2=             ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     189      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' muscl - had: ', mask1=tmask, clinfo3=cdtype ) 
    221190 
    222191      ! Save the horizontal advective trends for diagnostics 
    223192      IF( l_trdtra ) THEN 
    224          ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
    225          ! 
    226          ! T/S ZONAL advection trends 
    227          DO jk = 1, jpkm1 
    228             DO jj = 2, jpjm1 
    229                DO ji = fs_2, fs_jpim1   ! vector opt. 
    230                   !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
    231                   !   N.B. This computation is not valid along OBCs (if any) 
    232 #if defined key_zco 
    233                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
    234                   z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              & 
    235                      &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr 
    236 #else 
    237                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    238                   z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
    239                      &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
    240 #endif 
    241                   ztrdt(ji,jj,jk) = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x 
    242                   ztrds(ji,jj,jk) = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x 
    243                END DO 
    244             END DO 
    245          END DO 
    246          CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt) 
    247  
    248          ! T/S MERIDIONAL advection trends 
    249          DO jk = 1, jpkm1 
    250             DO jj = 2, jpjm1 
    251                DO ji = fs_2, fs_jpim1   ! vector opt. 
    252                   !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
    253                   !   N.B. This computation is not valid along OBCs (if any) 
    254 #if defined key_zco 
    255                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
    256                   z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              & 
    257                      &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr 
    258 #else 
    259                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    260                   z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
    261                      &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
    262 #endif 
    263                   ztrdt(ji,jj,jk) = - zbtr * ( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y           
    264                   ztrds(ji,jj,jk) = - zbtr * ( zs2(ji,jj,jk) - zs2(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y 
    265                END DO 
    266             END DO 
    267          END DO 
    268          CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt) 
    269  
    270          ! Save the up-to-date ta and sa trends 
    271          ztrdt(:,:,:) = ta(:,:,:)  
    272          ztrds(:,:,:) = sa(:,:,:)  
    273          ! 
    274       ENDIF 
    275  
    276       ! "zonal" mean advective heat and salt transport 
    277       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     193         CALL trd_tra_adv( kt, ktra, jpt_trd_xad, cdtype, zwx, pun, ptb ) 
     194         CALL trd_tra_adv( kt, ktra, jpt_trd_yad, cdtype, zwy, pvn, ptb ) 
     195      ENDIF 
     196 
     197      IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    278198         IF( lk_zco ) THEN 
    279199            DO jk = 1, jpkm1 
    280200               DO jj = 2, jpjm1 
    281201                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    282                     zt2(ji,jj,jk) = zt2(ji,jj,jk) * fse3v(ji,jj,jk) 
    283                     zs2(ji,jj,jk) = zs2(ji,jj,jk) * fse3v(ji,jj,jk) 
     202                    zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk) 
    284203                  END DO 
    285204               END DO 
    286205            END DO 
    287206         ENDIF 
    288          pht_adv(:) = ptr_vj( zt2(:,:,:) ) 
    289          pst_adv(:) = ptr_vj( zs2(:,:,:) ) 
    290       ENDIF 
     207         IF( ktra == jp_tem)   pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
     208         IF( ktra == jp_sal)   pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
     209      ENDIF 
     210 
    291211 
    292212      ! II. Vertical advective fluxes 
    … …  
    296216      ! interior values 
    297217      DO jk = 2, jpkm1 
    298          zt1(:,:,jk) = tmask(:,:,jk) * ( tb(:,:,jk-1) - tb(:,:,jk) ) 
    299          zs1(:,:,jk) = tmask(:,:,jk) * ( sb(:,:,jk-1) - sb(:,:,jk) ) 
     218         zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1) - ptb(:,:,jk) ) 
    300219      END DO 
    301220      ! surface & bottom boundary conditions 
    302       zt1 (:,:, 1 ) = 0.e0    ;    zt1 (:,:,jpk) = 0.e0 
    303       zs1 (:,:, 1 ) = 0.e0    ;    zs1 (:,:,jpk) = 0.e0 
     221      zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0 
    304222 
    305223      ! Slopes 
    … …  
    307225         DO jj = 1, jpj 
    308226            DO ji = 1, jpi 
    309                ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   & 
    310                   &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) ) 
    311                zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )   & 
    312                   &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji,jj,jk+1) ) ) 
     227               zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   & 
     228                  &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) ) 
    313229            END DO 
    314230         END DO 
    … …  
    316232 
    317233      ! Slopes limitation 
    318       ! interior values 
    319       DO jk = 2, jpkm1 
     234      DO jk = 2, jpkm1        ! interior values 
    320235         DO jj = 1, jpj 
    321236            DO ji = 1, jpi 
    322                ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   & 
    323                   &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   & 
    324                   &                  2.*ABS( zt1 (ji,jj,jk+1) ),   & 
    325                   &                  2.*ABS( zt1 (ji,jj,jk  ) ) ) 
    326                zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   & 
    327                   &           * MIN(    ABS( zsp1(ji,jj,jk  ) ),   & 
    328                   &                  2.*ABS( zs1 (ji,jj,jk+1) ),   & 
    329                   &                  2.*ABS( zs1 (ji,jj,jk  ) ) ) 
    330             END DO 
    331          END DO 
    332       END DO 
    333       ! surface values 
    334       ztp1(:,:,1) = 0.e0 
    335       zsp1(:,:,1) = 0.e0 
     237               zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) )   & 
     238                  &            * MIN(    ABS( zslpx(ji,jj,jk  ) ),   & 
     239                  &                   2.*ABS( zwx (ji,jj,jk+1) ),   & 
     240                  &                   2.*ABS( zwx (ji,jj,jk  ) ) ) 
     241            END DO 
     242         END DO 
     243      END DO 
     244      zslpx(:,:,1) = 0.e0      ! surface values 
    336245 
    337246      ! vertical advective flux 
    338       ! interior values 
    339       DO jk = 1, jpkm1 
     247      DO jk = 1, jpkm1        ! interior values 
    340248         zstep  = z2 * rdttra(jk) 
    341249         DO jj = 2, jpjm1       
    … …  
    344252               z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 
    345253               zalpha = 0.5 + z0w 
    346                zw  = z0w - 0.5 * pwn(ji,jj,jk+1)*zstep / fse3w(ji,jj,jk+1) 
    347                zzt1 = tb(ji,jj,jk+1) + zw*ztp1(ji,jj,jk+1) 
    348                zzt2 = tb(ji,jj,jk  ) + zw*ztp1(ji,jj,jk  ) 
    349                zzs1 = sb(ji,jj,jk+1) + zw*zsp1(ji,jj,jk+1) 
    350                zzs2 = sb(ji,jj,jk  ) + zw*zsp1(ji,jj,jk  ) 
    351                zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 ) 
    352                zs1(ji,jj,jk+1) = zew * ( zalpha * zzs1 + (1.-zalpha)*zzs2 ) 
    353             END DO 
    354          END DO 
    355       END DO 
    356       ! surface values 
     254               zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1) 
     255               zzwx = ptb(ji,jj,jk+1) + zw * zslpx(ji,jj,jk+1) 
     256               zzwy = ptb(ji,jj,jk  ) + zw * zslpx(ji,jj,jk  ) 
     257               zwx(ji,jj,jk+1) = zew * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
     258            END DO 
     259         END DO 
     260      END DO 
     261      !                       ! surface values 
    357262      IF( lk_dynspg_rl .OR. lk_vvl) THEN                ! rigid lid or variable volume: flux set to zero 
    358          zt1(:,:, 1 ) = 0.e0 
    359          zs1(:,:, 1 ) = 0.e0 
     263         zwx(:,:, 1 ) = 0.e0                                 ! surface  
     264         zwx(:,:,jpk) = 0.e0                                 ! bottom  
    360265      ELSE                                              ! free surface 
    361          zt1(:,:, 1 ) = pwn(:,:,1) * tb(:,:,1) 
    362          zs1(:,:, 1 ) = pwn(:,:,1) * sb(:,:,1) 
    363       ENDIF 
    364  
    365       ! bottom values 
    366       zt1(:,:,jpk) = 0.e0 
    367       zs1(:,:,jpk) = 0.e0 
    368  
     266         zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1)              ! Surface 
     267         zwx(:,:,jpk) = 0.e0                                 ! bottom  
     268 
     269      ENDIF 
    369270 
    370271      ! Compute & add the vertical advective trend 
    371  
    372272      DO jk = 1, jpkm1 
    373273         DO jj = 2, jpjm1       
    … …  
    375275               zbtr = 1. / fse3t(ji,jj,jk) 
    376276               ! horizontal advective trends 
    377                zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) ) 
    378                zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji,jj,jk+1) ) 
     277               zta = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 
    379278               ! add it to the general tracer trends 
    380                ta(ji,jj,jk) =  ta(ji,jj,jk) + zta 
    381                sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa 
     279               pta(ji,jj,jk) =  pta(ji,jj,jk) + zta 
    382280            END DO 
    383281         END DO 
    … …  
    386284      ! Save the vertical advective trends for diagnostic 
    387285      ! ------------------------------------------------- 
    388       IF( l_trdtra )   THEN 
    389          ! Recompute the vertical advection zta & zsa trends computed  
    390          ! at the step 2. above in making the difference between the new  
    391          ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract 
    392          ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends 
    393  
    394          DO jk = 1, jpkm1 
    395             DO jj = 2, jpjm1 
    396                DO ji = fs_2, fs_jpim1   ! vector opt. 
    397 #if defined key_zco 
    398                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
    399                   z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
    400                   z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
    401 #else 
    402                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    403                   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) 
    404                   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) 
    405 #endif 
    406                   z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
    407                   ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn  
    408                   ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn 
    409                END DO 
    410             END DO 
    411          END DO 
    412          CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt) 
    413          ! 
    414       ENDIF 
    415  
    416       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl zad  - Ta: ', mask1=tmask ,   & 
    417          &                       tab3d_2=sa, clinfo2=             ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     286      IF( l_trdtra )   CALL trd_tra_adv( kt, ktra, jpt_trd_zad, cdtype, zwx, pwn, ptb ) 
     287 
     288      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' muscl - zad: ', mask1=tmask, clinfo3=cdtype ) 
    418289      ! 
    419290   END SUBROUTINE tra_adv_muscl 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r719 r786  
    44   !! Ocean active tracers:  horizontal & vertical advective trend 
    55   !!============================================================================== 
    6    !! History :  9.0  !  02-06  (G. Madec) from traadv_muscl 
     6   !! History :  1.0  !  02-06  (G. Madec) from traadv_muscl 
     7   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
    78   !!---------------------------------------------------------------------- 
    89 
    … …  
    1112   !!                    and vertical advection trends using MUSCL2 scheme 
    1213   !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and active tracers 
    1414   USE dom_oce         ! ocean space and time domain 
    1515   USE trdmod          ! ocean active tracers trends  
    … …  
    3333#  include "vectopt_loop_substitute.h90" 
    3434   !!---------------------------------------------------------------------- 
    35    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    36    !! $Header$  
     35   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     36   !! $Id:$  
    3737   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3838   !!---------------------------------------------------------------------- 
    … …  
    4040CONTAINS 
    4141 
    42    SUBROUTINE tra_adv_muscl2( kt, pun, pvn, pwn ) 
     42   SUBROUTINE tra_adv_muscl2( kt, cdtype, ktra, pun, pvn, pwn,   & 
     43      &                                         ptb, ptn, pta ) 
    4344      !!---------------------------------------------------------------------- 
    4445      !!                   ***  ROUTINE tra_adv_muscl2  *** 
    … …  
    5152      !! 
    5253      !! ** Action  : - update (ta,sa) with the now advective tracer trends 
    53       !!              - save trends in (ztrdt,ztrds) ('key_trdtra') 
     54      !!              - save trends (lk_trdtra=T) 
    5455      !! 
    5556      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation 
    5657      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    5758      !!---------------------------------------------------------------------- 
    58       USE oce              , ztrdt => ua   ! use ua as workspace 
    59       USE oce              , ztrds => va   ! use va as workspace 
    60       !! 
    61       INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
    62       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component 
    63       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component 
    64       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component 
    65       !! 
    66       INTEGER ::   ji, jj, jk   ! dummy loop indices 
    67       REAL(wp) ::   & 
    68          zu, zv, zw, zeu, zev,           &   
    69          zew, zbtr, zstep,               & 
    70          z0u, z0v, z0w,                  & 
    71          zzt1, zzt2, zalpha,             & 
    72          zzs1, zzs2, z2,                 & 
    73          zta, zsa,                       & 
    74          z_hdivn_x, z_hdivn_y, z_hdivn 
    75       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zt1, zt2, ztp1, ztp2   ! 3D workspace 
    76       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zs1, zs2, zsp1, zsp2   !  "      " 
     59      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     60      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     61      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     62      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     63      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb             ! before tracer fields 
     64      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptn             ! now    tracer fields 
     65      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
     66      !! 
     67      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     68      REAL(wp) ::   zu, zv, zw, zeu, zev 
     69      REAL(wp) ::   zew, zbtr, zstep, z2  
     70      REAL(wp) ::   z0u, z0v, z0w 
     71      REAL(wp) ::   zzwx, zzwy, zalpha, zta 
     72      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zwx, zwy, zslpx, zslpy   ! 3D workspace 
    7773      !!---------------------------------------------------------------------- 
    7874 
    … …  
    9187 
    9288      ! first guess of the slopes 
    93       ! interior values 
    94       DO jk = 1, jpkm1 
     89      DO jk = 1, jpkm1                                       ! interior values 
     90 
    9591         DO jj = 1, jpjm1       
    9692            DO ji = 1, fs_jpim1   ! vector opt. 
    97                zt1(ji,jj,jk) = umask(ji,jj,jk) * ( tb(ji+1,jj,jk) - tb(ji,jj,jk) ) 
    98                zs1(ji,jj,jk) = umask(ji,jj,jk) * ( sb(ji+1,jj,jk) - sb(ji,jj,jk) ) 
    99                zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( tb(ji,jj+1,jk) - tb(ji,jj,jk) ) 
    100                zs2(ji,jj,jk) = vmask(ji,jj,jk) * ( sb(ji,jj+1,jk) - sb(ji,jj,jk) ) 
    101             END DO 
    102          END DO 
    103       END DO 
    104       ! bottom values 
    105       zt1(:,:,jpk) = 0.e0    ;    zt2(:,:,jpk) = 0.e0 
    106       zs1(:,:,jpk) = 0.e0    ;    zs2(:,:,jpk) = 0.e0 
    107  
    108       ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign) 
    109       CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. ) 
    110       CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. ) 
     93               zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk) - ptb(ji,jj,jk) ) 
     94               zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk) - ptb(ji,jj,jk) ) 
     95            END DO 
     96         END DO 
     97      END DO 
     98      zwx(:,:,jpk) = 0.e0    ;    zwy(:,:,jpk) = 0.e0        ! bottom values 
     99 
     100      ! lateral boundary conditions on zwx, zwy   (changed sign) 
     101      CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. ) 
    111102 
    112103      ! Slopes 
    113       ! interior values 
    114       DO jk = 1, jpkm1 
     104      DO jk = 1, jpkm1                                       ! interior values 
    115105         DO jj = 2, jpj 
    116106            DO ji = fs_2, jpi   ! vector opt. 
    117                ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   & 
    118                   &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) ) 
    119                zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji-1,jj  ,jk) )   & 
    120                   &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji-1,jj  ,jk) ) ) 
    121                ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   & 
    122                   &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) ) 
    123                zsp2(ji,jj,jk) =                    ( zs2(ji,jj,jk) + zs2(ji  ,jj-1,jk) )   & 
    124                   &           * ( 0.25 + SIGN( 0.25, zs2(ji,jj,jk) * zs2(ji  ,jj-1,jk) ) ) 
    125             END DO 
    126          END DO 
    127       END DO 
    128       ! bottom values 
    129       ztp1(:,:,jpk) = 0.e0    ;    ztp2(:,:,jpk) = 0.e0 
    130       zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0 
    131  
    132       ! Slopes limitation 
    133       DO jk = 1, jpkm1 
     107               zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
     108                  &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
     109               zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   & 
     110                  &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) ) 
     111            END DO 
     112         END DO 
     113      END DO 
     114      zslpx(:,:,jpk) = 0.e0    ;    zslpy(:,:,jpk) = 0.e0      ! bottom values 
     115 
     116      DO jk = 1, jpkm1                                       ! Slopes limitation 
    134117         DO jj = 2, jpj 
    135118            DO ji = fs_2, jpi   ! vector opt. 
    136                ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   & 
    137                   &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   & 
    138                   &                  2.*ABS( zt1 (ji-1,jj,jk) ),   & 
    139                   &                  2.*ABS( zt1 (ji  ,jj,jk) ) ) 
    140                zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   & 
    141                   &           * MIN(    ABS( zsp1(ji  ,jj,jk) ),   & 
    142                   &                  2.*ABS( zs1 (ji-1,jj,jk) ),   & 
    143                   &                  2.*ABS( zs1 (ji  ,jj,jk) ) ) 
    144                ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   & 
    145                   &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   & 
    146                   &                  2.*ABS( zt2 (ji,jj-1,jk) ),   & 
    147                   &                  2.*ABS( zt2 (ji,jj  ,jk) ) ) 
    148                zsp2(ji,jj,jk) = SIGN( 1., zsp2(ji,jj,jk) )   & 
    149                   &           * MIN(    ABS( zsp2(ji,jj  ,jk) ),   & 
    150                   &                  2.*ABS( zs2 (ji,jj-1,jk) ),   & 
    151                   &                  2.*ABS( zs2 (ji,jj  ,jk) ) ) 
     119               zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) )   & 
     120                  &            * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
     121                  &                   2.*ABS( zwx (ji-1,jj,jk) ),   & 
     122                  &                   2.*ABS( zwx (ji  ,jj,jk) ) ) 
     123               zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) )   & 
     124                  &            * MIN(    ABS( zslpy(ji,jj  ,jk) ),   & 
     125                  &                   2.*ABS( zwy (ji,jj-1,jk) ),   & 
     126                  &                   2.*ABS( zwy (ji,jj  ,jk) ) ) 
    152127            END DO 
    153128         END DO 
    … …  
    155130 
    156131      ! Advection terms 
    157       ! interior values 
    158       DO jk = 1, jpkm1 
     132      DO jk = 1, jpkm1                                        ! interior values 
    159133         zstep  = z2 * rdttra(jk) 
    160134         DO jj = 2, jpjm1       
    … …  
    172146               zalpha = 0.5 - z0u 
    173147               zu  = z0u - 0.5 * pun(ji,jj,jk) * zstep / e1u(ji,jj) 
    174                zzt1 = tb(ji+1,jj,jk) + zu*ztp1(ji+1,jj,jk) 
    175                zzt2 = tb(ji  ,jj,jk) + zu*ztp1(ji  ,jj,jk) 
    176                zzs1 = sb(ji+1,jj,jk) + zu*zsp1(ji+1,jj,jk) 
    177                zzs2 = sb(ji  ,jj,jk) + zu*zsp1(ji  ,jj,jk) 
    178                zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 ) 
    179                zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 ) 
     148               zzwx = ptb(ji+1,jj,jk) + zu*zslpx(ji+1,jj,jk) 
     149               zzwy = ptb(ji  ,jj,jk) + zu*zslpx(ji  ,jj,jk) 
     150               zwx(ji,jj,jk) = zeu * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    180151               ! 
    181152               z0v = SIGN( 0.5, pvn(ji,jj,jk) )             
    182153               zalpha = 0.5 - z0v 
    183154               zv  = z0v - 0.5 * pvn(ji,jj,jk) * zstep / e2v(ji,jj) 
    184                zzt1 = tb(ji,jj+1,jk) + zv*ztp2(ji,jj+1,jk) 
    185                zzt2 = tb(ji,jj  ,jk) + zv*ztp2(ji,jj  ,jk) 
    186                zzs1 = sb(ji,jj+1,jk) + zv*zsp2(ji,jj+1,jk) 
    187                zzs2 = sb(ji,jj  ,jk) + zv*zsp2(ji,jj  ,jk) 
    188                zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 ) 
    189                zs2(ji,jj,jk) = zev * ( zalpha * zzs1 + (1.-zalpha) * zzs2 ) 
     155               zzwx = ptb(ji,jj+1,jk) + zv*zslpy(ji,jj+1,jk) 
     156               zzwy = ptb(ji,jj  ,jk) + zv*zslpy(ji,jj  ,jk) 
     157               zwy(ji,jj,jk) = zev * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    190158            END DO 
    191159         END DO 
    … …  
    193161 
    194162      !!!!  centered scheme at lateral b.C. if off-shore velocity 
     163!!gm bug  :   seems to access jpj+1... jpi+1.... 
     164!!gm bug2 :   centered...  use tn, not ptb ! 
    195165      DO jk = 1, jpkm1 
    196166        DO jj = 2, jpjm1 
    … …  
    199169               IF( umask(ji,jj,jk) == 0. ) THEN 
    200170                  IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN 
    201                      zt1(ji+1,jj,jk) = e2u(ji+1,jj) * pun(ji+1,jj,jk) * ( tb(ji+1,jj,jk) + tb(ji+2,jj,jk) ) * 0.5 
    202                      zs1(ji+1,jj,jk) = e2u(ji+1,jj) * pun(ji+1,jj,jk) * ( sb(ji+1,jj,jk) + sb(ji+2,jj,jk) ) * 0.5 
     171                     zwx(ji+1,jj,jk) = e2u(ji+1,jj) * pun(ji+1,jj,jk) * ( ptn(ji+1,jj,jk) + ptn(ji+2,jj,jk) ) * 0.5 
    203172                  ENDIF 
    204173                  IF( pun(ji-1,jj,jk) < 0. ) THEN 
    205                      zt1(ji-1,jj,jk) = e2u(ji-1,jj) * pun(ji-1,jj,jk) * ( tb(ji-1,jj,jk) + tb(ji  ,jj,jk) ) * 0.5 
    206                      zs1(ji-1,jj,jk) = e2u(ji-1,jj) * pun(ji-1,jj,jk) * ( sb(ji-1,jj,jk) + sb(ji  ,jj,jk) ) * 0.5 
     174                     zwx(ji-1,jj,jk) = e2u(ji-1,jj) * pun(ji-1,jj,jk) * ( ptn(ji-1,jj,jk) + ptn(ji  ,jj,jk) ) * 0.5 
    207175                  ENDIF 
    208176               ENDIF 
    209177               IF( vmask(ji,jj,jk) == 0. ) THEN 
    210178                  IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN 
    211                      zt2(ji,jj+1,jk) = e1v(ji,jj+1) * pvn(ji,jj+1,jk) * ( tb(ji,jj+1,jk) + tb(ji,jj+2,jk) ) * 0.5 
    212                      zs2(ji,jj+1,jk) = e1v(ji,jj+1) * pvn(ji,jj+1,jk) * ( sb(ji,jj+1,jk) + sb(ji,jj+2,jk) ) * 0.5 
     179                     zwy(ji,jj+1,jk) = e1v(ji,jj+1) * pvn(ji,jj+1,jk) * ( ptn(ji,jj+1,jk) + ptn(ji,jj+2,jk) ) * 0.5 
    213180                  ENDIF 
    214181                  IF( pvn(ji,jj-1,jk) < 0. ) THEN 
    215                      zt2(ji,jj-1,jk) = e1v(ji,jj-1) * pvn(ji,jj-1,jk) * ( tb(ji,jj-1,jk) + tb(ji  ,jj,jk) ) * 0.5 
    216                      zs2(ji,jj-1,jk) = e1v(ji,jj-1) * pvn(ji,jj-1,jk) * ( sb(ji,jj-1,jk) + sb(ji  ,jj,jk) ) * 0.5 
     182                     zwy(ji,jj-1,jk) = e1v(ji,jj-1) * pvn(ji,jj-1,jk) * ( ptn(ji,jj-1,jk) + ptn(ji  ,jj,jk) ) * 0.5 
    217183                  ENDIF 
    218184               ENDIF 
    … …  
    220186               IF( umask(ji,jj,jk) == 0. ) THEN 
    221187                  IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN 
    222                      zt1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   & 
    223                         &            * pun(ji+1,jj,jk) * ( tb(ji+1,jj,jk) + tb(ji+2,jj,jk) ) * 0.5 
    224                      zs1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   & 
    225                         &            * pun(ji+1,jj,jk) * ( sb(ji+1,jj,jk) + sb(ji+2,jj,jk) ) * 0.5 
     188                     zwx(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   & 
     189                        &            * pun(ji+1,jj,jk) * ( ptn(ji+1,jj,jk) + ptn(ji+2,jj,jk) ) * 0.5 
    226190                  ENDIF 
    227191                  IF( pun(ji-1,jj,jk) < 0. ) THEN 
    228                      zt1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   & 
    229                         &            * pun(ji-1,jj,jk) * ( tb(ji-1,jj,jk) + tb(ji  ,jj,jk) ) * 0.5 
    230                      zs1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   & 
    231                         &            * pun(ji-1,jj,jk) * ( sb(ji-1,jj,jk) + sb(ji  ,jj,jk) ) * 0.5 
     192                     zwx(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   & 
     193                        &            * pun(ji-1,jj,jk) * ( ptn(ji-1,jj,jk) + ptn(ji  ,jj,jk) ) * 0.5 
    232194                  ENDIF 
    233195               ENDIF 
    234196               IF( vmask(ji,jj,jk) == 0. ) THEN 
    235197                  IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN 
    236                      zt2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   & 
    237                         &            * pvn(ji,jj+1,jk) * ( tb(ji,jj+1,jk) + tb(ji,jj+2,jk) ) * 0.5 
    238                      zs2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   & 
    239                         &            * pvn(ji,jj+1,jk) * ( sb(ji,jj+1,jk) + sb(ji,jj+2,jk) ) * 0.5 
     198                     zwy(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   & 
     199                        &            * pvn(ji,jj+1,jk) * ( ptn(ji,jj+1,jk) + ptn(ji,jj+2,jk) ) * 0.5 
    240200                  ENDIF 
    241201                  IF( pvn(ji,jj-1,jk) < 0. ) THEN 
    242                      zt2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   & 
    243                         &            * pvn(ji,jj-1,jk) * ( tb(ji,jj-1,jk) + tb(ji  ,jj,jk) ) * 0.5 
    244                      zs2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   & 
    245                         &            * pvn(ji,jj-1,jk) * ( sb(ji,jj-1,jk) + sb(ji  ,jj,jk) ) * 0.5 
     202                     zwy(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   & 
     203                        &            * pvn(ji,jj-1,jk) * ( ptn(ji,jj-1,jk) + ptn(ji  ,jj,jk) ) * 0.5 
    246204                  ENDIF 
    247205               ENDIF 
    … …  
    251209      END DO 
    252210 
    253       ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign) 
    254       CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. )  
    255       CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. ) 
     211      ! lateral boundary conditions on zwx, zwy   (changed sign) 
     212      CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. ) 
    256213 
    257214      ! Compute & add the horizontal advective trend 
    … …  
    266223#endif 
    267224               ! horizontal advective trends 
    268                zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   & 
    269                   &           + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) ) 
    270                zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk  )   & 
    271                   &           + zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk  ) )  
     225               zta = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     226                  &           + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )  
    272227               ! add it to the general tracer trends 
    273                ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    274                sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
     228               pta(ji,jj,jk) = pta(ji,jj,jk) + zta 
    275229            END DO 
    276230        END DO 
    … …  
    279233      ! Save the horizontal advective trends for diagnostic 
    280234      IF( l_trdtra ) THEN 
    281          ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
    282          ! 
    283          ! T/S ZONAL advection trends 
    284          DO jk = 1, jpkm1 
    285             DO jj = 2, jpjm1 
    286                DO ji = fs_2, fs_jpim1   ! vector opt. 
    287                   !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
    288                   !   N.B. This computation is not valid along OBCs (if any) 
    289 #if defined key_zco 
    290                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
    291                   z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              & 
    292                      &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr 
    293 #else 
    294                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    295                   z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
    296                      &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
    297 #endif 
    298                   ztrdt(ji,jj,jk) = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x 
    299                   ztrds(ji,jj,jk) = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x 
    300                END DO 
    301             END DO 
    302          END DO 
    303          CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt) 
    304  
    305          ! T/S MERIDIONAL advection trends 
    306          DO jk = 1, jpkm1 
    307             DO jj = 2, jpjm1 
    308                DO ji = fs_2, fs_jpim1   ! vector opt. 
    309                   !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
    310                   !   N.B. This computation is not valid along OBCs (if any) 
    311 #if defined key_zco 
    312                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
    313                   z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              & 
    314                      &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr 
    315 #else 
    316                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    317                   z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
    318                      &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
    319 #endif 
    320                   ztrdt(ji,jj,jk) = - zbtr * ( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y           
    321                   ztrds(ji,jj,jk) = - zbtr * ( zs2(ji,jj,jk) - zs2(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y 
    322                END DO 
    323             END DO 
    324          END DO 
    325          CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt) 
    326  
    327          ! Save the up-to-date ta and sa trends 
    328          ztrdt(:,:,:) = ta(:,:,:)  
    329          ztrds(:,:,:) = sa(:,:,:)  
    330          ! 
    331       ENDIF 
    332  
    333       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl2 had  - Ta: ', mask1=tmask,   & 
    334          &                       tab3d_2=sa, clinfo2=              ' Sa: ', mask2=tmask, clinfo3='tra') 
    335  
    336       ! "zonal" mean advective heat and salt transport 
    337       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     235         CALL trd_tra_adv( kt, ktra, jpt_trd_xad, cdtype, zwx, pun, ptb ) 
     236         CALL trd_tra_adv( kt, ktra, jpt_trd_yad, cdtype, zwy, pvn, ptb ) 
     237      ENDIF 
     238 
     239      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' muscl2 - had: ', mask1=tmask, clinfo3=cdtype ) 
     240 
     241      ! "Poleward" heat and salt transports 
     242      IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    338243         IF( lk_zco ) THEN 
    339244            DO jk = 1, jpkm1 
    340245               DO jj = 2, jpjm1 
    341246                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    342                     zt2(ji,jj,jk) = zt2(ji,jj,jk) * fse3v(ji,jj,jk) 
    343                     zs2(ji,jj,jk) = zs2(ji,jj,jk) * fse3v(ji,jj,jk) 
     247                    zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk) 
    344248                  END DO 
    345249               END DO 
    346250            END DO 
    347251         ENDIF 
    348          pht_adv(:) = ptr_vj( zt2(:,:,:) ) 
    349          pst_adv(:) = ptr_vj( zs2(:,:,:) ) 
     252         IF( ktra == jp_tem)   pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
     253         IF( ktra == jp_sal)   pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
    350254      ENDIF 
    351255 
    … …  
    356260      ! interior values 
    357261      DO jk = 2, jpkm1 
    358          zt1(:,:,jk) = tmask(:,:,jk) * ( tb(:,:,jk-1) - tb(:,:,jk) ) 
    359          zs1(:,:,jk) = tmask(:,:,jk) * ( sb(:,:,jk-1) - sb(:,:,jk) ) 
     262         zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1) - ptb(:,:,jk) ) 
    360263      END DO 
    361264      ! surface & bottom boundary conditions 
    362       zt1 (:,:, 1 ) = 0.e0    ;    zt1 (:,:,jpk) = 0.e0 
    363       zs1 (:,:, 1 ) = 0.e0    ;    zs1 (:,:,jpk) = 0.e0 
     265      zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0 
    364266 
    365267      ! Slopes 
    … …  
    367269         DO jj = 1, jpj 
    368270            DO ji = 1, jpi 
    369                ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   & 
    370                   &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) ) 
    371                zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )   & 
    372                   &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji,jj,jk+1) ) ) 
     271               zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   & 
     272                  &           * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) ) 
    373273            END DO 
    374274         END DO 
    … …  
    376276 
    377277      ! Slopes limitation 
    378       ! interior values 
    379       DO jk = 2, jpkm1 
     278      DO jk = 2, jpkm1        ! interior values 
    380279         DO jj = 1, jpj 
    381280            DO ji = 1, jpi 
    382                ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   & 
    383                   &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   & 
    384                   &                  2.*ABS( zt1 (ji,jj,jk+1) ),   & 
    385                   &                  2.*ABS( zt1 (ji,jj,jk  ) ) ) 
    386                zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   & 
    387                   &           * MIN(    ABS( zsp1(ji,jj,jk  ) ),   & 
    388                   &                  2.*ABS( zs1 (ji,jj,jk+1) ),   & 
    389                   &                  2.*ABS( zs1 (ji,jj,jk  ) ) ) 
    390             END DO 
    391          END DO 
    392       END DO 
    393       ! surface values 
    394       ztp1(:,:,1) = 0.e0 
    395       zsp1(:,:,1) = 0.e0 
     281               zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) )   & 
     282                  &           * MIN(    ABS( zslpx(ji,jj,jk  ) ),   & 
     283                  &                  2.*ABS( zwx (ji,jj,jk+1) ),   & 
     284                  &                  2.*ABS( zwx (ji,jj,jk  ) ) ) 
     285            END DO 
     286         END DO 
     287      END DO 
     288      zslpx(:,:,1) = 0.e0      ! surface values 
    396289 
    397290      ! vertical advective flux 
    398       ! interior values 
    399       DO jk = 1, jpkm1 
     291      DO jk = 1, jpkm1        ! interior values 
    400292         zstep  = z2 * rdttra(jk) 
    401293         DO jj = 2, jpjm1       
    … …  
    405297               zalpha = 0.5 + z0w 
    406298               zw  = z0w - 0.5 * pwn(ji,jj,jk+1)*zstep / fse3w(ji,jj,jk+1) 
    407                zzt1 = tb(ji,jj,jk+1) + zw*ztp1(ji,jj,jk+1) 
    408                zzt2 = tb(ji,jj,jk  ) + zw*ztp1(ji,jj,jk  ) 
    409                zzs1 = sb(ji,jj,jk+1) + zw*zsp1(ji,jj,jk+1) 
    410                zzs2 = sb(ji,jj,jk  ) + zw*zsp1(ji,jj,jk  ) 
    411                zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 ) 
    412                zs1(ji,jj,jk+1) = zew * ( zalpha * zzs1 + (1.-zalpha)*zzs2 ) 
    413             END DO 
    414          END DO 
    415       END DO 
    416       DO jk = 2, jpkm1 
     299               zzwx = ptb(ji,jj,jk+1) + zw*zslpx(ji,jj,jk+1) 
     300               zzwy = ptb(ji,jj,jk  ) + zw*zslpx(ji,jj,jk  ) 
     301               zwx(ji,jj,jk+1) = zew * ( zalpha * zzwx + (1.-zalpha)*zzwy ) 
     302            END DO 
     303         END DO 
     304      END DO 
     305      DO jk = 2, jpkm1        ! centered near the bottom 
    417306        DO jj = 2, jpjm1 
    418307            DO ji = fs_2, fs_jpim1   ! vector opt. 
    419308               IF( tmask(ji,jj,jk+1) == 0. ) THEN 
    420309                  IF( pwn(ji,jj,jk) > 0. ) THEN 
    421                      zt1(ji,jj,jk) = pwn(ji,jj,jk) * ( tb(ji,jj,jk-1) + tb(ji,jj,jk) ) * 0.5 
    422                      zs1(ji,jj,jk) = pwn(ji,jj,jk) * ( sb(ji,jj,jk-1) + sb(ji,jj,jk) ) * 0.5 
     310                     zwx(ji,jj,jk) = pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1) + ptn(ji,jj,jk) ) * 0.5 
    423311                  ENDIF 
    424312               ENDIF 
    … …  
    428316 
    429317      ! surface values 
    430       IF( lk_dynspg_rl .OR. lk_vvl ) THEN               ! rigid lid or variable volume: flux set to zero 
    431          zt1(:,:, 1 ) = 0.e0 
    432          zs1(:,:, 1 ) = 0.e0 
    433       ELSE                                              ! free surface 
    434          zt1(:,:, 1 ) = pwn(:,:,1) * tb(:,:,1) 
    435          zs1(:,:, 1 ) = pwn(:,:,1) * sb(:,:,1) 
    436       ENDIF 
    437  
    438       ! bottom values 
    439       zt1(:,:,jpk) = 0.e0 
    440       zs1(:,:,jpk) = 0.e0 
     318      IF( lk_dynspg_rl .OR. lk_vvl ) THEN              ! rigid lid or variable volume: flux set to zero 
     319         zwx(:,:, 1 ) = 0.e0                                 ! surface 
     320         zwx(:,:,jpk) = 0.e0                                 ! bottom  
     321      ELSE                                             ! free surface 
     322         zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1)               ! surface 
     323         zwx(:,:,jpk) = 0.e0                                 ! bottom  
     324      ENDIF 
    441325 
    442326 
    443327      ! Compute & add the vertical advective trend 
    444  
    445328      DO jk = 1, jpkm1 
    446329         DO jj = 2, jpjm1       
    … …  
    448331               zbtr = 1. / fse3t(ji,jj,jk) 
    449332               ! horizontal advective trends 
    450                zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) ) 
    451                zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji,jj,jk+1) ) 
     333               zta = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 
    452334               ! add it to the general tracer trends 
    453                ta(ji,jj,jk) =  ta(ji,jj,jk) + zta 
    454                sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa 
     335               pta(ji,jj,jk) =  pta(ji,jj,jk) + zta 
    455336            END DO 
    456337         END DO 
    … …  
    458339 
    459340      ! Save the vertical advective trends for diagnostic 
    460       IF( l_trdtra )   THEN 
    461          ! Recompute the vertical advection zta & zsa trends computed  
    462          ! at the step 2. above in making the difference between the new  
    463          ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract 
    464          ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends 
    465  
    466          DO jk = 1, jpkm1 
    467             DO jj = 2, jpjm1 
    468                DO ji = fs_2, fs_jpim1   ! vector opt. 
    469 #if defined key_zco 
    470                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
    471                   z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
    472                   z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
    473 #else 
    474                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    475                   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) 
    476                   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) 
    477 #endif 
    478                   z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
    479                   ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn  
    480                   ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn 
    481                END DO 
    482             END DO 
    483          END DO 
    484          CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt) 
    485          ! 
    486       ENDIF 
    487  
    488       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl2 zad  - Ta: ', mask1=tmask,   & 
    489          &                       tab3d_2=sa, clinfo2=              ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     341      IF( l_trdtra )   CALL trd_tra_adv( kt, ktra, jpt_trd_zad, cdtype, zwx, pwn, ptb ) 
     342 
     343      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' muscl2 - zad: ', mask1=tmask, clinfo3=cdtype ) 
    490344      ! 
    491345   END SUBROUTINE tra_adv_muscl2 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r719 r786  
    11MODULE traadv_qck 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  traadv_qck  *** 
    4    !! Ocean active tracers:  horizontal & vertical advective trend 
    5    !!============================================================================== 
    6  
     4   !! Ocean tracers:  horizontal & vertical advective trend using QUICKEST scheme 
     5   !!====================================================================== 
     6   !! History :  1.0  !  06-09  (G. Reffray)  Original code 
     7   !!            2.4  !  08-01  (G. Madec)  Merge TRA-TRC 
    78   !!---------------------------------------------------------------------- 
    8    !!   tra_adv_qck : update the tracer trend with the horizontal 
    9    !!                      advection trends using a 3st order 
    10    !!                      finite difference scheme 
    11    !!                      The vertical advection scheme is the 2nd centered scheme 
     9 
    1210   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    14    USE oce             ! ocean dynamics and active tracers 
     11   !!   tra_adv_qck : update the tracer trend with the horizontal advection 
     12   !!                 trends using a 3rd order finite difference scheme        ????? 
     13   !!                 The vertical advection scheme is the 2nd centered scheme ????? 
     14   !!---------------------------------------------------------------------- 
    1515   USE dom_oce         ! ocean space and time domain 
    1616   USE trdmod          ! ocean active tracers trends  
    1717   USE trdmod_oce      ! ocean variables trends 
    1818   USE flxrnf          ! 
    19    USE trabbl          ! advective term in the BBL 
    2019   USE ocfzpt          ! 
    2120   USE lib_mpp 
    … …  
    2928   PRIVATE 
    3029 
    31    !! * Accessibility 
    32    PUBLIC tra_adv_qck    ! routine called by step.F90 
    33  
    34    !! * Module variables 
    35    REAL(wp), DIMENSION(jpi,jpj),     SAVE ::   & 
    36          zbtr2 
    37    REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE ::   & 
    38          sl 
    39    REAL(wp) ::                                 & 
    40          cst1, cst2, dt, coef1                  ! temporary scalars 
    41    INTEGER  ::                                 &  
    42          ji, jj, jk                             ! dummy loop indices 
    43    !!---------------------------------------------------------------------- 
     30   PUBLIC tra_adv_qck    ! routine called by traadv.F90 
     31 
     32   REAL(wp), DIMENSION(jpi,jpj)     ::   zbtr2 
     33   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sl 
     34   REAL(wp) ::   cst1, cst2, dt, coef1                  ! temporary scalars 
     35   INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
     36 
    4437   !! * Substitutions 
    4538#  include "domzgr_substitute.h90" 
    4639#  include "vectopt_loop_substitute.h90" 
    4740   !!---------------------------------------------------------------------- 
    48    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    49    !! $Header$  
    50    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     41   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     42   !! $Id:$  
     43   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5144   !!---------------------------------------------------------------------- 
    5245 
    5346CONTAINS 
    5447 
    55 #if ! defined key_mpp_omp 
    56    !!---------------------------------------------------------------------- 
    57    !!   Default option :             quickest advection scheme (k-j-i loop) 
    58    !!---------------------------------------------------------------------- 
    59  
    60    SUBROUTINE tra_adv_qck( kt, pun, pvn, pwn ) 
     48   SUBROUTINE tra_adv_qck( kt, cdtype, ktra, pun, pvn, pwn,   & 
     49      &                                      ptb, ptn, pta ) 
    6150      !!---------------------------------------------------------------------- 
    6251      !!                  ***  ROUTINE tra_adv_qck  *** 
    … …  
    6756      !! ** Method :   The advection is evaluated by a third order scheme 
    6857      !!               For a positive velocity u : 
    69       !! 
    7058      !! 
    7159      !!                  i-1    i      i+1   i+2 
    … …  
    8371      !!                FC is the central point (or the first upwind point) 
    8472      !! 
    85       !!      Flux(i) = u(i) * {0.5(FC+FD)  -0.5C(i)(FD-FC)  -((1-C(i)å?)/6)(FU+FD-2FC)} 
     73      !!      Flux(i) = u(i) * {0.5(FC+FD)  -0.5C(i)(FD-FC)  -((1-C(i)Â?)/6)(FU+FD-2FC)} 
    8674      !!                with C(i)=|u(i)|dx(i)/dt (Courant number) 
    8775      !! 
    … …  
    9785      !!             - save the trends in (ttrdh,strdh) ('key_trdtra') 
    9886      !! 
    99       !! ** Reference : Leonard (1979, 1991) 
    100       !! History : 
    101       !!  9.0     !  06-09  (G. Reffray)  Original code 
    102       !!---------------------------------------------------------------------- 
    103       !! * Arguments 
    104       INTEGER, INTENT( in ) ::   kt             ! ocean time-step index 
    105       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pun   ! effective ocean velocity, u_component 
    106       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pvn   ! effective ocean velocity, v_component 
    107       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pwn   ! effective ocean velocity, w_component 
    108       !! 
    109       REAL(wp) :: z2                                          ! temporary scalar  
    110       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt, ztrds       ! temporary 3D workspace 
     87      !! References : Leonard (1979, 1991) 
     88      !!---------------------------------------------------------------------- 
     89      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     90      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     91      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     92      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     93      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb, ptn        ! before and now tracer fields 
     94      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
     95      !! 
     96      REAL(wp) :: z2                                   ! temporary scalar  
     97      !!---------------------------------------------------------------------- 
    11198 
    11299      IF( kt == nit000 ) THEN 
    113100         IF(lwp) WRITE(numout,*) 
    114101         IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3st order quickest advection scheme' 
    115          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case' 
    116          IF(lwp) WRITE(numout,*) 
     102         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    117103 
    118104         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    119105         cst1 = 1./12. 
    120106         cst2 = 2./3. 
    121          IF (l_trdtra ) THEN 
    122          CALL ctl_warn( ' Trends not yet implemented for PPM advection scheme ' ) 
    123          ENDIF 
    124107      ENDIF 
    125108 
    … …  
    128111      ENDIF 
    129112 
    130       ! Save ta and sa trends 
    131       IF( l_trdtra )   THEN      ! to be done 
    132          ztrdt(:,:,:) = ta(:,:,:)  
    133          ztrds(:,:,:) = sa(:,:,:)  
    134          l_adv = 'qst' 
    135       ENDIF 
    136113 
    137114      ! I. Slope estimation at the T-point for the limiter ULTIMATE 
    … …  
    163140      CALL lbc_lnk(   sl(:,:,:), 'T', 1. ) 
    164141 
     142 
    165143      ! II. The horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
    166144      !--------------------------------------------------------------------------- 
    167145 
    168       CALL tra_adv_qck_hor( kt , pun, pvn, tb , ta , pht_adv , z2) 
    169       CALL tra_adv_qck_hor( kt , pun, pvn, sb , sa , pst_adv , z2)   
    170  
    171       ! Save the horizontal advective trends for diagnostic 
    172       ! --------------------------------------------------- 
    173 !      IF( l_trdtra )   THEN    ! to be done 
    174 !         ! T/S ZONAL advection trends 
    175 !      ENDIF 
    176  
    177       IF(ln_ctl)   THEN 
    178           CALL prt_ctl(tab3d_1=ta, clinfo1=' centered2 had  - Ta: ', mask1=tmask, & 
    179              &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    180       ENDIF 
     146      CALL tra_adv_qck_hor( kt, cdtype, ktra, pun, pvn, ptb, pta, z2 ) 
     147 
     148      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' qck - had: ', mask1=tmask, clinfo3=cdtype ) 
     149 
    181150 
    182151      ! III. The vertical fluxes are computed with the 2nd order centered scheme 
    183152      !------------------------------------------------------------------------- 
    184153 
    185       CALL tra_adv_qck_ver( pwn, tn , ta, z2 ) 
    186       CALL tra_adv_qck_ver( pwn, sn , sa, z2 ) 
    187  
    188       ! Save the vertical advective trends for diagnostic 
    189       ! ------------------------------------------------- 
    190 !      IF( l_trdtra )   THEN    ! to be done 
    191          ! Recompute the vertical advection zta & zsa trends computed 
    192          ! at the step 2. above in making the difference between the new 
    193          ! trends and the previous one: ta()/sa - ztdta()/ztdsa() and substract 
    194          ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends 
    195 !     ENDIF 
    196  
    197       IF(ln_ctl)   THEN 
    198           CALL prt_ctl(tab3d_1=ta, clinfo1=' centered2 zad  - Ta: ', mask1=tmask, & 
    199              &         tab3d_2=sa, clinfo2=' Sa: ', mask2=tmask, clinfo3='tra') 
    200       ENDIF 
    201  
     154      CALL tra_adv_qck_ver( pwn, ptn , pta, z2 ) 
     155 
     156      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' qck - zad: ', mask1=tmask, clinfo3=cdtype ) 
     157      ! 
    202158   END SUBROUTINE tra_adv_qck 
    203159 
    204    SUBROUTINE tra_adv_qck_hor ( kt , pun, pvn, tra , traa , phtra_adv ,z2 ) 
    205       !!---------------------------------------------------------------------- 
    206       !! 
    207       !!---------------------------------------------------------------------- 
    208       !! * Arguments 
    209       INTEGER, INTENT( in ) ::   kt             ! ocean time-step index 
    210       REAL, INTENT( in )    ::   z2 
    211       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun, pvn            ! horizontal effective velocity 
    212  
    213       REAL(wp), INTENT ( out   ), DIMENSION(jpj)          ::     & 
    214          phtra_adv 
    215  
    216       REAL(wp), INTENT ( inout ), DIMENSION(jpi,jpj,jpk)  ::     & 
    217          tra, traa 
    218  
    219       REAL(wp) ::                                & 
    220          za, zbtr, e1, e2, c, dir, fu, fc, fd,   & ! temporary scalars 
    221          coef2, coef3, fho, mask, dx 
    222  
    223       REAL(wp), DIMENSION(jpi,jpj) ::            & 
    224          zee 
    225  
    226       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  & 
    227          zmask, zlap, dwst, lim  
    228  
    229  
     160 
     161   SUBROUTINE tra_adv_qck_hor ( kt, cdtype, ktra, pun, pvn, ptb, pta, z2 ) 
     162      !!---------------------------------------------------------------------- 
     163      !! 
     164      !!---------------------------------------------------------------------- 
     165      INTEGER         , INTENT(in   )                         ::   kt          ! ocean time-step index 
     166      CHARACTER(len=3), INTENT(in   )                         ::   cdtype      ! =TRA or TRC (tracer indicator) 
     167      INTEGER         , INTENT(in   )                         ::   ktra        ! tracer index 
     168      REAL(wp)        , INTENT(in   )                         ::   z2          ! ??? 
     169      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! horizontal effective velocity 
     170      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb         ! before tracer field 
     171      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta         ! tracer trend 
     172 
     173      REAL(wp) ::   za, zbtr, e1, e2, c, dir, fu, fc, fd   ! temporary scalars 
     174      REAL(wp) ::   coef2, coef3, fho, mask, dx 
     175      REAL(wp), DIMENSION(jpi,jpj) ::  zee 
     176      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask, zlap, dwst, lim  
     177      !!---------------------------------------------------------------------- 
    230178 
    231179      !---------------------------------------------------------------------- 
    232180      ! 0. Initialization (should ot be needed on the whole array ???) 
    233181      !---------------------------------------------------------------------- 
    234  
    235       zmask = 0.0                                                 
    236       zlap  = 0.0                                                   
    237       dwst  = 0.0                                                   
    238       lim   = 0.0      
     182      zmask(:,:,:)= 0.e0                                                 
     183      zlap (:,:,:)= 0.e0                                                   
     184      dwst (:,:,:)= 0.e0                                                   
     185      lim  (:,:,:)= 0.e0      
    239186                                             
    240187      !---------------------------------------------------------------------- 
    … …  
    264211         DO jj = 1, jpjm1 
    265212            DO ji = 1, fs_jpim1   ! vector opt. 
    266                zmask(ji,jj,jk) = zee(ji,jj) * ( tra(ji+1,jj  ,jk) - tra(ji,jj,jk) ) 
     213               zmask(ji,jj,jk) = zee(ji,jj) * ( ptb(ji+1,jj  ,jk) - ptb(ji,jj,jk) ) 
    267214            END DO 
    268215         END DO 
    … …  
    279226         !--- Function lim=FU+SL*(FC-FU) used by the limiter 
    280227         !--- Computation of the ustream and downstream lim at the T-points 
     228!!gm bug : fs_2  instead of 2 ... 
     229!!gm  a lot of optimisation to be done in this routine.... 
    281230         DO jj = 2, jpjm1 
    282231            DO ji = 2, fs_jpim1   ! vector opt. 
    283232               ! Upstream in the x-direction for the tracer 
    284                zmask(ji,jj,jk)=tra(ji-1,jj,jk)+sl(ji,jj,jk)*(tra(ji,jj,jk)-tra(ji-1,jj,jk)) 
     233               zmask(ji,jj,jk) =ptb(ji-1,jj,jk)+sl(ji,jj,jk)*(ptb(ji,jj,jk)-ptb(ji-1,jj,jk)) 
    285234               ! Downstream in the x-direction for the tracer 
    286                dwst (ji,jj,jk)=tra(ji+1,jj,jk)+sl(ji,jj,jk)*(tra(ji,jj,jk)-tra(ji+1,jj,jk)) 
     235               dwst (ji,jj,jk) =ptb(ji+1,jj,jk)+sl(ji,jj,jk)*(ptb(ji,jj,jk)-ptb(ji+1,jj,jk)) 
    287236            ENDDO 
    288237         ENDDO 
    … …  
    329278 
    330279               fu  = lim(ji,jj,jk)                                ! FU + sl(FC-FU) in the x-direction for T 
    331                fc  = dir*tra(ji  ,jj,jk)+(1-dir)*tra(ji+1,jj,jk)  ! FC in the x-direction for T 
    332                fd  = dir*tra(ji+1,jj,jk)+(1-dir)*tra(ji  ,jj,jk)  ! FD in the x-direction for T 
     280               fc  = dir*ptb(ji  ,jj,jk)+(1-dir)*ptb(ji+1,jj,jk)  ! FC in the x-direction for T 
     281               fd  = dir*ptb(ji+1,jj,jk)+(1-dir)*ptb(ji  ,jj,jk)  ! FD in the x-direction for T 
    333282 
    334283               !--- QUICKEST scheme 
    … …  
    358307               za = - zbtr * ( dwst(ji,jj,jk) - dwst(ji-1,jj  ,jk) ) 
    359308               !--- add it to the general tracer trends 
    360                traa(ji,jj,jk) = traa(ji,jj,jk) + za 
     309               pta(ji,jj,jk) = pta(ji,jj,jk) + za 
    361310            END DO 
    362311         END DO 
    … …  
    364313      END DO                                           !   End of slab 
    365314      !                                                ! =============== 
     315 
     316      ! Save the horizontal advective trends for diagnostic 
     317      IF( l_trdtra )   CALL trd_tra_adv( kt, ktra, jpt_trd_xad, cdtype, dwst, pun, ptb ) 
     318 
     319 
    366320      !---------------------------------------------------------------------- 
    367321      ! I. Part 2 : y-direction 
    … …  
    389343         DO jj = 1, jpjm1 
    390344            DO ji = 1, fs_jpim1   ! vector opt. 
    391                zmask(ji,jj,jk) = zee(ji,jj) * ( tra(ji  ,jj+1,jk) - tra(ji,jj,jk) ) 
     345               zmask(ji,jj,jk) = zee(ji,jj) * ( ptb(ji  ,jj+1,jk) - ptb(ji,jj,jk) ) 
    392346            END DO 
    393347         END DO 
    … …  
    408362            DO ji = 2, fs_jpim1   ! vector opt. 
    409363               ! Upstream in the y-direction for the tracer 
    410                zmask(ji,jj,jk)=tra(ji,jj-1,jk)+sl(ji,jj,jk)*(tra(ji,jj,jk)-tra(ji,jj-1,jk)) 
     364               zmask(ji,jj,jk)=ptb(ji,jj-1,jk)+sl(ji,jj,jk)*(ptb(ji,jj,jk)-ptb(ji,jj-1,jk)) 
    411365               ! Downstream in the y-direction for the tracer 
    412                dwst (ji,jj,jk)=tra(ji,jj+1,jk)+sl(ji,jj,jk)*(tra(ji,jj,jk)-tra(ji,jj+1,jk)) 
     366               dwst (ji,jj,jk)=ptb(ji,jj+1,jk)+sl(ji,jj,jk)*(ptb(ji,jj,jk)-ptb(ji,jj+1,jk)) 
    413367            ENDDO 
    414368         ENDDO 
    … …  
    455409 
    456410               fu  = lim(ji,jj,jk)                                ! FU + sl(FC-FU) in the y-direction for T 
    457                fc  = dir*tra(ji,jj  ,jk)+(1-dir)*tra(ji,jj+1,jk)  ! FC in the y-direction for T 
    458                fd  = dir*tra(ji,jj+1,jk)+(1-dir)*tra(ji,jj  ,jk)  ! FD in the y-direction for T 
     411               fc  = dir*ptb(ji,jj  ,jk)+(1-dir)*ptb(ji,jj+1,jk)  ! FC in the y-direction for T 
     412               fd  = dir*ptb(ji,jj+1,jk)+(1-dir)*ptb(ji,jj  ,jk)  ! FD in the y-direction for T 
    459413 
    460414               !--- QUICKEST scheme 
    … …  
    484438               za = - zbtr * (  dwst(ji,jj,jk) - dwst(ji  ,jj-1,jk) ) 
    485439               !--- add it to the general tracer trends 
    486                traa(ji,jj,jk) = traa(ji,jj,jk) + za 
     440               pta(ji,jj,jk) = pta(ji,jj,jk) + za 
    487441            END DO 
    488442         END DO 
    … …  
    491445      !                                                ! =============== 
    492446 
     447      ! Save the horizontal advective trends for diagnostic 
     448      IF( l_trdtra )   CALL trd_tra_adv( kt, ktra, jpt_trd_yad, cdtype, dwst, pvn, ptb ) 
     449 
    493450      ! "zonal" mean advective heat and salt transport  
    494       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     451      IF( ln_diaptr .AND. cdtype == 'TRA' .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    495452#if defined key_zco 
    496453         DO jk = 1, jpkm1 
    … …  
    501458            END DO 
    502459         END DO 
    503          phtra_adv(:) = ptr_vj( dwst(:,:,:) ) 
    504 #else 
    505          phtra_adv(:) = ptr_vj( dwst(:,:,:) ) 
    506460# endif 
     461         IF( ktra == jp_tem)   pht_adv(:) = ptr_vj( dwst(:,:,:) ) 
     462         IF( ktra == jp_sal)   pst_adv(:) = ptr_vj( dwst(:,:,:) ) 
    507463      ENDIF 
    508  
     464      ! 
    509465   END SUBROUTINE tra_adv_qck_hor 
    510466 
    511    SUBROUTINE tra_adv_qck_ver ( pwn, tra , traa, z2  )       
    512       !!---------------------------------------------------------------------- 
    513       !! 
    514       !!---------------------------------------------------------------------- 
    515       !! * Arguments 
    516  
    517       REAL(wp), INTENT ( in ) :: z2 
    518       REAL(wp), INTENT ( in ), DIMENSION(jpi,jpj,jpk)  ::     & 
    519          pwn 
    520       REAL(wp), INTENT ( inout ), DIMENSION(jpi,jpj,jpk)  ::     & 
    521          tra, traa 
    522  
    523       REAL(wp) ::                             & 
    524          za, ze3tr, dt, dir, fc, fd             ! temporary scalars 
     467 
     468   SUBROUTINE tra_adv_qck_ver( pwn, ptn , pta, z2  )       
     469      !!---------------------------------------------------------------------- 
     470      !! 
     471      !!---------------------------------------------------------------------- 
     472      REAL(wp), INTENT(in   )                         ::   z2 
     473      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pwn 
     474      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptn 
     475      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta 
     476      !! 
     477      REAL(wp) ::   za, ze3tr, dt, dir, fc, fd             ! temporary scalars 
    525478 
    526479      ! Vertical advection 
    … …  
    530483      ! ---------------------------- 
    531484 
    532       !Bottom value : flux set to zero 
    533       sl(:,:,jpk) = 0.e0 
     485      sl(:,:,jpk) = 0.e0      !Bottom value : flux set to zero 
    534486 
    535487      ! Surface value 
    536       IF( lk_dynspg_rl .OR. lk_vvl ) THEN 
    537          ! rigid lid : flux set to zero 
     488      IF( lk_dynspg_rl .OR. lk_vvl ) THEN         ! rigid lid : flux set to zero 
    538489         sl(:,:, 1 ) = 0.e0 
    539       ELSE 
    540          ! free surface-constant volume 
    541          sl(:,:, 1 ) = pwn(:,:,1) * tra(:,:,1) 
     490      ELSE                                        ! free surface-constant volume 
     491         sl(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1) 
    542492      ENDIF 
    543493 
    544494      ! Second order centered tracer flux at w-point 
    545  
    546495      DO jk = 2, jpkm1 
    547496         dt  = z2 *  rdttra(jk) 
    … …  
    549498            DO ji = fs_2, fs_jpim1   ! vector opt. 
    550499               dir = 0.5 + sign(0.5,pwn(ji,jj,jk))                                         ! if pwn>0 : dirw = 1 otherwise dirw = 0 
    551                fc = dir*tra(ji,jj,jk  )*fse3t(ji,jj,jk-1)+(1-dir)*tra(ji,jj,jk-1)*fse3t(ji,jj,jk  )   ! FC in the z-direction for T 
    552                fd = dir*tra(ji,jj,jk-1)*fse3t(ji,jj,jk  )+(1-dir)*tra(ji,jj,jk  )*fse3t(ji,jj,jk-1)   ! FD in the z-direction for T 
     500               fc = dir*ptn(ji,jj,jk  )*fse3t(ji,jj,jk-1)+(1-dir)*ptn(ji,jj,jk-1)*fse3t(ji,jj,jk  )   ! FC in the z-direction for T 
     501               fd = dir*ptn(ji,jj,jk-1)*fse3t(ji,jj,jk  )+(1-dir)*ptn(ji,jj,jk  )*fse3t(ji,jj,jk-1)   ! FD in the z-direction for T 
    553502               !--- Second order centered scheme 
    554503               sl(ji,jj,jk)=pwn(ji,jj,jk)*(fc+fd)/(fse3t(ji,jj,jk-1)+fse3t(ji,jj,jk)) 
    … …  
    559508      ! 2. Tracer flux divergence at t-point added to the general trend 
    560509      ! --------------------------------------------------------------- 
    561  
    562510      DO jk = 1, jpkm1 
    563511         DO jj = 2, jpjm1 
    … …  
    567515               za = - ze3tr * ( sl(ji,jj,jk) - sl(ji,jj,jk+1) ) 
    568516               ! add it to the general tracer trends 
    569                traa(ji,jj,jk) =  traa(ji,jj,jk) + za 
     517               pta(ji,jj,jk) =  pta(ji,jj,jk) + za 
    570518            END DO 
    571519         END DO 
    572520      END DO 
    573  
     521      ! 
    574522   END SUBROUTINE tra_adv_qck_ver 
    575523 
     524 
    576525   REAL FUNCTION bound(fu,fd,fc,fho) 
    577       real     ::  fu,fd,fc,fho,fref1,fref2 
     526      REAL(wp) ::  fu, fd, fc, fho, fref1, fref2 
    578527      fref1 = fu 
    579       fref2 = MAX(MIN(fc,fd),MIN(MAX(fc,fd),fref1)) 
    580       bound = MAX(MIN(fho,fc),MIN(MAX(fho,fc),fref2)) 
     528      fref2 = MAX(  MIN( fc , fd ), MIN( MAX( fc , fd ), fref1 )  ) 
     529      bound = MAX(  MIN( fho, fc ), MIN( MAX( fho, fc ), fref2 )  ) 
    581530   END FUNCTION 
    582  
    583 #else 
    584    !!---------------------------------------------------------------------- 
    585    !!   'key_mpp_omp' :      quickest advection (k- and j-slabs) 
    586    !!---------------------------------------------------------------------- 
    587    SUBROUTINE tra_adv_qck( kt, pun, pvn, pwn  ) 
    588       !!---------------------------------------------------------------------- 
    589       !! * Arguments 
    590       INTEGER, INTENT( in ) ::   kt             ! ocean time-step index 
    591       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pun   ! effective ocean velocity, u_component 
    592       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pvn   ! effective ocean velocity, v_component 
    593       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pwn   ! effective ocean velocity, w_component 
    594       !!----------------------------------------------------------------------   
    595          IF(lwp) WRITE(numout,*) 
    596          IF(lwp) WRITE(numout,*) 'tra_adv_ qck:3st order quickest advection scheme'  
    597          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case' 
    598          IF(lwp) WRITE(numout,*) 'WITH AUTOTASKING =>this routine doesn t exist for the moment' 
    599     IF(lwp) WRITE(numout,*) ' EMPTY ROUTINE!!!!!!'       
    600  
    601    END SUBROUTINE tra_adv_qck 
    602  
    603 #endif 
    604531 
    605532   !!====================================================================== 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r719 r786  
    44   !! Ocean active tracers:  horizontal & vertical advective trend 
    55   !!============================================================================== 
    6    !! History :       !  95-12  (L. Mortier)  Original code 
    7    !!                 !  00-01  (H. Loukos)  adapted to ORCA  
    8    !!                 !  00-10  (MA Foujols E.Kestenare)  include file not routine 
    9    !!                 !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes 
    10    !!                 !  01-07  (E. Durand G. Madec)  adaptation to ORCA config 
     6   !! History :  7.0  !  95-12  (L. Mortier)  Original code 
     7   !!            8.0  !  00-01  (H. Loukos)  adapted to ORCA  
     8   !!             -   !  00-10  (MA Foujols E.Kestenare)  include file not routine 
     9   !!             -   !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes 
     10   !!             -   !  01-07  (E. Durand G. Madec)  adaptation to ORCA config 
    1111   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    12    !!            9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 
    13    !!            9.0  !  08-04  (S. Cravatte) add the i-, j- & k- trends computation 
    14    !!            " "  !  05-11  (V. Garnier) Surface pressure gradient organization 
    15    !!---------------------------------------------------------------------- 
    16  
    17  
    18    !!---------------------------------------------------------------------- 
    19    !!   tra_adv_tvd  : update the tracer trend with the horizontal 
    20    !!                  and vertical advection trends using a TVD scheme 
    21    !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory 
    22    !!                  algorithm  
    23    !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean dynamics and active tracers 
     12   !!   NEMO     1.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 
     13   !!             -   !  08-04  (S. Cravatte) add the i-, j- & k- trends computation 
     14   !!             -   !  05-11  (V. Garnier) Surface pressure gradient organization 
     15   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
     16   !!---------------------------------------------------------------------- 
     17 
     18   !!---------------------------------------------------------------------- 
     19   !!   tra_adv_tvd  : update the tracer trend with the horizontal and 
     20   !!                  vertical advection trends using a TVD scheme 
     21   !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory algorithm 
     22   !!---------------------------------------------------------------------- 
    2523   USE dom_oce         ! ocean space and time domain 
    2624   USE trdmod          ! ocean active tracers trends  
    … …  
    2927   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    3028   USE trabbl          ! Advective term of BBL 
    31    USE lib_mpp 
     29   USE lib_mpp         ! 
    3230   USE lbclnk          ! ocean lateral boundary condition (or mpp link)  
    3331   USE diaptr          ! poleward transport diagnostics 
    3432   USE prtctl          ! Print control 
    3533 
    36  
    3734   IMPLICIT NONE 
    3835   PRIVATE 
    3936 
    40    PUBLIC   tra_adv_tvd    ! routine called by step.F90 
     37   PUBLIC   tra_adv_tvd    ! routine called by traadv.F90 
    4138 
    4239   !! * Substitutions 
    … …  
    4441#  include "vectopt_loop_substitute.h90" 
    4542   !!---------------------------------------------------------------------- 
    46    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    47    !! $Header$ 
     43   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     44   !! $Id:$  
    4845   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4946   !!---------------------------------------------------------------------- 
    … …  
    5148CONTAINS 
    5249 
    53    SUBROUTINE tra_adv_tvd( kt, pun, pvn, pwn ) 
     50   SUBROUTINE tra_adv_tvd( kt, cdtype, ktra, pun, pvn, pwn,   & 
     51      &                                      ptb, ptn, pta ) 
    5452      !!---------------------------------------------------------------------- 
    5553      !!                  ***  ROUTINE tra_adv_tvd  *** 
    … …  
    6260      !!       note: - this advection scheme needs a leap-frog time scheme 
    6361      !! 
    64       !! ** Action : - update (ta,sa) with the now advective tracer trends 
     62      !! ** Action : - update pta with the now advective tracer trends 
    6563      !!             - save the trends in (ztrdt,ztrds) ('key_trdtra') 
    6664      !!---------------------------------------------------------------------- 
    67       USE oce              , ztrdt => ua   ! use ua as workspace 
    68       USE oce              , ztrds => va   ! use va as workspace 
    69       !! 
    70       INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
    71       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component 
    72       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component 
    73       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component 
     65      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     66      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     67      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     68      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     69      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   ptb, ptn        ! before and now tracer fields 
     70      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
    7471      !! 
    7572      INTEGER  ::   ji, jj, jk              ! dummy loop indices 
    76       REAL(wp) ::                        &  ! temporary scalar 
    77          ztai, ztaj, ztak,               &  !    "         "    
    78          zsai, zsaj, zsak,               &  !    "         "    
    79          z_hdivn_x, z_hdivn_y, z_hdivn 
    80       REAL(wp) ::   & 
    81          z2dtt, zbtr, zeu, zev,          &  ! temporary scalar 
    82          zew, z2, zbtr1,                 &  ! temporary scalar 
    83          zfp_ui, zfp_vj, zfp_wk,         &  !    "         " 
    84          zfm_ui, zfm_vj, zfm_wk             !    "         " 
     73      REAL(wp) ::   ztai, ztaj, ztak 
     74      REAL(wp) ::   z2dtt, zbtr, zeu, zev   ! temporary scalar 
     75      REAL(wp) ::   zew, z2                          ! temporary scalar 
     76      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk           !    "         " 
     77      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk            !    "         " 
    8578      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zti, ztu, ztv, ztw   ! temporary workspace 
    86       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zsi, zsu, zsv, zsw   !    "           " 
    87       !!---------------------------------------------------------------------- 
    88  
    89       zti(:,:,:) = 0.e0   ;   zsi(:,:,:) = 0.e0 
     79      !!---------------------------------------------------------------------- 
     80 
     81      zti(:,:,:) = 0.e0  
    9082 
    9183      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    10193      ! 1. Bottom value : flux set to zero 
    10294      ! --------------- 
    103       ztu(:,:,jpk) = 0.e0   ;   zsu(:,:,jpk) = 0.e0 
    104       ztv(:,:,jpk) = 0.e0   ;   zsv(:,:,jpk) = 0.e0 
    105       ztw(:,:,jpk) = 0.e0   ;   zsw(:,:,jpk) = 0.e0 
    106       zti(:,:,jpk) = 0.e0   ;   zsi(:,:,jpk) = 0.e0 
     95      ztu(:,:,jpk) = 0.e0   ;   ztv(:,:,jpk) = 0.e0 
     96      ztw(:,:,jpk) = 0.e0   ;   zti(:,:,jpk) = 0.e0 
    10797 
    10898 
    … …  
    120110               zfp_vj = zev + ABS( zev ) 
    121111               zfm_vj = zev - ABS( zev ) 
    122                ztu(ji,jj,jk) = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk) 
    123                ztv(ji,jj,jk) = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk) 
    124                zsu(ji,jj,jk) = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk) 
    125                zsv(ji,jj,jk) = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk) 
     112               ztu(ji,jj,jk) = zfp_ui * ptb(ji,jj,jk) + zfm_ui * ptb(ji+1,jj  ,jk) 
     113               ztv(ji,jj,jk) = zfp_vj * ptb(ji,jj,jk) + zfm_vj * ptb(ji  ,jj+1,jk) 
    126114            END DO 
    127115         END DO 
    … …  
    132120      IF( lk_dynspg_rl .OR. lk_vvl ) THEN               ! rigid lid or variable volume: flux set to zero 
    133121         ztw(:,:,1) = 0.e0 
    134          zsw(:,:,1) = 0.e0 
    135122      ELSE                                              ! free surface 
    136          DO jj = 1, jpj 
    137             DO ji = 1, jpi 
    138                zew = e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,1) 
    139                ztw(ji,jj,1) = zew * tb(ji,jj,1) 
    140                zsw(ji,jj,1) = zew * sb(ji,jj,1) 
    141             END DO 
    142          END DO 
     123         ztw(:,:,1) = e1t(:,:) * e2t(:,:) * pwn(:,:,1) * ptb(:,:,1) 
    143124      ENDIF 
    144125 
    … …  
    150131               zfp_wk = zew + ABS( zew ) 
    151132               zfm_wk = zew - ABS( zew ) 
    152                ztw(ji,jj,jk) = zfp_wk * tb(ji,jj,jk) + zfm_wk * tb(ji,jj,jk-1) 
    153                zsw(ji,jj,jk) = zfp_wk * sb(ji,jj,jk) + zfm_wk * sb(ji,jj,jk-1) 
     133               ztw(ji,jj,jk) = zfp_wk * ptb(ji,jj,jk) + zfm_wk * ptb(ji,jj,jk-1) 
    154134            END DO 
    155135         END DO 
    … …  
    165145               ztaj = - ( ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  ) ) * zbtr 
    166146               ztak = - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr 
    167                zsai = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  ) ) * zbtr 
    168                zsaj = - ( zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  ) ) * zbtr 
    169                zsak = - ( zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr 
    170147               ! total intermediate advective trends 
    171148               zti(ji,jj,jk) = ztai + ztaj + ztak 
    172                zsi(ji,jj,jk) = zsai + zsaj + zsak 
    173             END DO 
    174          END DO 
    175       END DO 
    176  
    177  
    178       ! Save the intermediate i / j / k advective trends for diagnostics 
    179       ! ------------------------------------------------------------------- 
    180       ! Warning : We should use zun instead of un in the computations below, but we 
    181       ! also use hdivn which is computed with un, vn (check ???). So we use un, vn 
    182       ! for consistency. Results are therefore approximate with key_trabbl_adv. 
    183  
     149            END DO 
     150         END DO 
     151      END DO 
     152 
     153      !  Save the horizontal advective trends for diagnostic 
     154      ! ----------------------------------------------------- 
    184155      IF( l_trdtra ) THEN 
    185          ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
    186          !  
    187          ! T/S ZONAL advection trends 
    188          DO jk = 1, jpkm1 
    189             DO jj = 2, jpjm1 
    190                DO ji = fs_2, fs_jpim1   ! vector opt. 
    191                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    192                   ztrdt(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr 
    193                   ztrds(ji,jj,jk) = - ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) ) * zbtr 
    194                END DO 
    195             END DO 
    196          END DO 
    197          CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)    ! save the trends 
    198          ! 
    199          ! T/S MERIDIONAL advection trends 
    200          DO jk = 1, jpkm1 
    201             DO jj = 2, jpjm1 
    202                DO ji = fs_2, fs_jpim1   ! vector opt. 
    203                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    204                   ztrdt(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr 
    205                   ztrds(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) * zbtr 
    206                END DO 
    207             END DO 
    208          END DO 
    209          CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)     ! save the trends 
    210          ! 
    211          ! T/S VERTICAL advection trends 
    212          DO jk = 1, jpkm1 
    213             DO jj = 2, jpjm1 
    214                DO ji = fs_2, fs_jpim1   ! vector opt.          
    215                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    216                   ztrdt(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr 
    217                   ztrds(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr 
    218                END DO 
    219             END DO 
    220          END DO 
    221          CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)     ! save the trends 
    222          ! 
     156         CALL trd_tra_adv( kt, ktra, jpt_trd_xad, cdtype, ztu, pun, ptn ) 
     157         CALL trd_tra_adv( kt, ktra, jpt_trd_yad, cdtype, ztv, pvn, ptn ) 
     158         CALL trd_tra_adv( kt, ktra, jpt_trd_zad, cdtype, ztw, pwn, ptn ) 
    223159      ENDIF 
    224160 
    … …  
    228164         DO jj = 2, jpjm1 
    229165            DO ji = fs_2, fs_jpim1   ! vector opt. 
    230                ta(ji,jj,jk) =  ta(ji,jj,jk) + zti(ji,jj,jk) 
    231                sa(ji,jj,jk) =  sa(ji,jj,jk) + zsi(ji,jj,jk) 
    232                zti (ji,jj,jk) = ( tb(ji,jj,jk) + z2dtt * zti(ji,jj,jk) ) * tmask(ji,jj,jk) 
    233                zsi (ji,jj,jk) = ( sb(ji,jj,jk) + z2dtt * zsi(ji,jj,jk) ) * tmask(ji,jj,jk) 
    234             END DO 
    235          END DO 
    236       END DO 
    237  
    238       ! Lateral boundary conditions on zti, zsi   (unchanged sign) 
     166               pta(ji,jj,jk) =  pta(ji,jj,jk) + zti(ji,jj,jk) 
     167               zti (ji,jj,jk) = ( ptb(ji,jj,jk) + z2dtt * zti(ji,jj,jk) ) * tmask(ji,jj,jk) 
     168            END DO 
     169         END DO 
     170      END DO 
     171 
     172      ! Lateral boundary conditions on zti   (unchanged sign) 
    239173      CALL lbc_lnk( zti, 'T', 1. ) 
    240       CALL lbc_lnk( zsi, 'T', 1. ) 
    241174 
    242175 
    … …  
    249182               zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk) 
    250183               zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk) 
    251                ztu(ji,jj,jk) = zeu * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) - ztu(ji,jj,jk) 
    252                zsu(ji,jj,jk) = zeu * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) - zsu(ji,jj,jk) 
    253                ztv(ji,jj,jk) = zev * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) - ztv(ji,jj,jk) 
    254                zsv(ji,jj,jk) = zev * ( sn(ji,jj,jk) + sn(ji,jj+1,jk) ) - zsv(ji,jj,jk) 
     184               ztu(ji,jj,jk) = zeu * ( ptn(ji,jj,jk) + ptn(ji+1,jj,jk) ) - ztu(ji,jj,jk) 
     185               ztv(ji,jj,jk) = zev * ( ptn(ji,jj,jk) + ptn(ji,jj+1,jk) ) - ztv(ji,jj,jk) 
    255186            END DO 
    256187         END DO 
    … …  
    260191      ! Surface value 
    261192      ztw(:,:,1) = 0.e0 
    262       zsw(:,:,1) = 0.e0 
    263193 
    264194      ! Interior value 
    … …  
    267197            DO ji = 1, jpi 
    268198               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk) 
    269                ztw(ji,jj,jk) = zew * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) - ztw(ji,jj,jk) 
    270                zsw(ji,jj,jk) = zew * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) - zsw(ji,jj,jk) 
     199               ztw(ji,jj,jk) = zew * ( ptn(ji,jj,jk) + ptn(ji,jj,jk-1) ) - ztw(ji,jj,jk) 
    271200            END DO 
    272201         END DO 
    … …  
    274203 
    275204      ! Lateral bondary conditions 
    276       CALL lbc_lnk( ztu, 'U', -1. )   ;   CALL lbc_lnk( zsu, 'U', -1. ) 
    277       CALL lbc_lnk( ztv, 'V', -1. )   ;   CALL lbc_lnk( zsv, 'V', -1. ) 
    278       CALL lbc_lnk( ztw, 'W',  1. )   ;   CALL lbc_lnk( zsw, 'W',  1. ) 
     205      CALL lbc_lnk( ztu, 'U', -1. ) 
     206      CALL lbc_lnk( ztv, 'V', -1. ) 
     207      CALL lbc_lnk( ztw, 'W',  1. ) 
    279208 
    280209      ! 4. monotonicity algorithm 
    281210      ! ------------------------- 
    282       CALL nonosc( tb, ztu, ztv, ztw, zti, z2 ) 
    283       CALL nonosc( sb, zsu, zsv, zsw, zsi, z2 ) 
     211      CALL nonosc( ptb, ztu, ztv, ztw, zti, z2 ) 
    284212 
    285213 
    … …  
    294222               ztaj = - ( ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )) * zbtr 
    295223               ztak = - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1)) * zbtr 
    296                zsai = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )) * zbtr 
    297                zsaj = - ( zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )) * zbtr 
    298                zsak = - ( zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1)) * zbtr 
    299224 
    300225               ! add them to the general tracer trends 
    301                ta(ji,jj,jk) = ta(ji,jj,jk) + ztai + ztaj + ztak 
    302                sa(ji,jj,jk) = sa(ji,jj,jk) + zsai + zsaj + zsak 
    303             END DO 
    304          END DO 
    305       END DO 
    306  
    307  
    308       ! Save the advective trends for diagnostics 
    309       ! -------------------------------------------- 
    310  
     226               pta(ji,jj,jk) = pta(ji,jj,jk) + ztai + ztaj + ztak 
     227            END DO 
     228         END DO 
     229      END DO 
     230 
     231!!gm  the transport computation is wrong, the upstream part is missing ! 
     232      ! "zonal" mean advective heat and salt transport 
     233      IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     234         IF( ktra == jp_tem)   pht_adv(:) = ptr_vj( ztv(:,:,:) ) 
     235         IF( ktra == jp_sal)   pst_adv(:) = ptr_vj( ztv(:,:,:) ) 
     236      ENDIF 
     237 
     238      !  Save the horizontal advective trends for diagnostic 
     239      ! ----------------------------------------------------- 
    311240      IF( l_trdtra ) THEN 
    312          ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
    313          ! 
    314          ! T/S ZONAL advection trends 
    315          DO jk = 1, jpkm1 
    316             DO jj = 2, jpjm1 
    317                DO ji = fs_2, fs_jpim1   ! vector opt. 
    318                   !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
    319                   !   N.B. This computation is not valid along OBCs (if any) 
    320                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    321                   z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
    322                      &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
    323                   !-- Compute T/S zonal advection trends 
    324                   ztrdt(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_x 
    325                   ztrds(ji,jj,jk) = - ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_x 
    326                END DO 
    327             END DO 
    328          END DO 
    329          CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED 
    330          ! 
    331          ! T/S MERIDIONAL advection trends 
    332          DO jk = 1, jpkm1 
    333             DO jj = 2, jpjm1 
    334                DO ji = fs_2, fs_jpim1   ! vector opt. 
    335                   !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
    336                   !   N.B. This computation is not valid along OBCs (if any) 
    337                   zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    338                   z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
    339                      &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
    340                   !-- Compute T/S meridional advection trends 
    341                   ztrdt(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_y           
    342                   ztrds(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_y           
    343                END DO 
    344             END DO 
    345          END DO 
    346          CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED 
    347          ! 
    348          ! T/S VERTICAL advection trends 
    349          DO jk = 1, jpkm1 
    350             DO jj = 2, jpjm1 
    351                DO ji = fs_2, fs_jpim1   ! vector opt. 
    352                   zbtr1     = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
    353 #if defined key_zco 
    354                   zbtr      = zbtr1 
    355                   z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
    356                   z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
    357 #else 
    358                   zbtr      = zbtr1 / fse3t(ji,jj,jk) 
    359                   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) 
    360                   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) 
    361 #endif 
    362                   z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
    363                   zbtr      = zbtr1 / fse3t(ji,jj,jk) 
    364                   ztrdt(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr - tn(ji,jj,jk) * z_hdivn 
    365                   ztrds(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr - sn(ji,jj,jk) * z_hdivn 
    366                END DO 
    367             END DO 
    368          END DO 
    369          CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED 
    370          ! 
    371       ENDIF 
    372  
    373       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' tvd adv  - Ta: ', mask1=tmask,   & 
    374          &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    375  
    376       ! "zonal" mean advective heat and salt transport 
    377       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    378          pht_adv(:) = ptr_vj( ztv(:,:,:) ) 
    379          pst_adv(:) = ptr_vj( zsv(:,:,:) ) 
    380       ENDIF 
     241         CALL trd_tra_adv( kt, ktra, jpt_trd_xad, cdtype, ztu, pun, ptn, cnbpas='bis' )   ! <<< Add to iad trend 
     242         CALL trd_tra_adv( kt, ktra, jpt_trd_yad, cdtype, ztv, pvn, ptn, cnbpas='bis' )   ! <<< Add to jad trend 
     243         CALL trd_tra_adv( kt, ktra, jpt_trd_zad, cdtype, ztw, pwn, ptn, cnbpas='bis' )   ! <<< Add to zad trend 
     244      ENDIF 
     245 
     246      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' tvd - adv: ', mask1=tmask, clinfo3=cdtype ) 
    381247      ! 
    382248   END SUBROUTINE tra_adv_tvd 
    … …  
    396262      !!       in-space based differencing for fluid 
    397263      !!---------------------------------------------------------------------- 
    398       REAL(wp), INTENT( in ) ::   prdt                               ! ??? 
    399       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( inout ) ::   & 
    400          pbef,                            & ! before field 
    401          paft,                            & ! after field 
    402          paa,                             & ! monotonic flux in the i direction 
    403          pbb,                             & ! monotonic flux in the j direction 
    404          pcc                                ! monotonic flux in the k direction 
     264      REAL(wp), INTENT(in   ) ::   prdt                               ! ??? 
     265      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pbef, paft       ! before & after field 
     266      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paa, pbb, pcc    ! monotonic flux in the 3 directions 
    405267      !! 
    406268      INTEGER ::   ji, jj, jk               ! dummy loop indices 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r719 r786  
    22   !!============================================================================== 
    33   !!                       ***  MODULE  traadv_ubs  *** 
    4    !! Ocean active tracers:  horizontal & vertical advective trend 
     4   !! Ocean tracers:  horizontal & vertical advective trend 
    55   !!============================================================================== 
    6    !! History :  9.0  !  06-08  (L. Debreu, R. Benshila)  Original code 
     6   !! History :  1.0  !  06-08  (L. Debreu, R. Benshila)  Original code 
     7   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
    78   !!---------------------------------------------------------------------- 
    89 
    … …  
    1112   !!                 advection trends using a third order biaised scheme   
    1213   !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and active tracers 
    1414   USE dom_oce         ! ocean space and time domain 
    1515   USE trdmod 
    … …  
    3333#  include "vectopt_loop_substitute.h90" 
    3434   !!---------------------------------------------------------------------- 
    35    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    36    !! $Header$ 
     35   !! NEMO/OPA & TRP 2.4 , LOCEAN-IPSL (2008)  
     36   !! $Id:$  
    3737   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    3838   !!---------------------------------------------------------------------- 
    … …  
    4040CONTAINS 
    4141 
    42    SUBROUTINE tra_adv_ubs( kt, pun, pvn, pwn ) 
     42   SUBROUTINE tra_adv_ubs( kt, cdtype, ktra, pun, pvn, pwn,   & 
     43      &                                      ptb, ptn, pta ) 
    4344      !!---------------------------------------------------------------------- 
    4445      !!                  ***  ROUTINE tra_adv_ubs  *** 
    … …  
    7071      !! 
    7172      !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404.  
    72       !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741.  
    73       !!---------------------------------------------------------------------- 
    74       USE oce, ONLY :   zwx => ua   ! use ua as workspace 
    75       USE oce, ONLY :   zwy => va   ! use va as workspace 
    76       !! 
    77       INTEGER , INTENT(in)                         ::   kt             ! ocean time-step index 
    78       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pun   ! effective ocean velocity, u_component 
    79       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pvn   ! effective ocean velocity, v_component 
    80       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pwn   ! effective ocean velocity, w_component 
     73      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731–1741.  
     74      !!---------------------------------------------------------------------- 
     75      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     76      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     77      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     78      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     79      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   ptb, ptn        ! before and now tracer fields 
     80      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
    8181      !! 
    8282      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    83       REAL(wp) ::   zta, zsa, zbtr, zcoef                  ! temporary scalars 
    84       REAL(wp) ::   zfui, zfp_ui, zfm_ui, zcenut, zcenus   !    "         " 
    85       REAL(wp) ::   zfvj, zfp_vj, zfm_vj, zcenvt, zcenvs   !    "         " 
    86       REAL(wp) ::   z_hdivn_x, z_hdivn_y, z_hdivn          !    "         " 
     83      REAL(wp) ::   zta, zbtr, zcoef                  ! temporary scalars 
     84      REAL(wp) ::   zfui, zfp_ui, zfm_ui, zcenut      !    "         " 
     85      REAL(wp) ::   zfvj, zfp_vj, zfm_vj, zcenvt      !    "         " 
     86      REAL(wp) ::   z_hdivn                           !    "         " 
    8787      REAL(wp), DIMENSION(jpi,jpj)     ::   zeeu, zeev     ! temporary 2D workspace 
    88       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz , zww                        ! temporary 3D workspace 
     88      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy              ! temporary 3D workspace 
    8989      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu , ztv , zltu , zltv, ztrdt   !    "              " 
    90       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsu , zsv , zlsu , zlsv, ztrds   !    "              " 
    9190      !!---------------------------------------------------------------------- 
    9291 
    9392      zltu(:,:,:) = 0.e0 
    9493      zltv(:,:,:) = 0.e0 
    95       zlsu(:,:,:) = 0.e0 
    96       zlsv(:,:,:) = 0.e0 
    9794 
    9895      IF( kt == nit000 ) THEN 
    … …  
    104101      ENDIF 
    105102 
    106       ! Save ta and sa trends 
    107       ztrdt(:,:,:) = ta(:,:,:) 
    108       ztrds(:,:,:) = sa(:,:,:) 
     103      ! store pta trends 
     104      ztrdt(:,:,:) = pta(:,:,:) 
    109105 
    110106      zcoef = 1./6. 
    … …  
    132128         DO jj = 1, jpjm1 
    133129            DO ji = 1, fs_jpim1   ! vector opt. 
    134                ztu(ji,jj,jk) = zeeu(ji,jj) * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) ) 
    135                zsu(ji,jj,jk) = zeeu(ji,jj) * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) ) 
    136                ztv(ji,jj,jk) = zeev(ji,jj) * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) ) 
    137                zsv(ji,jj,jk) = zeev(ji,jj) * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) ) 
     130               ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj  ,jk) - ptb(ji,jj,jk) ) 
     131               ztv(ji,jj,jk) = zeev(ji,jj) * ( ptb(ji  ,jj+1,jk) - ptb(ji,jj,jk) ) 
    138132            END DO 
    139133         END DO 
    … …  
    145139#endif          
    146140               zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef 
    147                zlsu(ji,jj,jk) = (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)  ) * zcoef 
    148141               zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef 
    149                zlsv(ji,jj,jk) = (  zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) * zcoef 
    150142            END DO 
    151143         END DO 
    … …  
    155147 
    156148      ! Lateral boundary conditions on the laplacian (zlt,zls)   (unchanged sgn) 
    157       CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zlsu, 'T', 1. ) 
    158       CALL lbc_lnk( zltv, 'T', 1. )   ;    CALL lbc_lnk( zlsv, 'T', 1. ) 
     149      CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. ) 
    159150 
    160151      !                                                ! =============== 
    … …  
    178169               zfm_vj = zfvj - ABS( zfvj ) 
    179170               ! centered scheme 
    180                zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) ) 
    181                zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) ) 
    182                zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) ) 
    183                zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) ) 
     171               zcenut = zfui * ( ptn(ji,jj,jk) + ptn(ji+1,jj  ,jk) ) 
     172               zcenvt = zfvj * ( ptn(ji,jj,jk) + ptn(ji  ,jj+1,jk) ) 
    184173               ! mixed centered / upstream scheme 
    185174               zwx(ji,jj,jk) = zcenut - zfp_ui * zltu(ji,jj,jk) -zfm_ui * zltu(ji+1,jj,jk) 
    186175               zwy(ji,jj,jk) = zcenvt - zfp_vj * zltv(ji,jj,jk) -zfm_vj * zltv(ji,jj+1,jk) 
    187                zww(ji,jj,jk) = zcenus - zfp_ui * zlsu(ji,jj,jk) -zfm_ui * zlsu(ji+1,jj,jk) 
    188                zwz(ji,jj,jk) = zcenvs - zfp_vj * zlsv(ji,jj,jk) -zfm_vj * zlsv(ji,jj+1,jk) 
    189176            END DO 
    190177         END DO 
    … …  
    201188               zta = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   & 
    202189                  &            + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  ) 
    203                zsa = - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj  ,jk)   & 
    204                   &            + zwz(ji,jj,jk) - zwz(ji  ,jj-1,jk)  ) 
    205190               ! add it to the general tracer trends 
    206                ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    207                sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
     191               pta(ji,jj,jk) = pta(ji,jj,jk) + zta 
    208192            END DO 
    209193         END DO 
    … …  
    213197 
    214198      ! Horizontal trend used in tra_adv_ztvd subroutine 
    215       zltu(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)  
    216       zlsu(:,:,:) = sa(:,:,:) - ztrds(:,:,:)  
    217  
    218       ! 3. Save the horizontal advective trends for diagnostic 
    219       ! ------------------------------------------------------ 
    220       IF( l_trdtra )   THEN 
    221          ! Recompute the hoizontal advection zta & zsa trends computed  
    222          ! at the step 2. above in making the difference between the new  
    223          ! trends and the previous one ta()/sa - ztrdt()/ztrds() and add 
    224          ! the term tn()/sn()*hdivn() to recover the Uh gradh(T/S) trends 
    225          ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0 
    226          ! 
    227          ! T/S ZONAL advection trends 
    228          DO jk = 1, jpkm1 
    229             DO jj = 2, jpjm1 
    230                DO ji = fs_2, fs_jpim1   ! vector opt. 
    231                   !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
    232 #if defined key_zco 
    233                   zbtr = e1e2tr(ji,jj) 
    234                   z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)          & 
    235                      &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr 
    236 #else 
    237                   zbtr = e1e2tr(ji,jj) / fse3t(ji,jj,jk) 
    238                   z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          & 
    239                      &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr 
    240 #endif 
    241                   ztrdt(ji,jj,jk) = - ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_x 
    242                   ztrds(ji,jj,jk) = - ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_x 
    243                END DO 
    244             END DO 
    245          END DO 
    246          CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)    ! save the trends 
    247          ! 
    248          ! T/S MERIDIONAL advection trends 
    249          DO jk = 1, jpkm1 
    250             DO jj = 2, jpjm1 
    251                DO ji = fs_2, fs_jpim1   ! vector opt. 
    252                   !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
    253 #if defined key_zco 
    254                   zbtr      = e1e2tr(ji,jj) 
    255                   z_hdivn_y = (  e1v(ji,  jj) * pvn(ji,jj  ,jk)          & 
    256                      &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr 
    257 #else 
    258                   zbtr      = e1e2tr(ji,jj) / fse3t(ji,jj,jk) 
    259                   z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          & 
    260                      &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr 
    261 #endif 
    262                   ztrdt(ji,jj,jk) = - ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_y           
    263                   ztrds(ji,jj,jk) = - ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_y 
    264                END DO 
    265             END DO 
    266          END DO 
    267          CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)     ! save the trends 
    268          ! 
    269       ENDIF 
    270  
    271       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' ubs had  - Ta: ', mask1=tmask,   & 
    272          &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    273  
    274       ! "zonal" mean advective heat and salt transport  
    275       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     199      zltu(:,:,:) = pta(:,:,:) - ztrdt(:,:,:)  
     200 
     201      !  Save the horizontal advective trends for diagnostic 
     202      ! ----------------------------------------------------- 
     203      IF( l_trdtra ) THEN 
     204         CALL trd_tra_adv( kt, ktra, jpt_trd_xad, cdtype, zwx, pun, ptn ) 
     205         CALL trd_tra_adv( kt, ktra, jpt_trd_yad, cdtype, zwy, pvn, ptn ) 
     206      ENDIF 
     207 
     208      ! "Poleward" heat or salt transport  
     209      IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    276210         IF( lk_zco ) THEN 
    277211            DO jk = 1, jpkm1 
    278212               DO jj = 2, jpjm1 
    279213                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    280                      zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk) 
    281                      zwz(ji,jj,jk) = zwz(ji,jj,jk) * fse3v(ji,jj,jk) 
     214                    zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk) 
    282215                  END DO 
    283216               END DO 
    284217            END DO 
    285218         ENDIF 
    286          pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
    287          pst_adv(:) = ptr_vj( zwz(:,:,:) ) 
    288       ENDIF 
     219         IF( ktra == jp_tem)   pht_adv(:) = ptr_vj( zwy(:,:,:) ) 
     220         IF( ktra == jp_sal)   pst_adv(:) = ptr_vj( zwy(:,:,:) ) 
     221      ENDIF 
     222 
     223      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' ubs - had: ', mask1=tmask, clinfo3=cdtype ) 
     224 
    289225 
    290226      ! II. Vertical advection 
    291227      ! ---------------------- 
    292       IF( l_trdtra ) THEN          ! Save ta and sa trends 
    293          ztrdt(:,:,:) = ta(:,:,:) 
    294          ztrds(:,:,:) = sa(:,:,:) 
    295       ENDIF 
     228      IF( l_trdtra )   ztrdt(:,:,:) = pta(:,:,:)          ! Save ta and sa trends 
    296229     
    297230      ! TVD scheme the vertical direction   
    298       CALL tra_adv_ztvd(kt, pwn, zltu, zlsu) 
    299  
    300       IF( l_trdtra )   THEN         !  Save the final vertical advective trends 
     231      CALL tra_adv_ztvd( kt, pwn, zltu, ptb, ptn, pta ) 
     232 
     233      IF( l_trdtra )   THEN         !  vertical advective trend diagnostics 
    301234         DO jk = 1, jpkm1 
    302235            DO jj = 2, jpjm1 
    303236               DO ji = fs_2, fs_jpim1   ! vector opt. 
    304 #if defined key_zco 
    305                   zbtr      = e1e2tr(ji,jj) 
    306                   z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk) 
    307                   z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk) 
    308 #else 
    309                   zbtr      = e1e2tr(ji,jj) / fse3t(ji,jj,jk) 
    310                   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) 
    311                   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) 
    312 #endif 
    313                   z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr 
    314                   zbtr      = e1e2tr(ji,jj) / fse3t(ji,jj,jk) 
    315                   ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn 
    316                   ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn 
     237                  z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) / fse3t(ji,jj,jk) 
     238                  ztrdt(ji,jj,jk) = pta(ji,jj,jk) - ztrdt(ji,jj,jk+1)  +  ptn(ji,jj,jk) * z_hdivn  
    317239               END DO 
    318240            END DO 
    319241         END DO 
    320          CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)   ! <<< ADD TO PREVIOUSLY COMPUTED 
     242         CALL trd_tra( kt, ktra, jpt_trd_zad, cdtype, ptrd3d=ztrdt ) 
    321243         ! 
    322244      ENDIF 
    323  
    324       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' ubs zad  - Ta: ', mask1=tmask,   & 
    325          &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra') 
     245      
     246      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' ubs - zad: ', mask1=tmask, clinfo3=cdtype ) 
    326247      ! 
    327248   END SUBROUTINE tra_adv_ubs 
    328249 
    329250 
    330    SUBROUTINE tra_adv_ztvd( kt, pwn, zttrd, zstrd ) 
     251   SUBROUTINE tra_adv_ztvd( kt, pwn, zttrd, ptb, ptn, pta ) 
    331252      !!---------------------------------------------------------------------- 
    332253      !!                  ***  ROUTINE tra_adv_ztvd  *** 
    … …  
    342263      !!             - save the trends in (ztrdt,ztrds) ('key_trdtra') 
    343264      !!---------------------------------------------------------------------- 
    344       INTEGER , INTENT(in)                         ::   kt             ! ocean time-step 
    345       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn            ! verical effective velocity 
    346       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   zttrd, zstrd   ! lateral advective trends on T & S  
     265      INTEGER , INTENT(in   )                         ::   kt      ! ocean time-step 
     266      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pwn     ! verical effective velocity 
     267      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   zttrd   ! lateral advective trends on T & S  
     268      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   ptb, ptn        ! before and now tracer fields 
     269      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
    347270      !! 
    348271      INTEGER  ::   ji, jj, jk              ! dummy loop indices 
    349272      REAL(wp) ::   z2dtt, zbtr, zew, z2    ! temporary scalar   
    350       REAL(wp) ::   ztak, zfp_wk            !    "         " 
    351       REAL(wp) ::   zsak, zfm_wk            !    "         " 
     273      REAL(wp) ::   ztak, zfp_wk, zfm_wk            !    "         " 
    352274      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zti, ztw   ! temporary 3D workspace 
    353       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zsi, zsw   !    "              " 
    354275      !!---------------------------------------------------------------------- 
    355276 
    … …  
    366287      !  Bottom value : flux set to zero 
    367288      ! -------------- 
    368       ztw(:,:,jpk) = 0.e0   ;   zsw(:,:,jpk) = 0.e0 
    369       zti  (:,:,:) = 0.e0   ;   zsi  (:,:,:) = 0.e0 
     289      ztw(:,:,jpk) = 0.e0   ;   zti  (:,:,:) = 0.e0 
    370290 
    371291 
    … …  
    375295      IF( lk_dynspg_rl .OR. lk_vvl ) THEN                           ! rigid lid : flux set to zero 
    376296         ztw(:,:,1) = 0.e0 
    377          zsw(:,:,1) = 0.e0 
    378       ELSE                                              ! free surface 
    379          DO jj = 1, jpj 
    380             DO ji = 1, jpi 
    381                zew = e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,1) 
    382                ztw(ji,jj,1) = zew * tb(ji,jj,1) 
    383                zsw(ji,jj,1) = zew * sb(ji,jj,1) 
    384             END DO 
    385          END DO 
     297      ELSE                                                          ! free surface 
     298         ztw(:,:,1) = e1t(:,:) * e2t(:,:) * pwn(:,:,1) * ptb(:,:,1) 
    386299      ENDIF 
    387300 
    … …  
    393306               zfp_wk = zew + ABS( zew ) 
    394307               zfm_wk = zew - ABS( zew ) 
    395                ztw(ji,jj,jk) = zfp_wk * tb(ji,jj,jk) + zfm_wk * tb(ji,jj,jk-1) 
    396                zsw(ji,jj,jk) = zfp_wk * sb(ji,jj,jk) + zfm_wk * sb(ji,jj,jk-1) 
     308               ztw(ji,jj,jk) = zfp_wk * ptb(ji,jj,jk) + zfm_wk * ptb(ji,jj,jk-1) 
    397309            END DO 
    398310         END DO 
    … …  
    406318               zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    407319               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr 
    408                zsak = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr 
    409                ta(ji,jj,jk) =  ta(ji,jj,jk) + ztak 
    410                sa(ji,jj,jk) =  sa(ji,jj,jk) + zsak  
    411                zti (ji,jj,jk) = ( tb(ji,jj,jk) + z2dtt * ( ztak + zttrd(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
    412                zsi (ji,jj,jk) = ( sb(ji,jj,jk) + z2dtt * ( zsak + zstrd(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
     320               pta(ji,jj,jk) =  pta(ji,jj,jk) + ztak 
     321               zti (ji,jj,jk) = ( ptb(ji,jj,jk) + z2dtt * ( ztak + zttrd(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
    413322            END DO 
    414323         END DO 
    … …  
    417326      ! Lateral boundary conditions on zti, zsi   (unchanged sign) 
    418327      CALL lbc_lnk( zti, 'T', 1. ) 
    419       CALL lbc_lnk( zsi, 'T', 1. ) 
    420328 
    421329 
    422330      !  antidiffusive flux : high order minus low order 
    423331      ! -------------------------------------------------       
    424       ! Surface value 
    425       ztw(:,:,1) = 0.e0   ;   zsw(:,:,1) = 0.e0 
    426  
    427       ! Interior value 
    428       DO jk = 2, jpkm1 
     332      ztw(:,:,1) = 0.e0       ! Surface value 
     333 
     334      DO jk = 2, jpkm1        ! Interior value 
    429335         DO jj = 1, jpj 
    430336            DO ji = 1, jpi 
    431337               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk) 
    432                ztw(ji,jj,jk) = zew * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) - ztw(ji,jj,jk) 
    433                zsw(ji,jj,jk) = zew * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) - zsw(ji,jj,jk) 
     338               ztw(ji,jj,jk) = zew * ( ptn(ji,jj,jk) + ptn(ji,jj,jk-1) ) - ztw(ji,jj,jk) 
    434339            END DO 
    435340         END DO 
    … …  
    438343      !  monotonicity algorithm 
    439344      ! ------------------------ 
    440       CALL nonosc_z( tb, ztw, zti, z2 ) 
    441       CALL nonosc_z( sb, zsw, zsi, z2 ) 
     345      CALL nonosc_z( ptb, ztw, zti, z2 ) 
    442346 
    443347 
    … …  
    450354               ! k- vertical advective trends 
    451355               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr 
    452                zsak = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr 
    453356               ! add them to the general tracer trends 
    454                ta(ji,jj,jk) = ta(ji,jj,jk) + ztak 
    455                sa(ji,jj,jk) = sa(ji,jj,jk) + zsak 
     357               pta(ji,jj,jk) = pta(ji,jj,jk) + ztak 
    456358            END DO 
    457359         END DO 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/trabbc.F90

    r719 r786  
    1515   !!   tra_bbc_init : initialization of geothermal heat flux trend 
    1616   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1817   USE oce             ! ocean dynamics and active tracers 
    1918   USE dom_oce         ! ocean space and time domain 
    … …  
    4140   !! * Substitutions 
    4241#  include "domzgr_substitute.h90" 
     42#  include "vectopt_loop_substitute.h90" 
    4343   !!---------------------------------------------------------------------- 
    44    !!  OPA 9.0 , LOCEAN-IPSL (2006)  
    45    !! $Header$  
     44   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     45   !! $Id:$  
    4646   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4747   !!---------------------------------------------------------------------- 
    … …  
    7070      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129. 
    7171      !!---------------------------------------------------------------------- 
    72       USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
    73       USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
    74       !! 
    7572      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    7673      !! 
    77 #if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    78       INTEGER ::   ji       ! dummy loop indices 
    79 #else 
    8074      INTEGER ::   ji, jj   ! dummy loop indices 
    81 #endif 
    8275      REAL(wp) ::   zqgh_trd  ! geothermal heat flux trend 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt   ! 3D workspace    
    8377      !!---------------------------------------------------------------------- 
    8478 
    8579      IF( kt == nit000 )   CALL tra_bbc_init      ! Initialization 
    8680 
    87       IF( l_trdtra )   THEN         ! Save ta and sa trends 
    88          ztrdt(:,:,:) = ta(:,:,:)  
    89          ztrds(:,:,:) = 0.e0 
    90       ENDIF 
     81      IF( l_trdtra )   ztrdt(:,:,:) = ta(:,:,:)         ! Save ta and sa trends 
    9182 
    9283      ! Add the geothermal heat flux trend on temperature 
    … …  
    9586      ! 
    9687      CASE ( 1:2 )                !  geothermal heat flux 
    97 #if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    98          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    99             zqgh_trd = ro0cpr * qgh_trd0(ji,1) / fse3t(ji,1,nbotlevt(ji,1) ) 
    100             ta(ji,1,nbotlevt(ji,1)) = ta(ji,1,nbotlevt(ji,1)) + zqgh_trd 
    101          END DO 
     88#if defined key_vectopt_loop 
     89         DO jj = 1, 1                   ! vector opt. 
     90            DO ji = jpi+2, jpij-jpi-1   ! forced loop collapse 
    10291#else 
    103          DO jj = 2, jpjm1 
     92         DO jj = 2, jpjm1               ! standard loop 
    10493            DO ji = 2, jpim1 
     94#endif 
    10595               zqgh_trd = ro0cpr * qgh_trd0(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj)) 
    10696               ta(ji,jj,nbotlevt(ji,jj)) = ta(ji,jj,nbotlevt(ji,jj)) + zqgh_trd 
    10797            END DO 
    10898         END DO 
    109 #endif 
    11099      END SELECT 
    111100 
    112101      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics 
    113102         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    114          CALL trd_mod( ztrdt, ztrds, jptra_trd_bbc, 'TRA', kt ) 
     103         CALL trd_tra( kt, jp_tem, jpt_trd_ldf, 'TRA', ptrd3d=ztrdt) 
    115104      ENDIF 
    116105      ! 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/trabbl.F90

    r719 r786  
    114114      REAL(wp) ::   ze3u, ze3v              ! temporary scalars 
    115115      INTEGER  ::   iku, ikv 
    116       REAL(wp) ::   & 
    117          zsign, zt, zs, zh, zalbet,      &  ! temporary scalars 
    118          zgdrho, zbtr, zta, zsa 
    119       REAL(wp), DIMENSION(jpi,jpj) ::    & 
    120         zki, zkj, zkw, zkx, zky, zkz,    &  ! 2D workspace arrays 
    121         ztnb, zsnb, zdep,                & 
    122         ztbb, zsbb, zahu, zahv 
     116      REAL(wp) ::   zsign, zt, zs, zh, zalbet   ! temporary scalars 
     117      REAL(wp) ::   zgdrho, zbtr, zta, zsa 
     118      REAL(wp), DIMENSION(jpi,jpj) ::   zki, zkj, zkw, zkx, zky, zkz   ! 2D workspace arrays 
     119      REAL(wp), DIMENSION(jpi,jpj) ::   ztnb, zsnb, zdep 
     120      REAL(wp), DIMENSION(jpi,jpj) ::   ztbb, zsbb, zahu, zahv 
    123121      REAL(wp) ::    fsalbt, pft, pfs, pfh   ! statement function 
    124122      !!---------------------------------------------------------------------- 
    … …  
    258256            ! local density gradient along j-bathymetric slope 
    259257            zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
    260                    -          ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
     258               &   -          ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
    261259            ! sign of local j-gradient of density multiplied by the j-slope 
    262260            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    … …  
    412410            zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) ) 
    413411            zta = (  zkx(ji,jj) - zkx(ji-1,jj  )    & 
    414                    + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr 
     412               &   + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr 
    415413            zsa = (  zkz(ji,jj) - zkz(ji-1,jj  )    & 
    416                    + zkw(ji,jj) - zkw(ji  ,jj-1)  ) * zbtr 
     414               &   + zkw(ji,jj) - zkw(ji  ,jj-1)  ) * zbtr 
    417415            ta(ji,jj,ik) = ta(ji,jj,ik) + zta 
    418416            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 
    … …  
    425423         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    426424         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    427          CALL trd_mod(ztrdt, ztrds, jptra_trd_bbl, 'TRA', kt) 
     425         CALL trd_tra( kt, jp_tem, jpt_trd_bbl, 'TRA', ptrd3d=ztrdt) 
     426         CALL trd_tra( kt, jp_sal, jpt_trd_bbl, 'TRA', ptrd3d=ztrds) 
    428427      ENDIF 
    429428 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/tradmp.F90

    r719 r786  
    1111   !!            7.0  !  01-02  (M. Imbard)  cofdis, Original code 
    1212   !!            8.1  !  01-02  (G. Madec, E. Durand)  cleaning 
    13    !!            8.5  !  02-08  (G. Madec, E. Durand)  free form + modules 
     13   !!   NEMO     1.0  !  02-08  (G. Madec, E. Durand)  free form + modules 
     14   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
    1415   !!---------------------------------------------------------------------- 
    1516#if   defined key_tradmp   ||   defined key_esopa 
    … …  
    4748   LOGICAL, PUBLIC            ::   lk_tradmp = .TRUE.     !: internal damping flag 
    4849#endif 
    49    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   strdmp   !: damping salinity trend (psu/s) 
    5050   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   resto    !: restoring coeff. on T and S (s-1) 
    5151    
    … …  
    6262#  include "vectopt_loop_substitute.h90" 
    6363   !!---------------------------------------------------------------------- 
    64    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    65    !! $Header$  
     64   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     65   !! $Id:$  
    6666   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6767   !!---------------------------------------------------------------------- 
    … …  
    6969CONTAINS 
    7070 
    71    SUBROUTINE tra_dmp( kt ) 
     71   SUBROUTINE tra_dmp( kt, cdtype, ktra, ptb, pta ) 
    7272      !!---------------------------------------------------------------------- 
    7373      !!                   ***  ROUTINE tra_dmp  *** 
    … …  
    7979      !! ** Method  :   Newtonian damping towards t_dta and s_dta computed  
    8080      !!      and add to the general tracer trends: 
    81       !!                     ta = ta + resto * (t_dta - tb) 
    82       !!                     sa = sa + resto * (s_dta - sb) 
     81      !!                     pta = pta + resto * (t_dta - ptb) 
    8382      !!         The trend is computed either throughout the water column 
    8483      !!      (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or 
    8584      !!      below the well mixed layer (nlmdmp=2) 
    8685      !! 
    87       !! ** Action  : - update the tracer trends (ta,sa) with the newtonian  
     86      !! ** Action  : - update the tracer trends (pta) with the newtonian  
    8887      !!                damping trends. 
    89       !!              - save the trends in (ttrd,strd) ('key_trdtra') 
    90       !!---------------------------------------------------------------------- 
    91       USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
    92       USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
    93       !! 
    94       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    95       !! 
    96       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    97       REAL(wp) ::   ztest, zta, zsa       ! temporary scalars 
    98       !!---------------------------------------------------------------------- 
    99  
    100       IF( kt == nit000 )   CALL tra_dmp_init      ! Initialization 
    101  
    102       IF( l_trdtra )   THEN                       ! Save ta and sa trends 
    103          ztrdt(:,:,:) = ta(:,:,:)  
    104          ztrds(:,:,:) = sa(:,:,:)  
    105       ENDIF 
    106  
    107       ! 1. Newtonian damping trends on tracer fields 
    108       ! -------------------------------------------- 
    109       !    compute the newtonian damping trends depending on nmldmp 
    110  
    111       SELECT CASE ( nmldmp ) 
     88      !!              - save the trends in (ttrd) ('key_trdtra') 
     89      !!---------------------------------------------------------------------- 
     90      INTEGER         , INTENT(in   )                         ::   kt       ! ocean time-step index 
     91      CHARACTER(len=3), INTENT(in   )                         ::   cdtype   ! =TRA or TRC (tracer indicator) 
     92      INTEGER         , INTENT(in   )                         ::   ktra     ! tracer index 
     93      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb      ! before tracer field 
     94      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta      ! tracer trend  
     95      !! 
     96      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     97      REAL(wp) ::   zta          ! temporary scalars 
     98      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt   ! 3D workspace  
     99      !!---------------------------------------------------------------------- 
     100 
     101      IF( kt == nit000 .AND. ktra == jp_tem )   CALL tra_dmp_init      ! Initialization 
     102 
     103      IF( l_trdtra )   ztrdt(:,:,:) = pta(:,:,:)                      ! Save pta trend 
     104 
     105 
     106      SELECT CASE ( nmldmp )                                          ! compute the newtonian damping trends 
    112107      ! 
    113108      CASE( 0 )                ! newtonian damping throughout the water column 
    … …  
    115110            DO jj = 2, jpjm1 
    116111               DO ji = fs_2, fs_jpim1   ! vector opt. 
    117                   zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) ) 
    118                   zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) ) 
    119                   ! add the trends to the general tracer trends 
    120                   ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    121                   sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
    122                   ! save the salinity trend (used in flx to close the salt budget) 
    123                   strdmp(ji,jj,jk) = zsa 
     112                  pta(ji,jj,jk) = pta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - ptb(ji,jj,jk) ) 
    124113               END DO 
    125114            END DO 
    … …  
    130119            DO jj = 2, jpjm1 
    131120               DO ji = fs_2, fs_jpim1   ! vector opt. 
    132                   ztest = avt(ji,jj,jk) - 5.e-4 
    133                   IF( ztest < 0. ) THEN 
    134                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) ) 
    135                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) ) 
    136                   ELSE 
    137                      zta = 0.e0 
    138                      zsa = 0.e0 
     121                  IF( avt(ji,jj,jk) - 5.e-4 < 0. ) THEN   ;   zta = 1.e0 
     122                  ELSE                                    ;   zta = 0.e0 
    139123                  ENDIF 
    140                   ! add the trends to the general tracer trends 
    141                   ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    142                   sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
    143                   ! save the salinity trend (used in flx to close the salt budget) 
    144                   strdmp(ji,jj,jk) = zsa 
     124                  pta(ji,jj,jk) = pta(ji,jj,jk) + zta * resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - ptb(ji,jj,jk) ) 
    145125               END DO 
    146126            END DO 
    … …  
    151131            DO jj = 2, jpjm1 
    152132               DO ji = fs_2, fs_jpim1   ! vector opt. 
    153                   IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    154                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) ) 
    155                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) ) 
    156                   ELSE 
    157                      zta = 0.e0 
    158                      zsa = 0.e0 
     133                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN   ;   zta = 1.e0 
     134                  ELSE                                          ;   zta = 0.e0 
    159135                  ENDIF 
    160                   ! add the trends to the general tracer trends 
    161                   ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    162                   sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
    163                   ! save the salinity trend (used in flx to close the salt budget) 
    164                   strdmp(ji,jj,jk) = zsa 
     136                  pta(ji,jj,jk) = pta(ji,jj,jk) + zta * resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - ptb(ji,jj,jk) ) 
    165137               END DO 
    166138            END DO 
    … …  
    170142 
    171143      IF( l_trdtra )   THEN          ! save the damping tracer trends for diagnostic 
    172          ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    173          ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    174          CALL trd_mod(ztrdt, ztrds, jptra_trd_dmp, 'TRA', kt) 
     144         ztrdt(:,:,:) = pta(:,:,:) - ztrdt(:,:,:) 
     145         CALL trd_tra( kt, ktra, jpt_trd_dmp, 'TRA', ptrd3d=ztrdt) 
    175146      ENDIF 
    176147      !                              ! Control print 
    177       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
    178          &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     148      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' cen2 - dmp: ', mask1=tmask, clinfo3=cdtype ) 
    179149      ! 
    180150   END SUBROUTINE tra_dmp 
    … …  
    229199      IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem )   & 
    230200         &   CALL ctl_stop( 'no temperature and/or salinity data define key_dtatem and key_dtasal' ) 
    231  
    232       strdmp(:,:,:) = 0.e0       ! internal damping salinity trend (used in ocesbc) 
    233201 
    234202      !                          ! Damping coefficients initialization 
    … …  
    773741   LOGICAL , PUBLIC, PARAMETER ::   lk_tradmp = .FALSE.    !: internal damping flag 
    774742CONTAINS 
    775    SUBROUTINE tra_dmp( kt )        ! Empty routine 
    776       WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt 
     743   SUBROUTINE tra_dmp( kt, cdtype, ktra, ptb, pta ) 
     744!  SUBROUTINE tra_dmp( kt )        ! Empty routine 
     745!    INTEGER         , INTENT(in   )                         ::   kt       ! ocean time-step index 
     746      CHARACTER(len=3) ::   cdtype   ! =TRA or TRC (tracer indicator) 
     747!     INTEGER         , INTENT(in   )                         ::   ktra     ! tracer index 
     748      REAL, DIMENSION(:,:,:) ::   ptb, pta 
     749 
     750      WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt, ktra,cdtype, ptb(1,1,1), pta(1,1,1) 
    777751   END SUBROUTINE tra_dmp 
    778752#endif 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traldf.F90

    r719 r786  
    7070 
    7171      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    72       CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt )      ! iso-level laplacian 
    73       CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt )      ! rotated laplacian (except dk[ dk[.] ] part) 
    74       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt )      ! iso-level bilaplacian 
    75       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt )      ! s-coord. horizontal bilaplacian 
     72      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, 'TRA', jp_tem, gtu, gtv, tb, ta )      ! iso-level laplacian 
     73                       CALL tra_ldf_lap   ( kt, 'TRA', jp_sal, gsu, gsv, sb, sa )      ! iso-level laplacian 
     74      CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt, 'TRA', jp_tem, gtu, gtv, tb, ta )      ! rotated laplacian except dk2 
     75      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, 'TRA', jp_tem, gtu, gtv, tb, ta )      ! rotated laplacian except dk2 
     76                       CALL tra_ldf_bilap ( kt, 'TRA', jp_sal, gsu, gsv, sb, sa )      ! iso-level laplacian 
     77      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRA', jp_tem, gtu, gtv, tb, ta )      ! s-coord. horizontal bilaplacian 
     78                       CALL tra_ldf_bilapg( kt, 'TRA', jp_sal, gsu, gsv, sb, sa )      ! s-coord. horizontal bilaplacian 
    7679         ! 
    7780      CASE ( -1 )                                     ! esopa: test all possibility with control print 
    78          CALL tra_ldf_lap    ( kt ) 
    79          CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf0 - Ta: ', mask1=tmask,               & 
    80             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    81          CALL tra_ldf_iso    ( kt ) 
    82          CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf1 - Ta: ', mask1=tmask,               & 
    83             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    84          CALL tra_ldf_bilap  ( kt ) 
    85          CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf2 - Ta: ', mask1=tmask,               & 
    86             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    87          CALL tra_ldf_bilapg ( kt ) 
    88          CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf3 - Ta: ', mask1=tmask,               & 
    89             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     81                       CALL tra_ldf_lap   ( kt, 'TRA', jp_tem, gtu, gtv, tb, ta )      ! iso-level laplacian 
     82                       CALL tra_ldf_lap   ( kt, 'TRA', jp_sal, gsu, gsv, sb, sa )      ! iso-level laplacian 
     83                       CALL tra_ldf_iso   ( kt, 'TRA', jp_tem, gtu, gtv, tb, ta )      ! rotated laplacian except dk2 
     84                       CALL tra_ldf_iso   ( kt, 'TRA', jp_sal, gsu, gsv, sb, sa )      ! rotated laplacian except dk2 
     85                       CALL tra_ldf_bilap ( kt, 'TRA', jp_tem, gtu, gtv, tb, ta )      ! iso-level bilaplacian 
     86                       CALL tra_ldf_bilap ( kt, 'TRA', jp_sal, gsu, gsv, sb, sa )      ! iso-level laplacian 
     87                       CALL tra_ldf_bilapg( kt, 'TRA', jp_tem, gtu, gtv, tb, ta )      ! s-coord. horizontal bilaplacian 
     88                       CALL tra_ldf_bilapg( kt, 'TRA', jp_sal, gsu, gsv, sb, sa )      ! s-coord. horizontal bilaplacian 
    9089      END SELECT 
    9190 
    … …  
    9796         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    9897         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    99          CALL trd_mod( ztrdt, ztrds, jptra_trd_ldf, 'TRA', kt ) 
     98         CALL trd_tra( kt, jp_tem, jpt_trd_ldf, 'TRA', ptrd3d=ztrdt) 
     99         CALL trd_tra( kt, jp_sal, jpt_trd_ldf, 'TRA', ptrd3d=ztrds) 
    100100      ENDIF 
    101101      !                                          ! print mean trends (used for debugging) 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r719 r786  
    44   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!============================================================================== 
     6   !! History :  OPA  !  91-11  (G. Madec)  Original code 
     7   !!                 !  93-03  (M. Guyon)  symetrical conditions 
     8   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors 
     9   !!                 !  96-01  (G. Madec)  statement function for e3 
     10   !!                 !  96-01  (M. Imbard)  mpp exchange 
     11   !!                 !  97-07  (G. Madec)  optimization, and ahtt 
     12   !!            NEMO !  02-08  (G. Madec)  F90: Free form and module 
     13   !!            1.0  !  04-08  (C. Talandier) New trends organization 
     14   !!                 !  05-11  (G. Madec)  zps or sco as default option 
     15   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
     16   !!---------------------------------------------------------------------- 
    617 
    718   !!---------------------------------------------------------------------- 
    … …  
    920   !!                   using a iso-level biharmonic operator 
    1021   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    12    USE oce             ! ocean dynamics and active tracers 
    1322   USE dom_oce         ! ocean space and time domain 
    1423   USE ldftra_oce      ! ocean tracer   lateral physics 
    15    USE trdmod          ! ocean active tracers trends  
    16    USE trdmod_oce      ! ocean variables trends 
    1724   USE in_out_manager  ! I/O manager 
    18    USE ldfslp          ! iso-neutral slopes  
    1925   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2026   USE diaptr          ! poleward transport diagnostics 
    … …  
    2430   PRIVATE 
    2531 
    26    !! * Routine accessibility 
    2732   PUBLIC tra_ldf_bilap   ! routine called by step.F90 
    2833 
    … …  
    3338#  include "vectopt_loop_substitute.h90" 
    3439   !!---------------------------------------------------------------------- 
    35    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    36    !! $Header$  
    37    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     40   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     41   !! $Id:$  
     42   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3843   !!---------------------------------------------------------------------- 
    3944 
    4045CONTAINS 
    4146    
    42    SUBROUTINE tra_ldf_bilap( kt ) 
     47   SUBROUTINE tra_ldf_bilap( kt, cdtype, ktra, pgtu, pgtv,   & 
     48      &                                        ptb , pta   ) 
    4349      !!---------------------------------------------------------------------- 
    4450      !!                  ***  ROUTINE tra_ldf_bilap  *** 
    … …  
    6672      !! ** Action : - Update (ta,sa) arrays with the before iso-level 
    6773      !!               biharmonic mixing trend. 
     74      !!---------------------------------------------------------------------- 
     75      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     76      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     77      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     78      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj)     ::   pgtu, pgtv      ! tracer gradient at pstep levels 
     79      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb             ! before tracer field 
     80      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
    6881      !! 
    69       !! History : 
    70       !!        !  91-11  (G. Madec)  Original code 
    71       !!        !  93-03  (M. Guyon)  symetrical conditions 
    72       !!        !  95-11  (G. Madec)  suppress volumetric scale factors 
    73       !!        !  96-01  (G. Madec)  statement function for e3 
    74       !!        !  96-01  (M. Imbard)  mpp exchange 
    75       !!        !  97-07  (G. Madec)  optimization, and ahtt 
    76       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    77       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    78       !!        !  05-11  (G. Madec)  zps or sco as default option 
    79       !!---------------------------------------------------------------------- 
    80       !! * Modules used 
    81       USE oce           , ztu => ua,  &  ! use ua as workspace 
    82          &                ztv => va      ! use va as workspace 
    83  
    84       !! * Arguments 
    85       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    86  
    87       !! * Local declarations 
    8882      INTEGER ::   ji, jj, jk             ! dummy loop indices 
    8983      INTEGER ::   iku, ikv               ! temporary integers 
    90       REAL(wp) ::   zta, zsa              ! temporary scalars 
    91       REAL(wp), DIMENSION(jpi,jpj) ::   &  
    92          zeeu, zeev, zbtr,              & ! 2D workspace 
    93          zlt, zls 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &  
    95          zsu, zsv                         ! 3D workspace  
     84      REAL(wp), DIMENSION(jpi,jpj)     ::   zeeu, zeev, zbtr, zlt   ! 2D workspace 
     85      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv          ! 3D workspace  
    9686      !!---------------------------------------------------------------------- 
    9787 
    … …  
    110100         ! ---------------------------------- 
    111101 
    112          IF( lk_zco ) THEN      ! z-coordinate (1D arrays): no vertical scale factors 
    113             DO jj = 1, jpjm1 
    114                DO ji = 1, fs_jpim1   ! vector opt. 
    115                   zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj) ) 
    116                   zeeu(ji,jj) = e2u(ji,jj) / e1u(ji,jj) * umask(ji,jj,jk) 
    117                   zeev(ji,jj) = e1v(ji,jj) / e2v(ji,jj) * vmask(ji,jj,jk) 
    118                END DO 
     102         DO jj = 1, jpjm1 
     103            DO ji = 1, fs_jpim1   ! vector opt. 
     104               zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
     105               zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) 
     106               zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk) 
    119107            END DO 
    120          ELSE                   ! All coordinates (3D arrays): vertical scale factor are used 
    121             DO jj = 1, jpjm1 
    122                DO ji = 1, fs_jpim1   ! vector opt. 
    123                   zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
    124                   zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) 
    125                   zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk) 
    126                END DO 
    127             END DO 
    128          ENDIF 
     108         END DO 
    129109 
    130110 
    … …  
    135115         DO jj = 1, jpjm1 
    136116            DO ji = 1, fs_jpim1   ! vector opt. 
    137                ztu(ji,jj,jk) = zeeu(ji,jj) * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) ) 
    138                zsu(ji,jj,jk) = zeeu(ji,jj) * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) ) 
    139                ztv(ji,jj,jk) = zeev(ji,jj) * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) ) 
    140                zsv(ji,jj,jk) = zeev(ji,jj) * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) ) 
     117               ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj  ,jk) - ptb(ji,jj,jk) ) 
     118               ztv(ji,jj,jk) = zeev(ji,jj) * ( ptb(ji  ,jj+1,jk) - ptb(ji,jj,jk) ) 
    141119            END DO 
    142120         END DO 
    … …  
    147125                  iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1 
    148126                  ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1 
    149                   IF( iku == jk ) THEN 
    150                      ztu(ji,jj,jk) = zeeu(ji,jj) * gtu(ji,jj) 
    151                      zsu(ji,jj,jk) = zeeu(ji,jj) * gsu(ji,jj) 
    152                   ENDIF 
    153                   IF( ikv == jk ) THEN 
    154                      ztv(ji,jj,jk) = zeev(ji,jj) * gtv(ji,jj) 
    155                      zsv(ji,jj,jk) = zeev(ji,jj) * gsv(ji,jj) 
    156                   ENDIF 
     127                  IF( iku == jk )   ztu(ji,jj,jk) = zeeu(ji,jj) * pgtu(ji,jj) 
     128                  IF( ikv == jk )   ztv(ji,jj,jk) = zeev(ji,jj) * pgtv(ji,jj) 
    157129               END DO 
    158130            END DO 
    159131         ENDIF 
    160132 
    161          ! Second derivative (divergence) 
     133         ! Second derivative (divergence) multiply by the eddy diffusivity coefficient 
    162134         DO jj = 2, jpjm1 
    163135            DO ji = fs_2, fs_jpim1   ! vector opt. 
    164                zlt(ji,jj) = zbtr(ji,jj) * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    165                zls(ji,jj) = zbtr(ji,jj) * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) 
     136               zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr(ji,jj)   & 
     137                  &                          * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    166138            END DO 
    167139         END DO 
    168140 
    169          ! Multiply by the eddy diffusivity coefficient 
    170          DO jj = 2, jpjm1 
    171             DO ji = fs_2, fs_jpim1   ! vector opt. 
    172                zlt(ji,jj) = fsahtt(ji,jj,jk) * zlt(ji,jj) 
    173                zls(ji,jj) = fsahtt(ji,jj,jk) * zls(ji,jj) 
    174             END DO 
    175          END DO 
     141!!gm   k-loop must be cut here and a 3D lbclnk used 
    176142 
    177          ! Lateral boundary conditions on the laplacian (zlt,zls)   (unchanged sgn) 
    178          CALL lbc_lnk( zlt, 'T', 1. )   ;    CALL lbc_lnk( zls, 'T', 1. ) 
     143         ! Lateral boundary conditions on the laplacian (zlt)   (unchanged sgn) 
     144         CALL lbc_lnk( zlt, 'T', 1. )  
    179145 
    180146         ! 2. Bilaplacian 
    181147         ! -------------- 
    182148 
    183          ! third derivative (gradient) 
    184          DO jj = 1, jpjm1 
     149         DO jj = 1, jpjm1                              ! third derivative (gradient) 
    185150            DO ji = 1, fs_jpim1   ! vector opt. 
    186151               ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) ) 
    187                zsu(ji,jj,jk) = zeeu(ji,jj) * ( zls(ji+1,jj  ) - zls(ji,jj) ) 
    188152               ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) ) 
    189                zsv(ji,jj,jk) = zeev(ji,jj) * ( zls(ji  ,jj+1) - zls(ji,jj) ) 
    190153            END DO 
    191154         END DO 
    192155 
    193          ! fourth derivative (divergence) and add to the general tracer trend 
    194          DO jj = 2, jpjm1 
     156         DO jj = 2, jpjm1                              ! 4th derivative (divergence) and add to the general tracer trend 
    195157            DO ji = fs_2, fs_jpim1   ! vector opt. 
    196                ! horizontal diffusive trends 
    197                zta = zbtr(ji,jj) * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    198                zsa = zbtr(ji,jj) * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) 
    199                ! add it to the general tracer trends 
    200                ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    201                sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
     158               pta(ji,jj,jk) = pta(ji,jj,jk) + zbtr(ji,jj)   & 
     159                  &                          * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    202160            END DO 
    203161         END DO 
    … …  
    206164      !                                                ! =============== 
    207165 
    208       ! "zonal" mean lateral diffusive heat and salt transport 
    209       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    210          IF( lk_zco ) THEN      ! z-coordinate (1D arrays): multiply by the vertical scale factor 
    211             DO jk = 1, jpkm1 
    212                DO jj = 2, jpjm1 
    213                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    214                      ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk) 
    215                      zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk) 
    216                   END DO 
    217                END DO 
    218             END DO 
    219          ENDIF 
    220          pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    221          pst_ldf(:) = ptr_vj( zsv(:,:,:) ) 
     166 
     167      !                              ! "Poleward" lateral diffusive heat or salt transport  
     168      IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     169         IF( ktra == jp_tem)   pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     170         IF( ktra == jp_sal)   pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    222171      ENDIF 
    223172 
     173      !                              ! control print 
     174      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' ldf - bilap : ', mask1=tmask, clinfo3=cdtype ) 
     175      ! 
    224176   END SUBROUTINE tra_ldf_bilap 
    225177 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r719 r786  
    44   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!============================================================================== 
     6   !! History :  8.0  !  97-07  (G. Madec)  Original code 
     7   !!            NEMO !  02-08  (G. Madec)  F90: Free form and module 
     8   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_ldfslp   ||   defined key_esopa 
    711   !!---------------------------------------------------------------------- 
    … …  
    1216   !!   ldfght         :  ??? 
    1317   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    15    USE oce             ! ocean dynamics and tracers variables 
    1618   USE dom_oce         ! ocean space and time domain variables 
    1719   USE ldftra_oce      ! ocean active tracers: lateral physics 
    … …  
    4244CONTAINS 
    4345 
    44    SUBROUTINE tra_ldf_bilapg( kt ) 
     46   SUBROUTINE tra_ldf_bilapg( kt, cdtype, ktra, pgtu, pgtv,   & 
     47      &                                         ptb , pta   ) 
    4548      !!---------------------------------------------------------------------- 
    4649      !!                 ***  ROUTINE tra_ldf_bilapg  *** 
    … …  
    5558      !!         -1- compute the geopotential harmonic operator applied to 
    5659      !!      (tb,sb) and multiply it by the eddy diffusivity coefficient 
    57       !!      (done by a call to ldfght routine, result in (wk1,wk2) arrays). 
     60      !!      (done by a call to ldfght routine, result in wk1 array). 
    5861      !!      Applied the domain lateral boundary conditions by call to lbc_lnk 
    5962      !!         -2- compute the geopotential harmonic operator applied to 
    60       !!      (wk1,wk2) by a second call to ldfght routine (result in (wk3,wk4) 
     63      !!      wk1 by a second call to ldfght routine (result in wk2) 
    6164      !!      arrays). 
    62       !!         -3- Add this trend to the general trend (ta,sa): 
    63       !!            (ta,sa) = (ta,sa) + (wk3,wk4) 
    64       !! 
    65       !! ** Action : - Update (ta,sa) arrays with the before geopotential  
     65      !!         -3- Add this trend to the general trend pta: 
     66      !!            pta = pta + wk2 
     67      !! 
     68      !! ** Action : - Update pta arrays with the before geopotential  
    6669      !!               biharmonic mixing trend. 
    6770      !! 
    … …  
    7174      !!   9.0  !  04-08  (C. Talandier) New trends organization 
    7275      !!---------------------------------------------------------------------- 
    73       !! * Modules used 
    74       USE oce           , wk1 => ua,  &  ! use ua as workspace 
    75          &                wk2 => va      ! use va as workspace 
    76  
    77       !! * Arguments 
    78       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    79  
    80       !! * Local declarations 
     76      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     77      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     78      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     79      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj)     ::   pgtu, pgtv      ! tracer gradient at pstep levels 
     80      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb             ! before tracer field 
     81      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
     82      !! 
    8183      INTEGER ::   ji, jj, jk                 ! dummy loop indices 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    83          wk3, wk4                ! work array used for rotated biharmonic 
    84          !                       ! operator on tracers and/or momentum 
     84      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   wk1, wk2                ! workspace arrays 
    8585      !!---------------------------------------------------------------------- 
    8686 
    … …  
    9191      ENDIF 
    9292 
    93       ! 1. Laplacian of (tb,sb) * aht 
    94       ! -----------------------------  
    95       ! rotated harmonic operator applied to (tb,sb) 
    96       ! and multiply by aht (output in (wk1,wk2) ) 
    97  
    98       CALL ldfght ( kt, tb, sb, wk1, wk2, 1 ) 
    99  
    100  
    101       ! Lateral boundary conditions on (wk1,wk2)   (unchanged sign) 
    102       CALL lbc_lnk( wk1, 'T', 1. )   ;   CALL lbc_lnk( wk2, 'T', 1. ) 
    103  
    104       ! 2. Bilaplacian of (tb,sb) 
    105       ! ------------------------- 
    106       ! rotated harmonic operator applied to (wk1,wk2) 
    107       ! (output in (wk3,wk4) ) 
    108  
    109       CALL ldfght ( kt, wk1, wk2, wk3, wk4, 2 ) 
    110  
    111  
    112       ! 3. Update the tracer trends                    (j-slab :   2, jpj-1) 
    113       ! --------------------------- 
    114       !                                                ! =============== 
    115       DO jj = 2, jpjm1                                 !  Vertical slab 
    116          !                                             ! =============== 
    117          DO jk = 1, jpkm1 
     93      ! Laplacian of ptb * aht 
     94 
     95      CALL ldfght ( kt, cdtype, ktra, ptb, wk1, 1 )      ! rotated laplacian applied to ptb and * aht (output in wk1 ) 
     96 
     97      CALL lbc_lnk( wk1, 'T', 1. )                       ! Lateral boundary conditions on wk1   (unchanged sign) 
     98 
     99      ! Bilaplacian of ptb 
     100 
     101      CALL ldfght ( kt, cdtype, ktra, wk1, wk2,  2 )     ! rotated laplacian applied to wk1 (output in wk2 ) 
     102 
     103 
     104      ! Update the tracer trends 
     105      DO jk = 1, jpkm1 
     106         DO jj = 2, jpjm1  
    118107            DO ji = 2, jpim1 
    119                ! add it to the general tracer trends 
    120                ta(ji,jj,jk) = ta(ji,jj,jk) + wk3(ji,jj,jk) 
    121                sa(ji,jj,jk) = sa(ji,jj,jk) + wk4(ji,jj,jk) 
    122             END DO 
    123          END DO 
    124          !                                             ! =============== 
    125       END DO                                           !   End of slab 
    126       !                                                ! =============== 
    127  
     108               pta(ji,jj,jk) = pta(ji,jj,jk) + wk2(ji,jj,jk) 
     109            END DO 
     110         END DO 
     111      END DO 
     112      ! 
    128113   END SUBROUTINE tra_ldf_bilapg 
    129114 
    130115 
    131    SUBROUTINE ldfght ( kt, pt, ps, plt, pls, kaht ) 
     116   SUBROUTINE ldfght ( kt, cdtype, ktra, pt, plt, kaht ) 
    132117      !!---------------------------------------------------------------------- 
    133118      !!                  ***  ROUTINE ldfght  *** 
    134119      !!           
    135       !! ** Purpose :   Apply a geopotential harmonic operator to (pt,ps) and  
     120      !! ** Purpose :   Apply a geopotential harmonic operator to p and  
    136121      !!      multiply it by the eddy diffusivity coefficient (if kaht=1). 
    137122      !!      Routine only used in s-coordinates (l_sco=T) with bilaplacian 
    … …  
    140125      !! 
    141126      !! ** Method  :   The harmonic operator rotated along geopotential  
    142       !!      surfaces is applied to (pt,ps) using the slopes of geopotential 
     127      !!      surfaces is applied to pt using the slopes of geopotential 
    143128      !!      surfaces computed in inildf routine. The result is provided in 
    144       !!      (plt,pls) arrays. It is computed in 2 steps: 
     129      !!      plt arrays. It is computed in 2 steps: 
    145130      !! 
    146131      !!      First step: horizontal part of the operator. It is computed on 
    147       !!      ==========  pt as follows (idem on ps) 
     132      !!      ==========  pt as follows 
    148133      !!      horizontal fluxes : 
    149134      !!         zftu = e2u*e3u/e1u di[ pt ] - e2u*uslp dk[ mi(mk(pt)) ] 
    … …  
    154139      !! 
    155140      !!      Second step: vertical part of the operator. It is computed on 
    156       !!      ===========  pt as follows (idem on ps) 
     141      !!      ===========  pt as follows  
    157142      !!      vertical fluxes : 
    158143      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pt ] 
    … …  
    168153      !! * Action : 
    169154      !!      'key_trdtra' defined: the trend is saved for diagnostics. 
    170       !! 
    171       !! History : 
    172       !!   8.0  !  97-07  (G. Madec)  Original code 
    173       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    174       !!---------------------------------------------------------------------- 
    175       !! * Arguments 
    176       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    177       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  ) ::   & 
    178          pt, ps           ! tracer fields (before t and s for 1st call 
    179       !                   ! and laplacian of these fields for 2nd call. 
    180       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    181          plt, pls         ! partial harmonic operator applied to 
    182       !                   ! pt & ps components except 
    183       !                   ! second order vertical derivative term) 
    184       INTEGER, INTENT( in ) ::   & 
    185          kaht             ! =1 multiply the laplacian by the eddy diffusivity coeff. 
    186       !                   ! =2 no multiplication 
    187  
    188       !! * Local declarations 
    189       INTEGER ::   ji, jj, jk             ! dummy loop indices 
    190       REAL(wp) ::   & 
    191          zabe1, zabe2, zmku, zmkv,     &  ! temporary scalars 
    192          zbtr, ztah, zsah, ztav, zsav, & 
    193          zcof0, zcof1, zcof2,          & 
    194          zcof3, zcof4 
    195       REAL(wp), DIMENSION(jpi,jpj) ::  & 
    196          zftu, zfsu,                   &  ! workspace 
    197          zdkt, zdk1t,                  & 
    198          zdks, zdk1s 
    199       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    200          zftv, zfsv                       ! workspace (only v components for ptr) 
    201       REAL(wp), DIMENSION(jpi,jpk) ::  & 
    202          zftw, zfsw,                   &  ! workspace 
    203          zdit, zdjt, zdj1t,            & 
    204          zdis, zdjs, zdj1s 
     155      !!---------------------------------------------------------------------- 
     156      INTEGER         , INTENT(in )                         ::   kt       ! ocean time-step index 
     157      CHARACTER(len=3), INTENT(in )                         ::   cdtype   ! =TRA or TRC (tracer indicator) 
     158      INTEGER         , INTENT(in )                         ::   ktra     ! tracer index 
     159      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pt       ! before tracer field           (1st call) 
     160      !                                                                   ! laplacian of the tracer field (2nd call) 
     161      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   plt      ! harmonic operator applied to pt 
     162      INTEGER         , INTENT(in )                         ::   kaht     ! =1 multiply plt by aht 
     163      !                                                                   ! =2 no multiplication 
     164      !! 
     165      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     166      REAL(wp) ::   zabe1, zabe2, zmku, zmkv   ! temporary scalars 
     167      REAL(wp) ::   zbtr, ztah, ztav 
     168      REAL(wp) ::   zcof0, zcof1, zcof2 
     169      REAL(wp) ::   zcof3, zcof4 
     170      REAL(wp), DIMENSION(jpi,jpj)     ::   zftu, zdkt, zdk1t         ! 2D workspace 
     171      REAL(wp), DIMENSION(jpi,jpk)     ::   zftw, zdit, zdjt, zdj1t   ! 2D workspace 
     172      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zftv                      ! workspace (only v components for ptr) 
    205173      !!---------------------------------------------------------------------- 
    206174 
    … …  
    209177         !                            ! ********** !   ! =============== 
    210178 
    211          ! I.1 Vertical gradient of pt and ps at level jk and jk+1 
    212          ! ------------------------------------------------------- 
     179         ! I.1 Vertical gradient of pt at level jk and jk+1 
     180         ! ------------------------------------------------ 
    213181         !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 
    214182 
    215183         zdk1t(:,:) = ( pt(:,:,jk) - pt(:,:,jk+1) ) * tmask(:,:,jk+1) 
    216          zdk1s(:,:) = ( ps(:,:,jk) - ps(:,:,jk+1) ) * tmask(:,:,jk+1) 
    217184 
    218185         IF( jk == 1 ) THEN 
    219186            zdkt(:,:) = zdk1t(:,:) 
    220             zdks(:,:) = zdk1s(:,:) 
    221187         ELSE 
    222188            zdkt(:,:) = ( pt(:,:,jk-1) - pt(:,:,jk) ) * tmask(:,:,jk) 
    223             zdks(:,:) = ( ps(:,:,jk-1) - ps(:,:,jk) ) * tmask(:,:,jk) 
    224189         ENDIF 
    225190 
    … …  
    250215                   + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)     & 
    251216                             +zdk1t(ji,jj+1) + zdkt (ji,jj) )  ) 
    252  
    253                zfsu(ji,jj)= umask(ji,jj,jk) *   & 
    254                   (  zabe1 *( ps(ji+1,jj,jk) - ps(ji,jj,jk) )   & 
    255                    + zcof1 *( zdks (ji+1,jj) + zdk1s(ji,jj)     & 
    256                              +zdk1s(ji+1,jj) + zdks (ji,jj) )  ) 
    257  
    258                zfsv(ji,jj,jk)= vmask(ji,jj,jk) *   & 
    259                   (  zabe2 *( ps(ji,jj+1,jk) - ps(ji,jj,jk) )   & 
    260                    + zcof2 *( zdks (ji,jj+1) + zdk1s(ji,jj)     & 
    261                              +zdk1s(ji,jj+1) + zdks (ji,jj) )  ) 
    262217            END DO 
    263218         END DO 
    … …  
    270225            DO ji = 2 , jpim1 
    271226               ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) 
    272                zsah = zfsu(ji,jj) - zfsu(ji-1,jj) + zfsv(ji,jj,jk) - zfsv(ji,jj-1,jk) 
    273227               plt(ji,jj,jk) = ztah 
    274                pls(ji,jj,jk) = zsah 
    275228            END DO 
    276229         END DO 
    … …  
    279232      !                                                ! =============== 
    280233  
    281       !!but this should be done somewhere after  
    282       ! "zonal" mean diffusive heat and salt transport 
    283       IF( ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    284          pht_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    285          pst_ldf(:) = ptr_vj( zfsv(:,:,:) ) 
     234      ! "Poleward" diffusive heat or salt transport 
     235      IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     236         IF( ktra == jp_tem)   pht_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     237         IF( ktra == jp_sal)   pst_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    286238      ENDIF 
    287239 
    … …  
    296248            DO ji = 1, jpim1 
    297249               zdit (ji,jk) = ( pt(ji+1,jj  ,jk) - pt(ji,jj  ,jk) ) * umask(ji,jj  ,jk) 
    298                zdis (ji,jk) = ( ps(ji+1,jj  ,jk) - ps(ji,jj  ,jk) ) * umask(ji,jj  ,jk) 
    299250               zdjt (ji,jk) = ( pt(ji  ,jj+1,jk) - pt(ji,jj  ,jk) ) * vmask(ji,jj  ,jk) 
    300                zdjs (ji,jk) = ( ps(ji  ,jj+1,jk) - ps(ji,jj  ,jk) ) * vmask(ji,jj  ,jk) 
    301251               zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk) - pt(ji,jj-1,jk) ) * vmask(ji,jj-1,jk) 
    302                zdj1s(ji,jk) = ( ps(ji  ,jj  ,jk) - ps(ji,jj-1,jk) ) * vmask(ji,jj-1,jk) 
    303252            END DO 
    304253         END DO 
    … …  
    310259         ! Surface and bottom vertical fluxes set to zero 
    311260         zftw(:, 1 ) = 0.e0 
    312          zfsw(:, 1 ) = 0.e0 
    313261         zftw(:,jpk) = 0.e0 
    314          zfsw(:,jpk) = 0.e0 
    315262 
    316263         ! interior (2=<jk=<jpk-1) 
    … …  
    336283                   + zcof4 * ( zdjt (ji  ,jk-1) + zdj1t(ji  ,jk)     & 
    337284                              +zdj1t(ji  ,jk-1) + zdjt (ji  ,jk) )  ) 
    338  
    339                zfsw(ji,jk) = tmask(ji,jj,jk) *   & 
    340                   (  zcof0 * ( ps  (ji,jj,jk-1) - ps  (ji,jj,jk) )   & 
    341                    + zcof3 * ( zdis (ji  ,jk-1) + zdis (ji-1,jk)     & 
    342                               +zdis (ji-1,jk-1) + zdis (ji  ,jk) )   & 
    343                    + zcof4 * ( zdjs (ji  ,jk-1) + zdj1s(ji  ,jk)     & 
    344                               +zdj1s(ji  ,jk-1) + zdjs (ji  ,jk) )  ) 
    345285            END DO 
    346286         END DO 
    … …  
    358298                  ! vertical divergence 
    359299                  ztav = zftw(ji,jk) - zftw(ji,jk+1) 
    360                   zsav = zfsw(ji,jk) - zfsw(ji,jk+1) 
    361300                  ! harmonic operator applied to (pt,ps) and multiply by aht 
    362301                  plt(ji,jj,jk) = ( plt(ji,jj,jk) + ztav ) * zbtr 
    363                   pls(ji,jj,jk) = ( pls(ji,jj,jk) + zsav ) * zbtr 
    364302               END DO 
    365303            END DO 
    … …  
    372310                  ! vertical divergence 
    373311                  ztav = zftw(ji,jk) - zftw(ji,jk+1) 
    374                   zsav = zfsw(ji,jk) - zfsw(ji,jk+1) 
    375312                  ! harmonic operator applied to (pt,ps)  
    376313                  plt(ji,jj,jk) = ( plt(ji,jj,jk) + ztav ) * zbtr 
    377                   pls(ji,jj,jk) = ( pls(ji,jj,jk) + zsav ) * zbtr 
    378314               END DO 
    379315            END DO 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r719 r786  
    44   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!====================================================================== 
    6    !! History :        !  94-08  (G. Madec, M. Imbard) 
    7    !!                  !  97-05  (G. Madec)  split into traldf and trazdf 
    8    !!             8.5  !  02-08  (G. Madec)  Free form, F90 
    9    !!             9.0  !  05-11  (G. Madec)  merge traldf and trazdf :-) 
     6   !! History :  OPA  !  1994-08  (G. Madec, M. Imbard) 
     7   !!                 !  1997-05  (G. Madec)  split into traldf and trazdf 
     8   !!            NEMO !  2002-08  (G. Madec)  Free form, F90 
     9   !!            1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-) 
     10   !!            2.4  !  2008-01  (G. Madec) Merge TRA-TRC 
    1011   !!---------------------------------------------------------------------- 
    1112#if   defined key_ldfslp   ||   defined key_esopa 
    … …  
    2021   !!                  vector optimization, use k-j-i loops. 
    2122   !!---------------------------------------------------------------------- 
    22    USE oce             ! ocean dynamics and active tracers 
    2323   USE dom_oce         ! ocean space and time domain 
    2424   USE ldftra_oce      ! ocean active tracers: lateral physics 
    25    USE trdmod          ! ocean active tracers trends  
    26    USE trdmod_oce      ! ocean variables trends 
    2725   USE zdf_oce         ! ocean vertical physics 
    2826   USE in_out_manager  ! I/O manager 
    … …  
    4139#  include "vectopt_loop_substitute.h90" 
    4240   !!---------------------------------------------------------------------- 
    43    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    44    !! $Header$  
     41   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     42   !! $Id:$  
    4543   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4644   !!---------------------------------------------------------------------- 
    … …  
    4846CONTAINS 
    4947 
    50    SUBROUTINE tra_ldf_iso( kt ) 
     48   SUBROUTINE tra_ldf_iso( kt, cdtype, ktra, pgtu, pgtv,   & 
     49      &                                      ptb , pta   ) 
    5150      !!---------------------------------------------------------------------- 
    5251      !!                  ***  ROUTINE tra_ldf_iso  *** 
    … …  
    8988      !!            trend (except the dk[ dk[.] ] term) 
    9089      !!---------------------------------------------------------------------- 
    91       USE oce           , zftv => ua   ! use ua as workspace 
    92       USE oce           , zfsv => va   ! use va as workspace 
    93       !! 
    94       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
     90      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     91      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     92      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     93      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj)     ::   pgtu, pgtv      ! tracer gradient at pstep levels 
     94      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb             ! before tracer field 
     95      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
    9596      !! 
    9697      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    9798      INTEGER  ::   iku, ikv     ! temporary integer 
    98       REAL(wp) ::   zmsku, zabe1, zcof1, zcoef3, zta   ! temporary scalars 
    99       REAL(wp) ::   zmskv, zabe2, zcof2, zcoef4, zsa   !    "         " 
     99      REAL(wp) ::   zmsku, zabe1, zcof1, zcoef3   ! temporary scalars 
     100      REAL(wp) ::   zmskv, zabe2, zcof2, zcoef4   !    "         " 
    100101      REAL(wp) ::   zcoef0, zbtr                       !    "         " 
    101102      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt , zdk1t, zftu   ! 2D workspace 
    102       REAL(wp), DIMENSION(jpi,jpj)     ::   zdks , zdk1s, zfsu   !    "           " 
    103       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw     ! 3D workspace 
    104       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdis, zdjs, zsfw     !  "      " 
     103      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw, zftv     ! 3D workspace 
    105104      !!---------------------------------------------------------------------- 
    106105 
    … …  
    116115!!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient.... 
    117116      zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0 
    118       zdis (1,:,:) = 0.e0     ;     zdis (jpi,:,:) = 0.e0 
    119117      zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0 
    120       zdjs (1,:,:) = 0.e0     ;     zdjs (jpi,:,:) = 0.e0 
    121118!!end 
    122119 
    … …  
    125122         DO jj = 1, jpjm1 
    126123            DO ji = 1, fs_jpim1   ! vector opt. 
    127                zdit(ji,jj,jk) = ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) ) * umask(ji,jj,jk) 
    128                zdis(ji,jj,jk) = ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) ) * umask(ji,jj,jk) 
    129                zdjt(ji,jj,jk) = ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) ) * vmask(ji,jj,jk) 
    130                zdjs(ji,jj,jk) = ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) ) * vmask(ji,jj,jk) 
     124               zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk) - ptb(ji,jj,jk) ) * umask(ji,jj,jk) 
     125               zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk) - ptb(ji,jj,jk) ) * vmask(ji,jj,jk) 
    131126            END DO 
    132127         END DO 
    … …  
    138133               iku = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1 
    139134               ikv = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1 
    140                zdit(ji,jj,iku) = gtu(ji,jj)  
    141                zdis(ji,jj,iku) = gsu(ji,jj)                
    142                zdjt(ji,jj,ikv) = gtv(ji,jj)  
    143                zdjs(ji,jj,ikv) = gsv(ji,jj)                
     135               zdit(ji,jj,iku) = pgtu(ji,jj)  
     136               zdjt(ji,jj,ikv) = pgtv(ji,jj)  
    144137            END DO 
    145138         END DO 
    … …  
    150143      !!---------------------------------------------------------------------- 
    151144       
    152 !CDIR PARALLEL DO PRIVATE( zdk1t, zdk1s, zftu, zfsu )  
    153 !$OMP PARALLEL DO PRIVATE( zdk1t, zdk1s, zftu, zfsu ) 
     145!CDIR PARALLEL DO PRIVATE( zdk1t, zftu )  
     146!$OMP PARALLEL DO PRIVATE( zdk1t, zftu ) 
    154147      !                                                ! =============== 
    155148      DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    159152         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 
    160153 
    161          zdk1t(:,:) = ( tb(:,:,jk) - tb(:,:,jk+1) ) * tmask(:,:,jk+1) 
    162          zdk1s(:,:) = ( sb(:,:,jk) - sb(:,:,jk+1) ) * tmask(:,:,jk+1) 
     154         zdk1t(:,:) = ( ptb(:,:,jk) - ptb(:,:,jk+1) ) * tmask(:,:,jk+1) 
    163155 
    164156         IF( jk == 1 ) THEN 
    165157            zdkt(:,:) = zdk1t(:,:) 
    166             zdks(:,:) = zdk1s(:,:) 
    167158         ELSE 
    168             zdkt(:,:) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk) 
    169             zdks(:,:) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk) 
     159            zdkt(:,:) = ( ptb(:,:,jk-1) - ptb(:,:,jk) ) * tmask(:,:,jk) 
    170160         ENDIF 
    171161 
    … …  
    194184                  &              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      & 
    195185                  &                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk) 
    196                zfsu(ji,jj   ) = (  zabe1 * zdis(ji,jj,jk)   & 
    197                   &              + zcof1 * (  zdks (ji+1,jj) + zdk1s(ji,jj)      & 
    198                   &                         + zdk1s(ji+1,jj) + zdks (ji,jj)  )  ) * umask(ji,jj,jk) 
    199                zfsv(ji,jj,jk) = (  zabe2 * zdjs(ji,jj,jk)   & 
    200                   &              + zcof2 * (  zdks (ji,jj+1) + zdk1s(ji,jj)      & 
    201                   &                         + zdk1s(ji,jj+1) + zdks (ji,jj)  )  ) * vmask(ji,jj,jk) 
    202186            END DO 
    203187         END DO 
    … …  
    208192         DO jj = 2 , jpjm1 
    209193            DO ji = fs_2, fs_jpim1   ! vector opt. 
    210                zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
    211                zta = zbtr * ( zftu(ji,jj   ) - zftu(ji-1,jj   ) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  ) 
    212                zsa = zbtr * ( zfsu(ji,jj   ) - zfsu(ji-1,jj   ) + zfsv(ji,jj,jk) - zfsv(ji,jj-1,jk)  ) 
    213                ta (ji,jj,jk) = ta (ji,jj,jk) + zta 
    214                sa (ji,jj,jk) = sa (ji,jj,jk) + zsa 
     194               zbtr= 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     195               pta(ji,jj,jk) = pta(ji,jj,jk)   & 
     196                  &          + zbtr * ( zftu(ji,jj   ) - zftu(ji-1,jj   ) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  ) 
    215197            END DO 
    216198         END DO 
    … …  
    219201      !                                             ! =============== 
    220202 
    221       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   ! Poleward diffusive heat and salt transports 
    222          pht_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    223          pst_ldf(:) = ptr_vj( zfsv(:,:,:) ) 
     203      ! "Poleward" diffusive heat or salt transports 
     204      IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     205         IF( ktra == jp_tem)   pht_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     206         IF( ktra == jp_sal)   pst_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    224207      ENDIF 
    225208 
    … …  
    231214      ! ----------------------------- 
    232215      ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0 
    233       zsfw(1,:,:) = 0.e0     ;     zsfw(jpi,:,:) = 0.e0 
    234216 
    235217 
    … …  
    239221      ! Surface and bottom vertical fluxes set to zero 
    240222      ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0 
    241       zsfw(:,:, 1 ) = 0.e0      ;      zsfw(:,:,jpk) = 0.e0 
    242223 
    243224      ! interior (2=<jk=<jpk-1) 
    … …  
    260241                  &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      & 
    261242                  &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  ) 
    262  
    263                zsfw(ji,jj,jk) = zcoef3 * (   zdis(ji  ,jj  ,jk-1) + zdis(ji-1,jj  ,jk)      & 
    264                   &                        + zdis(ji-1,jj  ,jk-1) + zdis(ji  ,jj  ,jk)  )   & 
    265                   &           + zcoef4 * (   zdjs(ji  ,jj  ,jk-1) + zdjs(ji  ,jj-1,jk)      & 
    266                   &                        + zdjs(ji  ,jj-1,jk-1) + zdjs(ji  ,jj  ,jk)  ) 
    267243            END DO 
    268244         END DO 
    … …  
    276252         DO jj = 2, jpjm1 
    277253            DO ji = fs_2, fs_jpim1   ! vector opt. 
    278                zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
    279                zta  = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr 
    280                zsa  = (  zsfw(ji,jj,jk) - zsfw(ji,jj,jk+1)  ) * zbtr 
    281                ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    282                sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
     254               zbtr =  1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     255               pta(ji,jj,jk) = pta(ji,jj,jk) + (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr 
    283256            END DO 
    284257         END DO 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r719 r786  
    44   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!============================================================================== 
     6   !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code 
     7   !!                 !  91-11  (G. Madec) 
     8   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors 
     9   !!                 !  96-01  (G. Madec)  statement function for e3 
     10   !!            NEMO !  02-06  (G. Madec)  F90: Free form and module 
     11   !!            1.0  !  04-08  (C. Talandier) New trends organization 
     12   !!                 !  05-11  (G. Madec)  add zps case 
     13   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
     14   !!---------------------------------------------------------------------- 
    615 
    716   !!---------------------------------------------------------------------- 
    … …  
    918   !!                 using a iso-level harmonic (laplacien) operator. 
    1019   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    12    USE oce             ! ocean dynamics and active tracers 
    1320   USE dom_oce         ! ocean space and time domain 
    1421   USE ldftra_oce      ! ocean active tracers: lateral physics 
    15    USE trdmod          ! ocean active tracers trends  
    16    USE trdmod_oce      ! ocean variables trends 
    1722   USE in_out_manager  ! I/O manager 
    1823   USE diaptr          ! poleward transport diagnostics 
    … …  
    2328   PRIVATE 
    2429 
    25    !! * Routine accessibility 
    2630   PUBLIC tra_ldf_lap  ! routine called by step.F90 
     31 
     32      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   e1ur, e2vr, btr2   ! scale factor coefficients 
    2733 
    2834   !! * Substitutions 
    … …  
    3137#  include "vectopt_loop_substitute.h90" 
    3238   !!---------------------------------------------------------------------- 
    33    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    34    !! $Header$  
    35    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     39   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     40   !! $Id:$  
     41   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3642   !!---------------------------------------------------------------------- 
    3743    
    3844CONTAINS 
    3945 
    40    SUBROUTINE tra_ldf_lap( kt ) 
     46   SUBROUTINE tra_ldf_lap( kt, cdtype, ktra, pgtu, pgtv,   & 
     47      &                                      ptb , pta   ) 
    4148      !!---------------------------------------------------------------------- 
    4249      !!                  ***  ROUTINE tra_ldf_lap  *** 
    4350      !!                    
    44       !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive  
     51      !! ** Purpose :   Compute the before horizontal tracer diffusive  
    4552      !!      trend and add it to the general trend of tracer equation. 
    4653      !! 
    … …  
    4855      !!      fields (forward time scheme). The horizontal diffusive trends of  
    4956      !!      temperature (idem for salinity) is given by: 
    50       !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ] 
    51       !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] } 
     57      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(ptb) ] 
     58      !!                                   + dj-1[ aht e1v*e3v/e2v dj(ptb) ] } 
    5259      !!     Note: key_zco defined, the e3t=e3u=e3v, the trend becomes:   
    53       !!          difft = 1/(e1t*e2t) {  di-1[ aht e2u/e1u di(tb) ] 
    54       !!                               + dj-1[ aht e1v/e2v dj(tb) ] } 
    55       !!      Add this trend to the general tracer trend (ta,sa): 
    56       !!          (ta,sa) = (ta,sa) + ( difft , diffs ) 
     60      !!          difft = 1/(e1t*e2t) {  di-1[ aht e2u/e1u di(ptb) ] 
     61      !!                               + dj-1[ aht e1v/e2v dj(ptb) ] } 
     62      !!      Add this trend to the general tracer trend (pta): 
     63      !!          pta   = pta + difft 
    5764      !! 
    58       !! ** Action  : - Update (ta,sa) arrays with the before iso-level  
    59       !!                harmonic mixing trend. 
     65      !! ** Action  : - Update pta with the before iso-level harmonic mixing trend. 
     66      !!---------------------------------------------------------------------- 
     67      INTEGER         , INTENT(in   )                         ::   kt              ! ocean time-step index 
     68      CHARACTER(len=3), INTENT(in   )                         ::   cdtype          ! =TRA or TRC (tracer indicator) 
     69      INTEGER         , INTENT(in   )                         ::   ktra            ! tracer index 
     70      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj)     ::   pgtu, pgtv      ! tracer gradient at pstep levels 
     71      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb             ! before tracer field 
     72      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta             ! tracer trend  
    6073      !! 
    61       !! History : 
    62       !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code 
    63       !!        !  91-11  (G. Madec) 
    64       !!        !  95-11  (G. Madec)  suppress volumetric scale factors 
    65       !!        !  96-01  (G. Madec)  statement function for e3 
    66       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    67       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    68       !!        !  05-11  (G. Madec)  add zps case 
    69       !!---------------------------------------------------------------------- 
    70       USE oce              , ztu => ua,  &  ! use ua as workspace 
    71          &                   zsu => va      ! use va as workspace 
    72  
    73       !! * Arguments 
    74       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    75        
    76       !! * Local save 
    77       REAL(wp), DIMENSION(jpi,jpj), SAVE ::   & 
    78          ze1ur, ze2vr, zbtr2              ! scale factor coefficients 
    79        
    80       !! * Local declarations 
    81       INTEGER ::   ji, jj, jk             ! dummy loop indices 
    82       INTEGER ::   iku, ikv               ! temporary integers 
    83       REAL(wp) ::   & 
    84          zabe1, zta,                   &  ! temporary scalars 
    85          zabe2, zsa, zbtr                 !    "         " 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    87          ztv, zsv                         ! 3D workspace 
     74      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
     75      INTEGER  ::   iku, ikv       ! temporary integers 
     76      REAL(wp) ::   zabe1, zabe2   ! temporary scalars 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv   ! 3D workspace 
    8878      !!---------------------------------------------------------------------- 
    8979       
    … …  
    9282         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion' 
    9383         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
    94          ze1ur(:,:) = e2u(:,:) / e1u(:,:) 
    95          ze2vr(:,:) = e1v(:,:) / e2v(:,:) 
    96          zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
     84         e1ur(:,:) = e2u(:,:) / e1u(:,:) 
     85         e2vr(:,:) = e1v(:,:) / e2v(:,:) 
     86         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    9787      ENDIF 
     88 
    9889       
    9990      !                                                  ! ============= 
    … …  
    10495         DO jj = 1, jpjm1 
    10596            DO ji = 1, fs_jpim1   ! vector opt. 
    106 #if defined key_zco 
    107                zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) 
    108                zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) 
    109 #else 
    110                zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk) 
    111                zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk) 
    112 #endif 
    113                ztu(ji,jj,jk) = zabe1 * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) ) 
    114                zsu(ji,jj,jk) = zabe1 * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) ) 
    115                ztv(ji,jj,jk) = zabe2 * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) ) 
    116                zsv(ji,jj,jk) = zabe2 * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) ) 
     97               zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e1ur(ji,jj) * fse3u(ji,jj,jk) 
     98               zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e2vr(ji,jj) * fse3v(ji,jj,jk) 
     99               ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk) - ptb(ji,jj,jk) ) 
     100               ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk) - ptb(ji,jj,jk) ) 
    117101            END DO   
    118102         END DO   
    … …  
    124108                  ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1 
    125109                  IF( iku == jk ) THEN 
    126                      zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * ze1ur(ji,jj) * fse3u(ji,jj,iku) 
    127                      ztu(ji,jj,jk) = zabe1 * gtu(ji,jj) 
    128                      zsu(ji,jj,jk) = zabe1 * gsu(ji,jj) 
     110                     zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e1ur(ji,jj) * fse3u(ji,jj,iku) 
     111                     ztu(ji,jj,jk) = zabe1 * pgtu(ji,jj) 
    129112                  ENDIF 
    130113                  IF( ikv == jk ) THEN 
    131                      zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * ze2vr(ji,jj) * fse3v(ji,jj,ikv) 
    132                      ztv(ji,jj,jk) = zabe2 * gtv(ji,jj) 
    133                      zsv(ji,jj,jk) = zabe2 * gsv(ji,jj) 
     114                     zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e2vr(ji,jj) * fse3v(ji,jj,ikv) 
     115                     ztv(ji,jj,jk) = zabe2 * pgtv(ji,jj) 
    134116                  ENDIF 
    135117               END DO 
    … …  
    138120          
    139121          
    140          ! 2. Second derivative (divergence) 
     122         ! 2. Second derivative (divergence) added to the general tracer trends 
    141123         ! -------------------- 
    142124         DO jj = 2, jpjm1 
    143125            DO ji = fs_2, fs_jpim1   ! vector opt. 
    144 #if defined key_zco 
    145                zbtr = zbtr2(ji,jj) 
    146 #else 
    147                zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
    148 #endif 
    149                ! horizontal diffusive trends 
    150                zta = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
    151                   &          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    152                zsa = zbtr * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)   & 
    153                   &          + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) 
    154                ! add it to the general tracer trends 
    155                ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    156                sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
     126               pta(ji,jj,jk) = pta(ji,jj,jk) + btr2(ji,jj) / fse3t(ji,jj,jk)       & 
     127                  &                          * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
     128                  &                             + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    157129            END DO   
    158130         END DO   
    … …  
    161133      !                                                  ! ============= 
    162134 
    163       ! "zonal" mean lateral diffusive heat and salt transport  
    164       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    165          IF( lk_zco ) THEN   ! z-coordinate - full step (1D arrays) 
    166             DO jk = 1, jpkm1 
    167                DO jj = 2, jpjm1 
    168                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    169                     ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk) 
    170                     zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk) 
    171                   END DO 
    172                END DO 
    173             END DO 
    174          ENDIF 
    175          pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    176          pst_ldf(:) = ptr_vj( zsv(:,:,:) ) 
     135 
     136      ! "Poleward" lateral diffusive heat or salt transport  
     137      IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     138         IF( ktra == jp_tem)   pht_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     139         IF( ktra == jp_sal)   pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    177140      ENDIF 
    178141 
     142      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pta, clinfo1=' ldf - lap : ', mask1=tmask, clinfo3=cdtype ) 
     143      ! 
    179144   END SUBROUTINE tra_ldf_lap 
    180145 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/tranpc.F90

    r719 r786  
    202202            ztrdt(:,:,:) = tn(:,:,:) - ztrdt(:,:,:) 
    203203            ztrds(:,:,:) = sn(:,:,:) - ztrds(:,:,:) 
    204             CALL trd_mod(ztrdt, ztrds, jptra_trd_npc, 'TRA', kt) 
     204            CALL trd_tra( kt, jp_tem, jpt_trd_ldf, 'TRA', ptrd3d=ztrdt) 
     205            CALL trd_tra( kt, jp_sal, jpt_trd_ldf, 'TRA', ptrd3d=ztrds) 
    205206         ENDIF 
     207 
    206208       
    207209         ! Lateral boundary conditions on ( tn, sn )   ( Unchanged sign) 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/tranxt.F90

    r719 r786  
    278278      !                                                ! =============== 
    279279 
    280       IF( l_trdtra )   THEN      ! Take the Asselin trend into account  
     280      IF( l_trdtra )   THEN                      ! trend associated with the Asselin filter 
    281281         ztrdt(:,:,:) = ztrdt(:,:,:) / ( 2.*rdt ) 
    282282         ztrds(:,:,:) = ztrds(:,:,:) / ( 2.*rdt )          
    283          CALL trd_mod( ztrdt, ztrds, jptra_trd_atf, 'TRA', kt ) 
    284       END IF 
     283         CALL trd_tra( kt, jp_tem, jpt_trd_atf, 'TRA', ptrd3d=ztrdt) 
     284         CALL trd_tra( kt, jp_sal, jpt_trd_atf, 'TRA', ptrd3d=ztrds) 
     285      ENDIF 
     286 
    285287 
    286288      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tn, clinfo1=' nxt  - Tn: ', mask1=tmask,   & 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traqsr.F90

    r719 r786  
    44   !! Ocean physics: solar radiation penetration in the top ocean levels 
    55   !!====================================================================== 
    6    !! History :  6.0  !  90-10  (B. Blanke)  Original code 
     6   !! History :  OPA  !  90-10  (B. Blanke)  Original code 
    77   !!            7.0  !  91-11  (G. Madec) 
    88   !!                 !  96-01  (G. Madec)  s-coordinates 
    9    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    10    !!            9.0  !  05-11  (G. Madec) zco, zps, sco coordinate 
     9   !!  NEMO      1.0  !  02-06  (G. Madec)  F90: Free form and module 
     10   !!             -   !  05-11  (G. Madec) zco, zps, sco coordinate 
     11   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    4546#  include "vectopt_loop_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    47    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    48    !! $Header$  
     48   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     49   !! $Id:$ 
    4950   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5051   !!---------------------------------------------------------------------- 
    … …  
    7778      !!              - save the trend in ttrd ('key_trdtra') 
    7879      !!---------------------------------------------------------------------- 
    79       USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
    80       USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
    81       !! 
    8280      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    8381      !! 
    84       INTEGER  ::    ji, jj, jk       ! dummy loop indexes 
     82      INTEGER  ::   ji, jj, jk       ! dummy loop indexes 
    8583      REAL(wp) ::   zc0 , zta         ! temporary scalars 
     84      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt   ! 3D workspace 
    8685      !!---------------------------------------------------------------------- 
    8786 
    … …  
    9392      ENDIF 
    9493 
    95       IF( l_trdtra ) THEN      ! Save ta and sa trends 
    96          ztrdt(:,:,:) = ta(:,:,:)  
    97          ztrds(:,:,:) = 0.e0 
    98       ENDIF 
     94      IF( l_trdtra ) ztrdt(:,:,:) = ta(:,:,:)      ! Save ta and sa trends 
    9995 
    10096      ! ---------------------------------------------- ! 
    … …  
    161157      ENDIF 
    162158 
    163       IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
     159      IF( l_trdtra )   THEN                      ! qsr tracer trend saved for diagnostics 
    164160         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    165          CALL trd_mod( ztrdt, ztrds, jptra_trd_qsr, 'TRA', kt ) 
     161         CALL trd_tra( kt, jp_tem, jpt_trd_qsr, 'TRA', ptrd3d=ztrdt) 
    166162      ENDIF 
    167163      !                       ! print mean trends (used for debugging) 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/trasbc.F90

    r719 r786  
    11MODULE trasbc 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  trasbc  *** 
    44   !! Ocean active tracers:  surface boundary condition 
    5    !!============================================================================== 
    6    !! History :  8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
     5   !!====================================================================== 
     6   !! History :  OPA  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
    77   !!            8.2  !  01-02  (D. Ludicone)  sea ice and free surface 
    8    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     8   !!   NEMO     1.0  !  02-06  (G. Madec)  F90: Free form and module 
     9   !!            2.4  !  08-01  (G. Madec) Merge TRA-TRC 
    910   !!---------------------------------------------------------------------- 
    1011 
    … …  
    3132#  include "vectopt_loop_substitute.h90" 
    3233   !!---------------------------------------------------------------------- 
    33    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    34    !! $Header$  
     34   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     35   !! $Id:$  
    3536   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3637   !!---------------------------------------------------------------------- 
    … …  
    9899      !!              - save the trend it in ttrd ('key_trdtra') 
    99100      !!---------------------------------------------------------------------- 
    100       USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
    101       USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
    102       !! 
    103101      INTEGER, INTENT(in) ::   kt     ! ocean time-step index 
    104102      !! 
    105103      INTEGER  ::   ji, jj                   ! dummy loop indices 
    106104      REAL(wp) ::   zta, zsa, zsrau, zse3t   ! temporary scalars 
     105      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt, ztrds   ! 3D workspace 
    107106      !!---------------------------------------------------------------------- 
    108107 
    … …  
    144143      END DO 
    145144 
    146       IF( l_trdtra ) THEN      ! save the sbc trends for diagnostic 
     145      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    147146         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    148147         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    149          CALL trd_mod(ztrdt, ztrds, jptra_trd_nsr, 'TRA', kt) 
     148         CALL trd_tra( kt, jp_tem, jpt_trd_qns, 'TRA', ptrd3d=ztrdt) 
     149         CALL trd_tra( kt, jp_sal, jpt_trd_qns, 'TRA', ptrd3d=ztrds) 
    150150      ENDIF 
    151151      ! 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/trazdf.F90

    r719 r786  
    1414   USE dom_oce         ! ocean space and time domain variables  
    1515   USE zdf_oce         ! ocean vertical physics variables 
     16   USE zdfddm          ! vertical mixing: double diffusion 
    1617 
    1718   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    1819   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine) 
    19    USE trazdf_imp_jki  ! vertical diffusion  implicit (tra_zdf_imp_jki routine) 
    2020 
    2121   USE ldftra_oce      ! ocean active tracers: lateral physics 
    … …  
    4747#  include "vectopt_loop_substitute.h90" 
    4848   !!---------------------------------------------------------------------- 
    49    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    50    !! $Header$  
     49   !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008)  
     50   !! $Id:$  
    5151   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5252   !!---------------------------------------------------------------------- 
    … …  
    8484      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    8585      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    86          CALL tra_zdf_exp    ( kt, r2dt ) 
     86         CALL tra_zdf_exp    ( kt, r2dt,   avt       , tb, ta )   ! temperature 
     87         CALL tra_zdf_exp    ( kt, r2dt, fsavs(:,:,:), tb, ta )   ! salinity 
    8788         CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf0 - Ta: ', mask1=tmask,               & 
    8889            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    89          CALL tra_zdf_imp    ( kt, r2dt ) 
    90          CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf1 - Ta: ', mask1=tmask,               & 
    91             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    92          CALL tra_zdf_imp_jki( kt, r2dt ) 
    93          CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf2 - Ta: ', mask1=tmask,               & 
    94             &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     90         CALL tra_zdf_imp( kt, r2dt, 'TRA' )                      ! T & S zdf trends 
    9591 
    9692      CASE ( 0 )                                       ! explicit scheme 
    97          CALL tra_zdf_exp    ( kt, r2dt ) 
    98          IF( l_trdtra )   THEN                         ! save the vertical diffusive trends for further diagnostics 
     93         CALL tra_zdf_exp    ( kt, r2dt,   avt       , tb, ta )   ! temperature 
     94         CALL tra_zdf_exp    ( kt, r2dt, fsavs(:,:,:), tb, ta )   ! salinity 
     95         IF( l_trdtra )   THEN                                    ! zdf trends diagnostics 
    9996            ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    10097            ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    101             CALL trd_mod( ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt ) 
     98            CALL trd_tra( kt, jp_tem, jpt_trd_ldf, 'TRA', ptrd3d=ztrdt) 
     99            CALL trd_tra( kt, jp_sal, jpt_trd_ldf, 'TRA', ptrd3d=ztrds) 
    102100         ENDIF 
    103101 
    104       CASE ( 1 )                                       ! implicit scheme (k-j-i loop) 
    105          CALL tra_zdf_imp    ( kt, r2dt ) 
    106          IF( l_trdtra )   THEN                         ! save the vertical diffusive trends for further diagnostics 
     102      CASE ( 1 )                                       ! implicit scheme 
     103         CALL tra_zdf_imp( kt, r2dt, 'TRA' )                      ! T & S zdf trends 
     104         IF( l_trdtra )   THEN                                    ! zdf trends diagnostics 
    107105            DO jk = 1, jpkm1 
    108106               ztrdt(:,:,jk) = ( ( ta(:,:,jk) - tb(:,:,jk) ) / r2dt(jk) ) - ztrdt(:,:,jk) 
    109107               ztrds(:,:,jk) = ( ( sa(:,:,jk) - sb(:,:,jk) ) / r2dt(jk) ) - ztrds(:,:,jk) 
    110108            END DO 
    111             CALL trd_mod( ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt ) 
    112          ENDIF 
    113  
    114       CASE ( 2 )                                       ! implicit scheme (j-k-i loop) 
    115          CALL tra_zdf_imp_jki( kt, r2dt ) 
    116          IF( l_trdtra )   THEN                         ! save the vertical diffusive trends for further diagnostics 
    117             DO jk = 1, jpkm1 
    118                ztrdt(:,:,jk) = ( ( ta(:,:,jk) - tb(:,:,jk) ) / r2dt(jk) ) - ztrdt(:,:,jk) 
    119                ztrds(:,:,jk) = ( ( sa(:,:,jk) - sb(:,:,jk) ) / r2dt(jk) ) - ztrds(:,:,jk) 
    120             END DO 
    121             CALL trd_mod( ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt ) 
     109            CALL trd_tra( kt, jp_tem, jpt_trd_zdf, 'TRA', ptrd3d=ztrdt) 
     110            CALL trd_tra( kt, jp_sal, jpt_trd_zdf, 'TRA', ptrd3d=ztrds) 
    122111         ENDIF 
    123112 
    … …  
    127116      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf  - Ta: ', mask1=tmask,               & 
    128117         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    129  
     118      ! 
    130119   END SUBROUTINE tra_zdf 
    131120 
    … …  
    153142 
    154143      ! Choice from ln_zdfexp already read in namelist in zdfini module 
    155       IF( ln_zdfexp ) THEN               ! use explicit scheme 
    156          nzdf = 0 
    157       ELSE                               ! use implicit scheme 
    158          nzdf = 1 
     144      IF( ln_zdfexp ) THEN   ;   nzdf = 0              ! use explicit scheme 
     145      ELSE                   ;   nzdf = 1              ! use implicit scheme 
    159146      ENDIF 
    160147 
    … …  
    169156      ENDIF 
    170157 
    171       ! NEC autotasking / OpenMP 
    172 #if defined key_mpp_omp 
    173       IF( nzdf == 1 )   nzdf = 2                       ! j-k-i loop 
    174 #endif 
    175  
    176158      ! Test: esopa 
    177159      IF( lk_esopa )    nzdf = -1                      ! All schemes used 
    … …  
    184166         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme' 
    185167         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme' 
    186          IF( nzdf ==  2 )   WRITE(numout,*) '              Implicit (euler backward) scheme with j-k-i loops' 
    187168      ENDIF 
    188169 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/trazdf_exp.F90

    r719 r786  
    55   !!                        an explicit time-stepping (time spllitting scheme) 
    66   !!============================================================================== 
    7    !! History : 
    8    !!   6.0  !  90-10  (B. Blanke)  Original code 
    9    !!   7.0  !  91-11  (G. Madec) 
    10    !!        !  92-06  (M. Imbard)  correction on tracer trend loops 
    11    !!        !  96-01  (G. Madec)  statement function for e3 
    12    !!        !  97-05  (G. Madec)  vertical component of isopycnal 
    13    !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord 
    14    !!        !  00-08  (G. Madec)  double diffusive mixing 
    15    !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    16    !!   9.0  !  04-08  (C. Talandier) New trends organisation 
    17    !!        !  05-11  (G. Madec)  New organisation 
     7   !! History :  6.0  !  1990-10  (B. Blanke)  Original code 
     8   !!            7.0  !  1991-11  (G. Madec) 
     9   !!                 !  1992-06  (M. Imbard)  correction on tracer trend loops 
     10   !!                 !  1996-01  (G. Madec)  statement function for e3 
     11   !!                 !  1997-05  (G. Madec)  vertical component of isopycnal 
     12   !!                 !  1997-07  (G. Madec)  geopotential diffusion in s-coord 
     13   !!                 !  2000-08  (G. Madec)  double diffusive mixing 
     14   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module 
     15   !!             -   !  2004-08  (C. Talandier) New trends organisation 
     16   !!            2.0  !  2005-11  (G. Madec)  New organisation 
     17   !!            2.4  !  2008-01  (G. Madec) Merge TRA-TRC 
     18   !!---------------------------------------------------------------------- 
     19 
    1820   !!---------------------------------------------------------------------- 
    1921   !!   tra_zdf_exp  : update the tracer trend with the vertical diffusion 
    2022   !!                  using an explicit time stepping 
    2123   !!---------------------------------------------------------------------- 
    22    !! * Modules used 
    23    USE oce             ! ocean dynamics and active tracers  
    2424   USE dom_oce         ! ocean space and time domain  
    25    USE trdmod          ! ocean active tracers trends  
    26    USE trdmod_oce      ! ocean variables trends 
    2725   USE zdf_oce         ! ocean vertical physics 
    28    USE zdfddm          ! ocean vertical physics: double diffusion 
    2926   USE in_out_manager  ! I/O manager 
    30    USE prtctl          ! Print control 
    3127 
    3228   IMPLICIT NONE 
    3329   PRIVATE 
    3430 
    35    !! * Routine accessibility 
    3631   PUBLIC tra_zdf_exp          ! routine called by step.F90 
    3732 
    3833   !! * Substitutions 
    3934#  include "domzgr_substitute.h90" 
    40 #  include "zdfddm_substitute.h90" 
     35#  include "vectopt_loop_substitute.h90" 
    4136   !!---------------------------------------------------------------------- 
    4237   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    … …  
    4742CONTAINS 
    4843 
    49    SUBROUTINE tra_zdf_exp( kt, p2dt ) 
     44   SUBROUTINE tra_zdf_exp( kt, p2dt, pavt, ptb , pta  ) 
    5045      !!---------------------------------------------------------------------- 
    5146      !!                  ***  ROUTINE tra_zdf_exp  *** 
    … …  
    6863      !! 
    6964      !!--------------------------------------------------------------------- 
    70       !! * Arguments 
    71       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    72       REAL(wp), DIMENSION(jpk), INTENT( in ) ::   & 
    73          p2dt                                 ! vertical profile of tracer time-step 
    74        
    75       !! * Local declarations 
    76       INTEGER ::   ji, jj, jk, jl             ! dummy loop indices 
    77       REAL(wp) ::   & 
    78          zlavmr,                            & ! temporary scalars 
    79          zave3r, ze3tr,                     & !    "         " 
    80          zta, zsa                             !    "         "  
    81       REAL(wp), DIMENSION(jpi,jpk) ::   & 
    82          zwx, zwy, zwz, zww 
     65      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
     66      REAL(wp), INTENT(in   ), DIMENSION(jpk)         ::   p2dt   ! vertical profile of tracer time-step 
     67      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pavt   ! eddy diffusivity coef. 
     68      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb    ! before tracer field 
     69      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer trend  
     70      !! 
     71      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
     72      REAL(wp) ::   zlavmr, zave3r, ze3tr, zta   !    "         "  
     73      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy 
    8374      !!--------------------------------------------------------------------- 
    8475 
    … …  
    9283      ! 0. Local constant initialization 
    9384      ! -------------------------------- 
    94       zlavmr = 1. / float( n_zdfexp ) 
     85      zlavmr = 1. / FLOAT( n_zdfexp ) 
    9586 
    96       !                                                ! =============== 
    97       DO jj = 2, jpjm1                                 !  Vertical slab 
    98          !                                             ! =============== 
    99          ! 1. Initializations 
    100          ! ------------------ 
     87      ! 1. Initializations 
     88      ! ------------------ 
     89      zwy(:,:, 1 ) = 0.e0          ! surface : zero diffusive flux 
     90      zwy(:,:,jpk) = 0.e0          ! bottom  : zero diffusive flux 
     91      zwx(:,:,:) = ptb(:,:,:)      ! interior: start from before tracer 
    10192 
    102          ! Surface & bottom boundary conditions: no flux 
    103          DO ji = 2, jpim1 
    104             zwy(ji, 1 ) = 0.e0 
    105             zwy(ji,jpk) = 0.e0 
    106             zww(ji, 1 ) = 0.e0 
    107             zww(ji,jpk) = 0.e0 
    108          END DO 
    10993 
    110          ! zwx and zwz arrays set to before tracer values 
    111          DO jk = 1, jpk 
    112             DO ji = 2, jpim1 
    113                zwx(ji,jk) = tb(ji,jj,jk) 
    114                zwz(ji,jk) = sb(ji,jj,jk) 
     94      ! 2. Time splitting loop 
     95      ! ---------------------- 
     96 
     97      DO jl = 1, n_zdfexp 
     98         ! 
     99         ! first vertical derivative 
     100         DO jk = 2, jpk 
     101            DO jj = 2, jpjm1 
     102               DO ji = fs_2, fs_jpim1      ! vector opt. 
     103                  zave3r = 1.e0 / fse3w(ji,jj,jk)  
     104                  zwy(ji,jj,jk) =  pavt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r 
     105               END DO 
    115106            END DO 
    116107         END DO 
    117108 
    118  
    119          ! 2. Time splitting loop 
    120          ! ---------------------- 
    121  
    122          DO jl = 1, n_zdfexp 
    123  
    124             ! first vertical derivative 
    125             IF( lk_zdfddm ) THEN       ! double diffusion: avs /= avt 
    126                DO jk = 2, jpk 
    127                   DO ji = 2, jpim1 
    128                      zave3r = 1.e0 / fse3w(ji,jj,jk)  
    129                      zwy(ji,jk) =   avt(ji,jj,jk) * ( zwx(ji,jk-1) - zwx(ji,jk) ) * zave3r 
    130                      zww(ji,jk) = fsavs(ji,jj,jk) * ( zwz(ji,jk-1) - zwz(ji,jk) ) * zave3r 
    131                   END DO 
    132                END DO 
    133             ELSE                      ! default : avs = avt 
    134                DO jk = 2, jpk 
    135                   DO ji = 2, jpim1 
    136                      zave3r = avt(ji,jj,jk) / fse3w(ji,jj,jk) 
    137                      zwy(ji,jk) = zave3r *(zwx(ji,jk-1) - zwx(ji,jk) ) 
    138                      zww(ji,jk) = zave3r *(zwz(ji,jk-1) - zwz(ji,jk) ) 
    139                   END DO 
    140                END DO 
    141             ENDIF 
    142  
    143             ! trend estimation at kt+l*2*rdt/n_zdfexp 
    144             DO jk = 1, jpkm1 
    145                DO ji = 2, jpim1 
     109         ! trend estimation at kt+l*2*rdt/n_zdfexp 
     110         DO jk = 1, jpkm1 
     111            DO jj = 2, jpjm1 
     112               DO ji = fs_2, fs_jpim1      ! vector opt. 
    146113                  ze3tr = zlavmr / fse3t(ji,jj,jk) 
    147114                  ! 2nd vertical derivative 
    148                   zta = ( zwy(ji,jk) - zwy(ji,jk+1) ) * ze3tr 
    149                   zsa = ( zww(ji,jk) - zww(ji,jk+1) ) * ze3tr 
     115                  zta = ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr 
    150116                  ! update the tracer trends 
    151                   ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    152                   sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
     117                  pta(ji,jj,jk) = pta(ji,jj,jk) + zta 
    153118                  ! update tracer fields at kt+l*2*rdt/n_zdfexp 
    154                   zwx(ji,jk) = zwx(ji,jk) + p2dt(jk) * zta * tmask(ji,jj,jk) 
    155                   zwz(ji,jk) = zwz(ji,jk) + p2dt(jk) * zsa * tmask(ji,jj,jk) 
     119                  zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * zta * tmask(ji,jj,jk) 
    156120               END DO 
    157121            END DO 
    158122         END DO 
    159          !                                             ! =============== 
    160       END DO                                           !   End of slab 
    161       !                                                ! =============== 
    162  
     123         ! 
     124      END DO  
     125      ! 
    163126   END SUBROUTINE tra_zdf_exp 
    164127 

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r719 r786  
    44   !! Ocean active tracers:  vertical component of the tracer mixing trend 
    55   !!============================================================================== 
    6    !! History : 
    7    !!   6.0  !  90-10  (B. Blanke)  Original code 
    8    !!   7.0  !  91-11 (G. Madec) 
    9    !!        !  92-06 (M. Imbard) correction on tracer trend loops 
    10    !!        !  96-01 (G. Madec) statement function for e3 
    11    !!        !  97-05 (G. Madec) vertical component of isopycnal 
    12    !!        !  97-07 (G. Madec) geopotential diffusion in s-coord 
    13    !!        !  00-08 (G. Madec) double diffusive mixing 
    14    !!   8.5  !  02-08 (G. Madec)  F90: Free form and module 
    15    !!   9.0  !  06-11 (G. Madec)  New step reorganisation 
     6   !! History :  OPA  !  1990-10  (B. Blanke)  Original code 
     7   !!            7.0  !  1991-11 (G. Madec) 
     8   !!             -   !  1992-06 (M. Imbard) correction on tracer trend loops 
     9   !!            8.0  !  1996-01 (G. Madec) statement function for e3 
     10   !!             -   !  1997-05 (G. Madec) vertical component of isopycnal 
     11   !!             -   !  1997-07 (G. Madec) geopotential diffusion in s-coord 
     12   !!             -   !  2000-08 (G. Madec) double diffusive mixing 
     13   !!   NEMO     1.0  !  2002-08 (G. Madec)  F90: Free form and module 
     14   !!            2.0  !  2006-11 (G. Madec)  New step reorganisation 
     15   !!            2.4  !  2008-01  (G. Madec) Merge TRA-TRC 
     16   !!---------------------------------------------------------------------- 
     17 
    1618   !!---------------------------------------------------------------------- 
    1719   !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical   
    … …  
    1921   !!                 Vector optimization, use k-j-i loops. 
    2022   !!---------------------------------------------------------------------- 
    21    !! * Modules used 
    2223   USE oce             ! ocean dynamics and tracers variables 
    2324   USE dom_oce         ! ocean space and time domain variables  
    … …  
    3637   PRIVATE 
    3738 
    38    !! * Routine accessibility 
    3939   PUBLIC tra_zdf_imp   !  routine called by step.F90 
    4040 
    … …  
    5050CONTAINS 
    5151    
    52    SUBROUTINE tra_zdf_imp( kt, p2dt ) 
     52   SUBROUTINE tra_zdf_imp( kt, p2dt, cdtype ) 
    5353      !!---------------------------------------------------------------------- 
    5454      !!                  ***  ROUTINE tra_zdf_imp  *** 
    … …  
    8888      !! 
    8989      !!--------------------------------------------------------------------- 
    90       !! * Modules used 
    91       USE oce    , ONLY :   zwd   => ua,  &  ! ua used as workspace 
    92                             zws   => va      ! va   "          " 
    93       !! * Arguments 
    94       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    95       REAL(wp), DIMENSION(jpk), INTENT( in ) ::   & 
    96          p2dt                                ! vertical profile of tracer time-step 
    97  
    98       !! * Local declarations 
    99       INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    100       REAL(wp) ::   zavi, zrhs, znvvl,     & ! temporary scalars 
    101          ze3tb, ze3tn, ze3ta, zvsfvvl        ! variable vertical scale factors 
    102       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    103          zwi, zwt, zavsi                     ! workspace arrays 
     90      INTEGER         , INTENT(in   )                 ::   kt       ! ocean time-step index 
     91      CHARACTER(len=3), INTENT(in   )                 ::   cdtype   ! =TRA or TRC (tracer indicator) 
     92      REAL(wp)        , INTENT(in   ), DIMENSION(jpk) ::   p2dt     ! vertical profile of tracer time-step 
     93      !! 
     94      INTEGER  ::   ji, jj, jk                     ! dummy loop indices 
     95      REAL(wp) ::   znvvl                    ! temporary scalars 
     96      REAL(wp) ::   ze3tn, ze3ta, zvsfvvl   ! variable vertical scale factors 
     97      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwd, zws, zwi, zav   ! workspace arrays 
    10498      !!--------------------------------------------------------------------- 
    10599 
    … …  
    108102         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing (k-j-i loops)' 
    109103         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ ' 
    110          zavi = 0.e0      ! avoid warning at compilation phase when lk_ldfslp=F 
     104         IF( cdtype /= 'TRA' ) THEN 
     105            IF(lwp)WRITE(numout,*) 'CAUTION TRC casei still not coded ' 
     106         ENDIF 
    111107      ENDIF 
    112108 
    … …  
    116112      zws  (1,:, : ) = 0.e0     ;     zws  (jpi,:,:) = 0.e0 
    117113      zwi  (1,:, : ) = 0.e0     ;     zwi  (jpi,:,:) = 0.e0 
    118       zwt  (1,:, : ) = 0.e0     ;     zwt  (jpi,:,:) = 0.e0 
    119       zavsi(1,:, : ) = 0.e0     ;     zavsi(jpi,:,:) = 0.e0 
    120       zwt  (:,:,jpk) = 0.e0     ;     zwt  ( : ,:,1) = 0.e0 
    121       zavsi(:,:,jpk) = 0.e0     ;     zavsi( : ,:,1) = 0.e0 
     114      zav  (1,:, : ) = 0.e0     ;     zav  (jpi,:,:) = 0.e0 
     115      zav  (:,:,jpk) = 0.e0     ;     zav  ( : ,:,1) = 0.e0 
    122116 
    123117      ! I.1 Variable volume : to take into account vertical variable vertical scale factors 
    … …  
    137131      ! ------------------------ 
    138132 
     133      ! vertical mixing coef. put in zav 
     134      IF( ln_traldf_iso ) THEN      ! zav = avt + lateral mixing contribution 
    139135#if defined key_ldfslp 
    140       ! update and save of avt (and avs if double diffusive mixing) 
    141       DO jk = 2, jpkm1 
    142          DO jj = 2, jpjm1 
    143             DO ji = fs_2, fs_jpim1   ! vector opt. 
    144                zavi = fsahtw(ji,jj,jk)                       &   ! vertical mixing coef. due to lateral mixing 
    145                   & * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
    146                   &    + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) 
    147                zwt(ji,jj,jk) = avt(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature) 
    148 # if defined key_zdfddm 
    149                zavsi(ji,jj,jk) = fsavs(ji,jj,jk) + zavi          ! dd mixing: zavsi = total vertical mixing coef. on salinity 
    150 # endif 
    151             END DO 
    152          END DO 
    153       END DO 
    154  
    155 #else 
    156       ! No isopycnal diffusion 
    157       zwt(:,:,:) = avt(:,:,:) 
    158 # if defined key_zdfddm 
    159       zavsi(:,:,:) = avs(:,:,:) 
    160 # endif 
    161  
     136         DO jk = 2, jpkm1  
     137            DO jj = 2, jpjm1 
     138               DO ji = fs_2, fs_jpim1   ! vector opt. 
     139                  zav(ji,jj,jk) = avt(ji,jj,jk) + fsahtw(ji,jj,jk) * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
     140                     &                                                + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) 
     141               END DO 
     142            END DO 
     143         END DO 
    162144#endif 
     145      ELSE 
     146         zav(:,:,:) = avt(:,:,:)   ! zav = avt 
     147      ENDIF 
    163148 
    164149      ! Diagonal, inferior, superior  (including the bottom boundary condition via avt masked) 
    … …  
    169154               ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl                                ! after scale factor at T-point 
    170155               ze3tn = ( 1. - znvvl )*fse3t(ji,jj,jk) + znvvl                        ! now   scale factor at T-point 
    171                zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) ) 
    172                zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) 
     156               zwi(ji,jj,jk) = - p2dt(jk) * zav(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) ) 
     157               zws(ji,jj,jk) = - p2dt(jk) * zav(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) 
    173158               zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    174159            END DO 
    … …  
    189174      ! II.1. Vertical diffusion on t 
    190175      ! --------------------------- 
     176      CALL zdf_imp( p2dt, zwd, zws, zwi, tb, ta ) 
     177 
     178 
     179      ! II.2 Vertical diffusion on salinity 
     180      ! ----------------------------------- 
     181 
     182!!gm    question: why surface value of zav is zero????  to be checked 
     183      IF( lk_zdfddm ) THEN 
     184         ! vertical mixing coef. on salintity including isopycnal slope (if necessary) put in zav 
     185         IF( ln_traldf_iso ) THEN      ! zav = avt + lateral mixing contribution 
     186#if defined key_ldfslp 
     187            DO jk = 2, jpkm1 
     188               DO jj = 2, jpjm1 
     189                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     190                     zav(ji,jj,jk) = zav(ji,jj,jk) - avt(ji,jj,jk) + fsavs(ji,jj,jk)   
     191                  END DO 
     192               END DO 
     193            END DO 
     194#endif 
     195         ELSE                             ! zav = avs 
     196            zav(:,:,:) = avs(:,:,:)  
     197         ENDIF 
     198 
     199         ! Rebuild the Matrix as avt /= avs 
     200 
     201         ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked) 
     202         DO jk = 1, jpkm1 
     203            DO jj = 2, jpjm1 
     204               DO ji = fs_2, fs_jpim1   ! vector opt. 
     205                  zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + ssha(ji,jj) * mut(ji,jj,jk) ) 
     206                  ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl                              ! after scale factor at T-point 
     207                  ze3tn = ( 1. - znvvl )*fse3t(ji,jj,jk) + znvvl                      ! now   scale factor at T-point 
     208                  zwi(ji,jj,jk) = - p2dt(jk) * zav(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) ) 
     209                  zws(ji,jj,jk) = - p2dt(jk) * zav(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) 
     210                  zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     211               END DO 
     212            END DO 
     213         END DO 
     214 
     215         ! Surface boudary conditions 
     216         DO jj = 2, jpjm1 
     217            DO ji = fs_2, fs_jpim1   ! vector opt. 
     218               zvsfvvl = fsve3t(ji,jj,1) * ( 1 + ssha(ji,jj) * mut(ji,jj,1) ) 
     219               ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl                                  ! after scale factor at T-point 
     220               zwi(ji,jj,1) = 0.e0 
     221               zwd(ji,jj,1) = ze3ta - zws(ji,jj,1) 
     222            END DO 
     223         END DO 
     224         ! 
     225      ENDIF 
     226 
     227      CALL zdf_imp( p2dt, zwd, zws, zwi, tb, ta ) 
     228      ! 
     229   END SUBROUTINE tra_zdf_imp 
     230 
     231 
     232   SUBROUTINE zdf_imp( p2dt, pwd, pws, pwi, ptb, pta ) 
     233      !!---------------------------------------------------------------------- 
     234      !!                  ***  ROUTINE tra_zdf_imp  *** 
     235      !! 
     236      !! ** Purpose :   Compute the trend due to the vertical tracer diffusion 
     237      !!     including the vertical component of lateral mixing (only for 2nd 
     238      !!     order operator, for fourth order it is already computed and add 
     239      !!     to the general trend in traldf.F) and add it to the general trend 
     240      !!     of the tracer equations. 
     241      !! 
     242      !! ** Method  :   The vertical component of the lateral diffusive trends 
     243      !!      is provided by a 2nd order operator rotated along neutral or geo- 
     244      !!      potential surfaces to which an eddy induced advection can be  
     245      !!      added. It is computed using before fields (forward in time) and  
     246      !!      isopycnal or geopotential slopes computed in routine ldfslp. 
     247      !! 
     248      !!      Second part: vertical trend associated with the vertical physics 
     249      !!      ===========  (including the vertical flux proportional to dk[t] 
     250      !!                  associated with the lateral mixing, through the 
     251      !!                  update of avt) 
     252      !!      The vertical diffusion of tracers (t & s) is given by: 
     253      !!             difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) ) 
     254      !!      It is computed using a backward time scheme (t=ta). 
     255      !!      Surface and bottom boundary conditions: no diffusive flux on 
     256      !!      both tracers (bottom, applied through the masked field avt). 
     257      !!      Add this trend to the general trend ta,sa : 
     258      !!         ta = ta + dz( avt dz(t) ) 
     259      !!         (sa = sa + dz( avs dz(t) ) if lk_zdfddm=T ) 
     260      !! 
     261      !!      Third part: recover avt resulting from the vertical physics 
     262      !!      ==========  alone, for further diagnostics (for example to 
     263      !!                  compute the turbocline depth in zdfmxl.F90). 
     264      !!         avt = zavt 
     265      !!         (avs = zavs if lk_zdfddm=T ) 
     266      !! 
     267      !! ** Action  : - Update (ta,sa) with before vertical diffusion trend 
     268      !! 
     269      !!--------------------------------------------------------------------- 
     270      REAL(wp), INTENT(in   ), DIMENSION(jpk)         ::   p2dt     ! vertical profile of tracer time-step 
     271      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pwd      ! matrix: diagnal terms 
     272      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pws      ! matrix: upper   terms 
     273      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pwi      ! matrix: lower   terms 
     274      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   ptb      ! before tracer field 
     275      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pta      ! in : tracer trend 
     276      !                                                                     ! out: after tracer 
     277      !! 
     278      INTEGER  ::   ji, jj, jk                     ! dummy loop indices 
     279      REAL(wp) ::   zrhs, znvvl              ! temporary scalars 
     280      REAL(wp) ::   ze3tb, ze3tn, zvsfvvl   ! variable vertical scale factors 
     281      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwt    ! workspace arrays 
     282      !!--------------------------------------------------------------------- 
     283 
     284      ! Variable volume : to take into account vertical variable vertical scale factors 
     285      IF( lk_vvl ) THEN   ;    znvvl = 1. 
     286      ELSE                ;    znvvl = 0.e0 
     287      ENDIF 
    191288 
    192289      !! Matrix inversion from the first level 
    … …  
    201298      ! 
    202299      !   m is decomposed in the product of an upper and lower triangular matrix 
    203       !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 
    204       !   The second member is in 2d array zwy 
    205       !   The solution is in 2d array zwx 
    206       !   The 3d arry zwt is a work space array 
    207       !   zwy is used and then used as a work space array : its value is modified! 
     300      !   The 3 diagonal terms are the input 3d arrays: zwd, zws, zwi 
     301      !   The second member and solution are put in pta array 
     302      !   The zwt array is a work space array 
    208303 
    209304      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
    210305      DO jj = 2, jpjm1 
    211306         DO ji = fs_2, fs_jpim1 
    212             zwt(ji,jj,1) = zwd(ji,jj,1) 
     307            zwt(ji,jj,1) = pwd(ji,jj,1) 
    213308         END DO 
    214309      END DO 
    … …  
    216311         DO jj = 2, jpjm1 
    217312            DO ji = fs_2, fs_jpim1 
    218                zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)  /zwt(ji,jj,jk-1) 
     313               zwt(ji,jj,jk) = pwd(ji,jj,jk) - pwi(ji,jj,jk) * pws(ji,jj,jk-1)  /zwt(ji,jj,jk-1) 
    219314            END DO 
    220315         END DO 
    … …  
    227322            ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl 
    228323            ze3tn = ( 1. - znvvl ) + znvvl*fse3t (ji,jj,1) 
    229             ta(ji,jj,1) = ze3tb * tb(ji,jj,1) + p2dt(1) * ze3tn * ta(ji,jj,1) 
     324            pta(ji,jj,1) = ze3tb * ptb(ji,jj,1) + p2dt(1) * ze3tn * pta(ji,jj,1) 
    230325         END DO 
    231326      END DO 
    … …  
    237332               ze3tn = ( 1. - znvvl ) + znvvl*fse3t (ji,jj,jk) 
    238333               zrhs = ze3tb * tb(ji,jj,jk) + p2dt(jk) * ze3tn * ta(ji,jj,jk)   ! zrhs=right hand side  
    239                ta(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *ta(ji,jj,jk-1) 
     334               pta(ji,jj,jk) = zrhs - pwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pta(ji,jj,jk-1) 
    240335            END DO 
    241336         END DO 
    … …  
    247342      DO jj = 2, jpjm1 
    248343         DO ji = fs_2, fs_jpim1 
    249             ta(ji,jj,jpkm1) = ta(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 
     344            pta(ji,jj,jpkm1) = pta(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 
    250345         END DO 
    251346      END DO 
    … …  
    253348         DO jj = 2, jpjm1 
    254349            DO ji = fs_2, fs_jpim1 
    255                ta(ji,jj,jk) = ( ta(ji,jj,jk) - zws(ji,jj,jk) * ta(ji,jj,jk+1) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk) 
    256             END DO 
    257          END DO 
    258       END DO 
    259  
    260       ! II.2 Vertical diffusion on salinity 
    261       ! ----------------------------------- 
    262  
    263 #if defined key_zdfddm 
    264       ! Rebuild the Matrix as avt /= avs 
    265  
    266       ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked) 
    267       DO jk = 1, jpkm1 
    268          DO jj = 2, jpjm1 
    269             DO ji = fs_2, fs_jpim1   ! vector opt. 
    270                zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + ssha(ji,jj) * mut(ji,jj,jk) ) 
    271                ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl                                      ! after scale factor at T-point 
    272                ze3tn = ( 1. - znvvl )*fse3t(ji,jj,jk) + znvvl                              ! now   scale factor at T-point 
    273                zwi(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) ) 
    274                zws(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) 
    275                zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    276             END DO 
    277          END DO 
    278       END DO 
    279  
    280       ! Surface boudary conditions 
    281       DO jj = 2, jpjm1 
    282          DO ji = fs_2, fs_jpim1   ! vector opt. 
    283             zvsfvvl = fsve3t(ji,jj,1) * ( 1 + ssha(ji,jj) * mut(ji,jj,1) ) 
    284             ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl                                          ! after scale factor at T-point 
    285             zwi(ji,jj,1) = 0.e0 
    286             zwd(ji,jj,1) = ze3ta - zws(ji,jj,1) 
    287          END DO 
    288       END DO 
    289 #endif 
    290  
    291  
    292       !! Matrix inversion from the first level 
    293       !!---------------------------------------------------------------------- 
    294       !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk ) 
     350               pta(ji,jj,jk) = ( pta(ji,jj,jk) - pws(ji,jj,jk) * ta(ji,jj,jk+1) )   & 
     351                  &          / zwt(ji,jj,jk) * tmask(ji,jj,jk) 
     352            END DO 
     353         END DO 
     354      END DO 
    295355      ! 
    296       !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 ) 
    297       !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 ) 
    298       !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 ) 
    299       !        (        ...               )( ...  ) ( ...  ) 
    300       !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk ) 
    301       ! 
    302       !   m is decomposed in the product of an upper and lower triangular 
    303       !   matrix 
    304       !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 
    305       !   The second member is in 2d array zwy 
    306       !   The solution is in 2d array zwx 
    307       !   The 3d arry zwt is a work space array 
    308       !   zwy is used and then used as a work space array : its value is modified! 
    309  
    310       ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
    311       DO jj = 2, jpjm1 
    312          DO ji = fs_2, fs_jpim1 
    313             zwt(ji,jj,1) = zwd(ji,jj,1) 
    314          END DO 
    315       END DO 
    316       DO jk = 2, jpkm1 
    317          DO jj = 2, jpjm1 
    318             DO ji = fs_2, fs_jpim1 
    319                zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)  /zwt(ji,jj,jk-1) 
    320             END DO 
    321          END DO 
    322       END DO 
    323  
    324       ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    325       DO jj = 2, jpjm1 
    326          DO ji = fs_2, fs_jpim1 
    327             zvsfvvl = fsve3t(ji,jj,1) * ( 1 + sshb(ji,jj) * mut(ji,jj,1) ) 
    328             ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl                               ! before scale factor at T-point 
    329             ze3tn = ( 1. - znvvl ) + znvvl*fse3t(ji,jj,1)                        ! now    scale factor at T-point 
    330             sa(ji,jj,1) = ze3tb * sb(ji,jj,1) + p2dt(1) * ze3tn * sa(ji,jj,1) 
    331          END DO 
    332       END DO 
    333       DO jk = 2, jpkm1 
    334          DO jj = 2, jpjm1 
    335             DO ji = fs_2, fs_jpim1 
    336                zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + sshb(ji,jj) * mut(ji,jj,jk) ) 
    337                ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl                            ! before scale factor at T-point 
    338                ze3tn = ( 1. - znvvl ) + znvvl*fse3t(ji,jj,jk)                    ! now    scale factor at T-point 
    339                zrhs = ze3tb * sb(ji,jj,jk) + p2dt(jk) * ze3tn * sa(ji,jj,jk)     ! zrhs=right hand side 
    340                sa(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *sa(ji,jj,jk-1) 
    341             END DO 
    342          END DO 
    343       END DO 
    344  
    345       ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 
    346       ! Save the masked temperature after in ta 
    347       ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done it will not be done in tranxt) 
    348       DO jj = 2, jpjm1 
    349          DO ji = fs_2, fs_jpim1 
    350             sa(ji,jj,jpkm1) = sa(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 
    351          END DO 
    352       END DO 
    353       DO jk = jpk-2, 1, -1 
    354          DO jj = 2, jpjm1 
    355             DO ji = fs_2, fs_jpim1 
    356                sa(ji,jj,jk) = ( sa(ji,jj,jk) - zws(ji,jj,jk) * sa(ji,jj,jk+1) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk) 
    357             END DO 
    358          END DO 
    359       END DO 
    360  
    361    END SUBROUTINE tra_zdf_imp 
     356   END SUBROUTINE zdf_imp 
    362357 
    363358   !!============================================================================== 
Note: See TracChangeset for help on using the changeset viewer.