Changeset 13519


Ignore:
Timestamp:
2020-09-24T20:51:13+02:00 (4 months ago)
Author:
hadcv
Message:

Tiling for DIA routines called by TRA modules

Location:
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DIA
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DIA/diaar5.F90

    r13295 r13519  
    3434   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain) 
    3535   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
     36   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   hstr_adv, hstr_ldf 
    3637 
    3738   LOGICAL  :: l_ar5 
     
    5455      !!---------------------------------------------------------------------- 
    5556      ! 
    56       ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
     57      ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , & 
     58         &      hstr_adv(jpi,jpj,jpts,2), hstr_ldf(jpi,jpj,jpts,2), STAT=dia_ar5_alloc ) 
    5759      ! 
    5860      CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) 
     
    306308   END SUBROUTINE dia_ar5 
    307309 
    308  
    309    SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx )  
     310   ! TEMP: These changes and lbc_lnk not necessary if using XIOS (subdomain support, will not output haloes) 
     311   SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx ) 
    310312      !!---------------------------------------------------------------------- 
    311313      !!                    ***  ROUTINE dia_ar5_htr *** 
     
    316318      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
    317319      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf' 
    318       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: puflx  ! u-flux of advection/diffusion 
    319       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx  ! v-flux of advection/diffusion 
     320      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk)    , INTENT(in)   :: puflx  ! u-flux of advection/diffusion 
     321      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk)    , INTENT(in)   :: pvflx  ! v-flux of advection/diffusion 
    320322      ! 
    321323      INTEGER    ::  ji, jj, jk 
    322       REAL(wp), DIMENSION(jpi,jpj)  :: z2d 
    323  
    324      
    325       z2d(:,:) = puflx(:,:,1)  
    326       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    327          z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)  
    328       END_3D 
    329        CALL lbc_lnk( 'diaar5', z2d, 'U', -1.0_wp ) 
    330        IF( cptr == 'adv' ) THEN 
    331           IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d )  ! advective heat transport in i-direction 
    332           IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0     * z2d )  ! advective salt transport in i-direction 
    333        ENDIF 
    334        IF( cptr == 'ldf' ) THEN 
    335           IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d ) ! diffusive heat transport in i-direction 
    336           IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0     * z2d ) ! diffusive salt transport in i-direction 
    337        ENDIF 
    338        ! 
    339        z2d(:,:) = pvflx(:,:,1)  
    340        DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    341           z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)  
    342        END_3D 
    343        CALL lbc_lnk( 'diaar5', z2d, 'V', -1.0_wp ) 
    344        IF( cptr == 'adv' ) THEN 
    345           IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d )  ! advective heat transport in j-direction 
    346           IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0     * z2d )  ! advective salt transport in j-direction 
    347        ENDIF 
    348        IF( cptr == 'ldf' ) THEN 
    349           IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d ) ! diffusive heat transport in j-direction 
    350           IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0     * z2d ) ! diffusive salt transport in j-direction 
    351        ENDIF 
    352            
     324 
     325      IF( cptr /= 'adv' .AND. cptr /= 'ldf' ) RETURN 
     326      IF( ktra /= jp_tem .AND. ktra /= jp_sal ) RETURN 
     327 
     328      IF( cptr == 'adv' ) THEN 
     329         DO_2D( 0, 0, 0, 0 ) 
     330            hstr_adv(ji,jj,ktra,1) = puflx(ji,jj,1) 
     331            hstr_adv(ji,jj,ktra,2) = pvflx(ji,jj,1) 
     332         END_2D 
     333         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     334            hstr_adv(ji,jj,ktra,1) = hstr_adv(ji,jj,ktra,1) + puflx(ji,jj,jk) 
     335            hstr_adv(ji,jj,ktra,2) = hstr_adv(ji,jj,ktra,2) + pvflx(ji,jj,jk) 
     336         END_3D 
     337      ELSE IF( cptr == 'ldf' ) THEN 
     338         DO_2D( 0, 0, 0, 0 ) 
     339            hstr_ldf(ji,jj,ktra,1) = puflx(ji,jj,1) 
     340            hstr_ldf(ji,jj,ktra,2) = pvflx(ji,jj,1) 
     341         END_2D 
     342         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     343            hstr_ldf(ji,jj,ktra,1) = hstr_ldf(ji,jj,ktra,1) + puflx(ji,jj,jk) 
     344            hstr_ldf(ji,jj,ktra,2) = hstr_ldf(ji,jj,ktra,2) + pvflx(ji,jj,jk) 
     345         END_3D 
     346      ENDIF 
     347 
     348      IF( ntile == 0 .OR. ntile == nijtile ) THEN 
     349         IF( cptr == 'adv' ) THEN 
     350            CALL lbc_lnk( 'diaar5', hstr_adv(:,:,ktra,1), 'U', -1.0_wp ) 
     351            IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,1) )  ! advective heat transport in i-direction 
     352            IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0     * hstr_adv(:,:,ktra,1) )  ! advective salt transport in i-direction 
     353            CALL lbc_lnk( 'diaar5', hstr_adv(:,:,ktra,2), 'V', -1.0_wp ) 
     354            IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,2) )  ! advective heat transport in j-direction 
     355            IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0     * hstr_adv(:,:,ktra,2) )  ! advective salt transport in j-direction 
     356         ENDIF 
     357         IF( cptr == 'ldf' ) THEN 
     358            CALL lbc_lnk( 'diaar5', hstr_ldf(:,:,ktra,1), 'U', -1.0_wp ) 
     359            IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,1) ) ! diffusive heat transport in i-direction 
     360            IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0     * hstr_ldf(:,:,ktra,1) ) ! diffusive salt transport in i-direction 
     361            CALL lbc_lnk( 'diaar5', hstr_ldf(:,:,ktra,2), 'V', -1.0_wp ) 
     362            IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,2) ) ! diffusive heat transport in j-direction 
     363            IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0     * hstr_ldf(:,:,ktra,2) ) ! diffusive salt transport in j-direction 
     364         ENDIF 
     365      ENDIF 
    353366   END SUBROUTINE dia_ar5_hst 
    354367 
     
    373386         &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  &     
    374387         &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' ) .OR. & 
     388         &  iom_use( 'uadv_heattr' ) .OR. iom_use( 'udiff_heattr' ) .OR. & 
     389         &  iom_use( 'uadv_salttr' ) .OR. iom_use( 'udiff_salttr' ) .OR. & 
     390         &  iom_use( 'vadv_heattr' ) .OR. iom_use( 'vdiff_heattr' ) .OR. & 
     391         &  iom_use( 'vadv_salttr' ) .OR. iom_use( 'vdiff_salttr' ) .OR. & 
    375392         &  iom_use( 'rhop' )  ) L_ar5 = .TRUE. 
    376393   
  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DIA/diaptr.F90

    r13295 r13519  
    2222   USE oce              ! ocean dynamics and active tracers 
    2323   USE dom_oce          ! ocean space and time domain 
     24   ! TEMP: Possibly not necessary if using XIOS (if cumulative axis operations are possible) 
     25   USE domain, ONLY : dom_tile 
    2426   USE phycst           ! physical constants 
    2527   ! 
     
    3234   PRIVATE 
    3335 
     36   INTERFACE ptr_sum 
     37      MODULE PROCEDURE ptr_sum_3d, ptr_sum_2d 
     38   END INTERFACE 
     39 
    3440   INTERFACE ptr_sj 
    3541      MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d 
     
    4349 
    4450   !                                  !!** namelist  namptr  ** 
    45    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hstr_adv, hstr_ldf, hstr_eiv   !: Heat/Salt TRansports(adv, diff, Bolus.) 
    46    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hstr_ove, hstr_btr, hstr_vtr   !: heat Salt TRansports(overturn, baro, merional) 
     51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hstr_adv, hstr_ldf, hstr_eiv   !: Heat/Salt TRansports(adv, diff, Bolus.) 
     52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hstr_ove, hstr_btr, hstr_vtr   !: heat Salt TRansports(overturn, baro, merional) 
     53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   pvtr_int, pzon_int             !: Other zonal integrals 
    4754 
    4855   LOGICAL , PUBLIC ::   l_diaptr        !: tracers  trend flag (set from namelist in trdini) 
    4956   INTEGER, PARAMETER, PUBLIC ::   nptr = 5  ! (glo, atl, pac, ind, ipc) 
     57   INTEGER, PARAMETER         ::   jp_msk = 3 
     58   INTEGER, PARAMETER         ::   jp_vtr = 4 
    5059 
    5160   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
     
    5564   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks 
    5665   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk34 ! mask out Southern Ocean (=0 south of 34°S) 
    57  
    58    REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:)   :: p_fval1d 
    59    REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 
    6066 
    6167   LOGICAL ::   ll_init = .TRUE.        !: tracers  trend flag (set from namelist in trdini) 
     
    7177CONTAINS 
    7278 
     79   ! TEMP: Most changes and some code in this module not necessary if using XIOS (subdomain support, axis operations) 
    7380   SUBROUTINE dia_ptr( kt, Kmm, pvtr ) 
    7481      !!---------------------------------------------------------------------- 
     
    7784      INTEGER                         , INTENT(in)           ::   kt     ! ocean time-step index      
    7885      INTEGER                         , INTENT(in)           ::   Kmm    ! time level index 
    79       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport 
     86      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk)    , INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport 
     87      !!---------------------------------------------------------------------- 
     88      ! 
     89      IF( ln_timing )   CALL timing_start('dia_ptr') 
     90 
     91      IF( kt == nit000 .AND. ll_init )   CALL dia_ptr_init 
     92      ! 
     93      IF( l_diaptr ) THEN 
     94         ! Calculate zonal integrals 
     95         IF( PRESENT( pvtr ) ) THEN 
     96            CALL dia_ptr_zint( Kmm, pvtr ) 
     97         ELSE 
     98            CALL dia_ptr_zint( Kmm ) 
     99         ENDIF 
     100 
     101         ! Calculate diagnostics only when zonal integrals have finished 
     102         IF( ntile == 0 .OR. ntile == nijtile ) CALL dia_ptr_iom(kt, Kmm, pvtr) 
     103      ENDIF 
     104 
     105      IF( ln_timing )   CALL timing_stop('dia_ptr') 
     106      ! 
     107   END SUBROUTINE dia_ptr 
     108 
     109 
     110   SUBROUTINE dia_ptr_iom( kt, Kmm, pvtr ) 
     111      !!---------------------------------------------------------------------- 
     112      !!                  ***  ROUTINE dia_ptr_iom  *** 
     113      !!---------------------------------------------------------------------- 
     114      !! ** Purpose : Calculate diagnostics and send to XIOS 
     115      !!---------------------------------------------------------------------- 
     116      INTEGER                         , INTENT(in)           ::   kt     ! ocean time-step index 
     117      INTEGER                         , INTENT(in)           ::   Kmm    ! time level index 
     118      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk)    , INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport 
    80119      ! 
    81120      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    82       REAL(wp) ::   zsfc,zvfc               ! local scalar 
    83121      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace 
    84       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace 
    85       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d    ! 3D workspace 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace 
    87122      REAL(wp), DIMENSION(jpj)      ::  zvsum, ztsum, zssum   ! 1D workspace 
    88123      ! 
     
    94129      REAL(wp), DIMENSION(jpi,jpj,nptr)      :: z3dtr ! i-mean T and S, j-Stream-Function 
    95130      !!---------------------------------------------------------------------- 
    96       ! 
    97       IF( ln_timing )   CALL timing_start('dia_ptr') 
    98  
    99       IF( kt == nit000 .AND. ll_init )   CALL dia_ptr_init 
    100       ! 
    101       IF( .NOT. l_diaptr )   RETURN 
    102131 
    103132      IF( PRESENT( pvtr ) ) THEN 
    104133         IF( iom_use( 'zomsf' ) ) THEN    ! effective MSF 
    105134            DO jn = 1, nptr                                    ! by sub-basins 
    106                z4d1(1,:,:,jn) =  ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )  ! zonal cumulative effective transport excluding closed seas 
    107                DO jk = jpkm1, 1, -1  
     135               z4d1(1,:,:,jn) =  pvtr_int(:,:,jp_vtr,jn)                  ! zonal cumulative effective transport excluding closed seas 
     136               DO jk = jpkm1, 1, -1 
    108137                  z4d1(1,:,jk,jn) = z4d1(1,:,jk+1,jn) - z4d1(1,:,jk,jn)    ! effective j-Stream-Function (MSF) 
    109138               END DO 
     
    114143            CALL iom_put( 'zomsf', z4d1 * rc_sv ) 
    115144         ENDIF 
    116          IF(  iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.   & 
    117             & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 
    118             ! define fields multiplied by scalar 
    119             zmask(:,:,:) = 0._wp 
    120             zts(:,:,:,:) = 0._wp 
    121             DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 
    122                zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    123                zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
    124                zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
    125                zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
    126             END_3D 
    127          ENDIF 
    128145         IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 
    129146            DO jn = 1, nptr 
    130                sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
     147               sjk(:,:,jn) = pvtr_int(:,:,jp_msk,jn) 
    131148               r1_sjk(:,:,jn) = 0._wp 
    132149               WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
    133150               ! i-mean T and S, j-Stream-Function, basin 
    134                zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    135                zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    136                v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )  
     151               zt_jk(:,:,jn) = pvtr_int(:,:,jp_tem,jn) * r1_sjk(:,:,jn) 
     152               zs_jk(:,:,jn) = pvtr_int(:,:,jp_sal,jn) * r1_sjk(:,:,jn) 
     153               v_msf(:,:,jn) = pvtr_int(:,:,jp_vtr,jn) 
    137154               hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 
    138155               hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 
     
    158175            ! Calculate barotropic heat and salt transport here  
    159176            DO jn = 1, nptr 
    160                sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 
     177               sjk(:,1,jn) = SUM( pvtr_int(:,:,jp_msk,jn), 2 ) 
    161178               r1_sjk(:,1,jn) = 0._wp 
    162179               WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 
    163180               ! 
    164                zvsum(:) = ptr_sj( pvtr(:,:,:), btmsk34(:,:,jn) ) 
    165                ztsum(:) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
    166                zssum(:) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     181               zvsum(:) =    SUM( pvtr_int(:,:,jp_vtr,jn), 2 ) 
     182               ztsum(:) =    SUM( pvtr_int(:,:,jp_tem,jn), 2 ) 
     183               zssum(:) =    SUM( pvtr_int(:,:,jp_sal,jn), 2 ) 
    167184               hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 
    168185               hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 
     
    185202         ENDIF  
    186203         ! 
     204         hstr_ove(:,:,:) = 0._wp       ! Zero before next timestep 
     205         hstr_btr(:,:,:) = 0._wp 
     206         pvtr_int(:,:,:,:) = 0._wp 
    187207      ELSE 
    188          ! 
    189          zmask(:,:,:) = 0._wp 
    190          zts(:,:,:,:) = 0._wp 
    191          IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN    ! i-mean i-k-surface  
    192             DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    193                zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 
    194                zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
    195                zts(ji,jj,jk,jp_tem) = ts(ji,jj,jk,jp_tem,Kmm) * zsfc 
    196                zts(ji,jj,jk,jp_sal) = ts(ji,jj,jk,jp_sal,Kmm) * zsfc 
    197             END_3D 
     208         IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN    ! i-mean i-k-surface 
    198209            ! 
    199210            DO jn = 1, nptr 
    200                zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
    201                z4d1(:,:,:,jn) = zmask(:,:,:) 
     211               z4d1(1,:,:,jn) = pzon_int(:,:,jp_msk,jn) 
     212               DO ji = 2, jpi 
     213                  z4d1(ji,:,:,jn) = z4d1(1,:,:,jn) 
     214               ENDDO 
    202215            ENDDO 
    203216            CALL iom_put( 'zosrf', z4d1 ) 
    204217            ! 
    205218            DO jn = 1, nptr 
    206                z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 
    207                   &            / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
    208                DO ji = 1, jpi 
     219               z4d2(1,:,:,jn) = pzon_int(:,:,jp_tem,jn) / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
     220               DO ji = 2, jpi 
    209221                  z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 
    210222               ENDDO 
     
    213225            ! 
    214226            DO jn = 1, nptr 
    215                z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 
    216                   &            / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
    217                DO ji = 1, jpi 
     227               z4d2(1,:,:,jn) = pzon_int(:,:,jp_sal,jn) / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
     228               DO ji = 2, jpi 
    218229                  z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 
    219230               ENDDO 
     
    279290         ! 
    280291         IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 
    281             zts(:,:,:,:) = 0._wp 
    282             DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 
    283                zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    284                zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
    285                zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
    286             END_3D 
    287              CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 
    288              CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 
    289292             DO jn = 1, nptr 
    290293                z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
     
    303306         ENDIF 
    304307         ! 
     308         ! TEMP: Possibly not necessary if using XIOS (if cumulative axis operations are possible) 
     309         ! TODO: NOT TESTED- hangs on iom_get_var 
    305310         IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN 
     311            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
    306312            CALL iom_get_var(  'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 
    307313            z2d(:,:) = ptr_ci_2d( z2d(:,:) )   
    308314            CALL iom_put( 'uocetr_vsum_cumul', z2d ) 
    309          ENDIF 
    310          ! 
     315            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain 
     316         ENDIF 
     317         ! 
     318         hstr_adv(:,:,:) = 0._wp       ! Zero before next timestep 
     319         hstr_ldf(:,:,:) = 0._wp 
     320         hstr_eiv(:,:,:) = 0._wp 
     321         hstr_vtr(:,:,:) = 0._wp 
     322         pzon_int(:,:,:,:) = 0._wp 
    311323      ENDIF 
    312       ! 
    313       IF( ln_timing )   CALL timing_stop('dia_ptr') 
    314       ! 
    315    END SUBROUTINE dia_ptr 
     324   END SUBROUTINE dia_ptr_iom 
     325 
     326 
     327   SUBROUTINE dia_ptr_zint( Kmm, pvtr ) 
     328      !!---------------------------------------------------------------------- 
     329      !!                    ***  ROUTINE dia_ptr_zint *** 
     330      !!---------------------------------------------------------------------- 
     331      !! ** Purpose : i and i-k sum operations on arrays 
     332      !! 
     333      !! ** Method  : - Call ptr_sjk (i sum) or ptr_sj (i-k sum) to perform the sum operation 
     334      !!              - Call ptr_sum to add this result to the sum over tiles 
     335      !! 
     336      !! ** Action  : pvtr_int - terms for volume streamfunction, heat/salt transport barotropic/overturning terms 
     337      !!              pzon_int - terms for i mean temperature/salinity 
     338      !!---------------------------------------------------------------------- 
     339      INTEGER                     , INTENT(in)           :: Kmm          ! time level index 
     340      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(in), OPTIONAL :: pvtr         ! j-effective transport 
     341      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk)                       :: zmask        ! 3D workspace 
     342      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk,jpts)                  :: zts          ! 4D workspace 
     343      REAL(wp), DIMENSION(ST_1Dj(nn_hls),jpk,nptr)                 :: sjk, v_msf   ! Zonal sum: i-k surface area, j-effective transport 
     344      REAL(wp), DIMENSION(ST_1Dj(nn_hls),jpk,nptr)                 :: zt_jk, zs_jk ! Zonal sum: i-k surface area * (T, S) 
     345      REAL(wp)                                           :: zsfc, zvfc   ! i-k surface area 
     346      INTEGER  ::   ji, jj, jk, jn                                       ! dummy loop indices 
     347      !!---------------------------------------------------------------------- 
     348 
     349      IF( PRESENT( pvtr ) ) THEN 
     350         ! i sum of effective j transport excluding closed seas 
     351         IF( iom_use( 'zomsf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 
     352            DO jn = 1, nptr 
     353               v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) 
     354            ENDDO 
     355 
     356            CALL ptr_sum( pvtr_int(:,:,jp_vtr,:), v_msf(:,:,:) ) 
     357         ENDIF 
     358 
     359         ! i sum of j surface area, j surface area - temperature/salinity product on V grid 
     360         IF(  iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.   & 
     361            & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 
     362            zmask(:,:,:) = 0._wp 
     363            zts(:,:,:,:) = 0._wp 
     364 
     365            DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 
     366               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     367               zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
     368               zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc !Tracers averaged onto V grid 
     369               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
     370            END_3D 
     371 
     372            DO jn = 1, nptr 
     373               sjk(:,:,jn)   = ptr_sjk( zmask(:,:,:)     , btmsk(:,:,jn) ) 
     374               zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
     375               zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     376            ENDDO 
     377 
     378            CALL ptr_sum( pvtr_int(:,:,jp_msk,:), sjk(:,:,:)   ) 
     379            CALL ptr_sum( pvtr_int(:,:,jp_tem,:), zt_jk(:,:,:) ) 
     380            CALL ptr_sum( pvtr_int(:,:,jp_sal,:), zs_jk(:,:,:) ) 
     381         ENDIF 
     382      ELSE 
     383         ! i sum of j surface area - temperature/salinity product on T grid 
     384         IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN 
     385            zmask(:,:,:) = 0._wp 
     386            zts(:,:,:,:) = 0._wp 
     387 
     388            DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     389               zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 
     390               zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
     391               zts(ji,jj,jk,jp_tem) = ts(ji,jj,jk,jp_tem,Kmm) * zsfc 
     392               zts(ji,jj,jk,jp_sal) = ts(ji,jj,jk,jp_sal,Kmm) * zsfc 
     393            END_3D 
     394 
     395            DO jn = 1, nptr 
     396               sjk(:,:,jn)   = ptr_sjk( zmask(:,:,:)     , btmsk(:,:,jn) ) 
     397               zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
     398               zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     399            ENDDO 
     400 
     401            CALL ptr_sum( pzon_int(:,:,jp_msk,:), sjk(:,:,:)   ) 
     402            CALL ptr_sum( pzon_int(:,:,jp_tem,:), zt_jk(:,:,:) ) 
     403            CALL ptr_sum( pzon_int(:,:,jp_sal,:), zs_jk(:,:,:) ) 
     404         ENDIF 
     405 
     406         ! i-k sum of j surface area - temperature/salinity product on V grid 
     407         IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 
     408            zts(:,:,:,:) = 0._wp 
     409 
     410            DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 
     411               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     412               zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     413               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
     414            END_3D 
     415 
     416            CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 
     417            CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 
     418         ENDIF 
     419      ENDIF 
     420   END SUBROUTINE dia_ptr_zint 
    316421 
    317422 
     
    353458         IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum 
    354459 
    355          btmsk(:,:,1) = tmask_i(:,:)                  
     460         btmsk(:,:,:) = 0._wp 
     461         btmsk(:,:,1) = tmask_i(:,:) 
    356462         CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  ) 
    357463         CALL iom_get( inum, jpdom_global, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
     
    382488         hstr_btr(:,:,:) = 0._wp           ! 
    383489         hstr_vtr(:,:,:) = 0._wp           ! 
     490         pvtr_int(:,:,:,:) = 0._wp 
     491         pzon_int(:,:,:,:) = 0._wp 
    384492         ! 
    385493         ll_init = .FALSE. 
     
    399507      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
    400508      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv' 
    401       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx   ! 3D input array of advection/diffusion 
     509      REAL(wp), DIMENSION(ST_2D(nn_hls),jpk)    , INTENT(in)   :: pvflx ! 3D input array of advection/diffusion 
     510      REAL(wp), DIMENSION(ST_1Dj(nn_hls),nptr)                 :: zsj   ! 
    402511      INTEGER                                        :: jn    ! 
    403512 
     513      DO jn = 1, nptr 
     514         zsj(:,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
     515      ENDDO 
    404516      ! 
    405517      IF( cptr == 'adv' ) THEN 
    406          IF( ktra == jp_tem )  THEN 
    407              DO jn = 1, nptr 
    408                 hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    409              ENDDO 
    410          ENDIF 
    411          IF( ktra == jp_sal )  THEN 
    412              DO jn = 1, nptr 
    413                 hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    414              ENDDO 
    415          ENDIF 
     518         IF( ktra == jp_tem )  CALL ptr_sum( hstr_adv(:,jp_tem,:), zsj(:,:) ) 
     519         IF( ktra == jp_sal )  CALL ptr_sum( hstr_adv(:,jp_sal,:), zsj(:,:) ) 
     520      ELSE IF( cptr == 'ldf' ) THEN 
     521         IF( ktra == jp_tem )  CALL ptr_sum( hstr_ldf(:,jp_tem,:), zsj(:,:) ) 
     522         IF( ktra == jp_sal )  CALL ptr_sum( hstr_ldf(:,jp_sal,:), zsj(:,:) ) 
     523      ELSE IF( cptr == 'eiv' ) THEN 
     524         IF( ktra == jp_tem )  CALL ptr_sum( hstr_eiv(:,jp_tem,:), zsj(:,:) ) 
     525         IF( ktra == jp_sal )  CALL ptr_sum( hstr_eiv(:,jp_sal,:), zsj(:,:) ) 
     526      ELSE IF( cptr == 'vtr' ) THEN 
     527         IF( ktra == jp_tem )  CALL ptr_sum( hstr_vtr(:,jp_tem,:), zsj(:,:) ) 
     528         IF( ktra == jp_sal )  CALL ptr_sum( hstr_vtr(:,jp_sal,:), zsj(:,:) ) 
    416529      ENDIF 
    417530      ! 
    418       IF( cptr == 'ldf' ) THEN 
    419          IF( ktra == jp_tem )  THEN 
    420              DO jn = 1, nptr 
    421                 hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    422              ENDDO 
    423          ENDIF 
    424          IF( ktra == jp_sal )  THEN 
    425              DO jn = 1, nptr 
    426                 hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    427              ENDDO 
    428          ENDIF 
     531   END SUBROUTINE dia_ptr_hst 
     532 
     533 
     534   SUBROUTINE ptr_sum_2d( phstr, pva ) 
     535      !!---------------------------------------------------------------------- 
     536      !!                    ***  ROUTINE ptr_sum_2d *** 
     537      !!---------------------------------------------------------------------- 
     538      !! ** Purpose : Add two 2D arrays with (j,nptr) dimensions 
     539      !! 
     540      !! ** Method  : - phstr = phstr + pva 
     541      !!              - Call mpp_sum if the final tile 
     542      !! 
     543      !! ** Action  : phstr 
     544      !!---------------------------------------------------------------------- 
     545      REAL(wp), DIMENSION(jpj,nptr) , INTENT(inout)         ::  phstr  ! 
     546      REAL(wp), DIMENSION(ST_1Dj(nn_hls),nptr), INTENT(in)            ::  pva    ! 
     547      INTEGER                                               ::  jj 
     548#if defined key_mpp_mpi 
     549      INTEGER, DIMENSION(1)          ::  ish1d 
     550      INTEGER, DIMENSION(2)          ::  ish2d 
     551      REAL(wp), DIMENSION(jpj*nptr)  ::  zwork 
     552#endif 
     553 
     554      DO jj = ntsj, ntej 
     555         phstr(jj,:) = phstr(jj,:)  + pva(jj,:) 
     556      END DO 
     557 
     558#if defined key_mpp_mpi 
     559      IF( ntile == 0 .OR. ntile == nijtile ) THEN 
     560         ish1d(1) = jpj*nptr 
     561         ish2d(1) = jpj ; ish2d(2) = nptr 
     562         zwork(:) = RESHAPE( phstr(:,:), ish1d ) 
     563         CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl ) 
     564         phstr(:,:) = RESHAPE( zwork, ish2d ) 
    429565      ENDIF 
    430       ! 
    431       IF( cptr == 'eiv' ) THEN 
    432          IF( ktra == jp_tem )  THEN 
    433              DO jn = 1, nptr 
    434                 hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    435              ENDDO 
    436          ENDIF 
    437          IF( ktra == jp_sal )  THEN 
    438              DO jn = 1, nptr 
    439                 hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    440              ENDDO 
    441          ENDIF 
     566#endif 
     567   END SUBROUTINE ptr_sum_2d 
     568 
     569 
     570   SUBROUTINE ptr_sum_3d( phstr, pva ) 
     571      !!---------------------------------------------------------------------- 
     572      !!                    ***  ROUTINE ptr_sum_3d *** 
     573      !!---------------------------------------------------------------------- 
     574      !! ** Purpose : Add two 3D arrays with (j,k,nptr) dimensions 
     575      !! 
     576      !! ** Method  : - phstr = phstr + pva 
     577      !!              - Call mpp_sum if the final tile 
     578      !! 
     579      !! ** Action  : phstr 
     580      !!---------------------------------------------------------------------- 
     581      REAL(wp), DIMENSION(jpj,jpk,nptr) , INTENT(inout)     ::  phstr  ! 
     582      REAL(wp), DIMENSION(ST_1Dj(nn_hls),jpk,nptr), INTENT(in)        ::  pva    ! 
     583      INTEGER                                               ::  jj, jk 
     584#if defined key_mpp_mpi 
     585      INTEGER, DIMENSION(1)              ::  ish1d 
     586      INTEGER, DIMENSION(3)              ::  ish3d 
     587      REAL(wp), DIMENSION(jpj*jpk*nptr)  ::  zwork 
     588#endif 
     589 
     590      DO jk = 1, jpk 
     591         DO jj = ntsj, ntej 
     592            phstr(jj,jk,:) = phstr(jj,jk,:)  + pva(jj,jk,:) 
     593         END DO 
     594      END DO 
     595 
     596#if defined key_mpp_mpi 
     597      IF( ntile == 0 .OR. ntile == nijtile ) THEN 
     598         ish1d(1) = jpj*jpk*nptr 
     599         ish3d(1) = jpj ; ish3d(2) = jpk ; ish3d(3) = nptr 
     600         zwork(:) = RESHAPE( phstr(:,:,:), ish1d ) 
     601         CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl ) 
     602         phstr(:,:,:) = RESHAPE( zwork, ish3d ) 
    442603      ENDIF 
    443       ! 
    444       IF( cptr == 'vtr' ) THEN 
    445          IF( ktra == jp_tem )  THEN 
    446              DO jn = 1, nptr 
    447                 hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    448              ENDDO 
    449          ENDIF 
    450          IF( ktra == jp_sal )  THEN 
    451              DO jn = 1, nptr 
    452                 hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    453              ENDDO 
    454          ENDIF 
    455       ENDIF 
    456       ! 
    457    END SUBROUTINE dia_ptr_hst 
     604#endif 
     605   END SUBROUTINE ptr_sum_3d 
    458606 
    459607 
     
    463611      !!---------------------------------------------------------------------- 
    464612      INTEGER               ::   dia_ptr_alloc   ! return value 
    465       INTEGER, DIMENSION(3) ::   ierr 
     613      INTEGER, DIMENSION(2) ::   ierr 
    466614      !!---------------------------------------------------------------------- 
    467615      ierr(:) = 0 
     
    473621            &      hstr_ldf(jpj,jpts,nptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1)  ) 
    474622            ! 
    475          ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
     623         ALLOCATE( pvtr_int(jpj,jpk,jpts+2,nptr), & 
     624            &      pzon_int(jpj,jpk,jpts+1,nptr), STAT=ierr(2) ) 
    476625         ! 
    477626         dia_ptr_alloc = MAXVAL( ierr ) 
     
    493642      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx 
    494643      !!---------------------------------------------------------------------- 
    495       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)  ::   pvflx  ! mask flux array at V-point 
    496       REAL(wp), INTENT(in), DIMENSION(jpi,jpj)      ::   pmsk   ! Optional 2D basin mask 
     644      REAL(wp), INTENT(in), DIMENSION(ST_2D(nn_hls),jpk)  ::   pvflx  ! mask flux array at V-point 
     645      REAL(wp), INTENT(in), DIMENSION(jpi,jpj)  ::   pmsk   ! Optional 2D basin mask 
    497646      ! 
    498647      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments 
    499       INTEGER                  ::   ijpj         ! ??? 
    500       REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value 
     648      REAL(wp), DIMENSION(ST_1Dj(nn_hls)) :: p_fval  ! function value 
    501649      !!-------------------------------------------------------------------- 
    502650      ! 
    503       p_fval => p_fval1d 
    504  
    505       ijpj = jpj 
    506651      p_fval(:) = 0._wp 
    507652      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    508653         p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    509654      END_3D 
    510 #if defined key_mpp_mpi 
    511       CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) 
    512 #endif 
    513       ! 
    514655   END FUNCTION ptr_sj_3d 
    515656 
     
    526667      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx 
    527668      !!---------------------------------------------------------------------- 
    528       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pvflx  ! mask flux array at V-point 
     669      REAL(wp) , INTENT(in), DIMENSION(ST_2D(nn_hls))    ::   pvflx  ! mask flux array at V-point 
    529670      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pmsk   ! Optional 2D basin mask 
    530671      ! 
    531672      INTEGER                  ::   ji,jj       ! dummy loop arguments 
    532       INTEGER                  ::   ijpj        ! ??? 
    533       REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 
     673      REAL(wp), DIMENSION(ST_1Dj(nn_hls)) :: p_fval ! function value 
    534674      !!-------------------------------------------------------------------- 
    535       !  
    536       p_fval => p_fval1d 
    537  
    538       ijpj = jpj 
     675      ! 
    539676      p_fval(:) = 0._wp 
    540677      DO_2D( 0, 0, 0, 0 ) 
    541678         p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 
    542679      END_2D 
    543 #if defined key_mpp_mpi 
    544       CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl ) 
    545 #endif 
    546       !  
    547680   END FUNCTION ptr_sj_2d 
    548681 
     
    589722      !! 
    590723      IMPLICIT none 
    591       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! mask flux array at V-point 
    592       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask 
     724      REAL(wp) , INTENT(in), DIMENSION(ST_2D(nn_hls),jpk) ::   pta    ! mask flux array at V-point 
     725      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pmsk   ! Optional 2D basin mask 
    593726      !! 
    594727      INTEGER                           :: ji, jj, jk ! dummy loop arguments 
    595       REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value 
    596 #if defined key_mpp_mpi 
    597       INTEGER, DIMENSION(1) ::   ish 
    598       INTEGER, DIMENSION(2) ::   ish2 
    599       INTEGER               ::   ijpjjpk 
    600       REAL(wp), DIMENSION(jpj*jpk) ::   zwork    ! mask flux array at V-point 
    601 #endif 
     728      REAL(wp), DIMENSION(ST_1Dj(nn_hls),jpk) :: p_fval     ! return function value 
    602729      !!-------------------------------------------------------------------- 
    603730      ! 
    604       p_fval => p_fval2d 
    605  
    606731      p_fval(:,:) = 0._wp 
    607732      ! 
     
    609734         p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    610735      END_3D 
    611       ! 
    612 #if defined key_mpp_mpi 
    613       ijpjjpk = jpj*jpk 
    614       ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    615       zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 
    616       CALL mpp_sum( 'diaptr', zwork, ijpjjpk, ncomm_znl ) 
    617       p_fval(:,:) = RESHAPE( zwork, ish2 ) 
    618 #endif 
    619       ! 
    620736   END FUNCTION ptr_sjk 
    621737 
Note: See TracChangeset for help on using the changeset viewer.