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 12109 for NEMO/branches/2019/dev_r12072_TOP-01_ENHANCE-11_CEthe/src/OCE/DIA/diaptr.F90 – NEMO

Ignore:
Timestamp:
2019-12-07T12:40:06+01:00 (4 years ago)
Author:
cetlod
Message:

check out & merge dev_r11643_ENHANCE-11_CEthe_Shaconemo_diags branch onto dev_r12072_TOP-01_ENHANCE-11_CEthe

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r12072_TOP-01_ENHANCE-11_CEthe/src/OCE/DIA/diaptr.F90

    r11993 r12109  
    1010   !!            3.6  ! 2014-12  (C. Ethe) use of IOM 
    1111   !!            3.6  ! 2016-06  (T. Graham) Addition of diagnostics for CMIP6 
     12   !!            4.0  ! 2010-08  ( C. Ethe, J. Deshayes ) Improvment 
    1213   !!---------------------------------------------------------------------- 
    1314 
     
    4243 
    4344   !                                  !!** namelist  namptr  ** 
    44    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf, htr_eiv   !: Heat TRansports (adv, diff, Bolus.) 
    45    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf, str_eiv   !: Salt TRansports (adv, diff, Bolus.) 
    46    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_ove, str_ove   !: heat Salt TRansports ( overturn.) 
    47    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_btr, str_btr   !: heat Salt TRansports ( barotropic ) 
    48  
    49    LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F) 
    50    LOGICAL, PUBLIC ::   ln_subbas   !  Atlantic/Pacific/Indian basins calculation 
    51    INTEGER, PUBLIC ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)  
     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) 
     47 
     48   LOGICAL , PUBLIC ::   l_diaptr        !: tracers  trend flag (set from namelist in trdini) 
     49   INTEGER, PARAMETER, PUBLIC ::   nptr = 5  ! (glo, atl, pac, ind, ipc) 
    5250 
    5351   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
    5452   REAL(wp) ::   rc_pwatt = 1.e-15_wp  ! conversion from W    to PW (further x rau0 x Cp) 
    55    REAL(wp) ::   rc_ggram = 1.e-6_wp   ! conversion from g    to Pg 
    56  
    57    CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:)     :: clsubb 
    58    REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks 
    59    REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   :: btm30   ! mask out Southern Ocean (=0 south of 30°S) 
    60  
    61    REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:)     :: p_fval1d 
    62    REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: p_fval2d 
    63  
     53   REAL(wp) ::   rc_ggram = 1.e-9_wp   ! conversion from g    to Gg  (further x rau0) 
     54 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks 
     56   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 
     60 
     61   LOGICAL ::   ll_init = .TRUE.        !: tracers  trend flag (set from namelist in trdini) 
    6462   !! * Substitutions 
    6563#  include "vectopt_loop_substitute.h90" 
     
    7169CONTAINS 
    7270 
    73    SUBROUTINE dia_ptr( pvtr ) 
     71   SUBROUTINE dia_ptr( kt, pvtr ) 
    7472      !!---------------------------------------------------------------------- 
    7573      !!                  ***  ROUTINE dia_ptr  *** 
    7674      !!---------------------------------------------------------------------- 
     75      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index      
    7776      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport 
    7877      ! 
     
    8079      REAL(wp) ::   zsfc,zvfc               ! local scalar 
    8180      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace 
    8381      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace 
     82      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d    ! 3D workspace 
    8483      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace 
    85       REAL(wp), DIMENSION(jpj)     ::  vsum   ! 1D workspace 
    86       REAL(wp), DIMENSION(jpj,jpts)     ::  tssum   ! 1D workspace 
    87   
     84      REAL(wp), DIMENSION(jpj)      ::  zvsum, ztsum, zssum   ! 1D workspace 
    8885      ! 
    8986      !overturning calculation 
    90       REAL(wp), DIMENSION(jpj,jpk,nptr) ::   sjk  , r1_sjk ! i-mean i-k-surface and its inverse 
    91       REAL(wp), DIMENSION(jpj,jpk,nptr) ::   v_msf, sn_jk  , tn_jk ! i-mean T and S, j-Stream-Function 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvn   ! 3D workspace 
    93  
    94  
    95       CHARACTER( len = 12 )  :: cl1 
     87      REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk, r1_sjk, v_msf  ! i-mean i-k-surface and its inverse 
     88      REAL(wp), DIMENSION(jpj,jpk,nptr) :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function 
     89 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk,nptr)  :: z4d1, z4d2 
     91      REAL(wp), DIMENSION(jpi,jpj,nptr)      :: z3dtr ! i-mean T and S, j-Stream-Function 
    9692      !!---------------------------------------------------------------------- 
    9793      ! 
    9894      IF( ln_timing )   CALL timing_start('dia_ptr') 
    9995 
    100       ! 
     96      IF( kt == nit000 .AND. ll_init )   CALL dia_ptr_init 
     97      ! 
     98      IF( .NOT. l_diaptr )   RETURN 
     99 
    101100      IF( PRESENT( pvtr ) ) THEN 
    102          IF( iom_use("zomsfglo") ) THEN    ! effective MSF 
    103             z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) )  ! zonal cumulative effective transport 
    104             DO jk = 2, jpkm1  
    105               z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)   ! effective j-Stream-Function (MSF) 
     101         IF( iom_use( 'zomsf' ) ) THEN    ! effective MSF 
     102            DO jn = 1, nptr                                    ! by sub-basins 
     103               z4d1(1,:,:,jn) =  ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )  ! zonal cumulative effective transport excluding closed seas 
     104               DO jk = jpkm1, 1, -1  
     105                  z4d1(1,:,jk,jn) = z4d1(1,:,jk+1,jn) - z4d1(1,:,jk,jn)    ! effective j-Stream-Function (MSF) 
     106               END DO 
     107               DO ji = 1, jpi 
     108                  z4d1(ji,:,:,jn) = z4d1(1,:,:,jn) 
     109               ENDDO 
    106110            END DO 
    107             DO ji = 1, jpi 
    108                z3d(ji,:,:) = z3d(1,:,:) 
    109             ENDDO 
    110             cl1 = TRIM('zomsf'//clsubb(1) ) 
    111             CALL iom_put( cl1, z3d * rc_sv ) 
    112             DO jn = 2, nptr                                    ! by sub-basins 
    113                z3d(1,:,:) =  ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) )  
    114                DO jk = 2, jpkm1  
    115                   z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)    ! effective j-Stream-Function (MSF) 
    116                END DO 
    117                DO ji = 1, jpi 
    118                   z3d(ji,:,:) = z3d(1,:,:) 
    119                ENDDO 
    120                cl1 = TRIM('zomsf'//clsubb(jn) ) 
    121                CALL iom_put( cl1, z3d * rc_sv ) 
    122             END DO 
    123          ENDIF 
    124          IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 
     111            CALL iom_put( 'zomsf', z4d1 * rc_sv ) 
     112         ENDIF 
     113         IF(  iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.   & 
     114            & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 
    125115            ! define fields multiplied by scalar 
    126116            zmask(:,:,:) = 0._wp 
    127117            zts(:,:,:,:) = 0._wp 
    128             zvn(:,:,:) = 0._wp 
    129118            DO jk = 1, jpkm1 
    130119               DO jj = 1, jpjm1 
     
    134123                     zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid 
    135124                     zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 
    136                      zvn(ji,jj,jk)        = vn(ji,jj,jk)         * zvfc 
    137125                  ENDDO 
    138126               ENDDO 
    139127             ENDDO 
    140128         ENDIF 
    141          IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 
    142              sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 
    143              r1_sjk(:,:,1) = 0._wp 
    144              WHERE( sjk(:,:,1) /= 0._wp )   r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 
    145  
    146              ! i-mean T and S, j-Stream-Function, global 
    147              tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 
    148              sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 
    149              v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 
    150  
    151              htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 
    152              str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 
    153  
    154              z2d(1,:) = htr_ove(:,1) * rc_pwatt        !  (conversion in PW) 
    155              DO ji = 1, jpi 
    156                z2d(ji,:) = z2d(1,:) 
    157              ENDDO 
    158              cl1 = 'sophtove' 
    159              CALL iom_put( TRIM(cl1), z2d ) 
    160              z2d(1,:) = str_ove(:,1) * rc_ggram        !  (conversion in Gg) 
    161              DO ji = 1, jpi 
    162                z2d(ji,:) = z2d(1,:) 
    163              ENDDO 
    164              cl1 = 'sopstove' 
    165              CALL iom_put( TRIM(cl1), z2d ) 
    166              IF( ln_subbas ) THEN 
    167                 DO jn = 2, nptr 
    168                     sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
    169                     r1_sjk(:,:,jn) = 0._wp 
    170                     WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
    171  
    172                     ! i-mean T and S, j-Stream-Function, basin 
    173                     tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    174                     sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    175                     v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) )  
    176                     htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 
    177                     str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 
    178  
    179                     z2d(1,:) = htr_ove(:,jn) * rc_pwatt !  (conversion in PW) 
    180                     DO ji = 1, jpi 
    181                         z2d(ji,:) = z2d(1,:) 
    182                     ENDDO 
    183                     cl1 = TRIM('sophtove_'//clsubb(jn)) 
    184                     CALL iom_put( cl1, z2d ) 
    185                     z2d(1,:) = str_ove(:,jn) * rc_ggram        ! (conversion in Gg) 
    186                     DO ji = 1, jpi 
    187                         z2d(ji,:) = z2d(1,:) 
    188                     ENDDO 
    189                     cl1 = TRIM('sopstove_'//clsubb(jn)) 
    190                     CALL iom_put( cl1, z2d ) 
    191                 END DO 
    192              ENDIF 
    193          ENDIF 
    194          IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 
    195          ! Calculate barotropic heat and salt transport here  
    196              sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 
    197              r1_sjk(:,1,1) = 0._wp 
    198              WHERE( sjk(:,1,1) /= 0._wp )   r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 
    199              
    200             vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 
    201             tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 
    202             tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 
    203             htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 
    204             str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 
    205             z2d(1,:) = htr_btr(:,1) * rc_pwatt        !  (conversion in PW) 
    206             DO ji = 2, jpi 
    207                z2d(ji,:) = z2d(1,:) 
    208             ENDDO 
    209             cl1 = 'sophtbtr' 
    210             CALL iom_put( TRIM(cl1), z2d ) 
    211             z2d(1,:) = str_btr(:,1) * rc_ggram        !  (conversion in Gg) 
    212             DO ji = 2, jpi 
    213               z2d(ji,:) = z2d(1,:) 
    214             ENDDO 
    215             cl1 = 'sopstbtr' 
    216             CALL iom_put( TRIM(cl1), z2d ) 
    217             IF( ln_subbas ) THEN 
    218                 DO jn = 2, nptr 
    219                     sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 
    220                     r1_sjk(:,1,jn) = 0._wp 
    221                     WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 
    222                     vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 
    223                     tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
    224                     tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
    225                     htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 
    226                     str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 
    227                     z2d(1,:) = htr_btr(:,jn) * rc_pwatt !  (conversion in PW) 
    228                     DO ji = 1, jpi 
    229                         z2d(ji,:) = z2d(1,:) 
    230                     ENDDO 
    231                     cl1 = TRIM('sophtbtr_'//clsubb(jn)) 
    232                     CALL iom_put( cl1, z2d ) 
    233                     z2d(1,:) = str_btr(:,jn) * rc_ggram        ! (conversion in Gg) 
    234                     DO ji = 1, jpi 
    235                         z2d(ji,:) = z2d(1,:) 
    236                     ENDDO 
    237                     cl1 = TRIM('sopstbtr_'//clsubb(jn)) 
    238                     CALL iom_put( cl1, z2d ) 
    239                ENDDO 
    240             ENDIF !ln_subbas 
    241          ENDIF !iom_use("sopstbtr....) 
     129         IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 
     130            DO jn = 1, nptr 
     131               sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
     132               r1_sjk(:,:,jn) = 0._wp 
     133               WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
     134               ! i-mean T and S, j-Stream-Function, basin 
     135               zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     136               zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     137               v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )  
     138               hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 
     139               hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 
     140               ! 
     141            ENDDO 
     142            DO jn = 1, nptr 
     143               z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
     144               DO ji = 1, jpi 
     145                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     146               ENDDO 
     147            ENDDO 
     148            CALL iom_put( 'sophtove', z3dtr ) 
     149            DO jn = 1, nptr 
     150               z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
     151               DO ji = 1, jpi 
     152                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     153               ENDDO 
     154            ENDDO 
     155            CALL iom_put( 'sopstove', z3dtr ) 
     156         ENDIF 
     157 
     158         IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 
     159            ! Calculate barotropic heat and salt transport here  
     160            DO jn = 1, nptr 
     161               sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 
     162               r1_sjk(:,1,jn) = 0._wp 
     163               WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 
     164               ! 
     165               zvsum(:) = ptr_sj( pvtr(:,:,:), btmsk34(:,:,jn) ) 
     166               ztsum(:) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
     167               zssum(:) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     168               hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 
     169               hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 
     170               ! 
     171            ENDDO 
     172            DO jn = 1, nptr 
     173               z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
     174               DO ji = 1, jpi 
     175                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     176               ENDDO 
     177            ENDDO 
     178            CALL iom_put( 'sophtbtr', z3dtr ) 
     179            DO jn = 1, nptr 
     180               z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
     181               DO ji = 1, jpi 
     182                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     183               ENDDO 
     184            ENDDO 
     185            CALL iom_put( 'sopstbtr', z3dtr ) 
     186         ENDIF  
    242187         ! 
    243188      ELSE 
    244189         ! 
    245          IF( iom_use("zotemglo") ) THEN    ! i-mean i-k-surface  
     190         zmask(:,:,:) = 0._wp 
     191         zts(:,:,:,:) = 0._wp 
     192         IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN    ! i-mean i-k-surface  
    246193            DO jk = 1, jpkm1 
    247194               DO jj = 1, jpj 
     
    254201               END DO 
    255202            END DO 
     203            ! 
    256204            DO jn = 1, nptr 
    257205               zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
    258                cl1 = TRIM('zosrf'//clsubb(jn) ) 
    259                CALL iom_put( cl1, zmask ) 
    260                ! 
    261                z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 
    262                   &            / MAX( zmask(1,:,:), 10.e-15 ) 
    263                DO ji = 1, jpi 
    264                   z3d(ji,:,:) = z3d(1,:,:) 
    265                ENDDO 
    266                cl1 = TRIM('zotem'//clsubb(jn) ) 
    267                CALL iom_put( cl1, z3d ) 
    268                ! 
    269                z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 
    270                   &            / MAX( zmask(1,:,:), 10.e-15 ) 
    271                DO ji = 1, jpi 
    272                   z3d(ji,:,:) = z3d(1,:,:) 
    273                ENDDO 
    274                cl1 = TRIM('zosal'//clsubb(jn) ) 
    275                CALL iom_put( cl1, z3d ) 
    276             END DO 
     206               z4d1(:,:,:,jn) = zmask(:,:,:) 
     207            ENDDO 
     208            CALL iom_put( 'zosrf', z4d1 ) 
     209            ! 
     210            DO jn = 1, nptr 
     211               z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 
     212                  &            / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
     213               DO ji = 1, jpi 
     214                  z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 
     215               ENDDO 
     216            ENDDO 
     217            CALL iom_put( 'zotem', z4d2 ) 
     218            ! 
     219            DO jn = 1, nptr 
     220               z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 
     221                  &            / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
     222               DO ji = 1, jpi 
     223                  z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 
     224               ENDDO 
     225            ENDDO 
     226            CALL iom_put( 'zosal', z4d2 ) 
     227            ! 
    277228         ENDIF 
    278229         ! 
    279230         !                                ! Advective and diffusive heat and salt transport 
    280          IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN    
    281             z2d(1,:) = htr_adv(:,1) * rc_pwatt        !  (conversion in PW) 
    282             DO ji = 1, jpi 
    283                z2d(ji,:) = z2d(1,:) 
    284             ENDDO 
    285             cl1 = 'sophtadv'                  
    286             CALL iom_put( TRIM(cl1), z2d ) 
    287             z2d(1,:) = str_adv(:,1) * rc_ggram        ! (conversion in Gg) 
    288             DO ji = 1, jpi 
    289                z2d(ji,:) = z2d(1,:) 
    290             ENDDO 
    291             cl1 = 'sopstadv' 
    292             CALL iom_put( TRIM(cl1), z2d ) 
    293             IF( ln_subbas ) THEN 
    294               DO jn=2,nptr 
    295                z2d(1,:) = htr_adv(:,jn) * rc_pwatt        !  (conversion in PW) 
    296                DO ji = 1, jpi 
    297                  z2d(ji,:) = z2d(1,:) 
    298                ENDDO 
    299                cl1 = TRIM('sophtadv_'//clsubb(jn))                  
    300                CALL iom_put( cl1, z2d ) 
    301                z2d(1,:) = str_adv(:,jn) * rc_ggram        ! (conversion in Gg) 
    302                DO ji = 1, jpi 
    303                   z2d(ji,:) = z2d(1,:) 
    304                ENDDO 
    305                cl1 = TRIM('sopstadv_'//clsubb(jn))                  
    306                CALL iom_put( cl1, z2d )               
    307               ENDDO 
    308             ENDIF 
    309          ENDIF 
    310          ! 
    311          IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN    
    312             z2d(1,:) = htr_ldf(:,1) * rc_pwatt        !  (conversion in PW)  
    313             DO ji = 1, jpi 
    314                z2d(ji,:) = z2d(1,:) 
    315             ENDDO 
    316             cl1 = 'sophtldf' 
    317             CALL iom_put( TRIM(cl1), z2d ) 
    318             z2d(1,:) = str_ldf(:,1) * rc_ggram        !  (conversion in Gg) 
    319             DO ji = 1, jpi 
    320                z2d(ji,:) = z2d(1,:) 
    321             ENDDO 
    322             cl1 = 'sopstldf' 
    323             CALL iom_put( TRIM(cl1), z2d ) 
    324             IF( ln_subbas ) THEN 
    325               DO jn=2,nptr 
    326                z2d(1,:) = htr_ldf(:,jn) * rc_pwatt        !  (conversion in PW) 
    327                DO ji = 1, jpi 
    328                  z2d(ji,:) = z2d(1,:) 
    329                ENDDO 
    330                cl1 = TRIM('sophtldf_'//clsubb(jn))                  
    331                CALL iom_put( cl1, z2d ) 
    332                z2d(1,:) = str_ldf(:,jn) * rc_ggram        ! (conversion in Gg) 
    333                DO ji = 1, jpi 
    334                   z2d(ji,:) = z2d(1,:) 
    335                ENDDO 
    336                cl1 = TRIM('sopstldf_'//clsubb(jn))                  
    337                CALL iom_put( cl1, z2d )               
    338               ENDDO 
    339             ENDIF 
    340          ENDIF 
    341  
    342          IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN  
    343             z2d(1,:) = htr_eiv(:,1) * rc_pwatt        !  (conversion in PW)  
    344             DO ji = 1, jpi 
    345                z2d(ji,:) = z2d(1,:) 
    346             ENDDO 
    347             cl1 = 'sophteiv' 
    348             CALL iom_put( TRIM(cl1), z2d ) 
    349             z2d(1,:) = str_eiv(:,1) * rc_ggram        !  (conversion in Gg) 
    350             DO ji = 1, jpi 
    351                z2d(ji,:) = z2d(1,:) 
    352             ENDDO 
    353             cl1 = 'sopsteiv' 
    354             CALL iom_put( TRIM(cl1), z2d ) 
    355             IF( ln_subbas ) THEN 
    356                DO jn=2,nptr 
    357                   z2d(1,:) = htr_eiv(:,jn) * rc_pwatt        !  (conversion in PW) 
     231         IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN   
     232            !  
     233            DO jn = 1, nptr 
     234               z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
     235               DO ji = 1, jpi 
     236                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     237               ENDDO 
     238            ENDDO 
     239            CALL iom_put( 'sophtadv', z3dtr ) 
     240            DO jn = 1, nptr 
     241               z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
     242               DO ji = 1, jpi 
     243                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     244               ENDDO 
     245            ENDDO 
     246            CALL iom_put( 'sopstadv', z3dtr ) 
     247         ENDIF 
     248         ! 
     249         IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN   
     250            !  
     251            DO jn = 1, nptr 
     252               z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
     253               DO ji = 1, jpi 
     254                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     255               ENDDO 
     256            ENDDO 
     257            CALL iom_put( 'sophtldf', z3dtr ) 
     258            DO jn = 1, nptr 
     259               z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
     260               DO ji = 1, jpi 
     261                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     262               ENDDO 
     263            ENDDO 
     264            CALL iom_put( 'sopstldf', z3dtr ) 
     265         ENDIF 
     266         ! 
     267         IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN   
     268            !  
     269            DO jn = 1, nptr 
     270               z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
     271               DO ji = 1, jpi 
     272                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     273               ENDDO 
     274            ENDDO 
     275            CALL iom_put( 'sophteiv', z3dtr ) 
     276            DO jn = 1, nptr 
     277               z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
     278               DO ji = 1, jpi 
     279                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     280               ENDDO 
     281            ENDDO 
     282            CALL iom_put( 'sopsteiv', z3dtr ) 
     283         ENDIF 
     284         ! 
     285         IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 
     286            zts(:,:,:,:) = 0._wp 
     287            DO jk = 1, jpkm1 
     288               DO jj = 1, jpjm1 
    358289                  DO ji = 1, jpi 
    359                      z2d(ji,:) = z2d(1,:) 
     290                     zvfc = e1v(ji,jj) * e3v_n(ji,jj,jk) 
     291                     zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     292                     zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 
    360293                  ENDDO 
    361                   cl1 = TRIM('sophteiv_'//clsubb(jn))                  
    362                   CALL iom_put( cl1, z2d ) 
    363                   z2d(1,:) = str_eiv(:,jn) * rc_ggram        ! (conversion in Gg) 
    364                   DO ji = 1, jpi 
    365                      z2d(ji,:) = z2d(1,:) 
    366                   ENDDO 
    367                   cl1 = TRIM('sopsteiv_'//clsubb(jn))  
    368                   CALL iom_put( cl1, z2d )               
    369                ENDDO 
    370             ENDIF 
     294               ENDDO 
     295             ENDDO 
     296             CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 
     297             CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 
     298             DO jn = 1, nptr 
     299                z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
     300                DO ji = 1, jpi 
     301                   z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     302                ENDDO 
     303             ENDDO 
     304             CALL iom_put( 'sophtvtr', z3dtr ) 
     305             DO jn = 1, nptr 
     306               z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
     307               DO ji = 1, jpi 
     308                  z3dtr(ji,:,jn) = z3dtr(1,:,jn) 
     309               ENDDO 
     310            ENDDO 
     311            CALL iom_put( 'sopstvtr', z3dtr ) 
     312         ENDIF 
     313         ! 
     314         IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN 
     315            CALL iom_get_var(  'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 
     316            z2d(:,:) = ptr_ci_2d( z2d(:,:) )   
     317            CALL iom_put( 'uocetr_vsum_cumul', z2d ) 
    371318         ENDIF 
    372319         ! 
     
    384331      !! ** Purpose :   Initialization, namelist read 
    385332      !!---------------------------------------------------------------------- 
    386       INTEGER ::  jn           ! local integers 
    387       INTEGER ::  inum, ierr   ! local integers 
    388       INTEGER ::  ios          ! Local integer output status for namelist read 
    389       !! 
    390       NAMELIST/namptr/ ln_diaptr, ln_subbas 
    391       !!---------------------------------------------------------------------- 
    392  
    393       REWIND( numnam_ref )              ! Namelist namptr in reference namelist : Poleward transport 
    394       READ  ( numnam_ref, namptr, IOSTAT = ios, ERR = 901) 
    395 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist' ) 
    396  
    397       REWIND( numnam_cfg )              ! Namelist namptr in configuration namelist : Poleward transport 
    398       READ  ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 ) 
    399 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist' ) 
    400       IF(lwm) WRITE ( numond, namptr ) 
    401  
     333      INTEGER ::  inum, jn           ! local integers 
     334      !! 
     335      REAL(wp), DIMENSION(jpi,jpj) :: zmsk 
     336      !!---------------------------------------------------------------------- 
     337 
     338      l_diaptr = .FALSE. 
     339      IF(   iom_use( 'zomsf'    ) .OR. iom_use( 'zotem'    ) .OR. iom_use( 'zosal'    ) .OR.  & 
     340         &  iom_use( 'zosrf'    ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.  & 
     341         &  iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR.  & 
     342         &  iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR.  &  
     343         &  iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR.  & 
     344         &  iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) )  l_diaptr  = .TRUE. 
     345 
     346  
    402347      IF(lwp) THEN                     ! Control print 
    403348         WRITE(numout,*) 
     
    405350         WRITE(numout,*) '~~~~~~~~~~~~' 
    406351         WRITE(numout,*) '   Namelist namptr : set ptr parameters' 
    407          WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      ln_diaptr  = ', ln_diaptr 
    408          WRITE(numout,*) '      Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins      ln_subbas  = ', ln_subbas 
     352         WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      l_diaptr  = ', l_diaptr 
    409353      ENDIF 
    410354 
    411       IF( ln_diaptr ) THEN   
    412          ! 
    413          IF( ln_subbas ) THEN  
    414             nptr = 5            ! Global, Atlantic, Pacific, Indian, Indo-Pacific 
    415             ALLOCATE( clsubb(nptr) ) 
    416             clsubb(1) = 'glo' ;  clsubb(2) = 'atl'  ;  clsubb(3) = 'pac'  ;  clsubb(4) = 'ind'  ;  clsubb(5) = 'ipc' 
    417          ELSE                
    418             nptr = 1       ! Global only 
    419             ALLOCATE( clsubb(nptr) ) 
    420             clsubb(1) = 'glo'  
    421          ENDIF 
    422  
    423          !                                      ! allocate dia_ptr arrays 
     355      IF( l_diaptr ) THEN   
     356         ! 
    424357         IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 
    425358 
    426359         rc_pwatt = rc_pwatt * rau0_rcp          ! conversion from K.s-1 to PetaWatt 
     360         rc_ggram = rc_ggram * rau0              ! conversion from m3/s to Gg/s 
    427361 
    428362         IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum 
    429363 
    430          IF( ln_subbas ) THEN                ! load sub-basin mask 
    431             CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  ) 
    432             CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
    433             CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin 
    434             CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin 
    435             CALL iom_close( inum ) 
    436             btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin 
    437             WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean 
    438             ELSE WHERE                     ;   btm30(:,:) = ssmask(:,:) 
    439             END WHERE 
    440          ENDIF 
    441     
    442          btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean 
    443        
    444          DO jn = 1, nptr 
     364         btmsk(:,:,1) = tmask_i(:,:)                  
     365         CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  ) 
     366         CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
     367         CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin 
     368         CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin 
     369         CALL iom_close( inum ) 
     370         btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin 
     371         DO jn = 2, nptr 
    445372            btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only 
    446373         END DO 
     374         ! JD : modification so that overturning streamfunction is available in Atlantic at 34S to compare with observations 
     375         WHERE( gphit(:,:)*tmask_i(:,:) < -34._wp) 
     376           zmsk(:,:) = 0._wp      ! mask out Southern Ocean 
     377         ELSE WHERE                   
     378           zmsk(:,:) = ssmask(:,:) 
     379         END WHERE 
     380         btmsk34(:,:,1) = btmsk(:,:,1)                  
     381         DO jn = 2, nptr 
     382            btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:)               ! interior domain only 
     383         ENDDO 
    447384 
    448385         ! Initialise arrays to zero because diatpr is called before they are first calculated 
    449386         ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
    450          htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp  
    451          htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp  
    452          htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp  
    453          htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp 
    454          htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp 
     387         hstr_adv(:,:,:) = 0._wp            
     388         hstr_ldf(:,:,:) = 0._wp            
     389         hstr_eiv(:,:,:) = 0._wp            
     390         hstr_ove(:,:,:) = 0._wp            
     391         hstr_btr(:,:,:) = 0._wp           ! 
     392         hstr_vtr(:,:,:) = 0._wp           ! 
     393         ! 
     394         ll_init = .FALSE. 
    455395         ! 
    456396      ENDIF  
     
    471411      INTEGER                                        :: jn    ! 
    472412 
     413      ! 
    473414      IF( cptr == 'adv' ) THEN 
    474          IF( ktra == jp_tem )  htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 
    475          IF( ktra == jp_sal )  str_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     415         IF( ktra == jp_tem )  THEN 
     416             DO jn = 1, nptr 
     417                hstr_adv(:,jp_tem,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     418             ENDDO 
     419         ENDIF 
     420         IF( ktra == jp_sal )  THEN 
     421             DO jn = 1, nptr 
     422                hstr_adv(:,jp_sal,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     423             ENDDO 
     424         ENDIF 
    476425      ENDIF 
     426      ! 
    477427      IF( cptr == 'ldf' ) THEN 
    478          IF( ktra == jp_tem )  htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
    479          IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     428         IF( ktra == jp_tem )  THEN 
     429             DO jn = 1, nptr 
     430                hstr_ldf(:,jp_tem,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     431             ENDDO 
     432         ENDIF 
     433         IF( ktra == jp_sal )  THEN 
     434             DO jn = 1, nptr 
     435                hstr_ldf(:,jp_sal,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     436             ENDDO 
     437         ENDIF 
    480438      ENDIF 
     439      ! 
    481440      IF( cptr == 'eiv' ) THEN 
    482          IF( ktra == jp_tem )  htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
    483          IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     441         IF( ktra == jp_tem )  THEN 
     442             DO jn = 1, nptr 
     443                hstr_eiv(:,jp_tem,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     444             ENDDO 
     445         ENDIF 
     446         IF( ktra == jp_sal )  THEN 
     447             DO jn = 1, nptr 
     448                hstr_eiv(:,jp_sal,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     449             ENDDO 
     450         ENDIF 
    484451      ENDIF 
    485452      ! 
    486       IF( ln_subbas ) THEN 
    487          ! 
    488          IF( cptr == 'adv' ) THEN 
    489              IF( ktra == jp_tem ) THEN  
    490                 DO jn = 2, nptr 
    491                    htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
    492                 END DO 
    493              ENDIF 
    494              IF( ktra == jp_sal ) THEN  
    495                 DO jn = 2, nptr 
    496                    str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
    497                 END DO 
    498              ENDIF 
    499          ENDIF 
    500          IF( cptr == 'ldf' ) THEN 
    501              IF( ktra == jp_tem ) THEN  
    502                 DO jn = 2, nptr 
    503                     htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
    504                  END DO 
    505              ENDIF 
    506              IF( ktra == jp_sal ) THEN  
    507                 DO jn = 2, nptr 
    508                    str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
    509                 END DO 
    510              ENDIF 
    511          ENDIF 
    512          IF( cptr == 'eiv' ) THEN 
    513              IF( ktra == jp_tem ) THEN  
    514                 DO jn = 2, nptr 
    515                     htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
    516                  END DO 
    517              ENDIF 
    518              IF( ktra == jp_sal ) THEN  
    519                 DO jn = 2, nptr 
    520                    str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
    521                 END DO 
    522              ENDIF 
    523          ENDIF 
    524          ! 
     453      IF( cptr == 'vtr' ) THEN 
     454         IF( ktra == jp_tem )  THEN 
     455             DO jn = 1, nptr 
     456                hstr_vtr(:,jp_tem,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     457             ENDDO 
     458         ENDIF 
     459         IF( ktra == jp_sal )  THEN 
     460             DO jn = 1, nptr 
     461                hstr_vtr(:,jp_sal,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     462             ENDDO 
     463         ENDIF 
    525464      ENDIF 
     465      ! 
    526466   END SUBROUTINE dia_ptr_hst 
    527467 
     
    536476      ierr(:) = 0 
    537477      ! 
    538       ALLOCATE( btmsk(jpi,jpj,nptr) ,              & 
    539          &      htr_adv(jpj,nptr) , str_adv(jpj,nptr) ,   & 
    540          &      htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) ,   & 
    541          &      htr_ove(jpj,nptr) , str_ove(jpj,nptr) ,   & 
    542          &      htr_btr(jpj,nptr) , str_btr(jpj,nptr) ,   & 
    543          &      htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1)  ) 
    544          ! 
    545       ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
    546       ! 
    547       ALLOCATE( btm30(jpi,jpj), STAT=ierr(3)  ) 
    548  
    549          ! 
    550       dia_ptr_alloc = MAXVAL( ierr ) 
    551       CALL mpp_sum( 'diaptr', dia_ptr_alloc ) 
     478      IF( .NOT. ALLOCATED( btmsk ) ) THEN 
     479         ALLOCATE( btmsk(jpi,jpj,nptr)    , btmsk34(jpi,jpj,nptr),   & 
     480            &      hstr_adv(jpj,jpts,nptr), hstr_eiv(jpj,jpts,nptr), & 
     481            &      hstr_ove(jpj,jpts,nptr), hstr_btr(jpj,jpts,nptr), & 
     482            &      hstr_ldf(jpj,jpts,nptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1)  ) 
     483            ! 
     484         ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
     485         ! 
     486         dia_ptr_alloc = MAXVAL( ierr ) 
     487         CALL mpp_sum( 'diaptr', dia_ptr_alloc ) 
     488      ENDIF 
    552489      ! 
    553490   END FUNCTION dia_ptr_alloc 
     
    565502      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    566503      !!---------------------------------------------------------------------- 
    567       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)       ::   pva   ! mask flux array at V-point 
    568       REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask 
     504      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)  ::   pva   ! mask flux array at V-point 
     505      REAL(wp), INTENT(in), DIMENSION(jpi,jpj)      ::   pmsk   ! Optional 2D basin mask 
    569506      ! 
    570507      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments 
     
    577514      ijpj = jpj 
    578515      p_fval(:) = 0._wp 
    579       IF( PRESENT( pmsk ) ) THEN  
    580          DO jk = 1, jpkm1 
    581             DO jj = 2, jpjm1 
    582                DO ji = fs_2, fs_jpim1   ! Vector opt. 
    583                   p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 
    584                END DO 
     516      DO jk = 1, jpkm1 
     517         DO jj = 2, jpjm1 
     518            DO ji = fs_2, fs_jpim1   ! Vector opt. 
     519               p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    585520            END DO 
    586521         END DO 
    587       ELSE 
    588          DO jk = 1, jpkm1 
    589             DO jj = 2, jpjm1 
    590                DO ji = fs_2, fs_jpim1   ! Vector opt. 
    591                   p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj)  
    592                END DO 
    593             END DO 
    594          END DO 
    595       ENDIF 
     522      END DO 
    596523#if defined key_mpp_mpi 
    597524      CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) 
     
    612539      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    613540      !!---------------------------------------------------------------------- 
    614       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)           ::   pva   ! mask flux array at V-point 
    615       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask 
     541      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pva   ! mask flux array at V-point 
     542      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pmsk   ! Optional 2D basin mask 
    616543      ! 
    617544      INTEGER                  ::   ji,jj       ! dummy loop arguments 
     
    624551      ijpj = jpj 
    625552      p_fval(:) = 0._wp 
    626       IF( PRESENT( pmsk ) ) THEN  
    627          DO jj = 2, jpjm1 
    628             DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    629                p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 
    630             END DO 
     553      DO jj = 2, jpjm1 
     554         DO ji = fs_2, fs_jpim1   ! Vector opt. 
     555            p_fval(jj) = p_fval(jj) + pva(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 
    631556         END DO 
    632       ELSE 
    633          DO jj = 2, jpjm1 
    634             DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    635                p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 
    636             END DO 
    637          END DO 
    638       ENDIF 
     557      END DO 
    639558#if defined key_mpp_mpi 
    640559      CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl ) 
     
    643562   END FUNCTION ptr_sj_2d 
    644563 
     564   FUNCTION ptr_ci_2d( pva )   RESULT ( p_fval ) 
     565      !!---------------------------------------------------------------------- 
     566      !!                    ***  ROUTINE ptr_ci_2d  *** 
     567      !! 
     568      !! ** Purpose :   "meridional" cumulated sum computation of a j-flux array 
     569      !! 
     570      !! ** Method  : - j cumulated sum of pva using the interior 2D vmask (umask_i). 
     571      !! 
     572      !! ** Action  : - p_fval: j-cumulated sum of pva 
     573      !!---------------------------------------------------------------------- 
     574      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)  ::   pva   ! mask flux array at V-point 
     575      ! 
     576      INTEGER                  ::   ji,jj,jc       ! dummy loop arguments 
     577      INTEGER                  ::   ijpj        ! ???  
     578      REAL(wp), DIMENSION(jpi,jpj) :: p_fval ! function value 
     579      !!-------------------------------------------------------------------- 
     580      !  
     581      ijpj = jpj  ! ??? 
     582      p_fval(:,:) = 0._wp 
     583      DO jc = 1, jpnj ! looping over all processors in j axis 
     584         DO jj = 2, jpjm1 
     585            DO ji = fs_2, fs_jpim1   ! Vector opt. 
     586               p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 
     587            END DO 
     588         END DO 
     589         CALL lbc_lnk( 'diaptr', p_fval, 'U', -1. ) 
     590      END DO 
     591      !  
     592   END FUNCTION ptr_ci_2d 
     593 
     594 
    645595 
    646596   FUNCTION ptr_sjk( pta, pmsk )   RESULT ( p_fval ) 
     
    656606      !! 
    657607      IMPLICIT none 
    658       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pta    ! mask flux array at V-point 
    659       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask 
     608      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! mask flux array at V-point 
     609      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    ::   pmsk   ! Optional 2D basin mask 
    660610      !! 
    661611      INTEGER                           :: ji, jj, jk ! dummy loop arguments 
     
    673623      p_fval(:,:) = 0._wp 
    674624      ! 
    675       IF( PRESENT( pmsk ) ) THEN  
    676          DO jk = 1, jpkm1 
    677             DO jj = 2, jpjm1 
    678 !!gm here, use of tmask_i  ==> no need of loop over nldi, nlei.... 
    679                DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    680                   p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) 
    681                END DO 
     625      DO jk = 1, jpkm1 
     626         DO jj = 2, jpjm1 
     627            DO ji = fs_2, fs_jpim1   ! Vector opt. 
     628               p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    682629            END DO 
    683630         END DO 
    684       ELSE  
    685          DO jk = 1, jpkm1 
    686             DO jj = 2, jpjm1 
    687                DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    688                   p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj) 
    689                END DO 
    690             END DO 
    691          END DO 
    692       END IF 
     631      END DO 
    693632      ! 
    694633#if defined key_mpp_mpi 
Note: See TracChangeset for help on using the changeset viewer.