Changeset 1340


Ignore:
Timestamp:
2009-03-13T15:31:06+01:00 (12 years ago)
Author:
smasson
Message:

update diaptr, see ticket:361

Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/CONFIG/ORCA2_LIM/EXP00/namelist

    r1317 r1340  
    680680&namptr       !   Poleward Transport Diagnostic 
    681681!----------------------------------------------------------------------- 
    682    ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
    683    ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not  
     682   ln_diaptr  = .false.     !  Poleward heat and salt transport (T) or not (F) 
     683   ln_diaznl  = .false.     !  Add zonal means and meridional stream functions 
     684   ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not  
    684685                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    685    nf_ptr     =  15        !  Frequency of ptr computation [time step] 
    686 / 
     686   nf_ptr     =  1         !  Frequency of ptr computation [time step] 
     687   nf_ptr_wri =  15        !  Frequency of ptr outputs 
     688/ 
  • trunk/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist

    r1317 r1340  
    680680&namptr       !   Poleward Transport Diagnostic 
    681681!----------------------------------------------------------------------- 
    682    ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
    683    ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not  
     682   ln_diaptr  = .false.     !  Poleward heat and salt transport (T) or not (F) 
     683   ln_diaznl  = .false.     !  Add zonal means and meridional stream functions 
     684   ln_subbas  = .false.     !  Atlantic/Pacific/Indian basins computation (T) or not  
    684685                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    685    nf_ptr     =  15        !  Frequency of ptr computation [time step] 
    686 / 
     686   nf_ptr     =  1         !  Frequency of ptr computation [time step] 
     687   nf_ptr_wri =  15        !  Frequency of ptr outputs 
     688/ 
  • trunk/NEMO/OPA_SRC/DIA/diaptr.F90

    r1334 r1340  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  diaptr  *** 
    4    !! Ocean physics:  brief description of the purpose of the module 
    5    !!                 (please no more than 2 lines) 
     4   !! Ocean physics:  Computes meridonal transports and zonal means 
    65   !!===================================================================== 
    7    !! History :  9.0  !  03-09  (C. Talandir, G. Madec)  Original code 
     6   !! History :  9.0  !  03-09  (C. Talandier, G. Madec)  Original code 
    87   !!            9.0  !  06-01  (A. Biastoch)  Allow sub-basins computation 
    98   !!---------------------------------------------------------------------- 
     
    1413   !!   dia_ptr_wri  : Output of poleward fluxes 
    1514   !!   ptr_vjk      : "zonal" sum computation of a "meridional" flux array 
    16    !!   ptr_vtjk     : "zonal" mean computation of a tracer field 
     15   !!   ptr_tjk      : "zonal" mean computation of a tracer field 
    1716   !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional" 
    1817   !!                : flux array; Generic interface: ptr_vj_3d, ptr_vj_2d 
     
    2019   USE oce           ! ocean dynamics and active tracers 
    2120   USE dom_oce       ! ocean space and time domain 
    22    USE ldftra_oce    ! ??? 
     21   USE ldftra_oce    ! ocean active tracers: lateral physics 
    2322   USE lib_mpp 
    2423   USE in_out_manager 
     
    4140   PUBLIC   ptr_vjk        ! call by tra_ldf & tra_adv routines 
    4241 
    43    !!! ** init namelist (namptr) 
     42!!! ** init namelist (namptr) 
    4443   LOGICAL , PUBLIC                 ::   ln_diaptr = .FALSE.   !: Poleward transport flag (T) or not (F) 
    4544   LOGICAL , PUBLIC                 ::   ln_subbas = .FALSE.   !: Atlantic/Pacific/Indian basins calculation 
     45   LOGICAL , PUBLIC                 ::   ln_diaznl             !: Add zonal means and meridional stream functions 
    4646   INTEGER , PUBLIC                 ::   nf_ptr = 15           !: frequency of ptr computation 
     47   INTEGER , PUBLIC                 ::   nf_ptr_wri = 15       !: frequency of ptr outputs 
    4748 
    4849   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_adv, pst_adv      !: heat and salt poleward transport: advection 
     
    5253   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv, pst_eiv      !: heat and salt poleward transport: bolus advection 
    5354#endif 
    54    REAL(wp), PUBLIC, DIMENSION(jpj) ::   ht_atl,ht_ind,ht_pac  !: heat 
    55    REAL(wp), PUBLIC, DIMENSION(jpj) ::   st_atl,st_ind,st_pac  !: salt 
    56  
    57       
    58  
    59    REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk  , sn_jk  ,  &  !: "zonal" mean temperature and salinity 
    60       &                              v_msf_atl       ,  &  !: "meridional" Stream-Function 
     55   REAL(wp), PUBLIC, DIMENSION(jpj) ::   ht_glo,ht_atl,ht_ind,ht_pac,ht_ipc !: heat 
     56   REAL(wp), PUBLIC, DIMENSION(jpj) ::   st_glo,st_atl,st_ind,st_pac,st_ipc !: salt 
     57 
     58   INTEGER :: nidom_diaptr ! domain identifier for IOIPSL 
     59 
     60   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_glo, sn_jk_glo,  &  !: "zonal" mean temperature and salinity 
     61      &                              tn_jk_atl, sn_jk_atl,  & 
     62      &                              tn_jk_pac, sn_jk_pac,  & 
     63      &                              tn_jk_ind, sn_jk_ind,  & 
     64      &                              tn_jk_ipc, sn_jk_ipc,  & 
    6165      &                              v_msf_glo       ,  &  !: "meridional" Stream-Function 
    62       &                              v_msf_ipc       ,  &  !: "meridional" Stream-Function 
    63       &                              surf_jk_r             !: inverse of the ocean "zonal" section surface 
    64 #if defined key_diaeiv 
    65    REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv                  !: bolus "meridional" Stream-Function 
    66 #endif 
    67    REAL(wp), DIMENSION(jpi,jpj) ::   abasin, pbasin, ibasin     !: return function value 
     66      &                              v_msf_atl       ,  &   
     67      &                              v_msf_pac       ,  &   
     68      &                              v_msf_ind       ,  &   
     69      &                              v_msf_ipc       ,  &   
     70      &                              surf_jk_glo     ,  &  !: Ocean "zonal" section surface 
     71      &                              surf_jk_atl     ,  &   
     72      &                              surf_jk_pac     ,  &   
     73      &                              surf_jk_ind     ,  &          
     74      &                              surf_jk_ipc     ,  &  
     75      &                              surf_jk_r_glo   ,  &  !: inverse of the ocean "zonal" section surface 
     76      &                              surf_jk_r_atl   ,  &   
     77      &                              surf_jk_r_pac   ,  &   
     78      &                              surf_jk_r_ind   ,  &          
     79      &                              surf_jk_r_ipc        
     80#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 
    6884 
    6985   !! * Substitutions 
     
    144160 
    145161 
    146    FUNCTION ptr_vjk( pva )   RESULT ( p_fval ) 
     162   FUNCTION ptr_vjk( pva, bmask )   RESULT ( p_fval ) 
    147163      !!---------------------------------------------------------------------- 
    148164      !!                    ***  ROUTINE ptr_vjk  *** 
     
    156172      !!---------------------------------------------------------------------- 
    157173      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point 
     174      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: bmask ! Optional 2D basin mask 
    158175      !! 
    159176      INTEGER                      ::   ji, jj, jk   ! dummy loop arguments 
     
    166183      p_fval(:,:) = 0.e0 
    167184      ! 
    168       DO jk = 1, jpkm1 
    169          DO jj = 2, jpjm1 
    170            DO ji = fs_2, fs_jpim1 
    171             p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk)   & 
    172                &                                          * tmask_i(ji,jj+1) * tmask_i(ji,jj) 
    173            END DO 
    174          END DO 
    175       END DO 
     185      IF (PRESENT (bmask)) THEN  
     186         DO jk = 1, jpkm1 
     187            DO jj = 2, jpjm1 
     188               DO ji = fs_2, fs_jpim1 
     189                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk)   & 
     190                     &                                          * tmask_i(ji,jj+1) * tmask_i(ji,jj) & 
     191                     &                                          * bmask(ji,jj) 
     192               END DO 
     193            END DO 
     194         END DO 
     195      ELSE  
     196         DO jk = 1, jpkm1 
     197            DO jj = 2, jpjm1 
     198               DO ji = fs_2, fs_jpim1 
     199                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk)   & 
     200                     &                                          * tmask_i(ji,jj+1) * tmask_i(ji,jj) 
     201               END DO 
     202            END DO 
     203         END DO 
     204      END IF 
    176205      ! 
    177206      IF(lk_mpp) THEN 
     
    184213   END FUNCTION ptr_vjk 
    185214 
    186  
    187    FUNCTION ptr_vtjk( pva )   RESULT ( p_fval ) 
    188       !!---------------------------------------------------------------------- 
    189       !!                    ***  ROUTINE ptr_vtjk  *** 
     215   FUNCTION ptr_tjk( pta, bmask )   RESULT ( p_fval ) 
     216      !!---------------------------------------------------------------------- 
     217      !!                    ***  ROUTINE ptr_tjk  *** 
    190218      !! 
    191219      !! ** Purpose :   "zonal" mean computation of a tracer field 
    192220      !! 
    193       !! ** Method  : - i-sum of mj(pva) using the interior 2D vmask (vmask_i) 
     221      !! ** Method  : - i-sum of mj(pta) using tmask 
    194222      !!      multiplied by the inverse of the surface of the "zonal" ocean 
    195223      !!      section 
    196224      !! 
    197       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    198       !!---------------------------------------------------------------------- 
    199       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point 
     225      !! ** Action  : - p_fval: i-k-mean poleward flux of pta 
     226      !!---------------------------------------------------------------------- 
     227      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point 
     228      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: bmask ! Optional 2D basin mask 
    200229      !! 
    201230      INTEGER                     ::   ji, jj, jk   ! dummy loop arguments 
     
    207236      ! 
    208237      p_fval(:,:) = 0.e0 
    209       DO jk = 1, jpkm1 
    210          DO jj = 2, jpjm1 
    211             DO ji = fs_2, fs_jpim1   ! Vector opt. 
    212                p_fval(jj,jk) = p_fval(jj,jk) + ( pva(ji,jj,jk) + pva(ji,jj+1,jk) )              & 
    213                   &                          * e1v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk)   & 
    214                   &                          * tmask_i(ji,jj+1) * tmask_i(ji,jj) 
    215             END DO 
    216          END DO 
    217       END DO 
     238      IF (PRESENT (bmask)) THEN  
     239         DO jk = 1, jpkm1 
     240            DO jj = 2, jpjm1 
     241               DO ji = fs_2, fs_jpim1   ! Vector opt. 
     242                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk)                  & 
     243                     &                          * e1t(ji,jj) * fse3t(ji,jj,jk)   & 
     244                     &                          * tmask_i(ji,jj)                 & 
     245                     &                          * bmask(ji,jj) 
     246               END DO 
     247            END DO 
     248         END DO 
     249      ELSE  
     250         DO jk = 1, jpkm1 
     251            DO jj = 2, jpjm1 
     252               DO ji = fs_2, fs_jpim1   ! Vector opt. 
     253                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk)                  & 
     254                     &                          * e1t(ji,jj) * fse3t(ji,jj,jk)   & 
     255                     &                          * tmask_i(ji,jj) 
     256               END DO 
     257            END DO 
     258         END DO 
     259      END IF 
    218260      p_fval(:,:) = p_fval(:,:) * 0.5 
    219261      IF(lk_mpp) THEN 
     
    224266      END IF 
    225267      ! 
    226    END FUNCTION ptr_vtjk 
     268   END FUNCTION ptr_tjk 
    227269 
    228270 
     
    237279         &          zpwatt,     &              ! conversion from W    to PW 
    238280         &          zggram                     ! conversion from g    to Pg 
    239  
    240       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  & 
    241          v_atl , v_ipc,                    & 
    242          vt_atl, vt_pac, vt_ind,           & 
    243          vs_atl, vs_pac, vs_ind              
    244       INTEGER ::  inum       ! temporary logical unit 
    245       !!---------------------------------------------------------------------- 
    246  
    247       IF( kt == nit000 .OR. MOD( kt - nit000 + 1, nf_ptr ) == 0 )   THEN 
     281      REAL(wp), DIMENSION(jpi,jpj,jpk) :: vt, vs 
     282      !!---------------------------------------------------------------------- 
     283 
     284      IF( kt == nit000 .OR. MOD( kt, nf_ptr ) == 0 )   THEN 
    248285 
    249286         zsverdrup = 1.e-6 
    250287         zpwatt    = 1.e-15 
    251288         zggram    = 1.e-6 
    252     
    253          ! "zonal" mean temperature and salinity at V-points 
    254          tn_jk(:,:) = ptr_vtjk( tn(:,:,:) ) * surf_jk_r(:,:) 
    255          sn_jk(:,:) = ptr_vtjk( sn(:,:,:) ) * surf_jk_r(:,:) 
    256  
     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          
    257307         !-------------------------------------------------------- 
    258308         ! overturning calculation: 
    259   
    260          IF( ln_subbas ) THEN              ! Basins computation 
    261  
    262             IF( kt == nit000 ) THEN                ! load sub-basin mask 
    263                CALL iom_open( 'subbasins', inum ) 
    264                CALL iom_get( inum, jpdom_data, 'atlmsk', abasin )      ! Atlantic basin 
    265                CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin )      ! Pacific basin 
    266                CALL iom_get( inum, jpdom_data, 'indmsk', ibasin )      ! Indian basin 
    267                CALL iom_close( inum ) 
    268             ENDIF 
    269  
    270             ! basin separation: 
    271             DO jj = 1, jpj 
    272                DO ji = 1, jpi 
    273                   ! basin separated velocity 
    274                   v_atl(ji,jj,:) = vn(ji,jj,:)*abasin(ji,jj) 
    275                   v_ipc(ji,jj,:) = vn(ji,jj,:)*(pbasin(ji,jj)+ibasin(ji,jj)) 
    276  
    277                   ! basin separated T times V on T points 
    278                   vt_ind(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
    279                   vt_atl(ji,jj,:) = vt_ind(ji,jj,:) * abasin(ji,jj) 
    280                   vt_pac(ji,jj,:) = vt_ind(ji,jj,:) * pbasin(ji,jj) 
    281                   vt_ind(ji,jj,:) = vt_ind(ji,jj,:) * ibasin(ji,jj) 
    282  
    283                   ! basin separated S times V on T points 
    284                   vs_ind(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 
    285                   vs_atl(ji,jj,:) = vs_ind(ji,jj,:) * abasin(ji,jj) 
    286                   vs_pac(ji,jj,:) = vs_ind(ji,jj,:) * pbasin(ji,jj) 
    287                   vs_ind(ji,jj,:) = vs_ind(ji,jj,:) * ibasin(ji,jj) 
    288                END DO 
    289             END DO 
    290  
    291          ENDIF 
    292  
     309          
    293310         ! 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 
     320#else 
    294321         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          
    295330#if defined key_diaeiv 
    296331         v_msf_eiv(:,:) = ptr_vjk( v_eiv(:,:,:) )  
    297332#endif 
    298          IF( ln_subbas ) THEN 
    299             v_msf_atl(:,:) = ptr_vjk( v_atl (:,:,:) )  
    300             v_msf_ipc(:,:) = ptr_vjk( v_ipc (:,:,:) )  
    301             ht_atl(:) = SUM( ptr_vjk( vt_atl(:,:,:)), 2 ) 
    302             ht_pac(:) = SUM( ptr_vjk( vt_pac(:,:,:)), 2 ) 
    303             ht_ind(:) = SUM( ptr_vjk( vt_ind(:,:,:)), 2 ) 
    304             st_atl(:) = SUM( ptr_vjk( vs_atl(:,:,:)), 2 ) 
    305             st_pac(:) = SUM( ptr_vjk( vs_pac(:,:,:)), 2 ) 
    306             st_ind(:) = SUM( ptr_vjk( vs_ind(:,:,:)), 2 ) 
    307          ENDIF 
    308  
     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 
     348            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) 
     353            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) 
     362#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 
     367            END DO 
     368         END DO 
     369#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 
     374            END DO 
     375         END DO 
     376#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          
    309392         ! poleward tracer transports:  
    310393         ! overturning components: 
    311          pht_ove(:) = SUM( v_msf_glo(:,:) * tn_jk(:,:), 2 )   ! SUM over jk 
    312          pst_ove(:) = SUM( v_msf_glo(:,:) * sn_jk(:,:), 2 )   ! SUM over jk 
    313 #if defined key_diaeiv 
    314          pht_eiv(:) = SUM( v_msf_eiv(:,:) * tn_jk(:,:), 2 )   ! SUM over jk 
    315          pst_eiv(:) = SUM( v_msf_eiv(:,:) * sn_jk(:,:), 2 )   ! SUM over jk 
    316 #endif 
    317        
     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 
    318401         ! conversion in PW and G g 
    319402         zpwatt = zpwatt * rau0 * rcp 
     
    332415            ht_pac(:) = ht_pac(:) * zpwatt 
    333416            ht_ind(:) = ht_ind(:) * zpwatt 
     417            ht_ipc(:) = ht_ipc(:) * zpwatt 
    334418            st_atl(:) = st_atl(:) * zggram  
    335419            st_pac(:) = st_pac(:) * zggram 
    336420            st_ind(:) = st_ind(:) * zggram 
    337          ENDIF 
    338  
    339          ! "Meridional" Stream-Function 
    340          DO jk = 2,jpk  
    341             v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 
    342          END DO 
    343          v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 
    344  
    345 #if defined key_diaeiv 
    346          ! Bolus "Meridional" Stream-Function 
    347          DO jk = 2,jpk  
    348             v_msf_eiv(:,jk) = v_msf_eiv(:,jk-1) + v_msf_eiv(:,jk) 
    349          END DO 
    350          v_msf_eiv(:,:) = v_msf_eiv(:,:) * zsverdrup 
    351 #endif 
    352  
    353          IF( ln_subbas ) THEN 
    354             DO jk = 2,jpk  
    355                v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 
    356                v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 
    357             END DO 
    358             v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 
    359             v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 
     421            st_ipc(:) = st_ipc(:) * zggram 
    360422         ENDIF 
    361423 
     
    377439      !! ** Purpose :   Initialization, namelist read 
    378440      !!---------------------------------------------------------------------- 
    379       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z_1         ! temporary workspace 
    380  
    381       NAMELIST/namptr/ ln_diaptr, ln_subbas, nf_ptr 
     441      NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, nf_ptr, nf_ptr_wri 
     442      INTEGER ::  inum       ! temporary logical unit 
     443      INTEGER, DIMENSION (1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
    382444      !!---------------------------------------------------------------------- 
    383445 
     
    395457         WRITE(numout,*) '             Atla/Paci/Ind basins computation         ln_subbas = ', ln_subbas 
    396458         WRITE(numout,*) '             Frequency of computation                    nf_ptr = ', nf_ptr 
     459         WRITE(numout,*) '             Frequency of outputs                    nf_ptr_wri = ', nf_ptr_wri 
    397460      ENDIF 
    398461 
     462      IF( ln_subbas ) THEN                ! load sub-basin mask 
     463         CALL iom_open( 'subbasins', inum ) 
     464         CALL iom_get( inum, jpdom_data, 'atlmsk', abasin )      ! Atlantic basin 
     465         CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin )      ! Pacific basin 
     466         CALL iom_get( inum, jpdom_data, 'indmsk', ibasin )      ! Indian basin 
     467         CALL iom_close( inum ) 
     468         dbasin(:,:) = MAX ( pbasin(:,:), ibasin(:,:) ) 
     469         sbasin(:,:) = tmask (:,:,1) 
     470         WHERE ( gphit (:,:) < -30.e0) sbasin(:,:) = 0.e0 
     471      ENDIF 
     472       
    399473      ! inverse of the ocean "zonal" v-point section 
    400       z_1(:,:,:) = 1.e0 
    401       surf_jk_r(:,:) = ptr_vtjk( z_1(:,:,:) ) 
    402       WHERE( surf_jk_r(:,:) /= 0.e0 )   surf_jk_r(:,:) = 1.e0 / surf_jk_r(:,:) 
    403  
     474      surf_jk_glo(:,:) = ptr_tjk( tmask(:,:,:) ) 
     475      surf_jk_r_glo(:,:) = 0.e0 
     476      WHERE( surf_jk_glo(:,:) /= 0.e0 )   surf_jk_r_glo(:,:) = 1.e0 / surf_jk_glo(:,:) 
     477       
     478      IF (ln_subbas) THEN 
     479         surf_jk_atl(:,:) = ptr_tjk( tmask (:,:,:), abasin(:,:) ) 
     480         surf_jk_r_atl(:,:) = 0.e0 
     481         WHERE( surf_jk_atl(:,:) /= 0.e0 )   surf_jk_r_atl(:,:) = 1.e0 / surf_jk_atl(:,:) 
     482         ! 
     483         surf_jk_pac(:,:) = ptr_tjk( tmask (:,:,:), pbasin(:,:) ) 
     484         surf_jk_r_pac(:,:) = 0.e0 
     485         WHERE( surf_jk_pac(:,:) /= 0.e0 )   surf_jk_r_pac(:,:) = 1.e0 / surf_jk_pac(:,:) 
     486         !  
     487         surf_jk_ind(:,:) = ptr_tjk( tmask (:,:,:), ibasin(:,:) ) 
     488         surf_jk_r_ind(:,:) = 0.e0 
     489         WHERE( surf_jk_ind(:,:) /= 0.e0 )   surf_jk_r_ind(:,:) = 1.e0 / surf_jk_ind(:,:) 
     490         ! 
     491         surf_jk_ipc(:,:) = ptr_tjk( tmask (:,:,:), dbasin(:,:) ) 
     492         surf_jk_r_ipc(:,:) = 0.e0 
     493         WHERE( surf_jk_ipc(:,:) /= 0.e0 )   surf_jk_r_ipc(:,:) = 1.e0 / surf_jk_ipc(:,:) 
     494      END IF 
     495 
     496       
     497      !!---------------------------------------------------------------------- 
     498 
     499      iglo (1) = jpjglo 
     500      iloc (1) = nlcj 
     501      iabsf(1) = njmppt(narea) 
     502      iabsl(:) = iabsf(:) + iloc(:) - 1 
     503      ihals(1) = nldj - 1 
     504      ihale(1) = nlcj - nlej 
     505      idid (1) = 2 
     506 
     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) 
     516       
    404517   END SUBROUTINE dia_ptr_init 
    405518 
     
    415528      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    416529      !! 
    417       INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw, ndex(1) 
    418  
    419       CHARACTER (len=40)       ::   clhstnam, clop                   ! temporary names 
    420       INTEGER                  ::   iline, it, ji, itmod             ! 
     530      INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw 
     531      INTEGER, SAVE :: ndim  , ndim_atl     , ndim_pac     , ndim_ind     , ndim_ipc 
     532      INTEGER, SAVE ::         ndim_atl_30  , ndim_pac_30  , ndim_ind_30  , ndim_ipc_30 
     533      INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 
     534      INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex  , ndex_atl     , ndex_pac     , ndex_ind     , ndex_ipc 
     535      INTEGER, SAVE, DIMENSION (jpj*jpk) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30 
     536      INTEGER, SAVE, DIMENSION (jpj)     :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 
     537 
     538      CHARACTER (len=40)       ::   clhstnam, clop, clop_once, cl_comment   ! temporary names 
     539      INTEGER                  ::   iline, it, itmod, ji, jj, jk      ! 
    421540      REAL(wp)                 ::   zsto, zout, zdt, zjulian   ! temporary scalars 
    422541      REAL(wp), DIMENSION(jpj) ::   zphi, zfoo 
    423       !!---------------------------------------------------------------------- 
    424        
     542      REAL(wp), DIMENSION(jpj,jpk) :: z_1 
     543      !!---------------------------------------------------------------------- 
     544 
    425545      ! define time axis 
    426       it = kt 
     546      it    = kt 
    427547      itmod = kt - nit000 + 1 
    428548 
     
    430550      ! -------------- 
    431551      IF( kt == nit000 ) THEN 
    432           
     552 
    433553         zdt = rdt 
    434554         IF( nacc == 1 ) zdt = rdtmin 
     
    444564            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole 
    445565            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole 
    446             zphi(:) = 0.e0 
     566            zphi(:) = -9999.9999e0 
    447567            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) 
    448571               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain 
    449                ! correct highest latitude for ORCA05 
    450                IF( jp_cfg == 05  ) zphi(jpj) = zphi(jpjm1) + (zphi(jpjm1)-zphi(jpj-2))/2. 
    451                IF( jp_cfg == 05  ) zphi(jpj) = MIN( zphi(jpj), 90.) 
    452  
     572               ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 
     573               IF( jp_cfg == 05 ) THEN 
     574                  DO jj = mj0(jpjdta), mj1(jpjdta)  
     575                     zphi( jj ) = zphi(jpjdta-1) + (zphi(jpjdta-1)-zphi(jpjdta-2))/2. 
     576                     zphi( jj ) = MIN( zphi(jj), 90.) 
     577                  END DO 
     578               END IF 
     579               IF( jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 
     580                  DO jj = mj0(jpjdta-1), mj1(jpjdta-1)  
     581                     zphi( jj ) = 88.5e0 
     582                  END DO 
     583                  DO jj = mj0(jpjdta  ), mj1(jpjdta  )  
     584                     zphi( jj ) = 89.5e0 
     585                  END DO 
     586               END IF 
    453587            END DO 
    454588            ! 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 
    455593            IF( lk_mpp )   CALL mpp_sum( zphi, jpj )         
    456594 
    457595            !                                        ! ======================= 
    458          ELSE                                        !   OTHER configurations 
     596         ELSE                                        !   OTHER configurations  zjulian = zjulian - adatrj  
     597                                                     !   set calendar origin to the beginning of the experiment 
    459598            !                                        ! ======================= 
    460599            zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line 
    461600            ! 
    462601         ENDIF 
     602         DO jj = 1, jpj 
     603            WRITE(numout,*) 'diaptr(2) ', nproc, jj, mjg(jj), zphi(jj), '--' 
     604            CALL flush (numout) 
     605         ENDDO 
    463606 
    464607         ! OPEN netcdf file  
     
    466609         ! Define frequency of output and means 
    467610         zsto = nf_ptr * zdt 
    468          IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!) 
    469          ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time) 
    470          ENDIF 
    471          zout = 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 
    472620         zfoo(:) = 0.e0 
    473621 
     
    477625         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    478626 
    479          CALL dia_nam( clhstnam, nf_ptr, 'diaptr' ) 
     627         CALL dia_nam( clhstnam, nf_ptr_wri, 'diaptr' ) 
    480628         IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file ",clhstnam 
    481629 
    482630         ! Horizontal grid : zphi() 
    483631         CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   & 
    484             1, 1, 1, jpj, nit000-1, zjulian, zdt, nhoridz, numptr, domain_id=nidom ) 
     632            1, 1, 1, jpj, nit000-1, zjulian, zdt, nhoridz, numptr, domain_id=nidom_diaptr ) 
    485633         ! Vertical grids : gdept_0, gdepw_0 
    486634         CALL histvert( numptr, "deptht", "Vertical T levels",   & 
     
    488636         CALL histvert( numptr, "depthw", "Vertical W levels",   & 
    489637            "m", jpk, gdepw_0, ndepidzw, "down" ) 
    490           
     638 
     639         ! 
     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)' 
     671#else 
     672         cl_comment = ' ' 
     673#endif 
    491674         !  Zonal mean T and S 
    492           
    493          CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   & 
    494             1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    495          CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   & 
    496             1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    497  
    498          !  Meridional Stream-Function (eulerian and bolus) 
    499           
    500          CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global","Sv" ,   & 
     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 ) 
     684 
     685            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" ,   & 
    501720            1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    502          IF( ln_subbas ) THEN 
    503             CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic","Sv" ,   & 
     721         IF( ln_subbas .AND. ln_diaznl ) THEN 
     722            CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" ,   & 
    504723               1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    505             CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific","Sv" ,& 
     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" ,& 
    506729               1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    507730         ENDIF 
     
    516739            "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    517740         IF( ln_subbas ) THEN 
    518             CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"      ,  & 
     741            CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment),  & 
    519742               "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    520             CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"      ,   & 
     743            CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) ,  & 
    521744               "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    522             CALL histdef( numptr, "sohtind", "Heat Transport Indic"      ,     & 
     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), & 
    523748               "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    524749         ENDIF 
     
    544769#endif 
    545770         IF( ln_subbas ) THEN 
    546             CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"      ,    & 
     771            CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment)      ,  & 
    547772               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    548             CALL histdef( numptr, "sostpac", "Salt Transport Pacific"      ,     & 
     773            CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment)      ,   & 
    549774               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    550             CALL histdef( numptr, "sostind", "Salt Transport Indic"      ,       & 
     775            CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment)      ,    & 
    551776               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    552          ENDIF 
    553           
     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 
    554781         CALL histend( numptr ) 
    555782 
     
    560787         IF(lwp) THEN 
    561788            WRITE(numout,*) 
    562             WRITE(numout,*) 'dia_ptr : write Poleward Transports at time-step : ', kt 
     789            WRITE(numout,*) 'dia_ptr : compute Poleward Transports at time-step : ', kt 
    563790            WRITE(numout,*) '~~~~~~~~' 
    564791            WRITE(numout,*) 
    565792         ENDIF 
    566793 
    567          ndex(1) = 0 
    568          CALL histwrite( numptr, "zotemglo", it, tn_jk    , jpj*jpk, ndex ) 
    569          CALL histwrite( numptr, "zosalglo", it, sn_jk    , jpj*jpk, ndex ) 
     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 ) 
     813            END IF 
     814         ENDIF 
     815 
    570816         ! overturning outputs: 
    571          CALL histwrite( numptr, "zomsfglo", it, v_msf_glo , jpj*jpk, ndex ) 
    572          IF( ln_subbas ) THEN 
    573             CALL histwrite( numptr, "zomsfatl", it, v_msf_atl , jpj*jpk, ndex ) 
    574             CALL histwrite( numptr, "zomsfipc", it, v_msf_ipc , jpj*jpk, ndex ) 
    575          ENDIF 
    576          ! heat transport outputs: 
    577          IF( ln_subbas ) THEN 
    578             CALL histwrite( numptr, "sohtatl", it, ht_atl  , jpj, ndex ) 
    579             CALL histwrite( numptr, "sohtpac", it, ht_pac  , jpj, ndex ) 
    580             CALL histwrite( numptr, "sohtind", it, ht_ind  , jpj, ndex ) 
    581             CALL histwrite( numptr, "sostatl", it, st_atl  , jpj, ndex ) 
    582             CALL histwrite( numptr, "sostpac", it, st_pac  , jpj, ndex ) 
    583             CALL histwrite( numptr, "sostind", it, st_ind  , jpj, ndex ) 
    584          ENDIF 
    585  
    586          CALL histwrite( numptr, "sophtadv", it, pht_adv  , jpj, ndex ) 
    587          CALL histwrite( numptr, "sophtldf", it, pht_ldf  , jpj, ndex ) 
    588          CALL histwrite( numptr, "sophtove", it, pht_ove  , jpj, ndex ) 
    589          CALL histwrite( numptr, "sopstadv", it, pst_adv  , jpj, ndex ) 
    590          CALL histwrite( numptr, "sopstldf", it, pst_ldf  , jpj, ndex ) 
    591          CALL histwrite( numptr, "sopstove", it, pst_ove  , jpj, ndex ) 
    592 #if defined key_diaeiv 
    593          CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, jpj*jpk, ndex ) 
    594          CALL histwrite( numptr, "sophteiv", it, pht_eiv  , jpj    , ndex ) 
    595          CALL histwrite( numptr, "sopsteiv", it, pst_eiv  , jpj    , ndex ) 
    596 #endif 
    597   
     817         CALL histwrite( numptr, "zomsfglo", it, v_msf_glo, ndim, ndex ) 
     818         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 ) 
     823         ENDIF 
     824#if defined key_diaeiv 
     825         CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, ndim  , ndex   ) 
     826#endif 
     827 
    598828      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 
    599853      ! 
    600854   END SUBROUTINE dia_ptr_wri 
Note: See TracChangeset for help on using the changeset viewer.