Changeset 1345


Ignore:
Timestamp:
2009-03-27T15:49:55+01:00 (12 years ago)
Author:
rblod
Message:

Update diaptr for mpp case, see ticket #361

Location:
trunk/NEMO/OPA_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/DIA/diaptr.F90

    r1340 r1345  
    66   !! History :  9.0  !  03-09  (C. Talandier, G. Madec)  Original code 
    77   !!            9.0  !  06-01  (A. Biastoch)  Allow sub-basins computation 
     8   !!            9.0  !  03-09  (O. Marti) Add fields 
    89   !!---------------------------------------------------------------------- 
    910 
     
    4344   LOGICAL , PUBLIC                 ::   ln_diaptr = .FALSE.   !: Poleward transport flag (T) or not (F) 
    4445   LOGICAL , PUBLIC                 ::   ln_subbas = .FALSE.   !: Atlantic/Pacific/Indian basins calculation 
    45    LOGICAL , PUBLIC                 ::   ln_diaznl             !: Add zonal means and meridional stream functions 
     46   LOGICAL , PUBLIC                 ::   ln_diaznl = .FALSE.   !: Add zonal means and meridional stream functions 
     47   LOGICAL , PUBLIC                 ::   ln_ptrcomp = .FALSE.  !: Add decomposition : overturning (and gyre, soon ...) 
    4648   INTEGER , PUBLIC                 ::   nf_ptr = 15           !: frequency of ptr computation 
    4749   INTEGER , PUBLIC                 ::   nf_ptr_wri = 15       !: frequency of ptr outputs 
    4850 
    49    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_adv, pst_adv      !: heat and salt poleward transport: advection 
    50    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove, pst_ove      !: heat and salt poleward transport: overturning 
     51   REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   abasin, pbasin, ibasin, dbasin, sbasin !: Sub basin masks 
     52 
     53   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_adv, pst_adv  !: heat and salt poleward transport: advection 
     54   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_glo, pst_ove_glo, pht_ove_atl, pst_ove_atl, pht_ove_pac, pst_ove_pac, & 
     55      &        pht_ove_ind, pst_ove_ind, pht_ove_ipc, pst_ove_ipc  !: heat and salt poleward transport: overturning 
    5156   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ldf, pst_ldf      !: heat and salt poleward transport: lateral diffusion 
    5257#if defined key_diaeiv 
    53    REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv, pst_eiv      !: heat and salt poleward transport: bolus advection 
     58   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_glo, pst_eiv_glo, pht_eiv_atl, pst_eiv_atl, pht_eiv_pac, pst_eiv_pac, & 
     59      &        pht_eiv_ind, pst_eiv_ind, pht_eiv_ipc, pst_eiv_ipc !: heat and salt poleward transport: bolus advection 
    5460#endif 
    5561   REAL(wp), PUBLIC, DIMENSION(jpj) ::   ht_glo,ht_atl,ht_ind,ht_pac,ht_ipc !: heat 
    5662   REAL(wp), PUBLIC, DIMENSION(jpj) ::   st_glo,st_atl,st_ind,st_pac,st_ipc !: salt 
    5763 
    58    INTEGER :: nidom_diaptr ! domain identifier for IOIPSL 
     64   INTEGER :: nidom_diaptr = FLIO_DOM_NONE ! domain identifier for IOIPSL 
     65   INTEGER :: niter 
    5966 
    6067   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_glo, sn_jk_glo,  &  !: "zonal" mean temperature and salinity 
     
    7986      &                              surf_jk_r_ipc        
    8087#if defined key_diaeiv 
    81    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv              !: bolus "meridional" Stream-Function 
    82 #endif 
    83    REAL(wp), DIMENSION(jpi,jpj) ::   abasin, pbasin, ibasin, dbasin, sbasin !: Sub basin masks 
    84  
     88   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_glo, v_msf_eiv_atl, v_msf_eiv_pac, v_msf_eiv_ind, v_msf_eiv_ipc !: bolus "meridional" Stream-Function 
     89#endif 
     90  
    8591   !! * Substitutions 
    8692#  include "domzgr_substitute.h90" 
     
    123129      END DO 
    124130      ! 
    125       IF( lk_mpp )   CALL mpp_sum( p_fval, ijpj )     !!bug  I presume 
     131      IF( lk_mpp )   CALL mpp_sum( p_fval, ijpj, ncomm_znl)     !!bug  I presume 
    126132      ! 
    127133   END FUNCTION ptr_vj_3d 
     
    150156      p_fval(:) = 0.e0 
    151157      DO jj = 2, jpjm1 
    152          DO ji = fs_2, fs_jpim1   ! Vector opt. 
     158         DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    153159            p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj+1) * tmask_i(ji,jj) 
    154160         END DO 
    155161      END DO 
    156162      ! 
    157       IF( lk_mpp )   CALL mpp_sum( p_fval, ijpj )     !!bug  I presume 
     163      IF( lk_mpp )   CALL mpp_sum( p_fval, ijpj, ncomm_znl )     !!bug  I presume 
    158164      !  
    159165   END FUNCTION ptr_vj_2d 
     
    186192         DO jk = 1, jpkm1 
    187193            DO jj = 2, jpjm1 
    188                DO ji = fs_2, fs_jpim1 
     194               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    189195                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk)   & 
    190196                     &                                          * tmask_i(ji,jj+1) * tmask_i(ji,jj) & 
     
    196202         DO jk = 1, jpkm1 
    197203            DO jj = 2, jpjm1 
    198                DO ji = fs_2, fs_jpim1 
     204               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    199205                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk)   & 
    200206                     &                                          * tmask_i(ji,jj+1) * tmask_i(ji,jj) 
     
    207213         ish(1) = jpj*jpk  ;  ish2(1) = jpj  ;  ish2(2) = jpk 
    208214         zwork(:)= RESHAPE( p_fval, ish ) 
    209          CALL mpp_sum( zwork, jpj*jpk ) 
     215         CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 
    210216         p_fval(:,:)= RESHAPE( zwork, ish2 ) 
    211217      END IF 
     
    239245         DO jk = 1, jpkm1 
    240246            DO jj = 2, jpjm1 
    241                DO ji = fs_2, fs_jpim1   ! Vector opt. 
     247               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    242248                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk)                  & 
    243249                     &                          * e1t(ji,jj) * fse3t(ji,jj,jk)   & 
     
    250256         DO jk = 1, jpkm1 
    251257            DO jj = 2, jpjm1 
    252                DO ji = fs_2, fs_jpim1   ! Vector opt. 
     258               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    253259                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk)                  & 
    254260                     &                          * e1t(ji,jj) * fse3t(ji,jj,jk)   & 
     
    262268         ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    263269         zwork(:)= RESHAPE( p_fval, ish ) 
    264          CALL mpp_sum( zwork, jpj*jpk ) 
     270         CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 
    265271         p_fval(:,:)= RESHAPE(zwork,ish2) 
    266272      END IF 
     
    284290      IF( kt == nit000 .OR. MOD( kt, nf_ptr ) == 0 )   THEN 
    285291 
    286          zsverdrup = 1.e-6 
    287          zpwatt    = 1.e-15 
    288          zggram    = 1.e-6 
    289           
    290          IF ( ln_diaznl ) THEN 
    291             ! "zonal" mean temperature and salinity at V-points 
    292             tn_jk_glo(:,:) = ptr_tjk( tn(:,:,:) ) * surf_jk_r_glo(:,:) 
    293             sn_jk_glo(:,:) = ptr_tjk( sn(:,:,:) ) * surf_jk_r_glo(:,:) 
    294              
    295             IF (ln_subbas) THEN  
    296                tn_jk_atl(:,:) = ptr_tjk( tn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 
    297                sn_jk_atl(:,:) = ptr_tjk( sn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 
    298                tn_jk_pac(:,:) = ptr_tjk( tn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 
    299                sn_jk_pac(:,:) = ptr_tjk( sn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 
    300                tn_jk_ind(:,:) = ptr_tjk( tn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 
    301                sn_jk_ind(:,:) = ptr_tjk( sn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 
    302                tn_jk_ipc(:,:) = ptr_tjk( tn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 
    303                sn_jk_ipc(:,:) = ptr_tjk( sn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 
    304             ENDIF 
    305          ENDIF 
    306           
    307          !-------------------------------------------------------- 
    308          ! overturning calculation: 
    309           
    310          ! horizontal integral and vertical dz  
    311  
    312 #if defined key_diaeiv 
    313          v_msf_glo(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:) )  
    314          IF( ln_subbas .AND. ln_diaznl ) THEN 
    315             v_msf_atl(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) )  
    316             v_msf_pac(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) )  
    317             v_msf_ind(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) )  
    318             v_msf_ipc(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) )  
    319          ENDIF 
     292         IF ( MOD( kt, nf_ptr ) == 0 ) THEN  
     293 
     294            zsverdrup = 1.e-6 
     295            zpwatt    = 1.e-15 
     296            zggram    = 1.e-6 
     297 
     298            IF ( ln_diaznl ) THEN 
     299               ! "zonal" mean temperature and salinity at V-points 
     300               tn_jk_glo(:,:) = ptr_tjk( tn(:,:,:) ) * surf_jk_r_glo(:,:) 
     301               sn_jk_glo(:,:) = ptr_tjk( sn(:,:,:) ) * surf_jk_r_glo(:,:) 
     302 
     303               IF (ln_subbas) THEN  
     304                  tn_jk_atl(:,:) = ptr_tjk( tn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 
     305                  sn_jk_atl(:,:) = ptr_tjk( sn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 
     306                  tn_jk_pac(:,:) = ptr_tjk( tn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 
     307                  sn_jk_pac(:,:) = ptr_tjk( sn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 
     308                  tn_jk_ind(:,:) = ptr_tjk( tn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 
     309                  sn_jk_ind(:,:) = ptr_tjk( sn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 
     310                  tn_jk_ipc(:,:) = ptr_tjk( tn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 
     311                  sn_jk_ipc(:,:) = ptr_tjk( sn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 
     312               ENDIF 
     313            ENDIF 
     314 
     315            !-------------------------------------------------------- 
     316            ! overturning calculation: 
     317 
     318            ! horizontal integral and vertical dz  
     319 
     320#if defined key_diaeiv 
     321            v_msf_glo(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:) )  
     322            IF( ln_subbas .AND. ln_diaznl ) THEN 
     323               v_msf_atl(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) )  
     324               v_msf_pac(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) )  
     325               v_msf_ind(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) )  
     326               v_msf_ipc(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) )  
     327            ENDIF 
    320328#else 
    321          v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) )  
    322          IF( ln_subbas .AND. ln_diaznl ) THEN 
    323             v_msf_atl(:,:) = ptr_vjk( vn (:,:,:), abasin(:,:)*sbasin(:,:) )  
    324             v_msf_pac(:,:) = ptr_vjk( vn (:,:,:), pbasin(:,:)*sbasin(:,:) )  
    325             v_msf_ind(:,:) = ptr_vjk( vn (:,:,:), ibasin(:,:)*sbasin(:,:) )  
    326             v_msf_ipc(:,:) = ptr_vjk( vn (:,:,:), dbasin(:,:)*sbasin(:,:) )  
    327          ENDIF 
    328 #endif 
    329           
    330 #if defined key_diaeiv 
    331          v_msf_eiv(:,:) = ptr_vjk( v_eiv(:,:,:) )  
    332 #endif 
    333           
    334          ! "Meridional" Stream-Function 
    335          DO jk = 2,jpk  
    336             v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 
    337          END DO 
    338          v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 
    339 #if defined key_diaeiv 
    340          ! Bolus "Meridional" Stream-Function 
    341          DO jk = 2,jpk 
    342             v_msf_eiv(:,jk) = v_msf_eiv(:,jk-1) + v_msf_eiv(:,jk) 
    343          END DO 
    344          v_msf_eiv(:,:) = v_msf_eiv(:,:) * zsverdrup 
    345 #endif 
    346          ! 
    347          IF( ln_subbas .AND. ln_diaznl ) THEN 
     329            v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) )  
     330            IF( ln_subbas .AND. ln_diaznl ) THEN 
     331               v_msf_atl(:,:) = ptr_vjk( vn (:,:,:), abasin(:,:)*sbasin(:,:) )  
     332               v_msf_pac(:,:) = ptr_vjk( vn (:,:,:), pbasin(:,:)*sbasin(:,:) )  
     333               v_msf_ind(:,:) = ptr_vjk( vn (:,:,:), ibasin(:,:)*sbasin(:,:) )  
     334               v_msf_ipc(:,:) = ptr_vjk( vn (:,:,:), dbasin(:,:)*sbasin(:,:) )  
     335            ENDIF 
     336#endif 
     337 
     338#if defined key_diaeiv 
     339            v_msf_eiv_glo(:,:) = ptr_vjk( v_eiv(:,:,:) ) 
     340            IF (ln_subbas ) THEN  
     341               v_msf_eiv_atl(:,:) = ptr_vjk( v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 
     342               v_msf_eiv_pac(:,:) = ptr_vjk( v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 
     343               v_msf_eiv_ind(:,:) = ptr_vjk( v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 
     344               v_msf_eiv_ipc(:,:) = ptr_vjk( v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 
     345            END IF 
     346#endif 
     347 
     348            ! "Meridional" Stream-Function 
    348349            DO jk = 2,jpk  
    349                v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 
    350                v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk) 
    351                v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk) 
    352                v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 
     350               v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 
    353351            END DO 
    354             v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 
    355             v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup 
    356             v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 
    357             v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 
    358          ENDIF 
    359              
    360          ! Transports 
    361          ! T times V on T points (include bolus velocities) 
     352            v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 
     353#if defined key_diaeiv 
     354            ! Bolus "Meridional" Stream-Function 
     355            DO jk = 2,jpk 
     356               v_msf_eiv_glo(:,jk) = v_msf_eiv_glo(:,jk-1) + v_msf_eiv_glo(:,jk) 
     357            END DO 
     358            v_msf_eiv_glo(:,:) = v_msf_eiv_glo(:,:) * zsverdrup 
     359            IF ( ln_subbas ) THEN  
     360               DO jk = 2,jpk 
     361                  v_msf_eiv_atl(:,jk) = v_msf_eiv_atl(:,jk-1) + v_msf_eiv_atl(:,jk) 
     362                  v_msf_eiv_pac(:,jk) = v_msf_eiv_pac(:,jk-1) + v_msf_eiv_pac(:,jk) 
     363                  v_msf_eiv_ind(:,jk) = v_msf_eiv_ind(:,jk-1) + v_msf_eiv_ind(:,jk) 
     364                  v_msf_eiv_ipc(:,jk) = v_msf_eiv_ipc(:,jk-1) + v_msf_eiv_ipc(:,jk) 
     365               END DO 
     366            ENDIF 
     367#endif 
     368            ! 
     369            IF( ln_subbas .AND. ln_diaznl ) THEN 
     370               DO jk = 2,jpk  
     371                  v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 
     372                  v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk) 
     373                  v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk) 
     374                  v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 
     375               END DO 
     376               v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 
     377               v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup 
     378               v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 
     379               v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 
     380            ENDIF 
     381 
     382            ! Transports 
     383            ! T times V on T points (include bolus velocities) 
    362384#if defined key_diaeiv  
    363          DO jj = 1, jpj 
    364             DO ji = 1, jpi 
    365                vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5 
    366                vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5 
     385            DO jj = 1, jpj 
     386               DO ji = 1, jpi 
     387                  vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5 
     388                  vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5 
     389               END DO 
    367390            END DO 
    368          END DO 
    369391#else 
    370          DO jj = 1, jpj 
    371             DO ji = 1, jpi 
    372                vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
    373                vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:)  )*0.5 
     392            DO jj = 1, jpj 
     393               DO ji = 1, jpi 
     394                  vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
     395                  vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:)  )*0.5 
     396               END DO 
    374397            END DO 
    375          END DO 
    376398#endif  
    377           
    378          ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 ) 
    379          st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 ) 
    380           
    381          IF ( ln_subbas ) THEN  
    382             ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
    383             ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
    384             ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
    385             ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
    386             st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
    387             st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
    388             st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
    389             st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
    390          ENDIF 
    391           
    392          ! poleward tracer transports:  
    393          ! overturning components: 
    394          pht_ove(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
    395          pst_ove(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 )   ! SUM over jk 
    396 #if defined key_diaeiv 
    397          pht_eiv(:) = SUM( v_msf_eiv(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
    398          pst_eiv(:) = SUM( v_msf_eiv(:,:) * sn_jk_glo(:,:), 2 )   ! SUM over jk 
    399 #endif 
    400  
    401          ! conversion in PW and G g 
    402          zpwatt = zpwatt * rau0 * rcp 
    403          pht_adv(:) = pht_adv(:) * zpwatt   
    404          pht_ove(:) = pht_ove(:) * zpwatt 
    405          pht_ldf(:) = pht_ldf(:) * zpwatt 
    406          pst_adv(:) = pst_adv(:) * zggram 
    407          pst_ove(:) = pst_ove(:) * zggram 
    408          pst_ldf(:) = pst_ldf(:) * zggram 
    409 #if defined key_diaeiv 
    410          pht_eiv(:) = pht_eiv(:) * zpwatt 
    411          pst_eiv(:) = pst_eiv(:) * zggram 
    412 #endif 
    413          IF( ln_subbas ) THEN 
    414             ht_atl(:) = ht_atl(:) * zpwatt 
    415             ht_pac(:) = ht_pac(:) * zpwatt 
    416             ht_ind(:) = ht_ind(:) * zpwatt 
    417             ht_ipc(:) = ht_ipc(:) * zpwatt 
    418             st_atl(:) = st_atl(:) * zggram  
    419             st_pac(:) = st_pac(:) * zggram 
    420             st_ind(:) = st_ind(:) * zggram 
    421             st_ipc(:) = st_ipc(:) * zggram 
     399 
     400            ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 ) 
     401            st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 ) 
     402 
     403            IF ( ln_subbas ) THEN  
     404               ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
     405               ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
     406               ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
     407               ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
     408               st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 
     409               st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 
     410               st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 
     411               st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 
     412            ENDIF 
     413 
     414            ! poleward tracer transports:  
     415            ! overturning components: 
     416            IF ( ln_ptrcomp ) THEN  
     417               pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
     418               pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 )   
     419               IF ( ln_subbas ) THEN  
     420                  pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk 
     421                  pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 )   
     422                  pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk 
     423                  pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 )   
     424                  pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk 
     425                  pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 )   
     426                  pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk 
     427                  pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 )   
     428               END IF 
     429            END IF 
     430 
     431            ! Bolus component 
     432#if defined key_diaeiv 
     433            pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk 
     434            pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 )   ! SUM over jk 
     435            IF ( ln_subbas ) THEN  
     436               pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk 
     437               pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 )   ! SUM over jk 
     438               pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk 
     439               pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 )   ! SUM over jk 
     440               pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk 
     441               pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 )   ! SUM over jk 
     442               pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk 
     443               pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 )   ! SUM over jk 
     444            ENDIF 
     445#endif 
     446 
     447            ! conversion in PW and G g 
     448            zpwatt = zpwatt * rau0 * rcp 
     449            pht_adv(:) = pht_adv(:) * zpwatt   
     450            pht_ldf(:) = pht_ldf(:) * zpwatt 
     451            pst_adv(:) = pst_adv(:) * zggram 
     452            pst_ldf(:) = pst_ldf(:) * zggram 
     453            IF ( ln_ptrcomp ) THEN  
     454               pht_ove_glo(:) = pht_ove_glo(:) * zpwatt 
     455               pst_ove_glo(:) = pst_ove_glo(:) * zggram 
     456            END IF 
     457#if defined key_diaeiv 
     458            pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt 
     459            pst_eiv_glo(:) = pst_eiv_glo(:) * zggram 
     460#endif 
     461            IF( ln_subbas ) THEN 
     462               ht_atl(:) = ht_atl(:) * zpwatt 
     463               ht_pac(:) = ht_pac(:) * zpwatt 
     464               ht_ind(:) = ht_ind(:) * zpwatt 
     465               ht_ipc(:) = ht_ipc(:) * zpwatt 
     466               st_atl(:) = st_atl(:) * zggram  
     467               st_pac(:) = st_pac(:) * zggram 
     468               st_ind(:) = st_ind(:) * zggram 
     469               st_ipc(:) = st_ipc(:) * zggram 
     470            ENDIF 
    422471         ENDIF 
    423472 
     
    439488      !! ** Purpose :   Initialization, namelist read 
    440489      !!---------------------------------------------------------------------- 
    441       NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, nf_ptr, nf_ptr_wri 
    442       INTEGER ::  inum       ! temporary logical unit 
     490      NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nf_ptr, nf_ptr_wri 
     491      INTEGER :: inum       ! temporary logical unit 
    443492      INTEGER, DIMENSION (1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
    444493      !!---------------------------------------------------------------------- 
     
    458507         WRITE(numout,*) '             Frequency of computation                    nf_ptr = ', nf_ptr 
    459508         WRITE(numout,*) '             Frequency of outputs                    nf_ptr_wri = ', nf_ptr_wri 
     509      ENDIF 
     510 
     511      ! 
     512      ! Define MPI communicator for zonal sum 
     513      ! 
     514      IF( lk_mpp )  THEN 
     515         CALL mpp_ini_znl 
    460516      ENDIF 
    461517 
     
    505561      idid (1) = 2 
    506562 
    507       IF(lwp) THEN 
    508           WRITE(numout,*) 
    509           WRITE(numout,*) 'diaptr_init :   iloc  = ', iloc  
    510           WRITE(numout,*) '~~~~~~~~~~~     iabsf = ', iabsf 
    511           WRITE(numout,*) '                ihals = ', ihals 
    512           WRITE(numout,*) '                ihale = ', ihale 
    513       ENDIF 
    514  
    515       CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_diaptr) 
     563!-$$      IF(lwp) THEN 
     564!-$$          WRITE(numout,*) 
     565!-$$          WRITE(numout,*) 'dia_ptr_init :   iloc  = ', iloc  
     566!-$$          WRITE(numout,*) '~~~~~~~~~~~~     iabsf = ', iabsf 
     567!-$$          WRITE(numout,*) '                 ihals = ', ihals 
     568!-$$          WRITE(numout,*) '                 ihale = ', ihale 
     569!-$$      ENDIF  
     570 
     571      CALL flio_dom_set ( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_diaptr) 
    516572       
    517573   END SUBROUTINE dia_ptr_init 
     
    544600 
    545601      ! define time axis 
    546       it    = kt 
     602      it    = kt / nf_ptr 
    547603      itmod = kt - nit000 + 1 
     604       
     605!-$$      IF(lwp) THEN 
     606!-$$         WRITE(numout,*) 
     607!-$$         WRITE(numout,*) 'dia_ptr_wri : kt = ', kt, 'it = ', it, ' itmod = ', itmod, ' niter = ', niter 
     608!-$$         WRITE(numout,*) '~~~~~~~~~~~~' 
     609!-$$      ENDIF 
    548610 
    549611      ! Initialization 
    550612      ! -------------- 
    551613      IF( kt == nit000 ) THEN 
     614 
     615         niter = (nit000 - 1) / nf_ptr 
     616 
     617!-$$         IF(lwp) THEN 
     618!-$$            WRITE(numout,*) 
     619!-$$            WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 
     620!-$$            WRITE(numout,*) '~~~~~~~~~~~~' 
     621!-$$         ENDIF 
    552622 
    553623         zdt = rdt 
     
    562632            IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole 
    563633            IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole 
     634            IF( jp_cfg == 1   )   iline =  96   ! i-line that passes near the North Pole 
    564635            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole 
    565636            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole 
    566             zphi(:) = -9999.9999e0 
     637            zphi(:) = 0.e0 
    567638            DO ji = mi0(iline), mi1(iline)  
    568                WRITE(numout,*) 'diaptr : ', nproc, narea, iline, ji, mi0(iline), mi1(iline), & 
    569                   &  mj0(jpjdta-1), mj1(jpjdta-1), mj0(jpjdta), mj1(jpjdta), '--' 
    570                CALL flush (numout) 
    571639               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain 
    572640               ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 
    573641               IF( jp_cfg == 05 ) THEN 
    574642                  DO jj = mj0(jpjdta), mj1(jpjdta)  
    575                      zphi( jj ) = zphi(jpjdta-1) + (zphi(jpjdta-1)-zphi(jpjdta-2))/2. 
     643                     zphi( jj ) = zphi(mj0(jpjdta-1)) + (zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)))/2. 
    576644                     zphi( jj ) = MIN( zphi(jj), 90.) 
    577645                  END DO 
    578646               END IF 
    579                IF( jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 
     647               IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 
    580648                  DO jj = mj0(jpjdta-1), mj1(jpjdta-1)  
    581649                     zphi( jj ) = 88.5e0 
     
    587655            END DO 
    588656            ! provide the correct zphi to all local domains 
    589             DO jj = 1, jpj 
    590                WRITE(numout,*) 'diaptr(1) ', nproc, jj, mjg(jj), zphi(jj), '--' 
    591                CALL flush (numout) 
    592             ENDDO 
    593             IF( lk_mpp )   CALL mpp_sum( zphi, jpj )         
     657            IF( lk_mpp )   CALL mpp_sum( zphi, jpj, ncomm_znl )         
    594658 
    595659            !                                        ! ======================= 
    596660         ELSE                                        !   OTHER configurations  zjulian = zjulian - adatrj  
    597                                                      !   set calendar origin to the beginning of the experiment 
     661            !   set calendar origin to the beginning of the experiment 
    598662            !                                        ! ======================= 
    599663            zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line 
    600664            ! 
    601665         ENDIF 
    602          DO jj = 1, jpj 
    603             WRITE(numout,*) 'diaptr(2) ', nproc, jj, mjg(jj), zphi(jj), '--' 
    604             CALL flush (numout) 
    605          ENDDO 
    606  
    607          ! OPEN netcdf file  
    608          ! ---------------- 
    609          ! Define frequency of output and means 
    610          zsto = nf_ptr * zdt 
    611          IF( ln_mskland )   THEN    ! put 1.e+20 on land (very expensive!!) 
    612             clop      = "ave(only(x))" 
    613             clop_once = "once(only(x))" 
    614          ELSE                       ! no use of the mask value (require less cpu time) 
    615             clop      = "ave(x)"        
    616             clop_once = "once" 
    617          ENDIF 
    618  
    619          zout = nf_ptr_wri * zdt 
    620          zfoo(:) = 0.e0 
    621  
    622          ! Compute julian date from starting date of the run 
    623  
    624          CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
    625          zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    626  
    627          CALL dia_nam( clhstnam, nf_ptr_wri, 'diaptr' ) 
    628          IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file ",clhstnam 
    629  
    630          ! Horizontal grid : zphi() 
    631          CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   & 
    632             1, 1, 1, jpj, nit000-1, zjulian, zdt, nhoridz, numptr, domain_id=nidom_diaptr ) 
    633          ! Vertical grids : gdept_0, gdepw_0 
    634          CALL histvert( numptr, "deptht", "Vertical T levels",   & 
    635             "m", jpk, gdept_0, ndepidzt, "down" ) 
    636          CALL histvert( numptr, "depthw", "Vertical W levels",   & 
    637             "m", jpk, gdepw_0, ndepidzw, "down" ) 
    638  
    639666         ! 
    640          CALL wheneq ( jpj*jpk, MIN(surf_jk_glo(:,:), 1.e0), 1, 1., ndex  , ndim  )      ! Lat-Depth 
    641          CALL wheneq ( jpj    , MIN(surf_jk_glo(:,1), 1.e0), 1, 1., ndex_h, ndim_h )     ! Lat 
    642  
    643          IF (ln_subbas) THEN 
    644             z_1 (:,1) = 1.0e0 
    645             WHERE ( gphit (jpi/2,:) .LT. -30 ) z_1 (:,1) = 0.e0 
    646             DO jk = 2, jpk 
    647                z_1 (:,jk) = z_1 (:,1) 
    648             END DO 
    649  
    650             CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)         , 1.e0), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth 
    651             CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth 
    652             CALL wheneq ( jpj    , MIN(surf_jk_atl(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 
    653  
    654             CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)         , 1.e0), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth 
    655             CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth 
    656             CALL wheneq ( jpj    , MIN(surf_jk_pac(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 
    657  
    658             CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)         , 1.e0), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth 
    659             CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth 
    660             CALL wheneq ( jpj    , MIN(surf_jk_ind(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 
    661  
    662             CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)         , 1.e0), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth 
    663             CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth 
    664             CALL wheneq ( jpj    , MIN(surf_jk_ipc(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 
    665  
    666          ENDIF 
    667  
    668          !  
    669 #if defined key_diaeiv 
    670          cl_comment = ' (Bolus part included)' 
     667         ! Work only on westmost processor (will not work if mppini2 is used) 
     668         IF ( l_znl_root ) THEN  
     669            ! 
     670            ! OPEN netcdf file  
     671            ! ---------------- 
     672            ! Define frequency of output and means 
     673            zsto = nf_ptr * zdt 
     674            IF( ln_mskland )   THEN    ! put 1.e+20 on land (very expensive!!) 
     675               clop      = "ave(only(x))" 
     676               clop_once = "once(only(x))" 
     677            ELSE                       ! no use of the mask value (require less cpu time) 
     678               clop      = "ave(x)"        
     679               clop_once = "once" 
     680            ENDIF 
     681 
     682            zout = nf_ptr_wri * zdt 
     683            zfoo(:) = 0.e0 
     684 
     685            ! Compute julian date from starting date of the run 
     686 
     687            CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
     688            zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
     689 
     690            CALL dia_nam( clhstnam, nf_ptr_wri, 'diaptr' ) 
     691            IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam 
     692 
     693            ! Horizontal grid : zphi() 
     694            CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   & 
     695               1, 1, 1, jpj, niter, zjulian, zdt*nf_ptr, nhoridz, numptr, domain_id=nidom_diaptr ) 
     696            ! Vertical grids : gdept_0, gdepw_0 
     697            CALL histvert( numptr, "deptht", "Vertical T levels",   & 
     698               "m", jpk, gdept_0, ndepidzt, "down" ) 
     699            CALL histvert( numptr, "depthw", "Vertical W levels",   & 
     700               "m", jpk, gdepw_0, ndepidzw, "down" ) 
     701 
     702            ! 
     703            CALL wheneq ( jpj*jpk, MIN(surf_jk_glo(:,:), 1.e0), 1, 1., ndex  , ndim  )      ! Lat-Depth 
     704            CALL wheneq ( jpj    , MIN(surf_jk_glo(:,1), 1.e0), 1, 1., ndex_h, ndim_h )     ! Lat 
     705 
     706            IF (ln_subbas) THEN 
     707               z_1 (:,1) = 1.0e0 
     708               WHERE ( gphit (jpi/2,:) .LT. -30 ) z_1 (:,1) = 0.e0 
     709               DO jk = 2, jpk 
     710                  z_1 (:,jk) = z_1 (:,1) 
     711               END DO 
     712 
     713               CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)         , 1.e0), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth 
     714               CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth 
     715               CALL wheneq ( jpj    , MIN(surf_jk_atl(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 
     716 
     717               CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)         , 1.e0), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth 
     718               CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth 
     719               CALL wheneq ( jpj    , MIN(surf_jk_pac(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 
     720 
     721               CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)         , 1.e0), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth 
     722               CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth 
     723               CALL wheneq ( jpj    , MIN(surf_jk_ind(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 
     724 
     725               CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)         , 1.e0), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth 
     726               CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth 
     727               CALL wheneq ( jpj    , MIN(surf_jk_ipc(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 
     728 
     729            ENDIF 
     730 
     731            !  
     732#if defined key_diaeiv 
     733            cl_comment = ' (Bolus part included)' 
    671734#else 
    672          cl_comment = ' ' 
    673 #endif 
    674          !  Zonal mean T and S 
    675  
    676          IF ( ln_diaznl ) THEN  
    677             CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   & 
    678                1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    679             CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   & 
    680                1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    681  
    682             CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2"   ,   & 
    683                1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
     735            cl_comment = '                      ' 
     736#endif 
     737            !  Zonal mean T and S 
     738 
     739            IF ( ln_diaznl ) THEN  
     740               CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   & 
     741                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     742               CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   & 
     743                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     744 
     745               CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2"   ,   & 
     746                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
     747 
     748               IF (ln_subbas) THEN  
     749                  CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" ,   & 
     750                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     751                  CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU"  ,   & 
     752                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     753                  CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2"   ,   & 
     754                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
     755 
     756                  CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C"  ,   & 
     757                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     758                  CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU"   ,   & 
     759                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     760                  CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2"    ,   & 
     761                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
     762 
     763                  CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C"   ,   & 
     764                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     765                  CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU"    ,   & 
     766                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     767                  CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2"     ,   & 
     768                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
     769 
     770                  CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" ,   & 
     771                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     772                  CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU"  ,   & 
     773                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
     774                  CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2"   ,   & 
     775                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
     776               ENDIF 
     777 
     778            ENDIF 
     779 
     780            !  Meridional Stream-Function (Eulerian and Bolus) 
     781 
     782            CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" ,   & 
     783               1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
     784            IF( ln_subbas .AND. ln_diaznl ) THEN 
     785               CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" ,   & 
     786                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
     787               CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv"  ,   & 
     788                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
     789               CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv"   ,   & 
     790                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
     791               CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,& 
     792                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
     793            ENDIF 
     794 
     795            !  Heat transport  
     796 
     797            CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   & 
     798               "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     799            CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   & 
     800               "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     801            IF ( ln_ptrcomp ) THEN  
     802               CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   & 
     803                  "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     804            END IF 
     805            IF( ln_subbas ) THEN 
     806               CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment),  & 
     807                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     808               CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) ,  & 
     809                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     810               CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment)  ,  & 
     811                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     812               CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), & 
     813                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     814            ENDIF 
     815 
     816 
     817            !  Salt transport  
     818 
     819            CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   & 
     820               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     821            CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   & 
     822               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     823            IF ( ln_ptrcomp ) THEN  
     824               CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   & 
     825                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     826            END IF 
     827#if defined key_diaeiv 
     828            ! Eddy induced velocity 
     829            CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global",   & 
     830               "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
     831            CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   & 
     832               "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     833            CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   & 
     834               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     835#endif 
     836            IF( ln_subbas ) THEN 
     837               CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment)      ,  & 
     838                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     839               CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment)      ,   & 
     840                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     841               CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment)      ,    & 
     842                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     843               CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment),  & 
     844                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     845            ENDIF 
     846 
     847            CALL histend( numptr ) 
     848 
     849         END IF 
     850      END IF 
     851 
     852      IF( MOD( itmod, nf_ptr ) == 0 .AND. l_znl_root ) THEN 
     853 
     854         niter = niter + 1 
     855 
     856!-$$         IF(lwp) THEN 
     857!-$$            WRITE(numout,*) 
     858!-$$            WRITE(numout,*) 'dia_ptr_wri : write Poleward Transports at time-step : kt = ', kt, & 
     859!-$$               & 'it = ', it, ' itmod = ', itmod, ' niter = ', niter 
     860!-$$            WRITE(numout,*) '~~~~~~~~~~' 
     861!-$$            WRITE(numout,*) 
     862!-$$         ENDIF 
     863 
     864         IF (ln_diaznl ) THEN  
     865            CALL histwrite( numptr, "zosrfglo", niter, surf_jk_glo , ndim, ndex ) 
     866            CALL histwrite( numptr, "zotemglo", niter, tn_jk_glo  , ndim, ndex ) 
     867            CALL histwrite( numptr, "zosalglo", niter, sn_jk_glo  , ndim, ndex ) 
    684868 
    685869            IF (ln_subbas) THEN  
    686                CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" ,   & 
    687                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    688                CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU"  ,   & 
    689                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    690                CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2"   ,   & 
    691                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    692  
    693                CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C"  ,   & 
    694                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    695                CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU"   ,   & 
    696                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    697                CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2"    ,   & 
    698                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    699  
    700                CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C"   ,   & 
    701                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    702                CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU"    ,   & 
    703                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    704                CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2"     ,   & 
    705                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    706  
    707                CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" ,   & 
    708                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    709                CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU"  ,   & 
    710                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    711                CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2"   ,   & 
    712                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    713             ENDIF 
    714  
    715          ENDIF 
    716  
    717          !  Meridional Stream-Function (Eulerian and Bolus) 
    718  
    719          CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" ,   & 
    720             1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    721          IF( ln_subbas .AND. ln_diaznl ) THEN 
    722             CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" ,   & 
    723                1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    724             CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv"  ,   & 
    725                1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    726             CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv"   ,   & 
    727                1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    728             CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,& 
    729                1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    730          ENDIF 
    731  
    732          !  Heat transport  
    733  
    734          CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   & 
    735             "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    736          CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   & 
    737             "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    738          CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   & 
    739             "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    740          IF( ln_subbas ) THEN 
    741             CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment),  & 
    742                "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    743             CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) ,  & 
    744                "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    745             CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment)  ,  & 
    746                "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    747             CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), & 
    748                "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    749          ENDIF 
    750  
    751  
    752          !  Salt transport  
    753  
    754          CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   & 
    755             "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    756          CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   & 
    757             "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    758          CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   & 
    759             "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    760  
    761 #if defined key_diaeiv 
    762          ! Eddy induced velocity 
    763          CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global",   & 
    764             "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    765          CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   & 
    766             "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    767          CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   & 
    768             "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    769 #endif 
    770          IF( ln_subbas ) THEN 
    771             CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment)      ,  & 
    772                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    773             CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment)      ,   & 
    774                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    775             CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment)      ,    & 
    776                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    777             CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment),  & 
    778                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    779          ENDIF 
    780  
    781          CALL histend( numptr ) 
    782  
    783       ENDIF 
    784  
    785       IF( MOD( itmod, nf_ptr ) == 0 ) THEN 
    786  
    787          IF(lwp) THEN 
    788             WRITE(numout,*) 
    789             WRITE(numout,*) 'dia_ptr : compute Poleward Transports at time-step : ', kt 
    790             WRITE(numout,*) '~~~~~~~~' 
    791             WRITE(numout,*) 
    792          ENDIF 
    793  
    794          IF (ln_diaznl ) THEN  
    795             CALL histwrite( numptr, "zosrfglo", it, surf_jk_glo , ndim, ndex ) 
    796             CALL histwrite( numptr, "zotemglo", it, tn_jk_glo  , ndim, ndex ) 
    797             CALL histwrite( numptr, "zosalglo", it, sn_jk_glo  , ndim, ndex ) 
    798  
    799             IF (ln_subbas) THEN  
    800                CALL histwrite( numptr, "zosrfatl", it, surf_jk_atl, ndim_atl, ndex_atl ) 
    801                CALL histwrite( numptr, "zosrfpac", it, surf_jk_pac, ndim_pac, ndex_pac ) 
    802                CALL histwrite( numptr, "zosrfind", it, surf_jk_ind, ndim_ind, ndex_ind ) 
    803                CALL histwrite( numptr, "zosrfipc", it, surf_jk_ipc, ndim_ipc, ndex_ipc ) 
    804  
    805                CALL histwrite( numptr, "zotematl", it, tn_jk_atl  , ndim_atl, ndex_atl ) 
    806                CALL histwrite( numptr, "zosalatl", it, sn_jk_atl  , ndim_atl, ndex_atl ) 
    807                CALL histwrite( numptr, "zotempac", it, tn_jk_pac  , ndim_pac, ndex_pac ) 
    808                CALL histwrite( numptr, "zosalpac", it, sn_jk_pac  , ndim_pac, ndex_pac ) 
    809                CALL histwrite( numptr, "zotemind", it, tn_jk_ind  , ndim_ind, ndex_ind ) 
    810                CALL histwrite( numptr, "zosalind", it, sn_jk_ind  , ndim_ind, ndex_ind ) 
    811                CALL histwrite( numptr, "zotemipc", it, tn_jk_ipc  , ndim_ipc, ndex_ipc ) 
    812                CALL histwrite( numptr, "zosalipc", it, sn_jk_ipc  , ndim_ipc, ndex_ipc ) 
     870               CALL histwrite( numptr, "zosrfatl", niter, surf_jk_atl, ndim_atl, ndex_atl ) 
     871               CALL histwrite( numptr, "zosrfpac", niter, surf_jk_pac, ndim_pac, ndex_pac ) 
     872               CALL histwrite( numptr, "zosrfind", niter, surf_jk_ind, ndim_ind, ndex_ind ) 
     873               CALL histwrite( numptr, "zosrfipc", niter, surf_jk_ipc, ndim_ipc, ndex_ipc ) 
     874 
     875               CALL histwrite( numptr, "zotematl", niter, tn_jk_atl  , ndim_atl, ndex_atl ) 
     876               CALL histwrite( numptr, "zosalatl", niter, sn_jk_atl  , ndim_atl, ndex_atl ) 
     877               CALL histwrite( numptr, "zotempac", niter, tn_jk_pac  , ndim_pac, ndex_pac ) 
     878               CALL histwrite( numptr, "zosalpac", niter, sn_jk_pac  , ndim_pac, ndex_pac ) 
     879               CALL histwrite( numptr, "zotemind", niter, tn_jk_ind  , ndim_ind, ndex_ind ) 
     880               CALL histwrite( numptr, "zosalind", niter, sn_jk_ind  , ndim_ind, ndex_ind ) 
     881               CALL histwrite( numptr, "zotemipc", niter, tn_jk_ipc  , ndim_ipc, ndex_ipc ) 
     882               CALL histwrite( numptr, "zosalipc", niter, sn_jk_ipc  , ndim_ipc, ndex_ipc ) 
    813883            END IF 
    814884         ENDIF 
    815885 
    816886         ! overturning outputs: 
    817          CALL histwrite( numptr, "zomsfglo", it, v_msf_glo, ndim, ndex ) 
     887         CALL histwrite( numptr, "zomsfglo", niter, v_msf_glo, ndim, ndex ) 
    818888         IF( ln_subbas .AND. ln_diaznl ) THEN 
    819             CALL histwrite( numptr, "zomsfatl", it, v_msf_atl , ndim_atl_30, ndex_atl_30 ) 
    820             CALL histwrite( numptr, "zomsfpac", it, v_msf_pac , ndim_pac_30, ndex_pac_30 ) 
    821             CALL histwrite( numptr, "zomsfind", it, v_msf_ind , ndim_ind_30, ndex_ind_30 ) 
    822             CALL histwrite( numptr, "zomsfipc", it, v_msf_ipc , ndim_ipc_30, ndex_ipc_30 ) 
     889            CALL histwrite( numptr, "zomsfatl", niter, v_msf_atl , ndim_atl_30, ndex_atl_30 ) 
     890            CALL histwrite( numptr, "zomsfpac", niter, v_msf_pac , ndim_pac_30, ndex_pac_30 ) 
     891            CALL histwrite( numptr, "zomsfind", niter, v_msf_ind , ndim_ind_30, ndex_ind_30 ) 
     892            CALL histwrite( numptr, "zomsfipc", niter, v_msf_ipc , ndim_ipc_30, ndex_ipc_30 ) 
    823893         ENDIF 
    824894#if defined key_diaeiv 
    825          CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, ndim  , ndex   ) 
    826 #endif 
    827  
     895         CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv_glo, ndim  , ndex   ) 
     896#endif 
     897 
     898 
     899         ! heat transport outputs: 
     900         IF( ln_subbas ) THEN 
     901            CALL histwrite( numptr, "sohtatl", niter, ht_atl  , ndim_h_atl_30, ndex_h_atl_30 ) 
     902            CALL histwrite( numptr, "sohtpac", niter, ht_pac  , ndim_h_pac_30, ndex_h_pac_30 ) 
     903            CALL histwrite( numptr, "sohtind", niter, ht_ind  , ndim_h_ind_30, ndex_h_ind_30 ) 
     904            CALL histwrite( numptr, "sohtipc", niter, ht_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
     905            CALL histwrite( numptr, "sostatl", niter, st_atl  , ndim_h_atl_30, ndex_h_atl_30 ) 
     906            CALL histwrite( numptr, "sostpac", niter, st_pac  , ndim_h_pac_30, ndex_h_pac_30 ) 
     907            CALL histwrite( numptr, "sostind", niter, st_ind  , ndim_h_ind_30, ndex_h_ind_30 ) 
     908            CALL histwrite( numptr, "sostipc", niter, st_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
     909         ENDIF 
     910 
     911         CALL histwrite( numptr, "sophtadv", niter, pht_adv     , ndim_h, ndex_h ) 
     912         CALL histwrite( numptr, "sophtldf", niter, pht_ldf     , ndim_h, ndex_h ) 
     913         CALL histwrite( numptr, "sopstadv", niter, pst_adv     , ndim_h, ndex_h ) 
     914         CALL histwrite( numptr, "sopstldf", niter, pst_ldf     , ndim_h, ndex_h ) 
     915         IF ( ln_ptrcomp ) THEN  
     916            CALL histwrite( numptr, "sopstove", niter, pst_ove_glo , ndim_h, ndex_h ) 
     917            CALL histwrite( numptr, "sophtove", niter, pht_ove_glo , ndim_h, ndex_h ) 
     918         ENDIF 
     919#if defined key_diaeiv 
     920         CALL histwrite( numptr, "sophteiv", niter, pht_eiv_glo  , ndim_h, ndex_h ) 
     921         CALL histwrite( numptr, "sopsteiv", niter, pst_eiv_glo  , ndim_h, ndex_h ) 
     922#endif 
     923         ! 
    828924      ENDIF 
    829  
    830       ! heat transport outputs: 
    831       IF( ln_subbas ) THEN 
    832          CALL histwrite( numptr, "sohtatl", it, ht_atl  , ndim_h_atl_30, ndex_h_atl_30 ) 
    833          CALL histwrite( numptr, "sohtpac", it, ht_pac  , ndim_h_pac_30, ndex_h_pac_30 ) 
    834          CALL histwrite( numptr, "sohtind", it, ht_ind  , ndim_h_ind_30, ndex_h_ind_30 ) 
    835          CALL histwrite( numptr, "sohtipc", it, ht_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
    836          CALL histwrite( numptr, "sostatl", it, st_atl  , ndim_h_atl_30, ndex_h_atl_30 ) 
    837          CALL histwrite( numptr, "sostpac", it, st_pac  , ndim_h_pac_30, ndex_h_pac_30 ) 
    838          CALL histwrite( numptr, "sostind", it, st_ind  , ndim_h_ind_30, ndex_h_ind_30 ) 
    839          CALL histwrite( numptr, "sostipc", it, st_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
    840       ENDIF 
    841  
    842       CALL histwrite( numptr, "sophtadv", it, pht_adv  , ndim_h, ndex_h ) 
    843       CALL histwrite( numptr, "sophtldf", it, pht_ldf  , ndim_h, ndex_h ) 
    844       CALL histwrite( numptr, "sophtove", it, pht_ove  , ndim_h, ndex_h ) 
    845       CALL histwrite( numptr, "sopstadv", it, pst_adv  , ndim_h, ndex_h ) 
    846       CALL histwrite( numptr, "sopstldf", it, pst_ldf  , ndim_h, ndex_h ) 
    847       CALL histwrite( numptr, "sopstove", it, pst_ove  , ndim_h, ndex_h ) 
    848 #if defined key_diaeiv 
    849       CALL histwrite( numptr, "sophteiv", it, pht_eiv  , ndim_h, ndex_h ) 
    850       CALL histwrite( numptr, "sopsteiv", it, pst_eiv  , ndim_h, ndex_h ) 
    851 #endif 
    852  
    853925      ! 
    854926   END SUBROUTINE dia_ptr_wri 
  • trunk/NEMO/OPA_SRC/lib_mpp.F90

    r1344 r1345  
    1717   !!             -   !  2008  (R. Benshila) add mpp_ini_ice 
    1818   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd 
     19   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl  
    1920   !!---------------------------------------------------------------------- 
    2021#if   defined key_mpp_mpi   
     
    2728   !!   mpp_lnk_e   : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 
    2829   !!   mpprecv     : 
    29    !!   mppsend     : 
     30   !!   mppsend     :   SUBROUTINE mpp_ini_znl 
    3031   !!   mppscatter  : 
    3132   !!   mppgather   : 
     
    7071   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    7172   PUBLIC   mpprecv, mppsend, mppscatter, mppgather 
    72    PUBLIC   mppobc, mpp_ini_ice, mpp_isl 
     73   PUBLIC   mppobc, mpp_ini_ice, mpp_isl, mpp_ini_znl 
    7374#if defined key_oasis3 || defined key_oasis4 
    7475   PUBLIC   mppsize, mpprank 
     
    119120!!gm question : Pourquoi toutes les variables ice sont public??? 
    120121   ! variables used in case of sea-ice 
    121    INTEGER, PUBLIC ::   ngrp_ice        !: group ID for the ice processors (for rheology) 
    122122   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice 
    123    INTEGER, PUBLIC ::   ndim_rank_ice   !: number of 'ice' processors 
    124    INTEGER, PUBLIC ::   n_ice_root      !: number (in the comm_ice) of proc 0 in the ice comm 
     123   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology) 
     124   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors 
     125   INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm 
    125126   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_ice     ! dimension ndim_rank_ice 
     127 
     128   ! variables used for zonal integration 
     129   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average 
     130   LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row 
     131   INTEGER ::   ngrp_znl        ! group ID for the znl processors 
     132   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average 
     133   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain 
    126134    
    127135   ! North fold condition in mpp_mpi with jpni > 1 
    128136   INTEGER ::   ngrp_world        ! group ID for the world processors 
     137   INTEGER ::   ngrp_opa          ! group ID for the opa processors 
    129138   INTEGER ::   ngrp_north        ! group ID for the northern processors (to be fold) 
    130139   INTEGER ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north 
     
    355364            t3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    356365         END DO 
    357       END SELECT 
     366      END SELECT   
    358367      ! 
    359368      !                           ! Migrations 
     
    12441253 
    12451254 
    1246    SUBROUTINE mppmin_int( ktab ) 
     1255   SUBROUTINE mppmin_int( ktab, kcom ) 
    12471256      !!---------------------------------------------------------------------- 
    12481257      !!                  ***  routine mppmin_int  *** 
     
    12521261      !!---------------------------------------------------------------------- 
    12531262      INTEGER, INTENT(inout) ::   ktab      ! ??? 
    1254       !! 
    1255       INTEGER ::  ierror, iwork 
    1256       !!---------------------------------------------------------------------- 
    1257       ! 
    1258       CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, mpi_comm_opa, ierror ) 
     1263      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array 
     1264      !! 
     1265      INTEGER ::  ierror, iwork, localcomm 
     1266      !!---------------------------------------------------------------------- 
     1267      ! 
     1268      localcomm = mpi_comm_opa 
     1269      IF( PRESENT(kcom) )   localcomm = kcom 
     1270      ! 
     1271     CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror ) 
    12591272      ! 
    12601273      ktab = iwork 
     
    19831996 
    19841997 
     1998   SUBROUTINE mpp_ini_znl 
     1999      !!---------------------------------------------------------------------- 
     2000      !!               ***  routine mpp_ini_znl  *** 
     2001      !! 
     2002      !! ** Purpose :   Initialize special communicator for computing zonal sum 
     2003      !! 
     2004      !! ** Method  : - Look for processors in the same row 
     2005      !!              - Put their number in nrank_znl 
     2006      !!              - Create group for the znl processors 
     2007      !!              - Create a communicator for znl processors 
     2008      !!              - Determine if processor should write znl files 
     2009      !! 
     2010      !! ** output 
     2011      !!      ndim_rank_znl = number of processors on the same row 
     2012      !!      ngrp_znl = group ID for the znl processors 
     2013      !!      ncomm_znl = communicator for the ice procs. 
     2014      !!      n_znl_root = number (in the world) of proc 0 in the ice comm. 
     2015      !! 
     2016      !!---------------------------------------------------------------------- 
     2017      INTEGER :: ierr 
     2018      INTEGER :: jproc 
     2019      INTEGER :: ii 
     2020      INTEGER, DIMENSION(jpnij) :: kwork 
     2021      ! 
     2022      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world 
     2023      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world 
     2024      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa 
     2025      ! 
     2026      IF ( jpnj == 1 ) THEN 
     2027         ngrp_znl  = ngrp_world 
     2028         ncomm_znl = mpi_comm_opa 
     2029      ELSE 
     2030         ! 
     2031         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_opa, ierr ) 
     2032         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork 
     2033         !-$$        CALL flush(numout) 
     2034         ! 
     2035         ! Count number of processors on the same row 
     2036         ndim_rank_znl = 0 
     2037         DO jproc=1,jpnij 
     2038            IF ( kwork(jproc) == njmpp ) THEN 
     2039               ndim_rank_znl = ndim_rank_znl + 1 
     2040            ENDIF 
     2041         END DO 
     2042         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl 
     2043         !-$$        CALL flush(numout) 
     2044         ! Allocate the right size to nrank_znl 
     2045#if ! defined key_agrif 
     2046         IF (ALLOCATED(nrank_znl)) DEALLOCATE(nrank_znl) 
     2047#else 
     2048         DEALLOCATE(nrank_znl) 
     2049#endif 
     2050         ALLOCATE(nrank_znl(ndim_rank_znl)) 
     2051         ii = 0      
     2052         nrank_znl (:) = 0 
     2053         DO jproc=1,jpnij 
     2054            IF ( kwork(jproc) == njmpp) THEN 
     2055               ii = ii + 1 
     2056               nrank_znl(ii) = jproc -1  
     2057            ENDIF 
     2058         END DO 
     2059         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl 
     2060         !-$$        CALL flush(numout) 
     2061 
     2062         ! Create the opa group 
     2063         CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_opa,ierr) 
     2064         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa 
     2065         !-$$        CALL flush(numout) 
     2066 
     2067         ! Create the znl group from the opa group 
     2068         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr ) 
     2069         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl 
     2070         !-$$        CALL flush(numout) 
     2071 
     2072         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row 
     2073         CALL MPI_COMM_CREATE ( mpi_comm_opa, ngrp_znl, ncomm_znl, ierr ) 
     2074         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl 
     2075         !-$$        CALL flush(numout) 
     2076         ! 
     2077      END IF 
     2078 
     2079      ! Determines if processor if the first (starting from i=1) on the row 
     2080      IF ( jpni == 1 ) THEN  
     2081         l_znl_root = .TRUE. 
     2082      ELSE 
     2083         l_znl_root = .FALSE. 
     2084         kwork (1) = nimpp 
     2085         CALL mpp_min ( kwork(1), kcom = ncomm_znl) 
     2086         IF ( nimpp == kwork(1)) l_znl_root = .TRUE. 
     2087      END IF 
     2088 
     2089   END SUBROUTINE mpp_ini_znl 
     2090 
     2091 
    19852092   SUBROUTINE mpp_ini_north 
    19862093      !!---------------------------------------------------------------------- 
     
    24932600   END SUBROUTINE mpp_ini_ice 
    24942601 
     2602   SUBROUTINE mpp_ini_znl 
     2603      INTEGER :: kcom 
     2604      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?' 
     2605   END SUBROUTINE mpp_ini_znl 
     2606 
    24952607   SUBROUTINE mpp_comm_free( kcom ) 
    24962608      INTEGER :: kcom 
Note: See TracChangeset for help on using the changeset viewer.