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 7494 for branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Ignore:
Timestamp:
2016-12-14T10:02:43+01:00 (8 years ago)
Author:
timgraham
Message:

Addition of extra diagnostic outputs in CMIP6 data request. NB. Will require update to field_def file from shaconemo

Location:
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r5147 r7494  
    2626   USE cla             ! cross land advection      (cla_traadv     routine) 
    2727   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
     28   USE trd_oce         ! trends: ocean variables 
     29   USE trdtra          ! trends manager: tracers  
    2830   ! 
    2931   USE in_out_manager  ! I/O manager 
     
    7981      INTEGER ::   jk   ! dummy loop index 
    8082      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    8184      !!---------------------------------------------------------------------- 
    8285      ! 
     
    120123      IF( ln_diaptr )   CALL dia_ptr( zvn )                                     ! diagnose the effective MSF  
    121124      ! 
    122     
     125      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     126         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     127         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     128         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     129      ENDIF 
     130      ! 
    123131      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    124132      CASE ( 1 )   ;    CALL tra_adv_cen2   ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
     
    151159      END SELECT 
    152160      ! 
     161      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
     162         DO jk = 1, jpkm1 
     163            ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
     164            ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 
     165         END DO 
     166         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
     167         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 
     168         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     169      ENDIF 
    153170      !                                              ! print mean trends (used for debugging) 
    154171      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               & 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r5540 r7494  
    279279         END IF 
    280280         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    281          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    282            IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    283            IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    284          ENDIF 
     281         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
    285282         ! 
    286283      END DO 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r6204 r7494  
    2828   USE wrk_nemo        ! Memory Allocation 
    2929   USE timing          ! Timing 
     30   USE diaptr         ! Heat/Salt transport diagnostics 
     31   USE trddyn 
     32   USE trd_oce 
    3033 
    3134   IMPLICIT NONE 
     
    7881# endif   
    7982      REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d, z3d_T 
    8084      !!---------------------------------------------------------------------- 
    8185      ! 
     
    8488# if defined key_diaeiv  
    8589      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
     90      CALL wrk_alloc( jpi, jpj, jpk, z3d, z3d_T ) 
    8691# else 
    8792      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 
     
    160165         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current 
    161166         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current 
    162          IF( iom_use('ueiv_heattr') ) THEN 
    163             zztmp = 0.5 * rau0 * rcp  
     167         IF( iom_use('weiv_masstr') ) THEN   ! vertical mass transport & its square value 
     168           z2d(:,:) = rau0 * e12t(:,:) 
     169           DO jk = 1, jpk 
     170              z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 
     171           END DO 
     172           CALL iom_put( "weiv_masstr" , z3d )   
     173         ENDIF 
     174         IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") .OR. iom_use('ueiv_heattr3d')        & 
     175                                    .OR. iom_use("ueiv_salttr") .OR. iom_use('ueiv_salttr3d') ) THEN 
     176            z3d(:,:,jpk) = 0.e0 
     177            z2d(:,:) = 0.e0 
     178            DO jk = 1, jpkm1 
     179               z3d(:,:,jk) = rau0 * u_eiv(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     180               z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
     181            END DO 
     182            CALL iom_put( "ueiv_masstr", z3d )                  ! mass transport in i-direction 
     183         ENDIF 
     184 
     185         IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
     186            zztmp = 0.5 * rcp  
    164187            z2d(:,:) = 0.e0  
    165             DO jk = 1, jpkm1 
    166                DO jj = 2, jpjm1 
    167                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    168                      z2d(ji,jj) = z2d(ji,jj) + u_eiv(ji,jj,jk) & 
    169                        &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk)  
    170                   END DO 
    171                END DO 
    172             END DO 
    173             CALL lbc_lnk( z2d, 'U', -1. ) 
    174             CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! heat transport in i-direction 
     188            z3d_T(:,:,:) = 0.e0  
     189            DO jk = 1, jpkm1 
     190               DO jj = 2, jpjm1 
     191                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     192                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     193                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     194                  END DO 
     195               END DO 
     196            END DO 
     197            IF (iom_use('ueiv_heattr') ) THEN 
     198               CALL lbc_lnk( z2d, 'U', -1. ) 
     199               CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! 2D heat transport in i-direction 
     200            ENDIF 
     201            IF (iom_use('ueiv_heattr3d') ) THEN 
     202               CALL lbc_lnk( z3d_T, 'U', -1. ) 
     203               CALL iom_put( "ueiv_heattr3d", zztmp * z3d_T )              ! 3D heat transport in i-direction 
     204            ENDIF 
     205         ENDIF 
     206 
     207         IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d') ) THEN 
     208            zztmp = 0.5 * 0.001 
     209            z2d(:,:) = 0.e0  
     210            z3d_T(:,:,:) = 0.e0  
     211            DO jk = 1, jpkm1 
     212               DO jj = 2, jpjm1 
     213                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     214                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
     215                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     216                  END DO 
     217               END DO 
     218            END DO 
     219            IF (iom_use('ueiv_salttr') ) THEN 
     220               CALL lbc_lnk( z2d, 'U', -1. ) 
     221               CALL iom_put( "ueiv_salttr", zztmp * z2d )                  ! 2D salt transport in i-direction 
     222            ENDIF 
     223            IF (iom_use('ueiv_salttr3d') ) THEN 
     224               CALL lbc_lnk( z3d_T, 'U', -1. ) 
     225               CALL iom_put( "ueiv_salttr3d", zztmp * z3d_T )              ! 3D salt transport in i-direction 
     226            ENDIF 
     227         ENDIF 
     228 
     229         IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") .OR. iom_use('veiv_heattr3d')       & 
     230                                    .OR. iom_use("veiv_salttr") .OR. iom_use('veiv_salttr3d') ) THEN 
     231            z3d(:,:,jpk) = 0.e0 
     232            DO jk = 1, jpkm1 
     233               z3d(:,:,jk) = rau0 * v_eiv(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
     234            END DO 
     235            CALL iom_put( "veiv_masstr", z3d )                  ! mass transport in j-direction 
    175236         ENDIF 
    176237             
    177          IF( iom_use('veiv_heattr') ) THEN 
    178             zztmp = 0.5 * rau0 * rcp  
     238         IF( iom_use('veiv_heattr') .OR. iom_use('veiv_heattr3d') ) THEN 
     239            zztmp = 0.5 * rcp  
    179240            z2d(:,:) = 0.e0  
    180             DO jk = 1, jpkm1 
    181                DO jj = 2, jpjm1 
    182                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    183                      z2d(ji,jj) = z2d(ji,jj) + v_eiv(ji,jj,jk) & 
    184                      &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk)  
    185                   END DO 
    186                END DO 
    187             END DO 
    188             CALL lbc_lnk( z2d, 'V', -1. ) 
    189             CALL iom_put( "veiv_heattr", zztmp * z2d )                  !  heat transport in i-direction 
    190          ENDIF 
     241            z3d_T(:,:,:) = 0.e0  
     242            DO jk = 1, jpkm1 
     243               DO jj = 2, jpjm1 
     244                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     245                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     246                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     247                  END DO 
     248               END DO 
     249            END DO 
     250            IF (iom_use('veiv_heattr') ) THEN 
     251               CALL lbc_lnk( z2d, 'V', -1. ) 
     252               CALL iom_put( "veiv_heattr", zztmp * z2d )                  ! 2D heat transport in j-direction 
     253            ENDIF 
     254            IF (iom_use('veiv_heattr3d') ) THEN 
     255               CALL lbc_lnk( z3d_T, 'V', -1. ) 
     256               CALL iom_put( "veiv_heattr3d", zztmp * z3d_T )              ! 3D heat transport in j-direction 
     257            ENDIF 
     258         ENDIF 
     259 
     260         IF( iom_use('veiv_salttr') .OR. iom_use('veiv_salttr3d') ) THEN 
     261            zztmp = 0.5 * 0.001 
     262            z2d(:,:) = 0.e0  
     263            z3d_T(:,:,:) = 0.e0  
     264            DO jk = 1, jpkm1 
     265               DO jj = 2, jpjm1 
     266                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     267                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
     268                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 
     269                  END DO 
     270               END DO 
     271            END DO 
     272            IF (iom_use('veiv_salttr') ) THEN 
     273               CALL lbc_lnk( z2d, 'V', -1. ) 
     274               CALL iom_put( "veiv_salttr", zztmp * z2d )                  ! 2D salt transport in i-direction 
     275            ENDIF 
     276            IF (iom_use('veiv_salttr3d') ) THEN 
     277               CALL lbc_lnk( z3d_T, 'V', -1. ) 
     278               CALL iom_put( "veiv_salttr3d", zztmp * z3d_T )              ! 3D salt transport in i-direction 
     279            ENDIF 
     280         ENDIF 
     281 
     282         IF( iom_use('weiv_masstr') .OR. iom_use('weiv_heattr3d') .OR. iom_use('weiv_salttr3d')) THEN   ! vertical mass transport & its square value 
     283           z2d(:,:) = rau0 * e12t(:,:) 
     284           DO jk = 1, jpk 
     285              z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 
     286           END DO 
     287           CALL iom_put( "weiv_masstr" , z3d )                  ! mass transport in k-direction 
     288         ENDIF 
     289 
     290         IF( iom_use('weiv_heattr3d') ) THEN 
     291            zztmp = 0.5 * rcp  
     292            DO jk = 1, jpkm1 
     293               DO jj = 2, jpjm1 
     294                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     295                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj,jk+1,jp_tem) ) 
     296                  END DO 
     297               END DO 
     298            END DO 
     299            CALL lbc_lnk( z3d_T, 'T', 1. ) 
     300            CALL iom_put( "weiv_heattr3d", zztmp * z3d_T )                 ! 3D heat transport in k-direction 
     301         ENDIF 
     302 
     303         IF( iom_use('weiv_salttr3d') ) THEN 
     304            zztmp = 0.5 * 0.001  
     305            DO jk = 1, jpkm1 
     306               DO jj = 2, jpjm1 
     307                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     308                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj,jk+1,jp_sal) ) 
     309                  END DO 
     310               END DO 
     311            END DO 
     312            CALL lbc_lnk( z3d_T, 'T', 1. ) 
     313            CALL iom_put( "weiv_salttr3d", zztmp * z3d_T )                 ! 3D salt transport in k-direction 
     314         ENDIF 
     315 
    191316    END IF 
     317! 
     318    IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 
     319       z3d(:,:,:) = 0._wp 
     320       DO jk = 1, jpkm1 
     321          DO jj = 2, jpjm1 
     322             DO ji = fs_2, fs_jpim1   ! vector opt. 
     323                z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 
     324                &             * e1v(ji,jj) * fse3v(ji,jj,jk) 
     325             END DO 
     326          END DO 
     327       END DO 
     328       CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 
     329       z3d(:,:,:) = 0._wp 
     330       DO jk = 1, jpkm1 
     331          DO jj = 2, jpjm1 
     332             DO ji = fs_2, fs_jpim1   ! vector opt. 
     333                z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 
     334                &             * e1v(ji,jj) * fse3v(ji,jj,jk) 
     335             END DO 
     336          END DO 
     337       END DO 
     338       CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 
     339    ENDIF 
     340 
     341    IF( ln_KE_trd ) CALL trd_dyn(u_eiv, v_eiv, jpdyn_eivke, kt ) 
    192342# endif   
    193       !  
     343 
    194344# if defined key_diaeiv  
    195345      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
     346      CALL wrk_dealloc( jpi, jpj, jpk, z3d, z3d_T ) 
    196347# else 
    197348      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r5147 r7494  
    4545   !!---------------------------------------------------------------------- 
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    47    !! $Id$  
     47   !! $Id$ 
    4848   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 
     
    219219         END IF 
    220220         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    221          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    222             IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    223             IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    224          ENDIF 
     221         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:)  ) 
    225222 
    226223         ! II. Vertical advective fluxes 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r5147 r7494  
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    39    !! $Id$  
     39   !! $Id$ 
    4040   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4141   !!---------------------------------------------------------------------- 
     
    200200 
    201201         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    202          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    203             IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    204             IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    205          ENDIF 
     202         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:)  ) 
    206203 
    207204         ! II. Vertical advective fluxes 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r5147 r7494  
    355355         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    356356         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    357          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    358            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    359            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    360          ENDIF 
     357         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
    361358         ! 
    362359      END DO 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r6770 r7494  
    3434   USE timing         ! Timing 
    3535   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     36   USE iom 
    3637 
    3738   IMPLICIT NONE 
     
    4243 
    4344   LOGICAL ::   l_trd   ! flag to compute trends 
     45   LOGICAL ::   l_trans   ! flag to output vertically integrated transports 
    4446 
    4547   !! * Substitutions 
     
    8587      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    8688      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 
    87       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
     89      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 
     90      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d 
    8891      !!---------------------------------------------------------------------- 
    8992      ! 
     
    98101         ! 
    99102         l_trd = .FALSE. 
     103         l_trans = .FALSE. 
    100104         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     105         IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 
    101106      ENDIF 
    102107      ! 
    103       IF( l_trd )  THEN 
     108      IF( l_trd .OR. l_trans )  THEN 
    104109         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    105110         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0 
     111         CALL wrk_alloc( jpi, jpj, z2d ) 
     112      ENDIF 
     113      ! 
     114      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     115         CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
     116         zptry(:,:,:) = 0._wp 
    106117      ENDIF 
    107118      ! 
     
    187198 
    188199         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    189          IF( l_trd )  THEN  
     200         IF( l_trd .OR. l_trans )  THEN  
    190201            ! store intermediate advective trends 
    191202            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
    192203         END IF 
    193204         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    194          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    195            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    196            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    197          ENDIF 
     205         IF( cdtype == 'TRA' .AND. ln_diaptr )    zptry(:,:,:) = zwy(:,:,:)  
    198206 
    199207         ! 3. antidiffusive flux : high order minus low order 
     
    253261 
    254262         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    255          IF( l_trd )  THEN  
     263         IF( l_trd .OR. l_trans )  THEN  
    256264            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    257265            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    258266            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    259              
    260             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )    
    261             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
    262             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
     267         ENDIF 
     268          
     269         IF( l_trd ) THEN  
     270            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     271            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
     272            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    263273         END IF 
    264          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     274 
     275         IF( l_trans .AND. jn==jp_tem ) THEN 
     276            z2d(:,:) = 0._wp  
     277            DO jk = 1, jpkm1 
     278               DO jj = 2, jpjm1 
     279                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     280                     z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk)  
     281                  END DO 
     282               END DO 
     283            END DO 
     284            CALL lbc_lnk( z2d, 'U', -1. ) 
     285            CALL iom_put( "uadv_heattr", rau0_rcp * z2d )       ! heat transport in i-direction 
     286              ! 
     287            z2d(:,:) = 0._wp  
     288            DO jk = 1, jpkm1 
     289               DO jj = 2, jpjm1 
     290                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     291                     z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk)  
     292                  END DO 
     293               END DO 
     294            END DO 
     295            CALL lbc_lnk( z2d, 'V', -1. ) 
     296            CALL iom_put( "vadv_heattr", rau0_rcp * z2d )       ! heat transport in j-direction 
     297         ENDIF 
     298         ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    265299         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    266            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
    267            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
     300            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     301            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    268302         ENDIF 
    269303         ! 
    270304      END DO 
    271305      ! 
    272                    CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
    273       IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     306      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
     307      IF( l_trd .OR. l_trans )  THEN  
     308         CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     309         CALL wrk_dealloc( jpi, jpj, z2d ) 
     310      ENDIF 
     311      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    274312      ! 
    275313      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd') 
     
    318356      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 
    319357      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
     358      REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    320359      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 
    321360      !!---------------------------------------------------------------------- 
     
    339378         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    340379         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp 
     380      ENDIF 
     381      ! 
     382      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     383         CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
     384         zptry(:,:,:) = 0._wp 
    341385      ENDIF 
    342386      ! 
     
    428472         END IF 
    429473         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    430          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    431            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    432            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    433          ENDIF 
     474         IF( cdtype == 'TRA' .AND. ln_diaptr )  zptry(:,:,:) = zwy(:,:,:) 
    434475 
    435476         ! 3. antidiffusive flux : high order minus low order 
     
    556597         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    557598         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    558            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
    559            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
     599            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  
     600            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    560601         ENDIF 
    561602         ! 
     
    566607                   CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 
    567608      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     609      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    568610      ! 
    569611      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd_zts') 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r5147 r7494  
    177177         END IF 
    178178         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    179          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    180             IF( jn == jp_tem )  htr_adv(:) = ptr_sj( ztv(:,:,:) ) 
    181             IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) ) 
    182          ENDIF 
     179         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', ztv(:,:,:) ) 
    183180          
    184181         ! TVD scheme for the vertical direction   
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r5147 r7494  
    173173         !                                                 
    174174         ! "zonal" mean lateral diffusive heat and salt transport 
    175          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    176            IF( jn == jp_tem )  htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    177            IF( jn == jp_sal )  str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    178          ENDIF 
     175         IF( cdtype == 'TRA' .AND. ln_diaptr )   CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 
    179176         !                                                ! =========== 
    180177      END DO                                              ! tracer loop 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r5147 r7494  
    247247         !                                                ! =============== 
    248248         ! "Poleward" diffusive heat or salt transport 
    249          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN 
    250             ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    251             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    252             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    253          ENDIF 
     249        ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     250         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:) ) 
    254251 
    255252         !                             ! ************ !   ! =============== 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r5149 r7494  
    235235         ! 
    236236         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    237          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    238237            ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    239             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    240             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    241          ENDIF 
     238         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:)  ) 
    242239  
    243240         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r5147 r7494  
    386386         ! 
    387387         !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    388          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    389             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names 
    390             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    391          ENDIF 
     388         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'ldf', zftv(:,:,:) ) 
    392389 
    393390         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r5147 r7494  
    154154         ! 
    155155         ! "Poleward" diffusive heat or salt transports 
    156          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    157             IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    158             IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    159          ENDIF 
     156         IF( cdtype == 'TRA' .AND. ln_diaptr )    CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 
    160157         !                                                  ! ================== 
    161158      END DO                                                ! end of tracer loop 
Note: See TracChangeset for help on using the changeset viewer.