New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5023 – NEMO

Changeset 5023


Ignore:
Timestamp:
2015-01-09T15:40:20+01:00 (9 years ago)
Author:
cetlod
Message:

branch 2015/dev_r5020_CNRS_DIAPTR : Poleward TRansports diagnostics using XIOS, see ticket #1435

Location:
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM
Files:
33 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

    r4839 r5023  
    391391/ 
    392392!----------------------------------------------------------------------- 
    393 &namptr       !   Poleward Transport Diagnostic 
    394 !----------------------------------------------------------------------- 
    395    ln_diaznl  = .false.    !  Add zonal means and meridional stream functions 
    396    ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not 
    397                            !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    398    ln_ptrcomp = .false.    !  Add decomposition : overturning 
    399 / 
    400 !----------------------------------------------------------------------- 
    401393&namhsb       !  Heat and salt budgets 
    402394!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg

    r4667 r5023  
    330330/ 
    331331!----------------------------------------------------------------------- 
    332 &namptr       !   Poleward Transport Diagnostic 
    333 !----------------------------------------------------------------------- 
    334 / 
    335 !----------------------------------------------------------------------- 
    336332&namhsb       !  Heat and salt budgets 
    337333!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg

    r4990 r5023  
    350350/ 
    351351!----------------------------------------------------------------------- 
    352 &namptr       !   Poleward Transport Diagnostic 
    353 !----------------------------------------------------------------------- 
    354 / 
    355 !----------------------------------------------------------------------- 
    356352&namhsb       !  Heat and salt budgets 
    357353!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

    r4990 r5023  
    332332/ 
    333333!----------------------------------------------------------------------- 
    334 &namptr       !   Poleward Transport Diagnostic 
    335 !----------------------------------------------------------------------- 
    336 / 
    337 !----------------------------------------------------------------------- 
    338334&namhsb       !  Heat and salt budgets 
    339335!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg

    r4990 r5023  
    206206/ 
    207207!----------------------------------------------------------------------- 
    208 &namptr       !   Poleward Transport Diagnostic 
    209 !----------------------------------------------------------------------- 
    210 / 
    211 !----------------------------------------------------------------------- 
    212208&namhsb       !  Heat and salt budgets 
    213209!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg

    r4373 r5023  
    304304/ 
    305305!----------------------------------------------------------------------- 
    306 &namptr       !   Poleward Transport Diagnostic 
    307 !----------------------------------------------------------------------- 
    308 / 
    309 !----------------------------------------------------------------------- 
    310306&namhsb       !  Heat and salt budgets 
    311307!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ISOMIP/EXP00/namelist_cfg

    r4924 r5023  
    598598!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld") 
    599599!!   namflo       float parameters                                      ("key_float") 
    600 !!   namptr       Poleward Transport Diagnostics 
    601600!!   namhsb       Heat and salt budgets 
    602601!!====================================================================== 
    … …  
    623622/ 
    624623!----------------------------------------------------------------------- 
    625 &namptr       !   Poleward Transport Diagnostic 
    626 !----------------------------------------------------------------------- 
    627 / 
    628 !----------------------------------------------------------------------- 
    629624&namhsb       !  Heat and salt budgets 
    630625!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg

    r4990 r5023  
    177177/ 
    178178!----------------------------------------------------------------------- 
    179 &namptr       !   Poleward Transport Diagnostic 
    180 !----------------------------------------------------------------------- 
    181 / 
    182 !----------------------------------------------------------------------- 
    183179&namhsb       !  Heat and salt budgets 
    184180!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg

    r4995 r5023  
    180180/ 
    181181!----------------------------------------------------------------------- 
    182 &namptr       !   Poleward Transport Diagnostic 
    183 !----------------------------------------------------------------------- 
    184 / 
    185 !----------------------------------------------------------------------- 
    186182&namhsb       !  Heat and salt budgets 
    187183!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg

    r4370 r5023  
    264264/ 
    265265!----------------------------------------------------------------------- 
    266 &namptr       !   Poleward Transport Diagnostic 
    267 !----------------------------------------------------------------------- 
    268 / 
    269 !----------------------------------------------------------------------- 
    270266&namhsb       !  Heat and salt budgets  
    271267!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg

    r4370 r5023  
    177177/ 
    178178!----------------------------------------------------------------------- 
    179 &namptr       !   Poleward Transport Diagnostic 
    180 !----------------------------------------------------------------------- 
    181 / 
    182 !----------------------------------------------------------------------- 
    183179&namhsb       !  Heat and salt budgets 
    184180!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/SHARED/domain_def.xml

    r4690 r5023  
    66         <domain id="myzoom" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="5" zoom_nj="5" /> 
    77         <domain id="1point" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="1" zoom_nj="1" /> 
     8         <domain id="ptr" zoom_ibegin="0000"  zoom_jbegin="1" zoom_ni="1" zoom_nj="0000" /> 
    89         <!--   Eq section   --> 
    910         <domain id="EqT" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" /> 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/SHARED/field_def.xml

    r4996 r5023  
    511511      </field_group> 
    512512 
     513      <!-- Poleward transport : ptr -->      
     514      <field_group id="diaptr" domain_ref="ptr"  >  
     515        <field id="zomsfglo"          long_name="Meridional Stream-Function: Global"           unit="Sv"       grid_ref="grid_W_3D"  /> 
     516        <field id="zomsfatl"          long_name="Meridional Stream-Function: Atlantic"         unit="Sv"       grid_ref="grid_W_3D"  /> 
     517        <field id="zomsfpac"          long_name="Meridional Stream-Function: Pacific"          unit="Sv"       grid_ref="grid_W_3D"  /> 
     518        <field id="zomsfind"          long_name="Meridional Stream-Function: Indian"           unit="Sv"       grid_ref="grid_W_3D"  /> 
     519        <field id="zomsfipc"          long_name="Meridional Stream-Function: Pacific+Indian"   unit="Sv"       grid_ref="grid_W_3D"   /> 
     520        <field id="zotemglo"          long_name="Zonal Mean Temperature : Global"              unit="C"        grid_ref="grid_T_3D" /> 
     521        <field id="zotematl"          long_name="Zonal Mean Temperature : Atlantic"            unit="C"        grid_ref="grid_T_3D" /> 
     522        <field id="zotempac"          long_name="Zonal Mean Temperature : Pacific"             unit="C"        grid_ref="grid_T_3D" /> 
     523        <field id="zotemind"          long_name="Zonal Mean Temperature : Indian"              unit="C"        grid_ref="grid_T_3D" /> 
     524        <field id="zotemipc"          long_name="Zonal Mean Temperature : Pacific+Indian"      unit="C"        grid_ref="grid_T_3D" /> 
     525        <field id="zosalglo"          long_name="Zonal Mean Salinity : Global"                 unit="PSU"      grid_ref="grid_T_3D"   /> 
     526        <field id="zosalatl"          long_name="Zonal Mean Salinity : Atlantic"               unit="PSU"      grid_ref="grid_T_3D"   /> 
     527        <field id="zosalpac"          long_name="Zonal Mean Salinity : Pacific"                unit="PSU"      grid_ref="grid_T_3D"   /> 
     528        <field id="zosalind"          long_name="Zonal Mean Salinity : Indian"                 unit="PSU"      grid_ref="grid_T_3D"   /> 
     529        <field id="zosalipc"          long_name="Zonal Mean Salinity : Pacific+Indian"         unit="PSU"      grid_ref="grid_T_3D"   /> 
     530        <field id="zosrfglo"          long_name="Zonal Mean Surface"                           unit="m2"       grid_ref="grid_T_3D"  /> 
     531        <field id="zosrfatl"          long_name="Zonal Mean Surface : Atlantic"                unit="m2"       grid_ref="grid_T_3D"  /> 
     532        <field id="zosrfpac"          long_name="Zonal Mean Surface : Pacific"                 unit="m2"       grid_ref="grid_T_3D"  /> 
     533        <field id="zosrfind"          long_name="Zonal Mean Surface : Indian"                  unit="m2"       grid_ref="grid_T_3D"  /> 
     534        <field id="zosrfipc"          long_name="Zonal Mean Surface : Pacific+Indian"          unit="m2"       grid_ref="grid_T_3D"  /> 
     535        <field id="sophtadv"          long_name="Advective Heat Transport"                     unit="PW"       grid_ref="grid_T_2D" /> 
     536        <field id="sophtldf"          long_name="Diffusive Heat Transport"                     unit="PW"       grid_ref="grid_T_2D" /> 
     537        <field id="sopstadv"          long_name="Advective Salt Transport"                     unit="Giga g/s" grid_ref="grid_T_2D" /> 
     538        <field id="sopstldf"          long_name="Diffusive Salt Transport"                     unit="Giga g/s" grid_ref="grid_T_2D" /> 
     539      </field_group> 
     540 
     541 
    513542      <!-- ptrc on T grid --> 
    514543 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/SHARED/namelist_ref

    r4990 r5023  
    1010!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) 
    1111!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx) 
    12 !!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb) 
     12!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb) 
    1313!!             10 - miscellaneous    (namsol, nammpp, namctl) 
    1414!!             11 - Obs & Assim      (namobs, nam_asminc) 
    … …  
    10721072!!   namtrd       dynamics and/or tracer trends 
    10731073!!   namflo       float parameters                                      ("key_float") 
    1074 !!   namptr       Poleward Transport Diagnostics 
    10751074!!   namhsb       Heat and salt budgets 
    10761075!!====================================================================== 
    … …  
    11211120   ln_ariane     = .true.     !  Input with Ariane tool convention(T) 
    11221121   ln_flo_ascii  = .true.     !  Output with Ariane tool netcdf convention(F) or ascii file (T) 
    1123 / 
    1124 !----------------------------------------------------------------------- 
    1125 &namptr       !   Poleward Transport Diagnostic 
    1126 !----------------------------------------------------------------------- 
    1127    ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
    1128    ln_diaznl  = .true.     !  Add zonal means and meridional stream functions 
    1129    ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
    1130                            !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    1131    ln_ptrcomp = .true.     !  Add decomposition : overturning 
    1132    nn_fptr    =  1         !  Frequency of ptr computation [time step] 
    1133    nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
    11341122/ 
    11351123!----------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/cfg.txt

    r4990 r5023  
    1212ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
    1313ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
     14ORCA2_LIM_PTR OPA_SRC LIM_SRC_2 NST_SRC 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r4990 r5023  
    88   !!            3.2  ! 2010-03  (O. Marti, S. Flavoni) Add fields 
    99   !!            3.3  ! 2010-10  (G. Madec)  dynamical allocation 
     10   !!            3.6  ! 2014-12  (C. Ethe) use of IOM 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    1314   !!   dia_ptr      : Poleward Transport Diagnostics module 
    1415   !!   dia_ptr_init : Initialization, namelist read 
    15    !!   dia_ptr_wri  : Output of poleward fluxes 
    16    !!   ptr_vjk      : "zonal" sum computation of a "meridional" flux array 
    17    !!   ptr_tjk      : "zonal" mean computation of a tracer field 
    18    !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional" flux array 
    19    !!                   (Generic interface to ptr_vj_3d, ptr_vj_2d) 
     16   !!   ptr_sjk      : "zonal" mean computation of a field - tracer or flux array 
     17   !!   ptr_sj       : "zonal" and vertical sum computation of a "meridional" flux array 
     18   !!                   (Generic interface to ptr_sj_3d, ptr_sj_2d) 
    2019   !!---------------------------------------------------------------------- 
    2120   USE oce              ! ocean dynamics and active tracers 
    2221   USE dom_oce          ! ocean space and time domain 
     22   USE domngb 
    2323   USE phycst           ! physical constants 
    24    USE ldftra_oce       ! ocean active tracers: lateral physics 
    25    USE dianam           ! 
     24   ! 
    2625   USE iom              ! IOM library 
    27    USE ioipsl           ! IO-IPSL library 
    2826   USE in_out_manager   ! I/O manager 
    2927   USE lib_mpp          ! MPP library 
    30    USE lbclnk           ! lateral boundary condition - processor exchanges 
    3128   USE timing           ! preformance summary 
    32    USE wrk_nemo         ! working arrays 
    3329 
    3430   IMPLICIT NONE 
    3531   PRIVATE 
    3632 
    37    INTERFACE ptr_vj 
    38       MODULE PROCEDURE ptr_vj_3d, ptr_vj_2d 
     33   INTERFACE ptr_sj 
     34      MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d 
    3935   END INTERFACE 
    4036 
    41    PUBLIC   dia_ptr_init   ! call in opa module 
     37   PUBLIC   ptr_sj         ! call by tra_ldf & tra_adv routines 
     38   PUBLIC   ptr_sjk        !  
     39   PUBLIC   dia_ptr_alloc   ! call in opa module 
    4240   PUBLIC   dia_ptr        ! call in step module 
    43    PUBLIC   ptr_vj         ! call by tra_ldf & tra_adv routines 
    44    PUBLIC   ptr_vjk        ! call by tra_ldf & tra_adv routines 
    4541 
    4642   !                                  !!** namelist  namptr  ** 
    47    LOGICAL , PUBLIC ::   ln_diaptr     !: Poleward transport flag (T) or not (F) 
    48    LOGICAL , PUBLIC ::   ln_subbas     !: Atlantic/Pacific/Indian basins calculation 
    49    LOGICAL , PUBLIC ::   ln_diaznl     !: Add zonal means and meridional stream functions 
    50    LOGICAL , PUBLIC ::   ln_ptrcomp    !: Add decomposition : overturning (and gyre, soon ...) 
    51    INTEGER , PUBLIC ::   nn_fptr       !: frequency of ptr computation  [time step] 
    52    INTEGER , PUBLIC ::   nn_fwri       !: frequency of ptr outputs      [time step] 
    53  
    54    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf, htr_ove   !: Heat TRansports (adv, diff, overturn.) 
    55    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf, str_ove   !: Salt TRansports (adv, diff, overturn.) 
     43   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf   !: Heat TRansports (adv, diff, overturn.) 
     44   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf   !: Salt TRansports (adv, diff, overturn.) 
    5645    
    57    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   btmsk                  ! T-point basin interior masks 
    58    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   btm30                  ! mask out Southern Ocean (=0 south of 30°S) 
    59    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htr  , str             ! adv heat and salt transports (approx) 
    60    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_jk, sn_jk , v_msf   ! i-mean T and S, j-Stream-Function 
    61    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sjk  , r1_sjk          ! i-mean i-k-surface and its inverse         
    62    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htr_eiv, str_eiv       ! bolus adv heat ans salt transports ('key_diaeiv') 
    63    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_msf_eiv              ! bolus j-streamfuction              ('key_diaeiv') 
    64  
    65  
    66    INTEGER ::   niter       ! 
    67    INTEGER ::   nidom_ptr   ! 
    68    INTEGER ::   numptr      ! logical unit for Poleward TRansports 
    69    INTEGER ::   nptr        ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T)  
     46 
     47   LOGICAL, PUBLIC ::   l_diaptr = .TRUE.    !  Poleward transport flag (T) or not (F) 
     48   LOGICAL         ::   l_subbas = .FALSE.   !  Atlantic/Pacific/Indian basins calculation 
     49   LOGICAL         ::   linit    = .TRUE.    !  initialization flag (set to false after the 1st call) 
     50   INTEGER         ::   nptr                 ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)  
     51   INTEGER         ::   nx, ny  
    7052 
    7153   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
    … …  
    7355   REAL(wp) ::   rc_ggram = 1.e-6_wp   ! conversion from g    to Pg 
    7456 
    75    REAL(wp), TARGET, DIMENSION(:),   ALLOCATABLE, SAVE :: p_fval1d 
    76    REAL(wp), TARGET, DIMENSION(:,:), ALLOCATABLE, SAVE :: p_fval2d 
    77  
    78    !! Integer, 1D workspace arrays. Not common enough to be implemented in  
    79    !! wrk_nemo module. 
    80    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex  , ndex_atl     , ndex_pac     , ndex_ind     , ndex_ipc 
    81    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30 
    82    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 
     57   CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:)     :: clsubb 
     58   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks 
     59   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   :: btm30   ! mask out Southern Ocean (=0 south of 30°S) 
     60 
     61   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:)     :: p_fval1d 
     62   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: p_fval2d 
     63 
    8364 
    8465   !! * Substitutions 
    … …  
    9273CONTAINS 
    9374 
    94    FUNCTION dia_ptr_alloc() 
    95       !!---------------------------------------------------------------------- 
    96       !!                    ***  ROUTINE dia_ptr_alloc  *** 
    97       !!---------------------------------------------------------------------- 
    98       INTEGER               ::   dia_ptr_alloc   ! return value 
    99       INTEGER, DIMENSION(6) ::   ierr 
    100       !!---------------------------------------------------------------------- 
    101       ierr(:) = 0 
    102       ! 
    103       ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
    104          &      htr_adv(jpj) , str_adv(jpj) ,   & 
    105          &      htr_ldf(jpj) , str_ldf(jpj) ,   & 
    106          &      htr_ove(jpj) , str_ove(jpj),    & 
    107          &      htr(jpj,nptr) , str(jpj,nptr) , & 
    108          &      tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 
    109          &      sjk  (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1)  ) 
    110          ! 
    111 #if defined key_diaeiv 
    112       ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 
    113          &      v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) ) 
    114 #endif 
    115       ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3)) 
    116       ! 
    117       ALLOCATE(ndex(jpj*jpk),        ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), & 
    118          &     ndex_ind(jpj*jpk),    ndex_ipc(jpj*jpk),                    & 
    119          &     ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4)) 
    120  
    121       ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk),                   & 
    122          &     ndex_h(jpj),          ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), & 
    123          &     ndex_h_ind_30(jpj),   ndex_h_ipc_30(jpj), Stat=ierr(5) ) 
    124          ! 
    125      ALLOCATE( btm30(jpi,jpj) , STAT=ierr(6)  ) 
    126          ! 
    127       dia_ptr_alloc = MAXVAL( ierr ) 
    128       IF(lk_mpp)   CALL mpp_sum( dia_ptr_alloc ) 
    129       ! 
    130    END FUNCTION dia_ptr_alloc 
    131  
    132  
    133    FUNCTION ptr_vj_3d( pva )   RESULT ( p_fval ) 
    134       !!---------------------------------------------------------------------- 
    135       !!                    ***  ROUTINE ptr_vj_3d  *** 
    136       !! 
    137       !! ** Purpose :   i-k sum computation of a j-flux array 
    138       !! 
    139       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    140       !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
    141       !! 
    142       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    143       !!---------------------------------------------------------------------- 
    144       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point 
    145       !! 
    146       INTEGER                  ::   ji, jj, jk   ! dummy loop arguments 
    147       INTEGER                  ::   ijpj         ! ??? 
    148       REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value 
    149       !!-------------------------------------------------------------------- 
    150       ! 
    151       p_fval => p_fval1d 
    152  
    153       ijpj = jpj 
    154       p_fval(:) = 0._wp 
    155       DO jk = 1, jpkm1 
    156          DO jj = 2, jpjm1 
    157             DO ji = fs_2, fs_jpim1   ! Vector opt. 
    158                p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj)  
    159             END DO 
    160          END DO 
    161       END DO 
    162 #if defined key_mpp_mpi 
    163       IF(lk_mpp)   CALL mpp_sum( p_fval, ijpj, ncomm_znl) 
    164 #endif 
    165       ! 
    166    END FUNCTION ptr_vj_3d 
    167  
    168  
    169    FUNCTION ptr_vj_2d( pva )   RESULT ( p_fval ) 
    170       !!---------------------------------------------------------------------- 
    171       !!                    ***  ROUTINE ptr_vj_2d  *** 
    172       !! 
    173       !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array 
    174       !! 
    175       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    176       !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
    177       !! 
    178       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    179       !!---------------------------------------------------------------------- 
    180       IMPLICIT none 
    181       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pva   ! mask flux array at V-point 
    182       !! 
    183       INTEGER                  ::   ji,jj       ! dummy loop arguments 
    184       INTEGER                  ::   ijpj        ! ??? 
    185       REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 
    186       !!-------------------------------------------------------------------- 
    187       !  
    188       p_fval => p_fval1d 
    189  
    190       ijpj = jpj 
    191       p_fval(:) = 0._wp 
    192       DO jj = 2, jpjm1 
    193          DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    194             p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 
    195          END DO 
    196       END DO 
    197 #if defined key_mpp_mpi 
    198       CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 
    199 #endif 
    200       !  
    201    END FUNCTION ptr_vj_2d 
    202  
    203  
    204    FUNCTION ptr_vjk( pva, pmsk )   RESULT ( p_fval ) 
    205       !!---------------------------------------------------------------------- 
    206       !!                    ***  ROUTINE ptr_vjk  *** 
    207       !! 
    208       !! ** Purpose :   i-sum computation of a j-velocity array 
    209       !! 
    210       !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i). 
    211       !!              pva is supposed to be a masked flux (i.e. * vmask) 
    212       !! 
    213       !! ** Action  : - p_fval: i-mean poleward flux of pva 
    214       !!---------------------------------------------------------------------- 
    215       !! 
    216       IMPLICIT none 
    217       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point 
    218       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask 
    219       !! 
    220       INTEGER                           :: ji, jj, jk ! dummy loop arguments 
    221       REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value 
    222 #if defined key_mpp_mpi 
    223       INTEGER, DIMENSION(1) ::   ish 
    224       INTEGER, DIMENSION(2) ::   ish2 
    225       INTEGER               ::   ijpjjpk 
    226 #endif 
    227 #if defined key_mpp_mpi 
    228       REAL(wp), POINTER, DIMENSION(:) ::   zwork    ! mask flux array at V-point 
    229 #endif 
    230       !!-------------------------------------------------------------------- 
    231       ! 
    232 #if defined key_mpp_mpi 
    233       ijpjjpk = jpj*jpk 
    234       CALL wrk_alloc( jpj*jpk, zwork ) 
    235 #endif 
    236  
    237       p_fval => p_fval2d 
    238  
    239       p_fval(:,:) = 0._wp 
    240       ! 
    241       IF( PRESENT( pmsk ) ) THEN  
    242          DO jk = 1, jpkm1 
    243             DO jj = 2, jpjm1 
    244 !!gm here, use of tmask_i  ==> no need of loop over nldi, nlei.... 
    245                DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    246                   p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj) 
     75   SUBROUTINE dia_ptr( pvtr ) 
     76      !!---------------------------------------------------------------------- 
     77      !!                  ***  ROUTINE dia_ptr  *** 
     78      !!---------------------------------------------------------------------- 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport 
     80      ! 
     81      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     82      REAL(wp) ::   zv, zsfc               ! local scalar 
     83      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace 
     84      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace 
     85      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace 
     86      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace 
     87      CHARACTER( len = 10 )  :: cl1 
     88      !!---------------------------------------------------------------------- 
     89      ! 
     90      IF( nn_timing == 1 )   CALL timing_start('dia_ptr') 
     91 
     92      IF( linit )  THEN 
     93         CALL dia_ptr_init 
     94         linit = .FALSE. 
     95      ENDIF 
     96      ! 
     97      IF( PRESENT( pvtr ) ) THEN 
     98         IF( iom_use("zomsfglo") ) THEN    ! effective MSF 
     99            z3d(nx,:,:) = ptr_sjk( pvtr(:,:,:) )  ! zonal cumulative effective transport 
     100            DO jk = 2, jpkm1  
     101              z3d(nx,:,jk) = z3d(nx,:,jk-1) + z3d(nx,:,jk)   ! effective j-Stream-Function (MSF) 
     102           END DO 
     103            cl1 = TRIM('zomsf'//clsubb(1) ) 
     104            CALL iom_put( cl1, z3d * rc_sv ) 
     105            DO jn = 2, nptr                                    ! by sub-basins 
     106               z3d(nx,:,:) =  ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) )  
     107               DO jk = 2, jpkm1  
     108                  z3d(nx,:,jk) = z3d(nx,:,jk-1) + z3d(nx,:,jk)    ! effective j-Stream-Function (MSF) 
    247109               END DO 
    248             END DO 
    249          END DO 
    250       ELSE  
    251          DO jk = 1, jpkm1 
    252             DO jj = 2, jpjm1 
    253                DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    254                   p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj) 
    255                END DO 
    256             END DO 
    257          END DO 
    258       END IF 
    259       ! 
    260 #if defined key_mpp_mpi 
    261       ijpjjpk = jpj*jpk 
    262       ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    263       zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 
    264       CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 
    265       p_fval(:,:) = RESHAPE( zwork, ish2 ) 
    266 #endif 
    267       ! 
    268 #if defined key_mpp_mpi 
    269       CALL wrk_dealloc( jpj*jpk, zwork ) 
    270 #endif 
    271       ! 
    272    END FUNCTION ptr_vjk 
    273  
    274  
    275    FUNCTION ptr_tjk( pta, pmsk )   RESULT ( p_fval ) 
    276       !!---------------------------------------------------------------------- 
    277       !!                    ***  ROUTINE ptr_tjk  *** 
    278       !! 
    279       !! ** Purpose :   i-sum computation of e1t*e3t * a tracer field 
    280       !! 
    281       !! ** Method  : - i-sum of mj(pta) using tmask 
    282       !! 
    283       !! ** Action  : - p_fval: i-sum of e1t*e3t*pta 
    284       !!---------------------------------------------------------------------- 
    285       !! 
    286       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point 
    287       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask 
    288       !! 
    289       INTEGER                           :: ji, jj, jk   ! dummy loop arguments 
    290       REAL(wp), POINTER, DIMENSION(:,:) :: p_fval       ! return function value 
    291 #if defined key_mpp_mpi 
    292       INTEGER, DIMENSION(1) ::   ish 
    293       INTEGER, DIMENSION(2) ::   ish2 
    294       INTEGER               ::   ijpjjpk 
    295 #endif 
    296 #if defined key_mpp_mpi 
    297       REAL(wp), POINTER, DIMENSION(:) ::   zwork    ! mask flux array at V-point 
    298 #endif 
    299       !!--------------------------------------------------------------------  
    300       ! 
    301 #if defined key_mpp_mpi 
    302       ijpjjpk = jpj*jpk 
    303       CALL wrk_alloc( jpj*jpk, zwork ) 
    304 #endif 
    305  
    306       p_fval => p_fval2d 
    307  
    308       p_fval(:,:) = 0._wp 
    309       DO jk = 1, jpkm1 
    310          DO jj = 2, jpjm1 
    311             DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
    312                p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj) 
    313             END DO 
    314          END DO 
    315       END DO 
    316 #if defined key_mpp_mpi 
    317       ijpjjpk = jpj*jpk 
    318       ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    319       zwork(1:ijpjjpk)= RESHAPE( p_fval, ish ) 
    320       CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 
    321       p_fval(:,:)= RESHAPE( zwork, ish2 ) 
    322 #endif 
    323       ! 
    324 #if defined key_mpp_mpi 
    325       CALL wrk_dealloc( jpj*jpk, zwork ) 
    326 #endif 
    327       !     
    328    END FUNCTION ptr_tjk 
    329  
    330  
    331    SUBROUTINE dia_ptr( kt ) 
    332       !!---------------------------------------------------------------------- 
    333       !!                  ***  ROUTINE dia_ptr  *** 
    334       !!---------------------------------------------------------------------- 
    335       USE oce,     vt  =>   ua   ! use ua as workspace 
    336       USE oce,     vs  =>   va   ! use va as workspace 
    337       IMPLICIT none 
    338       !! 
    339       INTEGER, INTENT(in) ::   kt   ! ocean time step index 
    340       ! 
    341       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    342       REAL(wp) ::   zv               ! local scalar 
    343       !!---------------------------------------------------------------------- 
    344       ! 
    345       IF( nn_timing == 1 )   CALL timing_start('dia_ptr') 
    346       ! 
    347       IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 )   THEN 
    348          ! 
    349          IF( MOD( kt, nn_fptr ) == 0 ) THEN  
    350             ! 
    351             IF( ln_diaznl ) THEN               ! i-mean temperature and salinity 
    352                DO jn = 1, nptr 
    353                   tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    354                   sn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    355                END DO 
    356             ENDIF 
    357             ! 
    358             !                          ! horizontal integral and vertical dz  
    359             !                                ! eulerian velocity 
    360             v_msf(:,:,1) = ptr_vjk( vn(:,:,:) )  
    361             DO jn = 2, nptr 
    362                v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) )  
    363             END DO 
    364 #if defined key_diaeiv 
    365             DO jn = 1, nptr                  ! bolus velocity 
    366                v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) )   ! here no btm30 for MSFeiv 
    367             END DO 
    368             !                                ! add bolus stream-function to the eulerian one 
    369             v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:) 
    370 #endif 
    371             ! 
    372             !                          ! Transports 
    373             !                                ! local heat & salt transports at T-points  ( tsn*mj[vn+v_eiv] ) 
    374             vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp 
    375             DO jk= 1, jpkm1 
    376                DO jj = 2, jpj 
     110               cl1 = TRIM('zomsf'//clsubb(jn) ) 
     111               CALL iom_put( cl1, z3d * rc_sv ) 
     112            END DO 
     113         ENDIF 
     114         ! 
     115      ELSE 
     116         ! 
     117         IF( iom_use("zotemglo") ) THEN    ! i-mean i-k-surface  
     118            DO jk = 1, jpkm1 
     119               DO jj = 1, jpj 
    377120                  DO ji = 1, jpi 
    378 #if defined key_diaeiv  
    379                      zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp 
    380 #else 
    381                      zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 
    382 #endif  
    383                      vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem) 
    384                      vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal) 
    385                   END DO 
    386                END DO 
    387             END DO 
    388 !!gm useless as overlap areas are not used in ptr_vjk 
    389             CALL lbc_lnk( vs, 'V', -1. )   ;   CALL lbc_lnk( vt, 'V', -1. ) 
    390 !!gm 
    391             !                                ! heat & salt advective transports (approximation) 
    392             htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt   ! SUM over jk + conversion 
    393             str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram 
    394             DO jn = 2, nptr  
    395                htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_pwatt   ! mask Southern Ocean 
    396                str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_ggram   ! mask Southern Ocean 
    397             END DO 
    398  
    399             IF( ln_ptrcomp ) THEN            ! overturning transport 
    400                htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt   ! SUM over jk + conversion 
    401                str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram 
    402             END IF 
    403             !                                ! Advective and diffusive transport 
    404             htr_adv(:) = htr_adv(:) * rc_pwatt        ! these are computed in tra_adv... and tra_ldf... routines  
    405             htr_ldf(:) = htr_ldf(:) * rc_pwatt        ! here just the conversion in PW and Gg 
    406             str_adv(:) = str_adv(:) * rc_ggram 
    407             str_ldf(:) = str_ldf(:) * rc_ggram 
    408  
    409 #if defined key_diaeiv 
    410             DO jn = 1, nptr                  ! Bolus component 
    411                htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt   ! SUM over jk 
    412                str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram   ! SUM over jk 
    413             END DO 
    414 #endif 
    415             !                                ! "Meridional" Stream-Function 
     121                     zsfc = e1t(ji,jj) * fse3t(ji,jj,jk) 
     122                     zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
     123                     zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 
     124                     zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc 
     125                  ENDDO 
     126               ENDDO 
     127            ENDDO 
    416128            DO jn = 1, nptr 
    417                DO jk = 2, jpk  
    418                   v_msf    (:,jk,jn) = v_msf    (:,jk-1,jn) + v_msf    (:,jk,jn)       ! Eulerian j-Stream-Function 
    419 #if defined key_diaeiv 
    420                   v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn)       ! Bolus    j-Stream-Function 
    421  
    422 #endif 
    423                END DO 
    424             END DO 
    425             v_msf    (:,:,:) = v_msf    (:,:,:) * rc_sv       ! converte in Sverdrups 
    426 #if defined key_diaeiv 
    427             v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv 
    428 #endif 
    429          ENDIF 
    430          ! 
    431          CALL dia_ptr_wri( kt )                        ! outputs 
     129               zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
     130               cl1 = TRIM('zosrf'//clsubb(jn) ) 
     131               CALL iom_put( cl1, zmask ) 
     132               ! 
     133               z3d(nx,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 
     134                  &            / MAX( zmask(1,:,:), 10.e-15 ) 
     135               cl1 = TRIM('zotem'//clsubb(jn) ) 
     136               CALL iom_put( cl1, z3d ) 
     137               ! 
     138               z3d(nx,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 
     139                  &            / MAX( zmask(1,:,:), 10.e-15 ) 
     140               cl1 = TRIM('zosal'//clsubb(jn) ) 
     141               CALL iom_put( cl1, z3d ) 
     142            END DO 
     143         ENDIF 
     144         ! 
     145         !                                ! Advective and diffusive heat and salt transport 
     146         IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN    
     147            z2d(nx,:) = htr_adv(:) * rc_pwatt        !  (conversion in PW) 
     148            cl1 = 'sophtadv'                  
     149            CALL iom_put( TRIM(cl1), z2d ) 
     150            z2d(nx,:) = str_adv(:) * rc_ggram        ! (conversion in Gg) 
     151            cl1 = 'sopstadv' 
     152            CALL iom_put( TRIM(cl1), z2d ) 
     153         ENDIF 
     154         ! 
     155         IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN    
     156            z2d(nx,:) = htr_ldf(:) * rc_pwatt        !  (conversion in PW)  
     157            cl1 = 'sophtldf' 
     158            CALL iom_put( TRIM(cl1), z2d ) 
     159            z2d(nx,:) = str_ldf(:) * rc_ggram        !  (conversion in Gg) 
     160            cl1 = 'sopstldf' 
     161            CALL iom_put( TRIM(cl1), z2d ) 
     162         ENDIF 
    432163         ! 
    433164      ENDIF 
    434       ! 
    435 #if defined key_mpp_mpi 
    436       IF( kt == nitend .AND. l_znl_root )   CALL histclo( numptr )      ! Close the file 
    437 #else 
    438       IF( kt == nitend )                    CALL histclo( numptr )      ! Close the file 
    439 #endif 
    440165      ! 
    441166      IF( nn_timing == 1 )   CALL timing_stop('dia_ptr') 
    … …  
    450175      !! ** Purpose :   Initialization, namelist read 
    451176      !!---------------------------------------------------------------------- 
    452       INTEGER ::   jn           ! dummy loop indices  
    453       INTEGER ::   inum, ierr   ! local integers 
    454       INTEGER ::   ios          ! Local integer output status for namelist read 
    455 #if defined key_mpp_mpi 
    456       INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 
    457 #endif 
    458       !! 
    459       NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 
    460       !!---------------------------------------------------------------------- 
    461  
    462       REWIND( numnam_ref )              ! Namelist namptr in reference namelist : Poleward transport 
    463       READ  ( numnam_ref, namptr, IOSTAT = ios, ERR = 901) 
    464 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist', lwp ) 
    465  
    466       REWIND( numnam_cfg )              ! Namelist namptr in configuration namelist : Poleward transport 
    467       READ  ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 ) 
    468 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp ) 
    469       IF(lwm) WRITE ( numond, namptr ) 
    470  
     177      INTEGER :: jn,  inum   ! local integers 
     178      !!---------------------------------------------------------------------- 
     179 
     180      l_diaptr = iom_use("zomsfglo") .OR. iom_use("zotemglo") .OR. iom_use("sophtadv") .OR. iom_use("sophtldf") 
     181      CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  ) 
     182      IF( inum > 0 ) l_subbas  = .TRUE. 
     183       
    471184      IF(lwp) THEN                     ! Control print 
    472185         WRITE(numout,*) 
    … …  
    474187         WRITE(numout,*) '~~~~~~~~~~~~' 
    475188         WRITE(numout,*) '   Namelist namptr : set ptr parameters' 
    476          WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      ln_diaptr  = ', ln_diaptr 
    477          WRITE(numout,*) '      Overturning heat & salt transport                  ln_ptrcomp = ', ln_ptrcomp 
    478          WRITE(numout,*) '      T & S zonal mean and meridional stream function    ln_diaznl  = ', ln_diaznl  
    479          WRITE(numout,*) '      Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins      ln_subbas  = ', ln_subbas 
    480          WRITE(numout,*) '      Frequency of computation                           nn_fptr    = ', nn_fptr 
    481          WRITE(numout,*) '      Frequency of outputs                               nn_fwri    = ', nn_fwri 
     189         WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      l_diaptr  = ', l_diaptr 
     190         WRITE(numout,*) '      Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins      l_subbas  = ', l_subbas 
    482191      ENDIF 
    483        
    484       IF( ln_diaptr) THEN   
    485       
    486          IF( nn_timing == 1 )   CALL timing_start('dia_ptr_init') 
    487        
    488          IF( ln_subbas ) THEN   ;   nptr = 5       ! Global, Atlantic, Pacific, Indian, Indo-Pacific 
    489          ELSE                   ;   nptr = 1       ! Global only 
     192 
     193      IF( l_diaptr ) THEN   
     194         ! 
     195         CALL dom_ngb( 180., 90., nx, ny, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     196         ! 
     197         IF( l_subbas ) THEN  
     198            nptr = 5            ! Global, Atlantic, Pacific, Indian, Indo-Pacific 
     199            ALLOCATE( clsubb(nptr) ) 
     200            clsubb(1) = 'glo' ;  clsubb(2) = 'atl'  ;  clsubb(3) = 'pac'  ;  clsubb(4) = 'ind'  ;  clsubb(5) = 'ipc' 
     201         ELSE                
     202            nptr = 1       ! Global only 
     203            ALLOCATE( clsubb(nptr) ) 
     204            clsubb(1) = 'glo'  
    490205         ENDIF 
    491206 
    … …  
    493208         IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 
    494209 
    495          rc_pwatt = rc_pwatt * rau0 * rcp          ! conversion from K.s-1 to PetaWatt 
     210         rc_pwatt = rc_pwatt * rau0_rcp          ! conversion from K.s-1 to PetaWatt 
    496211 
    497212         IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum 
    498213 
    499          IF( ln_subbas ) THEN                ! load sub-basin mask 
    500             CALL iom_open( 'subbasins', inum ) 
     214         IF( l_subbas ) THEN                ! load sub-basin mask 
    501215            CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
    502216            CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin 
    … …  
    508222            END WHERE 
    509223         ENDIF 
     224    
    510225         btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean 
    511226       
    … …  
    513228            btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only 
    514229         END DO 
    515        
    516          IF( lk_vvl )   CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' ) 
    517  
    518          !                                   ! i-sum of e1v*e3v surface and its inverse 
    519          DO jn = 1, nptr 
    520             sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) ) 
    521             r1_sjk(:,:,jn) = 0._wp 
    522             WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
    523          END DO 
    524  
    525       ! Initialise arrays to zero because diatpr is called before they are first calculated 
    526       ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
    527       htr_adv(:) = 0._wp ; str_adv(:) =  0._wp ;  htr_ldf(:) = 0._wp ; str_ldf(:) =  0._wp 
    528  
    529 #if defined key_mpp_mpi  
    530          iglo (1) = jpjglo                   ! MPP case using MPI  ('key_mpp_mpi') 
    531          iloc (1) = nlcj 
    532          iabsf(1) = njmppt(narea) 
    533          iabsl(:) = iabsf(:) + iloc(:) - 1 
    534          ihals(1) = nldj - 1 
    535          ihale(1) = nlcj - nlej 
    536          idid (1) = 2 
    537          CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr ) 
    538 #else 
    539          nidom_ptr = FLIO_DOM_NONE 
    540 #endif 
    541       IF( nn_timing == 1 )   CALL timing_stop('dia_ptr_init') 
    542       ! 
     230 
     231         ! Initialise arrays to zero because diatpr is called before they are first calculated 
     232         ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
     233         htr_adv(:) = 0._wp  ;  str_adv(:) =  0._wp   
     234         htr_ldf(:) = 0._wp  ;  str_ldf(:) =  0._wp  
     235         ! 
    543236      ENDIF  
    544237      !  
    … …  
    546239 
    547240 
    548    SUBROUTINE dia_ptr_wri( kt ) 
    549       !!--------------------------------------------------------------------- 
    550       !!                ***  ROUTINE dia_ptr_wri  *** 
    551       !! 
    552       !! ** Purpose :   output of poleward fluxes 
    553       !! 
    554       !! ** Method  :   NetCDF file 
    555       !!---------------------------------------------------------------------- 
    556       !! 
    557       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    558       !! 
    559       INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw 
    560       INTEGER, SAVE ::   ndim  , ndim_atl     , ndim_pac     , ndim_ind     , ndim_ipc 
    561       INTEGER, SAVE ::           ndim_atl_30  , ndim_pac_30  , ndim_ind_30  , ndim_ipc_30 
    562       INTEGER, SAVE ::   ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 
    563       !! 
    564       CHARACTER (len=40) ::   clhstnam, clop, clop_once, cl_comment   ! temporary names 
    565       INTEGER            ::   iline, it, itmod, ji, jj, jk            ! 
    566 #if defined key_iomput 
    567       INTEGER            ::   inum                                    ! temporary logical unit 
     241   FUNCTION dia_ptr_alloc() 
     242      !!---------------------------------------------------------------------- 
     243      !!                    ***  ROUTINE dia_ptr_alloc  *** 
     244      !!---------------------------------------------------------------------- 
     245      INTEGER               ::   dia_ptr_alloc   ! return value 
     246      INTEGER, DIMENSION(3) ::   ierr 
     247      !!---------------------------------------------------------------------- 
     248      ierr(:) = 0 
     249      ! 
     250      ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
     251         &      htr_adv(jpj) , str_adv(jpj) ,   & 
     252         &      htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1)  ) 
     253         ! 
     254      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
     255      ! 
     256      ALLOCATE( btm30(jpi,jpj), STAT=ierr(3)  ) 
     257 
     258         ! 
     259      dia_ptr_alloc = MAXVAL( ierr ) 
     260      IF(lk_mpp)   CALL mpp_sum( dia_ptr_alloc ) 
     261      ! 
     262   END FUNCTION dia_ptr_alloc 
     263 
     264 
     265   FUNCTION ptr_sj_3d( pva, pmsk )   RESULT ( p_fval ) 
     266      !!---------------------------------------------------------------------- 
     267      !!                    ***  ROUTINE ptr_sj_3d  *** 
     268      !! 
     269      !! ** Purpose :   i-k sum computation of a j-flux array 
     270      !! 
     271      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
     272      !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
     273      !! 
     274      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
     275      !!---------------------------------------------------------------------- 
     276      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)       ::   pva   ! mask flux array at V-point 
     277      REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask 
     278      ! 
     279      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments 
     280      INTEGER                  ::   ijpj         ! ??? 
     281      REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value 
     282      !!-------------------------------------------------------------------- 
     283      ! 
     284      p_fval => p_fval1d 
     285 
     286      ijpj = jpj 
     287      p_fval(:) = 0._wp 
     288      IF( PRESENT( pmsk ) ) THEN  
     289         DO jk = 1, jpkm1 
     290            DO jj = 2, jpjm1 
     291               DO ji = fs_2, fs_jpim1   ! Vector opt. 
     292                  p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 
     293               END DO 
     294            END DO 
     295         END DO 
     296      ELSE 
     297         DO jk = 1, jpkm1 
     298            DO jj = 2, jpjm1 
     299               DO ji = fs_2, fs_jpim1   ! Vector opt. 
     300                  p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj)  
     301               END DO 
     302            END DO 
     303         END DO 
     304      ENDIF 
     305#if defined key_mpp_mpi 
     306      IF(lk_mpp)   CALL mpp_sum( p_fval, ijpj, ncomm_znl) 
    568307#endif 
    569       REAL(wp)           ::   zsto, zout, zdt, zjulian                ! temporary scalars 
    570       !! 
    571       REAL(wp), POINTER, DIMENSION(:)   ::   zphi, zfoo    ! 1D workspace 
    572       REAL(wp), POINTER, DIMENSION(:,:) ::   z_1           ! 2D workspace 
    573       !!--------------------------------------------------------------------  
    574       ! 
    575       CALL wrk_alloc( jpj       , zphi , zfoo ) 
    576       CALL wrk_alloc( jpj , jpk , z_1  ) 
    577  
    578       ! define time axis 
    579       it    = kt / nn_fptr 
    580       itmod = kt - nit000 + 1 
    581        
    582       ! Initialization 
    583       ! -------------- 
    584       IF( kt == nit000 ) THEN 
    585          niter = ( nit000 - 1 ) / nn_fptr 
    586          zdt = rdt 
    587          IF( nacc == 1 )   zdt = rdtmin 
    588          ! 
    589          IF(lwp) THEN 
    590             WRITE(numout,*) 
    591             WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 
    592             WRITE(numout,*) '~~~~~~~~~~~~' 
    593          ENDIF 
    594  
    595          ! Reference latitude (used in plots) 
    596          ! ------------------ 
    597          !                                           ! ======================= 
    598          IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations 
    599             !                                        ! ======================= 
    600             IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole 
    601             IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole 
    602             IF( jp_cfg == 1   )   iline =  96   ! i-line that passes near the North Pole 
    603             IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole 
    604             IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole 
    605             zphi(1:jpj) = 0._wp 
    606             DO ji = mi0(iline), mi1(iline)  
    607                zphi(1:jpj) = gphiv(ji,:)         ! if iline is in the local domain 
    608                ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 
    609                IF( jp_cfg == 05 ) THEN 
    610                   DO jj = mj0(jpjdta), mj1(jpjdta)  
    611                      zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp 
    612                      zphi( jj ) = MIN( zphi(jj), 90._wp ) 
    613                   END DO 
    614                END IF 
    615                IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 
    616                   DO jj = mj0(jpjdta-1), mj1(jpjdta-1)  
    617                      zphi( jj ) = 88.5_wp 
    618                   END DO 
    619                   DO jj = mj0(jpjdta  ), mj1(jpjdta  )  
    620                      zphi( jj ) = 89.5_wp 
    621                   END DO 
    622                END IF 
    623             END DO 
    624             ! provide the correct zphi to all local domains 
     308      ! 
     309   END FUNCTION ptr_sj_3d 
     310 
     311 
     312   FUNCTION ptr_sj_2d( pva, pmsk )   RESULT ( p_fval ) 
     313      !!---------------------------------------------------------------------- 
     314      !!                    ***  ROUTINE ptr_sj_2d  *** 
     315      !! 
     316      !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array 
     317      !! 
     318      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
     319      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
     320      !! 
     321      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
     322      !!---------------------------------------------------------------------- 
     323      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)           ::   pva   ! mask flux array at V-point 
     324      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask 
     325      ! 
     326      INTEGER                  ::   ji,jj       ! dummy loop arguments 
     327      INTEGER                  ::   ijpj        ! ??? 
     328      REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 
     329      !!-------------------------------------------------------------------- 
     330      !  
     331      p_fval => p_fval1d 
     332 
     333      ijpj = jpj 
     334      p_fval(:) = 0._wp 
     335      IF( PRESENT( pmsk ) ) THEN  
     336         DO jj = 2, jpjm1 
     337            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
     338               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 
     339            END DO 
     340         END DO 
     341      ELSE 
     342         DO jj = 2, jpjm1 
     343            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ? 
     344               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 
     345            END DO 
     346         END DO 
     347      ENDIF 
    625348#if defined key_mpp_mpi 
    626             CALL mpp_sum( zphi, jpj, ncomm_znl )         
     349      CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 
    627350#endif 
    628             !                                        ! ======================= 
    629          ELSE                                        !   OTHER configurations  
    630             !                                        ! ======================= 
    631             zphi(1:jpj) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line 
    632             ! 
    633          ENDIF 
    634          ! 
    635          ! Work only on westmost processor (will not work if mppini2 is used) 
     351      !  
     352   END FUNCTION ptr_sj_2d 
     353 
     354 
     355   FUNCTION ptr_sjk( pta, pmsk )   RESULT ( p_fval ) 
     356      !!---------------------------------------------------------------------- 
     357      !!                    ***  ROUTINE ptr_sjk  *** 
     358      !! 
     359      !! ** Purpose :   i-sum computation of an array 
     360      !! 
     361      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i). 
     362      !! 
     363      !! ** Action  : - p_fval: i-mean poleward flux of pva 
     364      !!---------------------------------------------------------------------- 
     365      !! 
     366      IMPLICIT none 
     367      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pta    ! mask flux array at V-point 
     368      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask 
     369      !! 
     370      INTEGER                           :: ji, jj, jk ! dummy loop arguments 
     371      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value 
    636372#if defined key_mpp_mpi 
    637          IF( l_znl_root ) THEN  
     373      INTEGER, DIMENSION(1) ::   ish 
     374      INTEGER, DIMENSION(2) ::   ish2 
     375      INTEGER               ::   ijpjjpk 
     376      REAL(wp), DIMENSION(jpj*jpk) ::   zwork    ! mask flux array at V-point 
    638377#endif 
    639             ! 
    640             ! OPEN netcdf file  
    641             ! ---------------- 
    642             ! Define frequency of output and means 
    643             zsto = nn_fptr * zdt 
    644             IF( ln_mskland )   THEN    ! put 1.e+20 on land (very expensive!!) 
    645                clop      = "ave(only(x))" 
    646                clop_once = "once(only(x))" 
    647             ELSE                       ! no use of the mask value (require less cpu time) 
    648                clop      = "ave(x)"        
    649                clop_once = "once" 
    650             ENDIF 
    651  
    652             zout = nn_fwri * zdt 
    653             zfoo(1:jpj) = 0._wp 
    654  
    655             CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )  ! Compute julian date from starting date of the run 
    656             zjulian = zjulian - adatrj                         ! set calendar origin to the beginning of the experiment 
    657  
    658 #if defined key_iomput 
    659             ! Requested by IPSL people, use by their postpro... 
    660             IF(lwp) THEN 
    661                CALL dia_nam( clhstnam, nn_fwri,' ' ) 
    662                CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    663                WRITE(inum,*) clhstnam 
    664                CLOSE(inum) 
    665             ENDIF 
     378      !!-------------------------------------------------------------------- 
     379      ! 
     380      p_fval => p_fval2d 
     381 
     382      p_fval(:,:) = 0._wp 
     383      ! 
     384      IF( PRESENT( pmsk ) ) THEN  
     385         DO jk = 1, jpkm1 
     386            DO jj = 2, jpjm1 
     387!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei.... 
     388               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
     389                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) 
     390               END DO 
     391            END DO 
     392         END DO 
     393      ELSE  
     394         DO jk = 1, jpkm1 
     395            DO jj = 2, jpjm1 
     396               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ? 
     397                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj) 
     398               END DO 
     399            END DO 
     400         END DO 
     401      END IF 
     402      ! 
     403#if defined key_mpp_mpi 
     404      ijpjjpk = jpj*jpk 
     405      ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk 
     406      zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 
     407      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 
     408      p_fval(:,:) = RESHAPE( zwork, ish2 ) 
    666409#endif 
    667  
    668             CALL dia_nam( clhstnam, nn_fwri, 'diaptr' ) 
    669             IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam 
    670  
    671             ! Horizontal grid : zphi() 
    672             CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   & 
    673                1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr) 
    674             ! Vertical grids : gdept_1d, gdepw_1d 
    675             CALL histvert( numptr, "deptht", "Vertical T levels",   & 
    676                &                   "m", jpk, gdept_1d, ndepidzt, "down" ) 
    677             CALL histvert( numptr, "depthw", "Vertical W levels",   & 
    678                &                   "m", jpk, gdepw_1d, ndepidzw, "down" ) 
    679             ! 
    680             CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex  , ndim  )      ! Lat-Depth 
    681             CALL wheneq ( jpj    , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h )     ! Lat 
    682  
    683             IF( ln_subbas ) THEN 
    684                z_1(:,1) = 1._wp 
    685                WHERE ( gphit(jpi/2,:) < -30._wp )   z_1(:,1) = 0._wp 
    686                DO jk = 2, jpk 
    687                   z_1(:,jk) = z_1(:,1) 
    688                END DO 
    689                !                       ! Atlantic (jn=2) 
    690                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)         , 1._wp), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth 
    691                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)*z_1(:,:), 1._wp), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth 
    692                CALL wheneq ( jpj    , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 
    693                !                       ! Pacific (jn=3) 
    694                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)         , 1._wp), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth 
    695                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)*z_1(:,:), 1._wp), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth 
    696                CALL wheneq ( jpj    , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 
    697                !                       ! Indian (jn=4) 
    698                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)         , 1._wp), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth 
    699                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)*z_1(:,:), 1._wp), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth 
    700                CALL wheneq ( jpj    , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 
    701                !                       ! Indo-Pacific (jn=5) 
    702                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)         , 1._wp), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth 
    703                CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)*z_1(:,:), 1._wp), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth 
    704                CALL wheneq ( jpj    , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 
    705             ENDIF 
    706             !  
    707 #if defined key_diaeiv 
    708             cl_comment = ' (Bolus part included)' 
    709 #else 
    710             cl_comment = '                      ' 
    711 #endif 
    712             IF( ln_diaznl ) THEN             !  Zonal mean T and S 
    713                CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   & 
    714                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    715                CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   & 
    716                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    717  
    718                CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2"   ,   & 
    719                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    720                ! 
    721                IF (ln_subbas) THEN  
    722                   CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" ,   & 
    723                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    724                   CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU"  ,   & 
    725                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    726                   CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2"   ,   & 
    727                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    728  
    729                   CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C"  ,   & 
    730                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    731                   CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU"   ,   & 
    732                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    733                   CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2"    ,   & 
    734                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    735  
    736                   CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C"   ,   & 
    737                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    738                   CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU"    ,   & 
    739                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    740                   CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2"     ,   & 
    741                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    742  
    743                   CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" ,   & 
    744                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    745                   CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU"  ,   & 
    746                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 
    747                   CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2"   ,   & 
    748                      1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 
    749                ENDIF 
    750             ENDIF 
    751             ! 
    752             !  Meridional Stream-Function (Eulerian and Bolus) 
    753             CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" ,   & 
    754                1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    755             IF( ln_subbas .AND. ln_diaznl ) THEN 
    756                CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" ,   & 
    757                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    758                CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv"  ,   & 
    759                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    760                CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv"   ,   & 
    761                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    762                CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,& 
    763                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    764             ENDIF 
    765             ! 
    766             !  Heat transport  
    767             CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   & 
    768                "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    769             CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   & 
    770                "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    771             IF ( ln_ptrcomp ) THEN  
    772                CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   & 
    773                   "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    774             END IF 
    775             IF( ln_subbas ) THEN 
    776                CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment),  & 
    777                   "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    778                CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) ,  & 
    779                   "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    780                CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment)  ,  & 
    781                   "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    782                CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), & 
    783                   "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    784             ENDIF 
    785             ! 
    786             !  Salt transport  
    787             CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   & 
    788                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    789             CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   & 
    790                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    791             IF ( ln_ptrcomp ) THEN  
    792                CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   & 
    793                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    794             END IF 
    795 #if defined key_diaeiv 
    796             ! Eddy induced velocity 
    797             CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global",   & 
    798                "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 
    799             CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   & 
    800                "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    801             CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   & 
    802                "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    803 #endif 
    804             IF( ln_subbas ) THEN 
    805                CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment)      ,  & 
    806                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    807                CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment)      ,   & 
    808                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    809                CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment)      ,    & 
    810                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    811                CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment),  & 
    812                   "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    813             ENDIF 
    814             ! 
    815             CALL histend( numptr ) 
    816             ! 
    817          END IF 
    818 #if defined key_mpp_mpi 
    819       END IF 
    820 #endif 
    821  
    822 #if defined key_mpp_mpi 
    823       IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN 
    824 #else 
    825       IF( MOD( itmod, nn_fptr ) == 0  ) THEN 
    826 #endif 
    827          niter = niter + 1 
    828  
    829          IF( ln_diaznl ) THEN  
    830             CALL histwrite( numptr, "zosrfglo", niter, sjk  (:,:,1) , ndim, ndex ) 
    831             CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1)  , ndim, ndex ) 
    832             CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1)  , ndim, ndex ) 
    833  
    834             IF (ln_subbas) THEN  
    835                CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl ) 
    836                CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac ) 
    837                CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind ) 
    838                CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc ) 
    839  
    840                CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2)  , ndim_atl, ndex_atl ) 
    841                CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2)  , ndim_atl, ndex_atl ) 
    842                CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3)  , ndim_pac, ndex_pac ) 
    843                CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3)  , ndim_pac, ndex_pac ) 
    844                CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4)  , ndim_ind, ndex_ind ) 
    845                CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4)  , ndim_ind, ndex_ind ) 
    846                CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5)  , ndim_ipc, ndex_ipc ) 
    847                CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5)  , ndim_ipc, ndex_ipc ) 
    848             END IF 
    849          ENDIF 
    850  
    851          ! overturning outputs: 
    852          CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex ) 
    853          IF( ln_subbas .AND. ln_diaznl ) THEN 
    854             CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 ) 
    855             CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 ) 
    856             CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 ) 
    857             CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 ) 
    858          ENDIF 
    859 #if defined key_diaeiv 
    860          CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim  , ndex   ) 
    861 #endif 
    862  
    863          ! heat transport outputs: 
    864          IF( ln_subbas ) THEN 
    865             CALL histwrite( numptr, "sohtatl", niter, htr(:,2)  , ndim_h_atl_30, ndex_h_atl_30 ) 
    866             CALL histwrite( numptr, "sohtpac", niter, htr(:,3)  , ndim_h_pac_30, ndex_h_pac_30 ) 
    867             CALL histwrite( numptr, "sohtind", niter, htr(:,4)  , ndim_h_ind_30, ndex_h_ind_30 ) 
    868             CALL histwrite( numptr, "sohtipc", niter, htr(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
    869             CALL histwrite( numptr, "sostatl", niter, str(:,2)  , ndim_h_atl_30, ndex_h_atl_30 ) 
    870             CALL histwrite( numptr, "sostpac", niter, str(:,3)  , ndim_h_pac_30, ndex_h_pac_30 ) 
    871             CALL histwrite( numptr, "sostind", niter, str(:,4)  , ndim_h_ind_30, ndex_h_ind_30 ) 
    872             CALL histwrite( numptr, "sostipc", niter, str(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 ) 
    873          ENDIF 
    874  
    875          CALL histwrite( numptr, "sophtadv", niter, htr_adv     , ndim_h, ndex_h ) 
    876          CALL histwrite( numptr, "sophtldf", niter, htr_ldf     , ndim_h, ndex_h ) 
    877          CALL histwrite( numptr, "sopstadv", niter, str_adv     , ndim_h, ndex_h ) 
    878          CALL histwrite( numptr, "sopstldf", niter, str_ldf     , ndim_h, ndex_h ) 
    879          IF( ln_ptrcomp ) THEN  
    880             CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h ) 
    881             CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h ) 
    882          ENDIF 
    883 #if defined key_diaeiv 
    884          CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1)  , ndim_h, ndex_h ) 
    885          CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1)  , ndim_h, ndex_h ) 
    886 #endif 
    887          ! 
    888       ENDIF 
    889       ! 
    890       CALL wrk_dealloc( jpj      , zphi , zfoo ) 
    891       CALL wrk_dealloc( jpj , jpk, z_1 ) 
    892       ! 
    893   END SUBROUTINE dia_ptr_wri 
     410      ! 
     411   END FUNCTION ptr_sjk 
     412 
    894413 
    895414   !!====================================================================== 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r4990 r5023  
    5151   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin] 
    5252   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
     53   REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp  
    5354   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
    5455 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5003 r5023  
    12401240      CHARACTER(len=256)             ::   clsuff                   ! suffix name 
    12411241      CHARACTER(len=1)               ::   cl1                      ! 1 character 
    1242       CHARACTER(len=2)               ::   cl2                      ! 2 characters 
     1242      CHARACTER(len=2)               ::   cl2                      ! 1 character 
    12431243      CHARACTER(len=3)               ::   cl3                      ! 3 characters 
    12441244      INTEGER                        ::   ji, jg                   ! loop counters 
    … …  
    12961296      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 
    12971297      CALL set_mooring( zlonpira, zlatpira ) 
     1298 
     1299      ! diaptr : zonal mean  
     1300      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     1301      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
     1302      CALL iom_update_file_name('ptr') 
     1303      ! 
    12981304       
    12991305   END SUBROUTINE set_xmlatt 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r4990 r5023  
    15891589      END SELECT 
    15901590      ! 
     1591      rau0_rcp    = rau0 * rcp  
    15911592      r1_rau0     = 1._wp / rau0 
    15921593      r1_rcp      = 1._wp / rcp 
    1593       r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 
     1594      r1_rau0_rcp = 1._wp / rau0_rcp  
    15941595      ! 
    15951596      IF(lwp) WRITE(numout,*) 
    … …  
    15971598      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
    15981599      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
     1600      IF(lwp) WRITE(numout,*) '          rau0 * rcp                       rau0_rcp = ', rau0_rcp 
    15991601      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
    16001602      ! 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r4990 r5023  
    2626   USE cla             ! cross land advection      (cla_traadv     routine) 
    2727   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
     28   ! 
    2829   USE in_out_manager  ! I/O manager 
    2930   USE iom             ! I/O module 
    … …  
    3334   USE timing          ! Timing 
    3435   USE sbc_oce 
     36   USE diaptr          ! Poleward heat transport  
    3537 
    3638 
    … …  
    111113      ! 
    112114      IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the mle transport (if necessary) 
     115      ! 
    113116      CALL iom_put( "uocetr_eff", zun )                                         ! output effective transport       
    114117      CALL iom_put( "vocetr_eff", zvn ) 
    115118      CALL iom_put( "wocetr_eff", zwn ) 
    116  
     119      ! 
     120      IF( l_diaptr )   CALL dia_ptr( zvn )                                     ! diagnose the effective MSF  
     121      ! 
     122    
    117123      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    118       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
    119       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
    120       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )   !  MUSCL  
    121       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
    122       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
    123       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
    124       CASE ( 7 )   ;   CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD ZTS 
     124      CASE ( 1 )   ;    CALL tra_adv_cen2   ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
     125      CASE ( 2 )   ;    CALL tra_adv_tvd    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
     126      CASE ( 3 )   ;    CALL tra_adv_muscl  ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts, ln_traadv_msc_ups )   !  MUSCL  
     127      CASE ( 4 )   ;    CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
     128      CASE ( 5 )   ;    CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
     129      CASE ( 6 )   ;    CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
     130      CASE ( 7 )   ;    CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD ZTS 
    125131      ! 
    126132      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r4990 r5023  
    279279         END IF 
    280280         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    281          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    282            IF( jn == jp_tem )   htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    283            IF( jn == jp_sal )   str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     281         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN   
     282           IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     283           IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    284284         ENDIF 
    285285         ! 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r4990 r5023  
    2121   USE trdtra         ! tracers trends manager 
    2222   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
    23    USE sbcrnf          ! river runoffs 
     23   USE sbcrnf         ! river runoffs 
    2424   USE diaptr         ! poleward transport diagnostics 
    2525   ! 
    … …  
    219219         END IF 
    220220         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    221          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    222             IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    223             IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     221         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN   
     222            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     223            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    224224         ENDIF 
    225225 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r4990 r5023  
    200200 
    201201         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    202          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    203             IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    204             IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     202         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 
     203            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     204            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    205205         ENDIF 
    206206 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r4990 r5023  
    355355         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    356356         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    357          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    358            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    359            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     357         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN   
     358           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     359           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    360360         ENDIF 
    361361         ! 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r4990 r5023  
    184184         END IF 
    185185         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    186          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    187            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    188            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     186         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN   
     187           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     188           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    189189         ENDIF 
    190190 
    … …  
    250250         END IF 
    251251         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    252          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    253            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:) 
    254            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:) 
     252         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN   
     253           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
     254           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
    255255         ENDIF 
    256256         ! 
    … …  
    398398         END IF 
    399399         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    400          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    401            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    402            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     400         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN   
     401           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     402           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    403403         ENDIF 
    404404 
    … …  
    524524         END IF 
    525525         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    526          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    527            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:) 
    528            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:) 
     526         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN   
     527           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
     528           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
    529529         ENDIF 
    530530         ! 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r4990 r5023  
    177177         END IF 
    178178         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    179          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    180             IF( jn == jp_tem )  htr_adv(:) = ptr_vj( ztv(:,:,:) ) 
    181             IF( jn == jp_sal )  str_adv(:) = ptr_vj( ztv(:,:,:) ) 
     179         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN   
     180            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( ztv(:,:,:) ) 
     181            IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) ) 
    182182         ENDIF 
    183183          

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r4990 r5023  
    166166         !                                                 
    167167         ! "zonal" mean lateral diffusive heat and salt transport 
    168          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    169            IF( jn == jp_tem )  htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    170            IF( jn == jp_sal )  str_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     168         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN   
     169           IF( jn == jp_tem )  htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
     170           IF( jn == jp_sal )  str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    171171         ENDIF 
    172172         !                                                ! =========== 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r4292 r5023  
    247247         !                                                ! =============== 
    248248         ! "Poleward" diffusive heat or salt transport 
    249          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     249         IF( cdtype == 'TRA' .AND. l_diaptr .AND. ( kaht == 2 ) ) THEN 
    250250            ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    251             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
    252             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
     251            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
     252            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    253253         ENDIF 
    254254 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r4990 r5023  
    109109      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    110110      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
    111 #if defined key_diaar5 
    112       REAL(wp)                         ::   zztmp               ! local scalar 
    113 #endif 
    114111      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    115112      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw  
    … …  
    225222         ! 
    226223         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    227          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     224         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 
    228225            ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    229             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
    230             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
     226            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
     227            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    231228         ENDIF 
    232229  
    233 #if defined key_diaar5 
    234          IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    235             z2d(:,:) = 0._wp  
    236             ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    237             zztmp = -1.0_wp * rau0 * rcp 
    238             DO jk = 1, jpkm1 
    239                DO jj = 2, jpjm1 
    240                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    241                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     230         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
     231           ! 
     232           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
     233               z2d(:,:) = 0._wp  
     234               DO jk = 1, jpkm1 
     235                  DO jj = 2, jpjm1 
     236                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     237                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     238                     END DO 
    242239                  END DO 
    243240               END DO 
    244             END DO 
    245             z2d(:,:) = zztmp * z2d(:,:) 
    246             CALL lbc_lnk( z2d, 'U', -1. ) 
    247             CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    248             z2d(:,:) = 0._wp  
    249             DO jk = 1, jpkm1 
    250                DO jj = 2, jpjm1 
    251                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    252                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     241               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     242               CALL lbc_lnk( z2d, 'U', -1. ) 
     243               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
     244               ! 
     245               z2d(:,:) = 0._wp  
     246               DO jk = 1, jpkm1 
     247                  DO jj = 2, jpjm1 
     248                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     249                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     250                     END DO 
    253251                  END DO 
    254252               END DO 
    255             END DO 
    256             z2d(:,:) = zztmp * z2d(:,:) 
    257             CALL lbc_lnk( z2d, 'V', -1. ) 
    258             CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
    259          END IF 
    260 #endif 
     253               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     254               CALL lbc_lnk( z2d, 'V', -1. ) 
     255               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
     256            END IF 
     257            ! 
     258         ENDIF 
    261259 
    262260         !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r4990 r5023  
    113113      REAL(wp) ::   ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt 
    114114      REAL(wp) ::   zah, zah_slp, zaei_slp 
    115 #if defined key_diaar5 
    116       REAL(wp) ::   zztmp              ! local scalar 
    117 #endif 
    118115      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d 
    119116      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw  
    … …  
    207204      END DO 
    208205      ! 
    209 #if defined key_iomput 
    210       IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 
    211          CALL wrk_alloc( jpi , jpj , jpk  , zw3d ) 
    212          DO jk=1,jpkm1 
    213             zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
    214          END DO 
    215          zw3d(:,:,jpk) = 0._wp 
    216          CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current 
    217  
    218          DO jk=1,jpk-1 
    219             zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
    220          END DO 
    221          zw3d(:,:,jpk) = 0._wp 
    222          CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current 
    223  
    224          DO jk=1,jpk-1 
    225             DO jj = 2, jpjm1 
    226                DO ji = fs_2, fs_jpim1  ! vector opt. 
    227                   zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 
    228                        &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
    229                END DO 
    230             END DO 
    231          END DO 
    232          zw3d(:,:,jpk) = 0._wp 
    233          CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current 
    234          CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     206      IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") )  THEN 
     207         ! 
     208         IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 
     209            CALL wrk_alloc( jpi , jpj , jpk  , zw3d ) 
     210            DO jk=1,jpkm1 
     211               zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
     212            END DO 
     213            zw3d(:,:,jpk) = 0._wp 
     214            CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current 
     215 
     216            DO jk=1,jpk-1 
     217               zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
     218            END DO 
     219            zw3d(:,:,jpk) = 0._wp 
     220            CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current 
     221 
     222            DO jk=1,jpk-1 
     223               DO jj = 2, jpjm1 
     224                  DO ji = fs_2, fs_jpim1  ! vector opt. 
     225                     zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 
     226                          &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
     227                  END DO 
     228               END DO 
     229            END DO 
     230            zw3d(:,:,jpk) = 0._wp 
     231            CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current 
     232            CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     233         ENDIF 
     234         ! 
    235235      ENDIF 
    236 #endif 
    237236      !                                                          ! =========== 
    238237      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    387386         ! 
    388387         !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    389          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    390             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )        ! 3.3  names 
    391             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     388         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 
     389            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names 
     390            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    392391         ENDIF 
    393392 
    394 #if defined key_diaar5 
    395          IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    396             z2d(:,:) = 0._wp 
    397             zztmp = rau0 * rcp 
    398             DO jk = 1, jpkm1 
    399                DO jj = 2, jpjm1 
    400                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    401                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
    402                   END DO 
    403                END DO 
    404             END DO 
    405             z2d(:,:) = zztmp * z2d(:,:) 
    406             CALL lbc_lnk( z2d, 'U', -1. ) 
    407             CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    408             z2d(:,:) = 0._wp 
    409             DO jk = 1, jpkm1 
    410                DO jj = 2, jpjm1 
    411                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    412                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
    413                   END DO 
    414                END DO 
    415             END DO 
    416             z2d(:,:) = zztmp * z2d(:,:) 
    417             CALL lbc_lnk( z2d, 'V', -1. ) 
    418             CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in j-direction 
    419          END IF 
    420 #endif 
     393         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
     394           ! 
     395           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
     396               z2d(:,:) = 0._wp  
     397               DO jk = 1, jpkm1 
     398                  DO jj = 2, jpjm1 
     399                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     400                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     401                     END DO 
     402                  END DO 
     403               END DO 
     404               z2d(:,:) = rau0_rcp * z2d(:,:)  
     405               CALL lbc_lnk( z2d, 'U', -1. ) 
     406               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
     407               ! 
     408               z2d(:,:) = 0._wp  
     409               DO jk = 1, jpkm1 
     410                  DO jj = 2, jpjm1 
     411                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     412                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     413                     END DO 
     414                  END DO 
     415               END DO 
     416               z2d(:,:) = rau0_rcp * z2d(:,:)      
     417               CALL lbc_lnk( z2d, 'V', -1. ) 
     418               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
     419            END IF 
     420            ! 
     421         ENDIF 
    421422         ! 
    422423      END DO 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r4990 r5023  
    148148         ! 
    149149         ! "Poleward" diffusive heat or salt transports 
    150          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    151             IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    152             IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     150         IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 
     151            IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
     152            IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    153153         ENDIF 
    154154         !                                                  ! ================== 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4990 r5023  
    6161   USE asminc          ! assimilation increments      
    6262   USE asmbkg          ! writing out state trajectory 
    63    USE diaptr          ! poleward transports           (dia_ptr_init routine) 
    6463   USE diadct          ! sections transports           (dia_dct_init routine) 
    6564   USE diaobs          ! Observation diagnostics       (dia_obs_init routine) 
    … …  
    439438      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    440439      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
    441                             CALL dia_ptr_init   ! Poleward TRansports initialization 
    442440      IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports 
    443441                            CALL dia_hsb_init   ! heat content, salt content and volume budgets 

  • branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5012 r5023  
    211211      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    212212      IF( .NOT. lk_cpl ) CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    213       IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics 
    214213      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    215214      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag 
    … …  
    244243      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
    245244                             CALL tra_ldf    ( kstp )       ! lateral mixing 
     245 
     246      IF( l_diaptr       )   CALL dia_ptr                   ! Poleward adv/ldf TRansports diagnostics 
     247 
    246248#if defined key_agrif 
    247249      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge 
    … …  
    320322      ENDIF 
    321323      IF( kstp == nit000   )   THEN 
    322                  CALL iom_close( numror )     ! close input  ocean restart file 
    323          IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce 
    324          IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice     
     324                                      CALL iom_close( numror )     ! close input  ocean restart file 
     325         IF( lwm )                    CALL FLUSH    ( numond )     ! flush output namelist oce 
     326         IF( lwm .AND. numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice     
    325327      ENDIF 
    326328      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file 
Note: See TracChangeset for help on using the changeset viewer.