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 1175 – NEMO

Changeset 1175


Ignore:
Timestamp:
2008-09-11T18:26:34+02:00 (16 years ago)
Author:
cetlod
Message:

update transport modules to take into account new trends organization, see ticket:248

Location:
trunk/NEMO/TOP_SRC/TRP
Files:
25 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/TOP_SRC/TRP/trcadv_cen2.F90

    r1152 r1175  
    1616   USE trcbbl              ! advective passive tracers in the BBL 
    1717   USE prtctl_trc 
     18   USE trdmld_trc 
     19   USE trdmld_trc_oce          ! ocean variables trends 
    1820 
    1921   IMPLICIT NONE 
    … …  
    7173      !!      * Add this trend now to the general trend of tracer tra: 
    7274      !!              tra = tra + ztra 
    73       !!      * trend diagnostic ('key_trc_diatrd'): the trend is saved 
     75      !!      * trend diagnostic ('key_trdmld_trc'): the trend is saved 
    7476      !!      for diagnostics. The trends saved is expressed as 
    7577      !!      Uh.gradh(T) 
    … …  
    8890      !!         Add this trend now to the general trend of tracer tra : 
    8991      !!            tra = tra + ztra 
    90       !!         Trend diagnostic ('key_trc_diatrd'): the trend is saved for 
     92      !!         Trend diagnostic ('key_trdmld_trc'): the trend is saved for 
    9193      !!      diagnostics. The trends saved is expressed as : 
    9294      !!             save trend =  w.gradz(T) = ztra - trn divn. 
    9395      !! 
    9496      !! ** Action : - update tra with the now advective tracer trends 
    95       !!             - save the trends in trtrd ('key_trc_diatrd') 
     97      !!             - save the trends in trtrd ('key_trdmld_trc') 
    9698      !! 
    9799      !! History : 
    … …  
    132134      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    133135         zind                              ! temporary workspace arrays 
    134 #if defined key_trc_diatrd 
     136 
    135137      REAL(wp) ::                           & 
    136138         ztai, ztaj,                        &  ! temporary scalars 
    137139         zfui1, zfvj1                          !    "         " 
    138 #endif 
     140 
     141      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    139142#if defined key_lim3 || defined key_lim2 
    140143      REAL(wp) ::                           & 
    … …  
    155158         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    156159      ENDIF 
     160 
     161      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
    157162 
    158163#if defined key_trcbbl_adv 
    … …  
    249254                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    250255 
    251 #if defined key_trc_diatrd  
     256#if defined key_trc_diatrd 
    252257                  ! recompute the trends in i- and j-direction as Uh gradh(T) 
    253 #if ! defined key_zco 
     258# if defined key_s_coord || defined key_partial_steps 
    254259                  zfui = 0.5 * e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk) 
    255260                  zfui1= 0.5 * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk) 
    … …  
    270275                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj 
    271276#endif 
     277 
    272278               END DO 
    273279            END DO 
    … …  
    275281         END DO                                           !   End of slab 
    276282         !                                                ! =============== 
    277       ENDDO 
     283 
     284         ! 3. Save the horizontal advective trends for diagnostics 
     285         ! ------------------------------------------------------- 
     286!CDIR BEGIN COLLAPSE 
     287         TRDTRC_XY : IF( l_trdtrc )THEN 
     288 
     289            ! 3.1) Passive tracer ZONAL advection trends 
     290            ztrtrd(:,:,:) = 0.e0 
     291 
     292            DO jk = 1, jpkm1 
     293               DO jj = 2, jpjm1 
     294                  DO ji = fs_2, fs_jpim1 
     295                     ! recompute the trends in i-direction as Uh gradh(T) 
     296# if  ! defined key_zco 
     297                     zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
     298                     zfui = 0.5 * e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk) 
     299                     zfui1= 0.5 * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk) 
     300# else 
     301                     zbtr = zbtr2(ji,jj) 
     302                     zfui = 0.5 * e2u(ji  ,jj) * zun(ji,  jj,jk) 
     303                     zfui1= 0.5 * e2u(ji-1,jj) * zun(ji-1,jj,jk) 
     304# endif 
     305                     ztai = - zbtr * ( zfui  * ( trn(ji+1,jj  ,jk,jn) - trn(ji,  jj,jk,jn) )    & 
     306                          &          + zfui1 * ( trn(ji,  jj,  jk,jn) - trn(ji-1,jj,jk,jn) ) ) 
     307 
     308                     ! save i- and j- advective trends computed as Uh gradh(T) 
     309                     ztrtrd(ji,jj,jk) = ztai 
     310                  END DO 
     311               END DO 
     312            END DO 
     313 
     314            IF( luttrd(jn) ) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_xad, kt)   ! handle the trend 
     315 
     316            ! 3.2)  Passive tracer MERIDIONAL advection trends 
     317            ztrtrd(:,:,:) = 0.e0 
     318 
     319            DO jk = 1, jpkm1 
     320               DO jj = 2, jpjm1 
     321                  DO ji = fs_2, fs_jpim1 
     322                     ! recompute the trends in j-direction as Uh gradh(T) 
     323# if ! defined key_zco 
     324                     zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
     325                     zfvj = 0.5 * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk) 
     326                     zfvj1= 0.5 * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk) 
     327# else 
     328                     zbtr = zbtr2(ji,jj) 
     329                     zfvj = 0.5 * e1v(ji,jj  ) * zvn(ji,jj  ,jk) 
     330                     zfvj1= 0.5 * e1v(ji,jj-1) * zvn(ji,jj-1,jk) 
     331# endif 
     332                     ztaj = - zbtr * ( zfvj  * ( trn(ji  ,jj+1,jk,jn) - trn(ji,jj  ,jk,jn) )    & 
     333                          &          + zfvj1 * ( trn(ji  ,jj  ,jk,jn) - trn(ji,jj-1,jk,jn) ) ) 
     334 
     335                     ! save i- and j- advective trends computed as Uh gradh(T) 
     336                     ztrtrd(ji,jj,jk) = ztaj 
     337                  END DO 
     338               END DO 
     339            END DO 
     340 
     341            IF( luttrd(jn) ) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_yad, kt)   ! handle the trend 
     342 
     343         ENDIF TRDTRC_XY 
     344!CDIR END 
     345         !                                                    ! =========== 
     346      END DO                                                  ! tracer loop 
     347      !                                                       ! =========== 
    278348 
    279349      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    333403                  ! add it to the general tracer trends 
    334404                  tra(ji,jj,jk,jn) =  tra(ji,jj,jk,jn) + ztra 
    335 #if defined key_trc_diatrd  
     405#if defined key_trc_diatrd 
    336406                  ! save the vertical advective trends computed as w gradz(T) 
    337407                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
    338408#endif 
     409 
    339410               END DO 
    340411            END DO 
    341412         END DO 
    342413 
    343       END DO 
     414         ! 3. Save the vertical advective trends for diagnostic  
     415         ! ---------------------------------------------------- 
     416 
     417!CDIR BEGIN COLLAPSE 
     418         TRDTRC_Z : IF( l_trdtrc )THEN 
     419            ztrtrd(:,:,:) = 0.e0 
     420 
     421            ! Compute T/S vertical advection trends 
     422            DO jk = 1, jpkm1 
     423               DO jj = 2, jpjm1 
     424                  DO ji = fs_2, fs_jpim1 
     425                     ze3tr = 1. / fse3t(ji,jj,jk) 
     426                     ! vertical advective trends  
     427                     ztra = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 
     428                     ! save the vertical advective trends computed as w gradz(T) 
     429                     ztrtrd(ji,jj,jk) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
     430                  END DO 
     431               END DO 
     432            END DO 
     433 
     434            IF( luttrd(jn) ) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt)  ! handle the trend 
     435 
     436         ENDIF TRDTRC_Z 
     437!CDIR END 
     438         !                                                    ! =========== 
     439      END DO                                                  ! tracer loop 
     440      !                                                       ! =========== 
     441 
     442      IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
    344443 
    345444      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

  • trunk/NEMO/TOP_SRC/TRP/trcadv_muscl.F90

    r1152 r1175  
    1818   USE lib_mpp 
    1919   USE prtctl_trc      ! Print control for debbuging 
     20   USE trdmld_trc 
     21   USE trdmld_trc_oce          ! ocean variables trends 
    2022 
    2123   IMPLICIT NONE 
    … …  
    2931   !!---------------------------------------------------------------------- 
    3032   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    31    !! $Id$  
     33   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcadv_muscl.F90,v 1.13 2007/10/12 09:26:30 opalod Exp $  
    3234   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3335   !!---------------------------------------------------------------------- 
    … …  
    4648      !! 
    4749      !! ** Action  : - update tra with the now advective tracer trends 
    48       !!              - save trends in trtrd ('key_trc_diatrd') 
     50      !!              - save trends ('key_trdmld_trc') 
    4951      !! 
    5052      !! References :                 
    … …  
    7880      REAL(wp) ::   z0u, z0v, z0w 
    7981      REAL(wp) ::   zzt1, zzt2, zalpha, z2dtt 
    80 #if defined key_trc_diatrd 
    81       REAL(wp) ::   ztai, ztaj 
    82       REAL(wp) ::   zfui, zfvj 
    83 #endif 
     82      REAL(wp) ::   ztai, ztaj, zfui, zfvj 
     83      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    8484      CHARACTER (len=22) :: charout 
    8585      !!---------------------------------------------------------------------- 
    … …  
    9292      ENDIF 
    9393 
    94   
     94       IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
    9595 
    9696#if defined key_trcbbl_adv 
    … …  
    105105 
    106106      DO jn = 1, jptra 
    107 #if defined key_trc_diatrd 
    108         DO jk = 1,jpk 
    109            DO jj = 1,jpj 
    110               DO ji = 1,jpi 
    111                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = 0. 
    112                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = 0. 
    113                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = 0. 
    114               END DO 
    115             END DO 
    116           END DO 
    117 #endif 
     107 
    118108         ! I. Horizontal advective fluxes 
    119109         ! ------------------------------ 
    … …  
    224214#if defined key_trc_diatrd 
    225215                  ! recompute the trends in i- and j-direction as Uh gradh(T) 
    226 #if ! defined key_zco 
     216#   if defined key_s_coord || defined key_partial_steps 
    227217                  zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   & 
    228218                     & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) 
    … …  
    241231                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj 
    242232#endif 
    243                END DO 
    244             END DO 
    245          END DO 
     233 
     234               END DO 
     235            END DO 
     236         END DO 
     237 
     238         ! 3. Save the horizontal advective trends for diagnostics 
     239         ! ------------------------------------------------------- 
     240!CDIR BEGIN COLLAPSE 
     241         TRDTRC_XY : IF( l_trdtrc ) THEN 
     242 
     243            ! 3.1) Passive tracer ZONAL advection trends 
     244            DO jk = 1, jpkm1 
     245               DO jj = 2, jpjm1 
     246                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     247#if ! defined key_zco 
     248                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     249                     zfui = e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk)   & 
     250                        & - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk) 
     251#else 
     252                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     253                     zfui = e2u(ji  ,jj) * zun(ji,  jj,jk)  - e2u(ji-1,jj) * zun(ji-1,jj,jk) 
     254#endif 
     255                     ! recompute the trends in i- direction as Uh gradh(T) 
     256                     ztrtrd(ji,jj,jk) = - zbtr*( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) - trn(ji,jj,jk,jn)*zfui ) 
     257                  END DO 
     258               END DO 
     259            END DO 
     260 
     261            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_xad, kt ) 
     262 
     263            ! 3.2)  Passive tracer MERIDIONAL advection trends 
     264            DO jk = 1, jpkm1 
     265               DO jj = 2, jpjm1 
     266                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     267                     ! recompute the trends in i- and j-direction as Uh gradh(T) 
     268#if ! defined key_zco 
     269                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     270                     zfvj = e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)   & 
     271                        & - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk) 
     272#else 
     273                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     274                     zfvj = e1v(ji,jj  ) * zvn(ji,jj  ,jk) - e1v(ji,jj-1) * zvn(ji,jj-1,jk) 
     275#endif 
     276                     ztrtrd(ji,jj,jk) = - zbtr*( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) - trn(ji,jj,jk,jn)*zfvj ) 
     277                  END DO 
     278               END DO 
     279            END DO 
     280 
     281            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_yad, kt ) 
     282 
     283         ENDIF TRDTRC_XY 
     284!CDIR END 
     285 
    246286      ENDDO 
    247287 
    … …  
    328368                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
    329369#endif 
    330                END DO 
    331             END DO 
    332          END DO 
    333  
     370 
     371               END DO 
     372            END DO 
     373         END DO 
     374 
     375         ! 3. Save the vertical advective trends for diagnostic 
     376         ! ---------------------------------------------------- 
     377!CDIR BEGIN COLLAPSE 
     378         TRDTRC_Z : IF( l_trdtrc )THEN 
     379 
     380            ! Compute T/S vertical advection trends 
     381            DO jk = 1, jpkm1 
     382               DO jj = 2, jpjm1 
     383                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     384                     zbtr = 1. / fse3t(ji,jj,jk) 
     385                     ! horizontal advective trends 
     386                     ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) ) 
     387                     ! save the vertical advective trends computed as w gradz(T) 
     388                     ztrtrd(ji,jj,jk) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
     389                  END DO 
     390               END DO 
     391            END DO 
     392 
     393            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt) 
     394 
     395         END IF TRDTRC_Z 
     396!CDIR END 
    334397      END DO 
    335398 

  • trunk/NEMO/TOP_SRC/TRP/trcadv_muscl2.F90

    r1152 r1175  
    1717   USE trcbbl          ! advective passive tracers in the BBL 
    1818   USE prtctl_trc          ! Print control for debbuging 
     19   USE trdmld_trc 
     20   USE trdmld_trc_oce          ! ocean variables trends 
    1921 
    2022   IMPLICIT NONE 
    … …  
    5052      !! 
    5153      !! ** Action : - update tra with the now advective tracer trends 
    52       !!             - save trends in trtrd ('key_trc_diatrd') 
     54      !!             - save trends ('key_trdmld_trc') 
    5355      !! 
    5456      !! References :                 
    … …  
    8183      REAL(wp) ::   zzt1, zzt2, zalpha 
    8284 
    83 #if defined key_trc_diatrd 
    8485      REAL(wp) ::   ztai, ztaj 
    8586      REAL(wp) ::   zfui, zfvj 
    86 #endif 
     87      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    8788      CHARACTER (len=22) :: charout 
    8889      !!---------------------------------------------------------------------- 
    … …  
    9596      ENDIF 
    9697       
     98      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     99 
    97100#if defined key_trcbbl_adv         
    98101      ! Advective bottom boundary layer 
    … …  
    262265#if defined key_trc_diatrd 
    263266                  ! recompute the trends in i- and j-direction as Uh gradh(T) 
    264 #if ! defined key_zco 
     267#   if defined key_s_coord || defined key_partial_steps 
    265268                  zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   & 
    266269                     & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) 
    … …  
    280283 
    281284#endif 
    282                END DO 
    283             END DO 
    284          END DO 
    285       ENDDO 
     285 
     286               END DO 
     287            END DO 
     288         END DO 
     289 
     290         ! 3. Save the horizontal advective trends for diagnostics 
     291         ! ------------------------------------------------------- 
     292 
     293         TRDTRC_XY : IF( l_trdtrc ) THEN 
     294 
     295!CDIRR COLLAPSE 
     296            ! 3.1) Passive tracer ZONAL advection trends 
     297            DO jk = 1, jpkm1 
     298               DO jj = 2, jpjm1 
     299                  DO ji = fs_2, fs_jpim1   ! vector opt.   
     300#if ! defined key_zco 
     301                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     302                     zfui = e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   & 
     303                        & - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) 
     304#else 
     305                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     306                     zfui = e2u(ji  ,jj) * un(ji,  jj,jk)   & 
     307                        & - e2u(ji-1,jj) * un(ji-1,jj,jk) 
     308#endif 
     309                     ! recompute the trends in i- direction as Uh gradh(T) 
     310                     ztrtrd(ji,jj,jk) = - zbtr*( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) - trn(ji,jj,jk,jn)*zfui ) 
     311                  END DO 
     312               END DO 
     313            END DO 
     314 
     315            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_xad, kt ) 
     316 
     317            ! 3.2)  Passive tracer MERIDIONAL advection trends 
     318            DO jk = 1, jpkm1 
     319               DO jj = 2, jpjm1 
     320                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     321                     ! recompute the trends in i- and j-direction as Uh gradh(T) 
     322#if ! defined key_zco 
     323                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     324                     zfvj = e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)   & 
     325                        & - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk) 
     326#else 
     327                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
     328                     zfvj = e1v(ji,jj  ) * vn(ji,jj  ,jk)   & 
     329                        & - e1v(ji,jj-1) * vn(ji,jj-1,jk) 
     330#endif 
     331                     ztrtrd(ji,jj,jk) = - zbtr*( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) - trn(ji,jj,jk,jn)*zfvj ) 
     332                  END DO 
     333               END DO 
     334            END DO 
     335 
     336            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_yad, kt ) 
     337 
     338         ENDIF TRDTRC_XY 
     339 
     340         !                           !============= 
     341      END DO                         ! tracer loop 
     342      !                              !============= 
    286343 
    287344      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    382439                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
    383440#endif 
    384                END DO 
    385             END DO 
    386          END DO 
    387  
    388       END DO 
     441 
     442               END DO 
     443            END DO 
     444         END DO 
     445 
     446 
     447         ! 3. Save the vertical advective trends for diagnostic 
     448         ! ---------------------------------------------------- 
     449 
     450         TRDTRC_Z : IF( l_trdtrc )THEN 
     451 
     452            ! Compute T/S vertical advection trends 
     453            DO jk = 1, jpkm1 
     454               DO jj = 2, jpjm1 
     455                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     456                     zbtr = 1. / fse3t(ji,jj,jk) 
     457                     ! horizontal advective trends 
     458                     ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) ) 
     459                     ! save the vertical advective trends computed as w gradz(T) 
     460                     ztrtrd(ji,jj,jk) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
     461                  END DO  
     462               END DO 
     463            END DO 
     464 
     465            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt) 
     466 
     467         END IF TRDTRC_Z 
     468 
     469         !                            !============= 
     470      END DO                          ! tracer loop 
     471      !                               !============= 
     472 
    389473 
    390474      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    394478      ENDIF 
    395479 
     480      IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
     481 
    396482   END SUBROUTINE trc_adv_muscl2 
    397483 

  • trunk/NEMO/TOP_SRC/TRP/trcadv_smolar.F90

    r1152 r1175  
    11MODULE trcadv_smolar 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  trcadv_smolar  *** 
    44   !! Ocean passive tracers:  horizontal & vertical advective trend 
    5    !!============================================================================== 
     5   !!====================================================================== 
     6   !! History :       !  87-06  (pa-dl) Original 
     7   !!                 !  91-11  (G. Madec) 
     8   !!                 !  94-08  (A. Czaja) 
     9   !!                 !  95-09  (M. Levy) passive tracers 
     10   !!                 !  98-03  (M.A. Foujols) lateral boundary conditions 
     11   !!                 !  99-02  (M.A. Foujols) lbc in conjonction with ORCA 
     12   !!                 !  00-05  (MA Foujols) add lbc for tracer trends 
     13   !!                 !  00-10  (MA Foujols and E.Kestenare) INCLUDE instead of routine 
     14   !!                 !  01-05  (E.Kestenare) fix bug in trtrd indexes 
     15   !!                 !  02-05  (M-A Filiberti, and M.Levy) correction in trtrd computation 
     16   !!           9.0   !  03-04  (C. Ethe)  F90: Free form and module 
     17   !!                 !  07-02  (C. Deltel) Diagnose ML trends for passive tracers 
     18   !!---------------------------------------------------------------------- 
    619#if defined key_top 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_top'                                                TOP models 
    920   !!---------------------------------------------------------------------- 
    1021   !!   trc_adv_smolar : update the passive tracer trend with the horizontal 
    … …  
    1324   !!---------------------------------------------------------------------- 
    1425   USE oce_trc             ! ocean dynamics and active tracers variables 
    15    USE trp_trc                 ! ocean passive tracers variables 
     26   USE trc                 ! ocean passive tracers variables 
    1627   USE lbclnk              ! ocean lateral boundary conditions (or mpp link) 
    1728   USE trcbbl              ! advective passive tracers in the BBL 
    18    USE trctrp_lec          ! passive tracers transport 
    1929   USE prtctl_trc          ! Print control for debbuging 
     30   USE trctrp_lec 
     31   USE trdmld_trc 
     32   USE trdmld_trc_oce      
    2033 
    2134   IMPLICIT NONE 
    2235   PRIVATE 
    2336 
    24    PUBLIC trc_adv_smolar    ! routine called by trcstp.F90 
    25  
    26    REAL(wp), DIMENSION(jpk) ::   rdttrc       ! vertical profile of tracer time-step 
     37   PUBLIC trc_adv_smolar   ! routine called by trcstp.F90 
     38 
     39   REAL(wp), DIMENSION(jpk) ::   rdttrc    ! vertical profile of tracer time-step 
    2740  
    2841   !! * Substitutions 
    … …  
    3043   !!---------------------------------------------------------------------- 
    3144   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    32    !! $Id$  
    33    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     45   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcadv_smolar.F90,v 1.11 2006/04/10 15:38:54 opalod Exp $  
     46   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3447   !!---------------------------------------------------------------------- 
    3548CONTAINS 
    … …  
    4053      !! 
    4154      !! ** Purpose :   Compute the now trend due to total advection of passi- 
    42       !!      ve tracer using a Smolarkiewicz FCT (Flux Corrected Transport )  
    43       !!      scheme and add it to the general tracer trend. 
     55      !!                ve tracer using a Smolarkiewicz FCT (Flux Corrected 
     56      !!                Transport) scheme and add it to the general tracer trend. 
    4457      !! 
    45       !! ** Method : Computation of not exactly the advection but the 
    46       !!             transport term, i.e.  div(u*tra).  
    47       !!             Computes the now horizontal and vertical advection with 
    48       !!             the complete 3d method. 
     58      !! ** Method  :  Computation of not exactly the advection but the 
     59      !!                transport term, i.e.  div(u*tra).  
     60      !!                Computes the now horizontal and vertical advection with 
     61      !!                the complete 3d method. 
    4962      !!  
    50       !!       note: - sc is an empirical factor to be used with care 
    51       !!             - this advection scheme needs an euler-forward time scheme 
     63      !!       Note : - sc is an empirical factor to be used with care 
     64      !!              - this advection scheme needs an euler-forward time scheme 
    5265      !! 
    5366      !! ** Action : - update tra with the now advective tracer trends 
    54       !!             - save trends in trtrd ('key_trc_diatrd') 
     67      !!             - save trends ('key_trdmld_trc') 
    5568      !! 
    56       !! References :                 
    57       !!     Piotr K. Smolarkiewicz, 1983, 
    58       !!       "A simple positive definit advection 
    59       !!        scheme with small IMPLICIT diffusion" 
    60       !!        Monthly Weather Review, pp 479-486 
    61       !! 
    62       !! History : 
    63       !!         !  87-06 (pa-dl) Original 
    64       !!         !  91-11 (G. Madec) 
    65       !!         !  94-08 (A. Czaja) 
    66       !!         !  95-09 (M. Levy) passive tracers 
    67       !!         !  98-03 (M.A. Foujols) lateral boundary conditions 
    68       !!         !  99-02 (M.A. Foujols) lbc in conjonction with ORCA 
    69       !!         !  00-05 (MA Foujols) add lbc for tracer trends 
    70       !!         !  00-10 (MA Foujols and E.Kestenare) INCLUDE instead of routine 
    71       !!         !  01-05 (E.Kestenare) fix bug in trtrd indexes 
    72       !!         !  02-05 (M-A Filiberti, and M.Levy) correction in trtrd computation 
    73       !!   9.0   !  03-04  (C. Ethe)  F90: Free form and module 
     69      !! References :   Smolarkiewicz, 1983, Mon. Wea. Rev. p. 479-486 
    7470      !!---------------------------------------------------------------------- 
    75       !! * modules used 
    7671#if defined key_trcbbl_adv 
    7772      USE oce_trc            , zun => ua,  &  ! use ua as workspace 
    … …  
    8075#else 
    8176      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un 
    82                                zvn => vn,  &  !              zvn == vn 
    83                                zwn => wn      !              zwn == wn 
    84 #endif 
    85       !! * Arguments 
    86       INTEGER, INTENT( in ) ::   kt         ! ocean time-step 
    87  
    88       !! * Local declarations 
    89       INTEGER :: ji, jj, jk,jt, jn            ! dummy loop indices 
    90  
    91       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &       
    92          zti, ztj,              & 
    93          zaa, zbb, zcc,         & 
    94          zx , zy , zz ,         & 
    95          zkx, zky, zkz,         & 
    96          zbuf 
    97  
    98 #if defined key_trc_diatrd 
     77           &                   zvn => vn,  &  !              zvn == vn 
     78           &                   zwn => wn      !              zwn == wn 
     79#endif 
     80      INTEGER, INTENT( in ) ::   kt                        ! ocean time-step 
     81      INTEGER :: ji, jj, jk,jt, jn                         ! dummy loop indices 
     82      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zti, ztj    
     83      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zaa, zbb, zcc 
     84      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zx , zy , zz 
     85      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zkx, zky, zkz 
     86      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbuf 
    9987      REAL(wp) :: zgm, zgz 
    100 #endif 
    101  
    10288      REAL(wp) :: zbtr, ztra 
    10389      REAL(wp) :: zfp_ui, zfp_vj, zfm_ui, zfm_vj, zfp_w, zfm_w 
    10490      CHARACTER (len=22) :: charout 
     91      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd 
    10592      !!---------------------------------------------------------------------- 
    106  
    10793 
    10894      IF( kt == nittrc000  .AND. lwp ) THEN 
    … …  
    11298         rdttrc(:) = rdttra(:) * FLOAT(ndttrc) 
    11399      ENDIF 
    114  
    115  
     100       
     101      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk,3) ) 
     102      
    116103#if defined key_trcbbl_adv         
    117104      ! Advective bottom boundary layer 
    … …  
    119106      zun(:,:,:) = un (:,:,:) - u_trc_bbl(:,:,:) 
    120107      zvn(:,:,:) = vn (:,:,:) - v_trc_bbl(:,:,:) 
    121       zwn(:,:,:) = wn (:,:,:) + w_trc_bbl( :,:,:) 
    122 #endif 
    123  
    124       ! tracer loop parallelized (macrotasking) 
    125       ! ======================================= 
    126        
    127       DO jn = 1, jptra 
    128           
     108      zwn(:,:,:) = wn (:,:,:) + w_trc_bbl(:,:,:) 
     109#endif 
     110 
     111      !                                                          ! =========== 
     112      DO jn = 1, jptra                                           ! tracer loop 
     113         !                                                       ! =========== 
    129114         ! 1. tracer flux in the 3 directions 
    130115         ! ---------------------------------- 
    131116          
    132          ! 1.1 mass flux at u v and t-points and initialization 
    133  
    134         DO jk = 1,jpk 
    135  
    136            DO jj = 1,jpj 
    137               DO ji = 1,jpi 
    138                  zaa(ji,jj,jk) = e2u(ji,jj)*fse3u(ji,jj,jk) * zun(ji,jj,jk) 
    139                  zbb(ji,jj,jk) = e1v(ji,jj)*fse3v(ji,jj,jk) * zvn(ji,jj,jk) 
    140                  zcc(ji,jj,jk) = e1t(ji,jj)*e2t(ji,jj)      * zwn(ji,jj,jk) 
    141                  zbuf(ji,jj,jk) = 0. 
    142                  ztj(ji,jj,jk) = 0. 
    143                  zx(ji,jj,jk) = 0. 
    144                  zy(ji,jj,jk) = 0. 
    145                  zz(ji,jj,jk) = 0. 
    146                  zti(ji,jj,jk) = trn(ji,jj,jk,jn) 
     117         !--1.1 Horizontal advection 
     118!CDIRR COLLAPSE 
     119         IF( l_trdtrc ) ztrtrd(:,:,:,:) = 0.e0             ! trends 
     120 
     121         DO jk = 1, jpk                                       ! Horizontal slab 
     122 
     123            ! ... Initialisations 
     124            zbuf(:,:,jk) = 0.e0    ;    ztj(:,:,jk) = 0.e0 
     125            zx  (:,:,jk) = 0.e0    ;    zy (:,:,jk) = 0.e0 
     126            zz  (:,:,jk) = 0.e0 
     127             
     128!CDIRR COLLAPSE 
     129            IF( l_trdtrc ) ztrtrd(:,:,:,:) = 0.e0             ! trends 
     130 
     131            ! ... Horizontal mass flux at u v and t-points 
     132            zaa(:,:,jk)  = e2u(:,:) * fse3u(:,:,jk) * zun(:,:,jk) 
     133            zbb(:,:,jk)  = e1v(:,:) * fse3v(:,:,jk) * zvn(:,:,jk) 
     134            zcc(:,:,jk)  = e1t(:,:) *   e2t(:,:)    * zwn(:,:,jk) 
     135            zti(:,:,jk)  = trn(:,:,jk,jn) 
     136 
    147137#if defined key_trc_diatrd 
    148                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = 0. 
    149                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = 0. 
    150                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = 0. 
    151 #endif 
    152               END DO 
    153            END DO 
    154             
    155            ! 1.2 calcul of intermediate field with an upstream advection scheme 
    156            !     and mass fluxes calculated above 
    157             
    158            ! calcul of tracer flux in the i and j direction 
    159             
    160            DO jj=1,jpj 
    161               zkx(  1,jj,jk)=0. 
    162               zkx(jpi,jj,jk)=0. 
    163            END DO 
    164             
    165            DO ji=1,jpi 
    166               zky(ji,  1,jk)=0. 
    167               zky(ji,jpj,jk)=0. 
    168            END DO 
    169             
    170            DO jj = 2,jpjm1 
    171               DO ji = 2,jpim1 
    172                  zfp_ui = 0.5 * ( zaa(ji,jj,jk) + ABS( zaa(ji,jj,jk) ) ) 
    173                  zfp_vj = 0.5 * ( zbb(ji,jj,jk) + ABS( zbb(ji,jj,jk) ) ) 
    174                  zfm_ui = 0.5 * ( zaa(ji,jj,jk) - ABS( zaa(ji,jj,jk) ) ) 
    175                  zfm_vj = 0.5 * ( zbb(ji,jj,jk) - ABS( zbb(ji,jj,jk) ) )             
    176                  zkx(ji,jj,jk) = zfp_ui * zti(ji,jj,jk) + zfm_ui * zti(ji+1,jj  ,jk)  
    177                  zky(ji,jj,jk) = zfp_vj * zti(ji,jj,jk) + zfm_vj * zti(ji    ,jj+1,jk)              
    178               END DO 
    179            END DO 
    180  
    181         END DO 
    182  
    183          ! II. Vertical advection 
    184          ! ---------------------- 
    185  
    186          ! Surface value 
    187          IF( lk_dynspg_rl ) THEN        ! rigid lid : flux set to zero 
     138            IF (luttrd(jn)) trtrd(:,:,jk,ikeep(jn),1) = 0. 
     139            IF (luttrd(jn)) trtrd(:,:,jk,ikeep(jn),2) = 0. 
     140            IF (luttrd(jn)) trtrd(:,:,jk,ikeep(jn),3) = 0. 
     141#endif 
     142 
     143            ! ... Horizontal tracer flux in the i and j direction 
     144            zkx( 1,  :,jk) = 0.e0     ;      zky(  :,  1,jk) = 0.e0 
     145            zkx(jpi, :,jk) = 0.e0     ;      zky(  :,jpj,jk) = 0.e0 
     146             
     147            DO jj = 2, jpjm1 
     148               DO ji = fs_2, fs_jpim1    ! Vector opt. 
     149                   
     150                  ! Upstream advection scheme using mass fluxes calculated above 
     151                  zfp_ui = 0.5 * ( zaa(ji,jj,jk) + ABS( zaa(ji,jj,jk) ) ) 
     152                  zfp_vj = 0.5 * ( zbb(ji,jj,jk) + ABS( zbb(ji,jj,jk) ) ) 
     153                  zfm_ui = 0.5 * ( zaa(ji,jj,jk) - ABS( zaa(ji,jj,jk) ) ) 
     154                  zfm_vj = 0.5 * ( zbb(ji,jj,jk) - ABS( zbb(ji,jj,jk) ) ) 
     155                   
     156                  ! Tracer fluxes 
     157                  zkx(ji,jj,jk) = zfp_ui * zti(ji,jj,jk) + zfm_ui * zti(ji+1,jj  ,jk)  
     158                  zky(ji,jj,jk) = zfp_vj * zti(ji,jj,jk) + zfm_vj * zti(ji  ,jj+1,jk)              
     159               END DO 
     160            END DO 
     161             
     162         END DO                                               ! Horizontal slab 
     163          
     164         ! ... Lateral boundary conditions on zk[xy] 
     165         CALL lbc_lnk( zkx, 'U', -1. ) 
     166         CALL lbc_lnk( zky, 'V', -1. ) 
     167          
     168         !--1.2 Vertical advection 
     169         IF( lk_dynspg_rl ) THEN        ! surface value for rigid lid : flux set to zero 
    188170            zkz(:,:, 1 ) = 0.e0   
    189          ELSE                           ! free surface 
     171         ELSE                           ! surface value for free surface 
    190172            zkz(:,:, 1 ) = zwn(:,:,1) * trn(:,:,1,jn) * tmask(ji,jj,1) 
    191173         ENDIF 
    192  
    193         DO jk = 2,jpk 
    194           DO jj = 1,jpj 
    195             DO ji = 1,jpi 
    196                zfp_w = 0.5 * ( zcc(ji,jj,jk) + ABS( zcc(ji,jj,jk) ) ) 
    197                zfm_w = 0.5 * ( zcc(ji,jj,jk) - ABS( zcc(ji,jj,jk) ) )         
    198                zkz(ji,jj,jk) = zfp_w * zti(ji,jj,jk) + zfm_w * zti(ji,jj,jk-1)      
    199             END DO 
    200           END DO 
    201         END DO 
    202  
    203 ! ... Lateral boundary conditions on zk[xy] 
    204       CALL lbc_lnk( zkx, 'U', -1. ) 
    205       CALL lbc_lnk( zky, 'V', -1. ) 
    206  
    207  
    208 ! 2. calcul of after field using an upstream advection scheme 
    209 ! ----------------------------------------------------------- 
    210  
    211         DO jk = 1,jpkm1 
    212           DO jj = 2,jpjm1 
    213             DO ji = 2,jpim1 
    214               zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk)) 
    215               ztj(ji,jj,jk) = -zbtr*    & 
    216      &            ( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk)  & 
    217      &            + zky(ji,jj,jk) - zky(ji,jj - 1,jk)  & 
    218      &            + zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 
     174          
     175         DO jk = 2, jpk     ! Vector opt. ??? 
     176            DO jj = 1, jpj 
     177               DO ji = 1, jpi 
     178                  zfp_w = 0.5 * ( zcc(ji,jj,jk) + ABS( zcc(ji,jj,jk) ) ) 
     179                  zfm_w = 0.5 * ( zcc(ji,jj,jk) - ABS( zcc(ji,jj,jk) ) )         
     180                  zkz(ji,jj,jk) = zfp_w * zti(ji,jj,jk) + zfm_w * zti(ji,jj,jk-1)      
     181               END DO 
     182            END DO 
     183         END DO 
     184          
     185         ! 2. Compute after field using an upstream advection scheme 
     186         ! --------------------------------------------------------- 
     187          
     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                  ztj(ji,jj,jk) = - zbtr *                                & 
     193                       &         ( zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )    & 
     194                       &         + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )    & 
     195                       &         + zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1) ) 
    219196#if defined key_trc_diatrd 
    220               IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  & 
    221      &                       zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) ) 
    222  
    223               IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  & 
    224      &            zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) ) 
    225  
    226               IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  & 
    227      &            zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 
    228 #endif 
    229             END DO 
    230           END DO 
    231         END DO 
    232  
    233 ! 2.1 start of antidiffusive correction loop 
    234  
    235         DO jt = 1,ncortrc 
    236  
    237 ! 2.2 calcul of intermediary field zti 
    238  
    239           DO jk = 1,jpkm1 
    240             DO jj = 2,jpjm1 
    241               DO ji = 2,jpim1 
    242                 zti(ji,jj,jk) = zti(ji,jj,jk)+rdttrc(jk)*ztj(ji,jj,jk) 
    243                 zbuf(ji,jj,jk) = zbuf(ji,jj,jk) + ztj(ji,jj,jk) 
    244               END DO 
    245             END DO 
    246           END DO 
    247  
    248 ! ... Lateral boundary conditions on zti 
    249       CALL lbc_lnk( zti, 'T', 1. ) 
    250  
    251  
    252 ! 2.3 calcul of the antidiffusive flux 
    253  
    254           DO jk = 1,jpkm1 
    255             DO jj = 2,jpjm1 
    256               DO ji = 2,jpim1 
    257                 zx(ji,jj,jk) = ( abs(zaa(ji,jj,jk)) - rdttrc(jk)       & 
    258      &              *zaa(ji,jj,jk)**2/                          & 
    259      &              (e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) )  & 
    260      &              *(zti(ji + 1,jj,jk) - zti( ji ,jj,jk))      & 
    261      &              /(zti( ji ,jj,jk) + zti(ji + 1,jj,jk) + rtrn)    & 
    262      &              * rsc 
    263  
    264                 zy(ji,jj,jk) = ( abs(zbb(ji,jj,jk)) - rdttrc(jk)       & 
    265      &              *zbb(ji,jj,jk)**2/                          & 
    266      &              (e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) )  & 
    267      &              *(zti(ji,jj + 1,jk) - zti(ji, jj ,jk))      & 
    268      &              /(zti(ji, jj ,jk) + zti(ji,jj + 1,jk) + rtrn)    & 
    269      &              * rsc 
    270               END DO 
    271             END DO 
    272           END DO 
    273  
    274           DO jk = 2,jpkm1 
    275             DO jj = 2,jpjm1 
    276               DO ji = 2,jpim1 
    277                 zz(ji,jj,jk) = ( abs(zcc(ji,jj,jk)) - rdttrc(jk)*zcc(ji,jj,jk)**2  &   
    278      &              /( e1t(ji,jj)*e2t(ji,jj)*fse3w(ji,jj,jk) ) ) & 
    279      &               *( zti(ji,jj,jk) - zti(ji,jj,jk - 1) )/  & 
    280      &                ( zti(ji,jj,jk) + zti(ji,jj,jk - 1) + rtrn )* rsc*( -1.) 
    281               END DO 
    282             END DO 
    283           END DO 
    284  
    285 ! 2.4 cross terms 
    286  
    287           IF (crosster) THEN 
    288               DO jk = 2,jpkm1 
    289                 DO jj = 2,jpjm1 
    290                   DO ji = 2,jpim1 
    291                     zx(ji,jj,jk) = zx(ji,jj,jk) & 
    292      &                  - 0.5*rdttrc(jk)*rsc*zaa(ji,jj,jk)*0.25* & 
    293      &                  (    (zbb(ji  ,jj - 1,jk  ) + zbb(ji + 1,jj - 1 & 
    294      &                  ,jk  ) + zbb(ji + 1,jj  ,jk  ) + zbb(ji  ,jj  & 
    295      &                  ,jk))* (zti(ji  ,jj + 1,jk  ) + zti(ji + 1,jj + & 
    296      &                  1,jk  ) - zti(ji + 1,jj - 1,jk  ) - zti(ji  ,jj & 
    297      &                  - 1,jk  ))/ (zti(ji  ,jj + 1,jk  ) + zti(ji + 1 & 
    298      &                  ,jj + 1,jk  ) + zti(ji + 1,jj - 1,jk  ) + zti(ji & 
    299      &                  ,jj - 1,jk  ) + rtrn) + (zcc(ji  ,jj  ,jk  ) + & 
    300      &                  zcc(ji + 1,jj  ,jk  ) + zcc(ji  ,jj  ,jk + 1) + & 
    301      &                  zcc(ji + 1,jj  ,jk + 1))* (zti(ji  ,jj  ,jk - 1) & 
    302      &                  + zti(ji + 1,jj  ,jk - 1) - zti(ji  ,jj  ,jk + 1 & 
    303      &                  )- zti(ji + 1,jj  ,jk + 1))/ (zti(ji  ,jj  ,jk - & 
    304      &                  1) + zti(ji + 1,jj  ,jk - 1) + zti(ji  ,jj  ,jk & 
    305      &                  +1) + zti(ji + 1,jj  ,jk + 1) + rtrn))/(e1u(ji & 
    306      &                  ,jj)*e2u(ji,jj)*fse3u(ji,jj,jk))*vmask(ji  ,jj - & 
    307      &                  1,jk  )*vmask(ji + 1,jj - 1,jk  )*vmask(ji + 1 & 
    308      &                  ,jj,jk)*vmask(ji  ,jj  ,jk  )*tmask(ji  ,jj  ,jk & 
    309      &                  )*tmask(ji + 1,jj  ,jk  )*tmask(ji  ,jj  ,jk + 1 & 
    310      &                  )*tmask(ji + 1,jj  ,jk + 1) 
    311  
    312                     zy(ji,jj,jk) = zy(ji,jj,jk)    &    
    313      &                  - 0.5*rdttrc(jk)*rsc*zbb(ji,jj,jk)*0.25*    &    
    314      &                  (    (zaa(ji - 1,jj  ,jk  ) + zaa(ji - 1,jj + 1    &    
    315      &                  ,jk  ) + zaa(ji  ,jj  ,jk  ) + zaa(ji  ,jj + 1    &    
    316      &                  ,jk))* (zti(ji + 1,jj + 1,jk  ) + zti(ji + 1,jj    &    
    317      &                  ,jk  ) - zti(ji - 1,jj + 1,jk  ) - zti(ji - 1,jj    &    
    318      &                  ,jk  ))/ (zti(ji + 1,jj + 1,jk  ) + zti(ji + 1    &    
    319      &                  ,jj  ,jk  ) + zti(ji - 1,jj + 1,jk  ) + zti(ji    &    
    320      &                  - 1,jj  ,jk  ) + rtrn) + (zcc(ji  ,jj  ,jk  )    &    
    321      &                  + zcc(ji  ,jj  ,jk + 1) + zcc(ji  ,jj + 1,jk  )    &    
    322      &                  + zcc(ji  ,jj + 1,jk + 1))* (zti(ji  ,jj  ,jk -    &    
    323      &                  1) + zti(ji  ,jj + 1,jk - 1) - zti(ji  ,jj  ,jk    &    
    324      &                  +1) - zti(ji  ,jj + 1,jk + 1))/ (zti(ji  ,jj    &    
    325      &                  ,jk- 1) + zti(ji  ,jj + 1,jk - 1) + zti(ji  ,jj    &    
    326      &                  ,jk+ 1) + zti(ji  ,jj + 1,jk + 1) + rtrn))    &    
    327      &                  /(e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk))    &    
    328      &                  *umask(ji - 1,jj,jk  )*umask(ji - 1,jj + 1,jk  )    &    
    329      &                  *umask(ji  ,jj,jk  )*umask(ji  ,jj + 1,jk  )    &    
    330      &                  *tmask(ji  ,jj,jk)*tmask(ji  ,jj  ,jk + 1)    &    
    331      &                  *tmask(ji  ,jj + 1,jk)*tmask(ji  ,jj + 1,jk + 1)       
    332  
    333                     zz(ji,jj,jk) = zz(ji,jj,jk)    &    
    334      &                  - 0.5*rdttrc(jk)*rsc*zcc(ji,jj,jk)*0.25*    &    
    335      &                  (    (zaa(ji - 1,jj  ,jk  ) + zaa(ji  ,jj  ,jk    &    
    336      &                  ) + zaa(ji  ,jj  ,jk - 1) + zaa(ji - 1,jj  ,jk -    &    
    337      &                  1))*(zti(ji + 1,jj  ,jk - 1) + zti(ji + 1,jj    &    
    338      &                  ,jk  ) - zti(ji - 1,jj  ,jk  ) - zti(ji - 1,jj    &    
    339      &                  ,jk - 1))/(zti(ji + 1,jj  ,jk - 1) + zti(ji + 1    &    
    340      &                  ,jj,jk  ) + zti(ji - 1,jj  ,jk  ) + zti(ji - 1    &    
    341      &                  ,jj,jk - 1) + rtrn) + (zbb(ji  ,jj - 1,jk  )    &    
    342      &                  + zbb(ji  ,jj  ,jk  ) + zbb(ji  ,jj  ,jk - 1)    &    
    343      &                  + zbb(ji  ,jj - 1,jk - 1))*(zti(ji  ,jj + 1,jk -    &    
    344      &                  1) + zti(ji  ,jj + 1,jk  ) - zti(ji  ,jj - 1,jk    &    
    345      &                  ) - zti(ji  ,jj - 1,jk - 1))/(zti(ji  ,jj + 1,jk    &    
    346      &                  - 1) + zti(ji  ,jj + 1,jk  ) + zti(ji  ,jj - 1    &    
    347      &                  ,jk  ) + zti(ji  ,jj - 1,jk - 1) + rtrn))    &    
    348      &                  /(e1t(ji,jj)*e2t(ji,jj)*fse3w(ji,jj,jk))    &    
    349      &                  *umask(ji - 1,jj,jk  )*umask(ji  ,jj  ,jk  )    &    
    350      &                  *umask(ji  ,jj,jk- 1)*umask(ji - 1,jj  ,jk - 1)    &    
    351      &                  *vmask(ji  ,jj- 1,jk)*vmask(ji  ,jj  ,jk  )    &    
    352      &                  *vmask(ji  ,jj  ,jk-1)*vmask(ji  ,jj - 1,jk - 1)        
    353                   END DO 
    354                 END DO 
    355               END DO 
    356  
    357               DO jj = 2,jpjm1 
    358                 DO ji = 2,jpim1 
    359                   zx(ji,jj,1) = zx(ji,jj,1)    &    
    360      &                - 0.5*rdttrc(jk)*rsc*zaa(ji,jj,1)*0.25*    &    
    361      &                ( (zbb(ji  ,jj - 1,1  ) + zbb(ji + 1,jj - 1,1  )    &    
    362      &                + zbb(ji + 1,jj  ,1  ) + zbb(ji  ,jj  ,1  ))    &    
    363      &                *(zti(ji  ,jj + 1,1  ) + zti(ji + 1,jj + 1,1  )    &    
    364      &                - zti(ji + 1,jj - 1,1  ) - zti(ji  ,jj - 1,1  ))    &    
    365      &                /(zti(ji  ,jj + 1,1  ) + zti(ji + 1,jj + 1,1  )    &    
    366      &                + zti(ji + 1,jj - 1,1  ) + zti(ji  ,jj - 1,1  ) +    &    
    367      &                rtrn))/(e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,1))    &    
    368      &                *vmask(ji  ,jj - 1,1  )*vmask(ji + 1,jj - 1,1  )    &    
    369      &                *vmask(ji + 1,jj  ,1  )*vmask(ji  ,jj  ,1  )     
    370  
    371                  zy(ji,jj,1) = zy(ji,jj,1)    &    
    372      &                - 0.5*rdttrc(jk)*rsc*zbb(ji,jj,1)*0.25*    &    
    373      &                ( (zaa(ji-1  ,jj ,1  ) + zaa(ji - 1,jj + 1,1  )    &    
    374      &                + zaa(ji ,jj  ,1  ) + zaa(ji  ,jj + 1  ,1  ))    &    
    375      &                *(zti(ji + 1,jj + 1,1  ) + zti(ji + 1,jj ,1  )    &    
    376      &                - zti(ji - 1,jj + 1,1  ) - zti(ji - 1,jj ,1  ))    &    
    377      &                /(zti(ji + 1,jj + 1,1  ) + zti(ji + 1,jj ,1  )    &    
    378      &                + zti(ji - 1,jj + 1,1  ) + zti(ji - 1,jj ,1  ) +    &    
    379      &                rtrn))/(e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,1))    &    
    380      &                *umask(ji - 1,jj,1  )*umask(ji - 1,jj + 1,1  )    &    
    381      &                *umask(ji    ,jj,1  )*umask(ji  ,jj + 1 ,1  )     
    382  
    383                 END DO 
    384               END DO 
    385           ENDIF 
    386  
    387           ! ... Lateral boundary conditions on z[xyz] 
    388           CALL lbc_lnk( zx, 'U', -1. ) 
    389           CALL lbc_lnk( zy, 'V', -1. ) 
    390           CALL lbc_lnk( zz, 'W',  1. ) 
    391  
    392 ! 2.4 reinitialization 
    393  
    394           DO jk = 1,jpk 
    395             DO jj = 1,jpj 
    396               DO ji = 1,jpi 
    397                 zaa(ji,jj,jk) = zx(ji,jj,jk) 
    398                 zbb(ji,jj,jk) = zy(ji,jj,jk) 
    399                 zcc(ji,jj,jk) = zz(ji,jj,jk) 
    400               END DO 
    401             END DO 
    402           END DO 
    403  
    404 ! 2.5 calcul of the final field: 
    405 !    advection by antidiffusive mass fluxes and an upstream scheme 
    406  
    407           DO jk = 1,jpk 
    408              DO jj = 2,jpjm1 
    409                 DO ji = 2,jpim1 
    410                    zfp_ui = 0.5 * ( zaa(ji,jj,jk) + ABS( zaa(ji,jj,jk) ) ) 
    411                    zfp_vj = 0.5 * ( zbb(ji,jj,jk) + ABS( zbb(ji,jj,jk) ) ) 
    412                    zfm_ui = 0.5 * ( zaa(ji,jj,jk) - ABS( zaa(ji,jj,jk) ) ) 
    413                    zfm_vj = 0.5 * ( zbb(ji,jj,jk) - ABS( zbb(ji,jj,jk) ) )             
    414                    zkx(ji,jj,jk) = zfp_ui * zti(ji,jj,jk) + zfm_ui * zti(ji+1,jj  ,jk)  
    415                    zky(ji,jj,jk) = zfp_vj * zti(ji,jj,jk) + zfm_vj * zti(ji    ,jj+1,jk)              
    416                 END DO 
    417              END DO 
    418           END DO 
    419  
    420           DO jk = 2,jpk 
    421              DO jj = 1,jpj 
    422                 DO ji = 1,jpi 
    423                    zfp_w = 0.5 * ( zcc(ji,jj,jk) + ABS( zcc(ji,jj,jk) ) ) 
    424                    zfm_w = 0.5 * ( zcc(ji,jj,jk) - ABS( zcc(ji,jj,jk) ) )        
    425                    zkz(ji,jj,jk) = zfp_w * zti(ji,jj,jk) + zfm_w * zti(ji,jj,jk-1)      
    426                 END DO 
    427              END DO 
    428           END DO 
    429  
    430  
    431 ! ... Lateral boundary conditions on zk[xy] 
    432       CALL lbc_lnk( zkx, 'U', -1. ) 
    433       CALL lbc_lnk( zky, 'V', -1. ) 
    434  
    435  
    436 ! 2.6. calcul of after field using an upstream advection scheme 
    437  
    438           DO jk = 1,jpkm1 
    439             DO jj = 2,jpjm1 
    440               DO ji = 2,jpim1 
    441                 zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk)) 
    442                 ztj(ji,jj,jk) = -zbtr*     &   
    443      &              ( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk)    &   
    444      &              + zky(ji,jj,jk) - zky(ji,jj - 1,jk)    &   
    445      &              + zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 
     197                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  & 
     198                       &                                        zbtr*( zkx(ji,jj,jk) - zkx(ji-1,jj,jk) ) 
     199 
     200                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  & 
     201                       &                                        zbtr*( zky(ji,jj,jk) - zky(ji,jj-1,jk) ) 
     202 
     203                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  & 
     204                       &                                        zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk+1) ) 
     205#endif 
     206 
     207               END DO 
     208            END DO 
     209         END DO 
     210          
     211         ! 3. Diagnose passive tracer trends (part 1/3) 
     212         ! -------------------------------------------- 
     213 
     214         IF( l_trdtrc ) THEN 
     215            DO jk = 1, jpkm1 
     216               DO jj = 2, jpjm1 
     217                  DO ji = fs_2, fs_jpim1   ! Vector opt. 
     218                     zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk)) 
     219                     ztrtrd(ji,jj,jk,1) = ztrtrd(ji,jj,jk,1) - zbtr*( zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  ) ) 
     220                     ztrtrd(ji,jj,jk,2) = ztrtrd(ji,jj,jk,2) - zbtr*( zky(ji,jj,jk) - zky(ji  ,jj-1,jk  ) ) 
     221                     ztrtrd(ji,jj,jk,3) = ztrtrd(ji,jj,jk,3) - zbtr*( zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1) ) 
     222                  END DO 
     223               END DO 
     224            END DO 
     225         ENDIF 
     226          
     227         ! 4. Antidiffusive correction loop 
     228         ! -------------------------------- 
     229         !                                      ! ----------------------------- 
     230         DO jt = 1, ncortrc                     ! antidiffusive correction loop 
     231            !                                   ! ----------------------------- 
     232             
     233            !--4.1 Compute intermediate field zti 
     234            DO jk = 1, jpkm1 
     235               zti (:,:,jk) = zti (:,:,jk) + rdttrc(jk) * ztj(:,:,jk) 
     236            END DO 
     237            zbuf(:,:,:) = zbuf(:,:,:) + ztj(:,:,:) 
     238             
     239            CALL lbc_lnk( zti, 'T', 1. )    ! lateral boundary 
     240             
     241            !--4.2 Compute the antidiffusive fluxes 
     242            DO jk = 1, jpkm1 
     243               DO jj = 2, jpjm1 
     244                  DO ji = fs_2, fs_jpim1    ! Vector opt. 
     245                     zx(ji,jj,jk) = ( abs(zaa(ji,jj,jk)) - rdttrc(jk)                     & 
     246                          &              *zaa(ji,jj,jk)**2/                               & 
     247                          &              (e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) )       & 
     248                          &              *(zti(ji + 1,jj,jk) - zti( ji ,jj,jk))           & 
     249                          &              /(zti( ji ,jj,jk) + zti(ji + 1,jj,jk) + rtrn)    & 
     250                          &              * rsc 
     251                      
     252                     zy(ji,jj,jk) = ( abs(zbb(ji,jj,jk)) - rdttrc(jk)                     & 
     253                          &              *zbb(ji,jj,jk)**2/                               & 
     254                          &              (e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) )       & 
     255                          &              *(zti(ji,jj + 1,jk) - zti(ji, jj ,jk))           & 
     256                          &              /(zti(ji, jj ,jk) + zti(ji,jj + 1,jk) + rtrn)    & 
     257                          &              * rsc 
     258                  END DO 
     259               END DO 
     260            END DO 
     261             
     262            DO jk = 2, jpkm1 
     263               DO jj = 2, jpjm1 
     264                  DO ji = fs_2, fs_jpim1    ! Vector opt. 
     265                     zz(ji,jj,jk) = ( abs(zcc(ji,jj,jk)) - rdttrc(jk)*zcc(ji,jj,jk)**2    &   
     266                          &              /( e1t(ji,jj)*e2t(ji,jj)*fse3w(ji,jj,jk) ) )     & 
     267                          &               *( zti(ji,jj,jk) - zti(ji,jj,jk - 1) )/         & 
     268                          &                ( zti(ji,jj,jk) + zti(ji,jj,jk - 1) + rtrn )* rsc*( -1.) 
     269                  END DO 
     270               END DO 
     271            END DO 
     272             
     273            !--4.3 Cross terms 
     274            CROSSTERMS: IF( crosster ) THEN 
     275               ! 
     276               DO jk = 2, jpkm1 
     277                  DO jj = 2, jpjm1 
     278                     DO ji = fs_2, fs_jpim1    ! Vector opt. 
     279                        zx(ji,jj,jk) = zx(ji,jj,jk)                                               & 
     280                             &                  - 0.5*rdttrc(jk)*rsc*zaa(ji,jj,jk)*0.25*          & 
     281                             &                  (    (zbb(ji  ,jj - 1,jk  ) + zbb(ji + 1,jj - 1   & 
     282                             &                  ,jk  ) + zbb(ji + 1,jj  ,jk  ) + zbb(ji  ,jj      & 
     283                             &                  ,jk))* (zti(ji  ,jj + 1,jk  ) + zti(ji + 1,jj +   & 
     284                             &                  1,jk  ) - zti(ji + 1,jj - 1,jk  ) - zti(ji  ,jj   & 
     285                             &                  - 1,jk  ))/ (zti(ji  ,jj + 1,jk  ) + zti(ji + 1   & 
     286                             &                  ,jj + 1,jk  ) + zti(ji + 1,jj - 1,jk  ) + zti(ji  & 
     287                             &                  ,jj - 1,jk  ) + rtrn) + (zcc(ji  ,jj  ,jk  ) +    & 
     288                             &                  zcc(ji + 1,jj  ,jk  ) + zcc(ji  ,jj  ,jk + 1) +   & 
     289                             &                  zcc(ji + 1,jj  ,jk + 1))* (zti(ji  ,jj  ,jk - 1)  & 
     290                             &                  + zti(ji + 1,jj  ,jk - 1) - zti(ji  ,jj  ,jk + 1  & 
     291                             &                  )- zti(ji + 1,jj  ,jk + 1))/ (zti(ji  ,jj  ,jk -  & 
     292                             &                  1) + zti(ji + 1,jj  ,jk - 1) + zti(ji  ,jj  ,jk   & 
     293                             &                  +1) + zti(ji + 1,jj  ,jk + 1) + rtrn))/(e1u(ji    & 
     294                             &                  ,jj)*e2u(ji,jj)*fse3u(ji,jj,jk))*vmask(ji  ,jj -  & 
     295                             &                  1,jk  )*vmask(ji + 1,jj - 1,jk  )*vmask(ji + 1    & 
     296                             &                  ,jj,jk)*vmask(ji  ,jj  ,jk  )*tmask(ji  ,jj  ,jk  & 
     297                             &                  )*tmask(ji + 1,jj  ,jk  )*tmask(ji  ,jj  ,jk + 1  & 
     298                             &                  )*tmask(ji + 1,jj  ,jk + 1) 
     299                        zy(ji,jj,jk) = zy(ji,jj,jk)                                               &    
     300                             &                  - 0.5*rdttrc(jk)*rsc*zbb(ji,jj,jk)*0.25*          &    
     301                             &                  (    (zaa(ji - 1,jj  ,jk  ) + zaa(ji - 1,jj + 1   &    
     302                             &                  ,jk  ) + zaa(ji  ,jj  ,jk  ) + zaa(ji  ,jj + 1    &    
     303                             &                  ,jk))* (zti(ji + 1,jj + 1,jk  ) + zti(ji + 1,jj   &    
     304                             &                  ,jk  ) - zti(ji - 1,jj + 1,jk  ) - zti(ji - 1,jj  &    
     305                             &                  ,jk  ))/ (zti(ji + 1,jj + 1,jk  ) + zti(ji + 1    &    
     306                             &                  ,jj  ,jk  ) + zti(ji - 1,jj + 1,jk  ) + zti(ji    &    
     307                             &                  - 1,jj  ,jk  ) + rtrn) + (zcc(ji  ,jj  ,jk  )     &    
     308                             &                  + zcc(ji  ,jj  ,jk + 1) + zcc(ji  ,jj + 1,jk  )   &    
     309                             &                  + zcc(ji  ,jj + 1,jk + 1))* (zti(ji  ,jj  ,jk -   &    
     310                             &                  1) + zti(ji  ,jj + 1,jk - 1) - zti(ji  ,jj  ,jk   &    
     311                             &                  +1) - zti(ji  ,jj + 1,jk + 1))/ (zti(ji  ,jj      &    
     312                             &                  ,jk- 1) + zti(ji  ,jj + 1,jk - 1) + zti(ji  ,jj   &    
     313                             &                  ,jk+ 1) + zti(ji  ,jj + 1,jk + 1) + rtrn))        &    
     314                             &                  /(e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk))          &    
     315                             &                  *umask(ji - 1,jj,jk  )*umask(ji - 1,jj + 1,jk  )  &    
     316                             &                  *umask(ji  ,jj,jk  )*umask(ji  ,jj + 1,jk  )      &    
     317                             &                  *tmask(ji  ,jj,jk)*tmask(ji  ,jj  ,jk + 1)        &    
     318                             &                  *tmask(ji  ,jj + 1,jk)*tmask(ji  ,jj + 1,jk + 1)       
     319                        zz(ji,jj,jk) = zz(ji,jj,jk)                                               &    
     320                             &                  - 0.5*rdttrc(jk)*rsc*zcc(ji,jj,jk)*0.25*          &    
     321                             &                  (    (zaa(ji - 1,jj  ,jk  ) + zaa(ji  ,jj  ,jk    &    
     322                             &                  ) + zaa(ji  ,jj  ,jk - 1) + zaa(ji - 1,jj  ,jk -  &    
     323                             &                  1))*(zti(ji + 1,jj  ,jk - 1) + zti(ji + 1,jj      &    
     324                             &                  ,jk  ) - zti(ji - 1,jj  ,jk  ) - zti(ji - 1,jj    &    
     325                             &                  ,jk - 1))/(zti(ji + 1,jj  ,jk - 1) + zti(ji + 1   &    
     326                             &                  ,jj,jk  ) + zti(ji - 1,jj  ,jk  ) + zti(ji - 1    &    
     327                             &                  ,jj,jk - 1) + rtrn) + (zbb(ji  ,jj - 1,jk  )      &    
     328                             &                  + zbb(ji  ,jj  ,jk  ) + zbb(ji  ,jj  ,jk - 1)     &    
     329                             &                  + zbb(ji  ,jj - 1,jk - 1))*(zti(ji  ,jj + 1,jk -  &    
     330                             &                  1) + zti(ji  ,jj + 1,jk  ) - zti(ji  ,jj - 1,jk   &    
     331                             &                  ) - zti(ji  ,jj - 1,jk - 1))/(zti(ji  ,jj + 1,jk  &    
     332                             &                  - 1) + zti(ji  ,jj + 1,jk  ) + zti(ji  ,jj - 1    &    
     333                             &                  ,jk  ) + zti(ji  ,jj - 1,jk - 1) + rtrn))         &    
     334                             &                  /(e1t(ji,jj)*e2t(ji,jj)*fse3w(ji,jj,jk))          &    
     335                             &                  *umask(ji - 1,jj,jk  )*umask(ji  ,jj  ,jk  )      &    
     336                             &                  *umask(ji  ,jj,jk- 1)*umask(ji - 1,jj  ,jk - 1)   &    
     337                             &                  *vmask(ji  ,jj- 1,jk)*vmask(ji  ,jj  ,jk  )       &    
     338                             &                  *vmask(ji  ,jj  ,jk-1)*vmask(ji  ,jj - 1,jk - 1)        
     339                     END DO 
     340                  END DO 
     341               END DO 
     342                
     343               DO jj = 2,jpjm1 
     344                     DO ji = fs_2, fs_jpim1    ! Vector opt. 
     345                     zx(ji,jj,1) = zx(ji,jj,1)                                                    &    
     346                          &                - 0.5*rdttrc(jk)*rsc*zaa(ji,jj,1)*0.25*                &    
     347                          &                ( (zbb(ji  ,jj - 1,1  ) + zbb(ji + 1,jj - 1,1  )       &    
     348                          &                + zbb(ji + 1,jj  ,1  ) + zbb(ji  ,jj  ,1  ))           &    
     349                          &                *(zti(ji  ,jj + 1,1  ) + zti(ji + 1,jj + 1,1  )        &    
     350                          &                - zti(ji + 1,jj - 1,1  ) - zti(ji  ,jj - 1,1  ))       &    
     351                          &                /(zti(ji  ,jj + 1,1  ) + zti(ji + 1,jj + 1,1  )        &    
     352                          &                + zti(ji + 1,jj - 1,1  ) + zti(ji  ,jj - 1,1  ) +      &    
     353                          &                rtrn))/(e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,1))          &    
     354                          &                *vmask(ji  ,jj - 1,1  )*vmask(ji + 1,jj - 1,1  )       &    
     355                          &                *vmask(ji + 1,jj  ,1  )*vmask(ji  ,jj  ,1  )     
     356                     zy(ji,jj,1) = zy(ji,jj,1)                                                    &    
     357                          &                - 0.5*rdttrc(jk)*rsc*zbb(ji,jj,1)*0.25*                &    
     358                          &                ( (zaa(ji-1  ,jj ,1  ) + zaa(ji - 1,jj + 1,1  )        &    
     359                          &                + zaa(ji ,jj  ,1  ) + zaa(ji  ,jj + 1  ,1  ))          &    
     360                          &                *(zti(ji + 1,jj + 1,1  ) + zti(ji + 1,jj ,1  )         &    
     361                          &                - zti(ji - 1,jj + 1,1  ) - zti(ji - 1,jj ,1  ))        &    
     362                          &                /(zti(ji + 1,jj + 1,1  ) + zti(ji + 1,jj ,1  )         &    
     363                          &                + zti(ji - 1,jj + 1,1  ) + zti(ji - 1,jj ,1  ) +       &    
     364                          &                rtrn))/(e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,1))          &    
     365                          &                *umask(ji - 1,jj,1  )*umask(ji - 1,jj + 1,1  )         &    
     366                          &                *umask(ji    ,jj,1  )*umask(ji  ,jj + 1 ,1  )     
     367                  END DO 
     368               END DO 
     369               ! 
     370            ENDIF CROSSTERMS 
     371            
     372            ! ... Lateral boundary conditions on z[xyz] 
     373            CALL lbc_lnk( zx, 'U', -1. )    ;    CALL lbc_lnk( zy, 'V', -1. ) 
     374            CALL lbc_lnk( zz, 'W',  1. ) 
     375 
     376            !--4.4 Reinitialization 
     377            zaa(:,:,:) = zx(:,:,:) 
     378            zbb(:,:,:) = zy(:,:,:) 
     379            zcc(:,:,:) = zz(:,:,:) 
     380 
     381            ! 5. Advection by antidiffusive mass fluxes & upstream scheme 
     382            ! ----------------------------------------------------------- 
     383             
     384            ! ... Horizontal 
     385            DO jk = 1, jpk 
     386               DO jj = 2, jpjm1 
     387                  DO ji = fs_2, fs_jpim1    ! Vector opt. 
     388                     zfp_ui = 0.5 * ( zaa(ji,jj,jk) + ABS( zaa(ji,jj,jk) ) ) 
     389                     zfp_vj = 0.5 * ( zbb(ji,jj,jk) + ABS( zbb(ji,jj,jk) ) ) 
     390                     zfm_ui = 0.5 * ( zaa(ji,jj,jk) - ABS( zaa(ji,jj,jk) ) ) 
     391                     zfm_vj = 0.5 * ( zbb(ji,jj,jk) - ABS( zbb(ji,jj,jk) ) )             
     392                     zkx(ji,jj,jk) = zfp_ui * zti(ji,jj,jk) + zfm_ui * zti(ji+1,jj  ,jk)  
     393                     zky(ji,jj,jk) = zfp_vj * zti(ji,jj,jk) + zfm_vj * zti(ji  ,jj+1,jk)              
     394                  END DO 
     395               END DO 
     396            END DO 
     397 
     398            ! ... Lateral boundary conditions on zk[xy] 
     399            CALL lbc_lnk( zkx, 'U', -1. ) 
     400            CALL lbc_lnk( zky, 'V', -1. ) 
     401             
     402            ! ... Vertical 
     403            DO jk = 2, jpk 
     404               DO jj = 1, jpj 
     405                  DO ji = fs_2, fs_jpim1    ! Vector opt. 
     406                     zfp_w = 0.5 * ( zcc(ji,jj,jk) + ABS( zcc(ji,jj,jk) ) ) 
     407                     zfm_w = 0.5 * ( zcc(ji,jj,jk) - ABS( zcc(ji,jj,jk) ) )        
     408                     zkz(ji,jj,jk) = zfp_w * zti(ji,jj,jk) + zfm_w * zti(ji,jj,jk-1)      
     409                  END DO 
     410               END DO 
     411            END DO 
     412 
     413            ! ... Compute ztj 
     414            DO jk = 1,jpkm1 
     415               DO jj = 2,jpjm1 
     416                  DO ji = fs_2, fs_jpim1    ! Vector opt. 
     417                     zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk)) 
     418                     ztj(ji,jj,jk) = - zbtr *                                     &   
     419                          &              ( zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )    &   
     420                          &              + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )    &   
     421                          &              + zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1) ) 
    446422#if defined key_trc_diatrd 
    447                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -    &   
    448      &              zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) )    
    449  
    450                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -    &   
    451      &              zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) ) 
    452  
    453                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -    &   
    454      &              zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 
    455 #endif 
    456               END DO 
    457             END DO 
    458           END DO 
    459  
    460 ! 2.6 END of antidiffusive correction loop 
    461  
    462         END DO 
    463  
    464 ! 3. trend due to horizontal and vertical advection of tracer jn 
    465 ! -------------------------------------------------------------- 
    466  
    467         DO jk = 1,jpk 
    468           DO jj = 2,jpjm1 
    469             DO ji = 2,jpim1 
    470               ztra = ( zbuf(ji,jj,jk) + ztj(ji,jj,jk) ) * tmask(ji,jj,jk) 
    471               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    472             END DO 
    473           END DO 
    474         END DO 
    475  
    476 ! 4.0 convert the transport trend into advection trend 
    477 ! ---------------------------------------------------- 
     423                     IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -    & 
     424                          &                                        zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) ) 
     425 
     426                     IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -    & 
     427                          &                                        zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) ) 
     428 
     429                     IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -    & 
     430                          &                                        zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 
     431#endif 
     432 
     433                  END DO 
     434               END DO 
     435            END DO 
     436 
     437            ! 6. Diagnose passive tracer trends (part 2/3) 
     438            ! -------------------------------------------- 
     439            IF( l_trdtrc ) THEN 
     440               DO jk = 1, jpkm1 
     441                  DO jj = 2, jpjm1 
     442                     DO ji = fs_2, fs_jpim1    ! Vector opt. 
     443                        zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk)) 
     444                        ztrtrd(ji,jj,jk,1) = ztrtrd(ji,jj,jk,1) - zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) )    
     445                        ztrtrd(ji,jj,jk,2) = ztrtrd(ji,jj,jk,2) - zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) ) 
     446                        ztrtrd(ji,jj,jk,3) = ztrtrd(ji,jj,jk,3) - zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) ) 
     447                     END DO 
     448                  END DO 
     449               END DO 
     450            ENDIF 
     451            !                            ! ------------------------------------ 
     452         END DO                          ! End of antidiffusive correction loop 
     453         !                               ! ------------------------------------ 
     454 
     455         ! 7. Trend due to horizontal and vertical advection of tracer jn 
     456         ! -------------------------------------------------------------- 
     457          
     458         DO jk = 1, jpk 
     459            DO jj = 2, jpjm1 
     460               DO ji = fs_2, fs_jpim1     ! Vector opt. 
     461                  ztra = ( zbuf(ji,jj,jk) + ztj(ji,jj,jk) ) * tmask(ji,jj,jk) 
     462                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     463               END DO 
     464            END DO 
     465         END DO 
     466 
     467 
     468         ! 8. Convert the transport trend into advection trend (part 3/3) 
     469         ! -------------------------------------------------------------- 
     470 
     471         IF( l_trdtrc ) THEN 
     472            ! ... Update the trends array 
     473            DO jk = 1, jpk 
     474               DO jj = 2, jpjm1 
     475                  DO  ji = fs_2, fs_jpim1 
     476                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     477                     zgm = zbtr * trn(ji,jj,jk,jn) *                                           &   
     478                          &  (   zun(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk)            &   
     479                          &    - zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)  ) 
     480             
     481                     zgz = zbtr * trn(ji,jj,jk,jn) *                                           &   
     482                          &  (   zvn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk)            &   
     483                          &    - zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)  ) 
     484             
     485                     ztrtrd(ji,jj,jk,1) = ztrtrd(ji,jj,jk,1) + zgm 
     486                     ztrtrd(ji,jj,jk,2) = ztrtrd(ji,jj,jk,2) + zgz 
     487                     ztrtrd(ji,jj,jk,3) = ztrtrd(ji,jj,jk,3) - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
     488                  END DO 
     489               END DO 
     490            END DO 
     491  
     492            ! ... Lateral boundary conditions on trtrd: 
     493            CALL lbc_lnk( ztrtrd(:,:,:,1), 'T', 1. ) 
     494            CALL lbc_lnk( ztrtrd(:,:,:,2), 'T', 1. ) 
     495            CALL lbc_lnk( ztrtrd(:,:,:,3), 'T', 1. ) 
     496  
     497            ! ... Miscellaneous trends diagnostics 
     498            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd(:,:,:,1), jn, jptrc_trd_xad, kt ) 
     499            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd(:,:,:,2), jn, jptrc_trd_yad, kt ) 
     500            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd(:,:,:,3), jn, jptrc_trd_zad, kt ) 
     501         ENDIF 
     502 
     503         !  Convert the transport trend into advection trend 
     504         ! --------------------------------------------------- 
    478505 
    479506#if defined key_trc_diatrd 
    480507        DO jk = 1,jpk 
    481508          DO jj = 2,jpjm1 
    482             DO  ji = 2,jpim1 
    483               zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk)) 
    484               zgm = zbtr * trn(ji,jj,jk,jn) *     &   
    485      &            ( zun(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk)    &   
    486      &            -zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)) 
    487  
    488               zgz = zbtr * trn(ji,jj,jk,jn) *     &   
    489      &            ( zvn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk)    &   
    490      &            -zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)) 
    491  
    492               IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) + zgm 
    493               IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) + zgz 
    494               IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3)    &   
    495      &            - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
    496             END DO 
     509             DO ji = fs_2, fs_jpim1     ! Vector opt. 
     510                zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     511                zgm = zbtr * trn(ji,jj,jk,jn) *                                       & 
     512                     &    (  zun(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk)       & 
     513                     &     - zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)    ) 
     514 
     515                zgz = zbtr * trn(ji,jj,jk,jn) *                                       & 
     516                     &    (  zvn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk)       & 
     517                     &     - zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)   ) 
     518 
     519                IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) + zgm 
     520                IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) + zgz 
     521                IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3)         & 
     522                     &                                      - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
     523             END DO 
    497524          END DO 
    498         END DO 
    499  
    500         ! Lateral boundary conditions on trtrd: 
    501  
    502         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),1), 'T', 1. ) 
    503         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),2), 'T', 1. ) 
    504         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),3), 'T', 1. ) 
    505 #endif 
    506  
     525       END DO 
     526 
     527       ! Lateral boundary conditions on trtrd 
     528       IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),1), 'T', 1. ) 
     529       IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),2), 'T', 1. ) 
     530       IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),3), 'T', 1. ) 
     531#endif 
     532 
     533        
     534       !                                                 ! ================== 
     535    END DO                                               ! END of tracer loop 
     536    !                                                    ! ================== 
     537 
     538    IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
    507539  
    508         ! END of tracer loop 
    509         ! ================== 
    510      ENDDO 
    511  
    512       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    513          WRITE(charout, FMT="('smolar - adv')") 
    514          CALL prt_ctl_trc_info(charout) 
    515          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    516       ENDIF 
    517       
     540    IF( ln_ctl ) THEN      ! print mean trends (used for debugging) 
     541       WRITE(charout, FMT="('smolar - adv')") 
     542       CALL prt_ctl_trc_info(charout) 
     543       CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     544    ENDIF 
     545     
    518546  END SUBROUTINE trc_adv_smolar 
    519547 

  • trunk/NEMO/TOP_SRC/TRP/trcadv_tvd.F90

    r1152 r1175  
    11MODULE trcadv_tvd 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  trcadv_tvd  *** 
    44   !! Ocean passive tracers:  horizontal & vertical advective trend 
    5    !!============================================================================== 
     5   !!====================================================================== 
     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 
     11   !!            9.0  !  02-06  (C. Ethe, G. Madec)  F90: Free form and module 
     12   !!                 !  07-02  (C. Deltel) Diagnose ML trends for passive tracers 
     13   !!---------------------------------------------------------------------- 
    614#if defined key_top 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_top'                                                TOP models 
    915   !!---------------------------------------------------------------------- 
    1016   !!   trc_adv_tvd  : update the passive tracer trend with the horizontal 
    … …  
    1420   !!---------------------------------------------------------------------- 
    1521   USE oce_trc             ! ocean dynamics and active tracers variables 
    16    USE trp_trc                 ! ocean passive tracers variables 
     22   USE trc                 ! ocean passive tracers variables 
    1723   USE lbclnk              ! ocean lateral boundary conditions (or mpp link) 
    1824   USE trcbbl              ! advective passive tracers in the BBL 
    1925   USE prtctl_trc      ! Print control for debbuging 
     26   USE trdmld_trc 
     27   USE trdmld_trc_oce      
    2028 
    2129   IMPLICIT NONE 
    2230   PRIVATE 
    2331 
    24    !! * Accessibility 
    2532   PUBLIC trc_adv_tvd    ! routine called by trcstp.F90 
    2633 
    … …  
    2936   !!---------------------------------------------------------------------- 
    3037   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    31    !! $Id$  
    32    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     38   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcadv_tvd.F90,v 1.12 2006/04/10 15:38:54 opalod Exp $  
     39   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3340   !!---------------------------------------------------------------------- 
    3441 
    … …  
    4754      !! 
    4855      !! ** Action : - update tra with the now advective tracer trends 
    49       !!             - save the trends in trtrd ('key_trc_diatrd) 
    50       !! 
    51       !! History : 
    52       !!        !  95-12  (L. Mortier)  Original code 
    53       !!        !  00-01  (H. Loukos)  adapted to ORCA  
    54       !!        !  00-10  (MA Foujols E.Kestenare)  include file not routine 
    55       !!        !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes 
    56       !!        !  01-07  (E. Durand G. Madec)  adaptation to ORCA config 
    57       !!   9.0  !  02-06  (C. Ethe, G. Madec)  F90: Free form and module 
     56      !!             - save the trends ('key_trdmld_trc) 
    5857      !!---------------------------------------------------------------------- 
    59       !! * Modules used 
    6058#if defined key_trcbbl_adv 
    6159      USE oce_trc            , zun => ua,  &  ! use ua as workspace 
    62          &                     zvn => va      ! use va as workspace 
     60           &                   zvn => va      ! use va as workspace 
    6361      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn 
    6462#else 
    6563      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un 
    66                                zvn => vn,  &  !             zvn == vn 
    67                                zwn => wn      !             zwn == wn 
     64           &                   zvn => vn,  &  !             zvn == vn 
     65           &                   zwn => wn      !             zwn == wn 
    6866#endif 
    69       !! * Arguments 
    70       INTEGER, INTENT( in ) ::   kt         ! ocean time-step 
    71  
    72       !! * Local declarations 
    73       INTEGER  ::   ji, jj, jk,jn           ! dummy loop indices 
    74  
    75       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    76          zti, ztu, ztv, ztw                ! temporary workspace 
    77  
    78       REAL(wp) ::   & 
    79          z2dtt, zbtr, zeu, zev, zew, z2, &  ! temporary scalar 
    80          zfp_ui, zfp_vj, zfp_wk,         &  !    "         " 
    81          zfm_ui, zfm_vj, zfm_wk             !    "         " 
    82  
    83 #if defined key_trc_diatrd 
    84        REAL(wp) :: & 
    85           zgm, zgz 
    86 #endif 
    87  
     67      INTEGER, INTENT( in ) ::   kt                        ! ocean time-step 
     68      INTEGER  ::   ji, jj, jk, jn                         ! dummy loop indices 
     69      !! 
     70      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zti, ztw 
     72      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd  ! trends 
     73      !! 
     74      REAL(wp) ::   z_hdivn_x, z_hdivn_y                   ! temporary scalars 
     75      REAL(wp) ::   z2dtt, zbtr, zeu, zev, zew, z2 
     76      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk 
     77      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk 
     78      REAL(wp) ::   zgm, zgz 
    8879      CHARACTER (len=22) :: charout 
    8980      !!---------------------------------------------------------------------- 
    … …  
    9687         WRITE(numout,*) '~~~~~~~~~~~' 
    9788      ENDIF 
     89 
     90      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
    9891 
    9992      IF( neuler == 0 .AND. kt == nittrc000 ) THEN 
    … …  
    111104#endif 
    112105 
    113       DO jn = 1, jptra 
     106      !                                                          ! =========== 
     107      DO jn = 1, jptra                                           ! tracer loop 
     108         !                                                       ! =========== 
     109 
     110         ! ============================================================ 
     111         ! I.              Intermediate advective trends 
     112         ! ============================================================ 
    114113 
    115114         ! 1. Bottom value : flux set to zero 
    116          ! --------------- 
    117          ztu(:,:,jpk) = 0.e0 
    118          ztv(:,:,jpk) = 0.e0 
    119          ztw(:,:,jpk) = 0.e0 
    120          zti(:,:,jpk) = 0.e0 
    121  
    122  
    123          ! 2. upstream advection with initial mass fluxes & intermediate update 
     115         ! ---------------------------------- 
     116         ztu(:,:,jpk) = 0.e0    ;    ztv(:,:,jpk) = 0.e0 
     117         ztw(:,:,jpk) = 0.e0    ;    zti(:,:,jpk) = 0.e0 
     118 
     119 
     120         ! 2. Upstream advection with initial mass fluxes & intermediate update 
    124121         ! -------------------------------------------------------------------- 
    125          ! upstream tracer flux in the i and j direction 
     122 
     123         ! ... Upstream tracer flux in the i and j direction 
    126124         DO jk = 1, jpkm1 
    127125            DO jj = 1, jpjm1 
    128126               DO ji = 1, fs_jpim1   ! vector opt. 
     127               !??? CD DO ji = fs_2, fs_jpim1    ! Vector opt. 
    129128                  zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk) 
    130129                  zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk) 
    131                   ! upstream scheme 
    132                   zfp_ui = zeu + ABS( zeu ) 
     130                  zfp_ui = zeu + ABS( zeu )   ! upstream scheme 
    133131                  zfm_ui = zeu - ABS( zeu ) 
    134132                  zfp_vj = zev + ABS( zev ) 
    … …  
    140138         END DO 
    141139 
    142          ! upstream tracer flux in the k direction 
     140         ! ... Upstream tracer flux in the k direction 
    143141         ! Surface value 
    144142         IF( lk_dynspg_rl ) THEN   ! rigid lid : flux set to zero 
    … …  
    156154         DO jk = 2, jpkm1 
    157155            DO jj = 1, jpj 
    158                DO ji = 1, jpi 
     156               DO ji = 1, jpi   ! CD ??? Vector opt.  
    159157                  zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * zwn(ji,jj,jk) 
    160158                  zfp_wk = zew + ABS( zew ) 
    … …  
    165163         END DO 
    166164 
    167          ! total advective trend 
     165         ! ... Total intermediate advective trend (flux divergence) 
    168166         DO jk = 1, jpkm1 
    169167            DO jj = 2, jpjm1 
    … …  
    173171                     &              + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   & 
    174172                     &              + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr 
    175  
    176173#if defined key_trc_diatrd 
    177174                  IF ( luttrd(jn) ) & 
    178175                     trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  & 
    179                         &                          zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) )                      
     176                        &                          zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) 
    180177                  IF ( luttrd(jn) ) & 
    181178                     trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  & 
    182                         &                          zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )                      
     179                        &                          zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 
    183180                  IF ( luttrd(jn) ) & 
    184181                     trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  & 
    … …  
    188185            END DO 
    189186         END DO 
    190  
    191  
    192          ! update and guess with monotonic sheme 
     187          
     188         ! 3. Save the intermediate i / j / k advective trends for diagnostics 
     189         ! ------------------------------------------------------------------- 
     190 
     191!CDIR BEGIN COLLAPSE 
     192         IF( l_trdtrc ) THEN 
     193 
     194            ! 3.1) Passive tracer ZONAL advection trends 
     195            ztrtrd(:,:,:) = 0.e0 
     196 
     197            DO jk = 1, jpkm1 
     198               DO jj = 2, jpjm1 
     199                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     200 
     201                     !-- Compute zonal divergence by splitting hdivn (see divcur.F90) 
     202                     !   N.B. This computation is not valid along OBCs (if any) 
     203                     zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     204                     z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * un(ji  ,jj,jk)          & 
     205                          &       - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) ) * zbtr 
     206 
     207                     !-- Compute zonal advection trends 
     208                     ztrtrd(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr & 
     209                          &             + trb(ji,jj,jk,jn) * z_hdivn_x 
     210                  END DO 
     211               END DO 
     212            END DO 
     213 
     214            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_xad, kt)    ! save the trends 
     215 
     216            ! 3.2) Passive tracer MERIDIONAL advection trends 
     217            ztrtrd(:,:,:) = 0.e0 
     218  
     219            DO jk = 1, jpkm1 
     220               DO jj = 2, jpjm1 
     221                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     222 
     223                     !-- Compute merid. divergence by splitting hdivn (see divcur.F90) 
     224                     !   N.B. This computation is not valid along OBCs (if any) 
     225                     zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     226                     z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)          & 
     227                          &       - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk) ) * zbtr 
     228 
     229                     !-- Compute merid. advection trends 
     230                     ztrtrd(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr & 
     231                          &             + trb(ji,jj,jk,jn) * z_hdivn_y 
     232                  END DO 
     233               END DO 
     234            END DO 
     235 
     236            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_yad, kt)     ! save the trends 
     237 
     238            ! 3.3) Passive tracer VERTICAL advection trends 
     239            ztrtrd(:,:,:) = 0.e0 
     240            DO jk = 1, jpkm1 
     241               DO jj = 2, jpjm1 
     242                  DO ji = fs_2, fs_jpim1   ! Vector opt. 
     243                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     244                     ztrtrd(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr   & 
     245                          &             - trb(ji,jj,jk,jn) * hdivn(ji,jj,jk) 
     246                  END DO 
     247               END DO 
     248            END DO 
     249 
     250            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt)     ! save the trends 
     251 
     252         ENDIF 
     253!CDIR END 
     254 
     255         ! 4. Update and guess with monotonic sheme 
     256         ! ---------------------------------------- 
    193257         DO jk = 1, jpkm1 
    194258            z2dtt = z2 * rdttra(jk) * FLOAT(ndttrc) 
    … …  
    201265         END DO 
    202266 
    203          ! Lateral boundary conditions on zti, zsi   (unchanged sign) 
     267         ! 5. Lateral boundary conditions on zti, zsi (unchanged sign) 
     268         ! ----------------------------------------------------------- 
    204269         CALL lbc_lnk( zti, 'T', 1. ) 
    205270 
    206          ! 3. antidiffusive flux : high order minus low order 
     271 
     272         ! ============================================================ 
     273         ! II.              Corrected advective trends 
     274         ! ============================================================ 
     275 
     276         ! 1. Antidiffusive flux : high order minus low order 
    207277         ! -------------------------------------------------- 
    208          ! antidiffusive flux on i and j 
     278         ! Antidiffusive flux on i and j 
    209279         DO jk = 1, jpkm1 
    210280            DO jj = 1, jpjm1 
    … …  
    218288         END DO 
    219289 
    220          ! antidiffusive flux on k 
    221          ! Surface value 
    222          ztw(:,:,1) = 0. 
    223  
    224          ! Interior value 
    225          DO jk = 2, jpkm1 
     290         ! Antidiffusive flux on k 
     291         ztw(:,:,1) = 0.e0    ! surface value 
     292         DO jk = 2, jpkm1     ! interior value 
    226293            DO jj = 1, jpj 
    227294               DO ji = 1, jpi 
    … …  
    237304         CALL lbc_lnk( ztw, 'W',  1. ) 
    238305 
    239          ! 4. monotonicity algorithm 
     306         ! 2. Monotonicity algorithm 
    240307         ! ------------------------- 
    241308         CALL nonosc( trb(:,:,:,jn), ztu, ztv, ztw, zti, z2 ) 
    242309 
    243310 
    244          ! 5. final trend with corrected fluxes 
     311         ! 3. Final trend with corrected fluxes 
    245312         ! ------------------------------------ 
    246313         DO jk = 1, jpkm1 
    … …  
    248315               DO ji = fs_2, fs_jpim1   ! vector opt. 
    249316                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     317                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)   & 
     318                     &         - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   & 
     319                     &           + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   & 
     320                     &           + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr 
    250321#if defined key_trc_diatrd 
    251322                  IF ( luttrd(jn) ) & 
    252323                     trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  & 
    253                         &                          zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) )                      
     324                        &                          zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) 
    254325                  IF ( luttrd(jn) ) & 
    255326                     trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  & 
    256                         &                          zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )                      
     327                        &                          zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 
    257328                  IF ( luttrd(jn) ) & 
    258329                     trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  & 
    259330                        &                          zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) 
    260331#endif 
    261                   tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)   & 
    262                      &         - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   & 
    263                      &           + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   & 
    264                      &           + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr 
    265                END DO 
    266             END DO 
    267          END DO 
    268          ! 6.0 convert the transport trend into advection trend 
    269          ! ---------------------------------------------------- 
    270           
     332 
     333               END DO 
     334            END DO 
     335         END DO 
     336 
    271337#if defined key_trc_diatrd 
    272338         DO jk = 1,jpk 
    … …  
    277343                     &         (  zun(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk)    & 
    278344                     &          - zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) ) 
    279                    
     345 
    280346                  zgz = zbtr * trn(ji,jj,jk,jn) *     & 
    281347                     &         (  zvn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk)    & 
    282348                     &          - zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) ) 
    283                    
     349 
    284350                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) + zgm 
    285351                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) + zgz 
    … …  
    289355            END DO 
    290356         END DO 
    291           
     357 
    292358         ! Lateral boundary conditions on trtrd: 
    293           
     359 
    294360         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),1), 'T', 1. ) 
    295361         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),2), 'T', 1. ) 
    … …  
    297363#endif 
    298364 
     365         ! 4. Save the advective trends for diagnostics 
     366         ! -------------------------------------------- 
     367         ! Warning : mass fluxes should probably be converted into advection  
     368         ! terms in the computations below ??? 
     369 
     370!CDIR BEGIN COLLAPSE 
     371         IF( l_trdtrc ) THEN 
     372             
     373            ! 4.1) Passive tracer ZONAL advection trends 
     374            ztrtrd(:,:,:) = 0.e0 
     375            DO jk = 1, jpkm1 
     376               DO jj = 2, jpjm1 
     377                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     378                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     379                     ztrtrd(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr 
     380                  END DO 
     381               END DO 
     382            END DO 
     383             
     384            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_xad, kt)   ! <<< ADD TO PREVIOUSLY COMPUTED 
     385 
     386            ! 4.2) Passive tracer MERIDIONAL advection trends 
     387            ztrtrd(:,:,:) = 0.e0 
     388            DO jk = 1, jpkm1 
     389               DO jj = 2, jpjm1 
     390                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     391                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     392                     ztrtrd(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr  
     393                  END DO 
     394               END DO 
     395            END DO 
     396             
     397            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_yad, kt)   ! <<< ADD TO PREVIOUSLY COMPUTED 
     398             
     399            ! 4.3) Passive tracer VERTICAL advection trends 
     400            ztrtrd(:,:,:) = 0.e0 
     401            DO jk = 1, jpkm1 
     402               DO jj = 2, jpjm1 
     403                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     404                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     405                     ztrtrd(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr 
     406                  END DO 
     407               END DO 
     408            END DO 
     409             
     410            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt)   ! <<< ADD TO PREVIOUSLY COMPUTED 
     411             
     412         ENDIF 
     413!CDIR END 
     414 
     415 
    299416      END DO 
     417 
     418      IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
    300419 
    301420      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    325444      !!        !  00-02  (H. Loukos)  rewritting for opa8 
    326445      !!        !  00-10  (M.A Foujols, E. Kestenare)  lateral b.c. 
     446      !!        !  01-03  (E. Kestenare)  add key_passivetrc 
    327447      !!        !  01-07  (E. Durand G. Madec)  adapted for T & S 
    328448      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    … …  
    342462      INTEGER ::   ikm1 
    343463      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo 
    344       REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, z2dtt 
     464      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt 
    345465      !!---------------------------------------------------------------------- 
    346466 
    347467      zbig = 1.e+40 
     468      zrtrn = 1.e-15 
    348469      zbetup(:,:,:) = 0.e0   ;   zbetdo(:,:,:) = 0.e0 
    349470 
    … …  
    409530               ! up & down beta terms 
    410531               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt 
    411                zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+rtrn) * zbt 
    412                zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+rtrn) * zbt 
     532               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 
     533               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt 
    413534            END DO 
    414535         END DO 

  • trunk/NEMO/TOP_SRC/TRP/trcbbc.F90

    r1152 r1175  
    44   !! Ocean passive tracers:  bottom boundary condition 
    55   !!====================================================================== 
    6 #if  defined key_top  &&  defined key_trcbbc 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_top' and 'key_trcbbc'       TOP model and geothermal heat flux 
     6   !! History :  8.1  !  99-10  (G. Madec)  original code 
     7   !!            8.5  !  02-08  (G. Madec)  free form + modules 
     8   !!                 !  02-11  (A. Bozec)  trc_bbc_init 
     9   !!            9.0  !  04-03  (C. Ethe)  adpated for passive tracers 
     10   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     11   !!---------------------------------------------------------------------- 
     12#if defined key_top && defined key_trcbbc 
     13   !!---------------------------------------------------------------------- 
     14   !!   'key_trcbbc'                                  geothermal heat flux 
    915   !!---------------------------------------------------------------------- 
    1016   !!   trc_bbc      : update the tracer trend at ocean bottom  
    1117   !!   trc_bbc_init : initialization of geothermal heat flux trend 
    1218   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1419   USE oce_trc             ! ocean dynamics and active tracers variables 
    15    USE trp_trc                 ! ocean passive tracers variables 
     20   USE trc                 ! ocean passive tracers variables 
    1621   USE prtctl_trc          ! Print control for debbuging 
    17   
     22   USE trdmld_trc 
     23   USE trdmld_trc_oce      
     24 
    1825   IMPLICIT NONE 
    1926   PRIVATE 
    2027 
    21    !! * Accessibility 
    2228   PUBLIC trc_bbc          ! routine called by trcstp.F90 
    2329 
    24    !! to be transfert in the namelist ???!    
     30   !! >>>>>>>>>>>>>>>>>>>>>>>>> MOVE TO NAMELIST >>>>>>>>>>>>>>>>>>>>>>>>>> 
    2531   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbc = .TRUE.   !: bbc flag 
    26  
    27    !! * Module variables 
    28    INTEGER ::                       & !!! ** bbc namelist (nambbc) ** 
    29       ngeo_trc_flux = 1                    ! Geothermal flux (0:no flux, 1:constant flux, 
    30       !                                !                  2:read in file ) 
    31    REAL(wp) ::                      & !!! ** bbc namlist ** 
    32       ngeo_trc_flux_const = 86.4e-3        ! Constant value of geothermal heat flux 
    33  
    34    INTEGER, DIMENSION(jpi,jpj) ::   & 
    35       nbotlevt                         ! ocean bottom level index at T-pt 
    36    REAL(wp), DIMENSION(jpi,jpj) ::  & 
    37       qgh_trd                          ! geothermal heating trend 
    38   
     32    
     33   INTEGER ::   ngeo_trc_flux = 1              !!! ** bbc namelist (nambbc) ** 
     34   !                                           ! Geothermal flux (0:no flux, 1:constant flux, 
     35   !                                           !                  2:read in file ) 
     36   REAL(wp) ::   ngeo_trc_flux_const = 86.4e-3 !!! ** bbc namlist ** 
     37   !                                           ! Constant value of geothermal heat flux 
     38 
     39   INTEGER, DIMENSION(jpi,jpj) ::   nbotlevt   ! ocean bottom level index at T-pt 
     40   REAL(wp), DIMENSION(jpi,jpj) ::   qgh_trd   ! geothermal heating trend 
     41   !! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     42 
    3943   !! * Substitutions 
    4044#  include "top_substitute.h90" 
    4145   !!---------------------------------------------------------------------- 
    4246   !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    43    !! $Id$  
    44    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     47   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcbbc.F90,v 1.11 2006/09/12 11:10:13 opalod Exp $  
     48   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4549   !!---------------------------------------------------------------------- 
    4650 
    … …  
    6872      !! References : 
    6973      !!      Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129. 
    70       !! 
    71       !! History : 
    72       !!   8.1  !  99-10  (G. Madec)  original code 
    73       !!   8.5  !  02-08  (G. Madec)  free form + modules 
    74       !!   9.0  !  04-03  (C. Ethe)  adpated for passive tracers 
    75       !!---------------------------------------------------------------------- 
    76       !! * Arguments 
    77       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    78  
    79       !! * Local declarations 
     74      !!---------------------------------------------------------------------- 
     75      INTEGER, INTENT( in ) ::   kt                         ! ocean time-step index 
     76 
    8077#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    81       INTEGER ::   ji, jn                  ! dummy loop indices 
    82 #else 
    83       INTEGER ::   ji, jj, jn              ! dummy loop indices 
    84 #endif 
    85       REAL(wp) ::   ztra                ! temporary scalar 
     78      INTEGER ::   ji, jn                                   ! dummy loop indices 
     79#else 
     80      INTEGER ::   ji, jj, jn                               ! dummy loop indices 
     81#endif 
     82      REAL(wp) ::   ztra                                    ! temporary scalar 
    8683      CHARACTER (len=22) :: charout 
     84      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd   ! trends 
    8785      !!---------------------------------------------------------------------- 
    8886 
    8987      ! 0. Initialization 
     88      ! ----------------- 
     89 
    9090      IF( kt == nittrc000 )   CALL trc_bbc_init 
    9191 
     92      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     93 
     94 
    9295      ! 1. Add the geothermal heat flux trend on temperature 
     96      ! ---------------------------------------------------- 
    9397 
    9498      SELECT CASE ( ngeo_trc_flux ) 
    … …  
    96100      CASE ( 1:2 )                !  geothermal heat flux 
    97101 
    98          DO jn = 1, jptra 
     102         !                                                       ! =========== 
     103         DO jn = 1, jptra                                        ! tracer loop 
     104            !                                                    ! =========== 
     105!CDIR COLLAPSE 
     106            IF( l_trdtrc )  ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
     107 
     108 
    99109#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    100110            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    … …  
    108118            END DO 
    109119#endif 
    110          END DO 
    111  
    112          IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     120             
     121            IF( l_trdtrc ) THEN 
     122!CDIR COLLAPSE 
     123               ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     124               IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_bbc, kt) 
     125            END IF 
     126 
     127            !                                                    ! =========== 
     128         END DO                                                  ! tracer loop 
     129         !                                                       ! =========== 
     130 
     131         IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
     132 
     133         IF( ln_ctl ) THEN     ! print mean trends (used for debugging) 
    113134            WRITE(charout, FMT="('bbc')") 
    114135            CALL prt_ctl_trc_info(charout) 
    … …  
    128149      !!      bottom ocean level 
    129150      !! 
    130       !! ** Method  :   Read the namtrabbc namelist and check the parameters. 
     151      !! ** Method  :   Read the namtopbbc namelist and check the parameters. 
    131152      !!      called at the first time step (nittrc000) 
    132153      !! 
    133       !! ** Input   : - Namlist namtrcbbc 
     154      !! ** Input   : - Namlist namtopbbc 
    134155      !!              - NetCDF file  : passivetrc_geothermal_heating.nc  
    135156      !!                               ( if necessary ) 
    … …  
    137158      !! ** Action  : - compute the heat geothermal trend qgh_trd 
    138159      !!              - compute the bottom ocean level nbotlevt 
    139       !! 
    140       !! history : 
    141       !!  8.5  ! 02-11 (A. Bozec) original code 
    142       !!---------------------------------------------------------------------- 
    143       !! * Modules used 
     160      !!---------------------------------------------------------------------- 
    144161      USE iom 
    145162 
    146       !! * local declarations 
    147163      CHARACTER (len=32) ::   clname 
    148164      INTEGER  ::   ji, jj              ! dummy loop indices 
    149165      INTEGER  ::   inum = 11           ! temporary logical unit 
    150166 
    151       NAMELIST/namtrcbbc/ngeo_trc_flux, ngeo_trc_flux_const  
     167      NAMELIST/namtopbbc/ngeo_trc_flux, ngeo_trc_flux_const  
    152168      !!---------------------------------------------------------------------- 
    153169 
    154170      ! Read Namelist nambbc : bottom momentum boundary condition 
    155       REWIND ( numnamtra ) 
    156       READ   ( numnamtra, namtrcbbc ) 
     171      REWIND ( numnat ) 
     172      READ   ( numnat, namtopbbc ) 
    157173 
    158174      ! Control print 

  • trunk/NEMO/TOP_SRC/TRP/trcbbl.F90

    r1152 r1175  
    11MODULE trcbbl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  trcbbl  *** 
    44   !! Ocean passive tracers physics :  advective and/or diffusive bottom boundary  
    55   !!                                  layer scheme 
    6    !!============================================================================== 
    7 #if  defined key_top && ( defined key_trcbbl_dif   ||   defined key_trcbbl_adv ) && ! defined key_c1d 
    8    !!---------------------------------------------------------------------- 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_top'         and                                    TOP models 
    11    !!   'key_trcbbl_dif'   or               diffusive bottom boundary layer 
    12    !!   'key_trcbbl_adv'                    advective bottom boundary layer 
     6   !!====================================================================== 
     7   !! History :  8.0  !  96-06  (L. Mortier)  Original code 
     8   !!            8.0  !  97-11  (G. Madec)  Optimization 
     9   !!            8.5  !  02-08  (G. Madec)  free form + modules 
     10   !!            9.0  !  04-03  (C. Ethe)   Adaptation for passive tracers 
     11   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     12   !!---------------------------------------------------------------------- 
     13#if  defined key_top && ( defined key_trcbbl_dif   ||   defined key_trcbbl_adv ) && ! defined key_cfg_1d 
     14   !!---------------------------------------------------------------------- 
     15   !!   'key_trcbbl_dif'   or            diffusive bottom boundary layer 
     16   !!   'key_trcbbl_adv'                 advective bottom boundary layer 
    1317   !!---------------------------------------------------------------------- 
    1418   !!   trc_bbl_dif  : update the passive tracer trends due to the bottom 
    … …  
    1721   !!                  boundary layer (advective and/or diffusive) 
    1822   !!---------------------------------------------------------------------- 
    19    !! * Modules used 
    2023   USE oce_trc             ! ocean dynamics and active tracers variables 
    21    USE trp_trc                 ! ocean passive tracers variables 
    22    USE trctrp_lec      ! passive tracers transport 
     24   USE trc                 ! ocean passive tracers variables 
     25   USE trctrp_lec          ! passive tracers transport 
    2326   USE prtctl_trc          ! Print control for debbuging 
    2427   USE eosbn2 
    2528   USE lbclnk 
     29   USE trdmld_trc 
     30   USE trdmld_trc_oce      
    2631 
    2732   IMPLICIT NONE 
    2833   PRIVATE 
    2934 
    30    !! * Routine accessibility 
    3135   PUBLIC trc_bbl_dif    ! routine called by step.F90 
    3236   PUBLIC trc_bbl_adv    ! routine called by step.F90 
    3337 
    34    !! * Shared module variables 
    3538# if defined key_trcbbl_dif 
    36    LOGICAL, PUBLIC, PARAMETER ::    &  !: 
    37       lk_trcbbl_dif = .TRUE.   !: advective bottom boundary layer flag 
    38  
     39   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_dif = .TRUE.   !: diffusive bottom boundary layer flag 
    3940# else 
    40    LOGICAL, PUBLIC, PARAMETER ::    &  !: 
    41       lk_trcbbl_dif = .FALSE.  !: advective bottom boundary layer flag 
     41   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_dif = .FALSE.  !: diffusive bottom boundary layer flag 
    4242# endif 
    4343 
    4444# if defined key_trcbbl_adv 
    45    LOGICAL, PUBLIC, PARAMETER ::    &  !: 
    46       lk_trcbbl_adv = .TRUE.   !: advective bottom boundary layer flag 
    47    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    48        u_trc_bbl, v_trc_bbl, &  !: velocity involved in exhanges in the advective BBL 
    49        w_trc_bbl                !: vertical increment of velocity due to advective BBL 
    50        !                        !  only affect tracer vertical advection 
     45   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_adv = .TRUE.   !: advective bottom boundary layer flag 
     46   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   u_trc_bbl  !: veloc. involved in the advective BBL 
     47   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   v_trc_bbl  !: veloc. involved in the advective BBL 
     48   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   w_trc_bbl  !: vertic. increment of veloc. due to adv. BBL 
     49   !                                                        !  only affect tracer vertical advection 
    5150# else 
    52    LOGICAL, PUBLIC, PARAMETER ::    &  !: 
    53       lk_trcbbl_adv = .FALSE.  !: advective bottom boundary layer flag 
     51   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_adv = .FALSE.  !: advective bottom boundary layer flag 
    5452# endif 
    5553 
    56    !! * Module variables 
    57    INTEGER, DIMENSION(jpi,jpj) ::   &  !: 
    58       mbkt, mbku, mbkv                 ! ??? 
    59  
     54   INTEGER, DIMENSION(jpi,jpj) ::   mbkt, mbku, mbkv 
    6055 
    6156   !! * Substitutions 
    … …  
    6358   !!---------------------------------------------------------------------- 
    6459   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    65    !! $Id$  
    66    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     60   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcbbl.F90,v 1.12 2006/09/12 11:10:13 opalod Exp $  
     61   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6762   !!---------------------------------------------------------------------- 
    6863 
    … …  
    10499      !! References : 
    105100      !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
     101      !!---------------------------------------------------------------------- 
     102      USE oce_trc, ONLY :   ztrtrd => ua                      ! use ua as 3D workspace    
    106103      !! 
    107       !! History : 
    108       !!   8.0  !  96-06  (L. Mortier)  Original code 
    109       !!   8.0  !  97-11  (G. Madec)  Optimization 
    110       !!   8.5  !  02-08  (G. Madec)  free form + modules 
    111       !!   9.0  !  04-03  (C. Ethe)   Adaptation for passive tracers 
    112       !!---------------------------------------------------------------------- 
    113       !! * Arguments  
    114       INTEGER, INTENT( in ) ::   kt         ! ocean time-step 
    115  
    116       !! * Local declarations 
    117       INTEGER ::   ji, jj,jn                ! dummy loop indices 
    118       INTEGER ::   ik 
    119       INTEGER ::   ii0, ii1, ij0, ij1       ! temporary integers 
    120       INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers 
    121       REAL(wp) ::   ze3u, ze3v              ! temporary scalars 
    122       INTEGER ::   iku, ikv 
    123       REAL(wp) ::   & 
    124          zsign, zt, zs, zh, zalbet,      &  ! temporary scalars 
    125          zgdrho, zbtr, ztra 
    126       REAL(wp), DIMENSION(jpi,jpj) ::    & 
    127         zki, zkj, zkx, zky,    &  ! temporary workspace arrays 
    128         ztnb, zsnb, zdep,                & 
    129         ztrb, zahu, zahv 
     104      INTEGER, INTENT( in ) ::   kt                         ! ocean time-step 
     105      INTEGER ::   ji, jj, jn                               ! dummy loop indices 
     106      INTEGER ::   ik, iku, ikv 
     107      INTEGER ::   ii0, ii1, ij0, ij1                       ! temporary integers 
     108      INTEGER ::   iku1, iku2, ikv1, ikv2                   ! temporary intergers 
     109      REAL(wp) ::   ze3u, ze3v                              ! temporary scalars 
     110      REAL(wp) ::   zsign, zt, zs, zh, zalbet 
     111      REAL(wp) ::   zgdrho, zbtr, ztra 
     112      REAL(wp), DIMENSION(jpi,jpj) ::   zki, zkj, zkx, zky  ! temporary workspace arrays 
     113      REAL(wp), DIMENSION(jpi,jpj) ::   ztnb, zsnb, zdep 
     114      REAL(wp), DIMENSION(jpi,jpj) ::   ztrb, zahu, zahv 
     115 
    130116      CHARACTER (len=22) :: charout 
    131       REAL(wp) ::   & 
    132          fsalbt, pft, pfs, pfh              ! statement function 
     117      REAL(wp) ::   fsalbt, pft, pfs, pfh                   ! statement function 
    133118      !!---------------------------------------------------------------------- 
    134119      ! ratio alpha/beta 
    … …  
    214199#   endif 
    215200         END DO 
    216      ENDIF 
    217  
    218 !! 
    219 !!     OFFLINE VERSION OF DIFFUSIVE BBL 
    220 !! 
     201      ENDIF 
     202 
    221203#if defined key_off_tra 
    222  
     204      !!===================================================================== 
     205      !!                I. OFFLINE VERSION OF DIFFUSIVE BBL 
     206      !!===================================================================== 
     207       
     208      ! 1. Criteria of additional bottom diffusivity : grad(rho).grad(h) < 0 
     209      ! -------------------------------------------------------------------- 
     210       
     211      !    Only used in the online version of diffusive BBL (see below) 
     212       
    223213      ! 2. Additional second order diffusive trends 
    224214      ! ------------------------------------------- 
    225  
    226       DO jn = 1, jptra 
    227          ! first derivative (gradient) 
    228           
     215      !                                                          ! =========== 
     216      DO jn = 1, jptra                                           ! tracer loop 
     217         !                                                       ! ===========        
     218 
     219         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) 
     220      
     221         ! first derivative (gradient)          
    229222#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    230223         jj = 1 
    … …  
    254247#  endif 
    255248         END DO 
    256 !! 
    257 !!  ONLINE VERSION OF DIFFUSIVE BBL 
    258 !! 
     249 
    259250#else 
    260       ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0 
    261       ! -------------------------------------------- 
     251      !!===================================================================== 
     252      !!               II. ONLINE VERSION OF DIFFUSIVE BBL 
     253      !!===================================================================== 
     254 
     255      ! 1. Criteria of additional bottom diffusivity : grad(rho).grad(h) < 0 
     256      ! -------------------------------------------------------------------- 
    262257      ! Sign of the local density gradient along the i- and j-slopes 
    263258      ! multiplied by the slope of the ocean bottom 
    264    SELECT CASE ( neos ) 
    265  
    266          CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    267  
     259      SELECT CASE ( neos ) 
     260 
     261      CASE ( 0 )                 ! Jackett and McDougall (1994) formulation 
     262          
    268263#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    269264      jj = 1 
    … …  
    313308#  endif 
    314309      END DO 
    315  
    316    CASE ( 1 )               ! Linear formulation function of temperature only 
     310       
     311      CASE ( 1 )                 ! Linear formulation function of temperature only 
    317312 
    318313#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    … …  
    351346      END DO 
    352347 
    353       CASE ( 2 )               ! Linear formulation function of temperature and salinity 
     348      CASE ( 2 )                 ! Linear formulation function of temperature and salinity 
    354349 
    355350      DO jj = 1, jpjm1 
    … …  
    375370      END DO 
    376371 
    377  
    378372      CASE DEFAULT 
    379373 
    … …  
    385379      ! 2. Additional second order diffusive trends 
    386380      ! ------------------------------------------- 
    387  
    388       DO jn = 1, jptra 
     381      !                                                          ! =========== 
     382      DO jn = 1, jptra                                           ! tracer loop 
     383         !                                                       ! =========== 
     384         IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn) 
     385 
    389386         ! first derivative (gradient) 
    390  
    391387#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    392388         jj = 1 
    … …  
    416412         END DO 
    417413#endif 
     414 
     415      !!===================================================================== 
     416      !!     III. COMMON CODE FOR OFFLINE/ONLINE VERSIONS OF DIFFUSIVE BBL 
     417      !!===================================================================== 
    418418 
    419419         IF( cp_cfg == "orca" ) THEN 
    420420             
    421421            SELECT CASE ( jp_cfg ) 
    422                !                                           ! ======================= 
     422               !                                        ! ======================= 
    423423            CASE ( 2 )                                  !  ORCA_R2 configuration 
    424424               !                                        ! ======================= 
    … …  
    466466         END DO 
    467467 
    468       END DO 
    469  
    470       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     468         ! save the trends for diagnostic 
     469         IF( l_trdtrc ) THEN 
     470            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     471            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_bbl, kt ) 
     472         END IF 
     473         !                                                       ! =========== 
     474      END DO                                                     ! tracer loop 
     475      !                                                          ! =========== 
     476 
     477      IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    471478         WRITE(charout, FMT="('bbl - dif')") 
    472479         CALL prt_ctl_trc_info(charout) 
    … …  
    496503      !! 
    497504      !! ** Purpose :   Initialization for the bottom boundary layer scheme. 
    498       !! 
    499       !! 
    500       !! History : 
    501       !!    8.5  !  02-08  (G. Madec)  Original code 
    502       !!---------------------------------------------------------------------- 
    503       !! * Local declarations 
    504       INTEGER ::   ji, jj      ! dummy loop indices 
    505  
    506       REAL(wp),  DIMENSION(jpi,jpj) :: zmbk   
    507  
     505      !!---------------------------------------------------------------------- 
     506      INTEGER ::   ji, jj 
     507      REAL(wp),  DIMENSION(jpi,jpj) ::   zmbk   
    508508      !!---------------------------------------------------------------------- 
    509509 

  • trunk/NEMO/TOP_SRC/TRP/trcdmp.F90

    r1152 r1175  
    44   !! Ocean physics: internal restoring trend on passive tracers 
    55   !!====================================================================== 
    6 #if  defined key_top  &&  defined key_trcdmp  
     6   !! History :  7.0  !         (G. Madec)  Original code 
     7   !!                 !  96-01  (G. Madec)  
     8   !!                 !  97-05  (H. Loukos)  adapted for passive tracers 
     9   !!            8.5  !  02-08  (G. Madec )  free form + modules 
     10   !!            9.0  !  04-03  (C. Ethe)    free form + modules 
     11   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
    712   !!---------------------------------------------------------------------- 
    8    !!   'key_top'                                                TOP models 
    9    !!   'key_trcdmp'                                       internal damping 
     13#if  defined key_top && defined key_trcdmp  
     14   !!---------------------------------------------------------------------- 
     15   !!   key_trcdmp                                         internal damping 
    1016   !!---------------------------------------------------------------------- 
    1117   !!   trc_dmp      : update the tracer trend with the internal damping 
    … …  
    1622   !!---------------------------------------------------------------------- 
    1723   USE oce_trc         ! ocean dynamics and tracers variables 
    18    USE trp_trc             ! ocean passive tracers variables 
     24   USE trc             ! ocean passive tracers variables 
    1925   USE trctrp_lec      ! passive tracers transport 
    2026   USE trcdta 
    2127   USE prtctl_trc      ! Print control for debbuging 
     28   USE trdmld_trc 
     29   USE trdmld_trc_oce      
    2230 
    2331   IMPLICIT NONE 
    2432   PRIVATE 
    2533 
    26    !! * Routine accessibility 
    27    PUBLIC trc_dmp   ! routine called by step.F90 
    28  
    29    !! * Shared module variables 
    30    LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.    !: internal damping flag 
    31  
    32    REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   & 
    33       restotr         ! restoring coeff. on tracers (s-1) 
     34   PUBLIC trc_dmp      ! routine called by step.F90 
     35 
     36   LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.   !: internal damping flag 
     37   REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   restotr   ! restoring coeff. on tracers (s-1) 
    3438 
    3539   !! * Substitutions 
    … …  
    3741   !!---------------------------------------------------------------------- 
    3842   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    39    !! $Id$  
    40    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     43   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $  
     44   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4145   !!---------------------------------------------------------------------- 
    4246 
    … …  
    6064      !! ** Action  : - update the tracer trends tra with the newtonian  
    6165      !!                damping trends. 
    62       !!              - save the trends in trtrd ('key_trc_diatrd') 
    63       !! 
    64       !! History : 
    65       !!   7.0  !         (G. Madec)  Original code 
    66       !!        !  96-01  (G. Madec)  
    67       !!        !  97-05  (H. Loukos)  adapted for passive tracers 
    68       !!   8.5  !  02-08  (G. Madec )  free form + modules 
    69       !!   9.0  !  04-03  (C. Ethe)    free form + modules 
    70       !!---------------------------------------------------------------------- 
    71       !! * Arguments 
     66      !!              - save the trends ('key_trdmld_trc') 
     67      !!---------------------------------------------------------------------- 
     68      USE oce, ONLY :   ztrtrd => ua  ! use ua as 3D workspace    
     69      !! 
    7270      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    73  
    74       !! * Local declarations 
    75       INTEGER  ::   ji, jj, jk, jn     ! dummy loop indices 
    76       REAL(wp) ::   ztest, ztra, zdt   ! temporary scalars 
     71      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
     72      REAL(wp) ::   ztest, ztra !!!, zdt    ! temporary scalars 
    7773      CHARACTER (len=22) :: charout 
    7874      !!---------------------------------------------------------------------- 
    … …  
    8278      IF( kt == nittrc000 ) CALL trc_dmp_init 
    8379 
     80 
    8481      ! 1. Newtonian damping trends on tracer fields 
    8582      ! -------------------------------------------- 
    … …  
    8986 
    9087      ! Initialize the input fields for newtonian damping 
    91       CALL trc_dta( kt ) 
    92  
    93       DO jn = 1, jptra 
     88      CALL dta_trc( kt ) 
     89 
     90      !                                                          ! =========== 
     91      DO jn = 1, jptra                                           ! tracer loop 
     92         !                                                       ! =========== 
     93         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends  
    9494 
    9595         IF( lutini(jn) ) THEN 
    … …  
    106106!!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt 
    107107                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    108 #    if defined key_trc_diatrd 
    109                         ! save the trends for diagnostics 
    110                         IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc-1) = ztra 
    111 #    endif 
    112108                     END DO 
    113109                  END DO 
    … …  
    129125#    if defined key_trc_diatrd 
    130126                        ! save the trends for diagnostics 
    131                         IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc-1) = ztra 
     127                        IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc) = ztra 
    132128#    endif 
     129 
    133130                     END DO 
    134131                  END DO 
    … …  
    149146#    if defined key_trc_diatrd 
    150147                        ! save the trends for diagnostics 
    151                         IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc-1) = ztra 
     148                        IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc) = ztra 
    152149#    endif 
     150 
    153151                     END DO 
    154152                  END DO 
    … …  
    159157         ENDIF 
    160158 
    161       END DO 
    162  
    163      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     159         IF( l_trdtrc ) THEN 
     160            ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:) 
     161            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_dmp, kt )        ! trends diags. 
     162         END IF 
     163         !                                                       ! =========== 
     164      END DO                                                     ! tracer loop 
     165      !                                                          ! =========== 
     166 
     167      IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    164168         WRITE(charout, FMT="('dmp')") 
    165          CALL prt_ctl_trc_info(charout) 
    166          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     169         CALL prt_ctl_trc_info( charout ) 
     170         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd' ) 
    167171      ENDIF 
    168172   
    … …  
    180184      !! ** Method  :   read the nammbf namelist and check the parameters 
    181185      !!      called by trc_dmp at the first timestep (nit000) 
    182       !! 
    183       !! History : 
    184       !!   8.5  !  02-08  (G. Madec)  Original code 
    185186      !!---------------------------------------------------------------------- 
    186187 
    … …  
    194195 
    195196      CASE DEFAULT 
    196          WRITE(ctmp1,*) '          bad flag value for ndmp = ', ndmp 
     197         WRITE(ctmp1,*) '          bad flag value for ndmptr = ', ndmptr 
    197198         CALL ctl_stop(ctmp1) 
    198199 
    … …  
    212213 
    213214      CASE DEFAULT 
    214          WRITE(ctmp1,*) '          bad flag value for nmldmp = ', nmldmp 
     215         WRITE(ctmp1,*) '          bad flag value for nmldmptr = ', nmldmptr 
    215216         CALL ctl_stop(ctmp1) 
    216217 
    217  
    218218      END SELECT 
    219219 
    220  
    221       ! 3. Damping coefficients initialization 
    222      ! -------------------------------------- 
    223  
    224          IF( lzoom ) THEN 
    225             CALL trccof_zoom 
    226          ELSE 
    227             CALL trccof 
    228          ENDIF 
     220      ! Damping coefficients initialization 
     221      ! ----------------------------------- 
     222      IF( lzoom ) THEN 
     223         CALL trccof_zoom 
     224      ELSE 
     225         CALL trccof 
     226      ENDIF 
    229227  
    230228   END SUBROUTINE trc_dmp_init 
    … …  
    357355         icot         ! logical unit for file distance to the coast 
    358356 
    359       CHARACTER (len=32) ::  clname, clname2, clname3 
     357      CHARACTER (len=32) ::  clname3 
    360358      REAL(wp) ::   & 
    361359         zdate0, zinfl, zlon,         & ! temporary scalars 

  • trunk/NEMO/TOP_SRC/TRP/trcldf_bilap.F90

    r1152 r1175  
    11MODULE trcldf_bilap 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                   ***  MODULE  trcldf_bilap  *** 
    4    !! TOP :  horizontal component of the lateral tracer mixing trend 
    5    !!============================================================================== 
     4   !! Ocean passive tracers:  horiz. component of the lateral tracer mixing trend 
     5   !!====================================================================== 
     6   !! History :       !  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   !!                 !  00-05  (MA Foujols) add lbc for tracer trends 
     13   !!                 !  00-10  (MA Foujols E. Kestenare) use passive tracer coefficient 
     14   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     15   !!            9.0  !  04-03  (C. Ethe )  F90: Free form and module 
     16   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     17   !!---------------------------------------------------------------------- 
    618#if defined key_top 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_top'                                                TOP models 
    919   !!---------------------------------------------------------------------- 
    1020   !!   trc_ldf_bilap : update the tracer trend with the horizontal diffusion 
    1121   !!                   using a iso-level biharmonic operator 
    1222   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1423   USE oce_trc         ! ocean dynamics and active tracers variables 
    15    USE trp_trc             ! ocean passive tracers variables 
     24   USE trp_trc         ! ocean passive tracers variables 
    1625   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    1726   USE prtctl_trc      ! Print control for debbuging 
     27   USE trdmld_trc 
     28   USE trdmld_trc_oce      
    1829 
    1930   IMPLICIT NONE 
    2031   PRIVATE 
    2132 
    22    !! * Routine accessibility 
    2333   PUBLIC trc_ldf_bilap   ! routine called by step.F90 
    2434 
    … …  
    2737   !!---------------------------------------------------------------------- 
    2838   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    29    !! $Id$  
     39   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_bilap.F90,v 1.10 2006/09/12 11:10:14 opalod Exp $  
    3040   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3141   !!---------------------------------------------------------------------- 
    … …  
    7080      !! ** Action : - Update tra arrays with the before iso-level 
    7181      !!               biharmonic mixing trend. 
    72       !!             - Save the trends in trtrd ('key_trc_diatrd') 
    73       !! 
    74       !! History : 
    75       !!        !  91-11  (G. Madec)  Original code 
    76       !!        !  93-03  (M. Guyon)  symetrical conditions 
    77       !!        !  95-11  (G. Madec)  suppress volumetric scale factors 
    78       !!        !  96-01  (G. Madec)  statement function for e3 
    79       !!        !  96-01  (M. Imbard)  mpp exchange 
    80       !!        !  97-07  (G. Madec)  optimization, and ahtt 
    81       !!        !  00-05  (MA Foujols) add lbc for tracer trends 
    82       !!        !  00-10  (MA Foujols E. Kestenare) use passive tracer coefficient 
    83       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    84       !!   9.0  !  04-03  (C. Ethe )  F90: Free form and module 
     82      !!             - Save the trends ('key_trdmld_trc') 
    8583      !!---------------------------------------------------------------------- 
    86       !! * Arguments 
    87       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    88  
    89       !! * Local declarations 
    90       INTEGER ::   ji, jj, jk, jn             ! dummy loop indices 
    91       INTEGER ::   iku, ikv                   ! temporary integers 
    92  
    93       REAL(wp) ::   ztra     ! temporary scalars 
    94  
    95       REAL(wp), DIMENSION(jpi,jpj) ::   &  
    96          zeeu, zeev, zbtr, zlt                 ! workspace 
    97       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &  
    98          ztu, ztv                              ! workspace 
     84      USE oce_trc,   ztrtrd => ua        ! use ua as workspace 
     85      !! 
     86      INTEGER, INTENT( in ) ::   kt                             ! ocean time-step index 
     87      INTEGER ::   ji, jj, jk, jn                               ! dummy loop indices 
     88      INTEGER ::   iku, ikv                                     ! temporary integers 
     89      REAL(wp) ::   ztra                                        ! temporary scalars 
     90      REAL(wp), DIMENSION(jpi,jpj) ::   zeeu, zeev, zbtr, zlt   ! workspace 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv            ! workspace 
    9992      CHARACTER (len=22) :: charout 
    10093      !!---------------------------------------------------------------------- 
    … …  
    10598         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
    10699      ENDIF 
    107       !  
    108  
    109       DO jn = 1, jptra 
     100      !                                                          ! =========== 
     101      DO jn = 1, jptra                                           ! tracer loop 
     102         !                                                       ! =========== 
     103         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)   ! save trends 
     104 
    110105                                                          ! =============== 
    111106         DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    199194                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),5) = (  ztv(ji,jj,jk) - ztv(ji-1,jj,jk) ) * zbtr(ji,jj) 
    200195#endif 
     196 
    201197               END DO 
    202198            END DO 
    … …  
    206202#if defined key_trc_diatrd 
    207203         ! Lateral boundary conditions on the laplacian zlt   (unchanged sgn) 
    208          IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),5), 'T', 1. )   
    209 #endif 
    210       END DO 
    211  
    212      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     204         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),5), 'T', 1. ) 
     205#endif 
     206 
     207         IF( l_trdtrc ) THEN 
     208            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     209            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_ldf, kt )    ! trends diags 
     210         END IF 
     211         !                                                       ! =========== 
     212      END DO                                                     ! tracer loop                 
     213      !                                                          ! =========== 
     214 
     215      IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    213216         WRITE(charout, FMT="('ldf - bilap')") 
    214          CALL prt_ctl_trc_info(charout) 
    215          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     217         CALL prt_ctl_trc_info( charout ) 
     218         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd' ) 
    216219      ENDIF 
    217220 

  • trunk/NEMO/TOP_SRC/TRP/trcldf_bilapg.F90

    r1152 r1175  
    11MODULE trcldf_bilapg 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  trcldf_bilapg  *** 
    44   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend 
    5    !!============================================================================== 
    6 #if defined key_top && defined key_ldfslp 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_top'        and                                     TOP models 
     5   !!====================================================================== 
     6   !! History :  8.0  !  97-07  (G. Madec)  Original code 
     7   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     8   !!            9.0  !  04-03  (C. Ethe)  adapted for passive tracers 
     9   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     10   !!---------------------------------------------------------------------- 
     11#if key_top && defined key_ldfslp 
     12   !!---------------------------------------------------------------------- 
    913   !!   'key_ldfslp'                  rotation of the lateral mixing tensor 
    1014   !!---------------------------------------------------------------------- 
    … …  
    1317   !!   ldfght         :  ??? 
    1418   !!---------------------------------------------------------------------- 
    15    !! * Modules used 
    1619   USE oce_trc             ! ocean dynamics and tracers variables 
    17    USE trp_trc                 ! ocean passive tracers variables 
     20   USE trc                 ! ocean passive tracers variables 
    1821   USE lbclnk              ! ocean lateral boundary condition (or mpp link) 
    1922   USE prtctl_trc          ! Print control for debbuging 
     23   USE trp_trc 
     24   USE trdmld_trc 
     25   USE trdmld_trc_oce      
    2026 
    2127   IMPLICIT NONE 
    2228   PRIVATE 
    2329 
    24    !! * Routine accessibility 
    2530   PUBLIC trc_ldf_bilapg    ! routine called by step.F90 
    2631 
    … …  
    2934   !!---------------------------------------------------------------------- 
    3035   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    31    !! $Id$  
    32    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     36   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_bilapg.F90,v 1.9 2006/04/10 15:38:54 opalod Exp $  
     37   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3338   !!---------------------------------------------------------------------- 
    3439    
    … …  
    5762      !! ** Action : - Update tra arrays with the before geopotential  
    5863      !!               biharmonic mixing trend. 
    59       !!             - Save the trends  in trtrd ('key_trc_diatrd') 
    60       !! 
    61       !! History : 
    62       !!   8.0  !  97-07  (G. Madec)  Original code 
    63       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    64       !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers 
    65       !!---------------------------------------------------------------------- 
    66       !! * Arguments 
    67       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    68  
    69       !! * Local declarations 
    70       INTEGER ::   ji, jj, jk,jn              ! dummy loop indices 
    71       REAL(wp) ::  ztra                       ! workspace    
    72       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   & 
    73          wk1, wk2               ! work array used for rotated biharmonic 
    74                                 ! operator on tracers and/or momentum 
    75       CHARACTER (len=22) :: charout 
     64      !!---------------------------------------------------------------------- 
     65      INTEGER, INTENT( in ) ::   kt                         ! ocean time-step index 
     66      INTEGER ::   ji, jj, jk, jn                           ! dummy loop indices 
     67      REAL(wp) ::   ztra                                    ! workspace    
     68      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   wk1, wk2  ! work array used for rotated biharmonic 
     69      !                                                     ! operator on tracers and/or momentum 
     70      CHARACTER (len=22) ::   charout 
    7671      !!---------------------------------------------------------------------- 
    7772 
    … …  
    9994 
    10095      CALL ldfght ( wk1, wk2, 2 ) 
    101  
    102  
    103       DO jn = 1, jptra 
     96      !                                                          ! =========== 
     97      DO jn = 1, jptra                                           ! tracer loop 
     98         !                                                       ! =========== 
     99 
    104100         ! 3. Update the tracer trends                    (j-slab :   2, jpj-1) 
    105101         ! --------------------------- 
    … …  
    120116         END DO                                           !   End of slab 
    121117         !                                                ! =============== 
    122  
    123       END DO 
    124  
    125      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     118         IF( l_trdtrc .AND. luttrd(jn) ) CALL trd_mod_trc( wk2(:,:,:,jn), jn, jptrc_trd_ldf, kt ) 
     119 
     120         !                                                       ! =========== 
     121      END DO                                                     ! tracer loop 
     122      !                                                          ! =========== 
     123 
     124 
     125      IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    126126         WRITE(charout, FMT="('ldf - bilapg')") 
    127          CALL prt_ctl_trc_info(charout) 
    128          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     127         CALL prt_ctl_trc_info( charout ) 
     128         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd' ) 
    129129      ENDIF 
    130130 
    … …  
    171171      !! * Action : 
    172172      !!      'key_trdtra' defined: the trend is saved for diagnostics. 
    173       !! 
    174       !! History : 
    175       !!   8.0  !  97-07  (G. Madec)  Original code 
    176       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    177       !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers 
    178       !!---------------------------------------------------------------------- 
    179       !! * Arguments 
     173      !!---------------------------------------------------------------------- 
    180174      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra), INTENT( in  ) ::   & 
    181175         pt               ! tracer fields before for 1st call 
    … …  
    189183      !                   ! =2 no multiplication 
    190184 
    191       !! * Local declarations 
    192185      INTEGER ::   ji, jj, jk,jn             ! dummy loop indices 
    193186      REAL(wp) ::   & 
    … …  
    204197         zftw,                          &  ! workspace 
    205198         zdit, zdjt, zdj1t 
    206  
    207       !!---------------------------------------------------------------------- 
    208  
     199      !!---------------------------------------------------------------------- 
    209200 
    210201      DO jn = 1, jptra 

  • trunk/NEMO/TOP_SRC/TRP/trcldf_iso.F90

    r1152 r1175  
    22   !!============================================================================== 
    33   !!                    ***  MODULE  trcldf_iso  *** 
     4   !!====================================================================== 
    45   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend 
    5    !!============================================================================== 
    6 #if defined key_top && defined key_ldfslp  
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_top'          and                                   TOP models 
     6   !! History : 
     7   !!        !  94-08  (G. Madec, M. Imbard) 
     8   !!        !  97-05  (G. Madec)  split into traldf and trazdf 
     9   !!        !  98-03  (L. Bopp, MA Foujols) passive tracer generalisation 
     10   !!        !  00-10  (MA Foujols E Kestenare) USE passive tracer coefficient 
     11   !!   8.5  !  02-08  (G. Madec)  Free form, F90 
     12   !!   9.0  !  04-03  (C. Ethe)  Free form, F90 
     13   !!        !  06-08  (C. Deltel) Diagnose ML trends for passive tracers 
     14   !!---------------------------------------------------------------------- 
     15#if key_top && defined key_ldfslp  
     16   !!---------------------------------------------------------------------- 
    917   !!   'key_ldfslp'                  rotation of the lateral mixing tensor 
    1018   !!---------------------------------------------------------------------- 
    … …  
    1321   !!                 laplacian operator in s-coordinate 
    1422   !!---------------------------------------------------------------------- 
    15    !! * Modules used 
    1623   USE oce_trc      ! ocean dynamics and tracers variables 
    17    USE trp_trc          ! ocean passive tracers variables 
     24   USE trp_trc      ! ocean passive tracers variables 
    1825   USE prtctl_trc   ! Print control for debbuging 
     26   USE trdmld_trc 
     27   USE trdmld_trc_oce      
    1928 
    2029   IMPLICIT NONE 
    2130   PRIVATE 
    2231 
    23    !! * Routine accessibility 
    2432   PUBLIC trc_ldf_iso  ! routine called by step.F90 
    2533 
    … …  
    2836   !!---------------------------------------------------------------------- 
    2937   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    30    !! $Id$  
    31    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     38   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_iso.F90,v 1.9 2006/04/10 15:38:54 opalod Exp $  
     39   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3240   !!---------------------------------------------------------------------- 
    3341 
    … …  
    6270      !! ** Action  : - Update tra arrays with the before isopycnal or 
    6371      !!                geopotential s-coord harmonic mixing trend. 
    64       !!              - Save the trends in trtrd ('key_trc_diatrd') 
    65       !! 
    66       !! History : 
    67       !!        !  94-08  (G. Madec, M. Imbard) 
    68       !!        !  97-05  (G. Madec)  split into traldf and trazdf 
    69       !!        !  98-03  (L. Bopp, MA Foujols) passive tracer generalisation 
    70       !!        !  00-10  (MA Foujols E Kestenare) USE passive tracer coefficient 
    71       !!   8.5  !  02-08  (G. Madec)  Free form, F90 
    72       !!   9.0  !  04-03  (C. Ethe)  Free form, F90 
     72      !!              - Save the trends ('key_trdmld_trc') 
    7373      !!---------------------------------------------------------------------- 
    74       !! * Modules used 
    7574      USE oce_trc       , zftu => ua,  &  ! use ua as workspace 
    7675         &                zfsu => va      ! use va as workspace 
    77  
    78       !! * Arguments 
    79       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    80  
    81       !! * Local declarations 
    82       INTEGER ::   ji, jj, jk,jn             ! dummy loop indices 
    83       REAL(wp) ::   & 
    84          zabe1, zabe2, zcof1, zcof2,   &  ! temporary scalars 
    85          zmsku, zmskv, zbtr,           & 
     76      !! 
     77      INTEGER, INTENT( in ) ::   kt                             ! ocean time-step index 
     78      !!                                                  
     79      INTEGER ::   ji, jj, jk, jn                               ! dummy loop indices 
     80      REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                  ! temporary scalars 
     81      REAL(wp) ::   zmsku, zmskv, zbtr, ztra 
    8682#if defined key_trcldf_eiv 
    87          zcg1, zcg2, zuwk, zvwk,       & 
    88          zuwk1, zvwk1,                 & 
    89 #endif 
    90          ztra 
    91  
    92       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    93          zdkt, zdk1t            ! workspace 
    94  
     83      REAL(wp) ::   zcg1, zcg2, zuwk, zvwk, zuwk1, zvwk1 
     84      REAL(wp) ::   z_hdivn_x, z_hdivn_y 
     85#endif 
     86      REAL(wp), DIMENSION(jpi,jpj) ::   zdkt, zdk1t             ! workspace 
    9587#if defined key_trcldf_eiv 
    96       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    97          zftug, zftvg 
    98  
    99 #if defined key_trc_diatrd 
    100       REAL(wp) ::   & 
    101          ztagu, ztagv 
    102 #endif 
    103  
    104 #endif 
    105  
    106       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    107          zftv                       ! workspace 
     88      REAL(wp), DIMENSION(jpi,jpj) ::   zftug, zftvg 
     89#endif 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zftv                ! workspace 
    10891      CHARACTER (len=22) :: charout 
     92      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd       ! trends arrays 
     93#   if defined key_trcldf_eiv 
     94      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd_xei 
     95      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd_yei 
     96#endif 
    10997      !!---------------------------------------------------------------------- 
    11098 
    … …  
    119107      ENDIF 
    120108 
    121  
    122       DO jn = 1, jptra 
     109      IF( l_trdtrc ) THEN 
     110         ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     111#   if defined key_trcldf_eiv 
     112         ALLOCATE( ztrtrd_xei(jpi,jpj,jpk) ) 
     113         ALLOCATE( ztrtrd_yei(jpi,jpj,jpk) ) 
     114#   endif 
     115      ENDIF 
     116 
     117      !                                                          ! =========== 
     118      DO jn = 1, jptra                                           ! tracer loop 
     119         !                                                       ! =========== 
     120 
     121!CDIR COLLAPSE 
     122         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) 
    123123 
    124124         !                                                ! =============== 
    … …  
    194194#   endif 
    195195 
    196             ! II.4 Second derivative (divergence) and add to the general trend 
    197             ! ---------------------------------------------------------------- 
     196            ! 3. Second derivative (divergence) and add to the general trend 
     197            ! -------------------------------------------------------------- 
    198198 
    199199            DO jj = 2 , jpjm1 
    … …  
    201201                  zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
    202202                  ztra = zbtr * (  zftu(ji,jj,jk) - zftu(ji-1,jj  ,jk)   & 
    203                      &          + zftv(ji,jj,jk) - zftv(ji  ,jj-1,jk)  ) 
     203                       &         + zftv(ji,jj,jk) - zftv(ji  ,jj-1,jk)  ) 
    204204                  tra (ji,jj,jk,jn) = tra (ji,jj,jk,jn) + ztra 
    205205#if defined key_trc_diatrd 
    … …  
    207207                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk  ) ) * zbtr 
    208208#endif 
     209 
    209210               END DO 
    210211            END DO 
    211  
    212 #if defined key_trc_diatrd 
    213 #   if defined key_trcldf_eiv 
    214             DO jj = 2 , jpjm1 
    215                DO ji = fs_2, fs_jpim1   ! vector opt. 
    216                   zbtr= 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    217                   ztagu = ( zftug(ji,jj) - zftug(ji-1,jj  ) ) * zbtr 
    218                   ztagv = ( zftvg(ji,jj) - zftvg(ji  ,jj-1) ) * zbtr 
    219                   IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = trtrd(ji,jj,jk,ikeep(jn),4) - ztagu 
    220                   IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = trtrd(ji,jj,jk,ikeep(jn),5) - ztagv 
    221                   IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),7) = ztagu 
    222                   IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),8) = ztagv 
    223                END DO 
    224              END DO 
    225 #   endif 
    226 #endif 
    227  
    228212            !                                          ! =============== 
    229213         END DO                                        !   End of slab   
    230214         !                                             ! =============== 
    231215 
    232       END DO 
    233  
    234       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     216         ! 4. Save the trends for diagnostic 
     217         ! --------------------------------- 
     218 
     219         IF( l_trdtrc ) THEN 
     220#   if defined key_trcldf_eiv 
     221 
     222            ! 4.1) Compute the eiv ZONAL & MERIDIONAL advective trends 
     223                                                          ! =============== 
     224            DO jk = 1, jpkm1                              ! Horizontal slab 
     225                                                          ! =============== 
     226               DO jj = 1, jpjm1 
     227                  DO ji = 1, fs_jpim1   ! vector opt. 
     228                     zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk  ) ) * fsaeitru(ji,jj,jk  ) * umask(ji,jj,jk  ) 
     229                     zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj,jk+1) ) * fsaeitru(ji,jj,jk+1) * umask(ji,jj,jk+1) 
     230                     zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk  ) ) * fsaeitrv(ji,jj,jk  ) * vmask(ji,jj,jk  ) 
     231                     zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeitrv(ji,jj,jk+1) * vmask(ji,jj,jk+1) 
     232                      
     233                     zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 ) 
     234                     zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 ) 
     235                      
     236                     zftug(ji,jj) = zcg1 * ( trb(ji+1,jj,jk,jn) + trb(ji,jj,jk,jn) ) 
     237                     zftvg(ji,jj) = zcg2 * ( trb(ji,jj+1,jk,jn) + trb(ji,jj,jk,jn) ) 
     238                  END DO 
     239               END DO 
     240                
     241!CDIRR COLLAPSE 
     242               DO jj = 2 , jpjm1 
     243                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     244                     zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
     245                      
     246                     !-- Compute zonal & meridional divergences of the eiv field : 
     247                     !     d_x[u_trc_eiv] = 1/(e1t*e2t*e3t) ( di[e2u*e3u u_trc_eiv] ) 
     248                     !     d_y[v_trc_eiv] = 1/(e1t*e2t*e3t) ( dj[e1v*e3v v_trc_eiv] ) 
     249                     !   N.B.  This is only possible if key_diaeiv is switched on. 
     250#       if defined key_diaeiv 
     251                     z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * u_trc_eiv(ji  ,jj  ,jk)  & 
     252                          &       - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * u_trc_eiv(ji-1,jj  ,jk) ) * zbtr 
     253                     z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * v_trc_eiv(ji,  jj  ,jk)  & 
     254                          &       - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * v_trc_eiv(ji  ,jj-1,jk) ) * zbtr 
     255#       else 
     256                     z_hdivn_x = 0.e0   ;   z_hdivn_y = 0.e0  
     257#       endif 
     258                     !-- Compute the zonal advective trends associated with eiv 
     259                     ztrtrd_xei(ji,jj,jk) =  zbtr * ( zftug(ji,jj) - zftug(ji-1,jj  ) )          & 
     260                          &                 - trn(ji,jj,jk,jn) * z_hdivn_x 
     261                      
     262                     !-- Compute the merid. advective trends associated with eiv 
     263                     ztrtrd_yei(ji,jj,jk) =  zbtr * ( zftvg(ji,jj) - zftvg(ji  ,jj-1) )          & 
     264                          &                 - trn(ji,jj,jk,jn) * z_hdivn_y 
     265                  END DO 
     266               END DO 
     267                                                          ! =============== 
     268            END DO                                        !   End of slab   
     269                                                          ! =============== 
     270            ! 4.2) Deduce the trend 
     271            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) - ztrtrd_xei(:,:,:) - ztrtrd_yei(:,:,:) 
     272#   else 
     273            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     274#   endif 
     275             
     276            ! 4.3) save the trends for diagnostic 
     277            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd    , jn, jptrc_trd_ldf, kt )  
     278#   if defined key_trcldf_eiv 
     279            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_xei, jn, jptrc_trd_xei, kt ) 
     280            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_yei, jn, jptrc_trd_yei, kt ) 
     281#   endif 
     282         ENDIF 
     283         !                                                    ! =========== 
     284      END DO                                                  ! tracer loop 
     285      !                                                       ! =========== 
     286 
     287      IF( l_trdtrc ) THEN 
     288         DEALLOCATE( ztrtrd ) 
     289#   if defined key_trcldf_eiv 
     290         DEALLOCATE( ztrtrd_xei ) 
     291         DEALLOCATE( ztrtrd_yei ) 
     292#   endif 
     293      ENDIF 
     294 
     295      IF( ln_ctl ) THEN        ! print mean trends (used for debugging) 
    235296         WRITE(charout, FMT="('ldf - iso')") 
    236297         CALL prt_ctl_trc_info(charout) 

  • trunk/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90

    r1152 r1175  
    11MODULE trcldf_iso_zps 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                   ***  MODULE  trcldf_iso_zps  *** 
    44   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend 
    5    !!============================================================================== 
    6 #if defined key_top &&  defined key_ldfslp  
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_top'          and                                   TOP models 
     5   !!====================================================================== 
     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  !  04-03  (C. Ethe)  adapted for passive tracers 
     10   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     11   !!---------------------------------------------------------------------- 
     12#if key_top &&  defined key_ldfslp  
     13   !!---------------------------------------------------------------------- 
    914   !!   'key_ldfslp'               slope of the lateral diffusive direction 
    1015   !!---------------------------------------------------------------------- 
    … …  
    1217   !!                     component of a iso-neutral laplacian operator 
    1318   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1519   USE oce_trc             ! ocean dynamics and active tracers variables 
    1620   USE trp_trc                 ! ocean passive tracers variables 
    1721   USE prtctl_trc          ! Print control for debbuging 
     22   USE trdmld_trc 
     23   USE trdmld_trc_oce      
    1824 
    1925   IMPLICIT NONE 
    2026   PRIVATE 
    2127 
    22    !! * Accessibility 
    2328   PUBLIC trc_ldf_iso_zps  ! routine called by step.F90 
    2429 
    … …  
    2732   !!---------------------------------------------------------------------- 
    2833   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    29    !! $Id$  
    30    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     34   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90,v 1.10 2006/09/12 11:10:14 opalod Exp $  
     35   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3136   !!---------------------------------------------------------------------- 
    3237 
    … …  
    6671      !!         Update tra arrays with the before along level biharmonic 
    6772      !!      mixing trend. 
    68       !!         Save in trtrd arrays the trends if 'key_trc_diatrd' defined 
    69       !! 
    70       !! History : 
    71       !!        !  94-08  (G. Madec, M. Imbard) 
    72       !!        !  97-05  (G. Madec)  split into traldf and trazdf 
    73       !!   8.5  !  02-08  (G. Madec)  Free form, F90 
    74       !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers 
     73      !!         Save the trends if 'key_trdmld_trc' defined 
    7574      !!---------------------------------------------------------------------- 
    76       !! * Modules used 
    7775      USE oce_trc       , zftu => ua,  &  ! use ua as workspace 
    7876         &                zfsu => va      ! use va as workspace 
    79  
    80       !! * Arguments 
     77      !! 
    8178      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    82  
    83       !! * Local declarations 
    8479      INTEGER ::   ji, jj, jk,jn          ! dummy loop indices 
    8580      INTEGER ::   iku, ikv               ! temporary integer 
    8681      REAL(wp) ::   & 
    8782         zabe1, zabe2, zcof1, zcof2,   &  ! temporary scalars 
    88          zmsku, zmskv, zbtr, ztra        
     83         zmsku, zmskv, zbtr, ztra,     & 
     84         ztagu, ztagv 
    8985 
    9086      REAL(wp), DIMENSION(jpi,jpj) ::   & 
    … …  
    9692#if defined key_trcldf_eiv 
    9793      REAL(wp), DIMENSION(jpi,jpj) ::   & 
    98          zftug, zftvg                    ! temporary workspace 
    99  
     94         zftug, zftvg                     ! temporary workspace 
     95      REAL(wp) ::   z_hdivn_x, z_hdivn_y 
    10096      REAL(wp) ::   & 
    10197         zuwk, zvwk,                   & 
    10298         zuwk1, zvwk1,                 & 
    10399         zcg1,zcg2 
    104  
    105 #if defined key_trc_diatrd 
    106       REAL(wp) ::   & 
    107          ztagu, ztagv 
    108 #endif 
    109  
    110100#endif 
    111101      CHARACTER (len=22) :: charout 
     102      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
     103      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd_xei 
     104      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd_yei 
    112105      !!---------------------------------------------------------------------- 
    113106 
    … …  
    122115      ENDIF 
    123116 
    124       DO jn = 1, jptra 
    125  
    126 #if defined key_trcldf_eiv && key_trc_diatrd 
    127          ztagu = 0.e0 
    128          ztagv = 0.e0 
    129 #endif 
     117      IF( l_trdtrc ) THEN 
     118         ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     119#   if defined key_trcldf_eiv 
     120         ALLOCATE( ztrtrd_xei(jpi,jpj,jpk) ) 
     121         ALLOCATE( ztrtrd_yei(jpi,jpj,jpk) ) 
     122#   endif 
     123      ENDIF 
     124 
     125      !                                                          ! =========== 
     126      DO jn = 1, jptra                                           ! tracer loop 
     127         !                                                       ! =========== 
     128!CDIR COLLAPSE 
     129         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)   ! save trends 
     130 
     131         ztagu = 0.e0    ;     ztagv = 0.e0 
    130132 
    131133         ! Horizontal passive tracer gradient  
    … …  
    164166            ENDIF 
    165167 
    166  
    167168            ! 2. Horizontal fluxes 
    168169            ! -------------------- 
    … …  
    174175 
    175176                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & 
    176                      + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. ) 
     177                       &           + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. ) 
    177178 
    178179                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   & 
    179                      + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. ) 
     180                       &           + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. ) 
    180181 
    181182                  zcof1 = -fsahtru(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
    … …  
    183184 
    184185                  zftu(ji,jj,jk) = umask(ji,jj,jk) * (  zabe1 * zgtbu(ji,jj,jk)   & 
    185                      &                                + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      & 
    186                      &                                           + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) 
     186                       &                              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      & 
     187                       &                                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) 
    187188                  zftv(ji,jj,jk) = vmask(ji,jj,jk) * (  zabe2 * zgtbv(ji,jj,jk)   & 
    188                      &                                + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      & 
    189                      &                                           + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) 
     189                       &                              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      & 
     190                       &                                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) 
    190191               END DO 
    191192            END DO 
    192193 
    193194# if defined key_trcldf_eiv 
    194             ! ---------------------------------------! 
    195             ! Eddy induced vertical advective fluxes ! 
    196             ! ---------------------------------------! 
     195 
     196            ! ... Eddy induced horizontal advective fluxes 
    197197            DO jj = 1, jpjm1 
    198198               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    219219# endif 
    220220 
    221             ! II.4 Second derivative (divergence) and add to the general trend 
    222             ! ---------------------------------------------------------------- 
     221            ! 3. Second derivative (divergence) and add to the general trend 
     222            ! -------------------------------------------------------------- 
    223223 
    224224            DO jj = 2 , jpjm1 
    … …  
    242242                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = trtrd(ji,jj,jk,ikeep(jn),4) - ztagu 
    243243                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = trtrd(ji,jj,jk,ikeep(jn),5) - ztagv 
    244                   IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),7) = ztagu 
    245                   IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),8) = ztagv 
    246                END DO 
    247             END DO 
    248 #   endif 
    249 #endif 
     244               END DO 
     245            END DO 
     246#   endif 
     247#endif 
     248 
    250249            !                                          ! =============== 
    251250         END DO                                        !   End of slab   
    252251         !                                             ! =============== 
    253       END DO 
    254  
    255       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     252 
     253         ! 4. Save the horizontal diffusive and advective (eiv) trends for diagnostics 
     254         ! --------------------------------------------------------------------------- 
     255!CDIR BEGIN COLLAPSE 
     256         IF( l_trdtrc ) THEN 
     257 
     258            ! 4.1) Compute the eiv ZONAL & MERIDIONAL advective trends 
     259 
     260#   if defined key_trcldf_eiv 
     261            !                                                ! =============== 
     262            DO jk = 1, jpkm1                                 ! Horizontal slab 
     263               !                                             ! =============== 
     264 
     265               DO jj = 1, jpjm1 
     266                  DO ji = 1, fs_jpim1   ! vector opt. 
     267                     zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj  ,jk  ) ) * fsaeitru(ji,jj,jk  ) * umask(ji,jj,jk  ) 
     268                     zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj  ,jk+1) ) * fsaeitru(ji,jj,jk+1) * umask(ji,jj,jk+1) 
     269                     zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji  ,jj+1,jk  ) ) * fsaeitrv(ji,jj,jk  ) * vmask(ji,jj,jk  ) 
     270                     zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji  ,jj+1,jk+1) ) * fsaeitrv(ji,jj,jk+1) * vmask(ji,jj,jk+1) 
     271                      
     272                     zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 ) 
     273                     zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 ) 
     274                      
     275                     zftug(ji,jj) = zcg1 * ( trb(ji+1,jj,jk,jn) + trb(ji,jj,jk,jn) ) 
     276                     zftvg(ji,jj) = zcg2 * ( trb(ji,jj+1,jk,jn) + trb(ji,jj,jk,jn) ) 
     277                  END DO 
     278               END DO 
     279 
     280               DO jj = 2 , jpjm1 
     281                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     282                   
     283                     zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
     284 
     285                     !-- Compute zonal & meridional divergences of the eiv field : 
     286                     !     d_x[u_trc_eiv] = 1/(e1t*e2t*e3t) ( di[e2u*e3u u_trc_eiv] ) 
     287                     !     d_y[v_trc_eiv] = 1/(e1t*e2t*e3t) ( dj[e1v*e3v v_trc_eiv] ) 
     288                     !   N.B.  This is only possible if key_diaeiv is switched on. 
     289#       if defined key_diaeiv 
     290                     z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * u_trc_eiv(ji  ,jj  ,jk)  & 
     291                          &       - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * u_trc_eiv(ji-1,jj  ,jk) ) * zbtr 
     292                     z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * v_trc_eiv(ji,  jj  ,jk)  & 
     293                          &       - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * v_trc_eiv(ji  ,jj-1,jk) ) * zbtr 
     294#       else 
     295                     z_hdivn_x = 0.e0   ;   z_hdivn_y = 0.e0  
     296#       endif 
     297                     !-- Compute the zonal advective trends associated with eiv 
     298                     ztrtrd_xei(ji,jj,jk) = zbtr * ( zftug(ji,jj) - zftug(ji-1,jj  ) )          & 
     299                          &                 - trn(ji,jj,jk,jn) * z_hdivn_x 
     300                      
     301                     !-- Compute the merid. advective trends associated with eiv 
     302                     ztrtrd_yei(ji,jj,jk) = zbtr * ( zftvg(ji,jj) - zftvg(ji  ,jj-1) )          & 
     303                          &                 - trn(ji,jj,jk,jn) * z_hdivn_y 
     304 
     305                  END DO 
     306               END DO 
     307               !                                             ! =============== 
     308            END DO                                           !   End of slab   
     309            !                                                ! =============== 
     310#   else 
     311            ztrtrd_xei(:,:,:) = 0.e0 
     312            ztrtrd_yei(:,:,:) = 0.e0 
     313#   endif 
     314            ! 4.2) Substract the eddy induced velocity 
     315            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) - ztrtrd_xei(:,:,:) - ztrtrd_yei(:,:,:) 
     316 
     317            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd    , jn, jptrc_trd_ldf, kt ) 
     318#   if defined key_trcldf_eiv 
     319            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_xei, jn, jptrc_trd_xei, kt ) 
     320            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_yei, jn, jptrc_trd_yei, kt ) 
     321#   endif 
     322 
     323         ENDIF 
     324!CDIR END 
     325         !                                                       ! =========== 
     326      END DO                                                     ! tracer loop 
     327      !                                                          ! =========== 
     328 
     329      IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    256330         WRITE(charout, FMT="('ldf - iso/zps')") 
    257          CALL prt_ctl_trc_info(charout) 
    258          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     331         CALL prt_ctl_trc_info( charout ) 
     332         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd' ) 
    259333      ENDIF 
    260334 

  • trunk/NEMO/TOP_SRC/TRP/trcldf_lap.F90

    r1152 r1175  
    11MODULE trcldf_lap 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  trcldf_lap  *** 
    44   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend 
    5    !!============================================================================== 
     5   !!====================================================================== 
     6   !! History :  1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code 
     7   !!                 !  91-11  (G. Madec) 
     8   !!                 !  95-02  (M. Levy)    passive tracers 
     9   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors 
     10   !!                 !  96-01  (G. Madec)  statement function for e3 
     11   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     12   !!            9.0  !  04-03  (C. Ethe)   passive tracer 
     13   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     14   !!---------------------------------------------------------------------- 
    615#if defined key_top 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_top'                                                TOP models 
    916   !!---------------------------------------------------------------------- 
    1017   !!   trc_ldf_lap  : update the tracer trend with the horizontal diffusion 
    … …  
    1421   USE trp_trc                 ! ocean passive tracers variables 
    1522   USE prtctl_trc          ! Print control for debbuging 
     23   USE trdmld_trc 
     24   USE trdmld_trc_oce      
    1625 
    1726   IMPLICIT NONE 
    … …  
    2534   !!---------------------------------------------------------------------- 
    2635   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    27    !! $Id$  
    28    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     36   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_lap.F90,v 1.10 2006/09/12 11:10:14 opalod Exp $  
     37   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    2938   !!---------------------------------------------------------------------- 
    3039    
    … …  
    5362      !! ** Action  : - Update tra arrays with the before iso-level  
    5463      !!                harmonic mixing trend. 
    55       !!              - Save the trends in trtrd ('key_trc_diatrd') 
    56       !! 
    57       !! History : 
    58       !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code 
    59       !!        !  91-11  (G. Madec) 
    60       !!        !  95-02  (M. Levy)    passive tracers 
    61       !!        !  95-11  (G. Madec)  suppress volumetric scale factors 
    62       !!        !  96-01  (G. Madec)  statement function for e3 
    63       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    64       !!   9.0  !  04-03  (C. Ethe)   passive tracer 
     64      !!              - Save the trends ('key_trdmld_trc') 
    6565      !!---------------------------------------------------------------------- 
    6666      USE oce_trc          , ztu => ua,  &  ! use ua as workspace 
    6767         &                   ztv => va      ! use va as workspace 
    6868 
    69       !! * Arguments 
    7069      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    71        
     70 
    7271      !! * Local save 
    7372      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   & 
    7473         ze1ur, ze2vr, zbtr2              ! scale factor coefficients 
    7574       
    76       !! * Local declarations 
    77       INTEGER ::   ji, jj, jk,jn         ! dummy loop indices 
     75      INTEGER ::   ji, jj, jk, jn         ! dummy loop indices 
    7876      REAL(wp) ::   & 
    79          zabe1, zabe2, zbtr              ! temporary scalars 
     77         zabe1, zabe2, zbtr               ! temporary scalars 
    8078 
    8179      REAL(wp) ::   & 
    82          ztra, ztrax, ztray              ! workspace 
     80         ztra, ztrax, ztray               ! workspace 
    8381      CHARACTER (len=22) :: charout 
     82      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    8483      !!---------------------------------------------------------------------- 
    8584       
    … …  
    9291         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    9392      ENDIF 
    94   
    95       DO jn = 1, jptra 
     93 
     94      IF( l_trdtrc ) THEN 
     95!         STOP 'trcldf_lap: this was never validated, please comment this line to proceed...' 
     96      ENDIF 
     97 
     98      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     99 
     100      !                                                          ! =========== 
     101      DO jn = 1, jptra                                           ! tracer loop 
     102         !                                                       ! =========== 
     103         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) 
    96104          
    97105         !                                                  ! ============= 
    … …  
    99107            !                                               ! ============= 
    100108            ! 1. First derivative (gradient) 
    101             ! ------------------- 
     109            ! ------------------------------ 
    102110            DO jj = 1, jpjm1 
    103111               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    116124 
    117125            ! 2. Second derivative (divergence) 
    118             ! -------------------- 
     126            ! --------------------------------- 
    119127            DO jj = 2, jpjm1 
    120128               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    130138                  ! add it to the general tracer trends 
    131139                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztrax + ztray 
    132  
    133140#if defined key_trc_diatrd 
    134141                  ! save the horizontal diffusive trends 
    … …  
    136143                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),5) = ztray 
    137144#endif 
     145 
    138146               END DO 
    139147            END DO 
    … …  
    141149         END DO                                             !  End of slab   
    142150         !                                                  ! ============= 
     151         IF( l_trdtrc ) THEN 
     152            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     153            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_ldf, kt )   ! trends diags 
     154         END IF 
     155         !                                                       ! =========== 
     156      END DO                                                     ! tracer loop 
     157      !                                                          ! =========== 
    143158 
    144       END DO 
     159      IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
    145160 
    146      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     161      IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    147162         WRITE(charout, FMT="('ldf - lap')") 
    148          CALL prt_ctl_trc_info(charout) 
    149          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     163         CALL prt_ctl_trc_info( charout ) 
     164         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    150165      ENDIF 
    151166 

  • trunk/NEMO/TOP_SRC/TRP/trcnxt.F90

    r1152 r1175  
    44   !! Ocean passive tracers:  time stepping on passives tracers 
    55   !!====================================================================== 
     6   !!====================================================================== 
     7   !! History :  7.0  !  91-11  (G. Madec)  Original code 
     8   !!                 !  93-03  (M. Guyon)  symetrical conditions 
     9   !!                 !  95-02  (M. Levy)   passive tracers 
     10   !!                 !  96-02  (G. Madec & M. Imbard)  opa release 8.0 
     11   !!            8.0  !  96-04  (A. Weaver)  Euler forward step 
     12   !!            8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad. 
     13   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     14   !!                 !  02-11  (C. Talandier, A-M Treguier) Open boundaries 
     15   !!            9.0  !  04-03  (C. Ethe) passive tracers 
     16   !!                 !  07-02  (C. Deltel) Diagnose ML trends for passive tracers 
     17   !!---------------------------------------------------------------------- 
    618#if defined key_top 
    719   !!---------------------------------------------------------------------- 
    … …  
    1628   USE trctrp_lec      ! pasive tracers transport 
    1729   USE prtctl_trc      ! Print control for debbuging 
     30   USE trdmld_trc 
     31   USE trdmld_trc_oce 
    1832   USE agrif_top_update 
    1933   USE agrif_top_interp 
    … …  
    5569      !! 
    5670      !! ** Action  : - update trb, trn 
    57       !! 
    58       !! History : 
    59       !!   7.0  !  91-11  (G. Madec)  Original code 
    60       !!        !  93-03  (M. Guyon)  symetrical conditions 
    61       !!        !  95-02  (M. Levy)   passive tracers  
    62       !!        !  96-02  (G. Madec & M. Imbard)  opa release 8.0 
    63       !!   8.0  !  96-04  (A. Weaver)  Euler forward step 
    64       !!   8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad. 
    65       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    66       !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries 
    67       !!   9.0  !  04-03  (C. Ethe) passive tracers  
    6871      !!---------------------------------------------------------------------- 
    6972      !! * Arguments 
     73      USE oce_trc, ONLY : ztrtrd => ua      ! use ua as a 3D workspace 
    7074      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    7175      !! * Local declarations 
    … …  
    130134                     END DO 
    131135                  END DO 
     136                  IF( l_trdtrc )   ztrtrd(:,:,:) = 0.e0           !    no trend 
    132137               ELSE 
     138                  IF( l_trdtrc ) THEN                             !    Asselin trend 
     139                     DO jj = 1, jpj 
     140                        DO ji = 1, jpi 
     141                           ztrtrd(ji,jj,jk) = atfp * ( trb(ji,jj,jk,jn) - 2*trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) 
     142                        END DO 
     143                     END DO 
     144                  ENDIF 
     145 
    133146                  DO jj = 1, jpj 
    134147                     DO ji = 1, jpi 
    … …  
    139152                  END DO 
    140153               ENDIF 
    141  
    142             ELSE 
    143 !  case of smolar scheme or muscl 
     154            ELSE                                                  ! >> EULER-FORWARD schemes (SMOLAR, MUSCL) 
     155               IF( l_trdtrc ) ztrtrd(:,:,:) = 0.e0                !    no trend 
     156 
    144157               DO jj = 1, jpj 
    145158                  DO ji = 1, jpi 
    … …  
    154167         END DO                                           !   End of slab 
    155168         !                                                ! =============== 
    156       END DO 
     169 
     170         IF( l_trdtrc ) THEN                                      ! trends 
     171            DO jk = 1, jpk 
     172               zfact = 2. * rdttra(jk) * FLOAT(ndttrc) 
     173               ztrtrd(:,:,jk) = ztrtrd(:,:,jk) / zfact            ! n.b. ztrtrd=0 in Euler-forward case 
     174            END DO 
     175            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_atf, kt ) 
     176         ENDIF 
     177         !                                                        ! =========== 
     178      END DO                                                      ! tracer loop 
     179      !                                                           ! =========== 
    157180 
    158181      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

  • trunk/NEMO/TOP_SRC/TRP/trcrad.F90

    r1146 r1175  
    1414   !!---------------------------------------------------------------------- 
    1515   USE oce_trc             ! ocean dynamics and tracers variables 
    16    USE trp_trc                 ! ocean passive tracers variables 
     16   USE trp_trc             ! ocean passive tracers variables 
     17   USE trctrp_lec , ONLY : ln_trcadv_tvd, ln_trcadv_cen2 
     18   USE trdmld_trc 
     19   USE trdmld_trc_oce 
    1720   USE lib_mpp 
    1821   USE prtctl_trc          ! Print control for debbuging 
    … …  
    5861      ENDIF 
    5962 
    60       IF( lk_cfc     )   CALL trc_rad_sms( trb, trn, jp_cfc0, jp_cfc1               ) ! CFC model 
    61       IF( lk_lobster )   CALL trc_rad_sms( trb, trn, jp_lob0, jp_lob1, cpreserv='Y' )  ! LOBSTER model 
    62       IF( lk_pisces  )   CALL trc_rad_sms( trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' )  ! PISCES model 
    63       IF( lk_my_trc  )   CALL trc_rad_sms( trb, trn, jp_myt0, jp_myt1               ) ! MY_TRC model 
     63      IF( lk_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0, jp_cfc1               ) ! CFC model 
     64      IF( lk_lobster )   CALL trc_rad_sms( kt, trb, trn, jp_lob0, jp_lob1, cpreserv='Y' )  ! LOBSTER model 
     65      IF( lk_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' )  ! PISCES model 
     66      IF( lk_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1               ) ! MY_TRC model 
    6467 
    6568 
    … …  
    7376   END SUBROUTINE trc_rad 
    7477 
    75    SUBROUTINE trc_rad_sms( ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) 
     78   SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) 
    7679      !!----------------------------------------------------------------------------- 
    7780      !!                  ***  ROUTINE trc_rad_sms  *** 
    … …  
    9093      !!-------------------------------------------------------------------------------- 
    9194      !! Arguments 
     95      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    9296      INTEGER  , INTENT( in ) ::  & 
    9397         jp_sms0, &       !: First index of the passive tracer model 
    … …  
    104108      REAL(wp) :: zvolk, ztrcorb, ztrmasb   ! temporary scalars 
    105109      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         " 
    106  
    107       !!---------------------------------------------------------------------- 
    108  
     110      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrdb  ! workspace arrays 
     111      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrdn  ! workspace arrays 
     112      LOGICAL ::   lldebug = .FALSE. 
     113 
     114      !!---------------------------------------------------------------------- 
     115 
     116      IF( l_trdtrc ) THEN 
     117        ! 
     118        ALLOCATE( ztrtrdb(jpi,jpj,jpk) ) 
     119        ALLOCATE( ztrtrdn(jpi,jpj,jpk) ) 
     120        ! 
     121      ENDIF 
    109122       
    110123      IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved  
    111124       
    112125         DO jn = jp_sms0, jp_sms1 
    113              
    114             ztrcorb = 0.e0 
    115             ztrmasb = 0.e0 
    116             ztrcorn = 0.e0 
    117             ztrmasn = 0.e0 
     126         !                                                        ! =========== 
     127         ztrcorb = 0.e0   ;   ztrmasb = 0.e0 
     128         ztrcorn = 0.e0   ;   ztrmasn = 0.e0 
     129 
     130!CDIR COLLAPSE 
     131         IF( l_trdtrc ) THEN 
     132            ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
     133            ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
     134         ENDIF 
     135 
    118136 
    119137            DO jk = 1, jpkm1 
    … …  
    159177            ENDIF 
    160178            ! 
     179            IF( l_trdtrc ) THEN 
     180               ! 
     181               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) / (2.*rdt) 
     182               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) / (2.*rdt) 
     183               IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdb, jn, jptrc_trd_radb, kt )       ! Asselin-like trend handling 
     184               IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdn, jn, jptrc_trd_radn, kt )       ! standard     trend handling 
     185              ! 
     186            ENDIF 
     187 
    161188         END DO 
    162189         ! 
    … …  
    176203 
    177204      ENDIF 
     205 
     206      IF( l_trdtrc )   DEALLOCATE( ztrtrdb, ztrtrdn ) 
    178207 
    179208   END SUBROUTINE trc_rad_sms 

  • trunk/NEMO/TOP_SRC/TRP/trcsbc.F90

    r1152 r1175  
    33   !!                       ***  MODULE  trcsbc  *** 
    44   !! Ocean passive tracers:  surface boundary condition 
     5   !!====================================================================== 
     6   !! History :  8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
     7   !!            8.2  !  01-02  (D. Ludicone)  sea ice and free surface 
     8   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     9   !!            9.0  !  04-03  (C. Ethe)  adapted for passive tracers 
     10   !!                 !  06-08  (C. Deltel) Diagnose ML trends for passive tracers 
    511   !!============================================================================== 
    612#if defined key_top 
    … …  
    1420   USE trp_trc                 ! ocean  passive tracers variables 
    1521   USE prtctl_trc          ! Print control for debbuging 
    16  
     22   USE trdmld_trc 
     23   USE trdmld_trc_oce 
    1724 
    1825   IMPLICIT NONE 
    … …  
    5259      !!                with the tracer surface boundary condition  
    5360      !! 
    54       !! History : 
    55       !!   8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
    56       !!   8.2  !  01-02  (D. Ludicone)  sea ice and free surface 
    57       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    58       !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers 
    5961      !!---------------------------------------------------------------------- 
    6062      !! * Arguments 
    … …  
    6466      INTEGER  ::   ji, jj, jn           ! dummy loop indices 
    6567      REAL(wp) ::   ztra, zsrau, zse3t   ! temporary scalars 
     68      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    6669      CHARACTER (len=22) :: charout 
    6770      !!---------------------------------------------------------------------- 
    … …  
    7376      ENDIF 
    7477 
     78      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     79 
    7580      ! 0. initialization 
    7681      zsrau = 1. / rauw 
    7782      IF( .NOT. ln_sco )  zse3t = 1. / fse3t(1,1,1) 
    78 #if defined key_trc_diatrd 
    79       DO jn = 1, jptra 
    80         IF (luttrd(jn)) trtrd(:,:,:,ikeep(jn),jpdiatrc) = 0.0 
    81       END DO 
    82 #endif 
    8383 
    8484      DO jn = 1, jptra 
    8585         ! 1. Concentration dillution effect on tra 
     86!CDIR COLLAPSE 
     87         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
     88 
    8689         DO jj = 2, jpj 
    8790            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    9295               ! add the trend to the general tracer trend 
    9396               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ztra 
    94 #if defined key_trc_diatrd 
    95                IF (luttrd(jn)) trtrd(ji,jj,1,ikeep(jn),jpdiatrc) = trtrd(ji,jj,1,jn,jpdiatrc) + ztra 
    96 #endif 
    9797            END DO 
    9898         END DO 
    9999          
    100       END DO 
     100         IF( l_trdtrc ) THEN 
     101!CDIR COLLAPSE 
     102            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     103            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_sbc, kt) 
     104         END IF 
     105 
     106         !                                                       ! =========== 
     107      END DO                                                     ! tracer loop 
     108      !                                                          ! =========== 
     109 
     110      IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
     111 
    101112 
    102113      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

  • trunk/NEMO/TOP_SRC/TRP/trcstp.F90

    r1152 r1175  
    1616   USE trcdia 
    1717   USE trcrst 
     18   USE trdmld_trc_oce 
     19   USE trdmld_trc 
     20   USE trdmld_trc_rst 
    1821 
    1922   IMPLICIT NONE 
    … …  
    5659      ENDIF 
    5760 
    58                        CALL trc_rst_opn( kt )       ! Open tracer restart file  
     61                             CALL trc_rst_opn( kt )       ! Open tracer restart file  
    5962 
    60                        CALL trc_sms( kt )           ! tracers: sink and source 
     63                             CALL trd_mld_trc_rst_opn( kt ) ! Open restart file for trends  
    6164 
    62                        CALL trc_trp( kt )           ! transport of passive tracers 
     65                             CALL trc_sms( kt )           ! tracers: sink and source 
    6366 
    64       IF( lrst_trc )   CALL trc_rst_wri( kt )       ! write tracer restart file 
     67                             CALL trc_trp( kt )           ! transport of passive tracers 
    6568 
    66                        CALL trc_dia( kt, kindic )   ! diagnostics 
     69      IF( lrst_trc )         CALL trc_rst_wri( kt )       ! write tracer restart file 
    6770 
     71                             CALL trc_dia( kt, kindic )   ! diagnostics 
     72 
     73      IF( lk_trdmld_trc  )   CALL trd_mld_trc( kt )     ! trends: Mixed-layer 
    6874 
    6975   END SUBROUTINE trc_stp 

  • trunk/NEMO/TOP_SRC/TRP/trczdf_exp.F90

    r1152 r1175  
    44   !! Ocean passive tracers:  vertical component of the tracer mixing trend using 
    55   !!                        an explicit time-stepping (time spllitting scheme) 
    6    !!============================================================================== 
     6   !!====================================================================== 
     7   !! History :  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   !!                 !  98-03  (L. Bopp MA Foujols) passive tracer generalisation 
     14   !!                 !  00-05  (MA Foujols) add lbc for tracer trends 
     15   !!                 !  00-06  (O Aumont)  correct isopycnal scheme suppress 
     16   !!                 !                     avt multiple correction 
     17   !!                 !  00-08  (G. Madec)  double diffusive mixing 
     18   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     19   !!            9.0  !  04-03  (C. Ethe )  adapted for passive tracers 
     20   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     21   !!---------------------------------------------------------------------- 
    722#if defined key_top 
    823   !!---------------------------------------------------------------------- 
    … …  
    1732   USE trctrp_lec       ! passive tracers transport 
    1833   USE prtctl_trc          ! Print control for debbuging 
     34   USE trdmld_trc 
     35   USE trdmld_trc_oce 
    1936 
    2037   IMPLICIT NONE 
    … …  
    5673      !! 
    5774      !! ** Action : - Update tra with the before vertical diffusion trend 
    58       !!             - Save the trends  in trtrd ('key_trc_diatrd') 
     75      !!             - Save the trends ('key_trdmld_trc') 
    5976      !! 
    60       !! History : 
    61       !!   6.0  !  90-10  (B. Blanke)  Original code 
    62       !!   7.0  !  91-11  (G. Madec) 
    63       !!        !  92-06  (M. Imbard)  correction on tracer trend loops 
    64       !!        !  96-01  (G. Madec)  statement function for e3 
    65       !!        !  97-05  (G. Madec)  vertical component of isopycnal 
    66       !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord 
    67       !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation 
    68       !!        !  00-05  (MA Foujols) add lbc for tracer trends 
    69       !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress 
    70       !!        !                     avt multiple correction 
    71       !!        !  00-08  (G. Madec)  double diffusive mixing 
    72       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    73       !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers 
    7477      !!--------------------------------------------------------------------- 
     78      USE oce_trc, ONLY :   ztrtrd => ua    ! use ua as 3D workspace 
    7579      !! * Arguments 
    7680      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    … …  
    9397      ENDIF 
    9498 
     99      IF( l_trdtrc ) THEN 
     100         STOP 'trczdf_exp: this was never validated, please comment this line to proceed...' 
     101      ENDIF 
     102 
    95103      ! 0. Local constant initialization 
    96104      ! -------------------------------- 
    … …  
    110118 
    111119      DO jn = 1, jptra 
    112  
     120         ! 
     121         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)   ! save trends 
    113122         !                                                ! =============== 
    114123         DO jj = 2, jpjm1                                 !  Vertical slab 
    … …  
    163172         END DO                                           !   End of slab 
    164173         !                                                ! =============== 
    165       END DO 
     174         IF( l_trdtrc ) THEN 
     175            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     176            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_zdf, kt ) 
     177         END IF 
     178 
     179         !                                                    ! =========== 
     180      END DO                                                  ! tracer loop 
     181      !                                                       ! =========== 
    166182 
    167183      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

  • trunk/NEMO/TOP_SRC/TRP/trczdf_imp.F90

    r1152 r1175  
    44   !! Ocean passive tracers:  vertical component of the tracer mixing trend 
    55   !!============================================================================== 
     6   !! History :  6.0  !  90-10  (B. Blanke)  Original code 
     7   !!            7.0  !  91-11  (G. Madec) 
     8   !!                 !  92-06  (M. Imbard)  correction on tracer trend loops 
     9   !!                 !  96-01  (G. Madec)  statement function for e3 
     10   !!                 !  97-05  (G. Madec)  vertical component of isopycnal 
     11   !!                 !  97-07  (G. Madec)  geopotential diffusion in s-coord 
     12   !!                 !  98-03  (L. Bopp MA Foujols) passive tracer generalisation 
     13   !!                 !  00-05  (MA Foujols) add lbc for tracer trends 
     14   !!                 !  00-06  (O Aumont)  correct isopycnal scheme suppress 
     15   !!                 !                     avt multiple correction 
     16   !!                 !  00-08  (G. Madec)  double diffusive mixing 
     17   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     18   !!            9.0  !  04-03  (C. Ethe )  adapted for passive tracers 
     19   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     20   !!---------------------------------------------------------------------- 
    621#if defined key_top 
    722   !!---------------------------------------------------------------------- 
    … …  
    1631   USE trctrp_lec          ! passive tracers transport 
    1732   USE prtctl_trc 
     33   USE trdmld_trc 
     34   USE trdmld_trc_oce 
    1835 
    1936   IMPLICIT NONE 
    … …  
    5572      !! 
    5673      !! ** Action  : - Update tra with the before vertical diffusion trend 
    57       !!              - save the trends in trtrd ('key_trc_diatrd') 
    58       !! 
    59       !! History : 
    60       !!   6.0  !  90-10  (B. Blanke)  Original code 
    61       !!   7.0  !  91-11  (G. Madec) 
    62       !!        !  92-06  (M. Imbard)  correction on tracer trend loops 
    63       !!        !  96-01  (G. Madec)  statement function for e3 
    64       !!        !  97-05  (G. Madec)  vertical component of isopycnal 
    65       !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord 
    66       !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation 
    67       !!        !  00-05  (MA Foujols) add lbc for tracer trends 
    68       !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress 
    69       !!        !                     avt multiple correction 
    70       !!        !  00-08  (G. Madec)  double diffusive mixing 
    71       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    72       !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers 
     74      !!              - save the trends  
     75      !! 
    7376      !!--------------------------------------------------------------------- 
     77      USE oce_trc, ONLY : ztrtrd => ua      ! use ua as 3D workspace 
     78      !! 
    7479      !! * Arguments 
    7580      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    … …  
    8186         zwx, zwy, zwt              ! ??? 
    8287      REAL(wp) ::  ztra      ! temporary scalars 
    83  
    8488      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   & 
    8589         ztrd 
    … …  
    105109         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)       
    106110      ENDIF 
    107  
    108       DO jn = 1 , jptra 
     111     !                                                       ! =========== 
     112      DO jn = 1, jptra                                        ! tracer loop 
     113         !                                                    ! =========== 
     114         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)         ! ??? validation needed 
    109115 
    110116    ! Initialisation      
    … …  
    208214        END DO 
    209215 
    210           
    211216#if defined key_trc_diatrd 
    212217         ! Compute and save the vertical diffusive of tracers trends 
    … …  
    230235         END DO 
    231236#  endif 
    232 #endif   
     237#endif 
     238 
    233239         ! Save the masked passive tracer after in tra 
    234240         ! (c a u t i o n:  tracer not its trend, Leap-frog scheme done 
    … …  
    241247            END DO 
    242248         END DO 
     249 
     250         IF( l_trdtrc ) THEN                            ! trends 
     251            DO jk = 1, jpkm1 
     252               ztrtrd(:,:,jk) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / rdttrc(jk) ) - ztrtrd(:,:,jk) 
     253            END DO 
     254            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zdf, kt) 
     255         END IF 
    243256 
    244257         IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    253266         ENDIF 
    254267 
    255       END DO 
     268         !                                                    ! =========== 
     269      END DO                                                  ! tracer loop 
     270      !                                                       ! =========== 
    256271 
    257272      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

  • trunk/NEMO/TOP_SRC/TRP/trczdf_iso.F90

    r1152 r1175  
    44   !! Ocean passive tracers:  vertical component of the tracer mixing trend 
    55   !!============================================================================== 
     6   !! History :  7.0  !  91-11  (G. Madec)  Original code 
     7   !!                 !  92-06  (M. Imbard)  correction on tracer trend loops 
     8   !!                 !  96-01  (G. Madec)  statement function for e3 
     9   !!                 !  97-05  (G. Madec)  vertical component of isopycnal 
     10   !!                 !  97-07  (G. Madec)  geopotential diffusion in s-coord 
     11   !!                 !  98-03  (L. Bopp MA Foujols) passive tracer generalisation 
     12   !!                 !  00-05  (MA Foujols) add lbc for tracer trends 
     13   !!                 !  00-06  (O Aumont)  correct isopycnal scheme suppress 
     14   !!                 !                     avt multiple correction 
     15   !!                 !  00-08  (G. Madec)  double diffusive mixing 
     16   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     17   !!            9.0  !  04-03  (C. Ethe )  adapted for passive tracers 
     18   !!---------------------------------------------------------------------- 
    619#if defined key_top  &&  ( defined key_ldfslp   ||   defined key_esopa ) 
    720   !!---------------------------------------------------------------------- 
    … …  
    1831   USE lbclnk           ! ocean lateral boundary conditions (or mpp link) 
    1932   USE trctrp_lec       ! passive tracers transport 
     33   USE trdmld_trc 
     34   USE trdmld_trc_oce 
    2035   USE prtctl_trc          ! Print control for debbuging 
    2136 
    … …  
    94109      !!         (avs = zavs if lk_trc_zdfddm=T ) 
    95110      !! 
    96       !!      'key_trc_diatrd' defined: trend saved for futher diagnostics. 
     111      !!      'key_trdmld_trc' defined: trend saved for futher diagnostics. 
    97112      !! 
    98113      !!      macro-tasked on vertical slab (jj-loop) 
    … …  
    100115      !! ** Action : 
    101116      !!         Update tra arrays with the before vertical diffusion trend 
    102       !!         Save in trtrd arrays the trends if 'key_trc_diatrd' defined 
    103       !! 
    104       !! History : 
    105       !!   7.0  !  91-11  (G. Madec)  Original code 
    106       !!        !  92-06  (M. Imbard)  correction on tracer trend loops 
    107       !!        !  96-01  (G. Madec)  statement function for e3 
    108       !!        !  97-05  (G. Madec)  vertical component of isopycnal 
    109       !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord 
    110       !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation 
    111       !!        !  00-05  (MA Foujols) add lbc for tracer trends 
    112       !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress 
    113       !!        !                     avt multiple correction 
    114       !!        !  00-08  (G. Madec)  double diffusive mixing 
    115       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    116       !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers 
     117      !!         Save in trtrd arrays the trends if 'key_trdmld_trc' defined 
    117118      !!--------------------------------------------------------------------- 
    118119      !! * Modules used 
    119       USE oce_trc               ,   & 
    120          zavs => va 
     120      USE oce_trc , ONLY :    zavs => va, ztrtrd => ua 
    121121 
    122122      !! * Arguments 
    … …  
    147147         zcoeg3,          & 
    148148         zuwk, zvwk,      & 
    149          zuwki, zvwki 
     149         zuwki, zvwki, z_hdivn_z 
    150150#endif 
    151151      CHARACTER (len=22) :: charout 
     152      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztrtrd_tmp 
    152153      !!--------------------------------------------------------------------- 
    153154 
    … …  
    160161#endif 
    161162      ENDIF 
     163 
    162164 
    163165      ! 0.0  Local constant initialization 
    … …  
    183185 
    184186      DO jn = 1, jptra 
     187 
     188         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends 
    185189 
    186190         ztavg = 0.e0 
    … …  
    338342                  ztav = (  ztfw(ji,jk) - ztfw(ji,jk+1)  ) * zbtr 
    339343                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztav 
    340  
    341344#if defined key_trc_diatrd 
    342345#   if defined key_trcldf_eiv 
    … …  
    344347                  !  WARNING trtrd(ji,jj,jk,6) used for vertical gent velocity trend 
    345348                  !                           not for damping !!! 
    346                   IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),9) = ztavg 
     349                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztavg 
    347350#   endif 
    348351                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - ztavg 
    349352#endif 
     353 
    350354               END DO 
    351355            END DO 
    … …  
    353357         END DO                                           !   End of slab 
    354358         !                                                ! =============== 
     359         ! II. Save the trends for diagnostics 
     360         ! =================================== 
     361         IF( l_trdtrc ) THEN 
     362#   if defined key_trcldf_eiv 
     363 
     364            ! II.1) Compute the eiv VERTICAL trend 
     365            DO jj = 2, jpjm1 
     366               DO jk = 1, jpkm1 
     367                  DO ji = 2, jpim1 
     368 
     369                     !-- Compute the eiv vertical divergence : 1/e3t ( dk[w_eiv] ) 
     370                     !   N.B. This is only possible if key_diaeiv is switched on. 
     371                     !     Else, the vertical eiv is not diagnosed, 
     372                     !     so we can only store the flux form trend d_z ( T * w_eiv ) 
     373                     !     instead of w_eiv * d_z( T ). Then, ONLY THE SUM of zonal, 
     374                     !     meridional, and vertical trends are valid. 
     375#       if defined key_diaeiv 
     376                     z_hdivn_z = ( 1./e3t(jk) ) * ( w_trc_eiv(ji,jj,jk) - w_trc_eiv(ji,jj,jk+1) ) 
     377#       else 
     378                     z_hdivn_z = 0.e0 
     379#       endif 
     380                     !-- Compute the vertical advective trend associated with eiv 
     381                     zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
     382                     ztrtrd_tmp(ji,jj,jk) = (  ztfwg(ji,jk) - ztfwg(ji,jk+1)  ) * zbtr   & 
     383                          &                 - trn(ji,jj,jk,jn) * z_hdivn_z 
     384                  END DO 
     385               END DO 
     386            END DO 
     387 
     388            ! II.2) Save the vertical eiv trend 
     389            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_tmp, jn, jptrc_trd_zei, kt ) 
     390 
     391#   endif 
     392 
     393            !-- Remove vert. eiv from the current up-to-date trend 
     394            !   N.B. ztrtrd_tmp is recycled for this purpose 
     395            ztrtrd_tmp(:,:,:) = ( tra(:,:,:,jn) - ztrtrd(:,:,:) ) - ztrtrd_tmp(:,:,:) 
     396 
     397            ! Save the new trends 
     398            ztrtrd(:,:,:) = tra(:,:,:,jn) 
     399         END IF 
     400 
    355401 
    356402      END DO 
    … …  
    420466#  endif 
    421467#endif 
     468            ! Compute and save the vertical diffusive of tracers trends 
    422469            ! Save the masked passive tracer after in tra 
    423470            ! (c a u t i o n:  tracer not its trend, Leap-frog scheme done 
    … …  
    431478         END DO                                           !   End of slab 
    432479         !                                                ! =============== 
     480 
     481         ! IV. Save the trends for diagnostics 
     482         ! =================================== 
     483         IF( l_trdtrc ) THEN 
     484            ! deduce the full vertical diff. trend (except for vertical eiv advection) 
     485#if defined key_trc_ldfiso 
     486            DO jk = 1, jpkm1 
     487               ztrtrd(:,:,jk) = ( (tra(:,:,jk,jn) - trb(:,:,jk,jn))/rdttrc(jk) ) - ztrtrd(:,:,jk) + ztrtrd_tmp(:,:,jk) 
     488            END DO 
     489#else 
     490            DO jk = 1, jpkm1 
     491               ztrtrd(:,:,jk) = ( (tra(:,:,jk,jn) - trb(:,:,jk,jn))/rdttrc(jk) ) - ztrtrd(:,:,jk) 
     492            END DO 
     493#endif 
     494            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_zdf, kt ) 
     495 
     496         END IF 
    433497 
    434498      END DO 

  • trunk/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90

    r1152 r1175  
    11MODULE trczdf_iso_vopt 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                 ***  MODULE  trczdf_iso_vopt  *** 
    44   !! Ocean passive tracers:  vertical component of the tracer mixing trend 
    5    !!============================================================================== 
    6 #if defined key_top  &&  ( defined key_ldfslp   ||   defined key_esopa ) 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_top'      and                                       TOP models 
     5   !!====================================================================== 
     6   !! History :  6.0  !  90-10 (B. Blanke)  Original code 
     7   !!            7.0  !  91-11 (G. Madec) 
     8   !!                 !  92-06 (M. Imbard) correction on tracer trend loops 
     9   !!                 !  96-01 (G. Madec) statement function for e3 
     10   !!                 !  97-05 (G. Madec) vertical component of isopycnal 
     11   !!                 !  97-07 (G. Madec) geopotential diffusion in s-coord 
     12   !!                 !  98-03  (L. Bopp MA Foujols) passive tracer generalisation 
     13   !!                 !  00-05  (MA Foujols) add lbc for tracer trends 
     14   !!                 !  00-06  (O Aumont)  correct isopycnal scheme suppress 
     15   !!                 !                     avt multiple correction 
     16   !!                 !  00-08  (G. Madec)  double diffusive mixing 
     17   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     18   !!            9.0  !  04-03  (C. Ethe )  adapted for passive tracers 
     19   !!                 !  06-08  (C. Deltel) Diagnose ML trends for passive tracer 
     20   !!---------------------------------------------------------------------- 
     21#if defined key_top && ( defined key_ldfslp   ||   defined key_esopa ) 
     22   !!---------------------------------------------------------------------- 
    923   !!   'key_ldfslp'                  rotation of the lateral mixing tensor 
    1024   !!---------------------------------------------------------------------- 
    … …  
    1630   !!   trc_zdf_zdf  : 
    1731   !!---------------------------------------------------------------------- 
    18    !! * Modules used 
    19    USE oce_trc         ! ocean dynamics and tracers variables 
    20    USE trp_trc             ! ocean passive tracers variables  
    21    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    22    USE trctrp_lec      ! passive tracers transport 
    23    USE prtctl_trc          ! Print control for debbuging 
     32   USE oce_trc               ! ocean dynamics and tracers variables 
     33   USE trp_trc                   ! ocean passive tracers variables  
     34   USE lbclnk                ! ocean lateral boundary conditions (or mpp link) 
     35   USE trctrp_lec 
     36   USE prtctl_trc            ! Print control for debbuging 
     37   USE trdmld_trc 
     38   USE trdmld_trc_oce      
    2439 
    2540   IMPLICIT NONE 
    2641   PRIVATE 
    2742 
    28    !! * Routine accessibility 
    2943   PUBLIC trc_zdf_iso_vopt   !  routine called by step.F90 
    3044 
    31    !! * Module variables 
    32    REAL(wp), DIMENSION(jpk) ::  & 
    33       rdttrc                          ! vertical profile of 2 x time-step 
     45   REAL(wp), DIMENSION(jpk) ::   rdttrc                    ! vertical profile of 2 x time-step 
     46   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrcavg  ! workspace arrays 
    3447 
    3548   !! * Substitutions 
    … …  
    3750   !!---------------------------------------------------------------------- 
    3851   !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    39    !! $Id$  
    40    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     52   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90,v 1.11 2007/02/21 12:55:33 opalod Exp $  
     53   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4154   !!---------------------------------------------------------------------- 
    4255 
    … …  
    5063      !! ** Method  : 
    5164      !! ** Action  : 
    52       !! 
    53       !! History : 
    54       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    55       !!   9.0  !  04-03  (C. Ethe)   adapted for passive tracers 
    5665      !!--------------------------------------------------------------------- 
    57       !! * Arguments 
    5866      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    5967      CHARACTER (len=22) :: charout 
    … …  
    6977      ENDIF 
    7078 
     79      IF( l_trdtrc ) THEN 
     80         ALLOCATE( ztrcavg(jpi,jpj,jpk,jptra) ) 
     81!CDIR COLLAPSE 
     82         ztrcavg(:,:,:,:) = 0.e0          ! initialisation step 
     83      ENDIF 
    7184 
    7285      ! I. vertical extra-diagonal part of the rotated tensor 
    7386      ! ----------------------------------------------------- 
    7487 
    75       CALL trc_zdf_iso 
    76  
    77       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     88      CALL trc_zdf_iso( kt ) 
     89 
     90      IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    7891         WRITE(charout, FMT="('zdf - 1')") 
    79          CALL prt_ctl_trc_info(charout) 
    80          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     92         CALL prt_ctl_trc_info( charout ) 
     93         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    8194      ENDIF 
    8295 
    … …  
    8699      CALL trc_zdf_zdf( kt ) 
    87100 
    88       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     101      IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    89102         WRITE(charout, FMT="('zdf - 2')") 
    90          CALL prt_ctl_trc_info(charout) 
    91          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     103         CALL prt_ctl_trc_info( charout ) 
     104         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    92105      ENDIF 
     106 
     107      IF( l_trdtrc ) DEALLOCATE( ztrcavg ) 
    93108 
    94109   END SUBROUTINE trc_zdf_iso_vopt 
    … …  
    135150      !! 
    136151      !! ** Action  : - Update tra with before vertical diffusion trend 
    137       !!              - Save the trend in trtrd  ('key_trc_diatrd') 
    138       !! 
    139       !! History : 
    140       !!   6.0  !  90-10  (B. Blanke)  Original code 
    141       !!   7.0  !  91-11 (G. Madec) 
    142       !!        !  92-06 (M. Imbard) correction on tracer trend loops 
    143       !!        !  96-01 (G. Madec) statement function for e3 
    144       !!        !  97-05 (G. Madec) vertical component of isopycnal 
    145       !!        !  97-07 (G. Madec) geopotential diffusion in s-coord 
    146       !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation 
    147       !!        !  00-05  (MA Foujols) add lbc for tracer trends 
    148       !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress 
    149       !!        !                     avt multiple correction 
    150       !!        !  00-08  (G. Madec)  double diffusive mixing 
    151       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    152       !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers 
     152      !!              - Save the trend in trtrd  ('key_trdmld_trc') 
    153153      !!--------------------------------------------------------------------- 
    154       !! * Modules used 
    155154      USE oce_trc, ONLY :   zwd   => ua,  &  ! ua, va used as 
    156155                            zws   => va      ! workspace 
    157       !! * Arguments 
    158156      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    159  
    160       !! * Local declarations 
    161       INTEGER ::   ji, jj, jk,jn                ! dummy loop indices 
    162       REAL(wp) ::   & 
    163          zavi, zrhs                          ! temporary scalars 
     157      INTEGER ::   ji, jj, jk, jn            ! dummy loop indices 
     158      REAL(wp) ::   zavi, zrhs               ! temporary scalars 
    164159      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    165160         zwi, zwt, zavsi                     ! temporary workspace arrays 
    166       REAL(wp) ::    ztra              !temporary scalars 
     161      REAL(wp) ::   ztra                     ! temporary scalars 
    167162#  if defined key_trc_diatrd 
    168163      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrd 
    169164#  endif 
     165      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    170166      !!--------------------------------------------------------------------- 
    171167 
    … …  
    185181      ENDIF 
    186182 
    187       DO jn = 1, jptra 
     183      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     184 
     185      !                                                          ! =========== 
     186      DO jn = 1, jptra                                           ! tracer loop 
     187         !                                                       ! =========== 
    188188          
    189          zwd( 1 ,:,:)=0.e0     ;     zwd(jpi,:,:)=0.e0 
    190          zws( 1 ,:,:)=0.e0     ;     zws(jpi,:,:)=0.e0 
    191          zwi( 1 ,:,:)=0.e0     ;     zwi(jpi,:,:)=0.e0 
    192  
    193          zwt( 1 ,:,:)=0.e0     ;     zwt(jpi,:,:)=0.e0 
    194          zwt(  :,:,1)=0.e0     ;     zwt(:,:,jpk)= 0.e0 
    195          zavsi( 1 ,:,:)=0.e0   ;     zavsi(jpi,:,:)=0.e0  
    196          zavsi(  :,:,1)=0.e0   ;     zavsi(:,:,jpk)=0.e0 
     189!CDIR COLLAPSE 
     190         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends 
     191          
     192         zwd  ( 1, :, : ) = 0.e0    ;     zwd  ( jpi, :,   : ) = 0.e0 
     193         zws  ( 1, :, : ) = 0.e0    ;     zws  ( jpi, :,   : ) = 0.e0 
     194         zwi  ( 1, :, : ) = 0.e0    ;     zwi  ( jpi, :,   : ) = 0.e0 
     195         zwt  ( 1, :, : ) = 0.e0    ;     zwt  ( jpi, :,   : ) = 0.e0 
     196         zwt  ( :, :, 1 ) = 0.e0    ;     zwt  (   :, :, jpk ) = 0.e0 
     197         zavsi( 1, :, : ) = 0.e0    ;     zavsi( jpi, :,   : ) = 0.e0  
     198         zavsi( :, :, 1 ) = 0.e0    ;     zavsi(   :, :, jpk ) = 0.e0 
    197199 
    198200#  if defined key_trc_diatrd 
    … …  
    224226 
    225227 
    226          ! II.2 Vertical diffusion on tracer 
    227          ! ---------------------------======== 
     228         ! II.1 Vertical diffusion on tracer 
     229         ! --------------------------------- 
    228230 
    229231         ! Rebuild the Matrix as avt /= avs 
    … …  
    313315#if defined key_trc_diatrd 
    314316         ! Compute and save the vertical diffusive passive tracer trends 
    315 #  if defined key_trcldf_iso  
     317#  if defined key_trcldf_iso 
    316318         DO jk = 1, jpkm1 
    317319            DO jj = 2, jpjm1 
    … …  
    334336#endif 
    335337 
    336       END DO 
     338 
     339         ! III. Save vertical trend assoc. with the vertical physics for diagnostics 
     340         ! ========================================================================= 
     341         IF( l_trdtrc )   THEN 
     342 
     343            ! III.1) Deduce the full vertical diff. trend (except for vertical eiv advection) 
     344            ! N.B. tavg & savg contain the contribution from the extra diagonal part 
     345            !   of the rotated tensor (from trc_zdf_iso). 
     346            IF( ln_trcldf_iso ) THEN 
     347!CDIR COLLAPSE 
     348               DO jk = 1, jpkm1 
     349                  ztrtrd(:,:,jk) = ( (tra(:,:,jk,jn) - trb(:,:,jk,jn))/rdttrc(jk) ) - ztrtrd(:,:,jk)  & 
     350                       &           + ztrcavg(:,:,jk,jn)  
     351               END DO 
     352            ELSE 
     353!CDIR COLLAPSE 
     354               DO jk = 1, jpkm1 
     355                  ztrtrd(:,:,jk) = ( (tra(:,:,jk,jn) - trb(:,:,jk,jn))/rdttrc(jk) ) - ztrtrd(:,:,jk) 
     356               END DO 
     357            ENDIF 
     358             
     359            ! III.2) save the trends for diagnostic 
     360            ! N.B. However the purely vertical diffusion "K_z" (included here) will be deduced 
     361            !   and removed from this trend before storage. It is stored separately, so as to 
     362            !   clearly distinguish both contributions (see trd_mld) 
     363            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_zdf, kt ) 
     364 
     365         END IF 
     366         !                                                    ! =========== 
     367      END DO                                                  ! tracer loop 
     368      !                                                       ! =========== 
     369       
     370      IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
    337371 
    338372   END SUBROUTINE trc_zdf_zdf 
    339373 
    340374 
    341    SUBROUTINE trc_zdf_iso 
     375   SUBROUTINE trc_zdf_iso( kt ) 
    342376      !!---------------------------------------------------------------------- 
    343377      !!                  ***  ROUTINE trc_zdf_iso  *** 
    … …  
    376410      !! ** Action : 
    377411      !!         Update tra arrays with the before vertical diffusion trend 
    378       !!         Save in trtrd arrays the trends if 'key_trc_diatrd' defined 
    379       !! 
    380       !! History : 
    381       !!   6.0  !  90-10  (B. Blanke)  Original code 
    382       !!   7.0  !  91-11  (G. Madec) 
    383       !!        !  92-06  (M. Imbard) correction on tracer trend loops 
    384       !!        !  96-01  (G. Madec) statement function for e3 
    385       !!        !  97-05  (G. Madec) vertical component of isopycnal 
    386       !!        !  97-07  (G. Madec) geopotential diffusion in s-coord 
    387       !!        !  98-03  (L. Bopp MA Foujols) passive tracer generalisation 
    388       !!        !  00-05  (MA Foujols) add lbc for tracer trends 
    389       !!        !  00-06  (O Aumont)  correct isopycnal scheme suppress 
    390       !!        !                     avt multiple correction 
    391       !!        !  00-08  (G. Madec)  double diffusive mixing 
    392       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    393       !!   9.0  !  04-03  (C. Ethe )  adapted for passive tracers 
     412      !!         Save in trtrd arrays the trends if 'key_trdmld_trc' defined 
    394413      !!--------------------------------------------------------------------- 
    395       !! * Modules used 
    396414      USE oce_trc, ONLY :   zwx => ua,  &  ! use ua, va as 
    397415                            zwy => va      ! workspace arrays 
    398416 
    399       !! * Local declarations 
    400       INTEGER ::   ji, jj, jk,jn       ! dummy loop indices 
    401       INTEGER ::   iku, ikv 
    402       REAL(wp) ::   & 
    403          ztavg,                  &  ! temporary scalars 
    404          zcoef0, zcoef3,         &  !    "         " 
    405          zcoef4,                 &  !    "         " 
    406          zbtr, zmku, zmkv,       &  !    "         " 
    407 #if defined key_trcldf_eiv 
    408          zcoeg3,                 &  !    "         " 
    409          zuwki, zvwki,           &  !    "         " 
    410          zuwk, zvwk,             &  !    "         " 
     417      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index 
     418      INTEGER ::   ji, jj, jk, jn                ! dummy loop indices 
     419      INTEGER ::   iku, ikv                       
     420      REAL(wp) ::   ztavg                        ! temporary scalars 
     421      REAL(wp) ::   zcoef0, zcoef3               !    "         " 
     422      REAL(wp) ::   zcoef4                       !    "         " 
     423      REAL(wp) ::   zbtr, zmku, zmkv             !    "         " 
     424#if defined key_trcldf_eiv                        
     425      REAL(wp) ::   zcoeg3, z_hdivn_z            !    "         " 
     426      REAL(wp) ::   zuwki, zvwki                 !    "         " 
     427      REAL(wp) ::   zuwk, zvwk                   !    "         " 
    411428#endif 
    412          ztav 
    413       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    414          zwz, zwt, ztfw             ! temporary workspace arrays 
     429      REAL(wp) ::   ztav 
     430      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz  ! temporary workspace arrays 
     431      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwt 
     432      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztfw 
     433      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    415434      !!--------------------------------------------------------------------- 
    416435 
    417       DO jn = 1, jptra 
     436 
     437      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     438 
     439      !                                                          ! =========== 
     440      DO jn = 1, jptra                                           ! tracer loop 
     441         !                                                       ! =========== 
    418442 
    419443         ! 0. Local constant initialization 
    420444         ! -------------------------------- 
     445         zwx (1,:,:) = 0.e0    ;     zwx (jpi,:,:) = 0.e0 
     446         zwy (1,:,:) = 0.e0    ;     zwy (jpi,:,:) = 0.e0 
     447         zwz (1,:,:) = 0.e0    ;     zwz (jpi,:,:) = 0.e0 
     448         zwt (1,:,:) = 0.e0    ;     zwt (jpi,:,:) = 0.e0 
     449         ztfw(1,:,:) = 0.e0    ;     ztfw(jpi,:,:) = 0.e0 
     450 
     451!CDIRR COLLAPSE 
     452         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends 
     453 
    421454         ztavg = 0.e0 
    422  
    423          zwx( 1 ,:,:)=0.e0     ;     zwx(jpi,:,:)=0.e0 
    424          zwy( 1 ,:,:)=0.e0     ;     zwy(jpi,:,:)=0.e0 
    425          zwz( 1 ,:,:)=0.e0     ;     zwz(jpi,:,:)=0.e0 
    426          zwt( 1 ,:,:)=0.e0     ;     zwt(jpi,:,:)=0.e0 
    427          ztfw( 1 ,:,:)=0.e0    ;     ztfw(jpi,:,:)=0.e0 
    428455 
    429456         ! I. Vertical trends associated with lateral mixing 
    430457         ! ------------------------------------------------- 
    431458         !    (excluding the vertical flux proportional to dk[t] ) 
    432  
    433459 
    434460         ! I.1 horizontal tracer gradient 
    … …  
    460486         ENDIF 
    461487 
    462  
    463488         ! I.2 Vertical fluxes 
    464489         ! ------------------- 
    … …  
    536561#endif 
    537562 
    538          ! I.5 Divergence of vertical fluxes added to the general tracer trend 
     563         ! I.3 Divergence of vertical fluxes added to the general tracer trend 
    539564         ! ------------------------------------------------------------------- 
    540565 
    … …  
    549574                  ztavg = ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * zbtr 
    550575                  !  WARNING trtrd(ji,jj,jk,7) used for vertical gent velocity trend  not for damping !!! 
    551                   IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),9) = ztavg 
     576                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),7) = ztavg 
    552577#   endif 
    553578                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - ztavg 
    554579#endif 
    555                END DO 
    556             END DO 
    557          END DO 
    558  
    559       END DO 
     580 
     581               END DO 
     582            END DO 
     583         END DO 
     584 
     585         ! II. Save the trends for diagnostics 
     586         ! ----------------------------------- 
     587         IF( l_trdtrc )   THEN 
     588#if defined key_trcldf_eiv 
     589 
     590            ! II.1) Compute the eiv VERTICAL trend 
     591!CDIRR COLLAPSE 
     592            DO jk = 1, jpkm1 
     593               DO jj = 2, jpjm1 
     594                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     595                      
     596                     !-- Compute the eiv vertical divergence : 1/e3t ( dk[w_eiv] ) 
     597                     !   N.B. This is only possible if key_diaeiv is switched on. 
     598                     !     Else, the vertical eiv is not diagnosed, 
     599                     !     so we can only store the flux form trend d_z ( T * w_eiv ) 
     600                     !     instead of w_eiv * d_z( T ). Then, ONLY THE SUM of zonal, 
     601                     !     meridional, and vertical trends are valid. 
     602#   if defined key_diaeiv 
     603                     z_hdivn_z = ( 1./e3t(jk) ) * ( w_trc_eiv(ji,jj,jk) - w_trc_eiv(ji,jj,jk+1) ) 
     604#   else 
     605                     z_hdivn_z = 0.e0 
     606#   endif 
     607                     zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
     608                     ztrcavg(ji,jj,jk,jn) = ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * zbtr & 
     609                           &                - trn(ji,jj,jk,jn) * z_hdivn_z 
     610                  END DO 
     611               END DO 
     612            END DO 
     613 
     614            ! II.2) save the trends for diagnostic 
     615            !       N.B. The other part of the computed trend is stored below for later 
     616            !         output (see trc_zdf_zdf)   
     617            IF (luttrd(jn)) CALL trd_mod_trc( ztrcavg(:,:,:,jn), jn, jptrc_trd_zei, kt ) 
     618 
     619#endif 
     620            !-- Retain only the vertical diff. trends due to the extra diagonal 
     621            !   part of the rotated tensor (i.e. remove vert. eiv from the trend) 
     622            !   N.B. ztrcavg is recycled for this purpose 
     623            ztrcavg(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:) - ztrcavg(:,:,:,jn) 
     624 
     625          END IF 
     626 
     627         !                                                       ! =========== 
     628      END DO                                                     ! tracer loop 
     629      !                                                          ! =========== 
     630 
     631      IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
    560632 
    561633   END SUBROUTINE trc_zdf_iso 

  • trunk/NEMO/TOP_SRC/TRP/trdmld_trc.F90

    r1174 r1175  
    3636   PRIVATE 
    3737 
     38   INTERFACE trd_mod_trc 
     39      MODULE PROCEDURE trd_mod_trc_trp, trd_mod_trc_bio 
     40   END INTERFACE 
     41 
    3842   PUBLIC trd_mod_trc                                             ! routine called by step.F90 
    3943   PUBLIC trd_mld_trc 
     44   PUBLIC trd_mld_bio 
    4045   PUBLIC trd_mld_trc_init 
    4146 
    … …  
    4651   INTEGER ::   ndimtrd1                         
    4752   INTEGER, SAVE ::  ionce, icount 
     53#if defined key_lobster 
     54   INTEGER ::   nidtrdbio, nh_tb 
     55   INTEGER, SAVE ::  ioncebio, icountbio 
     56   INTEGER, SAVE ::   nmoymltrdbio 
     57#endif 
    4858   LOGICAL :: llwarn  = .TRUE.                                    ! this should always be .TRUE. 
    4959   LOGICAL :: lldebug = .TRUE. 
    … …  
    5969CONTAINS 
    6070 
    61    SUBROUTINE trd_mod_trc( ptrtrd, kjn, ktrd, kt ) 
     71   SUBROUTINE trd_mod_trc_trp( ptrtrd, kjn, ktrd, kt ) 
    6272      !!---------------------------------------------------------------------- 
    6373      !!                  ***  ROUTINE trd_mod_trc  *** 
    … …  
    102112         CASE ( jptrc_trd_dmp     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_dmp    , '3D', kjn ) 
    103113         CASE ( jptrc_trd_sbc     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sbc    , '2D', kjn ) 
    104 #if defined key_lobster 
    105          CASE ( jptrc_trd_sms_sed )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sms_sed, '3D', kjn ) 
    106          CASE ( jptrc_trd_sms_bio )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sms_bio, '3D', kjn ) 
    107          CASE ( jptrc_trd_sms_exp )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sms_exp, '3D', kjn ) 
    108 #else 
    109114         CASE ( jptrc_trd_sms     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sms    , '3D', kjn ) 
    110 #endif 
    111115         CASE ( jptrc_trd_bbc     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_bbc    , '3D', kjn ) 
    112116         CASE ( jptrc_trd_radb    )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_radb   , '3D', kjn ) 
    … …  
    116120 
    117121 
    118    END SUBROUTINE trd_mod_trc 
     122   END SUBROUTINE trd_mod_trc_trp 
     123 
     124   SUBROUTINE trd_mod_trc_bio( ptrbio, ktrd, kt ) 
     125      !!---------------------------------------------------------------------- 
     126      !!                  ***  ROUTINE trd_mod_bio  *** 
     127      !!---------------------------------------------------------------------- 
     128 
     129      INTEGER, INTENT( in )  ::   kt                                  ! time step 
     130      INTEGER, INTENT( in )  ::   ktrd                                ! bio trend index 
     131      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrbio  ! Bio trend 
     132      !!---------------------------------------------------------------------- 
     133 
     134      CALL trd_mld_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends 
     135 
     136   END SUBROUTINE trd_mod_trc_bio 
     137 
    119138 
    120139   SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn ) 
    … …  
    230249    END SUBROUTINE trd_mld_trc_zint 
    231250     
     251    SUBROUTINE trd_mld_bio_zint( ptrc_trdmld, ktrd ) 
     252      !!---------------------------------------------------------------------- 
     253      !!                  ***  ROUTINE trd_mld_bio_zint  *** 
     254      !! 
     255      !! ** Purpose :   Compute the vertical average of the 3D fields given as arguments 
     256      !!                to the subroutine. This vertical average is performed from ocean 
     257      !!                surface down to a chosen control surface. 
     258      !! 
     259      !! ** Method/usage : 
     260      !!      The control surface can be either a mixed layer depth (time varying) 
     261      !!      or a fixed surface (jk level or bowl). 
     262      !!      Choose control surface with nctls in namelist NAMTRD : 
     263      !!        nctls_trc = 0  : use mixed layer with density criterion 
     264      !!        nctls_trc = 1  : read index from file 'ctlsurf_idx' 
     265      !!        nctls_trc > 1  : use fixed level surface jk = nctls_trc 
     266      !!      Note: in the remainder of the routine, the volume between the 
     267      !!            surface and the control surface is called "mixed-layer" 
     268      !!---------------------------------------------------------------------- 
     269      INTEGER, INTENT( in ) ::   ktrd          ! bio trend index 
     270      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmld ! passive trc trend 
     271#if defined key_lobster 
     272      !! local variables 
     273      INTEGER ::   ji, jj, jk, isum 
     274      REAL(wp), DIMENSION(jpi,jpj) ::  zvlmsk 
     275      !!---------------------------------------------------------------------- 
     276 
     277      ! I. Definition of control surface and integration weights 
     278      ! -------------------------------------------------------- 
     279      !            ==> only once per time step <== 
     280 
     281      IF( icountbio == 1 ) THEN 
     282         ! 
     283         tmltrd_bio(:,:,:) = 0.e0    ! <<< reset trend arrays to zero 
     284         ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer 
     285         SELECT CASE ( nctls_trc )                                    ! choice of the control surface 
     286            CASE ( -2  )   ;   STOP 'trdmld_trc : not ready '     !     -> isopycnal surface (see ???) 
     287            CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion 
     288            CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl) 
     289            CASE (  1  )   ;   nmld_trc(:,:) = nbol_trc(:,:)          !     -> read index from file 
     290            CASE (  2: )   ;   nctls_trc = MIN( nctls_trc, jpktrd_trc - 1 ) 
     291                               nmld_trc(:,:) = nctls_trc + 1          !     -> model level 
     292         END SELECT 
     293 
     294         ! ... Compute ndextrd1 and ndimtrd1 only once 
     295         IF( ioncebio == 1 ) THEN 
     296            ! 
     297            ! Check of validity : nmld_trc(ji,jj) <= jpktrd_trc 
     298            isum        = 0 
     299            zvlmsk(:,:) = 0.e0 
     300 
     301            IF( jpktrd_trc < jpk ) THEN 
     302               DO jj = 1, jpj 
     303                  DO ji = 1, jpi 
     304                     IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
     305                        zvlmsk(ji,jj) = tmask(ji,jj,1) 
     306                     ELSE 
     307                        isum = isum + 1 
     308                        zvlmsk(ji,jj) = 0. 
     309                     END IF 
     310                  END DO 
     311               END DO 
     312            END IF 
     313 
     314            ! Index of ocean points (2D only) 
     315            IF( isum > 0 ) THEN 
     316               WRITE(numout,*)' tmltrd_trc : Number of invalid points nmld_trc > jpktrd', isum 
     317               CALL wheneq( jpi*jpj, zvlmsk(:,:) , 1, 1., ndextrd1, ndimtrd1 ) 
     318            ELSE 
     319               CALL wheneq( jpi*jpj, tmask(:,:,1), 1, 1., ndextrd1, ndimtrd1 ) 
     320            END IF 
     321 
     322            ioncebio = 0                  ! no more pass here 
     323            ! 
     324         END IF !  ( ioncebio == 1 ) 
     325 
     326         ! ... Weights for vertical averaging 
     327         wkx_trc(:,:,:) = 0.e0 
     328         DO jk = 1, jpktrd_trc         ! initialize wkx_trc with vertical scale factor in mixed-layer 
     329            DO jj = 1,jpj 
     330              DO ji = 1,jpi 
     331                  IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
     332               END DO 
     333            END DO 
     334         END DO 
     335 
     336         rmld_trc(:,:) = 0. 
     337         DO jk = 1, jpktrd_trc         ! compute mixed-layer depth : rmld_trc 
     338            rmld_trc(:,:) = rmld_trc(:,:) + wkx_trc(:,:,jk) 
     339         END DO 
     340 
     341         DO jk = 1, jpktrd_trc         ! compute integration weights 
     342            wkx_trc(:,:,jk) = wkx_trc(:,:,jk) / MAX( 1., rmld_trc(:,:) ) 
     343         END DO 
     344 
     345         icountbio = 0                    ! <<< flag = off : control surface & integr. weights 
     346         !                             !     computed only once per time step 
     347      END IF ! ( icountbio == 1 ) 
     348 
     349      ! II. Vertical integration of trends in the mixed-layer 
     350      ! ----------------------------------------------------- 
     351 
     352 
     353      DO jk = 1, jpktrd_trc 
     354         tmltrd_bio(:,:,ktrd) = tmltrd_bio(:,:,ktrd) + ptrc_trdmld(:,:,jk) * wkx_trc(:,:,jk) 
     355      END DO 
     356 
     357#endif 
     358 
     359    END SUBROUTINE trd_mld_bio_zint 
     360 
    232361 
    233362    SUBROUTINE trd_mld_trc( kt ) 
    … …  
    823952   END SUBROUTINE trd_mld_trc 
    824953 
     954    SUBROUTINE trd_mld_bio( kt ) 
     955      !!---------------------------------------------------------------------- 
     956      !!                  ***  ROUTINE trd_mld  *** 
     957      !! 
     958      !! ** Purpose :  Compute and cumulate the mixed layer biological trends over an analysis 
     959      !!               period, and write NetCDF (or dimg) outputs. 
     960      !! 
     961      !! ** Method/usage : 
     962      !!          The stored trends can be chosen twofold (according to the ln_trdmld_trc_instant 
     963      !!          logical namelist variable) : 
     964      !!          1) to explain the difference between initial and final 
     965      !!             mixed-layer T & S (where initial and final relate to the 
     966      !!             current analysis window, defined by ntrd in the namelist) 
     967      !!          2) to explain the difference between the current and previous 
     968      !!             TIME-AVERAGED mixed-layer T & S (where time-averaging is 
     969      !!             performed over each analysis window). 
     970      !! 
     971      !! ** Consistency check : 
     972      !!        If the control surface is fixed ( nctls > 1 ), the residual term (dh/dt 
     973      !!        entrainment) should be zero, at machine accuracy. Note that in the case 
     974      !!        of time-averaged mixed-layer fields, this residual WILL NOT BE ZERO 
     975      !!        over the first two analysis windows (except if restart). 
     976      !!        N.B. For ORCA2_LIM, use e.g. ntrd=5, ucf=1., nctls=8 
     977      !!             for checking residuals. 
     978      !!             On a NEC-SX5 computer, this typically leads to: 
     979      !!                   O(1.e-20) temp. residuals (tml_res) when ln_trdmld_trc_instant=.false. 
     980      !!                   O(1.e-21) temp. residuals (tml_res) when ln_trdmld_trc_instant=.true. 
     981      !! 
     982      !! ** Action : 
     983      !!       At each time step, mixed-layer averaged trends are stored in the 
     984      !!       tmltrd(:,:,jpmld_xxx) array (see trdmld_oce.F90 for definitions of jpmld_xxx). 
     985      !!       This array is known when trd_mld is called, at the end of the stp subroutine, 
     986      !!       except for the purely vertical K_z diffusion term, which is embedded in the 
     987      !!       lateral diffusion trend. 
     988      !! 
     989      !!       In I), this K_z term is diagnosed and stored, thus its contribution is removed 
     990      !!       from the lateral diffusion trend. 
     991      !!       In II), the instantaneous mixed-layer T & S are computed, and misc. cumulative 
     992      !!       arrays are updated. 
     993      !!       In III), called only once per analysis window, we compute the total trends, 
     994      !!       along with the residuals and the Asselin correction terms. 
     995      !!       In IV), the appropriate trends are written in the trends NetCDF file. 
     996      !! 
     997      !! References : 
     998      !!       - Vialard & al. 
     999      !!       - See NEMO documentation (in preparation) 
     1000      !!---------------------------------------------------------------------- 
     1001      INTEGER, INTENT( in ) ::   kt                       ! ocean time-step index 
     1002#if defined key_lobster 
     1003      INTEGER  ::  jl, it 
     1004      LOGICAL  :: llwarn  = .TRUE., lldebug = .TRUE. 
     1005      REAL(wp), DIMENSION(jpi,jpj,jpdiabio) ::  ztmltrdbio2  ! only needed for mean diagnostics 
     1006      REAL(wp) :: zfn, zfn2 
     1007#if defined key_dimgout 
     1008      INTEGER ::  iyear,imon,iday 
     1009      CHARACTER(LEN=80) :: cltext, clmode 
     1010#endif 
     1011      !!---------------------------------------------------------------------- 
     1012      ! ... Warnings 
     1013      IF( llwarn ) THEN 
     1014         IF(      ( nittrc000 /= nit000   ) & 
     1015              .OR.( ndttrc    /= 1        )    ) THEN 
     1016 
     1017            WRITE(numout,*) 'Be careful, trends diags never validated' 
     1018            STOP 'Uncomment this line to proceed' 
     1019         END IF 
     1020      END IF 
     1021 
     1022      ! ====================================================================== 
     1023      ! II. Cumulate the trends over the analysis window 
     1024      ! ====================================================================== 
     1025 
     1026      ztmltrdbio2(:,:,:) = 0.e0  ! <<< reset arrays to zero 
     1027 
     1028      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 
     1029      ! ------------------------------------------------------------------------ 
     1030      IF( kt == 2 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) 
     1031         ! 
     1032         tmltrd_csum_ub_bio (:,:,:) = 0.e0 
     1033         ! 
     1034      END IF 
     1035 
     1036      ! II.4 Cumulated trends over the analysis period 
     1037      ! ---------------------------------------------- 
     1038      ! 
     1039      !         [  1rst analysis window ] [     2nd analysis window     ] 
     1040      ! 
     1041      ! 
     1042      !     o---[--o-----o-----o-----o--]-[--o-----o-----o-----o-----o--]---o-----o--> time steps 
     1043      !                            ntrd                             2*ntrd       etc. 
     1044      !     1      2     3     4    =5 e.g.                          =10 
     1045      ! 
     1046      IF( ( kt >= 2 ).OR.( lrsttr ) ) THEN 
     1047         ! 
     1048         nmoymltrdbio = nmoymltrdbio + 1 
     1049 
     1050         ! ... Trends associated with the time mean of the ML passive tracers 
     1051         tmltrd_sum_bio    (:,:,:) = tmltrd_sum_bio    (:,:,:) + tmltrd_bio    (:,:,:) 
     1052         tmltrd_csum_ln_bio(:,:,:) = tmltrd_csum_ln_bio(:,:,:) + tmltrd_sum_bio(:,:,:) 
     1053         ! 
     1054      END IF 
     1055 
     1056      ! ====================================================================== 
     1057      ! III. Prepare fields for output (get here ONCE PER ANALYSIS PERIOD) 
     1058      ! ====================================================================== 
     1059 
     1060      ! Convert to appropriate physical units 
     1061      tmltrd_bio(:,:,:) = tmltrd_bio(:,:,:) * ucf_trc 
     1062 
     1063      MODULO_NTRD : IF( MOD( kt, ntrd_trc ) == 0 ) THEN      ! nitend MUST be multiple of ntrd 
     1064         ! 
     1065         zfn  = float(nmoymltrdbio)    ;    zfn2 = zfn * zfn 
     1066 
     1067         ! III.1 Prepare fields for output ("instantaneous" diagnostics) 
     1068         ! ------------------------------------------------------------- 
     1069 
     1070#if defined key_diainstant 
     1071         STOP 'tmltrd_bio : key_diainstant was never checked within trdmld. Comment this to proceed.' 
     1072#endif 
     1073         ! III.2 Prepare fields for output ("mean" diagnostics) 
     1074         ! ---------------------------------------------------- 
     1075 
     1076         ztmltrdbio2(:,:,:) = tmltrd_csum_ub_bio(:,:,:) + tmltrd_csum_ln_bio(:,:,:) 
     1077 
     1078         !-- Lateral boundary conditions 
     1079#if ! defined key_gyre 
     1080         ! ES_B27_CD_WARN : lbc inutile GYRE, cf. + haut 
     1081         DO jn = 1, jpdiabio 
     1082           CALL lbc_lnk( ztmltrdbio2(:,:,jn), 'T', 1. ) 
     1083         ENDDO 
     1084#endif 
     1085         IF( lldebug ) THEN 
     1086            ! 
     1087            WRITE(numout,*) 'trd_mld_bio : write trends in the Mixed Layer for debugging process:' 
     1088            WRITE(numout,*) '~~~~~~~~~~~  ' 
     1089            WRITE(numout,*) 'TRC kt = ', kt, 'nmoymltrdbio = ', nmoymltrdbio 
     1090            WRITE(numout,*) 
     1091 
     1092            DO jl = 1, jpdiabio 
     1093              IF( ln_trdmld_trc_instant ) THEN 
     1094                  WRITE(numout,97) 'TRC jl =', jl, ' bio TREND INDEX  = ', jl, & 
     1095                     & ' SUM tmltrd_bio : ', SUM2D(tmltrd_bio(:,:,jl)) 
     1096              ELSE 
     1097                  WRITE(numout,97) 'TRC jl =', jl, ' bio TREND INDEX  = ', jl, & 
     1098                     & ' SUM ztmltrdbio2 : ', SUM2D(ztmltrdbio2(:,:,jl)) 
     1099              endif 
     1100            END DO 
     1101 
     110297          FORMAT(a10, i3, 2x, a30, i3, a20, 2x, g20.10) 
     110398          FORMAT(a10, i3, 2x, a30, 2x, g20.10) 
     110499          FORMAT('TRC jj =', i3,' : ', 10(g10.3,2x)) 
     1105            WRITE(numout,*) 
     1106            ! 
     1107         ENDIF 
     1108 
     1109         ! III.3 Time evolution array swap 
     1110         ! ------------------------------- 
     1111 
     1112         ! For passive tracer mean diagnostics 
     1113         tmltrd_csum_ub_bio (:,:,:) = zfn * tmltrd_sum_bio(:,:,:) - tmltrd_csum_ln_bio(:,:,:) 
     1114 
     1115         ! III.4 Convert to appropriate physical units 
     1116         ! ------------------------------------------- 
     1117         ztmltrdbio2    (:,:,:) = ztmltrdbio2    (:,:,:) * ucf_trc/zfn2 
     1118 
     1119      END IF MODULO_NTRD 
     1120 
     1121      ! ====================================================================== 
     1122      ! IV. Write trends in the NetCDF file 
     1123      ! ====================================================================== 
     1124 
     1125      ! IV.1 Code for dimg mpp output 
     1126      ! ----------------------------- 
     1127 
     1128# if defined key_dimgout 
     1129      STOP 'Not implemented' 
     1130# else 
     1131 
     1132      ! IV.2 Code for IOIPSL/NetCDF output 
     1133      ! ---------------------------------- 
     1134 
     1135      IF( lwp .AND. MOD( kt , ntrd_trc ) == 0 ) THEN 
     1136         WRITE(numout,*) ' ' 
     1137         WRITE(numout,*) 'trd_mld_bio : write ML bio trends in the NetCDF file :' 
     1138         WRITE(numout,*) '~~~~~~~~~~~ ' 
     1139         WRITE(numout,*) '          ', TRIM(clhstnam), ' at kt = ', kt 
     1140         WRITE(numout,*) '          N.B. nmoymltrdbio = ', nmoymltrdbio 
     1141         WRITE(numout,*) ' ' 
     1142      END IF 
     1143 
     1144 
     1145      ! define time axis 
     1146      it = kt - nit000 + 1 
     1147 
     1148 
     1149      ! 2. Start writing data 
     1150      ! --------------------- 
     1151 
     1152      NETCDF_OUTPUT : IF( ln_trdmld_trc_instant ) THEN    ! <<< write the trends for passive tracer instant. diags 
     1153         ! 
     1154            DO jl = 1, jpdiabio 
     1155               CALL histwrite( nidtrdbio,TRIM("ML_"//ctrd_bio(jl,2)) ,            & 
     1156                    &          it, tmltrd_bio(:,:,jl), ndimtrd1, ndextrd1 ) 
     1157            END DO 
     1158 
     1159 
     1160         IF( kt == nitend )   CALL histclo( nidtrdbio ) 
     1161 
     1162      ELSE    ! <<< write the trends for passive tracer mean diagnostics 
     1163 
     1164            DO jl = 1, jpdiabio 
     1165               CALL histwrite( nidtrdbio, TRIM("ML_"//ctrd_bio(jl,2)) ,            & 
     1166                    &          it, ztmltrdbio2(:,:,jl), ndimtrd1, ndextrd1 ) 
     1167            END DO 
     1168 
     1169            IF( kt == nitend )   CALL histclo( nidtrdbio ) 
     1170            ! 
     1171      END IF NETCDF_OUTPUT 
     1172 
     1173      ! Compute the control surface (for next time step) : flag = on 
     1174      icountbio = 1 
     1175 
     1176 
     1177# endif /* key_dimgout */ 
     1178 
     1179      IF( MOD( kt, ntrd_trc ) == 0 ) THEN 
     1180         ! 
     1181         ! III.5 Reset cumulative arrays to zero 
     1182         ! ------------------------------------- 
     1183         nmoymltrdbio = 0 
     1184         tmltrd_csum_ln_bio (:,:,:) = 0.e0 
     1185         tmltrd_sum_bio     (:,:,:) = 0.e0 
     1186      END IF 
     1187 
     1188      ! ====================================================================== 
     1189      ! Write restart file 
     1190      ! ====================================================================== 
     1191 
     1192! restart write is done in trd_mld_trc_write which is called by trd_mld_bio (Marina) 
     1193! 
     1194#endif 
     1195   END SUBROUTINE trd_mld_bio 
    8251196 
    8261197   REAL FUNCTION sum2d( ztab ) 
    … …  
    9661337      tmltrd_csum_ln_trc (:,:,:,:) = 0.e0   ;   rmld_sum_trc       (:,:)     = 0.e0 
    9671338 
     1339#if defined key_lobster 
     1340      nmoymltrdbio   = 0 
     1341      tmltrd_sum_bio     (:,:,:) = 0.e0     ;   tmltrd_csum_ln_bio (:,:,:) = 0.e0 
     1342#endif 
     1343 
    9681344      IF( lrsttr .AND. ln_trdmld_trc_restart ) THEN 
    9691345         CALL trd_mld_trc_rst_read 
    … …  
    9741350         tml_sumb_trc       (:,:,:)   = 0.e0   ;   tmltrd_csum_ub_trc (:,:,:,:) = 0.e0     ! mean 
    9751351         tmltrd_atf_sumb_trc(:,:,:)   = 0.e0   ;   tmltrd_rad_sumb_trc(:,:,:)   = 0.e0  
    976       ENDIF 
     1352#if defined key_lobster 
     1353         tmltrd_csum_ub_bio (:,:,:) = 0.e0 
     1354#endif 
     1355 
     1356       ENDIF 
    9771357 
    9781358      ilseq  = 1   ;   icount = 1   ;   ionce  = 1  ! open specifier    
     1359 
     1360#if defined key_lobster 
     1361      icountbio = 1   ;   ioncebio  = 1  ! open specifier 
     1362#endif 
    9791363 
    9801364      ! I.3 Read control surface from file ctlsurf_idx 
    … …  
    10541438      ctrd_trc(jpmld_trc_dmp    ,1) = " Tracer damping"                  ;   ctrd_trc(jpmld_trc_dmp    ,2) = "_dmp" 
    10551439      ctrd_trc(jpmld_trc_sbc    ,1) = " Surface boundary cond."          ;   ctrd_trc(jpmld_trc_sbc    ,2) = "_sbc" 
    1056 #if defined key_lobster 
    1057       ctrd_trc(jpmld_trc_sms_sed,1) = " Sources minus sinks : sed"       ;   ctrd_trc(jpmld_trc_sms_sed,2) = "_sms_sed" 
    1058       ctrd_trc(jpmld_trc_sms_bio,1) = " Sources minus sinks : bio"       ;   ctrd_trc(jpmld_trc_sms_bio,2) = "_sms_bio" 
    1059       ctrd_trc(jpmld_trc_sms_exp,1) = " Sources minus sinks : exp"       ;   ctrd_trc(jpmld_trc_sms_exp,2) = "_sms_exp" 
    1060 #else 
    10611440      ctrd_trc(jpmld_trc_sms,    1) = " Sources minus sinks"             ;   ctrd_trc(jpmld_trc_sms    ,2) = "_sms" 
    1062 #endif                                                                                                  
    10631441      ctrd_trc(jpmld_trc_radb   ,1) = " Correct negative concentrations" ;   ctrd_trc(jpmld_trc_radb   ,2) = "_radb" 
    10641442      ctrd_trc(jpmld_trc_radn   ,1) = " Correct negative concentrations" ;   ctrd_trc(jpmld_trc_radn   ,2) = "_radn" 
    … …  
    10811459      END DO 
    10821460 
     1461#if defined key_lobster 
     1462 
     1463          ctrd_bio(1,:) = "NO3PHY" 
     1464          ctrd_bio(2,:) = "NH4PHY" 
     1465          ctrd_bio(3,:) = "PHYNH4" 
     1466          ctrd_bio(4,:) = "PHYDOM" 
     1467          ctrd_bio(5,:) = "PHYZOO" 
     1468          ctrd_bio(6,:) = "PHYDET" 
     1469          ctrd_bio(7,:) = "DETZOO" 
     1470          ctrd_bio(8,:) = "DETSED" 
     1471          ctrd_bio(9,:) = "ZOODET" 
     1472          ctrd_bio(10,:) = "ZOOBOD" 
     1473          ctrd_bio(11,:) = "ZOONH4" 
     1474          ctrd_bio(12,:) = "ZOODOM" 
     1475          ctrd_bio(13,:) = "NH4NO3" 
     1476          ctrd_bio(14,:) = "DOMNH4" 
     1477          ctrd_bio(15,:) = "DETNH4" 
     1478          ctrd_bio(16,:) = "DETDOM" 
     1479          ctrd_bio(17,:) = "SEDNO3" 
     1480 
     1481 
     1482          !-- Create a NetCDF file and enter the define mode 
     1483          CALL dia_nam( clhstnam, ntrd_trc, 'trdbio' ) 
     1484          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
     1485             &             1, jpi, 1, jpj, 0, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom ) 
     1486 
     1487#endif 
     1488 
    10831489      !-- Define physical units 
    10841490      IF( ucf_trc == 1. ) THEN 
    … …  
    10941500         STOP 'Error : jpltrd_trc /= jpmld_trc_atf .OR.  jpltrd_trc - 1 /= jpmld_trc_radb'  ! see below 
    10951501      ENDIF 
    1096 #if defined key_lobster 
    1097       IF( lldebug ) THEN 
    1098          DO jn = 1, jptra 
    1099             WRITE(numout, *) 'TRC jpdet=', jpdet, ' jpnh4=', jpnh4 
    1100             WRITE(numout, *) 'TRC short title  ctrcnm  jn=", jn, " : ', ctrcnm(jn) 
    1101             WRITE(numout, *) 'TRC trim(ctrcnm(jn))//"_tot" = ', trim(ctrcnm(jn))//"ml_tot"  ! tml_tot -> detml_tot 
    1102          END DO 
    1103          CALL flush(numout) 
    1104       ENDIF 
    1105 #else 
    1106 !!      Error : this is not ready (PISCES) 
    1107 #endif       
    11081502 
    11091503      DO jn = 1, jptra 
    … …  
    11351529      END DO 
    11361530 
     1531#if defined key_lobster 
     1532      DO jl = 1, jpdiabio 
     1533         CALL histdef(nidtrdbio, TRIM("ML_"//ctrd_bio(jl,2)), TRIM(clmxl//" ML_"//ctrd_bio(jl,1))   ,            & 
     1534             &    cltrcu, jpi, jpj, nh_tb, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean 
     1535      END DO                                                                         ! if zsto=rdt above 
     1536#endif 
     1537 
    11371538      !-- Leave IOIPSL/NetCDF define mode 
    11381539      DO jn = 1, jptra 
    11391540         IF( luttrd(jn) )  CALL histend( nidtrd(jn) ) 
    11401541      END DO 
     1542 
     1543#if defined key_lobster 
     1544      !-- Leave IOIPSL/NetCDF define mode 
     1545      CALL histend( nidtrdbio ) 
     1546 
     1547      IF(lwp) WRITE(numout,*) 
     1548       IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization for ML bio trends' 
     1549#endif 
    11411550 
    11421551#endif        /* key_dimgout */ 

  • trunk/NEMO/TOP_SRC/TRP/trdmld_trc_oce.F90

    r1174 r1175  
    4141   INTEGER, PARAMETER ::   jptrc_trd_dmp     = 11   !: damping 
    4242   INTEGER, PARAMETER ::   jptrc_trd_sbc     = 12   !: surface boundary condition 
    43 #if defined key_lobster 
    44    INTEGER, PARAMETER ::   jptrc_trd_sms_sed = 13   !: sources m. sinks : sedimentation 
    45    INTEGER, PARAMETER ::   jptrc_trd_sms_bio = 14   !: sources m. sinks : bio 
    46    INTEGER, PARAMETER ::   jptrc_trd_sms_exp = 15   !: sources m. sinks : bio 
    47    INTEGER, PARAMETER ::   jptrc_trd_radn    = 16   !: corr. trn<0 in trcrad 
    48    INTEGER, PARAMETER ::   jptrc_trd_radb    = 17   !: corr. trb<0 in trcrad (like atf) 
    49    INTEGER, PARAMETER ::   jptrc_trd_atf     = 18   !: Asselin correction 
    50 #else 
    5143   INTEGER, PARAMETER ::   jptrc_trd_sms     = 13   !: sources m. sinks 
    5244   INTEGER, PARAMETER ::   jptrc_trd_radn    = 14   !: corr. trn<0 in trcrad 
    5345   INTEGER, PARAMETER ::   jptrc_trd_radb    = 15   !: corr. trb<0 in trcrad (like atf) 
    5446   INTEGER, PARAMETER ::   jptrc_trd_atf     = 16   !: Asselin correction 
    55 #endif 
    5647 
    5748#if defined key_trdmld_trc 
    … …  
    7667        jpmld_trc_dmp     = 11,     & !:     internal restoring trend 
    7768        jpmld_trc_sbc     = 12,     & !:     forcing  
    78 #if  defined key_lobster 
    79         jpmld_trc_sms_sed = 13,     & !:     sources minus sinks trend 
    80         jpmld_trc_sms_bio = 14,     & !:     sources minus sinks trend 
    81         jpmld_trc_sms_exp = 15,     & !:     sources minus sinks trend 
    82   !     jpmld_trc_xxx     = xx,     & !:     add here any additional trend    (** AND UPDATE JPLTRD_TRC BELOW **) 
    83         jpmld_trc_radn    = 16,     & !:     corr. trn<0 in trcrad 
    84         jpmld_trc_radb    = 17,     & !:     corr. trn<0 in trcrad (like atf) (** MUST BE BEFORE THE LAST ONE **) 
    85         jpmld_trc_atf     = 18        !:     asselin trend                    (** MUST BE    THE     LAST ONE **) 
    86 #else                                                       
    8769        jpmld_trc_sms     = 13,     & !:     sources minus sinks trend 
    8870  !     jpmld_trc_xxx     = xx,     & !:     add here any additional trend    (** AND UPDATE JPLTRD_TRC BELOW **) 
    … …  
    9072        jpmld_trc_radb    = 15,     & !:     corr. trb<0 in trcrad (like atf) (** MUST BE BEFORE THE LAST ONE **) 
    9173        jpmld_trc_atf     = 16        !:     asselin trend                    (** MUST BE    THE      LAST ONE**) 
    92 #endif 
    9374 
    9475   !! Trends diagnostics parameters 
    9576   !!--------------------------------------------------------------------- 
    9677   INTEGER, PARAMETER ::            & 
    97 #if defined key_lobster 
    98       jpltrd_trc = 18,                  & !: number of mixed-layer trends arrays 
    99 #else 
    10078      jpltrd_trc = 16,                  & !: number of mixed-layer trends arrays 
    101 #endif 
    10279      jpktrd_trc = jpk                    !: max level for mixed-layer trends diag. 
    10380 
    … …  
    151128#endif 
    152129 
     130#if defined key_lobster 
     131   CHARACTER(LEN=80) :: clname_bio, ctrd_bio(jpdiabio,2) 
     132   REAL(wp), DIMENSION(jpi,jpj,jpdiabio) ::  & 
     133      tmltrd_bio,                         &      !: \ biological contributions to the total trend , 
     134                                                 !: / cumulated over the current analysis window 
     135      tmltrd_sum_bio,                     &      !: sum of these trends over the analysis period 
     136      tmltrd_csum_ln_bio,                 &      !: now cumulated sum of trends over the "lower triangle" 
     137      tmltrd_csum_ub_bio                         !: before (prev. analysis period) cumulated sum over the 
     138                                                 !: upper triangle 
     139#endif 
    153140 
    154141#else 

  • trunk/NEMO/TOP_SRC/TRP/trdmld_trc_rst.F90

    r1174 r1175  
    6767      ! 
    6868      CHARACTER (len=35) :: charout 
    69       INTEGER ::   jk, jn               ! loop indice 
     69      INTEGER :: jl,  jk, jn               ! loop indice 
    7070      !!-------------------------------------------------------------------------------- 
    7171 
    … …  
    120120            END DO                                                     ! tracer loop 
    121121            !                                                          ! =========== 
     122#if defined key_lobster 
     123            DO jl = 1, jp_lobster_trd 
     124               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) ) 
     125            ENDDO 
     126#endif 
     127 
    122128         ENDIF 
    123129          
    … …  
    139145      ! 
    140146      CHARACTER (len=35) :: charout 
    141       INTEGER ::   jk, jn     ! loop indice 
     147      INTEGER ::  jk, jn, jl     ! loop indice 
    142148      !!----------------------------------------------------------------------------- 
    143149       
    … …  
    189195         END DO                                                     ! tracer loop 
    190196         !                                                          ! =========== 
     197 
     198#if defined key_lobster 
     199         DO jl = 1, jp_lobster_trd 
     200            CALL iom_get( inum, jpdom_local, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) ) 
     201         ENDDO 
     202#endif 
    191203          
    192204         CALL iom_close( inum ) 

  • trunk/NEMO/TOP_SRC/TRP/trp_trc.F90

    r1146 r1175  
    5151 
    5252# if defined key_trc_diatrd 
    53     
     53 
    5454   !!  non conservative trends (biological, ...) 
    5555   !! -------------------------------------------------- 
    56    LOGICAL, PUBLIC, DIMENSION (jptra) ::   luttrd   !: large trends diagnostic to write or not (namelist) 
    57     
    5856   !!  Advection-diffusion trends 
    5957   REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE ::   trtrd   !: trends of the tracer equations 
    60     
     58 
    6159   INTEGER, PUBLIC, DIMENSION(jptra) :: ikeep ! indice of tracer for which dyn trends are stored 
    62    INTEGER, PUBLIC                   :: nkeep ! number of tracers for which dyn trends are stored  
     60   INTEGER, PUBLIC                   :: nkeep ! number of tracers for which dyn trends are stored 
    6361   !                                          ! (used to allocate trtrd buffer) 
    6462 
    65    !! netcdf files and index common 
    66    !! -------------------------------------------------- 
    6763   INTEGER , PUBLIC ::   nwritetrd   !: frequency of additional arrays outputs(namelist) 
    68     
    69 # endif  
    70  
     64# endif 
    7165#else 
    7266   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.